From c72a09b779b110b2e189ab2b1872eb89f568605c Mon Sep 17 00:00:00 2001
From: Ludovic Courtes
Date: Sun, 15 Jan 2006 21:22:18 +0000
Subject: Introduced SRFI-3[45] conditions; cleaned up `evaluator.scm'.
* src/guile/skribilo/condition.scm: New.
* src/guile/skribilo/Makefile.am (dist_guilemodule_DATA): Added
`condition.scm'.
* src/guile/skribilo/evaluator.scm (skribe-eval): Renamed to
`evaluate-document'.
(skribe-eval-port): Renamed to `evaluate-document-from-port'.
(skribe-load-options): Renamed to `*load-options*', a fluid.
(skribe-load): Renamed to `load-document'. Use SRFI-34 `raise' when a
file is not found.
(skribe-include): Renamed to `include-document'. Use `raise'.
* src/guile/skribilo/utils/compat.scm (%skribe-known-files): New.
(skribe-load): New.
(skribe-include): New.
(skribe-load-options): New.
(skribe-eval): New.
(skribe-eval-port): New.
* src/skribilo.in: Invoke `call-with-skribilo-error-catch'. Added a
copyright notice.
* src/guile/skribilo.scm (doskribe): Use `evaluate-document-from-port',
not `skribe-eval-port'.
* configure.ac: Look for `(srfi srfi-35)'.
* AUTHORS: Mention that most of the code comes from the STkLos
implementation.
git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-24
---
src/guile/skribilo.scm | 3 +-
src/guile/skribilo/Makefile.am | 3 +-
src/guile/skribilo/condition.scm | 127 ++++++++++++++++++++++++++++++++++++
src/guile/skribilo/evaluator.scm | 124 ++++++++++++++++++++---------------
src/guile/skribilo/utils/compat.scm | 36 ++++++++++
src/skribilo.in | 29 +++++++-
6 files changed, 265 insertions(+), 57 deletions(-)
create mode 100644 src/guile/skribilo/condition.scm
(limited to 'src')
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
@@ -88,6 +101,29 @@
(define-public skribe-source-path *source-path*)
(define-public skribe-bib-path *bib-path*)
+
+;;;
+;;; 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.
diff --git a/src/skribilo.in b/src/skribilo.in
index 4b77c5e..952784a 100755
--- a/src/skribilo.in
+++ b/src/skribilo.in
@@ -1,7 +1,34 @@
#!/bin/sh
+
+# Copyright 2005,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.
+
# The `skribilo' executable.
main='(module-ref (resolve-module '\''(skribilo)) '\'main')'
exec ${GUILE-@GUILE@} --debug \
- -c "(catch #t (lambda () (apply $main (cdr (command-line)))) (lambda (key . args) (format (current-error-port) \"exception \`~a' raised~%\" key) (exit 1)))" "$@"
+ -c "
+(use-modules (skribilo condition))
+(catch #t (lambda ()
+ (call-with-skribilo-error-catch
+ (lambda ()
+ (apply $main (cdr (command-line))))))
+ (lambda (key . args)
+ (format (current-error-port) \"exception \`~a' raised~%\" key)
+ (exit 1)))" "$@"
--
cgit v1.2.3