diff options
Diffstat (limited to 'src/guile')
| -rw-r--r-- | src/guile/skribilo.scm | 9 | ||||
| -rw-r--r-- | src/guile/skribilo/Makefile.am | 2 | ||||
| -rw-r--r-- | src/guile/skribilo/evaluator.scm | 6 | ||||
| -rw-r--r-- | src/guile/skribilo/module.scm | 56 | ||||
| -rw-r--r-- | src/guile/skribilo/skribe/Makefile.am | 2 | ||||
| -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) |