diff options
82 files changed, 2745 insertions, 967 deletions
@@ -2,6 +2,473 @@ # arch-tag: automatic-ChangeLog--lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2 # +2006-07-30 11:35:52 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-65 + + Summary: + Introduced `type-name' as a replacement for `find-runtime-type'. + Revision: + skribilo--devel--1.2--patch-65 + + * src/guile/skribilo/lib.scm (type-name): New (formerly + `find-runtime-type'). + + * src/guile/skribilo/utils/compat.scm (find-runtime-type): New. + + modified files: + ChangeLog src/guile/skribilo/lib.scm + src/guile/skribilo/utils/compat.scm + + +2006-07-28 18:29:50 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-64 + + Summary: + Merge from lcourtes@laas.fr--2005-libre/skribilo--devo--1.2 + Revision: + skribilo--devel--1.2--patch-64 + + Patches applied: + + * lcourtes@laas.fr--2005-libre/skribilo--devo--1.2 (patch 22-34) + + - Fixed `engine-add-writer!' so that the insertion order is kept. + - Improved error reporting of the Skribilo module reader. + - Added a pie-chart package that can use either Ploticus or Lout. + - Updated Automake/Autoconf files for the `pie' package. + - Detect Ploticus at configuration-time and decide how to build the doc. + - Reverted patch-22 (was wrong). + - Added before the introduction of the User Manual. + - Updated the FSF address. + - Lout engine: Fixed handling of `:keywords' for `document'. + - pie: Fixed the Lout engine. + - Moved `skribe/api.scm' to `(skribilo package base)'. + - Moved `(skribilo skribe index)' to `(skribilo index)'. + - Fixed `ref' for references by title (`:chapter', `:section', etc.). + + new files: + src/guile/skribilo/package/pie/Makefile.am + + modified files: + ChangeLog configure.ac doc/skr/api.skr doc/user/Makefile.am + doc/user/bib.skb doc/user/eq.skb doc/user/links.skb + doc/user/pie.skb doc/user/sectioning.skb + doc/user/src/Makefile.am doc/user/user.skb + src/guile/skribilo.scm src/guile/skribilo/ast.scm + src/guile/skribilo/biblio.scm + src/guile/skribilo/biblio/abbrev.scm + src/guile/skribilo/biblio/author.scm + src/guile/skribilo/biblio/bibtex.scm + src/guile/skribilo/color.scm + src/guile/skribilo/coloring/c-lex.l + src/guile/skribilo/coloring/c-lex.l.scm + src/guile/skribilo/coloring/c.scm + src/guile/skribilo/coloring/lisp-lex.l + src/guile/skribilo/coloring/lisp-lex.l.scm + src/guile/skribilo/coloring/lisp.scm + src/guile/skribilo/coloring/xml-lex.l + src/guile/skribilo/coloring/xml-lex.l.scm + src/guile/skribilo/condition.scm src/guile/skribilo/debug.scm + src/guile/skribilo/engine.scm + src/guile/skribilo/engine/context.scm + src/guile/skribilo/engine/html.scm + src/guile/skribilo/engine/html4.scm + src/guile/skribilo/engine/lout.scm + src/guile/skribilo/evaluator.scm src/guile/skribilo/index.scm + src/guile/skribilo/lib.scm src/guile/skribilo/location.scm + src/guile/skribilo/module.scm src/guile/skribilo/output.scm + src/guile/skribilo/package/Makefile.am + src/guile/skribilo/package/base.scm + src/guile/skribilo/package/eq.scm + src/guile/skribilo/package/eq/lout.scm + src/guile/skribilo/package/pie.scm + src/guile/skribilo/package/pie/lout.scm + src/guile/skribilo/package/slide.scm + src/guile/skribilo/package/slide/html.scm + src/guile/skribilo/package/slide/latex.scm + src/guile/skribilo/package/slide/lout.scm + src/guile/skribilo/parameters.scm src/guile/skribilo/prog.scm + src/guile/skribilo/reader.scm + src/guile/skribilo/reader/outline.scm + src/guile/skribilo/reader/skribe.scm + src/guile/skribilo/resolve.scm + src/guile/skribilo/skribe/Makefile.am + src/guile/skribilo/skribe/param.scm + src/guile/skribilo/skribe/sui.scm + src/guile/skribilo/source.scm + src/guile/skribilo/utils/compat.scm + src/guile/skribilo/utils/files.scm + src/guile/skribilo/utils/images.scm + src/guile/skribilo/utils/keywords.scm + src/guile/skribilo/utils/strings.scm + src/guile/skribilo/utils/syntax.scm + src/guile/skribilo/verify.scm src/guile/skribilo/writer.scm + src/skribilo.in tools/skribebibtex/stklos/bibtex-lex.l + tools/skribebibtex/stklos/bibtex-parser.y + tools/skribebibtex/stklos/main.stk + + renamed files: + src/guile/skribilo/skribe/.arch-ids/api.scm.id + ==> src/guile/skribilo/package/.arch-ids/base.scm.id + src/guile/skribilo/skribe/.arch-ids/index.scm.id + ==> src/guile/skribilo/.arch-ids/index.scm.id + src/guile/skribilo/skribe/api.scm + ==> src/guile/skribilo/package/base.scm + src/guile/skribilo/skribe/index.scm + ==> src/guile/skribilo/index.scm + + new patches: + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-22 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-23 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-24 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-25 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-26 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-27 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-28 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-29 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-30 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-31 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-32 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-33 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-34 + + +2006-07-23 20:47:15 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-63 + + Summary: + Added a pie-chart package that can use either Ploticus or Lout. + Revision: + skribilo--devel--1.2--patch-63 + + * doc/user/user.skb: Use the `pie' package and include `pie.skb'. + + new files: + doc/user/pie.skb doc/user/src/.arch-ids/pie1.skb.id + doc/user/src/.arch-ids/pie2.skb.id doc/user/src/pie1.skb + doc/user/src/pie2.skb src/guile/skribilo/package/pie.scm + src/guile/skribilo/package/pie/.arch-ids/=id + src/guile/skribilo/package/pie/lout.scm + + modified files: + ChangeLog doc/user/user.skb + + new directories: + src/guile/skribilo/package/pie + src/guile/skribilo/package/pie/.arch-ids + + +2006-07-23 20:36:51 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-62 + + Summary: + Improved error reporting of the Skribilo module reader. + Revision: + skribilo--devel--1.2--patch-62 + + * src/guile/skribilo/utils/syntax.scm (%skribilo-module-reader): Improved + error reporting by showing the location of the unexpected character. + + modified files: + ChangeLog src/guile/skribilo/utils/syntax.scm + + +2006-07-23 14:38:34 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-61 + + Summary: + Fixed `engine-add-writer!' so that the insertion order is kept. + Revision: + skribilo--devel--1.2--patch-61 + + * src/guile/skribilo/engine.scm (engine-add-writer!): Use `append' + instead of `cons' when adding a writer, so that the insertion order is + honored when lookups are performed. This fixes a generation bug (e.g., + for the first page of the User Manual) and slightly improves + performance. + + * src/guile/skribilo/writer.scm (lookup-markup-writer): Documented the + impact of registration order. + + modified files: + ChangeLog src/guile/skribilo/engine.scm + src/guile/skribilo/writer.scm + + +2006-07-23 14:11:06 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-60 + + Summary: + Merge from lcourtes@laas.fr--2005-libre/skribilo--devo--1.2 + Revision: + skribilo--devel--1.2--patch-60 + + Patches applied: + + * lcourtes@laas.fr--2005-libre/skribilo--devo--1.2 (patch 8-21) + + - Use `setvbuf' on the Skribilo output port. + - Made `parse-list-of' tail-recursive. + - Fixed the handling of `:' by the Skribe reader. + - compat: Optimized `hashtable->list'. + - Merged the two bibliography modules. + - Implemented `markup-body-set!'. + - Fixed abbreviations and author names handling. + - Turned `with-debug' into a more self-sufficient macro. + - Removed unused code in `(skribilo lib)'. + - Removed the `(skribilo skribe utils)' module. + - Renamed `(skribilo runtime)' to `(skribilo utils strings)'. + - biblio abbrev: Added a few more abbreviations. + - Added support for the `:keywords' option of `document' (Lout + HTML). + - Made the HTML engine and `web-book' more style-neutral. + + new files: + src/guile/skribilo/utils/keywords.scm + + removed files: + src/guile/skribilo/skribe/.arch-ids/bib.scm.id + src/guile/skribilo/skribe/.arch-ids/utils.scm.id + src/guile/skribilo/skribe/bib.scm + src/guile/skribilo/skribe/utils.scm + + modified files: + ChangeLog NEWS doc/user/document.skb doc/user/user.skb + src/guile/skribilo/Makefile.am src/guile/skribilo/ast.scm + src/guile/skribilo/biblio.scm + src/guile/skribilo/biblio/abbrev.scm + src/guile/skribilo/biblio/author.scm + src/guile/skribilo/biblio/bibtex.scm + src/guile/skribilo/coloring/lisp.scm + src/guile/skribilo/debug.scm src/guile/skribilo/engine.scm + src/guile/skribilo/engine/html.scm + src/guile/skribilo/engine/lout.scm src/guile/skribilo/lib.scm + src/guile/skribilo/module.scm + src/guile/skribilo/package/eq.scm + src/guile/skribilo/package/eq/lout.scm + src/guile/skribilo/package/web-book.scm + src/guile/skribilo/skribe/Makefile.am + src/guile/skribilo/skribe/api.scm + src/guile/skribilo/utils/Makefile.am + src/guile/skribilo/utils/compat.scm + src/guile/skribilo/utils/strings.scm + src/guile/skribilo/verify.scm + + renamed files: + src/guile/skribilo/.arch-ids/runtime.scm.id + ==> src/guile/skribilo/utils/.arch-ids/strings.scm.id + src/guile/skribilo/runtime.scm + ==> src/guile/skribilo/utils/strings.scm + + new patches: + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-8 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-9 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-10 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-11 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-12 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-13 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-14 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-15 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-16 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-17 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-18 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-19 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-20 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-21 + + +2006-07-14 14:42:40 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-59 + + Summary: + Fixed the handling of `:' by the Skribe reader. + Revision: + skribilo--devel--1.2--patch-59 + + * src/guile/skribilo/reader/skribe.scm (make-colon-free-token-reader): + New. + (%make-skribe-reader): Make sure `:' is handled only by the keyword + reader. + + modified files: + ChangeLog src/guile/skribilo/reader/skribe.scm + + +2006-07-12 16:28:29 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-58 + + Summary: + Made `parse-list-of' tail-recursive. + Revision: + skribilo--devel--1.2--patch-58 + + * src/guile/skribilo/skribe/api.scm (parse-list-of): Made tail-recursive, + thereby fixing potential stack overflows (e.g., when building the user + manual) and perhaps slightly improving performance. + + modified files: + ChangeLog src/guile/skribilo/skribe/api.scm + + +2006-07-12 16:14:24 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-57 + + Summary: + Merge from lcourtes@laas.fr--2005-libre/skribilo--devo--1.2 + Revision: + skribilo--devel--1.2--patch-57 + + Patches applied: + + * lcourtes@laas.fr--2005-libre/skribilo--devo--1.2 (patch 2-7) + + - outline: Fixed the regexps of the inline markup for `tt' and `q'. + - Tiny configure fix: make `src/skribilo' executable. + - By default, use (internally) a reader that does not record positions. + - Use SRFI-35 error conditions in `resolve.scm' rather than the `error' + procedures. + - Noticeable performance improvements (notably in `debug'). + - Fixed autoloading of `verify', plus tiny cosmetic change. + + modified files: + ChangeLog configure.ac src/guile/skribilo/biblio.scm + src/guile/skribilo/debug.scm src/guile/skribilo/engine.scm + src/guile/skribilo/reader/outline.scm + src/guile/skribilo/resolve.scm + src/guile/skribilo/utils/syntax.scm + src/guile/skribilo/verify.scm src/skribilo.in + + new patches: + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-2 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-3 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-4 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-5 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-6 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-7 + + +2006-06-08 20:26:55 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-56 + + Summary: + Merge from lcourtes@laas.fr--2005-libre/skribilo--devo--1.2 + Revision: + skribilo--devel--1.2--patch-56 + + Patches applied: + + * lcourtes@laas.fr--2005-libre/skribilo--devo--1.2 (base, patch 1) + + - tag of lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--version-0 + - eq: Handle operator precedence when parenthesizing. + + modified files: + ChangeLog src/guile/skribilo/package/eq.scm + src/guile/skribilo/package/eq/lout.scm + + new patches: + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--base-0 + lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-1 + + +2006-06-08 20:24:12 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-55 + + Summary: + Merge from lcourtes@laas.fr--2004-libre + Revision: + skribilo--devel--1.2--patch-55 + + Patches applied: + + * lcourtes@laas.fr--2004-libre/skribilo--devel--1.2 (patch 84-87) + + - Added `bib-map'. + - Cleaned up the `write' method for `markup' and `unresolved' objects. + - Generalized the error condition handling framework. + - Fixed exception handling in `output.scm'. + + * lcourtes@laas.fr--2004-libre/skribilo--devel--1.2- (version 0) + + - Sealing and moving to `lcourtes@laas.fr--2005-libre/skribilo--devo--1.2'. + + modified files: + ChangeLog src/guile/skribilo/ast.scm + src/guile/skribilo/biblio.scm src/guile/skribilo/condition.scm + src/guile/skribilo/output.scm + + new patches: + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-84 + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-85 + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-86 + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-87 + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--version-0 + + +2006-05-10 17:14:10 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-54 + + Summary: + Merge from lcourtes@laas.fr--2004-libre + Revision: + skribilo--devel--1.2--patch-54 + + Patches applied: + + * lcourtes@laas.fr--2004-libre/skribilo--devel--1.2 (patch 80-83) + + - Added `markup-option-set!'. + - eq: Fixed the rendering of `*' in the Lout implementation. + - Added `bib-for-each'. Fixed binding issues in the evaluator and compat. + - Added biblio helpers (abbrev, author, BibTeX) taken from my `biblib.skr'. + + new files: + src/guile/skribilo/biblio/.arch-ids/=id + src/guile/skribilo/biblio/Makefile.am + src/guile/skribilo/biblio/abbrev.scm + src/guile/skribilo/biblio/author.scm + src/guile/skribilo/biblio/bibtex.scm + + modified files: + ChangeLog configure.ac src/guile/skribilo/Makefile.am + src/guile/skribilo/ast.scm src/guile/skribilo/biblio.scm + src/guile/skribilo/engine/lout.scm + src/guile/skribilo/evaluator.scm + src/guile/skribilo/package/eq/lout.scm + src/guile/skribilo/utils/compat.scm + + new directories: + src/guile/skribilo/biblio src/guile/skribilo/biblio/.arch-ids + + new patches: + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-80 + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-81 + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-82 + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-83 + + +2006-04-23 17:28:38 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-53 + + Summary: + Merge from lcourtes@laas.fr--2004-libre + Revision: + skribilo--devel--1.2--patch-53 + + Patches applied: + + * lcourtes@laas.fr--2004-libre/skribilo--devel--1.2 (patch 79) + + - eq: Added the `inline?' keyword; fixed the Lout engine. + + modified files: + ChangeLog src/guile/skribilo/package/eq.scm + src/guile/skribilo/package/eq/lout.scm + + new patches: + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-79 + + +2006-04-23 17:28:14 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-52 + + Summary: + Use `setvbuf' on the Skribilo output port. + Revision: + skribilo--devel--1.2--patch-52 + + * src/guile/skribilo.scm (skribilo): Call `setvbuf'. + + + modified files: + ChangeLog src/guile/skribilo.scm + + 2006-04-08 10:26:51 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-51 Summary: @@ -6,4 +6,7 @@ New in Skribilo 1.2 (compared to Skribe 1.2d) * New markups: `~', `numref', `!lout', `lout-illustration'. - * Extended markups: `footnote' now takes a `:label' option. + * Extended markups: + + - `footnote' now takes a `:label' option. + - `document' now takes a `:keywords' option. diff --git a/configure.ac b/configure.ac index ff903ff..e889401 100644 --- a/configure.ac +++ b/configure.ac @@ -21,10 +21,17 @@ GUILE_MODULE_REQUIRED([srfi srfi-35]) AC_PATH_PROG([LOUT], [lout], [not-found]) AM_CONDITIONAL([HAVE_LOUT], [test "x$LOUT" != "xnot-found"]) +# Look for Ploticus. +AC_PATH_PROGS([PLOTICUS], [ploticus pl], [not-found]) +AM_CONDITIONAL([HAVE_PLOTICUS], [test "x$PLOTICUS" != "xnot-found"]) + + AC_SUBST([SKRIBILO_DOC_DIR], ["$datadir/doc/skribilo"]) AC_SUBST([SKRIBILO_EXT_DIR], ["$datadir/skribilo/1.2/"]) AC_SUBST([SKRIBILO_SKR_PATH], ["$GUILE_SITE/"]) +AC_CONFIG_COMMANDS([skribilo-executable], [chmod a+x src/skribilo]) + AC_OUTPUT([Makefile src/skribilo src/Makefile @@ -37,8 +44,10 @@ AC_OUTPUT([Makefile src/guile/skribilo/package/Makefile src/guile/skribilo/package/slide/Makefile src/guile/skribilo/package/eq/Makefile + src/guile/skribilo/package/pie/Makefile src/guile/skribilo/skribe/Makefile src/guile/skribilo/coloring/Makefile + src/guile/skribilo/biblio/Makefile doc/Makefile doc/user/Makefile doc/user/src/Makefile diff --git a/doc/skr/api.skr b/doc/skr/api.skr index a86e745..369c605 100644 --- a/doc/skr/api.skr +++ b/doc/skr/api.skr @@ -330,7 +330,7 @@ (idx *markup-index*) (idx-note "definition") (idx-suffix #f) - (source "skribilo/skribe/api.scm") + (source "skribilo/package/base.scm") (def #f) (see-also '()) (others '()) diff --git a/doc/user/Makefile.am b/doc/user/Makefile.am index d53d46c..3428ad5 100644 --- a/doc/user/Makefile.am +++ b/doc/user/Makefile.am @@ -4,11 +4,12 @@ EXTRA_DIST = bib.skb char.skb colframe.skb document.skb emacs.skb \ engine.skb enumeration.skb eq.skb examples.skb figure.skb \ font.skb footnote.skb htmle.skb image.skb index.skb \ justify.skb latexe.skb lib.skb line.skb links.skb \ - markup.skb ornament.skb package.skb prgm.skb sectioning.skb \ + markup.skb ornament.skb package.skb pie.skb prgm.skb sectioning.skb \ skribe-config.skb skribec.skb skribeinfo.skb slide.skb start.skb \ syntax.skb table.skb toc.skb user.skb xmle.skb -BUILT_SOURCES = user.html +BUILT_SOURCES = doc-config.scm +html_DATA = user.html skribilo = $(top_srcdir)/src/skribilo load_path = $(top_srcdir)/src/guile:$(top_srcdir)/src/guile/skribilo/package @@ -19,7 +20,7 @@ load_path = $(top_srcdir)/src/guile:$(top_srcdir)/src/guile/skribilo/package if HAVE_LOUT -BUILT_SOURCES += user.ps +ps_DATA = user.ps %.lout: %.skb GUILE_LOAD_PATH=$(load_path):$$GUILE_LOAD_PATH \ @@ -30,3 +31,11 @@ BUILT_SOURCES += user.ps endif +if HAVE_PLOTICUS +doc-config.scm: + -echo "(define %have-ploticus? #t)" > $@ + -echo "(define %ploticus-path \"$(PLOTICUS)\")" >> $@ +else +doc-config.scm: + -echo "(define %have-ploticus? #f) (define %ploticus-path #f)" > $@ +endif diff --git a/doc/user/bib.skb b/doc/user/bib.skb index aa357e8..dd7ceb6 100644 --- a/doc/user/bib.skb +++ b/doc/user/bib.skb @@ -207,7 +207,7 @@ pre-existing functions for sorting entries:]) (doc-markup 'bib-sort/authors '((l [The list of entries.])) :force-engines *api-engines* - :source "skribilo/skribe/bib.scm" + :source "skribilo/biblio.scm" :others '(bib-sort/idents bib-sort/dates) :common-args '()) @@ -217,7 +217,7 @@ entries identifier. The last one sorts according to entries date.]) (example-produce (example :legend "Sorting bibliography entries" - (prgm :file "skribilo/skribe/bib.scm" + (prgm :file "skribilo/biblio.scm" :definition 'bib-sort/idents))))) ;*---------------------------------------------------------------------*/ diff --git a/doc/user/document.skb b/doc/user/document.skb index 5797da8..8521af0 100644 --- a/doc/user/document.skb +++ b/doc/user/document.skb @@ -39,6 +39,10 @@ (:html-title "The title of window of the HTML browser.") (:author "The authors of the document.") (:ending "An ending text.") + (:keywords "A list of keywords which may be plain strings +or markups. The keywords will not appear in the final document but only +as meta-information (e.g., using the HTML `meta' tag) if the engine used +supports it.") (:env "A counter environment.") (#!rest node... "The document nodes.")) :see-also '(author chapter toc)) diff --git a/doc/user/eq.skb b/doc/user/eq.skb index 62bd704..d8f4063 100644 --- a/doc/user/eq.skb +++ b/doc/user/eq.skb @@ -13,7 +13,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. ;;; FIXME: This is a stub and must be completed! diff --git a/doc/user/links.skb b/doc/user/links.skb index b454f28..96c5222 100644 --- a/doc/user/links.skb +++ b/doc/user/links.skb @@ -76,13 +76,13 @@ section, to bibliographic entries, to source code line number, etc.]) (:mark [A string that is the name of a mark. That mark has been introduced by a ,(markup-ref "mark") markup.]) (:handle [A Skribe node ,(markup-ref "handle").]) - (:ident [A reference to a node who has been specified - an ,(param :ident) value.]) - (:figure [The name of a ,(markup-ref "figure").]) - (:chapter [The name of a ,(markup-ref "chapter").]) - (:section [The name of a ,(markup-ref "section").]) - (:subsection [The name of a ,(markup-ref "subsection").]) - (:subsubsection [The name of a ,(markup-ref "subsubsection").]) + (:ident [The identifier of a node (which was specified + as an ,(param :ident) value).]) + (:figure [The identifier of a ,(markup-ref "figure").]) + (:chapter [The title of a ,(markup-ref "chapter").]) + (:section [The title of a ,(markup-ref "section").]) + (:subsection [The title of a ,(markup-ref "subsection").]) + (:subsubsection [The title of a ,(markup-ref "subsubsection").]) (:page [A boolean enabling/disabling page reference.]) (:bib ,[A name or a list of names of ,(ref :chapter "Bibliographies" :text "bibliographic") entry.]) diff --git a/doc/user/pie.skb b/doc/user/pie.skb new file mode 100644 index 0000000..477c3f7 --- /dev/null +++ b/doc/user/pie.skb @@ -0,0 +1,69 @@ +;;; Copyright 2006 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;; USA. + +;;; FIXME: This is a stub and must be completed! + +(chapter :title [Pie Charts] :ident "pie-charts" + + (p [Skribilo contains a pie-chart formatting package, located in the +,(tt [(skribilo package pie)]) module. It allows users to produces +represent numeric data as pie charts as in the following example:] + + (disp (pie :title [Use of Document Formatting Systems] + :fingers? #t :labels 'outside + :initial-angle 90 + :ident "pie-skribilo-rulez" + (slice :weight 10 :color "red" :detach? #t + (bold [Skribilo])) + (slice :weight 6 :color "green" "Skribe") + (slice :weight 6 :color "blue" "Lout") + (slice :weight 4 :color "lightgrey" "LaTeX") + (slice :weight 2 :color "yellow" "Docbook") + (slice :weight 1 :color "black" "others")))) + + (p [A default implementation, which uses ,(ref :text [Ploticus] :url +"http://ploticus.sf.net") as an external program, is available for all +engines. There is also a specific implementation for the Lout engine +which relies on Lout's own pie-chart package. In the latter case, you +don't need to have Ploticus installed, but you need it in the former.]) + (p [Currently it only supports slice-coloring, but support for +textures (particularly useful for black & white printouts) could be +added in the future.]) + + (section :title [Syntax] + + (p [Let us start with a simple example:] + + (example-produce + (example :legend "Example of a pie chart" + (prgm :file "src/pie1.skb")) + (disp (include "src/pie1.skb")))) + + (p [This illustrates the three markups provided by the ,(tt [pie]) +package, namely ,(tt [pie]), ,(tt [slice]), and ,(tt [sliceweight]). +This last markup returns the weight of the slice it is used in, be it as +a percentage or an absolute value. Note that the ,(tt [:total]) option +of ,(tt [pie]) can be used to create pie charts no entirely filled.]) + (p [Various options allow the pie layout to be controlled:] + + (example-produce + (example :legend "Specifying the layout of a pie chart" + (prgm :file "src/pie2.skb")) + (disp (include "src/pie2.skb")))))) + +;;; arch-tag: 60382016-3a63-4466-83e0-46a259cb39ab diff --git a/doc/user/sectioning.skb b/doc/user/sectioning.skb index 5f1dc3f..9d11d08 100644 --- a/doc/user/sectioning.skb +++ b/doc/user/sectioning.skb @@ -101,7 +101,7 @@ paragraphs.]) (p [The function ,(code "p") is an alias for ,(code "paragraph").]) (doc-markup 'p '((#!rest node... "The nodes of the paragraph.")) - :source "skribilo/skribe/api.scm" + :source "skribilo/package/base.scm" :see-also '(document chapter section paragraph))) ;*--- blockquote -----------------------------------------------------*/ diff --git a/doc/user/src/Makefile.am b/doc/user/src/Makefile.am index 6d7daf4..6c61a1f 100644 --- a/doc/user/src/Makefile.am +++ b/doc/user/src/Makefile.am @@ -4,8 +4,8 @@ EXTRA_DIST = api1.skb api10.skb api11.skb api12.skb api13.skb \ api4.skb api5.skb api6.skb api7.skb api8.skb \ api9.skb bib1.sbib bib2.skb bib3.skb bib4.skb \ bib5.skb bib6.skb eq1.skb eq2.skb index1.skb \ - index2.skb index3.skb links1.skb links2.skb prgm1.skb \ - prgm2.skb prgm3.skb slides.skb start1.skb start2.skb \ - start3.skb start4.skb start5.skb + index2.skb index3.skb links1.skb links2.skb pie1.skb pie2.skb \ + prgm1.skb prgm2.skb prgm3.skb slides.skb \ + start1.skb start2.skb start3.skb start4.skb start5.skb ## arch-tag: 9614a784-cac2-4399-bd61-18c9172f48a8 diff --git a/doc/user/src/pie1.skb b/doc/user/src/pie1.skb new file mode 100644 index 0000000..0d0fd0b --- /dev/null +++ b/doc/user/src/pie1.skb @@ -0,0 +1,13 @@ +;; A sad pie chart. +;; + +(pie :title [Casualties in the Israel-Lebanon 2006 Conflict (source: +English Wikipedia page, 2006-07-23)] + :total 450 ;; to show the uncertainty on figures + :ident "pie-lebanon-2006" + :labels 'outside :fingers? #t + + (slice :weight 8 :color "black" [Hezbollah militants]) + (slice :weight 42 :color "blue" [soldiers]) + (slice :weight 317 :color "red" :detach? #t + [civilians (,(sliceweight :percentage? #t)%)])) diff --git a/doc/user/src/pie2.skb b/doc/user/src/pie2.skb new file mode 100644 index 0000000..84b5394 --- /dev/null +++ b/doc/user/src/pie2.skb @@ -0,0 +1,14 @@ +;; Another sad pie chart. +;; + +(pie :title [Casualties of the Conflict in Iraq since 2003 (source: +English Wikipedia page, 2006-07-23)] + :ident "pie-iraq-2006" + :fingers? #f + :labels 'inside + :initial-angle 45 + :radius 2 + + (slice :weight 100000 :color "red" :detach? #t + [civilians (,(sliceweight :percentage? #t)%)]) + (slice :weight (+ 2555 229) :color #xeeeeee [soldiers])) diff --git a/doc/user/user.skb b/doc/user/user.skb index f6a25ef..d1f9287 100644 --- a/doc/user/user.skb +++ b/doc/user/user.skb @@ -20,7 +20,13 @@ ;*---------------------------------------------------------------------*/ ;* Packages */ ;*---------------------------------------------------------------------*/ -(use-modules (skribilo package eq)) +(use-modules (skribilo package eq) + (skribilo package pie)) + +;; Load the compile-time configuration file. +(load "doc-config.scm") + +(if %have-ploticus? (set! %ploticus-program %ploticus-path)) ;*---------------------------------------------------------------------*/ ;* HTML custom */ @@ -49,6 +55,8 @@ ;* The document */ ;*---------------------------------------------------------------------*/ (document :title "Skribilo User Manual" + :keywords '("Skribilo" "Skribe" "User Manual" "text processing" + "HTML" "LaTeX" "Lout" "PostScript" "PDF") :env '((example-counter 0) (example-env ())) :author (list (author :name "Erick Gallesio" :affiliation "Université de Nice - Sophia Antipolis" @@ -59,14 +67,14 @@ (author :name "Ludovic Courtès" :email (mailto *courtes-mail*))) - (linebreak 1) - (center (frame (bold (font :size 1. [ -This is the documentation for Skribe version -,(color :fg "red" (skribe-release)).])))) - (linebreak 1) +(p :class "welcome" + [Welcome to the User Manual for Skribilo version ,(skribe-release). +If you are new to Skribilo, please read the ,(ref :ident "intro" +:text [introduction]) first.]) + ;;; Introduction -(chapter :title "Introduction" :number #f :toc #f :file #f [ +(chapter :title "Introduction" :ident "intro" :number #f :toc #t :file #f [ Skribe is a programming language designed for implementing electronic documents. It is mainly designed for the writing of technical documents such as the documentation of computer programs. With Skribe these @@ -79,7 +87,9 @@ produce a high-quality printed document, and so on.] Everyone needing to design web pages, info documents, man pages or Postscript files can use Skribe. In particular, there is ,(bold "no need") for programming skills in order to use Skribe. Skribe can be used as -any text description languages such as TeX, LaTeX or HTML.]) +any text description languages such as ,(ref :text [LaTeX] :url +"http://latex-project.org/"), ,(ref :text [Lout] :url +"http://lout.sf.net/") or HTML.]) (section :title "Why using Skribe?" :number #f [ There are three main reasons for using Skribe:] @@ -132,6 +142,9 @@ as HTML, Info pages, man pages, Postscript, etc.])))) ;;; Equations (include "eq.skb") +;;; Pie charts +(if %have-ploticus? (include "pie.skb")) + ;;; Standard Library (include "lib.skb") diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm index dbaa368..53afa89 100644 --- a/src/guile/skribilo.scm +++ b/src/guile/skribilo.scm @@ -22,7 +22,7 @@ exec ${GUILE-guile} --debug -l $0 -c "(apply $main (cdr (command-line)))" "$@" ;;;; ;;;; 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, +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;;; USA. ;;;; Commentary: @@ -464,6 +464,8 @@ Processes a Skribilo/Skribe source file and produces its output. (open-output-file output-file) (current-output-port)))) + (setvbuf (*skribilo-output-port*) _IOFBF 16384) + ;; (start-stack 7 (if source-file (with-input-from-file source-file doskribe) diff --git a/src/guile/skribilo/Makefile.am b/src/guile/skribilo/Makefile.am index 6689d15..8de8774 100644 --- a/src/guile/skribilo/Makefile.am +++ b/src/guile/skribilo/Makefile.am @@ -2,9 +2,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 \ + reader.scm resolve.scm \ source.scm parameters.scm verify.scm \ writer.scm ast.scm location.scm \ condition.scm -SUBDIRS = utils reader engine package skribe coloring +SUBDIRS = utils reader engine package skribe coloring biblio diff --git a/src/guile/skribilo/ast.scm b/src/guile/skribilo/ast.scm index 3968b18..f8ee519 100644 --- a/src/guile/skribilo/ast.scm +++ b/src/guile/skribilo/ast.scm @@ -1,7 +1,8 @@ ;;; ast.scm -- Skribilo abstract syntax trees. ;;; -;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> -;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -16,12 +17,13 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo ast) :use-module (oop goops) :autoload (skribilo location) (location?) + :autoload (skribilo lib) (skribe-type-error skribe-error) :use-module (skribilo utils syntax) :export (<ast> ast? ast-loc ast-loc-set! ast-parent ast->string ast->file-location @@ -34,9 +36,11 @@ <processor> processor? processor-combinator processor-engine <markup> markup? bind-markup! markup-options is-markup? - markup-markup markup-body markup-ident markup-class + markup-markup markup-body markup-body-set! + markup-ident markup-class find-markups - markup-option markup-option-add! markup-output + markup-option markup-option-set! + markup-option-add! markup-output markup-parent markup-document markup-chapter <container> container? container-options @@ -44,9 +48,15 @@ container-env-get <document> document? document-ident document-body - document-options document-end)) + document-options document-end -;;; Author: Ludovic Courtès + ;; traversal + find-markup-ident + container-search-down search-down find-down find1-down + find-up find1-up + ast-document ast-chapter ast-section)) + +;;; Author: Erick Gallesio, Manuel Serrano, Ludovic Courtès ;;; ;;; Commentary: ;;; @@ -214,6 +224,9 @@ (define (markup? obj) (is-a? obj <markup>)) (define (markup-options obj) (slot-ref obj 'options)) (define markup-body node-body) +(define (markup-body-set! m body) + (slot-set! m 'resolved? #f) + (slot-set! m 'body body)) (define (markup-option m opt) (if (markup? m) @@ -222,6 +235,14 @@ (cadr c))) (skribe-type-error 'markup-option "Illegal markup: " m "markup"))) +(define (markup-option-set! m opt val) + (if (markup? m) + (let ((c (assq opt (slot-ref m 'options)))) + (if (and (pair? c) (pair? (cdr c))) + (set-cdr! c (list val)) + (skribe-error 'markup-option-set! "unknown option: " + m))) + (skribe-type-error 'markup-option-set! "Illegal markup: " m "markup"))) (define (markup-option-add! m opt val) (if (markup? m) @@ -263,12 +284,31 @@ (hash-ref *node-table* ident #f)) -(define-method (write-object (obj <markup>) port) - (format port "#[~A (~A/~A) ~A]" +(define-method (write (obj <markup>) port) + (format port "#<~A (~A/~A) ~A>" (class-name (class-of obj)) (slot-ref obj 'markup) (slot-ref obj 'ident) - (address-of obj))) + (object-address obj))) + +(define-method (write (node <unresolved>) port) + (let ((proc (slot-ref node 'proc))) + (format port "#<<unresolved> (~A~A) ~A>" + proc + (let* ((name (or (procedure-name proc) "")) + (source (procedure-source proc)) + (file (and source (source-property source 'filename))) + (line (and source (source-property source 'line)))) + (format (current-error-port) "src=~a~%" source) + (string-append name + (if file + (string-append " " file + (if line + (number->string line) + "")) + ""))) + (object-address node)))) + ;;; XXX: This was already commented out in the original Skribe source. @@ -332,6 +372,119 @@ (define document-env container-env) + +;;; +;;; AST traversal utilities. +;;; + + +;; The procedures below are almost unchanged compared to Skribe 1.2d's +;; `lib.scm' file found in the `common' directory, written by Manuel Serrano +;; (I removed uses of `with-debug' et al., though). + + +(define (find-markup-ident ident) + (let ((r (find-markups ident))) + (if (or (pair? r) (null? r)) + r + '()))) + +(define (container-search-down pred obj) + (let loop ((obj (markup-body obj))) + (cond + ((pair? obj) + (apply append (map (lambda (o) (loop o)) obj))) + ((container? obj) + (let ((rest (loop (markup-body obj)))) + (if (pred obj) + (cons obj rest) + rest))) + ((pred obj) + (list obj)) + (else + '())))) + +(define (search-down pred obj) + (let loop ((obj (markup-body obj))) + (cond + ((pair? obj) + (apply append (map (lambda (o) (loop o)) obj))) + ((markup? obj) + (let ((rest (loop (markup-body obj)))) + (if (pred obj) + (cons obj rest) + rest))) + ((pred obj) + (list obj)) + (else + '())))) + +(define (find-down pred obj) + (let loop ((obj obj)) + (cond + ((pair? obj) + (apply append (map (lambda (o) (loop o)) obj))) + ((markup? obj) + (if (pred obj) + (list (cons obj (loop (markup-body obj)))) + '())) + (else + (if (pred obj) + (list obj) + '()))))) + +(define (find1-down pred obj) + (let loop ((obj obj) + (stack '())) + (cond + ((memq obj stack) + (skribe-error 'find1-down "Illegal cyclic object" obj)) + ((pair? obj) + (let liip ((obj obj)) + (cond + ((null? obj) + #f) + (else + (or (loop (car obj) (cons obj stack)) + (liip (cdr obj))))))) + ((pred obj) + obj) + ((markup? obj) + (loop (markup-body obj) (cons obj stack))) + (else + #f)))) + +(define (find-up pred obj) + (let loop ((obj obj) + (res '())) + (cond + ((not (ast? obj)) + res) + ((pred obj) + (loop (ast-parent obj) (cons obj res))) + (else + (loop (ast-parent obj) (cons obj res)))))) + +(define (find1-up pred obj) + (let loop ((obj obj)) + (cond + ((not (ast? obj)) + #f) + ((pred obj) + obj) + (else + (loop (ast-parent obj)))))) + +(define (ast-document m) + (find1-up document? m)) + +(define (ast-chapter m) + (find1-up (lambda (n) (is-markup? n 'chapter)) m)) + +(define (ast-section m) + (find1-up (lambda (n) (is-markup? n 'section)) m)) + + ;;; arch-tag: e2489bd6-1b6d-4b03-bdfb-83cffd2f7ce7 ;;; ast.scm ends here diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm index 082fb99..e5ab6e3 100644 --- a/src/guile/skribilo/biblio.scm +++ b/src/guile/skribilo/biblio.scm @@ -1,7 +1,7 @@ ;;; biblio.scm -- Bibliography functions. ;;; -;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> -;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> +;;; Copyright 2005, 2006 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 @@ -15,27 +15,46 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA.main.st (define-module (skribilo biblio) - :use-module (skribilo runtime) + :use-module (skribilo utils strings) :use-module (skribilo utils syntax) ;; `when', `unless' - :use-module (skribilo module) - :use-module (skribilo skribe bib) ;; `make-bib-entry' - :autoload (srfi srfi-34) (raise) + :autoload (srfi srfi-34) (raise) :use-module (srfi srfi-35) - :autoload (skribilo condition) (&file-search-error) + :use-module (srfi srfi-1) + :autoload (skribilo condition) (&file-search-error) :autoload (skribilo reader) (%default-reader) :autoload (skribilo parameters) (*bib-path*) - :autoload (ice-9 format) (format) + :autoload (skribilo ast) (<markup> <handle>) + + :use-module (ice-9 optargs) + :use-module (oop goops) + :export (bib-table? make-bib-table default-bib-table - bib-add! bib-duplicate - skribe-open-bib-file parse-bib)) + bib-add! bib-duplicate bib-for-each bib-map + skribe-open-bib-file parse-bib + + bib-load! resolve-bib resolve-the-bib make-bib-entry + + ;; sorting entries + bib-sort/authors bib-sort/idents bib-sort/dates)) + +;;; Author: Erick Gallesio, Manuel Serrano, Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; Provides the bibliography data type and basic bibliography handling, +;;; including simple procedures to sort bibliography entries. +;;; +;;; FIXME: This module need cleanup! +;;; +;;; Code: (fluid-set! current-reader %skribilo-module-reader) @@ -66,15 +85,23 @@ (set! *bib-table* (make-bib-table "default-bib-table"))) *bib-table*) -;; -;; Utilities -;; (define (%bib-error who entry) (let ((msg "bibliography syntax error on entry")) (if (%epair? entry) (skribe-line-error (%epair-file entry) (%epair-line entry) who msg entry) (skribe-error who msg entry)))) +(define* (bib-for-each proc :optional (table (default-bib-table))) + (hash-for-each (lambda (ident entry) + (proc ident entry)) + table)) + +(define* (bib-map proc :optional (table (default-bib-table))) + (hash-map->list (lambda (ident entry) + (proc ident entry)) + table)) + + ;;; ====================================================================== ;;; ;;; BIB-DUPLICATE @@ -162,3 +189,194 @@ path))) (raise (condition (&file-search-error (file-name file) (path (*bib-path*)))))))) + + +;;; +;;; High-level API. +;;; +;;; The contents of the file below are unchanged compared to Skribe 1.2d's +;;; `bib.scm' file found in the `common' directory. The copyright notice for +;;; this file was: +;;; +;;; Copyright 2001, 2002, 2003, 2004 Manuel Serrano +;;; + + +;*---------------------------------------------------------------------*/ +;* bib-load! ... */ +;*---------------------------------------------------------------------*/ +(define (bib-load! table filename command) + (if (not (bib-table? table)) + (skribe-error 'bib-load "Illegal bibliography table" table) + ;; read the file + (let ((p (skribe-open-bib-file filename command))) + (if (not (input-port? p)) + (skribe-error 'bib-load "Can't open data base" filename) + (unwind-protect + (parse-bib table p) + (close-input-port p)))))) + +;*---------------------------------------------------------------------*/ +;* resolve-bib ... */ +;*---------------------------------------------------------------------*/ +(define (resolve-bib table ident) + (if (not (bib-table? table)) + (skribe-error 'resolve-bib "Illegal bibliography table" table) + (let* ((i (cond + ((string? ident) ident) + ((symbol? ident) (symbol->string ident)) + (else (skribe-error 'resolve-bib "Illegal ident" ident)))) + (en (hash-ref table i))) + (if (is-markup? en '&bib-entry) + en + #f)))) + +;*---------------------------------------------------------------------*/ +;* make-bib-entry ... */ +;*---------------------------------------------------------------------*/ +(define (make-bib-entry kind ident fields from) + (let* ((m (make <markup> + :markup '&bib-entry + :ident ident + :options `((kind ,kind) (from ,from)))) + (h (make <handle> :ast m))) + (for-each (lambda (f) + (if (and (pair? f) + (pair? (cdr f)) + (null? (cddr f)) + (symbol? (car f))) + (markup-option-add! m + (car f) + (make <markup> + :markup (symbol-append + '&bib-entry- + (car f)) + :parent h + :body (cadr f))) + (bib-parse-error f))) + fields) + m)) + +;*---------------------------------------------------------------------*/ +;* bib-sort/authors ... */ +;*---------------------------------------------------------------------*/ +(define (bib-sort/authors l) + (define (cmp i1 i2 def) + (cond + ((and (markup? i1) (markup? i2)) + (cmp (markup-body i1) (markup-body i2) def)) + ((markup? i1) + (cmp (markup-body i1) i2 def)) + ((markup? i2) + (cmp i1 (markup-body i2) def)) + ((and (string? i1) (string? i2)) + (if (string=? i1 i2) + (def) + (string<? i1 i2))) + ((string? i1) + #f) + ((string? i2) + #t) + (else + (def)))) + (sort l (lambda (e1 e2) + (cmp (markup-option e1 'author) + (markup-option e2 'author) + (lambda () + (cmp (markup-option e1 'year) + (markup-option e2 'year) + (lambda () + (cmp (markup-option e1 'title) + (markup-option e2 'title) + (lambda () + (cmp (markup-ident e1) + (markup-ident e2) + (lambda () + #t))))))))))) + +;*---------------------------------------------------------------------*/ +;* bib-sort/idents ... */ +;*---------------------------------------------------------------------*/ +(define (bib-sort/idents l) + (sort l (lambda (e f) (string<? (markup-ident e) (markup-ident f))))) + +;*---------------------------------------------------------------------*/ +;* bib-sort/dates ... */ +;*---------------------------------------------------------------------*/ +(define (bib-sort/dates l) + (sort l (lambda (p1 p2) + (define (month-num m) + (let ((body (markup-body m))) + (if (not (string? body)) + 13 + (let* ((s (if (> (string-length body) 3) + (substring body 0 3) + body)) + (sy (string->symbol (string-downcase body))) + (c (assq sy '((jan . 1) + (feb . 2) + (mar . 3) + (apr . 4) + (may . 5) + (jun . 6) + (jul . 7) + (aug . 8) + (sep . 9) + (oct . 10) + (nov . 11) + (dec . 12))))) + (if (pair? c) (cdr c) 13))))) + (let ((d1 (markup-option p1 'year)) + (d2 (markup-option p2 'year))) + (cond + ((not (markup? d1)) #f) + ((not (markup? d2)) #t) + (else + (let ((y1 (markup-body d1)) + (y2 (markup-body d2))) + (cond + ((string>? y1 y2) #t) + ((string<? y1 y2) #f) + (else + (let ((d1 (markup-option p1 'month)) + (d2 (markup-option p2 'month))) + (cond + ((not (markup? d1)) #f) + ((not (markup? d2)) #t) + (else + (let ((m1 (month-num d1)) + (m2 (month-num d2))) + (> m1 m2)))))))))))))) + +;*---------------------------------------------------------------------*/ +;* resolve-the-bib ... */ +;*---------------------------------------------------------------------*/ +(define (resolve-the-bib table n sort pred count opts) + (define (count! entries) + (let loop ((es entries) + (i 1)) + (if (pair? es) + (begin + (markup-option-add! (car es) + :title + (make <markup> + :markup '&bib-entry-ident + :parent (car es) + :options `((number ,i)) + :body (make <handle> :ast (car es)))) + (loop (cdr es) (+ i 1)))))) + (if (not (bib-table? table)) + (skribe-error 'resolve-the-bib "Illegal bibliography table" table) + (let* ((es (sort (hash-map->list (lambda (key val) val) table))) + (fes (filter (if (procedure? pred) + (lambda (m) (pred m n)) + (lambda (m) (pair? (markup-option m 'used)))) + es))) + (count! (if (eq? count 'full) es fes)) + (make <markup> + :markup '&the-bibliography + :options opts + :body fes)))) + + +;;; biblio.scm ends here diff --git a/src/guile/skribilo/biblio/Makefile.am b/src/guile/skribilo/biblio/Makefile.am new file mode 100644 index 0000000..9442562 --- /dev/null +++ b/src/guile/skribilo/biblio/Makefile.am @@ -0,0 +1,4 @@ +guilemoduledir = $(GUILE_SITE)/skribilo/biblio +dist_guilemodule_DATA = bibtex.scm author.scm abbrev.scm + +## arch-tag: aeffaead-c3f0-47f3-a0b3-bb3e22da2657 diff --git a/src/guile/skribilo/biblio/abbrev.scm b/src/guile/skribilo/biblio/abbrev.scm new file mode 100644 index 0000000..9c88b6a --- /dev/null +++ b/src/guile/skribilo/biblio/abbrev.scm @@ -0,0 +1,170 @@ +;;; abbrev.scm -- Determining abbreviations. +;;; +;;; Copyright 2006 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;; USA. + +(define-module (skribilo biblio abbrev) + :use-module (srfi srfi-13) + :autoload (skribilo ast) (markup? markup-body-set!) + :autoload (skribilo utils strings) (make-string-replace) + :autoload (ice-9 regex) (regexp-substitute/global) + :export (is-abbreviation? is-acronym? abbreviate-word + abbreviate-string abbreviate-markup + + %cs-conference-abbreviations + %ordinal-number-abbreviations + %common-booktitle-abbreviations)) + +;;; Author: Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; Heuristics to identify or generate abbreviations. This module +;;; particularly targets booktitle abbreviations (in bibliography entries). +;;; +;;; Code: + +(define (is-abbreviation? str) + ;; Return #t if STR denotes an abbreviation or name initial. + (and (>= (string-length str) 2) + (char=? (string-ref str 1) #\.))) + +(define (is-acronym? str) + (string=? str (string-upcase str))) + +(define (abbreviate-word word) + (if (or (string=? "" word) + (and (>= (string-length word) 3) + (string=? "and" (substring word 0 3))) + (is-acronym? word)) + word + (let ((dash (string-index word #\-)) + (abbr (string (string-ref word 0) #\.))) + (if (not dash) + abbr + (string-append (string (string-ref word 0)) "-" + (abbreviate-word + (substring word (+ 1 dash) + (string-length word)))))))) + +(define (abbreviate-string subst title) + ;; Abbreviate common conference names within TITLE based on the SUBST list + ;; of regexp-substitution pairs (see examples below). This function also + ;; removes the abbreviation if it appears in parentheses right after the + ;; substitution regexp. Example: + ;; + ;; "Symposium on Operating Systems Principles (SOSP 2004)" + ;; + ;; yields + ;; + ;; "SOSP" + ;; + (let loop ((title title) + (subst subst)) + (if (null? subst) + title + (let* ((abbr (cdar subst)) + (abbr-rexp (string-append "( \\(" abbr "[^\\)]*\\))?")) + (to-replace (string-append (caar subst) abbr-rexp))) + (loop (regexp-substitute/global #f to-replace title + 'pre abbr 'post) + (cdr subst)))))) + +(define (abbreviate-markup subst markup) + ;; A version of `abbreviate-string' generalized to arbitrary markup + ;; objects. + (let loop ((markup markup)) + (cond ((string? markup) + (let ((purify (make-string-replace '((#\newline " ") + (#\tab " "))))) + (abbreviate-string subst (purify markup)))) + ((list? markup) + (map loop markup)) + ((markup? markup) + (markup-body-set! markup (loop (markup-body title))) + markup) + (else markup)))) + + +;;; +;;; Common English abbreviations. +;;; + +;; The following abbreviation alists may be passed to `abbreviate-string' +;; and `abbreviate-markup'. + +(define %cs-conference-abbreviations + ;; Common computer science conferences and their acronym. + '(("(Symposium [oO]n )?Operating Systems? Design and [iI]mplementation" + . "OSDI") + ("(Symposium [oO]n )?Operating Systems? Principles" + . "SOSP") + ("([wW]orkshop [oO]n )?Hot Topics [iI]n Operating Systems" + . "HotOS") + ("([cC]onference [oO]n )?[fF]ile [aA]nd [sS]torage [tT]echnologies" + . "FAST") + ("([tT]he )?([iI]nternational )?[cC]onference [oO]n [aA]rchitectural Support [fF]or Programming Languages [aA]nd Operating Systems" + . "ASPLOS") + ("([tT]he )?([iI]nternational )?[cC]onference [oO]n Peer-[tT]o-[pP]eer Computing" + . "P2P") + ("([iI]nternational )?[cC]onference [oO]n [dD]ata [eE]ngineering" + . "ICDE") + ("([cC]onference [oO]n )?[mM]ass [sS]torage [sS]ystems( [aA]nd [tT]echnologies)?" + . "MSS") + ("([sS]ymposium [oO]n )?[nN]etworked [sS]ystems [dD]esign [aA]nd [Ii]mplementation" + . "NSDI"))) + + +(define %ordinal-number-abbreviations + ;; The poor man's abbreviation system. + + ;; FIXME: Given the current `abbreviate-string', there is no clean way to + ;; make it ignore things like "twenty-first" (instead of yielding an awful + ;; "twenty-1st"). + '(("[Ff]irst" . "1st") + ("[sS]econd" . "2nd") + ("[Tt]hird" . "3rd") + ("[Ff]ourth" . "4th") + ("[Ff]ifth" . "5th") + ("[Ss]ixth" . "6th") + ("[Ss]eventh" . "7th") + ("[eE]ighth" . "8th") + ("[Nn]inth" . "9th") + ("[Tt]enth" . "10th") + ("[Ee]leventh" . "11th") + ("[Tt]welfth" . "12th") + ("[Tt]hirteenth" . "13th") + ("[Ff]ourteenth" . "14th") + ("[Ff]ifteenth" . "15th") + ("[Ss]ixteenth" . "16th") + ("[Ss]eventeenth" . "17th") + ("[Ee]ighteenth" . "18th") + ("[Nn]ineteenth" . "19th"))) + +(define %common-booktitle-abbreviations + ;; Common book title abbreviations. This is used by + ;; `abbreviate-booktitle'. + '(("[pP]roceedings?" . "Proc.") + ("[iI]nternational" . "Int.") + ("[sS]ymposium" . "Symp.") + ("[cC]onference" . "Conf."))) + + +;;; arch-tag: 34e0c5bb-592f-467b-b59a-d6f7d130ae4e + +;;; abbrev.scm ends here diff --git a/src/guile/skribilo/biblio/author.scm b/src/guile/skribilo/biblio/author.scm new file mode 100644 index 0000000..ea15f4c --- /dev/null +++ b/src/guile/skribilo/biblio/author.scm @@ -0,0 +1,136 @@ +;;; author.scm -- Handling author names. +;;; +;;; Copyright 2006 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;; USA. + +(define-module (skribilo biblio author) + :use-module (srfi srfi-13) + :use-module (srfi srfi-14) + :use-module (skribilo biblio abbrev) + :autoload (skribilo ast) (markup-option markup-body markup-ident) + :autoload (skribilo lib) (skribe-error) + :autoload (skribilo utils strings) (make-string-replace) + :export (comma-separated->author-list + comma-separated->and-separated-authors + + extract-first-author-name + abbreviate-author-first-names + abbreviate-first-names + first-author-last-name + + bib-sort/first-author-last-name)) + +;;; Author: Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; Heuristics to manipulate author names as strings. +;;; +;;; Code: + +(define (comma-separated->author-list authors) + ;; Return a list of strings where each individual string is an author + ;; name. AUTHORS is a string representing a list of author names separated + ;; by a comma. + + ;; XXX: I should use SRFI-13 instead. + (string-split authors #\,)) + +(define (comma-separated->and-separated-authors authors) + ;; Take AUTHORS, a string containing comma-separated author names, and + ;; return a string where author names are separated by " and " (suitable + ;; for BibTeX). + (string-join (comma-separated->author-list authors) + " and " 'infix)) + + +(define (extract-first-author-name names) + ;; Extract the name of the first author from string + ;; NAMES that is a comma-separated list of authors. + (let ((author-name-end (or (string-index names #\,) + (string-length names)))) + (substring names 0 author-name-end))) + +(define (abbreviate-author-first-names name) + ;; Abbreviate author first names + (let* ((components (string-split name #\space)) + (component-number (length components))) + (apply string-append + (append + (map (lambda (c) + (string-append (abbreviate-word c) " ")) + (list-head components + (- component-number 1))) + (list-tail components (- component-number 1)))))) + +(define (abbreviate-first-names names) + ;; Abbreviate first names in NAMES. NAMES is supposed to be + ;; something like "Ludovic Courtès, Marc-Olivier Killijian". + (let loop ((names ((make-string-replace '((#\newline " ") + (#\tab " "))) + names)) + (result "")) + (if (string=? names "") + result + (let* ((len (string-length names)) + (first-author-names-end (or (string-index names #\,) + len)) + (first-author-names (substring names 0 + first-author-names-end)) + (next (substring names + (min (+ 1 first-author-names-end) len) + len))) + (loop next + (string-append result + (if (string=? "" result) "" ", ") + (abbreviate-author-first-names + first-author-names))))))) + + +(define (first-author-last-name authors) + ;; Return a string containing exactly the last name of the first author. + ;; Author names in AUTHORS are assumed to be comma separated. + (let loop ((first-author (extract-first-author-name authors))) + (let ((space (string-index first-author #\space))) + (if (not space) + first-author + (loop (substring first-author (+ space 1) + (string-length first-author))))))) + +(define (bib-sort/first-author-last-name entries) + ;; May be passed as the `:sort' argument of `the-bibliography'. + (let ((check-author (lambda (e) + (if (not (markup-option e 'author)) + (skribe-error 'web + "No author for this bib entry" + (markup-ident e)) + #t)))) + (sort entries + (lambda (e1 e2) + (let* ((x1 (check-author e1)) + (x2 (check-author e2)) + (a1 (first-author-last-name + (markup-body (markup-option e1 'author)))) + (a2 (first-author-last-name + (markup-body (markup-option e2 'author))))) + (string-ci<=? a1 a2)))))) + + +;;; arch-tag: c9a1ef10-a2cd-4a06-bd35-fbdee1abf09a + +;;; author.scm ends here diff --git a/src/guile/skribilo/biblio/bibtex.scm b/src/guile/skribilo/biblio/bibtex.scm new file mode 100644 index 0000000..319df1d --- /dev/null +++ b/src/guile/skribilo/biblio/bibtex.scm @@ -0,0 +1,83 @@ +;;; bibtex.scm -- Handling BibTeX references. +;;; +;;; Copyright 2006 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;; USA. + + +(define-module (skribilo biblio bibtex) + :autoload (skribilo utils strings) (make-string-replace) + :autoload (skribilo ast) (markup-option ast->string) + :autoload (skribilo engine) (engine-filter find-engine) + :use-module (skribilo biblio author) + :use-module (srfi srfi-39) + :export (print-as-bibtex-entry)) + +;;; Author: Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; A set of BibTeX tools, e.g., issuing a BibTeX entry from a `&bib-entry' +;;; markup object. +;;; +;;; Code: + +(define *bibtex-author-filter* + ;; Defines how the `author' field is to be filtered. + (make-parameter comma-separated->and-separated-authors)) + +(define (print-as-bibtex-entry entry) + "Display @code{&bib-entry} object @var{entry} as a BibTeX entry." + (let ((show-option (lambda (opt) + (let* ((o (markup-option entry opt)) + (f (make-string-replace '((#\newline " ")))) + (g (if (eq? opt 'author) + (lambda (a) + ((*bibtex-author-filter*) (f a))) + f))) + (if (not o) + #f + `(,(symbol->string opt) + " = \"" + ,(g (ast->string (markup-body o))) + "\",")))))) + (format #t "@~a{~a,~%" + (markup-option entry 'kind) + (markup-ident entry)) + (for-each (lambda (opt) + (let* ((o (show-option opt)) + (tex-filter (engine-filter + (find-engine 'latex))) + (filter (lambda (n) + (tex-filter (ast->string n)))) + (id (lambda (a) a))) + (if o + (display + (apply string-append + `(,@(map (if (eq? 'url opt) + id filter) + (cons " " o)) + "\n")))))) + '(author institution title + booktitle journal number + year month url pages address publisher)) + (display "}\n"))) + + +;;; arch-tag: 8b5913cc-9077-4e92-839e-c4c633b7bd46 + +;;; bibtex.scm ends here diff --git a/src/guile/skribilo/color.scm b/src/guile/skribilo/color.scm index d2ba1d4..8b6205f 100644 --- a/src/guile/skribilo/color.scm +++ b/src/guile/skribilo/color.scm @@ -16,7 +16,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. diff --git a/src/guile/skribilo/coloring/c-lex.l b/src/guile/skribilo/coloring/c-lex.l index a5b337e..7d7b1ce 100644 --- a/src/guile/skribilo/coloring/c-lex.l +++ b/src/guile/skribilo/coloring/c-lex.l @@ -16,7 +16,7 @@ ;;;; ;;;; 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, +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;;; USA. ;;;; ;;;; Author: Erick Gallesio [eg@essi.fr] diff --git a/src/guile/skribilo/coloring/c-lex.l.scm b/src/guile/skribilo/coloring/c-lex.l.scm index c9129cf..d78e09e 100644 --- a/src/guile/skribilo/coloring/c-lex.l.scm +++ b/src/guile/skribilo/coloring/c-lex.l.scm @@ -14,7 +14,7 @@ ; ; 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. +; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ; ; Gestion des Input Systems diff --git a/src/guile/skribilo/coloring/c.scm b/src/guile/skribilo/coloring/c.scm index baa3e53..d2a2b9f 100644 --- a/src/guile/skribilo/coloring/c.scm +++ b/src/guile/skribilo/coloring/c.scm @@ -16,7 +16,7 @@ ;;;; ;;;; 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, +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;;; USA. ;;;; ;;;; Author: Erick Gallesio [eg@essi.fr] diff --git a/src/guile/skribilo/coloring/lisp-lex.l b/src/guile/skribilo/coloring/lisp-lex.l index c4db526..30b6a44 100644 --- a/src/guile/skribilo/coloring/lisp-lex.l +++ b/src/guile/skribilo/coloring/lisp-lex.l @@ -16,7 +16,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. diff --git a/src/guile/skribilo/coloring/lisp-lex.l.scm b/src/guile/skribilo/coloring/lisp-lex.l.scm index b5db4e8..6ae7fe6 100644 --- a/src/guile/skribilo/coloring/lisp-lex.l.scm +++ b/src/guile/skribilo/coloring/lisp-lex.l.scm @@ -14,7 +14,7 @@ ; ; 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. +; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ; ; Gestion des Input Systems diff --git a/src/guile/skribilo/coloring/lisp.scm b/src/guile/skribilo/coloring/lisp.scm index e3458b1..13bb6db 100644 --- a/src/guile/skribilo/coloring/lisp.scm +++ b/src/guile/skribilo/coloring/lisp.scm @@ -16,7 +16,7 @@ ;;;; ;;;; 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, +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;;; USA. @@ -24,7 +24,7 @@ :use-module (skribilo utils syntax) :use-module (skribilo source) :use-module (skribilo lib) - :use-module (skribilo runtime) + :use-module (skribilo utils strings) :use-module (srfi srfi-39) :use-module (ice-9 match) :autoload (ice-9 regex) (make-regexp) diff --git a/src/guile/skribilo/coloring/xml-lex.l b/src/guile/skribilo/coloring/xml-lex.l index 5d9a8d9..aa7d312 100644 --- a/src/guile/skribilo/coloring/xml-lex.l +++ b/src/guile/skribilo/coloring/xml-lex.l @@ -17,7 +17,7 @@ ;;;; ;;;; 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, +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;;; USA. ;;;; ;;;; Author: Erick Gallesio [eg@essi.fr] diff --git a/src/guile/skribilo/coloring/xml-lex.l.scm b/src/guile/skribilo/coloring/xml-lex.l.scm index 0e3fe05..d58e42b 100644 --- a/src/guile/skribilo/coloring/xml-lex.l.scm +++ b/src/guile/skribilo/coloring/xml-lex.l.scm @@ -14,7 +14,7 @@ ; ; 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. +; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ; ; Gestion des Input Systems diff --git a/src/guile/skribilo/condition.scm b/src/guile/skribilo/condition.scm index 820dcc5..4d61efb 100644 --- a/src/guile/skribilo/condition.scm +++ b/src/guile/skribilo/condition.scm @@ -15,20 +15,26 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo condition) + :autoload (srfi srfi-1) (find) :autoload (srfi srfi-34) (guard) :use-module (srfi srfi-35) :use-module (srfi srfi-39) :export (&skribilo-error skribilo-error? &invalid-argument-error invalid-argument-error? + &too-few-arguments-error too-few-arguments-error? + &file-error file-error? &file-search-error file-search-error? &file-open-error file-open-error? &file-write-error file-write-error? + register-error-condition-handler! + lookup-error-condition-handler + %call-with-skribilo-error-catch call-with-skribilo-error-catch)) @@ -58,6 +64,11 @@ (proc-name invalid-argument-error:proc-name) (argument invalid-argument-error:argument)) +(define-condition-type &too-few-arguments-error &skribilo-error + too-few-arguments-error? + (proc-name too-few-arguments-error:proc-name) + (arguments too-few-arguments-error:arguments)) + ;;; ;;; File errors. @@ -80,6 +91,28 @@ ;;; +;;; Adding new error conditions from other modules. +;;; + +(define %external-error-condition-alist '()) + +(define (register-error-condition-handler! pred handler) + (set! %external-error-condition-alist + (cons (cons pred handler) + %external-error-condition-alist))) + +(define (lookup-error-condition-handler c) + (let ((pair (find (lambda (pair) + (let ((pred (car pair))) + (pred c))) + %external-error-condition-alist))) + (if (pair? pair) + (cdr pair) + #f))) + + + +;;; ;;; Convenience functions. ;;; @@ -90,6 +123,11 @@ (invalid-argument-error:argument c)) (exit exit-val)) + ((too-few-arguments-error? c) + (format (current-error-port) "in `~a': too few arguments: ~S~%" + (too-few-arguments-error:proc-name c) + (too-few-arguments-error:arguments c))) + ((file-search-error? c) (format (current-error-port) "~a: not found in path `~S'~%" (file-error:file-name c) @@ -111,9 +149,15 @@ (file-error:file-name c)) (exit exit-val)) - ((skribilo-error? c) - (format (current-error-port) "undefined skribilo error: ~S~%" - c) + (;;(skribilo-error? c) + #t ;; XXX: The SRFI-35 currently in `guile-lib' doesn't work + ;; properly with non-direct super-types. + (let ((handler (lookup-error-condition-handler c))) + (if (procedure? handler) + (handler c) + (format (current-error-port) + "undefined skribilo error: ~S~%" + c))) (exit exit-val))) (thunk))) diff --git a/src/guile/skribilo/debug.scm b/src/guile/skribilo/debug.scm index 1481a56..f7709a0 100644 --- a/src/guile/skribilo/debug.scm +++ b/src/guile/skribilo/debug.scm @@ -15,14 +15,15 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo debug) :use-module (skribilo utils syntax) :use-module (srfi srfi-17) - :use-module (srfi srfi-39)) + :use-module (srfi srfi-39) + :export-syntax (debug-item with-debug)) (fluid-set! current-reader %skribilo-module-reader) @@ -102,14 +103,15 @@ ;;; ;;; debug-item ;;; -(define-public (debug-item . args) - (if (or (>= (*debug*) (*margin-level*)) - (*debug-item?*)) - (begin - (display (*debug-margin*) (*debug-port*)) - (display (debug-color (- (*debug-depth*) 1) "- ") (*debug-port*)) - (for-each (lambda (a) (display a (*debug-port*))) args) - (newline (*debug-port*))))) +(define-macro (debug-item . args) + `(if (*debug-item?*) (%do-debug-item ,@args))) + +(define-public (%do-debug-item . args) + (begin + (display (*debug-margin*) (*debug-port*)) + (display (debug-color (- (*debug-depth*) 1) "- ") (*debug-port*)) + (for-each (lambda (a) (display a (*debug-port*))) args) + (newline (*debug-port*)))) ;;(define-macro (debug-item . args) ;; `()) @@ -125,30 +127,29 @@ ;;; ;;; %with-debug -;; -(define-public (%with-debug lvl lbl thunk) - (parameterize ((*margin-level* lvl)) - (if (or (and (number? lvl) (>= (*debug*) lvl)) - (and (symbol? lbl) - (memq lbl (*watched-symbols*)))) - (parameterize ((*debug-item?* #t)) - (display (*debug-margin*) (*debug-port*)) - (display (if (= (*debug-depth*) 0) - (debug-color (*debug-depth*) "+ " lbl) - (debug-color (*debug-depth*) "--+ " lbl)) - (*debug-port*)) - (newline (*debug-port*)) - (%with-debug-margin (debug-color (*debug-depth*) " |") - thunk)) - (thunk)))) - -(define-macro (with-debug level label . body) - `(%with-debug ,level ,label (lambda () ,@body))) - -;;(define-macro (with-debug level label . body) -;; `(begin ,@body)) - -(export with-debug) +;;; +(define-public (%do-with-debug lvl lbl thunk) + (parameterize ((*margin-level* lvl) + (*debug-item?* #t)) + (display (*debug-margin*) (*debug-port*)) + (display (if (= (*debug-depth*) 0) + (debug-color (*debug-depth*) "+ " lbl) + (debug-color (*debug-depth*) "--+ " lbl)) + (*debug-port*)) + (newline (*debug-port*)) + (%with-debug-margin (debug-color (*debug-depth*) " |") + thunk))) + +(define-macro (with-debug level label . body) + ;; We have this as a macro in order to avoid procedure calls in the + ;; non-debugging case. Unfortunately, the macro below duplicates BODY, + ;; which has a negative impact on memory usage and startup time (XXX). + (if (number? level) + `(if (or (>= (*debug*) ,level) + (memq ,label (*watched-symbols*))) + (%do-with-debug ,level ,label (lambda () ,@body)) + (begin ,@body)) + (error "with-debug: syntax error"))) ; Example: diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm index 3e05571..06667ad 100644 --- a/src/guile/skribilo/engine.scm +++ b/src/guile/skribilo/engine.scm @@ -16,7 +16,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo engine) @@ -38,7 +38,7 @@ *current-engine* default-engine default-engine-set! make-engine copy-engine find-engine lookup-engine - engine-custom engine-custom-set! + engine-custom engine-custom-set! engine-custom-add! engine-format? engine-add-writer! processor-get-engine push-default-engine pop-default-engine @@ -302,6 +302,11 @@ otherwise the requested engine is returned." (set-car! (cdr c) val) (slot-set! e 'customs (cons (list id val) customs))))) +(define (engine-custom-add! e id val) + (let ((old (engine-custom e id))) + (if (unspecified? old) + (engine-custom-set! e id (list val)) + (engine-custom-set! e id (cons val old))))) (define (engine-add-writer! e ident pred upred opt before action after class valid) @@ -369,7 +374,7 @@ otherwise the requested engine is returned." (use-modules (skribilo module)) ;; At this point, we're almost done with the bootstrap process. -(format #t "base engine: ~a~%" (lookup-engine 'base)) +;(format #t "base engine: ~a~%" (lookup-engine 'base)) (define *current-engine* ;; By default, use the HTML engine. diff --git a/src/guile/skribilo/engine/context.scm b/src/guile/skribilo/engine/context.scm index a79e88a..c9e0986 100644 --- a/src/guile/skribilo/engine/context.scm +++ b/src/guile/skribilo/engine/context.scm @@ -16,7 +16,7 @@ ;;;; ;;;; 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, +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;;; USA. ;;;; ;;;; Author: Erick Gallesio [eg@essi.fr] diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm index 4ba058a..c290189 100644 --- a/src/guile/skribilo/engine/html.scm +++ b/src/guile/skribilo/engine/html.scm @@ -115,7 +115,7 @@ ;; emit-sui (emit-sui #f) ;; the body - (background "#ffffff") + (background #f) (foreground #f) ;; the margins (margin-padding 3) @@ -124,42 +124,42 @@ (section-left-margin #f) (left-margin-font #f) (left-margin-size 17.) - (left-margin-background "#dedeff") + (left-margin-background #f) (left-margin-foreground #f) (right-margin #f) (chapter-right-margin #f) (section-right-margin #f) (right-margin-font #f) (right-margin-size 17.) - (right-margin-background "#dedeff") + (right-margin-background #f) (right-margin-foreground #f) ;; author configuration (author-font #f) ;; title configuration (title-font #f) - (title-background "#8381de") + (title-background #f) (title-foreground #f) (file-title-separator " -- ") ;; html file naming (file-name-proc ,html-file-default) ;; index configuration - (index-header-font-size +2.) + (index-header-font-size #f) ;; +2. ;; chapter configuration (chapter-number->string number->string) (chapter-file #f) ;; section configuration (section-title-start "<h3>") (section-title-stop "</h3>") - (section-title-background "#dedeff") - (section-title-foreground "black") + (section-title-background #f) + (section-title-foreground #f) (section-title-number-separator " ") (section-number->string number->string) (section-file #f) ;; subsection configuration (subsection-title-start "<h3>") (subsection-title-stop "</h3>") - (subsection-title-background "#ffffff") - (subsection-title-foreground "#8381de") + (subsection-title-background #f) + (subsection-title-foreground #f) (subsection-title-number-separator " ") (subsection-number->string number->string) (subsection-file #f) @@ -167,7 +167,7 @@ (subsubsection-title-start "<h4>") (subsubsection-title-stop "</h4>") (subsubsection-title-background #f) - (subsubsection-title-foreground "#8381de") + (subsubsection-title-foreground #f) (subsubsection-title-number-separator " ") (subsubsection-number->string number->string) (subsubsection-file #f) @@ -572,7 +572,7 @@ ;* document ... */ ;*---------------------------------------------------------------------*/ (markup-writer 'document - :options '(:title :author :ending :html-title :env) + :options '(:title :author :ending :html-title :env :keywords) :action (lambda (n e) (let* ((id (markup-ident n)) (title (new markup @@ -601,13 +601,23 @@ ;*---------------------------------------------------------------------*/ (markup-writer '&html-head :before (lambda (n e) - (printf "<head>\n") - (printf "<meta http-equiv=\"Content-Type\" content=\"text/html;") - (printf "charset=~A\">\n" (engine-custom (find-engine 'html) - 'charset))) + (printf "<head>\n") + (printf "<meta http-equiv=\"Content-Type\" content=\"text/html;") + (printf "charset=~A\">\n" (engine-custom (find-engine 'html) + 'charset))) :after "</head>\n\n") ;*---------------------------------------------------------------------*/ +;* &html-meta ... */ +;*---------------------------------------------------------------------*/ +(markup-writer '&html-meta + :before "<meta name=\"keywords\" content=\"" + :action (lambda (n e) + (let ((kw* (map ast->string (or (markup-body n) '())))) + (output (keyword-list->comma-separated kw*) e))) + :after "\">\n") + +;*---------------------------------------------------------------------*/ ;* &html-body ... */ ;*---------------------------------------------------------------------*/ (markup-writer '&html-body @@ -867,7 +877,10 @@ (when title (display "<table width=\"100%\" class=\"skribetitle\" cellspacing=\"0\" cellpadding=\"0\"><tbody>\n<tr>") (if (html-color-spec? tbg) - (printf "<td align=\"center\" bgcolor=\"~a\">" tbg) + (printf "<td align=\"center\"~A>" + (if (html-color-spec? tbg) + (string-append "bgcolor=\"" tbg "\"") + "")) (display "<td align=\"center\">")) (if (string? tfg) (printf "<font color=\"~a\">" tfg)) @@ -1058,13 +1071,9 @@ (display "</td></tr>")) ;; name (printf "<tr><td align=\"~a\">" align) - (if nfn - (printf "<font ~a>\n" nfn) - (display "<font size=\"+2\"><i>\n")) + (if nfn (printf "<font ~a>\n" nfn)) (output name e) - (if nfn - (printf "</font>\n") - (display "</i></font>\n")) + (if nfn (printf "</font>\n")) (display "</td></tr>") ;; title (if title (row title)) @@ -1190,12 +1199,18 @@ (class (markup-class n)) (parent n) (body (html-browser-title n)))) + (meta (new markup + (markup '&html-meta) + (ident (string-append id "-meta")) + (class (markup-class n)) + (parent n) + (body (markup-option n :keywords)))) (head (new markup (markup '&html-head) (ident (string-append id "-head")) (class (markup-class n)) (parent n) - (body header))) + (body (list header meta)))) (ftnote (new markup (markup '&html-footnotes) (ident (string-append id "-footnote")) diff --git a/src/guile/skribilo/engine/html4.scm b/src/guile/skribilo/engine/html4.scm index ddc7c73..48550ef 100644 --- a/src/guile/skribilo/engine/html4.scm +++ b/src/guile/skribilo/engine/html4.scm @@ -16,7 +16,7 @@ ;;;; ;;;; 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, +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;;; USA. ;;;; ;;;; Author: Erick Gallesio [eg@essi.fr] diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm index 8727df8..893ab2e 100644 --- a/src/guile/skribilo/engine/lout.scm +++ b/src/guile/skribilo/engine/lout.scm @@ -15,7 +15,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. ;;; Taken from `lcourtes@laas.fr--2004-libre', @@ -642,7 +642,8 @@ (pdf-author #t) ;; Keywords (a list of string) in the PDF - ;; document information. + ;; document information. This custom is deprecated, + ;; use the `:keywords' option of `document' instead. (pdf-keywords #f) ;; Extra PDF information, an alist of key-value @@ -812,15 +813,11 @@ (if (or (string? t) (ast? t)) t (markup-option doc :title)))) - (keywords (engine-custom engine 'pdf-keywords)) - (extra-fields (engine-custom engine 'pdf-extra-info)) - (stringify-kw (lambda (kws) - (let loop ((kws kws) (s "")) - (if (null? kws) s - (loop (cdr kws) - (string-append s (car kws) - (if (pair? (cdr kws)) - ", " "")))))))) + (keywords (or (engine-custom engine 'pdf-keywords) + (map ast->string + (or (markup-option doc :keywords) '())))) + (extra-fields (engine-custom engine 'pdf-extra-info))) + (string-append "[ " (if title (docinfo-field "Title" (ast->string title)) @@ -837,13 +834,11 @@ (else (ast->string author))) "")) "") - (if keywords + (if (pair? keywords) (docinfo-field "Keywords" - (cond ((string? keywords) - keywords) - ((pair? keywords) - (stringify-kw keywords)) - (else ""))) + (apply string-append + (keyword-list->comma-separated + keywords))) "") ;; arbitrary key-value pairs, see sect. 4.7, "Info ;; dictionary" of the `pdfmark' reference. @@ -926,7 +921,7 @@ (if (< size 0) "0.3f" "1.5f") "1.0f")))) -(define (lout-color-specification skribe-color) +(define-public (lout-color-specification skribe-color) ;; Return a Lout color name, ie. a string which is either an English color ;; name or something like "rgb 0.5 0.2 0.6". `skribe-color' is a string ;; representing a Skribe color such as "black" or "#ffffff". @@ -975,7 +970,7 @@ ;* document ... */ ;*---------------------------------------------------------------------*/ (markup-writer 'document - :options '(:title :author :ending :env) + :options '(:title :author :ending :keywords :env) :before (lambda (n e) ;; `e' is the engine (let* ((doc-type (let ((d (engine-custom e 'document-type))) (if (string? d) @@ -1136,7 +1131,7 @@ (lout-make-doc-cover-sheet n e)))) (if doc-style? - ;; Putting it here will only works with `doc' documents. + ;; Putting it here will only work with `doc' documents. (lout-output-pdf-meta-info n e)))) :after (lambda (n e) @@ -1363,21 +1358,6 @@ (printf "\n\n@End @~a\n\n" lout-markup)))) -(define (markup-option-set! m opt val) - ;; Sets the value of markup option `opt' of markup `m' to `val'. - (let ((o (assoc opt (markup-options m)))) - (if o - (begin -; (set-cdr! o val) - (markup-option-add! m opt val) ;; FIXME: the above method fails - (if (not (eq? (markup-option m opt) val)) - (skribe-error 'markup-option-set! - "Doesn't work!" (markup-option m opt)))) - (begin - (lout-debug "markup-option-set!: markup ~a doesn't have option ~a" - m opt) - #f)))) - (define (lout-markup-child-type skribe-markup) ;; Return the child markup type of `skribe-markup' (e.g. for `chapter', ;; return `section'). @@ -1413,8 +1393,15 @@ ;; first section while other styles don't. (printf "\n@Begin~as\n" lout-markup-name)) - ;; update the `&substructs-started?' option of the parent - (markup-option-set! parent '&substructs-started? #t) + ;; FIXME: We need to make sure that PARENT is a large-scale + ;; structure, otherwise it won't have the `&substructs-started?' + ;; option (e.g., if PARENT is a `color' markup). I need to clarify + ;; this. + (if (memq (markup-markup parent) + '(document chapter section subsection subsubsection)) + ;; update the `&substructs-started?' option of the parent + (markup-option-set! parent '&substructs-started? #t)) + (lout-debug "start-struct: updated parent: ~a" (markup-option parent '&substructs-started?)))) diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm index b47f821..abee2fd 100644 --- a/src/guile/skribilo/evaluator.scm +++ b/src/guile/skribilo/evaluator.scm @@ -16,7 +16,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. @@ -26,7 +26,8 @@ :autoload (skribilo parameters) (*verbose* *document-path*) :autoload (skribilo location) (<location>) :autoload (skribilo ast) (ast? markup?) - :autoload (skribilo engine) (engine? find-engine engine-ident) + :autoload (skribilo engine) (*current-engine* + engine? find-engine engine-ident) :autoload (skribilo reader) (*document-reader*) :autoload (skribilo verify) (verify) @@ -56,8 +57,8 @@ ;;; (define (%evaluate expr) ;; Evaluate EXPR, an arbitrary S-expression that may contain calls to the - ;; markup functions defined in `(skribilo skribe api)', e.g., `(bold - ;; "hello")'. + ;; markup functions defined in a markup package such as + ;; `(skribilo package base)', e.g., `(bold "hello")'. (let ((result (eval expr (current-module)))) (if (ast? result) diff --git a/src/guile/skribilo/skribe/index.scm b/src/guile/skribilo/index.scm index 415cadf..33f8d15 100644 --- a/src/guile/skribilo/skribe/index.scm +++ b/src/guile/skribilo/index.scm @@ -1,7 +1,7 @@ ;;; index.scm ;;; ;;; Copyright 2003, 2004 Manuel Serrano -;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -16,52 +16,70 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo skribe index)) +(define-module (skribilo index) + :use-syntax (skribilo utils syntax) + :use-syntax (skribilo lib) + + :use-module (skribilo lib) + :use-module (skribilo ast) + :use-module (srfi srfi-39) + + ;; XXX: The use of `mark' here introduces a cross-dependency between + ;; `index' and `package base'. Thus, we require that each of these two + ;; modules autoloads the other one. + :autoload (skribilo package base) (mark) + + :export (index? make-index-table *index-table* + default-index resolve-the-index)) + + +(fluid-set! current-reader %skribilo-module-reader) ;;; Author: Manuel Serrano ;;; Commentary: ;;; -;;; A library of index-related functions. +;;; A library of functions dealing with the creation of indices in +;;; documents. ;;; ;;; Code: -;;; The contents of the file below are unchanged compared to Skribe 1.2d's -;;; `index.scm' file found in the `common' directory. +;;; The contents of the file below are (almost) unchanged compared to Skribe +;;; 1.2d's `index.scm' file found in the `common' directory. ;*---------------------------------------------------------------------*/ ;* index? ... */ ;*---------------------------------------------------------------------*/ -(define-public (index? obj) - (hashtable? obj)) +(define (index? obj) + (hash-table? obj)) ;*---------------------------------------------------------------------*/ ;* *index-table* ... */ ;*---------------------------------------------------------------------*/ -(define-public *index-table* #f) +(define *index-table* (make-parameter #f)) ;*---------------------------------------------------------------------*/ ;* make-index-table ... */ ;*---------------------------------------------------------------------*/ -(define-public (make-index-table ident) - (make-hashtable)) +(define (make-index-table ident) + (make-hash-table)) ;*---------------------------------------------------------------------*/ ;* default-index ... */ ;*---------------------------------------------------------------------*/ -(define-public (default-index) - (if (not *index-table*) - (set! *index-table* (make-index-table "default-index"))) - *index-table*) +(define (default-index) + (if (not (*index-table*)) + (*index-table* (make-index-table "default-index"))) + (*index-table*)) ;*---------------------------------------------------------------------*/ ;* resolve-the-index ... */ ;*---------------------------------------------------------------------*/ -(define-public (resolve-the-index loc i c indexes split char-offset header-limit col) +(define (resolve-the-index loc i c indexes split char-offset header-limit col) ;; fetch the descriminating index name letter (define (index-ref n) (let ((name (markup-option n 'name))) @@ -101,7 +119,10 @@ (else (loop (cdr buckets) (cons (car buckets) res))))))) - (let* ((entries (apply append (map hashtable->list indexes))) + (let* ((entries (apply append (map (lambda (t) + (hash-map->list + (lambda (key val) val) t)) + indexes))) (sorted (map sort-entries-bucket (merge-buckets (sort entries diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm index f08a36e..21b2a4d 100644 --- a/src/guile/skribilo/lib.scm +++ b/src/guile/skribilo/lib.scm @@ -17,7 +17,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo lib) @@ -27,7 +27,7 @@ skribe-warning skribe-warning/ast skribe-message - %procedure-arity) + type-name %procedure-arity) :export-syntax (new define-markup define-simple-markup define-simple-container define-processor-markup) @@ -146,6 +146,21 @@ (options (the-options opts))))) + +;;; +;;; TYPE-NAME +;;; +(define (type-name obj) + (cond ((string? obj) "string") + ((ast? obj) "ast") + ((list? obj) "list") + ((pair? obj) "pair") + ((number? obj) "number") + ((char? obj) "character") + ((keyword? obj) "keyword") + (else (with-output-to-string + (lambda () (write obj)))))) + ;;; ;;; SKRIBE-EVAL-LOCATION ... ;;; @@ -215,38 +230,9 @@ (apply format (current-error-port) fmt obj))) - ;;; -;;; KEY-GET -;;; -;;; We need to redefine the standard key-get to be more permissive. In -;;; STklos key-get accepts a list which is formed only of keywords. In -;;; Skribe, parameter lists are of the form -;;; (:title "..." :option "...." body1 body2 body3) -;;; So is we find an element which is not a keyword, we skip it (unless it -;;; follows a keyword of course). Since the compiler of extended lambda -;;; uses the function key-get, it will now accept Skribe markups -(define* (key-get lst key #:optional (default #f) default?) - (define (not-found) - (if default? - default - (error 'key-get "value ~S not found in list ~S" key lst))) - (let Loop ((l lst)) - (cond - ((null? l) - (not-found)) - ((not (pair? l)) - (error 'key-get "bad list ~S" lst)) - ((keyword? (car l)) - (if (null? (cdr l)) - (error 'key-get "bad keyword list ~S" lst) - (if (eq? (car l) key) - (cadr l) - (Loop (cddr l))))) - (else - (Loop (cdr l)))))) - - +;;; %PROCEDURE-ARITY +;;; (define (%procedure-arity proc) (car (procedure-property proc 'arity))) diff --git a/src/guile/skribilo/location.scm b/src/guile/skribilo/location.scm index c663605..7c870fa 100644 --- a/src/guile/skribilo/location.scm +++ b/src/guile/skribilo/location.scm @@ -16,7 +16,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo location) diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm index 753aca8..54989fb 100644 --- a/src/guile/skribilo/module.scm +++ b/src/guile/skribilo/module.scm @@ -1,6 +1,6 @@ ;;; module.scm -- Integration of Skribe code as Guile modules. ;;; -;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -15,7 +15,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo module) @@ -45,12 +45,14 @@ (srfi srfi-13) ;; strings (ice-9 optargs) ;; `define*' + (skribilo package base) ;; the core markups (skribilo utils syntax) ;; `unless', `when', etc. (skribilo utils compat) ;; `skribe-load-path', etc. + (skribilo utils keywords) ;; `the-body', `the-options' + (skribilo utils strings) ;; `make-string-replace', etc. (skribilo module) (skribilo ast) ;; `<document>', `document?', etc. (skribilo config) - (skribilo runtime) ;; `the-options', `the-body', `make-string-replace' (skribilo biblio) (skribilo lib) ;; `define-markup', `unwind-protect', etc. (skribilo resolve) @@ -73,6 +75,8 @@ ((skribilo engine html) . (html-markup-class html-class html-width)) ((skribilo utils images) . (convert-image)) + ((skribilo index) . (index? make-index-table default-index + resolve-the-index)) ((skribilo source) . (source-read-lines source-fontify language? language-extractor language-fontifier source-fontify)) @@ -86,7 +90,7 @@ ((ice-9 receive) . (receive)))) (define %skribe-core-modules - '("utils" "api" "bib" "index" "param" "sui")) + '("param" "sui")) diff --git a/src/guile/skribilo/output.scm b/src/guile/skribilo/output.scm index 02633f1..7a49fd1 100644 --- a/src/guile/skribilo/output.scm +++ b/src/guile/skribilo/output.scm @@ -1,7 +1,7 @@ ;;; output.scm -- Skribilo output stage. ;;; ;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> -;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -16,23 +16,75 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo output) - :export (output) :autoload (skribilo engine) (engine-ident processor-get-engine) :autoload (skribilo writer) (writer? writer-ident lookup-markup-writer) - :use-module (skribilo lib) + :autoload (skribilo location) (location?) :use-module (skribilo ast) :use-module (skribilo debug) :use-module (skribilo utils syntax) - :use-module (oop goops)) + :use-module (oop goops) + + :use-module (skribilo condition) + :use-module (srfi srfi-35) + :use-module (srfi srfi-34) + + :export (output + &output-error &output-unresolved-error &output-writer-error + output-error? output-unresolved-error? output-writer-error?)) + (fluid-set! current-reader %skribilo-module-reader) +;;; +;;; Error conditions. +;;; + +(define-condition-type &output-error &skribilo-error + output-error?) + +(define-condition-type &output-unresolved-error &output-error + output-unresolved-error? + (ast output-unresolved-error:ast)) + +(define-condition-type &output-writer-error &output-error + output-writer-error? + (writer output-writer-error:writer)) + + +(define (handle-output-error c) + ;; Issue a user-friendly error message for error condition C. + (cond ((output-unresolved-error? c) + (let* ((node (output-unresolved-error:ast c)) + (location (and (ast? node) (ast-loc node)))) + (format (current-error-port) "unresolved node: ~a~a~%" + node + (if (location? location) + (string-append " " + (location-file location) ":" + (location-line location)) + "")))) + ((output-writer-error? c) + (format (current-error-port) "invalid writer: ~a~%" + (output-writer-error:writer c))) + (else + (format (current-error-port) "undefined output error: ~a~%" + c)))) + +(register-error-condition-handler! output-error? + handle-output-error) + + + +;;; +;;; Output method. +;;; + (define-generic out) (define (%out/writer n e w) @@ -58,11 +110,10 @@ ((is-a? (car writer) <writer>) (%out/writer node e (car writer))) ((not (car writer)) - (skribe-error 'output - (format #f "illegal ~A user writer" (engine-ident e)) - (if (markup? node) (markup-markup node) node))) + (raise (condition (&output-writer-error (writer writer))))) (else - (skribe-error 'output "illegal user writer" (car writer))))))) + (raise (condition (&output-writer-error (writer writer))))))))) + ;;; @@ -79,7 +130,9 @@ (out (car n*) e) (loop (cdr n*))) ((not (null? n*)) - (skribe-error 'out "Illegal argument" n*))))) + (raise (condition (&invalid-argument-error + (proc-name output) + (argument n*)))))))) (define-method (out (node <string>) e) @@ -113,7 +166,9 @@ (if (> n 0) (if (<= n lb) (output (list-ref body (- n 1)) e) - (skribe-error '! "Too few arguments provided" n))) + (raise (condition (&too-few-arguments-error + (proc-name "output<command>") + (arguments n)))))) lf) (let ((c (string-ref fmt i))) (cond @@ -128,7 +183,9 @@ (output (list-ref body (- n 1)) e) i) (else - (skribe-error '! "Too few arguments provided" n)))) + (raise (condition (&too-few-arguments-error + (proc-name "output<command>") + (arguments n))))))) (else (loops (+ i 1) (+ (- (char->integer c) @@ -151,7 +208,7 @@ (define-method (out (n <unresolved>) e) - (skribe-error 'output "orphan unresolved" n)) + (raise (condition (&output-unresolved-error (ast n))))) (define-method (out (node <markup>) e) diff --git a/src/guile/skribilo/package/Makefile.am b/src/guile/skribilo/package/Makefile.am index 6cb30b9..693f088 100644 --- a/src/guile/skribilo/package/Makefile.am +++ b/src/guile/skribilo/package/Makefile.am @@ -2,6 +2,6 @@ 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 \ - eq.scm + eq.scm pie.scm base.scm -SUBDIRS = slide eq +SUBDIRS = slide eq pie diff --git a/src/guile/skribilo/skribe/api.scm b/src/guile/skribilo/package/base.scm index 2cd8b2e..8f484a0 100644 --- a/src/guile/skribilo/skribe/api.scm +++ b/src/guile/skribilo/package/base.scm @@ -1,4 +1,4 @@ -;;; api.scm -- The markup API of Skribe/Skribilo. +;;; base.scm -- The base markup package of Skribe/Skribilo. ;;; ;;; Copyright 2003, 2004 Manuel Serrano ;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr> @@ -16,13 +16,34 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo skribe api) +(define-module (skribilo package base) + :use-syntax (skribilo lib) + :use-syntax (skribilo reader) + :use-syntax (skribilo utils syntax) + :use-syntax (ice-9 optargs) + + :use-module (skribilo ast) + :use-module (skribilo resolve) + :use-module (skribilo utils keywords) + :autoload (srfi srfi-1) (every any filter) + :autoload (skribilo evaluator) (include-document) + :autoload (skribilo engine) (engine?) + + ;; optional ``sub-packages'' + :autoload (skribilo biblio) (default-bib-table resolve-bib) + :autoload (skribilo color) (skribe-use-color!) + :autoload (skribilo source) (language? source-read-lines source-fontify) + :autoload (skribilo prog) (make-prog-body resolve-line) + :autoload (skribilo index) (make-index-table) + :replace (symbol)) -;;; Author: Manuel Serrano +(fluid-set! current-reader (make-reader 'skribe)) + +;;; Author: Manuel Serrano ;;; Commentary: ;;; ;;; This module contains all the core markups of Skribe/Skribilo. @@ -30,8 +51,8 @@ ;;; Code: -;;; The contents of the file below are unchanged compared to Skribe 1.2d's -;;; `api.scm' file found in the `common' directory. +;;; The contents of the file below are (almost) unchanged compared to Skribe +;;; 1.2d's `api.scm' file found in the `common' directory. @@ -41,7 +62,7 @@ (define-markup (include file) (if (not (string? file)) (skribe-error 'include "Illegal file (string expected)" file) - (skribe-include file))) + (include-document file))) ;*---------------------------------------------------------------------*/ ;* document ... */ @@ -51,12 +72,12 @@ #!key (ident #f) (class "document") (title #f) (html-title #f) (author #f) - (ending #f) (env '())) + (ending #f) (keywords '()) (env '())) (new document (markup 'document) (ident (or ident (ast->string title) - (symbol->string (gensym 'document)))) + (symbol->string (gensym "document")))) (class class) (required-options '(:title :author :ending)) (options (the-options opts :ident :class :env)) @@ -68,6 +89,20 @@ (list 'figure-counter 0) (list 'figure-env '())))))) ;*---------------------------------------------------------------------*/ +;* keyword-list->comma-separated ... */ +;*---------------------------------------------------------------------*/ +(define-public (keyword-list->comma-separated kw*) + ;; Turn the the list of keywords (which may be strings or other markups) + ;; KW* into a markup where the elements of KW* are comma-separated. This + ;; may commonly be used in handling the `:keywords' option of `document'. + (let loop ((kw* kw*) (result '())) + (if (null? kw*) + (reverse! result) + (loop (cdr kw*) + (cons* (if (pair? (cdr kw*)) ", " "") + (car kw*) result))))) + +;*---------------------------------------------------------------------*/ ;* author ... */ ;*---------------------------------------------------------------------*/ (define-markup (author #!rest @@ -87,7 +122,7 @@ (skribe-error 'author "Illegal align value" align) (new container (markup 'author) - (ident (or ident (symbol->string (gensym 'author)))) + (ident (or ident (symbol->string (gensym "author")))) (class class) (required-options '(:name :title :affiliation :email :url :address :phone :photo :align)) (options `((:name ,name) @@ -107,7 +142,7 @@ (let ((body (the-body opts))) (new container (markup 'toc) - (ident (or ident (symbol->string (gensym 'toc)))) + (ident (or ident (symbol->string (gensym "toc")))) (class class) (required-options '()) (options `((:chapter ,chapter) @@ -147,7 +182,7 @@ title (html-title #f) (file #f) (toc #t) (number #t)) (new container (markup 'chapter) - (ident (or ident (symbol->string (gensym 'chapter)))) + (ident (or ident (symbol->string (gensym "chapter")))) (class class) (required-options '(:title :file :toc :number)) (options `((:toc ,toc) @@ -187,7 +222,7 @@ title (file #f) (toc #t) (number #t)) (new container (markup 'section) - (ident (or ident (symbol->string (gensym 'section)))) + (ident (or ident (symbol->string (gensym "section")))) (class class) (required-options '(:title :toc :file :toc :number)) (options `((:number ,(section-number number 'section)) @@ -214,7 +249,7 @@ title (file #f) (toc #t) (number #t)) (new container (markup 'subsection) - (ident (or ident (symbol->string (gensym 'subsection)))) + (ident (or ident (symbol->string (gensym "subsection")))) (class class) (required-options '(:title :toc :file :number)) (options `((:number ,(section-number number 'subsection)) @@ -238,7 +273,7 @@ title (file #f) (toc #f) (number #t)) (new container (markup 'subsubsection) - (ident (or ident (symbol->string (gensym 'subsubsection)))) + (ident (or ident (symbol->string (gensym "subsubsection")))) (class class) (required-options '(:title :toc :number :file)) (options `((:number ,(section-number number 'subsubsection)) @@ -258,7 +293,7 @@ (define-markup (~ #!rest opts #!key (class #f)) (new markup (markup '~) - (ident (gensym '~)) + (ident (gensym "~")) (class class) (required-options '()) (options (the-options opts :class)) @@ -272,7 +307,7 @@ ;; The `:label' option used to be called `:number'. (new container (markup 'footnote) - (ident (symbol->string (gensym 'footnote))) + (ident (symbol->string (gensym "footnote"))) (class class) (required-options '()) (options `((:label @@ -292,7 +327,7 @@ ;*---------------------------------------------------------------------*/ (define-markup (linebreak #!rest opts #!key (ident #f) (class #f)) (let ((ln (new markup - (ident (or ident (symbol->string (gensym 'linebreak)))) + (ident (or ident (symbol->string (gensym "linebreak")))) (class class) (markup 'linebreak))) (num (the-body opts))) @@ -316,7 +351,7 @@ (width 100.) (height 1)) (new markup (markup 'hrule) - (ident (or ident (symbol->string (gensym 'hrule)))) + (ident (or ident (symbol->string (gensym "hrule")))) (class class) (required-options '()) (options `((:width ,width) @@ -334,7 +369,7 @@ (bg #f) (fg #f) (width #f) (margin #f)) (new container (markup 'color) - (ident (or ident (symbol->string (gensym 'color)))) + (ident (or ident (symbol->string (gensym "color")))) (class class) (required-options '(:bg :fg :width)) (options `((:bg ,(if bg (skribe-use-color! bg) bg)) @@ -352,7 +387,7 @@ (width #f) (margin 2) (border 1)) (new container (markup 'frame) - (ident (or ident (symbol->string (gensym 'frame)))) + (ident (or ident (symbol->string (gensym "frame")))) (class class) (required-options '(:width :border :margin)) (options `((:margin ,margin) @@ -373,7 +408,7 @@ (size #f) (face #f)) (new container (markup 'font) - (ident (or ident (symbol->string (gensym 'font)))) + (ident (or ident (symbol->string (gensym "font")))) (class class) (required-options '(:size)) (options (the-options opts :ident :class)) @@ -391,7 +426,7 @@ ((center left right) (new container (markup 'flush) - (ident (or ident (symbol->string (gensym 'flush)))) + (ident (or ident (symbol->string (gensym "flush")))) (class class) (required-options '(:side)) (options (the-options opts :ident :class)) @@ -426,7 +461,7 @@ (skribe-error 'prog "Illegal mark" mark) (new container (markup 'prog) - (ident (or ident (symbol->string (gensym 'prog)))) + (ident (or ident (symbol->string (gensym "prog")))) (class class) (required-options '(:line :mark)) (options (the-options opts :ident :class :linedigit)) @@ -523,7 +558,7 @@ (let ((s (ast->string legend))) (if (not (string=? s "")) s - (symbol->string (gensym 'figure)))))) + (symbol->string (gensym "figure")))))) (class class) (required-options '(:legend :number :multicolumns)) (options `((:number @@ -551,12 +586,13 @@ (null? (cdr lst))) (parse-list-of for markup (car lst))) (else - (let loop ((lst lst)) + (let loop ((lst lst) + (result '())) (cond ((null? lst) - '()) + (reverse! result)) ((pair? (car lst)) - (loop (car lst))) + (loop (car lst) result)) (else (let ((r (car lst))) (if (not (is-markup? r markup)) @@ -567,7 +603,7 @@ (markup-markup r) (find-runtime-type r)) markup))) - (cons r (loop (cdr lst)))))))))) + (loop (cdr lst) (cons r result))))))))) ;*---------------------------------------------------------------------*/ ;* itemize ... */ @@ -575,7 +611,7 @@ (define-markup (itemize #!rest opts #!key (ident #f) (class "itemize") symbol) (new container (markup 'itemize) - (ident (or ident (symbol->string (gensym 'itemize)))) + (ident (or ident (symbol->string (gensym "itemize")))) (class class) (required-options '(:symbol)) (options `((:symbol ,symbol) ,@(the-options opts :ident :class))) @@ -587,7 +623,7 @@ (define-markup (enumerate #!rest opts #!key (ident #f) (class "enumerate") symbol) (new container (markup 'enumerate) - (ident (or ident (symbol->string (gensym 'enumerate)))) + (ident (or ident (symbol->string (gensym "enumerate")))) (class class) (required-options '(:symbol)) (options `((:symbol ,symbol) ,@(the-options opts :ident :class))) @@ -599,7 +635,7 @@ (define-markup (description #!rest opts #!key (ident #f) (class "description") symbol) (new container (markup 'description) - (ident (or ident (symbol->string (gensym 'description)))) + (ident (or ident (symbol->string (gensym "description")))) (class class) (required-options '(:symbol)) (options `((:symbol ,symbol) ,@(the-options opts :ident :class))) @@ -616,7 +652,7 @@ (skribe-type-error 'item "Illegal key:" key "node") (new container (markup 'item) - (ident (or ident (symbol->string (gensym 'item)))) + (ident (or ident (symbol->string (gensym "item")))) (class class) (required-options '(:key)) (options `((:key ,key) ,@(the-options opts :ident :class :key))) @@ -667,7 +703,7 @@ (else (new container (markup 'table) - (ident (or ident (symbol->string (gensym 'table)))) + (ident (or ident (symbol->string (gensym "table")))) (class class) (required-options '(:width :frame :rules)) (options `((:frame ,frame) @@ -682,7 +718,7 @@ (define-markup (tr #!rest opts #!key (ident #f) (class #f) (bg #f)) (new container (markup 'tr) - (ident (or ident (symbol->string (gensym 'tr)))) + (ident (or ident (symbol->string (gensym "tr")))) (class class) (required-options '()) (options `(,@(if bg `((:bg ,(if bg (skribe-use-color! bg) bg))) '()) @@ -723,7 +759,7 @@ (else (new container (markup 'tc) - (ident (or ident (symbol->string (gensym 'tc)))) + (ident (or ident (symbol->string (gensym "tc")))) (class class) (required-options '(:width :align :valign :colspan)) (options `((markup ,m) @@ -780,7 +816,7 @@ (else (new markup (markup 'image) - (ident (or ident (symbol->string (gensym 'image)))) + (ident (or ident (symbol->string (gensym "image")))) (class class) (required-options '(:file :url :width :height)) (options (the-options opts :ident :class)) @@ -863,7 +899,13 @@ (skribe-error 'processor "Illegal engine" engine)) ((and procedure (or (not (procedure? procedure)) - (not (correct-arity? procedure 2)))) + (not (let ((a (procedure-property procedure 'arity))) + (and (pair? a) + (let ((compulsory (car a)) + (optional (cadr a)) + (rest? (caddr a))) + (or rest? + (>= (+ compulsory optional) 2)))))))) (skribe-error 'processor "Illegal procedure" procedure)) (else (new processor @@ -911,7 +953,7 @@ (define-markup (mailto #!rest opts #!key (ident #f) (class "mailto") text) (new markup (markup 'mailto) - (ident (or ident (symbol->string (gensym 'ident)))) + (ident (or ident (symbol->string (gensym "ident")))) (class class) (required-options '(:text)) (options (the-options opts :ident :class)) @@ -920,7 +962,7 @@ ;*---------------------------------------------------------------------*/ ;* *mark-table* ... */ ;*---------------------------------------------------------------------*/ -(define *mark-table* (make-hashtable)) +(define *mark-table* (make-hash-table)) ;*---------------------------------------------------------------------*/ ;* mark ... */ @@ -949,7 +991,7 @@ (class class) (options (the-options opts :ident :class :text)) (body text)))) - (hashtable-put! *mark-table* bs n) + (hash-set! *mark-table* bs n) n))))) ;*---------------------------------------------------------------------*/ @@ -1019,7 +1061,31 @@ (required-options '(:text)) (options `((kind handle) ,@(the-options opts :ident :class))) (body text))) - (define (doref text kind) + (define (do-title-ref title kind) + (if (not (string? title)) + (skribe-type-error 'ref "illegal reference" title "string") + (new unresolved + (proc (lambda (n e env) + (let* ((doc (ast-document n)) + (s (find1-down + (lambda (n) + (and (is-markup? n kind) + (equal? (markup-option n :title) + title))) + doc))) + (if s + (new markup + (markup 'ref) + (ident (symbol->string 'title-ref)) + (class class) + (required-options '(:text)) + (options `((kind ,kind) + (mark ,title) + ,@(the-options opts :ident :class))) + (body (new handle + (ast s)))) + (unref n title (or kind 'title))))))))) + (define (do-ident-ref text kind) (if (not (string? text)) (skribe-type-error 'ref "Illegal reference" text "string") (new unresolved @@ -1028,7 +1094,7 @@ (if s (new markup (markup 'ref) - (ident (symbol->string 'ref)) + (ident (symbol->string 'indent-ref)) (class class) (required-options '(:text)) (options `((kind ,kind) @@ -1042,7 +1108,7 @@ (skribe-type-error 'mark "Illegal mark, " mark "string") (new unresolved (proc (lambda (n e env) - (let ((s (hashtable-get *mark-table* mark))) + (let ((s (hash-ref *mark-table* mark))) (if s (new markup (markup 'ref) @@ -1108,17 +1174,17 @@ (cond (skribe (skribe-ref skribe)) (handle (handle-ref handle)) - (ident (doref ident #f)) - (chapter (doref chapter 'chapter)) - (section (doref section 'section)) - (subsection (doref subsection 'subsection)) - (subsubsection (doref subsubsection 'subsubsection)) - (figure (doref figure 'figure)) + (ident (do-ident-ref ident #f)) + (chapter (do-title-ref chapter 'chapter)) + (section (do-title-ref section 'section)) + (subsection (do-title-ref subsection 'subsection)) + (subsubsection (do-title-ref subsubsection 'subsubsection)) + (figure (do-ident-ref figure 'figure)) (mark (mark-ref mark)) (bib (bib-ref bib)) (url (url-ref)) (line (line-ref line)) - (else (skribe-error 'ref "Illegal reference" opts))))) + (else (skribe-error 'ref "illegal reference" opts))))) ;*---------------------------------------------------------------------*/ ;* resolve ... */ @@ -1212,11 +1278,11 @@ "Illegal index table, " index "index")))) - (m (mark (symbol->string (gensym)))) + (m (mark (symbol->string (gensym "mark")))) (h (new handle (ast m))) (new (new markup (markup '&index-entry) - (ident (or ident (symbol->string (gensym 'index)))) + (ident (or ident (symbol->string (gensym "index")))) (class class) (options `((name ,ename) ,@(the-options opts :ident :class))) (body (if url @@ -1225,10 +1291,12 @@ ;; New is bound to a dummy option of the mark in order ;; to make new options verified. (markup-option-add! m 'to-verify new) - (hashtable-update! table - ename - (lambda (cur) (cons new cur)) - (list new)) + + (let ((handle (hash-get-handle table ename))) + (if (not handle) + (hash-set! table ename (list new)) + (set-cdr! handle (cons new (cdr handle))))) + m)) ;*---------------------------------------------------------------------*/ @@ -1255,7 +1323,7 @@ (skribe-error 'the-index "Illegal char offset" char-offset)) ((not (integer? column)) (skribe-error 'the-index "Illegal column number" column)) - ((not (every? index? bd)) + ((not (every index? bd)) (skribe-error 'the-index "Illegal indexes" (filter (lambda (o) (not (index? o))) bd))) diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm index 45a863f..4f5020e 100644 --- a/src/guile/skribilo/package/eq.scm +++ b/src/guile/skribilo/package/eq.scm @@ -15,7 +15,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo package eq) @@ -26,8 +26,8 @@ :use-module (skribilo lib) :use-module (skribilo utils syntax) :use-module (skribilo module) - :use-module (skribilo skribe utils) ;; `the-options', etc. - :autoload (skribilo skribe api) (it symbol sub sup) + :use-module (skribilo utils keywords) ;; `the-options', etc. + :autoload (skribilo package base) (it symbol sub sup) :autoload (skribilo engine lout) (lout-illustration) :use-module (ice-9 optargs)) @@ -76,10 +76,6 @@ sim cong approx neq equiv le ge subset supset subseteq supseteq oplus otimes perp mid lceil rceil lfloor rfloor langle rangle)) -(define %rebindings - (map (lambda (sym) - (list sym (symbol-append 'eq: sym))) - %operators)) (define (make-fast-member-predicate lst) (let ((h (make-hash-table))) @@ -93,15 +89,60 @@ (define-public known-operator? (make-fast-member-predicate %operators)) (define-public known-symbol? (make-fast-member-predicate %symbols)) +(define-public equation-markup-name? + (make-fast-member-predicate (map (lambda (s) + (symbol-append 'eq: s)) + %operators))) + (define-public (equation-markup? m) "Return true if @var{m} is an instance of one of the equation sub-markups." - (define eq-sym? - (make-fast-member-predicate (map (lambda (s) - (symbol-append 'eq: s)) - %operators))) (and (markup? m) - (eq-sym? (markup-markup m)))) + (equation-markup-name? (markup-markup m)))) + +(define-public (equation-markup-name->operator m) + "Given symbol @var{m} (an equation markup name, e.g., @code{eq:+}), return +a symbol representing the mathematical operator denoted by @var{m} (e.g., +@code{+})." + (if (equation-markup-name? m) + (string->symbol (let ((str (symbol->string m))) + (substring str + (+ 1 (string-index str #\:)) + (string-length str)))) + #f)) + + +;;; +;;; Operator precedence. +;;; + +(define %operator-precedence + ;; FIXME: This needs to be augmented. + '((+ . 1) + (- . 1) + (* . 2) + (/ . 2) + (sum . 3) + (product . 3) + (= . 0) + (< . 0) + (> . 0) + (<= . 0) + (>= . 0))) + +(define-public (operator-precedence op) + (let ((p (assq op %operator-precedence))) + (if (pair? p) (cdr p) 0))) + + + +;;; +;;; Turning an S-exp into an `eq' markup. +;;; +(define %rebindings + (map (lambda (sym) + (list sym (symbol-append 'eq: sym))) + %operators)) (define (eq:symbols->strings equation) "Turn symbols located in non-@code{car} positions into strings." @@ -122,12 +163,14 @@ (eval `(let ,%rebindings ,(eq:symbols->strings equation)) (current-module))) + ;;; ;;; Markup. ;;; -(define-markup (eq :rest opts :key (ident #f) (renderer #f) (class "eq")) +(define-markup (eq :rest opts :key (ident #f) (inline? #f) + (renderer #f) (class "eq")) (new markup (markup 'eq) (ident (or ident (symbol->string (gensym "eq")))) @@ -208,13 +251,13 @@ body)) (loop (cdr body) (cons first result))))))))) + ;;; -;;; Base and text-only implementation. +;;; Text-based rendering. ;;; - (markup-writer 'eq (find-engine 'base) :action (lambda (node engine) ;; The `:renderer' option should be a symbol (naming an engine @@ -246,24 +289,37 @@ renderer)))))) (define-macro (simple-markup-writer op . obj) - `(markup-writer ',(symbol-append 'eq: op) (find-engine 'base) - :action (lambda (node engine) - (let loop ((operands (markup-body node))) - (if (null? operands) - #t - (let ((o (car operands))) - (display (if (equation-markup? o) "(" "")) - (output o engine) - (display (if (equation-markup? o) ")" "")) - (if (pair? (cdr operands)) - (begin - (display " ") - (output ,(if (null? obj) - (symbol->string op) - (car obj)) - engine) - (display " "))) - (loop (cdr operands)))))))) + ;; Note: The text-only rendering is less ambiguous if we parenthesize + ;; without taking operator precedence into account. + (let ((precedence (operator-precedence op))) + `(markup-writer ',(symbol-append 'eq: op) (find-engine 'base) + :action (lambda (node engine) + (let loop ((operands (markup-body node))) + (if (null? operands) + #t + (let* ((o (car operands)) + (nested-eq? (equation-markup? o)) + (need-paren? + (and nested-eq? +; (< (operator-precedence +; (equation-markup-name->operator +; (markup-markup o))) +; ,precedence) + ) + )) + + (display (if need-paren? "(" "")) + (output o engine) + (display (if need-paren? ")" "")) + (if (pair? (cdr operands)) + (begin + (display " ") + (output ,(if (null? obj) + (symbol->string op) + (car obj)) + engine) + (display " "))) + (loop (cdr operands))))))))) (simple-markup-writer +) (simple-markup-writer -) diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm index 561e4cb..c487b85 100644 --- a/src/guile/skribilo/package/eq/lout.scm +++ b/src/guile/skribilo/package/eq/lout.scm @@ -15,7 +15,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo package eq lout) @@ -26,7 +26,7 @@ :use-module (skribilo engine) :use-module (skribilo lib) :use-module (skribilo utils syntax) - :use-module (skribilo skribe utils) ;; `the-options', etc. + :use-module (skribilo utils keywords) ;; `the-options', etc. :use-module (ice-9 optargs)) (fluid-set! current-reader %skribilo-module-reader) @@ -53,64 +53,78 @@ (markup-writer 'eq (find-engine 'lout) - :before "{ @Eq { " + :options '(:inline?) + :before "{ " :action (lambda (node engine) - (let ((eq (markup-body node))) - ;(fprint (current-error-port) "eq=" eq) - (output eq engine))) + (display (if (markup-option node :inline?) + "@E { " + "@Eq { ")) + (let ((eq (markup-body node))) + ;;(fprint (current-error-port) "eq=" eq) + (output eq engine))) :after " } }") -;; -;; `+' and `-' have lower precedence than `*', `/', `=', etc., so their -;; operands do not need to be enclosed in braces. -;; - -(markup-writer 'eq:+ (find-engine 'lout) - :action (lambda (node engine) - (let loop ((operands (markup-body node))) - (if (null? operands) - #t - (begin - ;; no braces - (output (car operands) engine) - (if (pair? (cdr operands)) - (display " + ")) - (loop (cdr operands))))))) - -(markup-writer 'eq:- (find-engine 'lout) - :action (lambda (node engine) - (let loop ((operands (markup-body node))) - (if (null? operands) - #t - (begin - ;; no braces - (output (car operands) engine) - (if (pair? (cdr operands)) - (display " - ")) - (loop (cdr operands))))))) - -(define-macro (simple-lout-markup-writer sym . lout-name) - `(markup-writer ',(symbol-append 'eq: sym) - (find-engine 'lout) - :action (lambda (node engine) - (let loop ((operands (markup-body node))) - (if (null? operands) - #t - (begin - (display " { ") - (output (car operands) engine) - (display " }") - (if (pair? (cdr operands)) - (display ,(string-append " " - (if (null? lout-name) - (symbol->string sym) - (car lout-name)) - " "))) - (loop (cdr operands)))))))) +(define-macro (simple-lout-markup-writer sym . args) + (let* ((lout-name (if (null? args) + (symbol->string sym) + (car args))) + (parentheses? (if (or (null? args) (null? (cdr args))) + #t + (cadr args))) + (precedence (operator-precedence sym)) + + ;; Note: We could use `pmatrix' here but it precludes line-breaking + ;; within equations. + (open-par `(if need-paren? "{ @VScale ( }" "")) + (close-par `(if need-paren? "{ @VScale ) }" ""))) + + `(markup-writer ',(symbol-append 'eq: sym) + (find-engine 'lout) + :action (lambda (node engine) + (let loop ((operands (markup-body node))) + (if (null? operands) + #t + (let* ((op (car operands)) + (eq-op? (equation-markup? op)) + (need-paren? + (and eq-op? + (< (operator-precedence + (equation-markup-name->operator + (markup-markup op))) + ,precedence))) + (column (port-column + (current-output-port)))) + + ;; Work around Lout's limitations... + (if (> column 1000) (display "\n")) + + (display (string-append " { " + ,(if parentheses? + open-par + ""))) + (output op engine) + (display (string-append ,(if parentheses? + close-par + "") + " }")) + (if (pair? (cdr operands)) + (display ,(string-append " " + lout-name + " "))) + (loop (cdr operands))))))))) + + +;; `+' and `*' have higher precedence than `-', `/', `=', etc., so their +;; operands do not need to be enclosed in parentheses. OTOH, since we use a +;; horizontal bar of `/', we don't need to parenthesize its arguments. + + +(simple-lout-markup-writer +) (simple-lout-markup-writer * "times") -(simple-lout-markup-writer / "over") +(simple-lout-markup-writer - "-") +(simple-lout-markup-writer / "over" #f) (simple-lout-markup-writer =) (simple-lout-markup-writer <) (simple-lout-markup-writer >) diff --git a/src/guile/skribilo/package/pie.scm b/src/guile/skribilo/package/pie.scm new file mode 100644 index 0000000..8ccf858 --- /dev/null +++ b/src/guile/skribilo/package/pie.scm @@ -0,0 +1,314 @@ +;;; pie.scm -- An pie-chart formatting package. +;;; +;;; Copyright 2005, 2006 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;; USA. + +(define-module (skribilo package pie) + :autoload (skribilo ast) (markup? markup-ident ast-parent) + :autoload (skribilo output) (output) + :use-module (skribilo writer) + :use-module (skribilo engine) + :use-module (skribilo lib) ;; `skribe-error' et al. + :use-module (skribilo utils syntax) + :use-module (skribilo utils keywords) ;; `the-options', etc. + :use-module (skribilo utils strings) ;; `make-string-replace' + :use-module (skribilo module) + :autoload (skribilo color) (skribe-color->rgb) + :autoload (skribilo package base) (bold) + :autoload (skribilo engine lout) (lout-illustration) + :autoload (ice-9 popen) (open-output-pipe) + :use-module (ice-9 optargs) + :export (%ploticus-program %ploticus-debug? + pie-sliceweight-value pie-remove-markup)) + +(fluid-set! current-reader %skribilo-module-reader) + + + +;;; +;;; Markup. +;;; + +(define-markup (pie :rest opts + :key (ident #f) (title "Pie Chart") + (initial-angle 0) (total #f) (radius 3) + (fingers? #t) (labels 'outside) + (class "pie")) + (new container + (markup 'pie) + (ident (or ident (symbol->string (gensym "pie")))) + (options (the-options opts)) + (body (the-body opts)))) + +(define-markup (slice :rest opts + :key (ident #f) (weight 1) (color "white") (detach? #f)) + (new container + (markup 'slice) + (ident (or ident (symbol->string (gensym "slice")))) + (weight weight) + (color color) + (detach? detach?) + (options (the-options opts)) + (body (the-body opts)))) + +(define-markup (sliceweight :rest opts + :key (ident #f) (percentage? #f)) + (new markup + (markup 'sliceweight) + (ident (or ident (symbol->string (gensym "sliceweight")))) + (percentage? percentage?) + (options (the-options opts)) + (body '()))) + + + +;;; +;;; Helper functions. +;;; + +(define (make-rounder pow10) + ;; Return a procedure that round to 10 to the -POW10. + (let ((times (expt 10.0 pow10))) + (lambda (x) + (/ (round (* x times)) times)))) + +(define (pie-sliceweight-value sw-node pct?) + "Return the value that should be displayed by `sw-node', a + `sliceweight' markup node. If `pct?' is true, then this value + should be a percentage." + (let* ((the-slice (ast-parent sw-node)) + (weight (and the-slice (markup-option the-slice :weight)))) + (if (not the-slice) + (skribe-error 'lout + "`sliceweight' node not within a `slice' body" + sw-node) + (if pct? + (let* ((the-pie (ast-parent the-slice)) + (total (and the-pie + (markup-option the-pie + '&total-weight)))) + (if (not the-pie) + (skribe-error 'lout + "`slice' not within a `pie' body" + the-slice) + (* 100.0 (/ weight total)))) ;; flonum (FIXME: precision) + + weight)))) + +(define (pie-remove-markup node) + "Remove markup from `node', ie. turn something like `(it \"hello\")' into +the string \"hello\". Implement `sliceweight' markups too." + (define percentage-round (make-rounder 2)) + + (if (markup? node) + (if (and node (is-markup? node 'sliceweight)) + (let* ((pct? (markup-option node :percentage?)) + (value (pie-sliceweight-value node pct?))) + (number->string (percentage-round value))) + (pie-remove-markup (markup-body node))) + (if (list? node) + (apply string-append (map pie-remove-markup node)) + node))) + +(define strip-newlines (make-string-replace '((#\newline " ")))) + +(define (select-output-format engine) + ;; Choose an ouptut format suitable for ENGINE. + (define %supported-formats '("png" "ps" "eps" "svg" "svgz")) + (define %default-format "png") + + (let ((fmt (engine-custom engine 'image-format))) + (cond ((string? fmt) fmt) + ((and (list? fmt) (not (null? fmt))) + (let ((f (car fmt))) + (if (member f %supported-formats) + f + %default-format))) + (else %default-format)))) + + +;;; +;;; Default implementation (`base' engine). +;;; + +;; Ploticus-based implementation of pie charts, suitable for most engines. +;; See http://ploticus.sf.net for info about Ploticus. + +(define %ploticus-program "ploticus") +(define %ploticus-debug? #f) + +(define (color-spec->ploticus color-spec) + (define round (make-rounder 2)) + + (call-with-values (lambda () (skribe-color->rgb color-spec)) + (lambda (r g b) + (format #f "rgb(~a,~a,~a)" + (round (/ r 255.0)) + (round (/ g 255.0)) + (round (/ b 255.0)))))) + +(define (ploticus-script pie) + (let* ((weights (map (lambda (slice) + (markup-option slice :weight)) + (markup-body pie))) + (colors (map (lambda (slice) + (let ((c (markup-option slice :color))) + (string-append (color-spec->ploticus c) + " "))) + (markup-body pie))) + (total-weight (or (if (number? (markup-option pie + :total)) + (markup-option pie :total) + #f) + (apply + weights))) + + ;; Attach useful information to the pie and its slices + (-/- (markup-option-add! pie '&total-weight total-weight)) + + ;; One slice label per line -- so we need to remove + ;; newlines from labels. + (labels (map (lambda (b) + (strip-newlines (pie-remove-markup b))) + (markup-body pie))) + +; (flat-title (map pie-remove-markup +; (markup-option pie :title))) + (detached (map (lambda (slice) + (let ((d (markup-option slice + :detach?))) + (cond ((number? d) d) + (d 0.5) ;; default + (#t 0)))) + (markup-body pie))) + + (initial-angle (or (markup-option pie :initial-angle) + 0)) + (radius (or ;;FIXME + (markup-option pie :radius) 3)) + (max-radius (+ radius (apply max detached))) + + ;; center coordinates must take into account (i) the + ;; maxium radius when detached slices are considered and + ;; (ii) the fact that labels may get displayed to the + ;; left of the pie. + ;; FIXME: labels to the left (ii) end up being truncated + ;; when the radius is e.g. < 2. + (center `(,(+ max-radius + (* max-radius max-radius)) . + ,(* max-radius max-radius)))) + + (apply string-append + (append (list "#proc getdata\n" "data: ") + (map (lambda (weight) + (string-append (number->string weight) + "\n")) + weights) + `("\n" +; "#proc page\n" +; "title " ,@flat-title +; "\n" + "#proc pie\n" + "total: " + ,(number->string total-weight) + "\n" + "datafield: " "1" "\n") + `("firstslice: " ,(number->string initial-angle) "\n") + `("radius: " ,(number->string radius) "\n") + `("center: " ,(number->string (car center)) + " " ,(number->string (cdr center)) "\n") + `("labelmode: " + ,(case (markup-option + pie :labels) + ((outside) "line+label") + ((inside) "labelonly") + ((legend) "legend") + (else "legend")) + "\n" + "labels: " ,@(map (lambda (label) + (string-append label "\n")) + labels) + "\n") + `("explode: " + ,@(map (lambda (number) + (string-append (number->string number) + " ")) + detached) + "\n") + `("colors: " ,@colors "\n"))))) + +(markup-writer 'pie (find-engine 'base) + :action (lambda (node engine) + (let* ((fmt (select-output-format engine)) + (pie-file (string-append (markup-ident node) "." + fmt)) + (port (open-output-pipe + (string-append %ploticus-program + " -o " pie-file + " -cm -" fmt " -stdin"))) + (script (ploticus-script node))) + + + (if %ploticus-debug? + (format (current-error-port) "** Ploticus script: ~a" + script)) + + (display script port) + + (let ((exit-val (status:exit-val (close-pipe port)))) + (if (not (eqv? 0 exit-val)) + (skribe-error 'pie/ploticus + "ploticus exited with error code" + exit-val))) + + (if (not (file-exists? pie-file)) + (skribe-error 'ploticus + "Ploticus did not create the image file" + script)) + + (if (markup-option node :title) + (output (list (bold (markup-option node :title)) + (linebreak)) + engine)) + + (output (image :file pie-file + :class (markup-option node :class) + (or (markup-option node :title) + "A Pie Chart")) + engine)))) + +(markup-writer 'slice (find-engine 'base) + :action (lambda (node engine) + ;; Nothing to do here + (error "slice: this writer should never be invoked"))) + +(markup-writer 'sliceweight (find-engine 'base) + :action (lambda (node engine) + ;; Nothing to do here. + (error "sliceweight: this writer should never be invoked"))) + + +;;; +;;; Initialization. +;;; + +(when-engine-is-loaded 'lout + (lambda () + (resolve-module '(skribilo package pie lout)))) + + +;;; arch-tag: 8095d8f6-b810-4619-9fdb-23fb94a77ee3 diff --git a/src/guile/skribilo/package/pie/Makefile.am b/src/guile/skribilo/package/pie/Makefile.am new file mode 100644 index 0000000..3b4fafd --- /dev/null +++ b/src/guile/skribilo/package/pie/Makefile.am @@ -0,0 +1,4 @@ +guilemoduledir = $(GUILE_SITE)/skribilo/package/pie +dist_guilemodule_DATA = lout.scm + +## arch-tag: e6a03451-14c9-4331-8b96-71bde92ac142 diff --git a/src/guile/skribilo/package/pie/lout.scm b/src/guile/skribilo/package/pie/lout.scm new file mode 100644 index 0000000..61dbcb7 --- /dev/null +++ b/src/guile/skribilo/package/pie/lout.scm @@ -0,0 +1,132 @@ +;;; lout.scm -- Lout implementation of the `pie' package. +;;; +;;; Copyright 2005, 2006 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;; USA. + +(define-module (skribilo package pie lout) + :use-module (skribilo package pie) + :use-module (skribilo ast) + :autoload (skribilo output) (output) + :use-module (skribilo writer) + :use-module (skribilo engine) + :use-module (skribilo lib) + :use-module (skribilo utils syntax) + :use-module (skribilo utils keywords) ;; `the-options', etc. + :autoload (skribilo engine lout) (lout-color-specification) + :use-module (ice-9 optargs)) + +(fluid-set! current-reader %skribilo-module-reader) + + + +;;; +;;; Helper functions. +;;; + +(let ((lout (find-engine 'lout))) + (if lout + (engine-custom-set! lout 'includes + (string-append (engine-custom lout 'includes) + "\n@SysInclude { pie } # Pie Charts\n")))) + + + +;;; +;;; Writers. +;;; + +(markup-writer 'pie (find-engine 'lout) + :before (lambda (node engine) + (let* ((weights (map (lambda (slice) + (markup-option slice :weight)) + (markup-body node))) + (total-weight (or (if (number? (markup-option node + :total)) + (markup-option node :total) + #f) + (apply + weights)))) + + (if (= 0 total-weight) + (skribe-error 'lout + "Slices weight sum should not be zero" + total-weight)) + + ;; Attach useful information to the pie and its slices + (markup-option-add! node '&total-weight total-weight) + + (display "\n@Pie\n") + (display " abovecaption { ") + (if (markup-option node :title) + (output (markup-option node :title) engine)) + (display " }\n") + (format #t " totalweight { ~a }\n" total-weight) + (format #t " initialangle { ~a }\n" + (or (markup-option node :initial-angle) 0)) + (format #t " finger { ~a }\n" + (case (markup-option node :labels) + ((outside) (if (markup-option node :fingers?) + "yes" "no")) + (else "no"))) + + ;; We assume `:radius' to be centimeters + (if (markup-option node :radius) + (format #t " radius { ~ac }\n" + (markup-option node :radius))) + + (format #t " labelradius { ~a }\n" + (case (markup-option node :labels) + ((outside #f) "external") ; FIXME: options are + ; not availble within + ; :before? (hence the #f) + + ((inside) "internal") + (else + (skribe-error 'lout + "`:labels' should be one of 'inside or 'outside." + (markup-option node :labels))))) + (display "{\n"))) + :after "\n} # @Pie\n") + +(markup-writer 'slice (find-engine 'lout) + :options '(:weight :detach? :color) + :action (lambda (node engine) + (display " @Slice\n") + (format #t " detach { ~a }\n" + (if (markup-option node :detach?) + "yes" + "no")) + (format #t " paint { ~a }\n" + (lout-color-specification (markup-option node + :color))) + (format #t " weight { ~a }\n" + (markup-option node :weight)) + + (display " label { ") + (output (markup-body node) engine) + (display " }\n"))) + +(markup-writer 'sliceweight (find-engine 'base) + ;; This writer should work for every engine, provided the `pie' markup has + ;; a proper `&total-weight' option. + :action (lambda (node engine) + (let ((pct? (markup-option node :percentage?))) + (output (number->string + (pie-sliceweight-value node pct?)) + engine)))) + +;;; arch-tag: b5221e30-f80e-4b72-a281-83ce19ddb755 diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm index 629abdf..8c4582c 100644 --- a/src/guile/skribilo/package/slide.scm +++ b/src/guile/skribilo/package/slide.scm @@ -16,7 +16,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. diff --git a/src/guile/skribilo/package/slide/html.scm b/src/guile/skribilo/package/slide/html.scm index 128b7e3..58348df 100644 --- a/src/guile/skribilo/package/slide/html.scm +++ b/src/guile/skribilo/package/slide/html.scm @@ -15,7 +15,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-skribe-module (skribilo package slide html) diff --git a/src/guile/skribilo/package/slide/latex.scm b/src/guile/skribilo/package/slide/latex.scm index 4105e74..e187d3c 100644 --- a/src/guile/skribilo/package/slide/latex.scm +++ b/src/guile/skribilo/package/slide/latex.scm @@ -15,7 +15,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-skribe-module (skribilo package slide latex) diff --git a/src/guile/skribilo/package/slide/lout.scm b/src/guile/skribilo/package/slide/lout.scm index c36c793..817d0ed 100644 --- a/src/guile/skribilo/package/slide/lout.scm +++ b/src/guile/skribilo/package/slide/lout.scm @@ -15,7 +15,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-skribe-module (skribilo package slide lout) diff --git a/src/guile/skribilo/package/web-book.scm b/src/guile/skribilo/package/web-book.scm index a954c7a..e52bdc3 100644 --- a/src/guile/skribilo/package/web-book.scm +++ b/src/guile/skribilo/package/web-book.scm @@ -35,10 +35,11 @@ (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) + (tr :bg (engine-custom e 'title-background) + (th (let ((text (bold "main page")) + (bg (engine-custom e 'background))) + (if bg (color :fg bg text) text)))) + (tr :bg (engine-custom e 'background) (td (apply table :width 100. :border 0 (tr (td :align 'left :valign 'top @@ -60,12 +61,13 @@ (define chapter-browsing (lambda (n e) (center - (table :width 97. :border 1 :frame 'box + (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) + (tr :bg (engine-custom e 'title-background) + (th (let ((title (bold (markup-option n :title))) + (bg (engine-custom e 'background))) + (if bg (color :fg title) title)))) + (tr :bg (engine-custom e 'background) (td (toc (handle n) :chapter #t :section #t :subsection #t))))))) ;*---------------------------------------------------------------------*/ @@ -79,10 +81,11 @@ (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) + (tr :bg (engine-custom e 'title-background) + (th (let ((text (bold (if chap "Chapters" "Sections"))) + (bg (engine-custom e 'background))) + (if bg (color :fg bg text) text)))) + (tr :bg (engine-custom e 'background) (td (if chap (toc (handle n) :chapter #t :section #f) (toc (handle n) :section #t :subsection #t))))))))) diff --git a/src/guile/skribilo/parameters.scm b/src/guile/skribilo/parameters.scm index 04517e7..5893851 100644 --- a/src/guile/skribilo/parameters.scm +++ b/src/guile/skribilo/parameters.scm @@ -15,7 +15,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo parameters) diff --git a/src/guile/skribilo/prog.scm b/src/guile/skribilo/prog.scm index 87b964b..6ef41ee 100644 --- a/src/guile/skribilo/prog.scm +++ b/src/guile/skribilo/prog.scm @@ -16,7 +16,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo prog) diff --git a/src/guile/skribilo/reader.scm b/src/guile/skribilo/reader.scm index 95e545b..871d92c 100644 --- a/src/guile/skribilo/reader.scm +++ b/src/guile/skribilo/reader.scm @@ -15,7 +15,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo reader) diff --git a/src/guile/skribilo/reader/outline.scm b/src/guile/skribilo/reader/outline.scm index 4b7d00d..09792f5 100644 --- a/src/guile/skribilo/reader/outline.scm +++ b/src/guile/skribilo/reader/outline.scm @@ -15,7 +15,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo reader outline) @@ -133,13 +133,13 @@ line or a line comment." (match:substring m 1) (match:suffix m) (lambda (body) `(bold ,body))))) - ("``(([^`]|[^'])+)''" . + ("``(([^`^'])+)''" . ,(lambda (m) (values (match:prefix m) (match:substring m 1) (match:suffix m) (lambda (body) `(q ,body))))) - ("`(([^`]|[^'])+)'" . + ("`(([^`^'])+)'" . ,(lambda (m) (values (match:prefix m) (match:substring m 1) diff --git a/src/guile/skribilo/reader/skribe.scm b/src/guile/skribilo/reader/skribe.scm index f92f13b..d3dbb5f 100644 --- a/src/guile/skribilo/reader/skribe.scm +++ b/src/guile/skribilo/reader/skribe.scm @@ -1,6 +1,6 @@ ;;; skribe.scm -- A reader for the Skribe syntax. ;;; -;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -15,12 +15,13 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo reader skribe) :use-module (skribilo reader) :use-module (ice-9 optargs) + :use-module (srfi srfi-1) ;; the Scheme reader composition framework :use-module ((system reader) #:renamer (symbol-prefix-proc 'r:)) @@ -46,6 +47,17 @@ the Skribe syntax." (error "make-skribe-reader: unsupported version" version) %skribe-reader)) +(define (make-colon-free-token-reader tr) + ;; Stolen from `guile-reader' 0.3. + "If token reader @var{tr} handles the @code{:} (colon) character, remove it +from its specification and return the new token reader." + (let* ((spec (r:token-reader-specification tr)) + (proc (r:token-reader-procedure tr))) + (r:make-token-reader (filter (lambda (chr) + (not (char=? chr #\:))) + spec) + proc))) + (define &sharp-reader ;; The reader for what comes after a `#' character. (let* ((dsssl-keyword-reader ;; keywords à la `#!key' @@ -65,18 +77,23 @@ the Skribe syntax." (let ((colon-keywords ;; keywords à la `:key' fashion (r:make-token-reader #\: (r:token-reader-procedure - (r:standard-token-reader 'keyword))))) + (r:standard-token-reader 'keyword)))) + (symbol-misc-chars-tr + ;; Make sure `:' is handled only by the keyword token reader. + (make-colon-free-token-reader + (r:standard-token-reader 'r6rs-symbol-misc-chars)))) + ;; Note: we use the `r6rs-symbol-*' and `r6rs-number' token readers since ;; they consider square brackets as delimiters. (r:make-reader (cons* (r:make-token-reader #\# &sharp-reader) colon-keywords + symbol-misc-chars-tr (map r:standard-token-reader `(whitespace sexp string r6rs-number r6rs-symbol-lower-case r6rs-symbol-upper-case - r6rs-symbol-misc-chars quote-quasiquote-unquote semicolon-comment skribe-exp))) diff --git a/src/guile/skribilo/resolve.scm b/src/guile/skribilo/resolve.scm index 34d6bde..224bc06 100644 --- a/src/guile/skribilo/resolve.scm +++ b/src/guile/skribilo/resolve.scm @@ -16,24 +16,70 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo resolve) :use-module (skribilo debug) - :use-module (skribilo runtime) :use-module (skribilo ast) :use-module (skribilo utils syntax) :use-module (oop goops) :use-module (srfi srfi-39) + :use-module (skribilo condition) + :use-module (srfi srfi-34) + :use-module (srfi srfi-35) + :export (resolve! resolve-search-parent resolve-children resolve-children* - find1 resolve-counter resolve-parent resolve-ident)) + find1 resolve-counter resolve-parent resolve-ident + + &resolution-error resolution-error? + &resolution-orphan-error resolution-orphan-error? + resolution-orphan-error:ast)) (fluid-set! current-reader %skribilo-module-reader) + +;;; +;;; Error conditions. +;;; + +(define-condition-type &resolution-error &skribilo-error + resolution-error?) + +(define-condition-type &resolution-orphan-error &resolution-error + resolution-orphan-error? + (ast resolution-orphan-error:ast)) + + +(define (handle-resolution-error c) + ;; Issue a user-friendly error message for error condition C. + (cond ((resolution-orphan-error? c) + (let* ((node (resolution-orphan-error:ast c)) + (location (and (ast? node) (ast-loc node)))) + (format (current-error-port) "orphan node: ~a~a~%" + node + (if (location? location) + (string-append " " + (location-file location) ":" + (location-line location)) + "")))) + + (else + (format (current-error-port) "undefined resolution error: ~a~%" + c)))) + +(register-error-condition-handler! resolution-error? + handle-resolution-error) + + + +;;; +;;; Resolving nodes. +;;; + (define *unresolved* (make-parameter #f)) (define-generic do-resolve!) @@ -81,7 +127,9 @@ (set-car! n* (do-resolve! (car n*) engine env)) (set-cdr! n* (do-resolve! (cdr n*) engine env))) (else - (error 'do-resolve "illegal argument" n*))))) + (raise (condition (&invalid-argument-error + (proc-name "do-resolve!<pair>") + (argument n*)))))))) (define-method (do-resolve! (node <node>) engine env) @@ -186,7 +234,7 @@ (cadr c) n))) ((eq? (slot-ref n 'parent) 'unspecified) - (skribe-error 'resolve-parent "orphan node" n)) + (raise (condition (&resolution-orphan-error (ast n))))) (else (slot-ref n 'parent))))) @@ -219,7 +267,7 @@ (let ((c (assq (symbol-append cnt '-counter) e))) (if (not (pair? c)) (if (or (null? opt) (not (car opt)) (null? e)) - (skribe-error cnt "orphan node" n) + (raise (condition (&resolution-orphan-error (ast n)))) (begin (set-cdr! (last-pair e) (list (list (symbol-append cnt '-counter) 0) @@ -252,10 +300,9 @@ (debug-item "markup=" markup) (debug-item "n=" (if (markup? n) (markup-markup n) n)) (if (not (string? ident)) - (skribe-type-error 'resolve-ident - "Illegal ident" - ident - "string") + (raise (condition (&invalid-argument-error ;; type error + (proc-name "resolve-ident") + (argument ident)))) (let ((mks (find-markups ident))) (and mks (if (not markup) diff --git a/src/guile/skribilo/skribe/Makefile.am b/src/guile/skribilo/skribe/Makefile.am index e005313..4b5797f 100644 --- a/src/guile/skribilo/skribe/Makefile.am +++ b/src/guile/skribilo/skribe/Makefile.am @@ -1,2 +1,2 @@ guilemoduledir = $(GUILE_SITE)/skribilo/skribe -dist_guilemodule_DATA = api.scm bib.scm index.scm param.scm sui.scm utils.scm +dist_guilemodule_DATA = param.scm sui.scm diff --git a/src/guile/skribilo/skribe/bib.scm b/src/guile/skribilo/skribe/bib.scm deleted file mode 100644 index 2bc2238..0000000 --- a/src/guile/skribilo/skribe/bib.scm +++ /dev/null @@ -1,215 +0,0 @@ -;;; lib.scm -;;; -;;; Copyright 2001, 2002, 2003, 2004 Manuel Serrano -;;; 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-skribe-module (skribilo skribe bib) - :use-module (skribilo biblio)) - -;;; Author: Manuel Serrano -;;; Commentary: -;;; -;;; A library of bibliography-related functions. -;;; -;;; Code: - - -;;; The contents of the file below are unchanged compared to Skribe 1.2d's -;;; `bib.scm' file found in the `common' directory. - -;*---------------------------------------------------------------------*/ -;* bib-load! ... */ -;*---------------------------------------------------------------------*/ -(define-public (bib-load! table filename command) - (if (not (bib-table? table)) - (skribe-error 'bib-load "Illegal bibliography table" table) - ;; read the file - (let ((p (skribe-open-bib-file filename command))) - (if (not (input-port? p)) - (skribe-error 'bib-load "Can't open data base" filename) - (unwind-protect - (parse-bib table p) - (close-input-port p)))))) - -;*---------------------------------------------------------------------*/ -;* resolve-bib ... */ -;*---------------------------------------------------------------------*/ -(define-public (resolve-bib table ident) - (if (not (bib-table? table)) - (skribe-error 'resolve-bib "Illegal bibliography table" table) - (let* ((i (cond - ((string? ident) ident) - ((symbol? ident) (symbol->string ident)) - (else (skribe-error 'resolve-bib "Illegal ident" ident)))) - (en (hashtable-get table i))) - (if (is-markup? en '&bib-entry) - en - #f)))) - -;*---------------------------------------------------------------------*/ -;* make-bib-entry ... */ -;*---------------------------------------------------------------------*/ -(define-public (make-bib-entry kind ident fields from) - (let* ((m (new markup - (markup '&bib-entry) - (ident ident) - (options `((kind ,kind) (from ,from))))) - (h (new handle - (ast m)))) - (for-each (lambda (f) - (if (and (pair? f) - (pair? (cdr f)) - (null? (cddr f)) - (symbol? (car f))) - (markup-option-add! m - (car f) - (new markup - (markup (symbol-append - '&bib-entry- - (car f))) - (parent h) - (body (cadr f)))) - (bib-parse-error f))) - fields) - m)) - -;*---------------------------------------------------------------------*/ -;* bib-sort/authors ... */ -;*---------------------------------------------------------------------*/ -(define-public (bib-sort/authors l) - (define (cmp i1 i2 def) - (cond - ((and (markup? i1) (markup? i2)) - (cmp (markup-body i1) (markup-body i2) def)) - ((markup? i1) - (cmp (markup-body i1) i2 def)) - ((markup? i2) - (cmp i1 (markup-body i2) def)) - ((and (string? i1) (string? i2)) - (if (string=? i1 i2) - (def) - (string<? i1 i2))) - ((string? i1) - #f) - ((string? i2) - #t) - (else - (def)))) - (sort l (lambda (e1 e2) - (cmp (markup-option e1 'author) - (markup-option e2 'author) - (lambda () - (cmp (markup-option e1 'year) - (markup-option e2 'year) - (lambda () - (cmp (markup-option e1 'title) - (markup-option e2 'title) - (lambda () - (cmp (markup-ident e1) - (markup-ident e2) - (lambda () - #t))))))))))) - -;*---------------------------------------------------------------------*/ -;* bib-sort/idents ... */ -;*---------------------------------------------------------------------*/ -(define-public (bib-sort/idents l) - (sort l (lambda (e f) (string<? (markup-ident e) (markup-ident f))))) - -;*---------------------------------------------------------------------*/ -;* bib-sort/dates ... */ -;*---------------------------------------------------------------------*/ -(define-public (bib-sort/dates l) - (sort l (lambda (p1 p2) - (define (month-num m) - (let ((body (markup-body m))) - (if (not (string? body)) - 13 - (let* ((s (if (> (string-length body) 3) - (substring body 0 3) - body)) - (sy (string->symbol (string-downcase body))) - (c (assq sy '((jan . 1) - (feb . 2) - (mar . 3) - (apr . 4) - (may . 5) - (jun . 6) - (jul . 7) - (aug . 8) - (sep . 9) - (oct . 10) - (nov . 11) - (dec . 12))))) - (if (pair? c) (cdr c) 13))))) - (let ((d1 (markup-option p1 'year)) - (d2 (markup-option p2 'year))) - (cond - ((not (markup? d1)) #f) - ((not (markup? d2)) #t) - (else - (let ((y1 (markup-body d1)) - (y2 (markup-body d2))) - (cond - ((string>? y1 y2) #t) - ((string<? y1 y2) #f) - (else - (let ((d1 (markup-option p1 'month)) - (d2 (markup-option p2 'month))) - (cond - ((not (markup? d1)) #f) - ((not (markup? d2)) #t) - (else - (let ((m1 (month-num d1)) - (m2 (month-num d2))) - (> m1 m2)))))))))))))) - -;*---------------------------------------------------------------------*/ -;* resolve-the-bib ... */ -;*---------------------------------------------------------------------*/ -(define-public (resolve-the-bib table n sort pred count opts) - (define (count! entries) - (let loop ((es entries) - (i 1)) - (if (pair? es) - (begin - (markup-option-add! (car es) - :title - (new markup - (markup '&bib-entry-ident) - (parent (car es)) - (options `((number ,i))) - (body (new handle - (ast (car es)))))) - (loop (cdr es) (+ i 1)))))) - (if (not (bib-table? table)) - (skribe-error 'resolve-the-bib "Illegal bibliography table" table) - (let* ((es (sort (hashtable->list table))) - (fes (filter (if (procedure? pred) - (lambda (m) (pred m n)) - (lambda (m) (pair? (markup-option m 'used)))) - es))) - (count! (if (eq? count 'full) es fes)) - (new markup - (markup '&the-bibliography) - (options opts) - (body fes))))) - - -;;; bib.scm ends here diff --git a/src/guile/skribilo/skribe/param.scm b/src/guile/skribilo/skribe/param.scm index 6aebd0a..2084b00 100644 --- a/src/guile/skribilo/skribe/param.scm +++ b/src/guile/skribilo/skribe/param.scm @@ -16,7 +16,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-skribe-module (skribilo skribe param)) diff --git a/src/guile/skribilo/skribe/sui.scm b/src/guile/skribilo/skribe/sui.scm index 9baa36a..333e794 100644 --- a/src/guile/skribilo/skribe/sui.scm +++ b/src/guile/skribilo/skribe/sui.scm @@ -16,7 +16,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-skribe-module (skribilo skribe sui)) diff --git a/src/guile/skribilo/skribe/utils.scm b/src/guile/skribilo/skribe/utils.scm deleted file mode 100644 index 9aaa81f..0000000 --- a/src/guile/skribilo/skribe/utils.scm +++ /dev/null @@ -1,259 +0,0 @@ -;;; utils.scm -;;; -;;; Copyright 2003, 2004 Manuel Serrano -;;; 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-skribe-module (skribilo skribe utils)) - -;;; Author: Manuel Serrano -;;; Commentary: -;;; -;;; A library of various utilities, including AST traversal helper functions. -;;; -;;; Code: - - -;;; The contents of the file below are unchanged compared to Skribe 1.2d's -;;; `lib.scm' file found in the `common' directory. - -;*---------------------------------------------------------------------*/ -;* engine-custom-add! ... */ -;*---------------------------------------------------------------------*/ -(define-public (engine-custom-add! e id val) - (let ((old (engine-custom e id))) - (if (unspecified? old) - (engine-custom-set! e id (list val)) - (engine-custom-set! e id (cons val old))))) - -;*---------------------------------------------------------------------*/ -;* find-markup-ident ... */ -;*---------------------------------------------------------------------*/ -(define-public (find-markup-ident ident) - (let ((r (find-markups ident))) - (if (or (pair? r) (null? r)) - r - '()))) - -;*---------------------------------------------------------------------*/ -;* container-search-down ... */ -;*---------------------------------------------------------------------*/ -(define-public (container-search-down pred obj) - (with-debug 4 'container-search-down - (debug-item "obj=" (find-runtime-type obj)) - (let loop ((obj (markup-body obj))) - (cond - ((pair? obj) - (apply append (map (lambda (o) (loop o)) obj))) - ((container? obj) - (let ((rest (loop (markup-body obj)))) - (if (pred obj) - (cons obj rest) - rest))) - ((pred obj) - (list obj)) - (else - '()))))) - -;*---------------------------------------------------------------------*/ -;* search-down ... */ -;*---------------------------------------------------------------------*/ -(define-public (search-down pred obj) - (with-debug 4 'search-down - (debug-item "obj=" (find-runtime-type obj)) - (let loop ((obj (markup-body obj))) - (cond - ((pair? obj) - (apply append (map (lambda (o) (loop o)) obj))) - ((markup? obj) - (let ((rest (loop (markup-body obj)))) - (if (pred obj) - (cons obj rest) - rest))) - ((pred obj) - (list obj)) - (else - '()))))) - -;*---------------------------------------------------------------------*/ -;* find-down ... */ -;*---------------------------------------------------------------------*/ -(define-public (find-down pred obj) - (with-debug 4 'find-down - (debug-item "obj=" (find-runtime-type obj)) - (let loop ((obj obj)) - (cond - ((pair? obj) - (apply append (map (lambda (o) (loop o)) obj))) - ((markup? obj) - (debug-item "loop=" (find-runtime-type obj) - " " (markup-ident obj)) - (if (pred obj) - (list (cons obj (loop (markup-body obj)))) - '())) - (else - (if (pred obj) - (list obj) - '())))))) - -;*---------------------------------------------------------------------*/ -;* find1-down ... */ -;*---------------------------------------------------------------------*/ -(define-public (find1-down pred obj) - (with-debug 4 'find1-down - (let loop ((obj obj) - (stack '())) - (debug-item "obj=" (find-runtime-type obj) - " " (if (markup? obj) (markup-markup obj) "???") - " " (if (markup? obj) (markup-ident obj) "")) - (cond - ((memq obj stack) - (skribe-error 'find1-down "Illegal cyclic object" obj)) - ((pair? obj) - (let liip ((obj obj)) - (cond - ((null? obj) - #f) - (else - (or (loop (car obj) (cons obj stack)) - (liip (cdr obj))))))) - ((pred obj) - obj) - ((markup? obj) - (loop (markup-body obj) (cons obj stack))) - (else - #f))))) - -;*---------------------------------------------------------------------*/ -;* find-up ... */ -;*---------------------------------------------------------------------*/ -(define-public (find-up pred obj) - (let loop ((obj obj) - (res '())) - (cond - ((not (ast? obj)) - res) - ((pred obj) - (loop (ast-parent obj) (cons obj res))) - (else - (loop (ast-parent obj) (cons obj res)))))) - -;*---------------------------------------------------------------------*/ -;* find1-up ... */ -;*---------------------------------------------------------------------*/ -(define-public (find1-up pred obj) - (let loop ((obj obj)) - (cond - ((not (ast? obj)) - #f) - ((pred obj) - obj) - (else - (loop (ast-parent obj)))))) - -;*---------------------------------------------------------------------*/ -;* ast-document ... */ -;*---------------------------------------------------------------------*/ -(define-public (ast-document m) - (find1-up document? m)) - -;*---------------------------------------------------------------------*/ -;* ast-chapter ... */ -;*---------------------------------------------------------------------*/ -(define-public (ast-chapter m) - (find1-up (lambda (n) (is-markup? n 'chapter)) m)) - -;*---------------------------------------------------------------------*/ -;* ast-section ... */ -;*---------------------------------------------------------------------*/ -(define-public (ast-section m) - (find1-up (lambda (n) (is-markup? n 'section)) m)) - -;*---------------------------------------------------------------------*/ -;* the-body ... */ -;* ------------------------------------------------------------- */ -;* Filter out the options */ -;*---------------------------------------------------------------------*/ -(define-public (the-body opt+) - (let loop ((opt* opt+) - (res '())) - (cond - ((null? opt*) - (reverse! res)) - ((not (pair? opt*)) - (skribe-error 'the-body "Illegal body" opt*)) - ((keyword? (car opt*)) - (if (null? (cdr opt*)) - (skribe-error 'the-body "Illegal option" (car opt*)) - (loop (cddr opt*) res))) - (else - (loop (cdr opt*) (cons (car opt*) res)))))) - -;*---------------------------------------------------------------------*/ -;* the-options ... */ -;* ------------------------------------------------------------- */ -;* Returns an list made of options. The OUT argument contains */ -;* keywords that are filtered out. */ -;*---------------------------------------------------------------------*/ -(define-public (the-options opt+ . out) - (let loop ((opt* opt+) - (res '())) - (cond - ((null? opt*) - (reverse! res)) - ((not (pair? opt*)) - (skribe-error 'the-options "Illegal options" opt*)) - ((keyword? (car opt*)) - (cond - ((null? (cdr opt*)) - (skribe-error 'the-options "Illegal option" (car opt*))) - ((memq (car opt*) out) - (loop (cdr opt*) res)) - (else - (loop (cdr opt*) - (cons (list (car opt*) (cadr opt*)) res))))) - (else - (loop (cdr opt*) res))))) - -;*---------------------------------------------------------------------*/ -;* list-split ... */ -;*---------------------------------------------------------------------*/ -(define-public (list-split l num . fill) - (let loop ((l l) - (i 0) - (acc '()) - (res '())) - (cond - ((null? l) - (reverse! (cons (if (or (null? fill) (= i num)) - (reverse! acc) - (append! (reverse! acc) - (make-list (- num i) (car fill)))) - res))) - ((= i num) - (loop l - 0 - '() - (cons (reverse! acc) res))) - (else - (loop (cdr l) - (+ i 1) - (cons (car l) acc) - res))))) - -;;; utils.scm ends here diff --git a/src/guile/skribilo/source.scm b/src/guile/skribilo/source.scm index 24e4b67..a61de4f 100644 --- a/src/guile/skribilo/source.scm +++ b/src/guile/skribilo/source.scm @@ -16,7 +16,7 @@ ;;;; ;;;; 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, +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;;; USA. ;;;; diff --git a/src/guile/skribilo/utils/Makefile.am b/src/guile/skribilo/utils/Makefile.am index fa693a1..9d9df6f 100644 --- a/src/guile/skribilo/utils/Makefile.am +++ b/src/guile/skribilo/utils/Makefile.am @@ -1,4 +1,5 @@ guilemoduledir = $(GUILE_SITE)/skribilo/utils -dist_guilemodule_DATA = syntax.scm compat.scm files.scm images.scm +dist_guilemodule_DATA = syntax.scm compat.scm files.scm images.scm \ + keywords.scm strings.scm ## arch-tag: 3a18b64b-1da2-417b-8338-2c534bca277f diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm index 24ce784..c8c3bd0 100644 --- a/src/guile/skribilo/utils/compat.scm +++ b/src/guile/skribilo/utils/compat.scm @@ -15,7 +15,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. @@ -32,6 +32,7 @@ :autoload (skribilo ast) (ast?) :autoload (skribilo condition) (file-search-error? &file-search-error) :autoload (skribilo reader) (make-reader) + :autoload (skribilo lib) (type-name) :use-module (skribilo debug) :re-export (file-size) ;; re-exported from `(skribilo utils files)' :replace (gensym)) @@ -169,7 +170,7 @@ (define-public skribe-eval-port evaluate-document-from-port) (set! %skribe-reader #f) -(define* (skribe-read #:optional (port (current-input-port))) +(define*-public (skribe-read #:optional (port (current-input-port))) (if (not %skribe-reader) (set! %skribe-reader (make-reader 'skribe))) (%skribe-reader port)) @@ -248,20 +249,11 @@ (hash-set! table key init-value) (set-cdr! handle (update-proc (cdr handle)))))) -(define-public hashtable->list (lambda (h) - (map cdr (hash-map->list cons h)))) +(define-public (hashtable->list h) + (hash-map->list (lambda (key val) val) h)) (define-public (find-runtime-type obj) - (cond ((string? obj) "string") - ((ast? obj) "ast") - ((list? obj) "list") - ((pair? obj) "pair") - ((number? obj) "number") - ((char? obj) "character") - ((keyword? obj) "keyword") - (else (with-output-to-string - (lambda () (write obj)))))) - + (type-name obj)) ;;; @@ -270,7 +262,17 @@ (use-modules ((srfi srfi-19) #:renamer (symbol-prefix-proc 's19:))) -(define (date) +(define-public (date) (s19:date->string (s19:current-date) "~c")) +(define-public (correct-arity? proc argcount) + (let ((a (procedure-property proc 'arity))) + (and (pair? a) + (let ((compulsory (car a)) + (optional (cadr a)) + (rest? (caddr a))) + (or rest? + (>= (+ compulsory optional) argcount)))))) + + ;;; compat.scm ends here diff --git a/src/guile/skribilo/utils/files.scm b/src/guile/skribilo/utils/files.scm index 7eb1cf2..6d89d4d 100644 --- a/src/guile/skribilo/utils/files.scm +++ b/src/guile/skribilo/utils/files.scm @@ -15,7 +15,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo utils files) diff --git a/src/guile/skribilo/utils/images.scm b/src/guile/skribilo/utils/images.scm index 2d163bc..24405d6 100644 --- a/src/guile/skribilo/utils/images.scm +++ b/src/guile/skribilo/utils/images.scm @@ -16,7 +16,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo utils images) diff --git a/src/guile/skribilo/utils/keywords.scm b/src/guile/skribilo/utils/keywords.scm new file mode 100644 index 0000000..1bcd5dc --- /dev/null +++ b/src/guile/skribilo/utils/keywords.scm @@ -0,0 +1,99 @@ +;;; keywords.scm -- Convenience procedures for keyword-argument handling. +;;; +;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2006 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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;; USA. + +(define-module (skribilo utils keywords) + :export (the-body the-options list-split)) + +;;; Author: Manuel Serrano, Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; This module provides convenience functions to handle keyword arguments. +;;; These are typically used by markup functions. +;;; +;;; Code: + +(define (the-body opt+) + ;; Filter out the keyword arguments from OPT+. + (let loop ((opt* opt+) + (res '())) + (cond + ((null? opt*) + (reverse! res)) + ((not (pair? opt*)) + (skribe-error 'the-body "Illegal body" opt*)) + ((keyword? (car opt*)) + (if (null? (cdr opt*)) + (skribe-error 'the-body "Illegal option" (car opt*)) + (loop (cddr opt*) res))) + (else + (loop (cdr opt*) (cons (car opt*) res)))))) + +(define (the-options opt+ . out) + ;; Return a list made of keyword arguments (i.e., each time, a keyword + ;; followed by its associated value). The OUT argument should be a list + ;; containing keyword argument names to be filtered out (e.g., + ;; `(#:ident)'). + (let loop ((opt* opt+) + (res '())) + (cond + ((null? opt*) + (reverse! res)) + ((not (pair? opt*)) + (skribe-error 'the-options "Illegal options" opt*)) + ((keyword? (car opt*)) + (cond + ((null? (cdr opt*)) + (skribe-error 'the-options "Illegal option" (car opt*))) + ((memq (car opt*) out) + (loop (cdr opt*) res)) + (else + (loop (cdr opt*) + (cons (list (car opt*) (cadr opt*)) res))))) + (else + (loop (cdr opt*) res))))) + +(define (list-split l num . fill) + (let loop ((l l) + (i 0) + (acc '()) + (res '())) + (cond + ((null? l) + (reverse! (cons (if (or (null? fill) (= i num)) + (reverse! acc) + (append! (reverse! acc) + (make-list (- num i) (car fill)))) + res))) + ((= i num) + (loop l + 0 + '() + (cons (reverse! acc) res))) + (else + (loop (cdr l) + (+ i 1) + (cons (car l) acc) + res))))) + +;;; arch-tag: 3e9066d5-6d7d-4da5-922b-cc3d4ba8476e + +;;; keywords.scm ends here diff --git a/src/guile/skribilo/runtime.scm b/src/guile/skribilo/utils/strings.scm index 73d776c..e8e8f8f 100644 --- a/src/guile/skribilo/runtime.scm +++ b/src/guile/skribilo/utils/strings.scm @@ -1,4 +1,4 @@ -;;; runtime.scm -- Skribilo runtime system +;;; strings.scm -- Convenience functions to manipulate strings. ;;; ;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> ;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr> @@ -15,31 +15,24 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-module (skribilo runtime) - ;; FIXME: Useful procedures are scattered between here and - ;; `(skribilo skribe utils)'. - :export (;; Utilities - strip-ref-base string-canonicalize - - ;; String writing +(define-module (skribilo utils strings) + :export (strip-ref-base string-canonicalize make-string-replace) :autoload (skribilo parameters) (*ref-base*) :use-module (skribilo lib) :use-module (srfi srfi-13)) - -;;; ====================================================================== + ;;; -;;; U T I L I T I E S +;;; Utilities. ;;; -;;; ====================================================================== - -;;FIXME: Remonter cette fonction (define (strip-ref-base file) + ;; Given FILE, a file path (a string), remove `(*ref-base*)' from it. + ;; This is useful, e.g., for hyperlinks. (if (not (string? (*ref-base*))) file (let ((l (string-length (*ref-base*)))) @@ -54,8 +47,9 @@ (substring file (+ l 1) (string-length file))))))) -;; FIXME: Remonter cette fonction (define (string-canonicalize old) + ;; Return a string that is a canonical summarized representation of string + ;; OLD. This is a one-way function. (let* ((l (string-length old)) (new (make-string l))) (let loop ((r 0) @@ -88,11 +82,10 @@ -;;; ====================================================================== + ;;; -;;; S T R I N G - W R I T I N G +;;; String writing. ;;; -;;; ====================================================================== ;; ;; (define (%make-html-replace) @@ -136,17 +129,17 @@ str) (get-output-string out))))) -(define string->html - (%make-general-string-replace '((#\" """) (#\& "&") (#\< "<") - (#\> ">")))) +(define %html-replacements + '((#\" """) (#\& "&") (#\< "<") (#\> ">"))) + +(define %string->html + (%make-general-string-replace %html-replacements)) (define (make-string-replace lst) (let ((l (sort lst (lambda (r1 r2) (char<? (car r1) (car r2)))))) (cond - ((equal? l '((#\" """) (#\& "&") (#\< "<") (#\> ">"))) - string->html) + ((equal? l %html-replacements) + %string->html) (else (%make-general-string-replace lst))))) - - diff --git a/src/guile/skribilo/utils/syntax.scm b/src/guile/skribilo/utils/syntax.scm index f7a5990..44bff09 100644 --- a/src/guile/skribilo/utils/syntax.scm +++ b/src/guile/skribilo/utils/syntax.scm @@ -1,6 +1,6 @@ ;;; syntax.scm -- Syntactic candy for Skribilo modules. ;;; -;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -15,7 +15,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo utils syntax) @@ -30,21 +30,33 @@ ;;; ;;; Commentary: ;;; -;;; A reader for the Skribe syntax, i.e. roughly R5RS Scheme plus DSSSL-style -;;; keywords and sk-exps (expressions introduced using a square bracket). +;;; This module provides syntactic candy for Skribilo modules, i.e., a syntax +;;; similar to Guile's default syntax with a few extensions, plus various +;;; convenience macros. ;;; ;;; Code: (define %skribilo-module-reader ;; The syntax used to read Skribilo modules. - (make-alternate-guile-reader '(colon-keywords - no-scsh-block-comments - srfi30-block-comments - srfi62-sexp-comments) - (lambda (chr port read) - (error "unexpected character in Skribilo module" - chr)) - 'reader/record-positions)) + (apply make-alternate-guile-reader + '(colon-keywords no-scsh-block-comments + srfi30-block-comments srfi62-sexp-comments) + (lambda (chr port read) + (let ((file (port-filename port)) + (line (port-line port)) + (column (port-column port))) + (error (string-append + (if (string? file) + (format #f "~a:~a:~a: " file line column) + "") + "unexpected character in Skribilo module") + chr))) + + ;; By default, don't record positions: this yields a nice read + ;; performance improvement. + (if (memq 'debug (debug-options)) + (list 'reader/record-positions) + '()))) (define %skribe-reader ;; The Skribe syntax reader. diff --git a/src/guile/skribilo/verify.scm b/src/guile/skribilo/verify.scm index 960ca6b..052b5cc 100644 --- a/src/guile/skribilo/verify.scm +++ b/src/guile/skribilo/verify.scm @@ -16,18 +16,17 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo verify) - :autoload (skribilo engine) (engine-ident) + :autoload (skribilo engine) (engine-ident processor-get-engine) :autoload (skribilo writer) (writer? writer-options lookup-markup-writer) :autoload (skribilo lib) (skribe-warning/ast skribe-warning skribe-error) :export (verify)) (use-modules (skribilo debug) - (skribilo runtime) (skribilo ast) (skribilo utils syntax) (oop goops)) diff --git a/src/guile/skribilo/writer.scm b/src/guile/skribilo/writer.scm index b46cddc..b16819d 100644 --- a/src/guile/skribilo/writer.scm +++ b/src/guile/skribilo/writer.scm @@ -16,7 +16,7 @@ ;;; ;;; 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, +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. (define-module (skribilo writer) diff --git a/src/skribilo.in b/src/skribilo.in index 7d3a78d..8d49f84 100755 --- a/src/skribilo.in +++ b/src/skribilo.in @@ -15,7 +15,7 @@ # # 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, +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, # USA. # The `skribilo' executable. @@ -26,10 +26,13 @@ # `--debug' had not been passed, not displaying a stack trace. See # http://lists.gnu.org/archive/html/guile-devel/2006-01/msg00022.html # for details. +# +# In any case, don't pass `--debug' by default (for performance +# reason). When needed, the use should explicitly set the `GUILE' +# environment variable to, e.g., "guile --debug". main='(module-ref (resolve-module '\''(skribilo)) '\'main')' -exec ${GUILE-@GUILE@} --debug \ - -c " +exec ${GUILE-@GUILE@} -c " (use-modules (skribilo condition)) (call-with-skribilo-error-catch diff --git a/tools/skribebibtex/stklos/bibtex-lex.l b/tools/skribebibtex/stklos/bibtex-lex.l index 03b4871..fa43b69 100644 --- a/tools/skribebibtex/stklos/bibtex-lex.l +++ b/tools/skribebibtex/stklos/bibtex-lex.l @@ -16,7 +16,7 @@ ;;;; ;;;; 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, +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;;; USA. ;;;; ;;;; Author: Erick Gallesio [eg@essi.fr] diff --git a/tools/skribebibtex/stklos/bibtex-parser.y b/tools/skribebibtex/stklos/bibtex-parser.y index 50236a9..77b619a 100644 --- a/tools/skribebibtex/stklos/bibtex-parser.y +++ b/tools/skribebibtex/stklos/bibtex-parser.y @@ -16,7 +16,7 @@ ;;;; ;;;; 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, +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;;; USA. ;;;; ;;;; Author: Erick Gallesio [eg@essi.fr] diff --git a/tools/skribebibtex/stklos/main.stk b/tools/skribebibtex/stklos/main.stk index 3225658..db1b031 100644 --- a/tools/skribebibtex/stklos/main.stk +++ b/tools/skribebibtex/stklos/main.stk @@ -16,7 +16,7 @@ ;;;; ;;;; 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, +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;;; USA. ;;;; ;;;; Author: Erick Gallesio [eg@essi.fr] |