diff --git a/lib/chibi/config.scm b/lib/chibi/config.scm index 10193e06..219d585a 100644 --- a/lib/chibi/config.scm +++ b/lib/chibi/config.scm @@ -112,6 +112,23 @@ (define (alist? x) (and (list? x) (every pair? x))) +;;> \subsubsubsection{\rawcode{(assoc-get alist key [equal? [default]])}} + +;;> Utility analogous to \scheme{conf-get} on a pure alist. Returns +;;> the value of the cell in \var{alist} whose car is \var{equal?} to +;;> \var{key}, where the value is determined as the \var{cadr} if the +;;> cell is a proper list of two elements and the \var{cdr} otherwise. +;;> If no cell is found, returns \var{default}, or \scheme{#f} if +;;> unspecified. + +(define (assoc-get alist key . o) + (cond + ((assoc key alist (or (and (pair? o) (car o)) equal?)) + => (lambda (x) + (if (and (pair? (cdr x)) (null? (cddr x))) (cadr x) (cdr x)))) + (else + (and (pair? o) (pair? (cdr o)) (cadr o))))) + ;;> Returns just the base of \var{config} without any parent. (define (conf-head config) diff --git a/lib/chibi/config.sld b/lib/chibi/config.sld index 387bfe4e..6786a54a 100644 --- a/lib/chibi/config.sld +++ b/lib/chibi/config.sld @@ -3,7 +3,8 @@ (export make-conf conf? conf-load conf-load-in-path conf-load-cascaded conf-verify conf-extend conf-append conf-set conf-unfold-key conf-get conf-get-list conf-get-cdr conf-get-multi - conf-specialize read-from-file conf-source conf-head conf-parent) + conf-specialize read-from-file conf-source conf-head conf-parent + assoc-get) (import (scheme base) (scheme read) (scheme write) (scheme file) (scheme time) (srfi 1)) ;; This is only used for config verification, it's acceptable to