aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Court`es2005-09-26 16:44:36 +0000
committerLudovic Court`es2005-09-26 16:44:36 +0000
commit914355d81a9134ae39b839828a9e8fe6b537bc5c (patch)
tree8a19b85eed59cd9902c1dc81fc7b6180ff65ef45
parent15456d415e58a5823700fe3198cf3916e917f2b9 (diff)
parent2d740bec3cc50480980d8aae3a06e27a5f0649e5 (diff)
downloadskribilo-914355d81a9134ae39b839828a9e8fe6b537bc5c.tar.gz
skribilo-914355d81a9134ae39b839828a9e8fe6b537bc5c.tar.lz
skribilo-914355d81a9134ae39b839828a9e8fe6b537bc5c.zip
Started relying on the per-module reader; first doc produced ever!
Patches applied: * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-2 Lots of changes, again. * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-3 Started relying on the per-module reader; first doc produced ever! git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-7
-rw-r--r--src/guile/README44
-rwxr-xr-xsrc/guile/skribilo.scm179
-rw-r--r--src/guile/skribilo/biblio.scm13
-rw-r--r--src/guile/skribilo/config.scm.in1
-rw-r--r--src/guile/skribilo/debug.scm3
-rw-r--r--src/guile/skribilo/engine.scm50
-rw-r--r--src/guile/skribilo/engine/base.scm (renamed from skr/base.skr)68
-rw-r--r--src/guile/skribilo/engine/context.scm (renamed from skr/context.skr)180
-rw-r--r--src/guile/skribilo/engine/html.scm (renamed from skr/html.skr)272
-rw-r--r--src/guile/skribilo/engine/html4.scm (renamed from skr/html4.skr)54
-rw-r--r--src/guile/skribilo/engine/latex-simple.scm (renamed from skr/latex-simple.skr)24
-rw-r--r--src/guile/skribilo/engine/latex.scm (renamed from skr/latex.skr)0
-rw-r--r--src/guile/skribilo/engine/xml.scm (renamed from skr/xml.skr)2
-rw-r--r--src/guile/skribilo/evaluator.scm (renamed from src/guile/skribilo/eval.scm)74
-rw-r--r--src/guile/skribilo/lib.scm85
-rw-r--r--src/guile/skribilo/module.scm148
-rw-r--r--src/guile/skribilo/output.scm29
-rw-r--r--src/guile/skribilo/reader.scm6
-rw-r--r--src/guile/skribilo/resolve.scm32
-rw-r--r--src/guile/skribilo/runtime.scm113
-rw-r--r--src/guile/skribilo/skribe/api.scm1
-rw-r--r--src/guile/skribilo/skribe/bib.scm1
-rw-r--r--src/guile/skribilo/skribe/utils.scm3
-rw-r--r--src/guile/skribilo/source.scm22
-rw-r--r--src/guile/skribilo/types.scm6
-rw-r--r--src/guile/skribilo/vars.scm8
-rw-r--r--src/guile/skribilo/verify.scm31
-rw-r--r--src/guile/skribilo/writer.scm97
28 files changed, 854 insertions, 692 deletions
diff --git a/src/guile/README b/src/guile/README
new file mode 100644
index 0000000..4bd7eff
--- /dev/null
+++ b/src/guile/README
@@ -0,0 +1,44 @@
+Skribilo -*- Outline -*-
+========
+
+Skribilo is a port of Skribe to GNU Guile.
+
+Here are a few goals.
+
+* Usability
+
+** Integration with Guile's module system
+
+** Better error handling, automatic back-traces, etc.
+
+** Add an option to continuously watch a file and re-compile it
+
+* Font-ends (readers)
+
+** Implement a new front-end mechanism (see `(skribilo reader)')
+
+** Skribe front-end (read Skribe syntax)
+
+** Texinfo front-end
+
+** Simple markup front-end (à la `txt2tags', Emacs' outline mode, or Wiki)
+
+* Back-ends (engines)
+
+** Easier to plug-in new back-ends (no need to modify the source)
+
+** Better HTML (or XHTML?) back-end
+
+** Lout back-end (including automatic `lout' invocation?)
+
+** Info back-end
+
+* Packages
+
+** Pie charts
+
+** Equations
+
+
+
+;;; arch-tag: 2d0a6235-5c09-4930-998c-56a4de2c0aca
diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm
index c352f7f..a43ec66 100755
--- a/src/guile/skribilo.scm
+++ b/src/guile/skribilo.scm
@@ -1,7 +1,7 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
main='(module-ref (resolve-module '\''(skribilo)) '\'main')'
-exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
+exec ${GUILE-guile} --debug -l $0 -c "(apply $main (cdr (command-line)))" "$@"
!#
;;;;
@@ -42,17 +42,11 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
;; Allow for this `:style' of keywords.
(read-set! keywords 'prefix)
-;; Allow for DSSSL-style keywords (i.e. `#!key', etc.).
-;; See http://lists.gnu.org/archive/html/guile-devel/2005-06/msg00060.html
-;; for details.
-(read-hash-extend #\! (lambda (chr port)
- (symbol->keyword (read port))))
-
(let ((gensym-orig gensym))
;; In Skribe, `gensym' expects a symbol as its (optional) argument, while
;; Guile's `gensym' expect a string. XXX
(set! gensym
- (lambda (. args)
+ (lambda args
(if (null? args)
(gensym-orig)
(let ((the-arg (car args)))
@@ -64,45 +58,25 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(skribe-error 'gensym "Invalid argument type"
the-arg))))))))
-; (use-modules (skribe eval)
-; (skribe configure)
-; (skribe runtime)
-; (skribe engine)
-; (skribe writer)
-; (skribe verify)
-; (skribe output)
-; (skribe biblio)
-; (skribe prog)
-; (skribe resolve)
-; (skribe source)
-; (skribe lisp)
-; (skribe xml)
-; (skribe c)
-; (skribe debug)
-; (skribe color))
-
-(use-modules (skribe runtime)
- (skribe configure)
- (skribe eval)
- (skribe engine)
- (skribe types) ;; because `new' is a macro and refers to classes
-
- (oop goops) ;; because `new' is a macro
- (ice-9 optargs)
- (ice-9 getopt-long))
+
+(define-module (skribilo))
+(use-modules (skribilo module)
+ (skribilo runtime)
+ (skribilo evaluator)
+ (skribilo types)
+ (skribilo engine)
+ (skribilo debug)
+ (skribilo vars)
+ (skribilo lib)
-(load "skribe/lib.scm")
+ (ice-9 optargs)
+ (ice-9 getopt-long))
-(load "../common/configure.scm")
-(load "../common/param.scm")
-(load "../common/lib.scm")
-(load "../common/sui.scm")
-(load "../common/index.scm")
-;; Markup definitions...
-(load "../common/api.scm")
+
+;;; FIXME: With my `#:reader' thing added to `define-module',
@@ -115,7 +89,7 @@ specifications."
,@(if alternate
`((single-char ,(string-ref alternate 0)))
'())
- (value #f)))
+ (value ,(if arg #t #f))))
(define (raw-options->getopt-long options)
"Converts @var{options} to a getopt-long-compatible representation."
@@ -130,9 +104,9 @@ specifications."
(("target" :alternate "t" :arg target
:help "sets the output format to <target>")
(set! engine (string->symbol target)))
- (("I" :arg path :help "adds <path> to Skribe path")
+ (("load-path" :alternate "I" :arg path :help "adds <path> to Skribe path")
(set! paths (cons path paths)))
- (("B" :arg path :help "adds <path> to bibliography path")
+ (("bib-path" :alternate "B" :arg path :help "adds <path> to bibliography path")
(skribe-bib-path-set! (cons path (skribe-bib-path))))
(("S" :arg path :help "adds <path> to source path")
(skribe-source-path-set! (cons path (skribe-source-path))))
@@ -247,7 +221,7 @@ Processes a Skribilo/Skribe source file and produces its output.
"))
(define (skribilo-show-version)
- (format #t "skribilo ~a~%" (skribe-release)))
+ (format #t "skribilo ~a~%" (skribilo-release)))
;;;; ======================================================================
;;;;
@@ -387,16 +361,20 @@ Processes a Skribilo/Skribe source file and produces its output.
;;;; S K R I B E
;;;;
;;;; ======================================================================
+; (define (doskribe)
+; (let ((e (find-engine *skribe-engine*)))
+; (if (and (engine? e) (pair? *skribe-precustom*))
+; (for-each (lambda (cv)
+; (engine-custom-set! e (car cv) (cdr cv)))
+; *skribe-precustom*))
+; (if (pair? *skribe-src*)
+; (for-each (lambda (f) (skribe-load f :engine *skribe-engine*))
+; *skribe-src*)
+; (skribe-eval-port (current-input-port) *skribe-engine*))))
+
(define (doskribe)
- (let ((e (find-engine *skribe-engine*)))
- (if (and (engine? e) (pair? *skribe-precustom*))
- (for-each (lambda (cv)
- (engine-custom-set! e (car cv) (cdr cv)))
- *skribe-precustom*))
- (if (pair? *skribe-src*)
- (for-each (lambda (f) (skribe-load f :engine *skribe-engine*))
- *skribe-src*)
- (skribe-eval-port (current-input-port) *skribe-engine*))))
+ (set-current-module (make-run-time-module))
+ (skribe-eval-port (current-input-port) *skribe-engine*))
;;;; ======================================================================
@@ -404,42 +382,87 @@ Processes a Skribilo/Skribe source file and produces its output.
;;;; M A I N
;;;;
;;;; ======================================================================
-(define (skribilo . args)
- (let* ((options (getopt-long (cons "skribilo" args) skribilo-options))
- (target (option-ref options 'target #f))
+(define-public (skribilo . args)
+ (let* ((options (getopt-long (cons "skribilo" args)
+ skribilo-options))
+ (engine (string->symbol
+ (option-ref options 'target "html")))
+ (debugging-level (option-ref options 'debug 0))
+ (load-path (option-ref options 'load-path "."))
+ (bib-path (option-ref options 'bib-path "."))
+ (preload '())
+ (variants '())
+
(help-wanted (option-ref options 'help #f))
(version-wanted (option-ref options 'version #f)))
+ ;; Set up the debugging infrastructure.
+ (debug-enable 'debug)
+ (debug-enable 'backtrace)
+ (debug-enable 'procnames)
+ (read-enable 'positions)
+
(cond (help-wanted (begin (skribilo-show-help) (exit 1)))
- (version-wanted (begin (skribilo-show-version) (exit 1)))
- (target (format #t "target set to `~a'~%" target)))
+ (version-wanted (begin (skribilo-show-version) (exit 1))))
+
+ ;; Parse the most important options.
+
+ (set! *skribe-engine* engine)
+
+ (set-skribe-debug! (string->number debugging-level))
+
+ (if (> (skribe-debug) 4)
+ (set! %load-hook
+ (lambda (file)
+ (format #t "~~ loading `~a'...~%" file))))
+
+ (set! %skribilo-load-path
+ (cons load-path %skribilo-load-path))
+ (set! %skribilo-bib-path
+ (cons bib-path %skribilo-bib-path))
+
+ (if (option-ref options 'verbose #f)
+ (set! *skribe-verbose* #t))
;; Load the user rc file
- (load-rc)
+ ;(load-rc)
;; Load the base file to bootstrap the system as well as the files
- ;; that are in the *skribe-preload* variable
- (skribe-load "base.skr" :engine 'base)
+ ;; that are in the PRELOAD variable.
+ (find-engine 'base)
(for-each (lambda (f)
(skribe-load f :engine *skribe-engine*))
- *skribe-preload*)
+ preload)
- ;; Load the specified variants
+ ;; Load the specified variants.
(for-each (lambda (x)
(skribe-load (format #f "~a.skr" x) :engine *skribe-engine*))
- (reverse! *skribe-variants*))
-
- ;; (if (string? *skribe-dest*)
- ;; (with-handler (lambda (kind loc msg)
- ;; (remove-file *skribe-dest*)
- ;; (error loc msg))
- ;; (with-output-to-file *skribe-dest* doskribe))
- ;; (doskribe))
- (if (string? *skribe-dest*)
- (with-output-to-file *skribe-dest* doskribe)
- (doskribe))))
-
-(display "skribilo loaded\n")
+ (reverse! variants))
+
+ (let ((files (option-ref options '() '())))
+
+ (if (> (length files) 2)
+ (error "you can specify at most one input file and one output file"
+ files))
+
+ (let* ((source-file (if (null? files) #f (car files)))
+ (dest-file (if (or (not source-file)
+ (null? (cdr files)))
+ #f
+ (cadr files)))
+ (do-it! (lambda ()
+ (if (string? dest-file)
+ (with-output-to-file dest-file doskribe)
+ (doskribe)))))
+
+ (if (and dest-file (file-exists? dest-file))
+ (delete-file dest-file))
+
+ (if source-file
+ (with-input-from-file source-file
+ do-it!)
+ (do-it!))))))
+
(define main skribilo)
diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm
index 0a4fc98..f3ddf97 100644
--- a/src/guile/skribilo/biblio.scm
+++ b/src/guile/skribilo/biblio.scm
@@ -27,10 +27,11 @@
(define-module (skribilo biblio)
- :use-module (skribilo runtime)
- :export (bib-tables? make-bib-table default-bib-table
- bib-load! resolve-bib resolve-the-bib
- bib-sort/authors bib-sort/idents bib-sort/dates))
+ :use-module (skribilo runtime)
+ :use-module (skribilo lib) ;; `when', `unless'
+ :use-module (skribilo vars)
+ :export (bib-table? make-bib-table default-bib-table
+ bib-add!))
(define *bib-table* #f)
@@ -50,7 +51,7 @@
(make-hash-table))
(define (bib-table? obj)
- (hashtable? obj))
+ (hash-table? obj))
(define (default-bib-table)
(unless *bib-table*
@@ -143,7 +144,7 @@
;;; ======================================================================
;; FIXME: Factoriser
(define (skribe-open-bib-file file command)
- (let ((path (find-path file *skribe-bib-path*)))
+ (let ((path (search-path *skribe-bib-path* file)))
(if (string? path)
(begin
(when (> *skribe-verbose* 0)
diff --git a/src/guile/skribilo/config.scm.in b/src/guile/skribilo/config.scm.in
index 6e40e7f..a5e3b7c 100644
--- a/src/guile/skribilo/config.scm.in
+++ b/src/guile/skribilo/config.scm.in
@@ -10,7 +10,6 @@
(define-public (skribilo-default-path) "@SKRIBILO_SKR_PATH@")
(define-public (skribilo-scheme) "guile")
-
;; Compatibility.
(define-public skribe-release skribilo-release)
diff --git a/src/guile/skribilo/debug.scm b/src/guile/skribilo/debug.scm
index 1a5478e..b880a66 100644
--- a/src/guile/skribilo/debug.scm
+++ b/src/guile/skribilo/debug.scm
@@ -73,8 +73,7 @@
(define (debug-color col . o)
(with-output-to-string
(if (and *skribe-debug-color*
- (equal? (getenv "TERM") "xterm")
- (interactive-port? *debug-port*))
+ (equal? (getenv "TERM") "xterm"))
(lambda ()
(format #t "[1;~Am" (+ 31 col))
(for-each display o)
diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm
index 9584f5e..1b39ec6 100644
--- a/src/guile/skribilo/engine.scm
+++ b/src/guile/skribilo/engine.scm
@@ -27,9 +27,10 @@
(define-module (skribilo engine)
:use-module (skribilo debug)
-; :use-module (skribilo eval)
+; :use-module (skribilo evaluator)
:use-module (skribilo writer)
:use-module (skribilo types)
+ :use-module (skribilo lib)
:use-module (oop goops)
:use-module (ice-9 optargs)
@@ -58,11 +59,14 @@
(define (default-engine-set! e)
- (if (not (engine? e))
- (skribe-error 'default-engine-set! "bad engine ~S" e))
- (set! *default-engine* e)
- (set! *default-engines* (cons e *default-engines*))
- e)
+ (with-debug 5 'default-engine-set!
+ (debug-item "engine=" e)
+
+ (if (not (engine? e))
+ (skribe-error 'default-engine-set! "bad engine ~S" e))
+ (set! *default-engine* e)
+ (set! *default-engines* (cons e *default-engines*))
+ e))
(define (push-default-engine e)
@@ -141,32 +145,22 @@
;;;
;;; FIND-ENGINE
;;;
-(define (%find-loaded-engine id version)
- (let loop ((es *engines*))
- (cond
- ((null? es) #f)
- ((eq? (slot-ref (car es) 'ident) id)
- (cond
- ((eq? version 'unspecified) (car es))
- ((eq? version (slot-ref (car es) 'version)) (car es))
- (else (Loop (cdr es)))))
- (else (loop (cdr es))))))
-
-(define* (find-engine id #:key (version 'unspecified))
- (with-debug 5 'find-engine
+(define* (lookup-engine id #:key (version 'unspecified))
+ "Look for an engine named @var{name} (a symbol) in the @code{(skribilo
+engine)} module hierarchy. If no such engine was found, an error is raised,
+otherwise the requested engine is returned."
+ (with-debug 5 'lookup-engine
(debug-item "id=" id " version=" version)
- (or (%find-loaded-engine id version)
- (let ((c (assq id *skribe-auto-load-alist*)))
- (debug-item "c=" c)
- (if (and c (string? (cdr c)))
- (begin
- (skribe-load (cdr c) :engine 'base)
- (%find-loaded-engine id version))
- #f)))))
+ (let* ((engine (symbol-append id '-engine))
+ (m (resolve-module `(skribilo engine ,id))))
+ (if (module-bound? m engine)
+ (module-ref m engine)
+ (error "no such engine" id)))))
-(define lookup-engine find-engine)
+(define (find-engine . args)
+ (false-if-exception (apply lookup-engine args)))
;;;
diff --git a/skr/base.skr b/src/guile/skribilo/engine/base.scm
index ec987ec..53d837d 100644
--- a/skr/base.skr
+++ b/src/guile/skribilo/engine/base.scm
@@ -9,6 +9,8 @@
;* BASE Skribe engine */
;*=====================================================================*/
+(define-skribe-module (skribilo engine base))
+
;*---------------------------------------------------------------------*/
;* base-engine ... */
;*---------------------------------------------------------------------*/
@@ -110,7 +112,7 @@
("Downarrow" "v")
("<=>" "<=>")
("<==>" "<==>")
- ;; Mathematical operators
+ ;; Mathematical operators
("asterisk" "*")
("angle" "<")
("and" "^;")
@@ -122,13 +124,13 @@
("mid" "|")
("langle" "<")
("rangle" ">")
- ;; LaTeX
+ ;; LaTeX
("circ" "o")
("top" "T")
("lhd" "<")
("rhd" ">")
("parallel" "||")))))
-
+
;*---------------------------------------------------------------------*/
;* mark ... */
;*---------------------------------------------------------------------*/
@@ -203,7 +205,7 @@
:before "["
:action (lambda (n e) (output (markup-option n :title) e))
:after "]")
-
+
;*---------------------------------------------------------------------*/
;* &bib-entry-body ... */
;*---------------------------------------------------------------------*/
@@ -220,11 +222,11 @@
(if (eq? (caar descr) 'or)
(let ((o1 (cadr (car descr))))
(if (markup-option n o1)
- (loop (cons o1 (cdr descr))
- pending
+ (loop (cons o1 (cdr descr))
+ pending
#t)
(let ((o2 (caddr (car descr))))
- (loop (cons o2 (cdr descr))
+ (loop (cons o2 (cdr descr))
pending
armed))))
(let ((o (markup-option n (cadr (car descr)))))
@@ -240,7 +242,7 @@
(loop (cdr descr) pending armed)))))
((symbol? (car descr))
(let ((o (markup-option n (car descr))))
- (if o
+ (if o
(begin
(if (and armed pending)
(output pending e))
@@ -250,7 +252,7 @@
((null? (cdr descr))
(output (car descr) e))
((string? (car descr))
- (loop (cdr descr)
+ (loop (cdr descr)
(if pending pending (car descr))
armed))
(else
@@ -260,26 +262,26 @@
(output-fields
(case (markup-option n 'kind)
((techreport)
- `(author " -- " (or title url documenturl) " -- "
+ `(author " -- " (or title url documenturl) " -- "
number ", " institution ", "
- address ", " month ", " year ", "
+ address ", " month ", " year ", "
("pp. " pages) "."))
((article)
- `(author " -- " (or title url documenturl) " -- "
+ `(author " -- " (or title url documenturl) " -- "
journal ", " volume "" ("(" number ")") ", "
address ", " month ", " year ", "
("pp. " pages) "."))
((inproceedings)
- `(author " -- " (or title url documenturl) " -- "
+ `(author " -- " (or title url documenturl) " -- "
booktitle ", " series ", " ("(" number ")") ", "
address ", " month ", " year ", "
("pp. " pages) "."))
((book)
- '(author " -- " (or title url documenturl) " -- "
+ '(author " -- " (or title url documenturl) " -- "
publisher ", " address
", " month ", " year ", " ("pp. " pages) "."))
((phdthesis)
- '(author " -- " (or title url documenturl) " -- " type ", "
+ '(author " -- " (or title url documenturl) " -- " type ", "
school ", " address
", " month ", " year"."))
((misc)
@@ -322,7 +324,7 @@
:action (lambda (n e)
(define (make-mark-entry n fst)
(let ((l (tr :class 'index-mark-entry
- (td :colspan 2 :align 'left
+ (td :colspan 2 :align 'left
(bold (it (sf n)))))))
(if fst
(list l)
@@ -330,13 +332,13 @@
(define (make-primary-entry n p)
(let* ((note (markup-option n :note))
(b (markup-body n))
- (c (if note
+ (c (if note
(list b
(it (list " (" note ")")))
b)))
- (when p
- (markup-option-add! b :text
- (list (markup-option b :text)
+ (when p
+ (markup-option-add! b :text
+ (list (markup-option b :text)
", p."))
(markup-option-add! b :page #t))
(tr :class 'index-primary-entry
@@ -347,7 +349,7 @@
(bb (markup-body b)))
(cond
((not (or bb (is-markup? b 'url-ref)))
- (skribe-error 'the-index
+ (skribe-error 'the-index
"Illegal entry"
b))
(note
@@ -355,13 +357,13 @@
(it (ref :class "the-index-secondary"
:handle bb
:page p
- :text (if p
+ :text (if p
(list note ", p.")
note)))
(it (ref :class "the-index-secondary"
:url (markup-option b :url)
:page p
- :text (if p
+ :text (if p
(list note ", p.")
note))))))
(tr :class 'index-secondary-entry
@@ -370,12 +372,12 @@
(else
(let ((r (if bb
(ref :class "the-index-secondary"
- :handle bb
- :page p
+ :handle bb
+ :page p
:text (if p " ..., p." " ..."))
(ref :class "the-index-secondary"
:url (markup-option b :url)
- :page p
+ :page p
:text (if p " ..., p." " ...")))))
(tr :class 'index-secondary-entry
(td :valign 'top :align 'right :width 1.)
@@ -387,11 +389,11 @@
((null? ie)
'())
((not (pair? (car ie)))
- (append (make-mark-entry (car ie) f)
+ (append (make-mark-entry (car ie) f)
(loop (cdr ie) #f)))
(else
(cons (make-primary-entry (caar ie) p)
- (append (map (lambda (x)
+ (append (map (lambda (x)
(make-secondary-entry x p))
(cdar ie))
(loop (cdr ie) #f)))))))
@@ -399,7 +401,7 @@
(let* ((l (length ie))
(w (/ 100. nc))
(iepc (let ((d (/ l nc)))
- (if (integer? d)
+ (if (integer? d)
(inexact->exact d)
(+ 1 (inexact->exact (truncate d))))))
(split (list-split ie iepc)))
@@ -417,13 +419,13 @@
((null? ie)
"")
((or (not (integer? nc)) (= nc 1))
- (table :width 100.
- :&skribe-eval-location loc
+ (table :width 100.
+ :&skribe-eval-location loc
:class "index-table"
(make-column ie pref)))
(else
(table :width 100.
- :&skribe-eval-location loc
+ :&skribe-eval-location loc
:class "index-table"
(make-sub-tables ie nc pref))))))
(output (skribe-eval t e) e))))
@@ -434,7 +436,7 @@
;* The index header is only useful for targets that support */
;* hyperlinks such as HTML. */
;*---------------------------------------------------------------------*/
-(markup-writer '&the-index-header
+(markup-writer '&the-index-header
:action (lambda (n e) #f))
;*---------------------------------------------------------------------*/
diff --git a/skr/context.skr b/src/guile/skribilo/engine/context.scm
index 5bc5316..48a069e 100644
--- a/skr/context.skr
+++ b/src/guile/skribilo/engine/context.scm
@@ -1,31 +1,33 @@
;;;;
;;;; context.skr -- ConTeXt mode for Skribe
-;;;;
+;;;;
;;;; Copyright © 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
-;;;;
-;;;;
+;;;;
+;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
-;;;;
+;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
-;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
-;;;;
+;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 23-Sep-2004 17:21 (eg)
;;;; Last file update: 3-Nov-2004 12:54 (eg)
;;;;
+(define-skribe-module (skribilo engine context))
+
;;;; ======================================================================
-;;;; context-customs ...
+;;;; context-customs ...
;;;; ======================================================================
(define context-customs
'((source-comment-color "#ffa600")
@@ -45,9 +47,9 @@
(document-style "book")))
;;;; ======================================================================
-;;;; context-encoding ...
+;;;; context-encoding ...
;;;; ======================================================================
-(define context-encoding
+(define context-encoding
'((#\# "\\type{#}")
(#\| "\\type{|}")
(#\{ "$\\{$")
@@ -65,16 +67,16 @@
(#\\ "$\\backslash$")))
;;;; ======================================================================
-;;;; context-pre-encoding ...
+;;;; context-pre-encoding ...
;;;; ======================================================================
-(define context-pre-encoding
+(define context-pre-encoding
(append '((#\space "~")
(#\~ "\\type{~}"))
context-encoding))
;;;; ======================================================================
-;;;; context-symbol-table ...
+;;;; context-symbol-table ...
;;;; ======================================================================
(define (context-symbol-table math)
`(("iexcl" "!`")
@@ -302,23 +304,23 @@
;;;; context-width
;;;; ======================================================================
(define (context-width width)
- (cond
- ((string? width)
+ (cond
+ ((string? width)
width)
((and (number? width) (inexact? width))
(string-append (number->string (/ width 100.)) "\\textwidth"))
- (else
+ (else
(string-append (number->string width) "pt"))))
;;;; ======================================================================
;;;; context-dim
;;;; ======================================================================
(define (context-dim dimension)
- (cond
- ((string? dimension)
+ (cond
+ ((string? dimension)
dimension)
((number? dimension)
- (string-append (number->string (inexact->exact (round dimension)))
+ (string-append (number->string (inexact->exact (round dimension)))
"pt"))))
;;;; ======================================================================
@@ -354,16 +356,16 @@
;; Color was never used before
(let ((name (symbol->string (gensym 'col))))
(hashtable-put! *skribe-context-color-table* spec name)
- (printf "\\definecolor[~A][~A]\n"
- name
+ (printf "\\definecolor[~A][~A]\n"
+ name
(skribe-color->context-color spec))))))
(skribe-get-used-colors))
(newline))
(define (skribe-declare-standard-colors engine)
- (for-each (lambda (x)
+ (for-each (lambda (x)
(skribe-use-color! (engine-custom engine x)))
- '(source-comment-color source-define-color source-module-color
+ '(source-comment-color source-define-color source-module-color
source-markup-color source-thread-color source-string-color
source-bracket-color source-type-color)))
@@ -375,7 +377,7 @@
c)))
;;;; ======================================================================
-;;;; context-engine ...
+;;;; context-engine ...
;;;; ======================================================================
(define context-engine
(default-engine-set!
@@ -388,7 +390,7 @@
:custom context-customs)))
;;;; ======================================================================
-;;;; document ...
+;;;; document ...
;;;; ======================================================================
(markup-writer 'document
:options '(:title :subtitle :author :ending :env)
@@ -400,13 +402,13 @@
(skribe-release) (date))
;; Make URLs active
(printf "\\setupinteraction[state=start]\n")
- ;; Choose the document font
- (printf "\\setupbodyfont[~a,~apt]\n" (engine-custom e 'font-type)
+ ;; Choose the document font
+ (printf "\\setupbodyfont[~a,~apt]\n" (engine-custom e 'font-type)
(engine-custom e 'font-size))
- ;; Color
+ ;; Color
(display "\\setupcolors[state=start]\n")
;; Load Style
- (printf "\\input skribe-context-~a.tex\n"
+ (printf "\\input skribe-context-~a.tex\n"
(engine-custom e 'document-style))
;; Insert User customization
(let ((s (engine-custom e 'user-style)))
@@ -414,15 +416,15 @@
;; Output used colors
(skribe-declare-standard-colors e)
(skribe-declare-used-colors)
-
+
(display "\\starttext\n\\StartTitlePage\n")
;; title
(let ((t (markup-option n :title)))
(when t
- (skribe-eval (new markup
- (markup '&context-title)
+ (skribe-eval (new markup
+ (markup '&context-title)
(body t)
- (options
+ (options
`((subtitle ,(markup-option n :subtitle)))))
e
:env `((parent ,n)))))
@@ -431,7 +433,7 @@
(when a
(if (list? a)
;; List of authors. Use multi-columns
- (begin
+ (begin
(printf "\\defineparagraphs[Authors][n=~A]\n" (length a))
(display "\\startAuthors\n")
(let Loop ((l a))
@@ -477,17 +479,17 @@
(url (markup-option n :url))
(address (markup-option n :address))
(phone (markup-option n :phone))
- (out (lambda (n)
- (output n e)
+ (out (lambda (n)
+ (output n e)
(display "\\\\\n"))))
(display "{\\midaligned{")
- (when name (out name))
- (when title (out title))
- (when affiliation (out affiliation))
+ (when name (out name))
+ (when title (out title))
+ (when affiliation (out affiliation))
(when (pair? address) (for-each out address))
- (when phone (out phone))
- (when email (out email))
- (when url (out url))
+ (when phone (out phone))
+ (when email (out email))
+ (when url (out url))
(display "}}\n"))))
@@ -556,15 +558,15 @@
;;;; ======================================================================
;;;; hrule ...
;;;; ======================================================================
-(markup-writer 'hrule
+(markup-writer 'hrule
:options '(:width :height)
:before (lambda (n e)
- (printf "\\blackrule[width=~A,height=~A]\n"
+ (printf "\\blackrule[width=~A,height=~A]\n"
(context-width (markup-option n :width))
(context-dim (markup-option n :height)))))
-
+
;;;; ======================================================================
-;;;; color ...
+;;;; color ...
;;;; ======================================================================
(markup-writer 'color
:options '(:bg :fg :width :margin :border)
@@ -584,12 +586,12 @@
(when m
(printf ",offset=~A" (context-width m)))
(when bg
- (printf ",background=color,backgroundcolor=~A"
+ (printf ",background=color,backgroundcolor=~A"
(skribe-get-color bg)))
(when fg
- (printf ",foregroundcolor=~A"
+ (printf ",foregroundcolor=~A"
(skribe-get-color fg)))
- (when c
+ (when c
(display ",framecorner=round"))
(printf "]\n"))
;; Probably just a foreground was specified
@@ -620,7 +622,7 @@
"fit"))
(printf ",rulethickness=~A" (context-dim b))
(printf ",offset=~A" (context-width m))
- (when c
+ (when c
(display ",framecorner=round"))
(printf "]\n")))
:after "\\stopframedtext ")
@@ -630,7 +632,7 @@
;;;; ======================================================================
(markup-writer 'font
:options '(:size)
- :action (lambda (n e)
+ :action (lambda (n e)
(let* ((size (markup-option n :size))
(cs (engine-custom e 'font-size))
(ns (cond
@@ -643,7 +645,7 @@
((string? size)
(let ((nb (string->number size)))
(if (not (number? nb))
- (skribe-error
+ (skribe-error
'font
(format "Illegal font size ~s" size)
nb)
@@ -657,10 +659,10 @@
(printf "{\\switchtobodyfont[~apt]" ns)
(output (markup-body n) ne)
(display "}"))))
-
+
;;;; ======================================================================
-;;;; flush ...
+;;;; flush ...
;;;; ======================================================================
(markup-writer 'flush
:options '(:side)
@@ -711,7 +713,7 @@
:custom (engine-customs e))))
(output (markup-body n) ne)))
:after "\n\\stoplines\n}")
-
+
;;;; ======================================================================
;;;; itemize, enumerate ...
@@ -719,8 +721,8 @@
(define (context-itemization-action n e descr?)
(let ((symbol (markup-option n :symbol)))
(for-each (lambda (item)
- (if symbol
- (begin
+ (if symbol
+ (begin
(display "\\sym{")
(output symbol e)
(display "}"))
@@ -732,14 +734,14 @@
(markup-body n))))
(markup-writer 'itemize
- :options '(:symbol)
+ :options '(:symbol)
:before "\\startnarrower[left]\n\\startitemize[serried]\n"
:action (lambda (n e) (context-itemization-action n e #f))
:after "\\stopitemize\n\\stopnarrower\n")
(markup-writer 'enumerate
- :options '(:symbol)
+ :options '(:symbol)
:before "\\startnarrower[left]\n\\startitemize[n][standard]\n"
:action (lambda (n e) (context-itemization-action n e #f))
:after "\\stopitemize\n\\stopnarrower\n")
@@ -748,7 +750,7 @@
;;;; description ...
;;;; ======================================================================
(markup-writer 'description
- :options '(:symbol)
+ :options '(:symbol)
:before "\\startnarrower[left]\n\\startitemize[serried]\n"
:action (lambda (n e) (context-itemization-action n e #t))
:after "\\stopitemize\n\\stopnarrower\n")
@@ -757,7 +759,7 @@
;;;; item ...
;;;; ======================================================================
(markup-writer 'item
- :options '(:key)
+ :options '(:key)
:action (lambda (n e)
(let ((k (markup-option n :key)))
(when k
@@ -772,7 +774,7 @@
;; Output body
(output (markup-body n) e)
;; Terminate
- (when k
+ (when k
(display "\n\\stopnarrower\n")))))
;;;; ======================================================================
@@ -792,13 +794,13 @@
(let ((ident (markup-ident n))
(number (markup-option n :number))
(legend (markup-option n :legend)))
- (unless number
+ (unless number
(display "{\\setupcaptions[number=off]\n"))
(display "\\placefigure\n")
(printf " [~a]\n" (string-canonicalize ident))
(display " {") (output legend e) (display "}\n")
(display " {") (output (markup-body n) e) (display "}")
- (unless number
+ (unless number
(display "}\n")))))
;;;; ======================================================================
@@ -818,7 +820,7 @@
(printf "\n{\\bTABLE\n")
(printf "\\setupTABLE[")
(printf "width=~A" (if width (context-width width) "fit"))
- (when border
+ (when border
(printf ",rulethickness=~A" (context-dim border)))
(when cp
(printf ",offset=~A" (context-width cp)))
@@ -832,7 +834,7 @@
((cols) (display vert))
((all) (display hor) (display vert)))))
- (when frame
+ (when frame
;; hsides, vsides, lhs, rhs, box, border
(let ((top "\\setupTABLE[row][first][frame=off,topframe=on]\n")
(bot "\\setupTABLE[row][last][frame=off,bottomframe=on]\n")
@@ -845,8 +847,8 @@
((lhs) (display left))
((rhs) (display right))
((vsides) (display left) (diplay right))
- ((box border) (display top) (display bot)
- (display left) (display right)))))))
+ ((box border) (display top) (display bot)
+ (display left) (display right)))))))
:after (lambda (n e)
(printf "\\eTABLE}\n")))
@@ -862,7 +864,7 @@
(let ((bg (markup-option n :bg)))
(when bg
(printf "[background=color,backgroundcolor=~A]"
- (skribe-get-color bg)))))
+ (skribe-get-color bg)))))
:after "\\eTR\n")
@@ -871,7 +873,7 @@
;;;; ======================================================================
(markup-writer 'tc
:options '(:width :align :valign :colspan)
- :before (lambda (n e)
+ :before (lambda (n e)
(let ((th? (eq? 'th (markup-option n 'markup)))
(width (markup-option n :width))
(align (markup-option n :align))
@@ -882,13 +884,13 @@
(printf "\\bTD[")
(printf "width=~a" (if width (context-width width) "fit"))
(when valign
- ;; This is buggy. In fact valign an align can't be both
+ ;; This is buggy. In fact valign an align can't be both
;; specified in ConTeXt
(printf ",align=~a" (case valign
((center) 'lohi)
((bottom) 'low)
((top) 'high))))
- (when align
+ (when align
(printf ",align=~a" (case align
((left) 'right) ; !!!!
((right) 'left) ; !!!!
@@ -896,10 +898,10 @@
(unless (equal? colspan 1)
(printf ",nx=~a" colspan))
(display "]")
- (when th?
+ (when th?
;; This is a TH, output is bolded
(display "{\\bf{"))))
-
+
:after (lambda (n e)
(when (equal? (markup-option n 'markup) 'th)
;; This is a TH, output is bolded
@@ -919,8 +921,8 @@
(zoom (markup-option n :zoom))
(body (markup-body n))
(efmt (engine-custom e 'image-format))
- (img (or url (convert-image file
- (if (list? efmt)
+ (img (or url (convert-image file
+ (if (list? efmt)
efmt
'("jpg"))))))
(if (not (string? img))
@@ -977,7 +979,7 @@
:action (lambda (n e)
(let ((text (markup-option n :text))
(url (markup-body n)))
- (when (pair? url)
+ (when (pair? url)
(context-url (format "mailto:~A" (car url))
(or text
(car url))
@@ -987,24 +989,24 @@
;;;; ======================================================================
(markup-writer 'mark
:before (lambda (n e)
- (printf "\\reference[~a]{}\n"
+ (printf "\\reference[~a]{}\n"
(string-canonicalize (markup-ident n)))))
;;;; ======================================================================
;;;; ref ...
;;;; ======================================================================
(markup-writer 'ref
- :options '(:text :chapter :section :subsection :subsubsection
+ :options '(:text :chapter :section :subsection :subsubsection
:figure :mark :handle :page)
:action (lambda (n e)
(let* ((text (markup-option n :text))
(page (markup-option n :page))
(c (handle-ast (markup-body n)))
(id (markup-ident c)))
- (cond
+ (cond
(page ;; Output the page only (this is a hack)
(when text (output text e))
- (printf "\\at[~a]"
+ (printf "\\at[~a]"
(string-canonicalize id)))
((or (markup-option n :chapter)
(markup-option n :section)
@@ -1041,7 +1043,7 @@
(markup-writer 'bib-ref+
:options '(:text :bib)
:before (lambda (n e) (output "[" e))
- :action (lambda (n e)
+ :action (lambda (n e)
(let loop ((rs (markup-body n)))
(cond
((null? rs)
@@ -1063,7 +1065,7 @@
;;;; ======================================================================
(markup-writer 'url-ref
:options '(:url :text)
- :action (lambda (n e)
+ :action (lambda (n e)
(context-url (markup-option n :url) (markup-option n :text) e)))
;;//;*---------------------------------------------------------------------*/
@@ -1138,13 +1140,13 @@
;;;; ======================================================================
(markup-writer '&the-index
:options '(:column)
- :action
+ :action
(lambda (n e)
(define (make-mark-entry n)
(display "\\blank[medium]\n{\\bf\\it\\tfc{")
(skribe-eval (bold n) e)
(display "}}\\crlf\n"))
-
+
(define (make-primary-entry n)
(let ((b (markup-body n)))
(markup-option-add! b :text (list (markup-option b :text) ", "))
@@ -1192,7 +1194,7 @@
(color :fg cc n1)
n1)))
(skribe-eval n2 e))))
-
+
;;;; ======================================================================
;;;; &source-line-comment ...
;;;; ======================================================================
@@ -1204,7 +1206,7 @@
(color :fg cc n1)
n1)))
(skribe-eval n2 e))))
-
+
;;;; ======================================================================
;;;; &source-keyword ...
;;;; ======================================================================
@@ -1335,7 +1337,7 @@
;;;; ======================================================================
-;;;; Context Only Markups
+;;;; Context Only Markups
;;;; ======================================================================
;;;
@@ -1363,7 +1365,7 @@
;;;
;;; ConTeXt and TeX
-;;;
+;;;
(define-markup (ConTeXt #!key (space #t))
(if (engine-format? "context")
(! (if space "\\CONTEXT\\ " "\\CONTEXT"))
diff --git a/skr/html.skr b/src/guile/skribilo/engine/html.scm
index 79186ca..c85f18f 100644
--- a/skr/html.skr
+++ b/src/guile/skribilo/engine/html.scm
@@ -16,61 +16,68 @@
;* @ref ../../doc/user/htmle.skb:ref@ */
;*=====================================================================*/
+(define-skribe-module (skribilo engine html)
+ #:use-module ((srfi srfi-19) :renamer (symbol-prefix-proc 's19:)))
+
+
+;; Keep a reference to the base engine.
+(define base-engine (find-engine 'base))
+
;*---------------------------------------------------------------------*/
;* html-file-default ... */
;*---------------------------------------------------------------------*/
(define html-file-default
;; Default implementation of the `file-name-proc' custom.
(let ((table '())
- (filename (gensym)))
+ (filename (tmpnam)))
(define (get-file-name base suf)
- (let* ((c (assoc base table))
- (n (if (pair? c)
- (let ((n (+ 1 (cdr c))))
- (set-cdr! c n)
- n)
- (begin
- (set! table (cons (cons base 1) table))
- 1))))
- (format "~a-~a.~a" base n suf)))
+ (let* ((c (assoc base table))
+ (n (if (pair? c)
+ (let ((n (+ 1 (cdr c))))
+ (set-cdr! c n)
+ n)
+ (begin
+ (set! table (cons (cons base 1) table))
+ 1))))
+ (format "~a-~a.~a" base n suf)))
(lambda (node e)
- (let ((f (markup-option node filename))
- (file (markup-option node :file)))
- (cond
- ((string? f)
- f)
- ((string? file)
- file)
- ((or file
- (and (is-markup? node 'chapter)
- (engine-custom e 'chapter-file))
- (and (is-markup? node 'section)
- (engine-custom e 'section-file))
- (and (is-markup? node 'subsection)
- (engine-custom e 'subsection-file))
- (and (is-markup? node 'subsubsection)
- (engine-custom e 'subsubsection-file)))
- (let* ((b (or (and (string? *skribe-dest*)
- (prefix *skribe-dest*))
- ""))
- (s (or (and (string? *skribe-dest*)
- (suffix *skribe-dest*))
- "html"))
- (nm (get-file-name b s)))
- (markup-option-add! node filename nm)
- nm))
- ((document? node)
- *skribe-dest*)
- (else
- (let ((p (ast-parent node)))
- (if (container? p)
- (let ((file (html-file p e)))
- (if (string? file)
- (begin
- (markup-option-add! node filename file)
- file)
- #f))
- #f))))))))
+ (let ((f (markup-option node filename))
+ (file (markup-option node :file)))
+ (cond
+ ((string? f)
+ f)
+ ((string? file)
+ file)
+ ((or file
+ (and (is-markup? node 'chapter)
+ (engine-custom e 'chapter-file))
+ (and (is-markup? node 'section)
+ (engine-custom e 'section-file))
+ (and (is-markup? node 'subsection)
+ (engine-custom e 'subsection-file))
+ (and (is-markup? node 'subsubsection)
+ (engine-custom e 'subsubsection-file)))
+ (let* ((b (or (and (string? *skribe-dest*)
+ (prefix *skribe-dest*))
+ ""))
+ (s (or (and (string? *skribe-dest*)
+ (suffix *skribe-dest*))
+ "html"))
+ (nm (get-file-name b s)))
+ (markup-option-add! node filename nm)
+ nm))
+ ((document? node)
+ *skribe-dest*)
+ (else
+ (let ((p (ast-parent node)))
+ (if (container? p)
+ (let ((file (html-file p e)))
+ (if (string? file)
+ (begin
+ (markup-option-add! node filename file)
+ file)
+ #f))
+ #f))))))))
;*---------------------------------------------------------------------*/
;* html-engine ... */
@@ -262,8 +269,8 @@
("yacute" "&#253;")
("thorn" "&#254;")
("ymul" "&#255;")
- ;; Greek
- ("Alpha" "&#913;")
+ ;; Greek
+ ("Alpha" "&#913;")
("Beta" "&#914;")
("Gamma" "&#915;")
("Delta" "&#916;")
@@ -339,7 +346,7 @@
("Downarrow" "&#8659;")
("<=>" "&#8660;")
("<==>" "&#8660;")
- ;; Mathematical operators
+ ;; Mathematical operators
("forall" "&#8704;")
("partial" "&#8706;")
("exists" "&#8707;")
@@ -387,13 +394,13 @@
("langle" "&#9001;")
("rangle" "&#9002;")
;; Misc
- ("loz" "&#9674;")
+ ("loz" "&#9674;")
("spades" "&#9824;")
("clubs" "&#9827;")
("hearts" "&#9829;")
("diams" "&#9830;")
("euro" "&#8464;")
- ;; LaTeX
+ ;; LaTeX
("dag" "dag")
("ddag" "ddag")
("circ" "o")
@@ -442,17 +449,17 @@
((string? n)
n)
((number? n)
- (if (procedure? proc)
+ (if (procedure? proc)
(proc n)
(number->string n)))
(else
"")))
(define (html-chapter-number c)
- (html-number (markup-option c :number)
+ (html-number (markup-option c :number)
(engine-custom e 'chapter-number->string)))
(define (html-section-number c)
(let ((p (ast-parent c))
- (s (html-number (markup-option c :number)
+ (s (html-number (markup-option c :number)
(engine-custom e 'section-number->string))))
(cond
((is-markup? p 'chapter)
@@ -461,7 +468,7 @@
(string-append s)))))
(define (html-subsection-number c)
(let ((p (ast-parent c))
- (s (html-number (markup-option c :number)
+ (s (html-number (markup-option c :number)
(engine-custom e 'subsection-number->string))))
(cond
((is-markup? p 'section)
@@ -470,7 +477,7 @@
(string-append "." s)))))
(define (html-subsubsection-number c)
(let ((p (ast-parent c))
- (s (html-number (markup-option c :number)
+ (s (html-number (markup-option c :number)
(engine-custom e 'subsubsection-number->string))))
(cond
((is-markup? p 'subsection)
@@ -497,7 +504,7 @@
(skribe-error 'html-container-number
"Not a container"
(markup-markup c))))))))
-
+
;*---------------------------------------------------------------------*/
;* html-counter ... */
;*---------------------------------------------------------------------*/
@@ -553,10 +560,10 @@
;* html-color-spec? ... */
;*---------------------------------------------------------------------*/
(define (html-color-spec? v)
- (and v
+ (and v
(not (unspecified? v))
(or (not (string? v)) (> (string-length v) 0))))
-
+
;*---------------------------------------------------------------------*/
;* document ... */
;*---------------------------------------------------------------------*/
@@ -599,7 +606,7 @@
;*---------------------------------------------------------------------*/
;* &html-body ... */
;*---------------------------------------------------------------------*/
-(markup-writer '&html-body
+(markup-writer '&html-body
:before (lambda (n e)
(let ((bg (engine-custom e 'background)))
(display "<body")
@@ -680,7 +687,7 @@
(let* ((ic (engine-custom e 'favicon))
(id (markup-ident n)))
(unless (string? id)
- (skribe-error '&html-generic-header
+ (skribe-error '&html-generic-header
(format "Illegal identifier `~a'" id)
n))
;; title
@@ -716,7 +723,7 @@
(ident (string-append id "-css"))
(body (let ((c (engine-custom e 'css)))
(if (string? c)
- (list c)
+ (list c)
c))))
e)
;; javascript
@@ -745,7 +752,7 @@
(for-each (lambda (css)
(printf " <link href=~s rel=\"stylesheet\" type=\"text/css\">\n" css))
css)))))
-
+
(markup-writer '&html-header-style
:before " <style type=\"text/css\">\n <!--\n"
:action (lambda (n e)
@@ -767,7 +774,7 @@
(for-each (lambda (css)
(let ((p (open-input-file css)))
(if (not (input-port? p))
- (skribe-error
+ (skribe-error
'html-css
"Can't open CSS file for input"
css)
@@ -780,7 +787,7 @@
(close-input-port p)))))
icss))))
:after " -->\n </style>\n")
-
+
(markup-writer '&html-header-javascript
:action (lambda (n e)
(when (engine-custom e 'javascript)
@@ -807,8 +814,8 @@
(for-each (lambda (s)
(printf "<script type=\"text/javascript\" src=\"~a\"></script>" s))
js))))
-
-
+
+
;*---------------------------------------------------------------------*/
;* &html-header ... */
;*---------------------------------------------------------------------*/
@@ -827,13 +834,20 @@
(let ((body (markup-body n)))
(if body
(output body #t)
- (skribe-eval [
-,(hrule)
-,(p :class "ending" (font :size -1 [
-This ,(sc "Html") page has been produced by
-,(ref :url (skribe-url) :text "Skribe").
-,(linebreak)
-Last update ,(it (date)).]))] e))))
+ (skribe-eval
+ (list (hrule)
+ (p :class "ending"
+ (font :size -1
+ (list "This HTML page was "
+ "produced by "
+ (ref :text "Skribilo"
+ :url (skribilo-url))
+ "."
+ (linebreak)
+ "Last update: "
+ (s19:date->string
+ (s19:current-date))))))
+ e))))
:after "</div>\n")
;*---------------------------------------------------------------------*/
@@ -894,8 +908,8 @@ Last update ,(it (date)).]))] e))))
(let loop ((fns footnotes))
(if (pair? fns)
(let ((fn (car fns)))
- (printf "<a name=\"footnote-~a\">"
- (string-canonicalize
+ (printf "<a name=\"footnote-~a\">"
+ (string-canonicalize
(container-ident fn)))
(printf "<sup><small>~a</small></sup></a>: "
(markup-option fn :number))
@@ -1109,12 +1123,12 @@ Last update ,(it (date)).]))] e))))
;; blank columns
(col level)
;; number
- (printf "<td valign=\"top\" align=\"left\">~a</td>"
+ (printf "<td valign=\"top\" align=\"left\">~a</td>"
(html-container-number c e))
;; title
(printf "<td colspan=\"~a\" width=\"100%\">"
(- 4 level))
- (printf "<a href=\"~a#~a\">"
+ (printf "<a href=\"~a#~a\">"
(if (string=? f *skribe-dest*)
""
(strip-ref-base (or f *skribe-dest* "")))
@@ -1139,8 +1153,8 @@ Last update ,(it (date)).]))] e))))
(handle-ast b)
b)))
(if (not (container? bb))
- (error 'toc
- "Illegal body (container expected)"
+ (error 'toc
+ "Illegal body (container expected)"
(if (markup? bb)
(markup-markup bb)
"???"))
@@ -1151,7 +1165,7 @@ Last update ,(it (date)).]))] e))))
(and ss (is-markup? x 'subsection))
(and s (is-markup? x 'section))
(and c (is-markup? x 'chapter))
- (markup-option n (symbol->keyword
+ (markup-option n (symbol->keyword
(markup-markup x))))))
(container-body bb))))
;; avoid to produce an empty table
@@ -1159,9 +1173,9 @@ Last update ,(it (date)).]))] e))))
(display "<table cellspacing=\"1\" cellpadding=\"1\" width=\"100%\"")
(html-class n)
(display ">\n<tbody>\n")
-
+
(for-each (lambda (n) (toc-entry n 0)) lst)
-
+
(display "</tbody>\n</table>\n")))))))
;*---------------------------------------------------------------------*/
@@ -1186,7 +1200,7 @@ Last update ,(it (date)).]))] e))))
(ident (string-append id "-footnote"))
(class (markup-class n))
(parent n)
- (body (reverse!
+ (body (reverse!
(container-env-get n 'footnote-env)))))
(page (new markup
(markup '&html-page)
@@ -1202,7 +1216,7 @@ Last update ,(it (date)).]))] e))))
(body (or (markup-option n :ending)
(let ((p (ast-document n)))
(and p (markup-option p :ending)))))))
- (body (new markup
+ (body (new markup
(markup '&html-body)
(ident (string-append id "-body"))
(class (markup-class n))
@@ -1231,17 +1245,17 @@ Last update ,(it (date)).]))] e))))
(ti (let* ((nb (html-container-number n e))
(tc (markup-option n :title))
(ti (if (document? p)
- (list (markup-option p :title)
+ (list (markup-option p :title)
(engine-custom e 'file-title-separator)
tc)
tc))
- (sep (engine-custom
+ (sep (engine-custom
e
- (symbol-append (markup-markup n)
+ (symbol-append (markup-markup n)
'-title-number-separator)))
(nti (and tc
(if (and nb (not (equal? nb "")))
- (list nb
+ (list nb
(if (unspecified? sep) ". " sep)
ti)
ti))))
@@ -1344,7 +1358,7 @@ Last update ,(it (date)).]))] e))))
;; on-file section writer
(markup-writer 'section
:options '(:title :html-title :number :toc :file :env)
- :predicate (lambda (n e)
+ :predicate (lambda (n e)
(or (markup-option n :file)
(engine-custom e 'section-file)))
:action &html-generic-subdocument)
@@ -1356,11 +1370,11 @@ Last update ,(it (date)).]))] e))))
:options '(:title :html-title :number :toc :env :file)
:before html-section-title
:after "</div>\n")
-
+
;; on-file subsection writer
(markup-writer 'section
:options '(:title :html-title :number :toc :file :env)
- :predicate (lambda (n e)
+ :predicate (lambda (n e)
(or (markup-option n :file)
(engine-custom e 'subsection-file)))
:action &html-generic-subdocument)
@@ -1376,7 +1390,7 @@ Last update ,(it (date)).]))] e))))
;; on-file subsection writer
(markup-writer 'section
:options '(:title :html-title :number :toc :file :env)
- :predicate (lambda (n e)
+ :predicate (lambda (n e)
(or (markup-option n :file)
(engine-custom e 'subsubsection-file)))
:action &html-generic-subdocument)
@@ -1384,7 +1398,7 @@ Last update ,(it (date)).]))] e))))
;*---------------------------------------------------------------------*/
;* paragraph ... */
;*---------------------------------------------------------------------*/
-(markup-writer 'paragraph
+(markup-writer 'paragraph
:before (lambda (n e)
(when (and (>= (skribe-debug) 2) (location? (ast-loc n)))
(printf "<span style=\"display: block; position: relative; left: -2cm; font-size: x-small; font-style: italic; color: ff8e1e;\">~a</span>"
@@ -1405,7 +1419,7 @@ Last update ,(it (date)).]))] e))))
;*---------------------------------------------------------------------*/
;* linebreak ... */
;*---------------------------------------------------------------------*/
-(markup-writer 'linebreak
+(markup-writer 'linebreak
:before (lambda (n e)
(display "<br")
(html-class n)
@@ -1414,14 +1428,14 @@ Last update ,(it (date)).]))] e))))
;*---------------------------------------------------------------------*/
;* hrule ... */
;*---------------------------------------------------------------------*/
-(markup-writer 'hrule
+(markup-writer 'hrule
:options '(:width :height)
:before (lambda (n e)
(let ((width (markup-option n :width))
(height (markup-option n :height)))
(display "<hr")
(html-class n)
- (if (< width 100)
+ (if (< width 100)
(printf " width=\"~a\"" (html-width width)))
(if (> height 1)
(printf " size=\"~a\"" height))
@@ -1432,7 +1446,7 @@ Last update ,(it (date)).]))] e))))
;*---------------------------------------------------------------------*/
(markup-writer 'color
:options '(:bg :fg :width :margin)
- :before (lambda (n e)
+ :before (lambda (n e)
(let ((m (markup-option n :margin))
(w (markup-option n :width))
(bg (markup-option n :bg))
@@ -1446,7 +1460,7 @@ Last update ,(it (date)).]))] e))))
(display "<td bgcolor=\"")
(output bg e)
(display "\">"))
- (when (html-color-spec? fg)
+ (when (html-color-spec? fg)
(display "<font color=\"")
(output fg e)
(display "\">"))))
@@ -1461,7 +1475,7 @@ Last update ,(it (date)).]))] e))))
;*---------------------------------------------------------------------*/
(markup-writer 'frame
:options '(:width :margin :border)
- :before (lambda (n e)
+ :before (lambda (n e)
(let ((m (markup-option n :margin))
(b (markup-option n :border))
(w (markup-option n :width)))
@@ -1478,7 +1492,7 @@ Last update ,(it (date)).]))] e))))
;*---------------------------------------------------------------------*/
(markup-writer 'font
:options '(:size :face)
- :before (lambda (n e)
+ :before (lambda (n e)
(let ((size (markup-option n :size))
(face (markup-option n :face)))
(when (and (number? size) (inexact? size))
@@ -1527,8 +1541,8 @@ Last update ,(it (date)).]))] e))))
(html-class n)
(display "width=\"100%\" cellpadding=\"0\" cellspacing=\"0\" border=\"0\"><tr><td align=\"right\">"))
(else
- (skribe-error 'flush
- "Illegal side"
+ (skribe-error 'flush
+ "Illegal side"
(markup-option n :side)))))
:after (lambda (n e)
(case (markup-option n :side)
@@ -1563,7 +1577,7 @@ Last update ,(it (date)).]))] e))))
;* itemize ... */
;*---------------------------------------------------------------------*/
(markup-writer 'itemize
- :options '(:symbol)
+ :options '(:symbol)
:before (html-markup-class "ul")
:action (lambda (n e)
(for-each (lambda (item)
@@ -1584,7 +1598,7 @@ Last update ,(it (date)).]))] e))))
;* enumerate ... */
;*---------------------------------------------------------------------*/
(markup-writer 'enumerate
- :options '(:symbol)
+ :options '(:symbol)
:before (html-markup-class "ol")
:action (lambda (n e)
(for-each (lambda (item)
@@ -1604,7 +1618,7 @@ Last update ,(it (date)).]))] e))))
;* description ... */
;*---------------------------------------------------------------------*/
(markup-writer 'description
- :options '(:symbol)
+ :options '(:symbol)
:before (html-markup-class "dl")
:action (lambda (n e)
(for-each (lambda (item)
@@ -1628,7 +1642,7 @@ Last update ,(it (date)).]))] e))))
;* item ... */
;*---------------------------------------------------------------------*/
(markup-writer 'item
- :options '(:key)
+ :options '(:key)
:action (lambda (n e)
(let ((k (markup-option n :key)))
(if k
@@ -1643,9 +1657,9 @@ Last update ,(it (date)).]))] e))))
;*---------------------------------------------------------------------*/
;* blockquote ... */
;*---------------------------------------------------------------------*/
-(markup-writer 'blockquote
+(markup-writer 'blockquote
:options '()
- :before (lambda (n e)
+ :before (lambda (n e)
(display "<blockquote ")
(html-class n)
(display ">\n"))
@@ -1679,17 +1693,17 @@ Last update ,(it (date)).]))] e))))
;*---------------------------------------------------------------------*/
;* &html-figure-legend ... */
;*---------------------------------------------------------------------*/
-(markup-writer '&html-figure-legend
+(markup-writer '&html-figure-legend
:options '(:number)
:before (lambda (n e)
(display "<center>")
(let ((number (markup-option n :number))
(legend (markup-option n :legend)))
- (if number
+ (if number
(printf "<strong>Fig. ~a:</strong> " number)
(printf "<strong>Fig. :</strong> "))))
:after "</center>")
-
+
;*---------------------------------------------------------------------*/
;* table ... */
;*---------------------------------------------------------------------*/
@@ -1719,7 +1733,7 @@ Last update ,(it (date)).]))] e))))
((number? cstyle)
(printf " style=\"border-collapse: separate; border-spacing=~apt\"" cstyle)))
(if frame
- (printf " frame=\"~a\""
+ (printf " frame=\"~a\""
(if (eq? frame 'none) "void" frame)))
(if (and rules (not (eq? rules 'header)))
(printf " rules=\"~a\"" rules))
@@ -1738,7 +1752,7 @@ Last update ,(it (date)).]))] e))))
(when (html-color-spec? bg) (printf " bgcolor=\"~a\"" bg))
(display ">")))
:after "</tr>\n")
-
+
;*---------------------------------------------------------------------*/
;* tc ... */
;*---------------------------------------------------------------------*/
@@ -1771,7 +1785,7 @@ Last update ,(it (date)).]))] e))))
:after (lambda (n e)
(let ((markup (or (markup-option n 'markup) 'td)))
(printf "</~a>" markup))))
-
+
;*---------------------------------------------------------------------*/
;* image ... @label image@ */
;*---------------------------------------------------------------------*/
@@ -1784,7 +1798,7 @@ Last update ,(it (date)).]))] e))))
(height (markup-option n :height))
(body (markup-body n))
(efmt (engine-custom e 'image-format))
- (img (or url (convert-image file
+ (img (or url (convert-image file
(if (list? efmt)
efmt
'("gif" "jpg" "png"))))))
@@ -1851,7 +1865,7 @@ Last update ,(it (date)).]))] e))))
;*---------------------------------------------------------------------*/
(markup-writer 'mailto
:options '(:text)
- :predicate (lambda (n e)
+ :predicate (lambda (n e)
(and (engine-custom e 'javascript)
(or (string? (markup-body n))
(and (pair? (markup-body n))
@@ -1926,7 +1940,7 @@ Last update ,(it (date)).]))] e))))
(markup '&html-section-ref)
(body (markup-body n)))
e))
-
+
((not m)
(output (new markup
(markup '&html-unmark-ref)
@@ -1939,7 +1953,7 @@ Last update ,(it (date)).]))] e))))
;*---------------------------------------------------------------------*/
;* &html-figure-ref ... */
;*---------------------------------------------------------------------*/
-(markup-writer '&html-figure-ref
+(markup-writer '&html-figure-ref
:action (lambda (n e)
(let ((c (handle-ast (markup-body n))))
(if (or (not (markup? c))
@@ -1950,7 +1964,7 @@ Last update ,(it (date)).]))] e))))
;*---------------------------------------------------------------------*/
;* &html-section-ref ... */
;*---------------------------------------------------------------------*/
-(markup-writer '&html-section-ref
+(markup-writer '&html-section-ref
:action (lambda (n e)
(let ((c (handle-ast (markup-body n))))
(if (not (markup? c))
@@ -1960,7 +1974,7 @@ Last update ,(it (date)).]))] e))))
;*---------------------------------------------------------------------*/
;* &html-unmark-ref ... */
;*---------------------------------------------------------------------*/
-(markup-writer '&html-unmark-ref
+(markup-writer '&html-unmark-ref
:action (lambda (n e)
(let ((c (handle-ast (markup-body n))))
(if (not (markup? c))
@@ -1971,8 +1985,8 @@ Last update ,(it (date)).]))] e))))
(let ((l (markup-option c :legend)))
(if l
(output t e)
- (display
- (string-canonicalize
+ (display
+ (string-canonicalize
(markup-ident c)))))))))))
;*---------------------------------------------------------------------*/
@@ -1990,7 +2004,7 @@ Last update ,(it (date)).]))] e))))
(markup-writer 'bib-ref+
:options '(:text :bib)
:before "["
- :action (lambda (n e)
+ :action (lambda (n e)
(let loop ((rs (markup-body n)))
(cond
((null? rs)
@@ -2032,7 +2046,7 @@ Last update ,(it (date)).]))] e))))
(display "\"")
(when class (printf " class=\"~a\"" class))
(display ">")))
- :action (lambda (n e)
+ :action (lambda (n e)
(let ((v (markup-option n :text)))
(output (or v (markup-option n :url)) e)))
:after "</a>")
@@ -2060,7 +2074,7 @@ Last update ,(it (date)).]))] e))))
:options '(:mark :handle)
:action (lambda (n e)
(error 'page-ref:html "Not implemented yet" n)))
-
+
;*---------------------------------------------------------------------*/
;* &bib-entry-label ... */
;*---------------------------------------------------------------------*/
@@ -2125,7 +2139,7 @@ Last update ,(it (date)).]))] e))))
(color :fg cc n1)
n1)))
(skribe-eval n2 e))))
-
+
;*---------------------------------------------------------------------*/
;* &source-line-comment ... */
;*---------------------------------------------------------------------*/
@@ -2137,7 +2151,7 @@ Last update ,(it (date)).]))] e))))
(color :fg cc n1)
n1)))
(skribe-eval n2 e))))
-
+
;*---------------------------------------------------------------------*/
;* &source-keyword ... */
;*---------------------------------------------------------------------*/
diff --git a/skr/html4.skr b/src/guile/skribilo/engine/html4.scm
index acb7068..614ca99 100644
--- a/skr/html4.skr
+++ b/src/guile/skribilo/engine/html4.scm
@@ -1,38 +1,40 @@
;;;;
;;;; html4.skr -- HTML 4.01 Engine
-;;;;
+;;;;
;;;; Copyright © 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
-;;;;
-;;;;
+;;;;
+;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
-;;;;
+;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
-;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
-;;;;
+;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 18-Feb-2004 11:58 (eg)
;;;; Last file update: 26-Feb-2004 21:09 (eg)
;;;;
+(define-skribe-module (skribilo engine html4))
+
(define (find-children node)
(define (flat l)
- (cond
+ (cond
((null? l) l)
((pair? l) (append (flat (car l))
(flat (cdr l))))
(else (list l))))
-
- (if (markup? node)
+
+ (if (markup? node)
(flat (markup-body node))
node))
@@ -45,9 +47,9 @@
(engine-custom-set! le 'html-variant "html4")
(engine-custom-set! le 'html4-logo "http://www.w3.org/Icons/valid-html401")
(engine-custom-set! le 'html4-validator "http://validator.w3.org/check/referer")
-
+
;;----------------------------------------------------------------------
- ;; &html-html ...
+ ;; &html-html ...
;;----------------------------------------------------------------------
(markup-writer '&html-html le
:before "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
@@ -55,21 +57,21 @@
:after "</html>")
;;----------------------------------------------------------------------
- ;; &html-ending
+ ;; &html-ending
;;----------------------------------------------------------------------
(let* ((img (engine-custom le 'html4-logo))
(url (engine-custom le 'html4-validator))
- (bottom (list (hrule)
+ (bottom (list (hrule)
(table :width 100.
(tr
(td :align 'left
(font :size -1 [
- This ,(sc "Html") page has been produced by
+ This ,(sc "Html") page has been produced by
,(ref :url (skribe-url) :text "Skribe").
,(linebreak)
Last update ,(it (date)).]))
(td :align 'right :valign 'top
- (ref :url url
+ (ref :url url
:text (image :url img :width 88 :height 31))))))))
(markup-writer '&html-ending le
:before "<div class=\"skribe-ending\">"
@@ -79,13 +81,13 @@
(output body #t)
(skribe-eval bottom e))))
:after "</div>\n"))
-
+
;;----------------------------------------------------------------------
;; color ...
;;----------------------------------------------------------------------
(markup-writer 'color le
:options '(:bg :fg :width :margin)
- :before (lambda (n e)
+ :before (lambda (n e)
(let ((m (markup-option n :margin))
(w (markup-option n :width))
(bg (markup-option n :bg))
@@ -106,27 +108,27 @@
:after (lambda (n e)
(when (markup-option n :fg)
(display "</span>"))
- (when (markup-option n :bg)
+ (when (markup-option n :bg)
(display "</td></tr>\n</tbody></table>"))))
-
+
;;----------------------------------------------------------------------
;; font ...
;;----------------------------------------------------------------------
(markup-writer 'font le
:options '(:size :face)
- :before (lambda (n e)
+ :before (lambda (n e)
(let ((face (markup-option n :face))
(size (let ((sz (markup-option n :size)))
(cond
((or (unspecified? sz) (not sz))
#f)
((and (number? sz) (or (inexact? sz) (negative? sz)))
- (format "~a%"
- (+ 100
+ (format "~a%"
+ (+ 100
(* 20 (inexact->exact (truncate sz))))))
((number? sz)
sz)
- (else
+ (else
(skribe-error 'font
(format "Illegal font size ~s" sz)
n))))))
@@ -153,8 +155,8 @@
;;----------------------------------------------------------------------
(markup-writer 'roman le
:before "<span style=\"font-family: serif\">"
- :after "</span>")
-
+ :after "</span>")
+
;;----------------------------------------------------------------------
;; table ...
;;----------------------------------------------------------------------
diff --git a/skr/latex-simple.skr b/src/guile/skribilo/engine/latex-simple.scm
index dd2eccb..638c158 100644
--- a/skr/latex-simple.skr
+++ b/src/guile/skribilo/engine/latex-simple.scm
@@ -1,5 +1,7 @@
+(define-skribe-module (skribilo engine latex-simple))
+
;;;
-;;; LES CUSTOMS SONT TROP SPECIFIQUES POUR LA DISTRIBS. NE DOIT PAS VIRER
+;;; LES CUSTOMS SONT TROP SPECIFIQUES POUR LA DISTRIBS. NE DOIT PAS VIRER
;;; CE FICHIER (sion simplifie il ne rest plus grand chose)
;;; Erick 27-10-04
;;;
@@ -24,7 +26,7 @@
"\\usepackage{epsfig}
\\usepackage{workshop}
\\conferenceinfo{Fifth Workshop on Scheme and Functional Programming.}
- {September 22, 2004, Snowbird, Utah, USA.}
+ {September 22, 2004, Snowbird, Utah, USA.}
\\CopyrightYear{2004}
\\CopyrightHolder{Damien Ciabrini}
\\renewcommand{\\ttdefault}{cmtt}
@@ -46,28 +48,28 @@
:options '(:text :bib)
:before "\\cite{"
:action (lambda (n e) (display (markup-option n :bib)))
- :after "}")
+ :after "}")
(markup-writer 'bib-ref+ le
:options '(:text :bib)
:before "\\cite{"
- :action (lambda (n e)
+ :action (lambda (n e)
(let loop ((bibs (markup-option n :bib)))
(if (pair? bibs)
- (begin
+ (begin
(display (car bibs))
(if (pair? (cdr bibs)) (display ", "))
(loop (cdr bibs))))))
:after "}")
(markup-writer '&the-bibliography le
- :action (lambda (n e)
+ :action (lambda (n e)
(print "\\bibliographystyle{abbrv}")
(display "\\bibliography{biblio}")))
-
+
; ACM-style for authors
(markup-writer '&latex-author le
:before (lambda (n e)
(let ((body (markup-body n)))
- (if (pair? body)
+ (if (pair? body)
(print "\\numberofauthors{" (length body) "}"))
(print "\\author{")))
:after "}\n")
@@ -80,9 +82,9 @@
(address (markup-option n :address))
(email (markup-option n :email)))
(define (row pre n post)
- (display pre)
+ (display pre)
(output n e)
- (display post)
+ (display post)
(display "\\\\\n"))
;; name
(if name (row "\\alignauthor " name ""))
@@ -97,5 +99,5 @@
:after "")
)
-(define (include-biblio)
+(define (include-biblio)
(the-bibliography))
diff --git a/skr/latex.skr b/src/guile/skribilo/engine/latex.scm
index bc20493..bc20493 100644
--- a/skr/latex.skr
+++ b/src/guile/skribilo/engine/latex.scm
diff --git a/skr/xml.skr b/src/guile/skribilo/engine/xml.scm
index 784b6f0..4f26d12 100644
--- a/skr/xml.skr
+++ b/src/guile/skribilo/engine/xml.scm
@@ -16,6 +16,8 @@
;* @ref ../../doc/user/xmle.skb:ref@ */
;*=====================================================================*/
+(define-skribe-module (skribilo engine xml))
+
;*---------------------------------------------------------------------*/
;* xml-engine ... */
;*---------------------------------------------------------------------*/
diff --git a/src/guile/skribilo/eval.scm b/src/guile/skribilo/evaluator.scm
index 8bae8ad..703186c 100644
--- a/src/guile/skribilo/eval.scm
+++ b/src/guile/skribilo/evaluator.scm
@@ -26,20 +26,26 @@
;; FIXME; On peut implémenter maintenant skribe-warning/node
-(define-module (skribilo eval)
+(define-module (skribilo evaluator)
:export (skribe-eval skribe-eval-port skribe-load skribe-load-options
- skribe-include
-
- run-time-module make-run-time-module))
+ skribe-include))
(use-modules (skribilo debug)
+ (skribilo reader)
(skribilo engine)
(skribilo verify)
(skribilo resolve)
(skribilo output)
- (ice-9 optargs))
+ (skribilo types)
+ (skribilo lib)
+ (skribilo vars)
+ (ice-9 optargs)
+ (oop goops))
+
+
+
(define *skribe-loaded* '()) ;; List of already loaded files
(define *skribe-load-options* '())
@@ -47,41 +53,7 @@
(eval expr (current-module)))
-(define *skribilo-user-module* #f)
-
-(define *skribilo-user-imports*
- '((srfi srfi-1)
- (oop goops)
- (skribilo module)
- (skribilo config)
- (skribilo vars)
- (skribilo runtime)
- (skribilo biblio)
- (skribilo lib)
- (skribilo resolve)))
-
-;;;
-;;; MAKE-RUN-TIME-MODULE
-;;;
-(define (make-run-time-module)
- "Return a new module that imports all the necessary bindings required for
-execution of Skribilo/Skribe code."
- (let ((the-module (make-module)))
- (for-each (lambda (iface)
- (module-use! the-module (resolve-module iface)))
- *skribilo-user-imports*)
- (set-module-name! the-module '(skribilo-user))
- the-module))
-
-;;;
-;;; RUN-TIME-MODULE
-;;;
-(define (run-time-module)
- "Return the default instance of a Skribilo/Skribe run-time module."
- (if (not *skribilo-user-module*)
- (set! *skribilo-user-module* (make-run-time-module)))
- *skribilo-user-module*)
;;;
;;; SKRIBE-EVAL
@@ -98,19 +70,20 @@ execution of Skribilo/Skribe code."
;;;
;;; SKRIBE-EVAL-PORT
;;;
-(define* (skribe-eval-port port engine #:key (env '()))
+(define* (skribe-eval-port port engine #:key (env '())
+ (reader %default-reader))
(with-debug 2 'skribe-eval-port
(debug-item "engine=" engine)
(let ((e (if (symbol? engine) (find-engine engine) engine)))
(debug-item "e=" e)
(if (not (is-a? e <engine>))
- (skribe-error 'skribe-eval-port "Cannot find engine" engine)
- (let loop ((exp (read port)))
+ (skribe-error 'skribe-eval-port "cannot find engine" engine)
+ (let loop ((exp (reader port)))
(with-debug 10 'skribe-eval-port
(debug-item "exp=" exp))
(unless (eof-object? exp)
(skribe-eval (%evaluate exp) e :env env)
- (loop (read port))))))))
+ (loop (reader port))))))))
;;;
;;; SKRIBE-LOAD
@@ -124,13 +97,14 @@ execution of Skribilo/Skribe code."
(with-debug 4 'skribe-load
(debug-item " engine=" engine)
(debug-item " path=" path)
- (debug-item " opt" opt)
+ (debug-item " opt=" opt)
(let* ((ei (cond
((not engine) *skribe-engine*)
((engine? engine) engine)
- ((not (symbol? engine)) (skribe-error 'skribe-load
- "Illegal engine" engine))
+ ((not (symbol? engine))
+ (skribe-error 'skribe-load
+ "Illegal engine" engine))
(else engine)))
(path (cond
((not path) (skribe-path))
@@ -138,14 +112,14 @@ execution of Skribilo/Skribe code."
((not (and (list? path) (every? string? path)))
(skribe-error 'skribe-load "Illegal path" path))
(else path)))
- (filep (find-path file path)))
+ (filep (search-path path file)))
(set! *skribe-load-options* opt)
(unless (and (string? filep) (file-exists? filep))
(skribe-error 'skribe-load
- (format "Cannot find ~S in path" file)
- *skribe-path*))
+ (string-append "cannot find `" file "' in path")
+ (skribe-path)))
;; Load this file if not already done
(unless (member filep *skribe-loaded*)
@@ -167,7 +141,7 @@ execution of Skribilo/Skribe code."
(unless (every string? path)
(skribe-error 'skribe-include "Illegal path" path))
- (let ((path (find-path file path)))
+ (let ((path (search-path path file)))
(unless (and (string? path) (file-exists? path))
(skribe-error 'skribe-load
(format "Cannot find ~S in path" file)
diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm
index 26b348a..ef8ef8d 100644
--- a/src/guile/skribilo/lib.scm
+++ b/src/guile/skribilo/lib.scm
@@ -32,6 +32,13 @@
skribe-warning skribe-warning/ast
skribe-message
+ ;; paths as lists of directories
+
+ %skribilo-load-path
+ %skribilo-image-path %skribilo-bib-path %skribilo-source-path
+
+ ;; compatibility
+
skribe-path skribe-path-set!
skribe-image-path skribe-image-path-set!
skribe-bib-path skribe-bib-path-set!
@@ -45,11 +52,13 @@
printf fprintf
any? every?
process-input-port process-output-port process-error-port
+ %procedure-arity
make-hashtable hashtable?
hashtable-get hashtable-put! hashtable-update!
hashtable->list
+ skribe-read
find-runtime-type)
:export-syntax (new define-markup define-simple-markup
@@ -58,6 +67,11 @@
;; for compatibility
unwind-protect unless when)
+ :use-module (skribilo config)
+ :use-module (skribilo types)
+ :use-module (skribilo reader)
+ :use-module (skribilo vars)
+
:use-module (srfi srfi-1)
:use-module (ice-9 optargs))
@@ -79,7 +93,7 @@
(define-macro (define-markup bindings . body)
;; This is just an `(ice-9 optargs)' kind of `lambda*', with DSSSL
;; keyword-style conversion enabled. However, using `(ice-9 optargs)', the
- ;; `#:rest' argument can only appear last which not what Skribe/DSSSL
+ ;; `#:rest' argument can only appear last, which is not what Skribe/DSSSL
;; expect, hence `fix-rest-arg'.
(define (fix-rest-arg args)
(let loop ((args args)
@@ -94,7 +108,7 @@
(let ((name (car bindings))
(opts (cdr bindings)))
- `(define* ,(cons name (fix-rest-arg opts)) ,@body)))
+ `(define*-public ,(cons name (fix-rest-arg opts)) ,@body)))
;;;
@@ -256,44 +270,34 @@
(Loop (cdr l))))))
-
+
;;; ======================================================================
;;;
;;; A C C E S S O R S
;;;
;;; ======================================================================
-;; SKRIBE-PATH
-(define (skribe-path) *skribe-path*)
-
-(define (skribe-path-set! path)
- (if (not (and (list? path) (every string? path)))
- (skribe-error 'skribe-path-set! "Illegal path" path)
- (set! *skribe-path* path)))
-
-;; SKRIBE-IMAGE-PATH
-(define (skribe-image-path) *skribe-image-path*)
-(define (skribe-image-path-set! path)
- (if (not (and (list? path) (every string? path)))
- (skribe-error 'skribe-image-path-set! "Illegal path" path)
- (set! *skribe-image-path* path)))
+(define %skribilo-load-path (list (skribilo-default-path) "."))
+(define %skribilo-image-path '("."))
+(define %skribilo-bib-path '("."))
+(define %skribilo-source-path '("."))
-;; SKRIBE-BIB-PATH
-(define (skribe-bib-path) *skribe-bib-path*)
+(define-macro (define-compatibility-accessors var oldname)
+ (let ((newname (symbol-append '%skribilo- var))
+ (setter (symbol-append oldname '-set!)))
+ `(begin
+ (define (,oldname) ,newname)
+ (define (,setter path)
+ (if (not (and (list? path) (every string? path)))
+ (skribe-error ',setter "illegal path" path)
+ (set! ,newname path))))))
-(define (skribe-bib-path-set! path)
- (if (not (and (list? path) (every string? path)))
- (skribe-error 'skribe-bib-path-set! "Illegal path" path)
- (set! *skribe-bib-path* path)))
+(define-compatibility-accessors load-path skribe-path)
+(define-compatibility-accessors image-path skribe-image-path)
+(define-compatibility-accessors bib-path skribe-bib-path)
+(define-compatibility-accessors source-path skribe-source-path)
-;; SKRBE-SOURCE-PATH
-(define (skribe-source-path) *skribe-source-path*)
-
-(define (skribe-source-path-set! path)
- (if (not (and (list? path) (every string? path)))
- (skribe-error 'skribe-source-path-set! "Illegal path" path)
- (set! *skribe-source-path* path)))
;;; ======================================================================
@@ -346,6 +350,19 @@
(define find-runtime-type (lambda (obj) obj))
+
+;;;
+;;; Various things.
+;;;
+
+(define %skribe-reader (make-reader 'skribe))
+
+(define* (skribe-read #:optional (port (current-input-port)))
+ (%skribe-reader port))
+
+(define (%procedure-arity proc)
+ (car (procedure-property proc 'arity)))
+
(define-macro (unwind-protect expr1 expr2)
;; This is no completely correct.
`(dynamic-wind
@@ -353,8 +370,8 @@
(lambda () ,expr1)
(lambda () ,expr2)))
-(define-macro (unless expr body)
- `(if (not ,expr) ,body))
+(define-macro (unless condition . exprs)
+ `(if (not ,condition) (begin ,@exprs)))
-(define-macro (when expr . exprs)
- `(if ,expr (begin ,@exprs)))
+(define-macro (when condition . exprs)
+ `(if ,condition (begin ,@exprs)))
diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm
index 4d29f31..854c50d 100644
--- a/src/guile/skribilo/module.scm
+++ b/src/guile/skribilo/module.scm
@@ -20,7 +20,9 @@
(define-module (skribilo module)
:use-module (skribilo reader)
- :use-module (skribilo eval)
+ :use-module (skribilo evaluator)
+ :use-module (skribilo debug)
+ :use-module (srfi srfi-1)
:use-module (ice-9 optargs))
;;; Author: Ludovic Courtès
@@ -35,44 +37,47 @@
;;;
;;; Code:
-(define-macro (define-skribe-module name)
+(define *skribilo-user-imports*
+ ;; List of modules that should be imported by any good Skribilo module.
+ '((srfi srfi-1) ;; lists
+ (srfi srfi-13) ;; strings
+ ;(srfi srfi-19) ;; date and time
+ (oop goops) ;; `make'
+ (ice-9 optargs) ;; `define*'
+
+ (skribilo module)
+ (skribilo types) ;; `<document>', `document?', etc.
+ (skribilo config)
+ (skribilo vars)
+ (skribilo runtime) ;; `the-options', `the-body'
+ (skribilo biblio)
+ (skribilo lib) ;; `define-markup', `unwind-protect', etc.
+ (skribilo resolve)
+ (skribilo engine)
+ (skribilo writer)
+ (skribilo output)
+ (skribilo evaluator)))
+
+(define *skribe-core-modules*
+ '("utils" "api" "bib" "index" "param" "sui"))
+
+(define-macro (define-skribe-module name . options)
`(begin
- (define-module ,name)
+ (define-module ,name
+ #:reader (make-reader 'skribe)
+ #:use-module (skribilo reader)
+ ,@options)
;; Pull all the bindings that Skribe code may expect, plus those needed
;; to actually create and read the module.
- (use-modules (skribilo module)
- (skribilo reader)
- (skribilo eval) ;; `run-time-module'
-
- (srfi srfi-1)
- (ice-9 optargs)
-
- (skribilo lib) ;; `define-markup', `unwind-protect', etc.
- (skribilo runtime)
- (skribilo vars)
- (skribilo config))
-
- (use-syntax (skribilo lib))
-
- ;; The `define' below results in a module-local definition. So the
- ;; definition of `read' in the `(guile-user)' module is left untouched.
- ;(define read ,(make-reader 'skribe))
-
- ;; Everything is exported.
- (define-macro (define . things)
- (let* ((first (car things))
- (binding (cond ((symbol? first) first)
- ((list? first) (car first))
- ((pair? first) (car first))
- (else
- (error "define/skribe: bad formals" first)))))
- `(begin
- (define-public ,@things)
- ;; Automatically push it to the run-time user module.
-; (module-define! ,(run-time-module)
-; (quote ,binding) ,binding)
- )))))
+ ,(cons 'use-modules
+ (append *skribilo-user-imports*
+ (filter-map (lambda (mod)
+ (let ((m `(skribilo skribe
+ ,(string->symbol
+ mod))))
+ (and (not (equal? m name)) m)))
+ *skribe-core-modules*)))))
;; Make it available to the top-level module.
@@ -80,39 +85,70 @@
'define-skribe-module define-skribe-module)
+
+
+(define *skribilo-user-module* #f)
+
+;;;
+;;; MAKE-RUN-TIME-MODULE
+;;;
+(define-public (make-run-time-module)
+ "Return a new module that imports all the necessary bindings required for
+execution of Skribilo/Skribe code."
+ (let ((the-module (make-module)))
+ (for-each (lambda (iface)
+ (module-use! the-module (resolve-module iface)))
+ (append *skribilo-user-imports*
+ (map (lambda (mod)
+ `(skribilo skribe
+ ,(string->symbol mod)))
+ *skribe-core-modules*)))
+ (set-module-name! the-module '(skribilo-user))
+ the-module))
+
+;;;
+;;; RUN-TIME-MODULE
+;;;
+(define-public (run-time-module)
+ "Return the default instance of a Skribilo/Skribe run-time module."
+ (if (not *skribilo-user-module*)
+ (set! *skribilo-user-module* (make-run-time-module)))
+ *skribilo-user-module*)
+
+
+;; FIXME: This will eventually be replaced by the per-module reader thing in
+;; Guile.
(define-public (load-file-with-read file read module)
- (with-input-from-file file
- (lambda ()
+ (with-debug 5 'load-file-with-read
+ (debug-item "loading " file)
+
+ (with-input-from-file (search-path %load-path file)
+ (lambda ()
; (format #t "load-file-with-read: ~a~%" read)
- (let loop ((sexp (read))
- (result #f))
- (if (eof-object? sexp)
- result
- (begin
+ (let loop ((sexp (read))
+ (result #f))
+ (if (eof-object? sexp)
+ result
+ (begin
; (format #t "preparing to evaluate `~a'~%" sexp)
- (loop (read)
- (eval sexp module))))))))
+ (loop (read)
+ (primitive-eval sexp)))))))))
(define-public (load-skribilo-file file reader-name)
(load-file-with-read file (make-reader reader-name) (current-module)))
-(define-public *skribe-core-modules*
- '("utils" "api" "bib" "index" "param" "sui"))
-
(define*-public (load-skribe-modules #:optional (debug? #f))
"Load the core Skribe modules, both in the @code{(skribilo skribe)}
hierarchy and in @code{(run-time-module)}."
(for-each (lambda (mod)
- (if debug?
- (format #t "loading skribe module `~a'...~%" mod))
- (load-skribilo-file (string-append "skribe/" mod ".scm")
- 'skribe))
- *skribe-core-modules*)
- (for-each (lambda (mod)
+ (format #t "~~ loading skribe module `~a'...~%" mod)
+ (load-skribilo-file (string-append "skribilo/skribe/"
+ mod ".scm")
+ 'skribe)
(module-use! (run-time-module)
- (resolve-interface (list skribilo skribe
- (string->symbol
- mod)))))
+ (resolve-module `(skribilo skribe
+ ,(string->symbol mod)))))
*skribe-core-modules*))
+
;;; module.scm ends here
diff --git a/src/guile/skribilo/output.scm b/src/guile/skribilo/output.scm
index cc690ec..8a63a48 100644
--- a/src/guile/skribilo/output.scm
+++ b/src/guile/skribilo/output.scm
@@ -1,24 +1,24 @@
;;;;
;;;; output.stk -- Skribe Output Stage
-;;;;
+;;;;
;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
-;;;;
-;;;;
+;;;;
+;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
-;;;;
+;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
-;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
-;;;;
+;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 13-Aug-2003 18:42 (eg)
;;;; Last file update: 5-Mar-2004 10:32 (eg)
@@ -29,8 +29,9 @@
(use-modules (skribilo debug)
(skribilo types)
-; (skribe engine)
-; (skribe writer)
+; (skribilo engine)
+ (skribilo writer)
+ (skribilo lib) ;; `when', `unless'
(oop goops))
@@ -47,7 +48,7 @@
(invoke (slot-ref w 'action) n e)
(invoke (slot-ref w 'after) n e))))
-
+
(define (output node e . writer)
(with-debug 3 'output
@@ -60,10 +61,10 @@
(%out/writer node e (car writer)))
((not (car writer))
(skribe-error 'output
- (format "Illegal ~A user writer" (engine-ident e))
+ (format #f "illegal ~A user writer" (engine-ident e))
(if (markup? node) (markup-markup node) node)))
(else
- (skribe-error 'output "Illegal user writer" (car writer)))))))
+ (skribe-error 'output "illegal user writer" (car writer)))))))
;;;
@@ -74,7 +75,7 @@
(define-method (out (node <pair>) e)
- (let Loop ((n* node))
+ (let loop ((n* node))
(cond
((pair? n*)
(out (car n*) e)
@@ -135,7 +136,7 @@
(+ (- (char->integer c)
(char->integer #\0))
(* 10 n))))))))
-
+
(let loop ((i 0))
(cond
((= i lf)
diff --git a/src/guile/skribilo/reader.scm b/src/guile/skribilo/reader.scm
index a149ab1..27c740b 100644
--- a/src/guile/skribilo/reader.scm
+++ b/src/guile/skribilo/reader.scm
@@ -21,7 +21,8 @@
(define-module (skribilo reader)
:use-module (srfi srfi-9) ;; records
:use-module (srfi srfi-17) ;; generalized `set!'
- :export (%make-reader lookup-reader make-reader)
+ :export (%make-reader lookup-reader make-reader
+ %default-reader)
:export-syntax (define-reader define-public-reader))
;;; Author: Ludovic Courtès
@@ -65,7 +66,7 @@
(define (lookup-reader name)
"Look for a reader named @var{name} (a symbol) in the @code{(skribilo
-readers)} module hierarchy. If no such reader was found, an error is
+reader)} module hierarchy. If no such reader was found, an error is
raised."
(let ((m (resolve-module `(skribilo reader ,name))))
(if (module-bound? m 'reader-specification)
@@ -78,5 +79,6 @@ raised."
(make (reader:make spec)))
(make)))
+(define %default-reader (make-reader 'skribe))
;;; reader.scm ends here
diff --git a/src/guile/skribilo/resolve.scm b/src/guile/skribilo/resolve.scm
index 2dc5e98..14f36b2 100644
--- a/src/guile/skribilo/resolve.scm
+++ b/src/guile/skribilo/resolve.scm
@@ -1,24 +1,24 @@
;;;;
;;;; resolve.stk -- Skribe Resolve Stage
-;;;;
+;;;;
;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
-;;;;
-;;;;
+;;;;
+;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
-;;;;
+;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
-;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
-;;;;
+;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 13-Aug-2003 18:39 (eg)
;;;; Last file update: 17-Feb-2004 14:43 (eg)
@@ -28,6 +28,7 @@
:use-module (skribilo debug)
:use-module (skribilo runtime)
:use-module (skribilo types)
+ :use-module (skribilo lib) ;; `unless' and `when'
:use-module (oop goops)
@@ -50,17 +51,19 @@
(define (resolve! ast engine env)
(with-debug 3 'resolve
(debug-item "ast=" ast)
- (fluid-let ((*unresolved* #f))
+ (let ((*unresolved* (make-fluid)))
+ (fluid-set! *unresolved* #f)
+
(let Loop ((ast ast))
- (set! *unresolved* #f)
+ (fluid-set! *unresolved* #f)
(let ((ast (do-resolve! ast engine env)))
- (if *unresolved*
+ (if (fluid-ref *unresolved*)
(Loop ast)
ast))))))
;;;; ======================================================================
;;;;
-;;;; D O - R E S O L V E !
+;;;; D O - R E S O L V E !
;;;;
;;;; ======================================================================
@@ -193,10 +196,10 @@
(debug-item "parent=" p " "
(if (is-a? p 'markup) (slot-ref p 'markup) "???"))
(cond
- ((pred p) p)
+ ((pred p) p)
((is-a? p <unresolved>) p)
((not p) #f)
- (else (resolve-search-parent p e pred))))))
+ (else (resolve-search-parent p e pred))))))
;;;; ======================================================================
;;;;
@@ -229,7 +232,7 @@
(else
(set-car! (cdr c) (+ 1 num))
(+ 1 num)))))))
-
+
;;;; ======================================================================
;;;;
;;;; RESOLVE-IDENT
@@ -257,4 +260,3 @@
(car mks))
(else
(loop (cdr mks)))))))))))
-
diff --git a/src/guile/skribilo/runtime.scm b/src/guile/skribilo/runtime.scm
index af76237..1f411dc 100644
--- a/src/guile/skribilo/runtime.scm
+++ b/src/guile/skribilo/runtime.scm
@@ -27,6 +27,7 @@
(define-module (skribilo runtime)
:export (;; Utilities
strip-ref-base ast->file-location string-canonicalize
+ the-options the-body
;; Markup functions
markup-option markup-option-add! markup-output
@@ -48,7 +49,9 @@
(skribilo verify)
(skribilo resolve)
(skribilo output)
- (skribilo eval)
+ (skribilo evaluator)
+ (skribilo vars)
+ (srfi srfi-13)
(oop goops))
@@ -195,7 +198,7 @@
to))))))
(define (convert-image file formats)
- (let ((path (find-path file (skribe-image-path))))
+ (let ((path (search-path (skribe-image-path) file)))
(if (not path)
(skribe-error 'convert-image
(format "Can't find `~a' image file in path: " file)
@@ -253,20 +256,23 @@
;; The general version
(lambda (str)
(let ((out (open-output-string)))
- (dotimes (i (string-length str))
- (let* ((ch (string-ref str i))
- (res (assq ch lst)))
- (display (if res (cadr res) ch) out)))
+ (string-for-each (lambda (ch)
+ (let ((res (assq ch lst)))
+ (display (if res (cadr res) ch) out)))
+ str)
(get-output-string out))))
+(define string->html
+ (%make-general-string-replace '((#\" "&quot;") (#\& "&amp;") (#\< "&lt;")
+ (#\> "&gt;"))))
(define (make-string-replace lst)
(let ((l (sort lst (lambda (r1 r2) (char<? (car r1) (car r2))))))
(cond
((equal? l '((#\" "&quot;") (#\& "&amp;") (#\< "&lt;") (#\> "&gt;")))
- string->html)
+ string->html)
(else
- (%make-general-string-replace lst)))))
+ (%make-general-string-replace lst)))))
@@ -411,48 +417,49 @@
;;NEW '()))))))
;;NEW
-;;NEW ;;;; ======================================================================
-;;NEW ;;;;
-;;NEW ;;;; M A R K U P A R G U M E N T P A R S I N G
-;;NEW ;;;
-;;NEW ;;;; ======================================================================
-;;NEW (define (the-body opt)
-;;NEW ;; Filter out the options
-;;NEW (let loop ((opt* opt)
-;;NEW (res '()))
-;;NEW (cond
-;;NEW ((null? opt*)
-;;NEW (reverse! res))
-;;NEW ((not (pair? opt*))
-;;NEW (skribe-error 'the-body "Illegal body" opt))
-;;NEW ((keyword? (car opt*))
-;;NEW (if (null? (cdr opt*))
-;;NEW (skribe-error 'the-body "Illegal option" (car opt*))
-;;NEW (loop (cddr opt*) res)))
-;;NEW (else
-;;NEW (loop (cdr opt*) (cons (car opt*) res))))))
-;;NEW
-;;NEW
-;;NEW
-;;NEW (define (the-options opt+ . out)
-;;NEW ;; Returns an list made of options.The OUT argument contains
-;;NEW ;; keywords that are filtered out.
-;;NEW (let loop ((opt* opt+)
-;;NEW (res '()))
-;;NEW (cond
-;;NEW ((null? opt*)
-;;NEW (reverse! res))
-;;NEW ((not (pair? opt*))
-;;NEW (skribe-error 'the-options "Illegal options" opt*))
-;;NEW ((keyword? (car opt*))
-;;NEW (cond
-;;NEW ((null? (cdr opt*))
-;;NEW (skribe-error 'the-options "Illegal option" (car opt*)))
-;;NEW ((memq (car opt*) out)
-;;NEW (loop (cdr opt*) res))
-;;NEW (else
-;;NEW (loop (cdr opt*)
-;;NEW (cons (list (car opt*) (cadr opt*)) res)))))
-;;NEW (else
-;;NEW (loop (cdr opt*) res)))))
-;;NEW
+
+;;;; ======================================================================
+;;;;
+;;;; M A R K U P A R G U M E N T P A R S I N G
+;;;;
+;;;; ======================================================================
+(define (the-body opt)
+ ;; Filter out the options
+ (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)
+ ;; Returns an list made of options.The OUT argument contains
+ ;; keywords that are filtered 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)))))
+
diff --git a/src/guile/skribilo/skribe/api.scm b/src/guile/skribilo/skribe/api.scm
index 2828908..e7ba4a6 100644
--- a/src/guile/skribilo/skribe/api.scm
+++ b/src/guile/skribilo/skribe/api.scm
@@ -253,6 +253,7 @@
;* paragraph ... */
;*---------------------------------------------------------------------*/
(define-simple-markup paragraph)
+(define-public p paragraph)
;*---------------------------------------------------------------------*/
;* footnote ... */
diff --git a/src/guile/skribilo/skribe/bib.scm b/src/guile/skribilo/skribe/bib.scm
index f1a32c1..2ec5c0b 100644
--- a/src/guile/skribilo/skribe/bib.scm
+++ b/src/guile/skribilo/skribe/bib.scm
@@ -32,7 +32,6 @@
;;; The contents of the file below are unchanged compared to Skribe 1.2d's
;;; `bib.scm' file found in the `common' directory.
-
;*---------------------------------------------------------------------*/
;* bib-load! ... */
;*---------------------------------------------------------------------*/
diff --git a/src/guile/skribilo/skribe/utils.scm b/src/guile/skribilo/skribe/utils.scm
index f963020..b2a5cfb 100644
--- a/src/guile/skribilo/skribe/utils.scm
+++ b/src/guile/skribilo/skribe/utils.scm
@@ -19,7 +19,8 @@
;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;; USA.
-(define-skribe-module (skribilo skribe utils))
+(define-skribe-module (skribilo skribe utils)
+ #:export (ast-document))
;;; Author: Manuel Serrano
;;; Commentary:
diff --git a/src/guile/skribilo/source.scm b/src/guile/skribilo/source.scm
index e56f350..c682687 100644
--- a/src/guile/skribilo/source.scm
+++ b/src/guile/skribilo/source.scm
@@ -1,24 +1,24 @@
;;;;
;;;; source.stk -- Skibe SOURCE implementation stuff
-;;;;
+;;;;
;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
-;;;;
-;;;;
+;;;;
+;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
-;;;;
+;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
-;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
-;;;;
+;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 3-Sep-2003 12:22 (eg)
;;;; Last file update: 27-Oct-2004 20:09 (eg)
@@ -27,7 +27,8 @@
(define-module (skribilo source)
- :export (source-read-lines source-read-definition source-fontify))
+ :export (source-read-lines source-read-definition source-fontify)
+ :use-module (skribilo vars))
;; Temporary solution
@@ -42,7 +43,7 @@
;* source-read-lines ... */
;*---------------------------------------------------------------------*/
(define (source-read-lines file start stop tab)
- (let ((p (find-path file (skribe-source-path))))
+ (let ((p (search-path (skribe-source-path) file)))
(if (or (not (string? p)) (not (file-exists? p)))
(skribe-error 'source
(format "Can't find `~a' source file in path" file)
@@ -119,7 +120,7 @@
;* source-read-definition ... */
;*---------------------------------------------------------------------*/
(define (source-read-definition file definition tab lang)
- (let ((p (find-path file (skribe-source-path))))
+ (let ((p (search-path (skribe-source-path) file)))
(cond
((not (language-extractor lang))
(skribe-error 'source
@@ -187,4 +188,3 @@
(cons* 'eol (substring str j i) r))))
(else
(loop (+ i 1) j r))))))
-
diff --git a/src/guile/skribilo/types.scm b/src/guile/skribilo/types.scm
index 0d51c70..0893587 100644
--- a/src/guile/skribilo/types.scm
+++ b/src/guile/skribilo/types.scm
@@ -33,10 +33,12 @@
<node> node? node-options node-loc
<engine> engine? engine-ident engine-format engine-customs
engine-filter engine-symbol-table
- <writer> writer? write-object
+ <writer> writer? write-object writer-options writer-ident
+ writer-before writer-action writer-after
<processor> processor? processor-combinator processor-engine
<markup> markup? bind-markup! markup-options is-markup?
- markup-body find-markups write-object
+ markup-markup markup-body markup-ident markup-class
+ find-markups write-object
<container> container? container-options
container-ident container-body
<document> document? document-ident document-body
diff --git a/src/guile/skribilo/vars.scm b/src/guile/skribilo/vars.scm
index 51a7ee7..7e75e0f 100644
--- a/src/guile/skribilo/vars.scm
+++ b/src/guile/skribilo/vars.scm
@@ -21,7 +21,8 @@
;;; USA.
-(define-module (skribilo vars))
+(define-module (skribilo vars)
+ #:use-module (srfi srfi-17))
;;;
;;; Switches
@@ -30,6 +31,11 @@
(define-public *skribe-warning* 5)
(define-public *load-rc* #t)
+(define-public skribe-debug
+ (let ((level 0))
+ (getter-with-setter (lambda () level)
+ (lambda (val) (set! level val)))))
+
;;;
;;; PATH variables
;;;
diff --git a/src/guile/skribilo/verify.scm b/src/guile/skribilo/verify.scm
index 93a1be3..1ff0b5b 100644
--- a/src/guile/skribilo/verify.scm
+++ b/src/guile/skribilo/verify.scm
@@ -1,24 +1,24 @@
;;;;
;;;; verify.stk -- Skribe Verification Stage
-;;;;
+;;;;
;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
-;;;;
-;;;;
+;;;;
+;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
-;;;;
+;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
-;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
-;;;;
+;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 13-Aug-2003 11:57 (eg)
;;;; Last file update: 27-Oct-2004 16:35 (eg)
@@ -29,9 +29,10 @@
(use-modules (skribilo debug)
; (skribilo engine)
-; (skribilo writer)
+ (skribilo writer)
; (skribilo runtime)
(skribilo types)
+ (skribilo lib) ;; `when', `unless'
(oop goops))
@@ -61,16 +62,16 @@
;;; CHECK-OPTIONS
;;;
(define (check-options lopts markup engine)
-
+
;; Only keywords are checked, symbols are voluntary left unchecked. */
(with-debug 6 'check-options
(debug-item "markup=" (markup-markup markup))
(debug-item "options=" (slot-ref markup 'options))
(debug-item "lopts=" lopts)
(for-each
- (lambda (o2)
+ (lambda (o2)
(for-each
- (lambda (o)
+ (lambda (o)
(if (and (keyword? o)
(not (eq? o :&skribe-eval-location))
(not (memq o lopts)))
@@ -85,11 +86,11 @@
(markup-option markup o)))))
o2))
(slot-ref markup 'options))))
-
+
;;; ======================================================================
;;;
-;;; V E R I F Y
+;;; V E R I F Y
;;;
;;; ======================================================================
@@ -124,7 +125,7 @@
(with-debug 5 'verify::<markup>
(debug-item "node=" (markup-markup node))
(debug-item "options=" (slot-ref node 'options))
- (debug-item "e=" (engine-ident e))
+ (debug-item "e=" (engine-ident e))
(next-method)
@@ -157,5 +158,3 @@
(slot-ref e 'customs))
node)
-
-
diff --git a/src/guile/skribilo/writer.scm b/src/guile/skribilo/writer.scm
index 048dcfb..eeefe8b 100644
--- a/src/guile/skribilo/writer.scm
+++ b/src/guile/skribilo/writer.scm
@@ -1,24 +1,24 @@
;;;;
;;;; writer.stk -- Skribe Writer Stuff
-;;;;
+;;;;
;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
-;;;;
-;;;;
+;;;;
+;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
-;;;;
+;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
-;;;;
+;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
-;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
-;;;;
+;;;;
;;;; Author: Erick Gallesio [eg@essi.fr]
;;;; Creation date: 15-Sep-2003 22:21 (eg)
;;;; Last file update: 4-Mar-2004 10:48 (eg)
@@ -31,8 +31,10 @@
(use-modules (skribilo debug)
-; (skribilo engine)
+ (skribilo engine)
(skribilo output)
+ (skribilo types)
+ (skribilo lib)
(oop goops)
(ice-9 optargs))
@@ -40,7 +42,7 @@
;;;; ======================================================================
;;;;
-;;;; INVOKE
+;;;; INVOKE
;;;;
;;;; ======================================================================
(define (invoke proc node e)
@@ -56,13 +58,13 @@
;;;; ======================================================================
;;;;
-;;;; LOOKUP-MARKUP-WRITER
+;;;; LOOKUP-MARKUP-WRITER
;;;;
;;;; ======================================================================
(define (lookup-markup-writer node e)
(let ((writers (slot-ref e 'writers))
(delegate (slot-ref e 'delegate)))
- (let Loop ((w* writers))
+ (let loop ((w* writers))
(cond
((pair? w*)
(let ((pred (slot-ref (car w*) 'pred)))
@@ -76,7 +78,7 @@
;;;; ======================================================================
;;;;
-;;;; MAKE-WRITER-PREDICATE
+;;;; MAKE-WRITER-PREDICATE
;;;;
;;;; ======================================================================
(define (make-writer-predicate markup predicate class)
@@ -104,26 +106,55 @@
;;;; ======================================================================
;;;;
-;;;; MARKUP-WRITER
+;;;; MARKUP-WRITER
;;;;
;;;; ======================================================================
-(define* (markup-writer markup #:optional engine
+; (define-macro (lambda** arglist . body)
+; (let ((parse-arglist (module-ref (resolve-module '(ice-9 optargs))
+; 'parse-arglist)))
+; (parse-arglist
+; arglist
+; (lambda (mandatory-args optionals keys aok? rest-arg)
+; (let ((l**-rest-arg (gensym "L**-rest"))
+; (l**-loop (gensym "L**-loop")))
+; `(lambda (,@mandatory-args . ,l**-rest-arg)
+; `(let ,l**-loop ((,l**-rest-arg ,l**-rest-arg)
+; (,rest-arg '())
+; ,@optionals
+; ,@keys)
+; (if (null? ,l**-rest-arg)
+; (begin
+; ,@body)
+
+(define* (markup-writer markup ;; #:optional (engine #f)
#:key (predicate #f) (class #f) (options '())
- (validate #f)
- (before #f) (action 'unspecified) (after #f))
- (let ((e (or engine (default-engine))))
+ (validate #f)
+ (before #f)
+ (action 'unspecified)
+ (after #f)
+ #:rest engine)
+ ;;; FIXME: `lambda*' sucks and fails when both optional arguments and
+ ;;; keyword arguments are used together. In particular, if ENGINE is not
+ ;;; specified by the caller but other keyword arguments are specified, it
+ ;;; will consider the value of ENGINE to be the first keyword found.
+
+; (let ((e (or engine (default-engine))))
+ (let ((e (or (and (list? engine)
+ (not (keyword? (car engine))))
+ (default-engine))))
+
(cond
((and (not (symbol? markup)) (not (eq? markup #t)))
- (skribe-error 'markup-writer "Illegal markup" markup))
+ (skribe-error 'markup-writer "illegal markup" markup))
((not (engine? e))
- (skribe-error 'markup-writer "Illegal engine" e))
+ (skribe-error 'markup-writer "illegal engine" e))
((and (not predicate)
(not class)
(null? options)
(not before)
(eq? action 'unspecified)
(not after))
- (skribe-error 'markup-writer "Illegal writer" markup))
+ (skribe-error 'markup-writer "illegal writer" markup))
(else
(let ((m (make-writer-predicate markup predicate class))
(ac (if (eq? action 'unspecified)
@@ -135,35 +166,35 @@
;;;; ======================================================================
;;;;
-;;;; MARKUP-WRITER-GET
+;;;; MARKUP-WRITER-GET
;;;;
;;;; ======================================================================
(define* (markup-writer-get markup :optional engine :key (class #f) (pred #f))
(let ((e (or engine (default-engine))))
(cond
((not (symbol? markup))
- (skribe-error 'markup-writer-get "Illegal symbol" markup))
+ (skribe-error 'markup-writer-get "Illegal symbol" markup))
((not (engine? e))
- (skribe-error 'markup-writer-get "Illegal engine" e))
+ (skribe-error 'markup-writer-get "Illegal engine" e))
(else
(let liip ((e e))
(let loop ((w* (slot-ref e 'writers)))
(cond
((pair? w*)
- (if (and (eq? (writer-ident (car w*)) markup)
+ (if (and (eq? (writer-ident (car w*)) markup)
(equal? (writer-class (car w*)) class)
(or (unspecified? pred)
(eq? (slot-ref (car w*) 'upred) pred)))
(car w*)
(loop (cdr w*))))
((engine? (slot-ref e 'delegate))
- (liip (slot-ref e 'delegate)))
+ (liip (slot-ref e 'delegate)))
(else
- #f))))))))
+ #f))))))))
;;;; ======================================================================
;;;;
-;;;; MARKUP-WRITER-GET*
+;;;; MARKUP-WRITER-GET*
;;;;
;;;; ======================================================================
@@ -194,16 +225,16 @@
;;; ======================================================================
;;;;
-;;;; COPY-MARKUP-WRITER
+;;;; COPY-MARKUP-WRITER
;;;;
;;;; ======================================================================
(define* (copy-markup-writer markup old-engine :optional new-engine
- :key (predicate 'unspecified)
- (class 'unspecified)
+ :key (predicate 'unspecified)
+ (class 'unspecified)
(options 'unspecified)
- (validate 'unspecified)
- (before 'unspecified)
- (action 'unspecified)
+ (validate 'unspecified)
+ (before 'unspecified)
+ (action 'unspecified)
(after 'unspecified))
(let ((old (markup-writer-get markup old-engine))
(new-engine (or new-engine old-engine)))