From 7f3b61347a8170344fffea8335945baa24ebc543 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Mon, 31 Jul 2006 16:29:34 +0000 Subject: Moved the `sui' module; removed the `skribe' subdirectory. * configure.ac: Don't produce `src/guile/skribilo/skribe/Makefile'. * src/guile/skribilo/Makefile.am (SUBDIRS): Removed `skribe'. * src/guile/skribilo/sui.scm: No longer use `define-skribe-module'. Rewrote the use the native hash-table API, `(ice-9 match)', and `format' instead of `fprint'. * src/guile/skribilo.scm (doskribe): Use `*skribilo-user-module*'. * src/guile/skribilo/evaluator.scm: Autoload `(skribilo module)'. (%evaluate): Evaluate EXPR in `*skribilo-user-module*'. * src/guile/skribilo/module.scm (%skribilo-user-autoloads): Added `(skribilo sui)'. (%skribe-core-modules): Removed. (define-skribe-module): Don't refer to it. (make-run-time-module): Use `the-root-module'. Properly build it using `make-autoload-interface' and `module-use-interfaces!' so that duplicates are correctly handled. (*skribilo-user-module*): New parameter. git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-40 --- configure.ac | 1 - src/guile/skribilo.scm | 9 +- src/guile/skribilo/Makefile.am | 2 +- src/guile/skribilo/evaluator.scm | 6 +- src/guile/skribilo/module.scm | 56 ++++------ src/guile/skribilo/skribe/Makefile.am | 2 - src/guile/skribilo/skribe/sui.scm | 187 -------------------------------- src/guile/skribilo/sui.scm | 199 ++++++++++++++++++++++++++++++++++ 8 files changed, 232 insertions(+), 230 deletions(-) delete mode 100644 src/guile/skribilo/skribe/Makefile.am delete mode 100644 src/guile/skribilo/skribe/sui.scm create mode 100644 src/guile/skribilo/sui.scm diff --git a/configure.ac b/configure.ac index e889401..2ac4dcc 100644 --- a/configure.ac +++ b/configure.ac @@ -45,7 +45,6 @@ AC_OUTPUT([Makefile src/guile/skribilo/package/slide/Makefile src/guile/skribilo/package/eq/Makefile src/guile/skribilo/package/pie/Makefile - src/guile/skribilo/skribe/Makefile src/guile/skribilo/coloring/Makefile src/guile/skribilo/biblio/Makefile doc/Makefile 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/skribe/sui.scm deleted file mode 100644 index 333e794..0000000 --- a/src/guile/skribilo/skribe/sui.scm +++ /dev/null @@ -1,187 +0,0 @@ -;;; sui.scm -;;; -;;; Copyright 2003, 2004 Manuel Serrano -;;; Copyright 2005 Ludovic Courtès -;;; -;;; -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2 of the License, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software -;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;;; USA. - -(define-skribe-module (skribilo skribe sui)) - -;;; Author: Manuel Serrano -;;; Commentary: -;;; -;;; Library dealing with Skribe URL Indexes (SUI). -;;; -;;; Code: - - -;;; The contents of the file below are unchanged compared to Skribe 1.2d's -;;; `sui.scm' file found in the `common' directory. - - -;*---------------------------------------------------------------------*/ -;* *sui-table* ... */ -;*---------------------------------------------------------------------*/ -(define *sui-table* (make-hashtable)) - -;*---------------------------------------------------------------------*/ -;* load-sui ... */ -;* ------------------------------------------------------------- */ -;* Returns a SUI sexp if already loaded. Load it otherwise. */ -;* Raise an error if the file cannot be open. */ -;*---------------------------------------------------------------------*/ -(define (load-sui path) - (let ((sexp (hashtable-get *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))) - (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)) - (else - (skribe-error 'load-sui - "Illegal `Skribe Url Index' file" - path))) - sexp) - (close-input-port p)))))))) - -;*---------------------------------------------------------------------*/ -;* sui-ref->url ... */ -;*---------------------------------------------------------------------*/ -(define (sui-ref->url dir sui ident opts) - (let ((refs (sui-find-ref sui ident opts))) - (and (pair? refs) - (let ((base (sui-file sui)) - (file (car (car refs))) - (mark (cdr (car refs)))) - (format "~a/~a#~a" dir (or file base) mark))))) - -;*---------------------------------------------------------------------*/ -;* sui-title ... */ -;*---------------------------------------------------------------------*/ -(define (sui-title sexp) - (match-case sexp - ((sui (and ?title (? string?)) . ?-) - title) - (else - (skribe-error 'sui-title "Illegal `sui' format" sexp)))) - -;*---------------------------------------------------------------------*/ -;* sui-file ... */ -;*---------------------------------------------------------------------*/ -(define (sui-file sexp) - (sui-key sexp :file)) - -;*---------------------------------------------------------------------*/ -;* sui-key ... */ -;*---------------------------------------------------------------------*/ -(define (sui-key sexp key) - (match-case sexp - ((sui ?- . ?rest) - (let loop ((rest rest)) - (and (pair? rest) - (if (eq? (car rest) key) - (and (pair? (cdr rest)) - (cadr rest)) - (loop (cdr rest)))))) - (else - (skribe-error 'sui-key "Illegal `sui' format" sexp)))) - -;*---------------------------------------------------------------------*/ -;* sui-find-ref ... */ -;*---------------------------------------------------------------------*/ -(define (sui-find-ref sui ident opts) - (let ((ident (assq :ident opts)) - (mark (assq :mark opts)) - (class (let ((c (assq :class opts))) - (and (pair? c) (cadr c)))) - (chapter (assq :chapter opts)) - (section (assq :section opts)) - (subsection (assq :subsection opts)) - (subsubsection (assq :subsubsection opts))) - (match-case sui - ((sui (? string?) . ?refs) - (cond - (mark (sui-search-ref 'marks refs (cadr mark) class)) - (chapter (sui-search-ref 'chapters refs (cadr chapter) class)) - (section (sui-search-ref 'sections refs (cadr section) class)) - (subsection (sui-search-ref 'subsections refs (cadr subsection) class)) - (subsubsection (sui-search-ref 'subsubsections refs (cadr subsubsection) class)) - (ident (sui-search-all-refs sui ident class)) - (else '()))) - (else - (skribe-error 'sui-find-ref "Illegal `sui' format" sui))))) - -;*---------------------------------------------------------------------*/ -;* sui-search-all-refs ... */ -;*---------------------------------------------------------------------*/ -(define (sui-search-all-refs sui id refs) - '()) - -;*---------------------------------------------------------------------*/ -;* sui-search-ref ... */ -;*---------------------------------------------------------------------*/ -(define (sui-search-ref kind refs val class) - (define (find-ref refs val class) - (map (lambda (r) - (let ((f (memq :file r)) - (c (memq :mark r))) - (cons (and (pair? f) (cadr f)) (and (pair? c) (cadr c))))) - (filter (if class - (lambda (m) - (and (pair? m) - (string? (car m)) - (string=? (car m) val) - (let ((c (memq :class m))) - (and (pair? c) - (eq? (cadr c) class))))) - (lambda (m) - (and (pair? m) - (string? (car m)) - (string=? (car m) val)))) - refs))) - (let loop ((refs refs)) - (if (pair? refs) - (if (and (pair? (car refs)) (eq? (caar refs) kind)) - (find-ref (cdar refs) val class) - (loop (cdr refs))) - '()))) - -;*---------------------------------------------------------------------*/ -;* sui-filter ... */ -;*---------------------------------------------------------------------*/ -(define (sui-filter sui pred1 pred2) - (match-case sui - ((sui (? string?) . ?refs) - (let loop ((refs refs) - (res '())) - (if (pair? refs) - (if (and (pred1 (car refs))) - (loop (cdr refs) - (cons (filter pred2 (cdar refs)) res)) - (loop (cdr refs) res)) - (reverse! res)))) - (else - (skribe-error 'sui-filter "Illegal `sui' format" sui)))) diff --git a/src/guile/skribilo/sui.scm b/src/guile/skribilo/sui.scm new file mode 100644 index 0000000..e0a9b19 --- /dev/null +++ b/src/guile/skribilo/sui.scm @@ -0,0 +1,199 @@ +;;; sui.scm +;;; +;;; Copyright 2003, 2004 Manuel Serrano +;;; Copyright 2005, 2006 Ludovic Courtès +;;; +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;; USA. + +(define-module (skribilo 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: +;;; +;;; Library dealing with Skribe URL Indexes (SUI). +;;; +;;; Code: + + +;;; 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-hash-table)) + +;*---------------------------------------------------------------------*/ +;* load-sui ... */ +;* ------------------------------------------------------------- */ +;* Returns a SUI sexp if already loaded. Load it otherwise. */ +;* Raise an error if the file cannot be open. */ +;*---------------------------------------------------------------------*/ +(define (load-sui path) + (let ((sexp (hash-ref *sui-table* path))) + (or sexp + (begin + (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 sexp + (('sui (? string?) . _) + (hash-set! *sui-table* path sexp)) + (else + (skribe-error 'load-sui + "Illegal `Skribe Url Index' file" + path))) + sexp) + (close-input-port p)))))))) + +;*---------------------------------------------------------------------*/ +;* sui-ref->url ... */ +;*---------------------------------------------------------------------*/ +(define (sui-ref->url dir sui ident opts) + (let ((refs (sui-find-ref sui ident opts))) + (and (pair? refs) + (let ((base (sui-file sui)) + (file (car (car refs))) + (mark (cdr (car refs)))) + (format #f "~a/~a#~a" dir (or file base) mark))))) + +;*---------------------------------------------------------------------*/ +;* sui-title ... */ +;*---------------------------------------------------------------------*/ +(define (sui-title sexp) + (match sexp + (('sui (and title (? string?)) . _) + title) + (else + (skribe-error 'sui-title "Illegal `sui' format" sexp)))) + +;*---------------------------------------------------------------------*/ +;* sui-file ... */ +;*---------------------------------------------------------------------*/ +(define (sui-file sexp) + (sui-key sexp :file)) + +;*---------------------------------------------------------------------*/ +;* sui-key ... */ +;*---------------------------------------------------------------------*/ +(define (sui-key sexp key) + (match sexp + (('sui _ . rest) + (let loop ((rest rest)) + (and (pair? rest) + (if (eq? (car rest) key) + (and (pair? (cdr rest)) + (cadr rest)) + (loop (cdr rest)))))) + (else + (skribe-error 'sui-key "Illegal `sui' format" sexp)))) + +;*---------------------------------------------------------------------*/ +;* sui-find-ref ... */ +;*---------------------------------------------------------------------*/ +(define (sui-find-ref sui ident opts) + (let ((ident (assq :ident opts)) + (mark (assq :mark opts)) + (class (let ((c (assq :class opts))) + (and (pair? c) (cadr c)))) + (chapter (assq :chapter opts)) + (section (assq :section opts)) + (subsection (assq :subsection opts)) + (subsubsection (assq :subsubsection opts))) + (match sui + (('sui (? string?) . refs) + (cond + (mark (sui-search-ref 'marks refs (cadr mark) class)) + (chapter (sui-search-ref 'chapters refs (cadr chapter) class)) + (section (sui-search-ref 'sections refs (cadr section) class)) + (subsection (sui-search-ref 'subsections refs (cadr subsection) class)) + (subsubsection (sui-search-ref 'subsubsections refs (cadr subsubsection) class)) + (ident (sui-search-all-refs sui ident class)) + (else '()))) + (else + (skribe-error 'sui-find-ref "Illegal `sui' format" sui))))) + +;*---------------------------------------------------------------------*/ +;* sui-search-all-refs ... */ +;*---------------------------------------------------------------------*/ +(define (sui-search-all-refs sui id refs) + '()) + +;*---------------------------------------------------------------------*/ +;* sui-search-ref ... */ +;*---------------------------------------------------------------------*/ +(define (sui-search-ref kind refs val class) + (define (find-ref refs val class) + (map (lambda (r) + (let ((f (memq :file r)) + (c (memq :mark r))) + (cons (and (pair? f) (cadr f)) (and (pair? c) (cadr c))))) + (filter (if class + (lambda (m) + (and (pair? m) + (string? (car m)) + (string=? (car m) val) + (let ((c (memq :class m))) + (and (pair? c) + (eq? (cadr c) class))))) + (lambda (m) + (and (pair? m) + (string? (car m)) + (string=? (car m) val)))) + refs))) + (let loop ((refs refs)) + (if (pair? refs) + (if (and (pair? (car refs)) (eq? (caar refs) kind)) + (find-ref (cdar refs) val class) + (loop (cdr refs))) + '()))) + +;*---------------------------------------------------------------------*/ +;* sui-filter ... */ +;*---------------------------------------------------------------------*/ +(define (sui-filter sui pred1 pred2) + (match sui + (('sui (? string?) . refs) + (let loop ((refs refs) + (res '())) + (if (pair? refs) + (if (and (pred1 (car refs))) + (loop (cdr refs) + (cons (filter pred2 (cdar refs)) res)) + (loop (cdr refs) res)) + (reverse! res)))) + (else + (skribe-error 'sui-filter "Illegal `sui' format" sui)))) -- cgit v1.2.3