diff options
Diffstat (limited to 'src/bigloo/configure.bgl')
-rw-r--r-- | src/bigloo/configure.bgl | 90 |
1 files changed, 0 insertions, 90 deletions
diff --git a/src/bigloo/configure.bgl b/src/bigloo/configure.bgl deleted file mode 100644 index e100d8d..0000000 --- a/src/bigloo/configure.bgl +++ /dev/null @@ -1,90 +0,0 @@ -;*=====================================================================*/ -;* 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))))))))) |