summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/guile/skribilo.scm9
-rw-r--r--src/guile/skribilo/Makefile.am2
-rw-r--r--src/guile/skribilo/evaluator.scm6
-rw-r--r--src/guile/skribilo/module.scm56
-rw-r--r--src/guile/skribilo/skribe/Makefile.am2
-rw-r--r--src/guile/skribilo/sui.scm (renamed from src/guile/skribilo/skribe/sui.scm)56
6 files changed, 67 insertions, 64 deletions
diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm
index 53afa89..531b0fb 100644
--- a/src/guile/skribilo.scm
+++ b/src/guile/skribilo.scm
@@ -36,7 +36,7 @@ exec ${GUILE-guile} --debug -l $0 -c "(apply $main (cdr (command-line)))" "$@"
(define-module (skribilo)
- :autoload (skribilo module) (make-run-time-module)
+ :autoload (skribilo module) (make-run-time-module *skribilo-user-module*)
:autoload (skribilo engine) (*current-engine*)
:autoload (skribilo reader) (*document-reader*)
:use-module (skribilo utils syntax))
@@ -367,14 +367,17 @@ Processes a Skribilo/Skribe source file and produces its output.
;; FIXME: Using this technique, anything written to `stderr' will
;; also end up in the output file (e.g. Guile warnings).
(set-current-output-port (*skribilo-output-port*))
- (set-current-module (make-run-time-module)))
+ (let ((user (make-run-time-module)))
+ (set-current-module user)
+ (*skribilo-user-module* user)))
(lambda ()
;;(format #t "engine is ~a~%" (*current-engine*))
(evaluate-document-from-port (current-input-port)
(*current-engine*)))
(lambda ()
(set-current-output-port output-port)
- (set-current-module user-module)))))
+ (set-current-module user-module)
+ (*skribilo-user-module* #f)))))
diff --git a/src/guile/skribilo/Makefile.am b/src/guile/skribilo/Makefile.am
index 8de8774..48fa5ca 100644
--- a/src/guile/skribilo/Makefile.am
+++ b/src/guile/skribilo/Makefile.am
@@ -7,4 +7,4 @@ dist_guilemodule_DATA = biblio.scm color.scm config.scm \
writer.scm ast.scm location.scm \
condition.scm
-SUBDIRS = utils reader engine package skribe coloring biblio
+SUBDIRS = utils reader engine package coloring biblio
diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm
index abee2fd..8502d51 100644
--- a/src/guile/skribilo/evaluator.scm
+++ b/src/guile/skribilo/evaluator.scm
@@ -31,7 +31,9 @@
:autoload (skribilo reader) (*document-reader*)
:autoload (skribilo verify) (verify)
- :autoload (skribilo resolve) (resolve!))
+ :autoload (skribilo resolve) (resolve!)
+
+ :autoload (skribilo module) (*skribilo-user-module*))
(use-modules (skribilo utils syntax)
@@ -59,7 +61,7 @@
;; Evaluate EXPR, an arbitrary S-expression that may contain calls to the
;; markup functions defined in a markup package such as
;; `(skribilo package base)', e.g., `(bold "hello")'.
- (let ((result (eval expr (current-module))))
+ (let ((result (eval expr (*skribilo-user-module*))))
(if (ast? result)
(let ((file (source-property expr 'filename))
diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm
index d8885b6..ac8eee0 100644
--- a/src/guile/skribilo/module.scm
+++ b/src/guile/skribilo/module.scm
@@ -23,7 +23,9 @@
:use-module (skribilo debug)
:use-module (srfi srfi-1)
:use-module (ice-9 optargs)
- :use-module (skribilo utils syntax))
+ :use-module (srfi srfi-39)
+ :use-module (skribilo utils syntax)
+ :export (make-run-time-module *skribilo-user-module*))
(fluid-set! current-reader %skribilo-module-reader)
@@ -85,13 +87,11 @@
((skribilo prog) . (make-prog-body resolve-line))
((skribilo color) .
(skribe-color->rgb skribe-get-used-colors skribe-use-color!))
+ ((skribilo sui) . (load-sui))
((ice-9 and-let-star) . (and-let*))
((ice-9 receive) . (receive))))
-(define %skribe-core-modules
- '("sui"))
-
;; The very macro to turn a legacy Skribe file (which uses Skribe's syntax)
@@ -110,14 +110,7 @@
;; Pull all the bindings that Skribe code may expect, plus those needed
;; to actually create and read the module.
;; TODO: These should be auto-loaded.
- ,(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)))
+ ,(cons 'use-modules %skribilo-user-imports)
;; Change the current reader to a Skribe-compatible reader. If this
;; primitive is not provided by Guile (i.e., version <= 1.7.2), then it
@@ -133,33 +126,28 @@
-(define %skribilo-user-module #f)
-
;;;
;;; MAKE-RUN-TIME-MODULE
;;;
-(define-public (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)))
- (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)
+ (let* ((the-module (make-module))
+ (autoloads (map (lambda (name+bindings)
+ (make-autoload-interface the-module
+ (car name+bindings)
+ (cdr name+bindings)))
+ %skribilo-user-autoloads)))
+ (set-module-name! the-module '(skribilo-user))
+ (module-use-interfaces! the-module
+ (cons the-root-module
+ (append (map resolve-interface
+ %skribilo-user-imports)
+ autoloads)))
+ the-module))
+
+;; The current module in which the document is evaluated.
+(define *skribilo-user-module* (make-parameter (make-run-time-module)))
;;; module.scm ends here
diff --git a/src/guile/skribilo/skribe/Makefile.am b/src/guile/skribilo/skribe/Makefile.am
deleted file mode 100644
index 924789b..0000000
--- a/src/guile/skribilo/skribe/Makefile.am
+++ /dev/null
@@ -1,2 +0,0 @@
-guilemoduledir = $(GUILE_SITE)/skribilo/skribe
-dist_guilemodule_DATA = sui.scm
diff --git a/src/guile/skribilo/skribe/sui.scm b/src/guile/skribilo/sui.scm
index 333e794..e0a9b19 100644
--- a/src/guile/skribilo/skribe/sui.scm
+++ b/src/guile/skribilo/sui.scm
@@ -1,7 +1,7 @@
;;; sui.scm
;;;
;;; Copyright 2003, 2004 Manuel Serrano
-;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
;;;
;;;
;;; This program is free software; you can redistribute it and/or modify
@@ -19,7 +19,18 @@
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;; USA.
-(define-skribe-module (skribilo skribe sui))
+(define-module (skribilo sui)
+ :use-module (skribilo utils syntax)
+ :use-module (skribilo lib)
+ :use-module (ice-9 match)
+ :use-module (srfi srfi-1)
+ :autoload (skribilo parameters) (*verbose*)
+ :autoload (skribilo reader) (make-reader)
+
+ :export (load-sui sui-ref->url sui-title sui-file sui-key
+ sui-find-ref sui-search-ref sui-filter))
+
+(fluid-set! current-reader %skribilo-module-reader)
;;; Author: Manuel Serrano
;;; Commentary:
@@ -29,14 +40,14 @@
;;; Code:
-;;; The contents of the file below are unchanged compared to Skribe 1.2d's
-;;; `sui.scm' file found in the `common' directory.
+;;; The contents of the file below are (almost) unchanged compared to Skribe
+;;; 1.2d's `sui.scm' file found in the `common' directory.
;*---------------------------------------------------------------------*/
;* *sui-table* ... */
;*---------------------------------------------------------------------*/
-(define *sui-table* (make-hashtable))
+(define *sui-table* (make-hash-table))
;*---------------------------------------------------------------------*/
;* load-sui ... */
@@ -45,21 +56,22 @@
;* Raise an error if the file cannot be open. */
;*---------------------------------------------------------------------*/
(define (load-sui path)
- (let ((sexp (hashtable-get *sui-table* path)))
+ (let ((sexp (hash-ref *sui-table* path)))
(or sexp
(begin
- (when (> *skribe-verbose* 0)
- (fprintf (current-error-port) " [loading sui: ~a]\n" path))
- (let ((p (open-input-file path)))
+ (when (> (*verbose*) 0)
+ (format (current-error-port) " [loading sui: ~a]\n" path))
+ (let ((p (open-input-file path))
+ (read (make-reader 'skribe)))
(if (not (input-port? p))
(skribe-error 'load-sui
"Can't find `Skribe Url Index' file"
path)
(unwind-protect
(let ((sexp (read p)))
- (match-case sexp
- ((sui (? string?) . ?-)
- (hashtable-put! *sui-table* path sexp))
+ (match sexp
+ (('sui (? string?) . _)
+ (hash-set! *sui-table* path sexp))
(else
(skribe-error 'load-sui
"Illegal `Skribe Url Index' file"
@@ -76,14 +88,14 @@
(let ((base (sui-file sui))
(file (car (car refs)))
(mark (cdr (car refs))))
- (format "~a/~a#~a" dir (or file base) mark)))))
+ (format #f "~a/~a#~a" dir (or file base) mark)))))
;*---------------------------------------------------------------------*/
;* sui-title ... */
;*---------------------------------------------------------------------*/
(define (sui-title sexp)
- (match-case sexp
- ((sui (and ?title (? string?)) . ?-)
+ (match sexp
+ (('sui (and title (? string?)) . _)
title)
(else
(skribe-error 'sui-title "Illegal `sui' format" sexp))))
@@ -98,8 +110,8 @@
;* sui-key ... */
;*---------------------------------------------------------------------*/
(define (sui-key sexp key)
- (match-case sexp
- ((sui ?- . ?rest)
+ (match sexp
+ (('sui _ . rest)
(let loop ((rest rest))
(and (pair? rest)
(if (eq? (car rest) key)
@@ -121,8 +133,8 @@
(section (assq :section opts))
(subsection (assq :subsection opts))
(subsubsection (assq :subsubsection opts)))
- (match-case sui
- ((sui (? string?) . ?refs)
+ (match sui
+ (('sui (? string?) . refs)
(cond
(mark (sui-search-ref 'marks refs (cadr mark) class))
(chapter (sui-search-ref 'chapters refs (cadr chapter) class))
@@ -168,13 +180,13 @@
(find-ref (cdar refs) val class)
(loop (cdr refs)))
'())))
-
+
;*---------------------------------------------------------------------*/
;* sui-filter ... */
;*---------------------------------------------------------------------*/
(define (sui-filter sui pred1 pred2)
- (match-case sui
- ((sui (? string?) . ?refs)
+ (match sui
+ (('sui (? string?) . refs)
(let loop ((refs refs)
(res '()))
(if (pair? refs)