diff options
Diffstat (limited to 'src/guile')
| -rw-r--r-- | src/guile/skribilo.scm | 3 | ||||
| -rw-r--r-- | src/guile/skribilo/Makefile.am | 3 | ||||
| -rw-r--r-- | src/guile/skribilo/condition.scm | 127 | ||||
| -rw-r--r-- | src/guile/skribilo/evaluator.scm | 124 | ||||
| -rw-r--r-- | src/guile/skribilo/utils/compat.scm | 36 |
5 files changed, 237 insertions, 56 deletions
diff --git a/src/guile/skribilo.scm b/src/guile/skribilo.scm index be914fb..b9805b3 100644 --- a/src/guile/skribilo.scm +++ b/src/guile/skribilo.scm @@ -365,7 +365,8 @@ Processes a Skribilo/Skribe source file and produces its output. (set-current-module (make-run-time-module))) (lambda () ;;(format #t "engine is ~a~%" (*current-engine*)) - (skribe-eval-port (current-input-port) (*current-engine*))) + (evaluate-document-from-port (current-input-port) + (*current-engine*))) (lambda () (set-current-output-port output-port) (set-current-module user-module))))) diff --git a/src/guile/skribilo/Makefile.am b/src/guile/skribilo/Makefile.am index f136956..6689d15 100644 --- a/src/guile/skribilo/Makefile.am +++ b/src/guile/skribilo/Makefile.am @@ -4,6 +4,7 @@ dist_guilemodule_DATA = biblio.scm color.scm config.scm \ lib.scm module.scm output.scm prog.scm \ reader.scm resolve.scm runtime.scm \ source.scm parameters.scm verify.scm \ - writer.scm ast.scm location.scm + writer.scm ast.scm location.scm \ + condition.scm SUBDIRS = utils reader engine package skribe coloring diff --git a/src/guile/skribilo/condition.scm b/src/guile/skribilo/condition.scm new file mode 100644 index 0000000..820dcc5 --- /dev/null +++ b/src/guile/skribilo/condition.scm @@ -0,0 +1,127 @@ +;;; condition.scm -- Skribilo SRFI-35 error condition hierarchy. +;;; +;;; Copyright 2006 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +;;; USA. + +(define-module (skribilo condition) + :autoload (srfi srfi-34) (guard) + :use-module (srfi srfi-35) + :use-module (srfi srfi-39) + :export (&skribilo-error skribilo-error? + &invalid-argument-error invalid-argument-error? + &file-error file-error? + &file-search-error file-search-error? + &file-open-error file-open-error? + &file-write-error file-write-error? + + %call-with-skribilo-error-catch + call-with-skribilo-error-catch)) + +;;; Author: Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; Top-level of Skribilo's SRFI-35 error conditions. +;;; +;;; Code: + + +;;; +;;; Standard error conditions. +;;; + +(define-condition-type &skribilo-error &error + skribilo-error?) + + +;;; +;;; Generic errors. +;;; + +(define-condition-type &invalid-argument-error &skribilo-error + invalid-argument-error? + (proc-name invalid-argument-error:proc-name) + (argument invalid-argument-error:argument)) + + +;;; +;;; File errors. +;;; + +(define-condition-type &file-error &skribilo-error + file-error? + (file-name file-error:file-name)) + +(define-condition-type &file-search-error &file-error + file-search-error? + (path file-search-error:path)) + +(define-condition-type &file-open-error &file-error + file-open-error?) + +(define-condition-type &file-write-error &file-error + file-write-error?) + + + +;;; +;;; Convenience functions. +;;; + +(define (%call-with-skribilo-error-catch thunk exit exit-val) + (guard (c ((invalid-argument-error? c) + (format (current-error-port) "in `~a': invalid argument: ~S~%" + (invalid-argument-error:proc-name c) + (invalid-argument-error:argument c)) + (exit exit-val)) + + ((file-search-error? c) + (format (current-error-port) "~a: not found in path `~S'~%" + (file-error:file-name c) + (file-search-error:path c)) + (exit exit-val)) + + ((file-open-error? c) + (format (current-error-port) "~a: cannot open file~%" + (file-error:file-name c)) + (exit exit-val)) + + ((file-write-error? c) + (format (current-error-port) "~a: cannot write to file~%" + (file-error:file-name c)) + (exit exit-val)) + + ((file-error? c) + (format (current-error-port) "file error: ~a~%" + (file-error:file-name c)) + (exit exit-val)) + + ((skribilo-error? c) + (format (current-error-port) "undefined skribilo error: ~S~%" + c) + (exit exit-val))) + + (thunk))) + +(define-macro (call-with-skribilo-error-catch thunk) + `(call/cc (lambda (cont) + (%call-with-skribilo-error-catch ,thunk cont #f)))) + +;;; arch-tag: 285010f9-06ea-4c39-82c2-6c3604f668b3 + +;;; conditions.scm ends here diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm index c1b378d..002ca54 100644 --- a/src/guile/skribilo/evaluator.scm +++ b/src/guile/skribilo/evaluator.scm @@ -1,7 +1,7 @@ ;;; eval.scm -- Skribilo evaluator. ;;; ;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> -;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; Copyright 2005,2006 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -21,8 +21,8 @@ (define-module (skribilo evaluator) - :export (skribe-eval skribe-eval-port skribe-load skribe-load-options - skribe-include) + :export (evaluate-document evaluate-document-from-port + load-document include-document *load-options*) :autoload (skribilo parameters) (*verbose* *document-path*) :autoload (skribilo location) (<location>) :autoload (skribilo ast) (ast? markup?) @@ -34,26 +34,30 @@ (use-modules (skribilo utils syntax) + (skribilo condition) (skribilo debug) (skribilo output) (skribilo lib) (ice-9 optargs) (oop goops) + (srfi srfi-1) (srfi srfi-13) - (srfi srfi-1)) + (srfi srfi-34) + (srfi srfi-35) + (srfi srfi-39)) (fluid-set! current-reader %skribilo-module-reader) -(define *skribe-loaded* '()) ;; List of already loaded files -(define *skribe-load-options* '()) - ;;; ;;; %EVALUATE ;;; (define (%evaluate expr) + ;; Evaluate EXPR, an arbitrary S-expression that may contain calls to the + ;; markup functions defined in `(skribilo skribe api)', e.g., `(bold + ;; "hello")'. (let ((result (eval expr (current-module)))) (if (ast? result) @@ -68,12 +72,13 @@ - ;;; -;;; SKRIBE-EVAL +;;; EVALUATE-DOCUMENT ;;; -(define* (skribe-eval a e :key (env '())) - (with-debug 2 'skribe-eval +(define* (evaluate-document a e :key (env '())) + ;; Argument A must denote an AST of something like that, not just an + ;; S-exp. + (with-debug 2 'evaluate-document (debug-item "a=" a " e=" (engine-ident e)) (let ((a2 (resolve! a e env))) (debug-item "resolved a=" a) @@ -82,36 +87,38 @@ (output a3 e))))) ;;; -;;; SKRIBE-EVAL-PORT +;;; EVALUATE-DOCUMENT-FROM-PORT ;;; -(define* (skribe-eval-port port engine :key (env '()) - (reader %default-reader)) - (with-debug 2 'skribe-eval-port +(define* (evaluate-document-from-port port engine + :key (env '()) + (reader %default-reader)) + (with-debug 2 'evaluate-document-from-port (debug-item "engine=" engine) (debug-item "reader=" reader) (let ((e (if (symbol? engine) (find-engine engine) engine))) (debug-item "e=" e) (if (not (engine? e)) - (skribe-error 'skribe-eval-port "cannot find engine" engine) + (skribe-error 'evaluate-document-from-port "cannot find engine" engine) (let loop ((exp (reader port))) - (with-debug 10 'skribe-eval-port + (with-debug 10 'evaluate-document-from-port (debug-item "exp=" exp)) (unless (eof-object? exp) - (skribe-eval (%evaluate exp) e :env env) + (evaluate-document (%evaluate exp) e :env env) (loop (reader port)))))))) + ;;; -;;; SKRIBE-LOAD +;;; LOAD-DOCUMENT ;;; -;;; FIXME: Use a fluid for that. -(define *skribe-load-options* '()) +;; Options that may make sense to a specific back-end or package. +(define-public *load-options* (make-parameter '())) -(define (skribe-load-options) - *skribe-load-options*) +;; List of the names of files already loaded. +(define *loaded-files* (make-parameter '())) -(define* (skribe-load file :key (engine #f) (path #f) :rest opt) +(define* (load-document file :key (engine #f) (path #f) :rest opt) (with-debug 4 'skribe-load (debug-item " engine=" engine) (debug-item " path=" path) @@ -122,7 +129,9 @@ ((not path) (*document-path*)) ((string? path) (list path)) ((not (and (list? path) (every? string? path))) - (skribe-error 'skribe-load "illegal path" path)) + (raise (condition (&invalid-argument-error + (proc-name 'load-document) + (argument path))))) (else path)) %load-path)) (filep (or (search-path path file) @@ -135,44 +144,51 @@ ".scm") file)))))) - (set! *skribe-load-options* opt) - (unless (and (string? filep) (file-exists? filep)) - (skribe-error 'skribe-load - (string-append "cannot find `" file "' in path") - path)) - - ;; Load this file if not already done - (unless (member filep *skribe-loaded*) - (cond - ((> (*verbose*) 1) - (format (current-error-port) " [loading file: ~S ~S]\n" filep opt)) - ((> (*verbose*) 0) - (format (current-error-port) " [loading file: ~S]\n" filep))) - ;; Load it - (with-input-from-file filep - (lambda () - (skribe-eval-port (current-input-port) ei))) - (set! *skribe-loaded* (cons filep *skribe-loaded*)))))) + (raise (condition (&file-search-error + (file-name file) + (path path))))) + + ;; Pass the additional options to the back-end and/or packages being + ;; used. + (parameterize ((*load-options* opt)) + + ;; Load this file if not already done + ;; FIXME: Shouldn't we remove this logic? -- Ludo'. + (unless (member filep (*loaded-files*)) + (cond + ((> (*verbose*) 1) + (format (current-error-port) " [loading file: ~S ~S]\n" filep opt)) + ((> (*verbose*) 0) + (format (current-error-port) " [loading file: ~S]\n" filep))) + + ;; Load it + (with-input-from-file filep + (lambda () + (evaluate-document-from-port (current-input-port) ei))) + + (*loaded-files* (cons filep (*loaded-files*)))))))) ;;; -;;; SKRIBE-INCLUDE +;;; INCLUDE-DOCUMENT ;;; -(define* (skribe-include file :key (path (*document-path*)) - (reader %default-reader)) +(define* (include-document file :key (path (*document-path*)) + (reader %default-reader)) ;; FIXME: We should default to `*skribilo-current-reader*'. (unless (every string? path) - (skribe-error 'skribe-include "illegal path" path)) + (raise (condition (&invalid-argument-error (proc-name 'include-document) + (argument path))))) + + (let ((full-path (search-path path file))) + (unless (and (string? full-path) (file-exists? full-path)) + (raise (condition (&file-search-error + (file-name file) + (path path))))) - (let ((path (search-path path file))) - (unless (and (string? path) (file-exists? path)) - (skribe-error 'skribe-load - (format #t "cannot find ~S in path" file) - path)) (when (> (*verbose*) 0) - (format (current-error-port) " [including file: ~S]\n" path)) + (format (current-error-port) " [including file: ~S]\n" full-path)) - (with-input-from-file path + (with-input-from-file full-path (lambda () (let Loop ((exp (reader (current-input-port))) (res '())) diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm index d9a63d6..b6e6420 100644 --- a/src/guile/skribilo/utils/compat.scm +++ b/src/guile/skribilo/utils/compat.scm @@ -20,10 +20,23 @@ (define-module (skribilo utils compat) + :use-module (skribilo utils syntax) :use-module (skribilo parameters) + :use-module (skribilo evaluator) :use-module (srfi srfi-1) + :use-module (ice-9 optargs) :replace (gensym)) +;;; Author: Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; This module defines symbols for compatibility with Skribe 1.2. +;;; +;;; Code: + +(fluid-set! current-reader %skribilo-module-reader) + ;;; ;;; gensym @@ -90,6 +103,29 @@ ;;; +;;; Evaluator. +;;; + +(define %skribe-known-files + ;; Like of Skribe package files and their equivalent Skribilo module. + '(("web-book.skr" . (skribilo packages web-book)))) + +(define*-public (skribe-load file :rest args) + (let ((mod (assoc-ref %skribe-known-files file))) + (if mod + (set-module-uses! (current-module) + (cons mod (module-uses (current-module)))) + (apply load-document file args)))) + +(define-public skribe-include include-document) +(define-public skribe-load-options *load-options*) + +(define-public skribe-eval evaluate-document) +(define-public skribe-eval-port evaluate-document-from-port) + + + +;;; ;;; Compatibility with Bigloo. ;;; |