summaryrefslogtreecommitdiff
path: root/skribe/src/bigloo/configure.bgl
diff options
context:
space:
mode:
Diffstat (limited to 'skribe/src/bigloo/configure.bgl')
-rw-r--r--skribe/src/bigloo/configure.bgl90
1 files changed, 90 insertions, 0 deletions
diff --git a/skribe/src/bigloo/configure.bgl b/skribe/src/bigloo/configure.bgl
new file mode 100644
index 0000000..e100d8d
--- /dev/null
+++ b/skribe/src/bigloo/configure.bgl
@@ -0,0 +1,90 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/configure.bgl */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Jul 23 18:42:21 2003 */
+;* Last change : Mon Feb 9 06:51:11 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The general configuration options. */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_configure
+ (export (skribe-release)
+ (skribe-url)
+ (skribe-doc-dir)
+ (skribe-ext-dir)
+ (skribe-default-path)
+ (skribe-scheme)
+
+ (skribe-configure . opt)
+ (skribe-enforce-configure . opt)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-configuration ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-configuration)
+ `((:release ,(skribe-release))
+ (:scheme ,(skribe-scheme))
+ (:url ,(skribe-url))
+ (:doc-dir ,(skribe-doc-dir))
+ (:ext-dir ,(skribe-ext-dir))
+ (:default-path ,(skribe-default-path))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-configure ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-configure . opt)
+ (let ((conf (skribe-configuration)))
+ (cond
+ ((null? opt)
+ conf)
+ ((null? (cdr opt))
+ (let ((cell (assq (car opt) conf)))
+ (if (pair? cell)
+ (cadr cell)
+ 'void)))
+ (else
+ (let loop ((opt opt))
+ (cond
+ ((null? opt)
+ #t)
+ ((not (keyword? (car opt)))
+ #f)
+ ((or (null? (cdr opt)) (keyword? (cadr opt)))
+ #f)
+ (else
+ (let ((cell (assq (car opt) conf)))
+ (if (and (pair? cell)
+ (if (procedure? (cadr opt))
+ ((cadr opt) (cadr cell))
+ (equal? (cadr opt) (cadr cell))))
+ (loop (cddr opt))
+ #f)))))))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-enforce-configure ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-enforce-configure . opt)
+ (let loop ((o opt))
+ (when (pair? o)
+ (cond
+ ((or (not (keyword? (car o)))
+ (null? (cdr o)))
+ (error 'skribe-enforce-configure
+ "Illegal enforcement"
+ opt))
+ ((skribe-configure (car o) (cadr o))
+ (loop (cddr o)))
+ (else
+ (error 'skribe-enforce-configure
+ (format "Configuration mismatch: ~a" (car o))
+ (if (procedure? (cadr o))
+ (format "provided `~a'"
+ (skribe-configure (car o)))
+ (format "provided `~a', required `~a'"
+ (skribe-configure (car o))
+ (cadr o)))))))))