py-configparser-20131003-svn/0000755000175000017500000000000012223275030014305 5ustar xachxachpy-configparser-20131003-svn/tests/0000755000175000017500000000000012223275030015447 5ustar xachxachpy-configparser-20131003-svn/tests/tests.lisp0000644000175000017500000001543210767300543017520 0ustar xachxach (defpackage #:py-configparser-tests (:use #:cl #:py-configparser #:rt)) (in-package :py-configparser-tests) ;; test 1 ;; should succeed (deftest basic.parser (typep (with-input-from-string (s "[n] p=q z=%(p)s ") (read-stream (make-config) s)) 'config) T) (deftest basic.get-option.1 (with-input-from-string (s "[n] p=q z=%(p)s and some more ") (equal (get-option (read-stream (make-config) s) "n" "z") "q and some more")) T) (deftest basic.get-option.2 (with-input-from-string (s "[n] p=q delta=%(gamma)s z=%(p)s and some more ") (equal (get-option (read-stream (make-config) s) "n" "delta" :defaults '(("gamma" . "the gamma value"))) "the gamma value")) T) (deftest basic.get-option.3 (with-input-from-string (s "[n] p=15 delta=%(gamma)s z=%(p)s and some more ") (equal (get-option (read-stream (make-config) s) "n" "p" :type :number) 15)) T) (deftest basic.get-option.4 (with-input-from-string (s "[n] p=yes delta=%(gamma)s z=%(p)s and some more ") (equal (get-option (read-stream (make-config) s) "n" "p" :type :boolean) T)) T) (deftest basic.get-option.5 (with-input-from-string (s "[n] p=q delta=%(gamma)s z=%(p)s and some more [DEFAULT] gamma=the gamma value ") (equal (get-option (read-stream (make-config) s) "n" "delta") "the gamma value")) T) (deftest basic.sections (with-input-from-string (s "[n] post-section header gunk ignored p=q z=%(p)s ") (equal (sections (read-stream (make-config) s)) '("n"))) T) (deftest basic.comments-only (typep (with-input-from-string (s "#comments only ") (read-stream (make-config) s)) 'config) T) (deftest basic.no-newline (typep (with-input-from-string (s "#comments without trailing \#Newline") (read-stream (make-config) s)) 'config) T) (deftest basic.with-defaults (equal (with-input-from-string (s "[DEFAULT] def-option = options without trailing newline") (get-option (read-stream (make-config) s) "DEFAULT" "def-option")) "options without trailing newline") T) ;; newlines only (deftest basic.newlines-only (with-input-from-string (s " ") (typep (read-stream (make-config) s) 'config)) T) ;; empty lines only (deftest basic.empty-lines-only (with-input-from-string (s " # The next two lines intentionally contain spaces-only ") (typep (read-stream (make-config) s) 'config)) T) ;; options (deftest basic.options (equal (with-input-from-string (s "[n] p=q z=%(p)s ") (options (read-stream (make-config) s) "n")) '("z" "p")) T) ;; items (deftest basic.items.1 (equal (with-input-from-string (s "[n] p=q z=%(p)s ") (items (read-stream (make-config) s) "n" :expand nil)) '(("z" . "%(p)s") ("p" . "q"))) T) (deftest basic.items.2 (equal (with-input-from-string (s "[n] p=q z=%(p)s ") (items (read-stream (make-config) s) "n" :expand t)) '(("z" . "q") ("p" . "q"))) T) (deftest basic.items.3 (equal (with-input-from-string (s "[n] p=q delta=%(gamma)s z=%(p)s ") (items (read-stream (make-config) s) "n" :expand t :defaults '(("gamma" . "the gamma")))) '(("z" . "q") ("delta" . "the gamma") ("p" . "q"))) T) ;; sections (deftest basic.sections.1 (equal (with-input-from-string (s "[n] p=q z=%(p)s [v] [t] ") (sections (read-stream (make-config) s))) '("t" "v" "n")) T) (deftest basic.sections.2 (equal (with-input-from-string (s "[n] p=q z=%(p)s [v] [t] [DEFAULT] p=t ") (sections (read-stream (make-config) s))) '("t" "v" "n")) T) ;; add-section (deftest basic.add-section (with-input-from-string (s "[n] p=q z=%(p)s [t] ") (let ((c (read-stream (make-config) s))) (unless (has-section-p c "v") (add-section c "v") (not (null (has-section-p c "v")))))) T) ;; set-option (deftest basic.set-option.1 (with-input-from-string (s "[n] p=q z=%(p)s [t] ") (let ((c (read-stream (make-config) s))) (unless (has-option-p c "t" "b") (set-option c "t" "b" "ok") (equal (get-option c "t" "b") "ok")))) T) (deftest basic.set-option.2 (with-input-from-string (s "[n] p=q z=%(p)s [t] ") (let ((c (read-stream (make-config) s))) (set-option c "n" "p" "ok") (equal (get-option c "n" "p") "ok"))) T) ;; remove-option (deftest basic.remove-option (with-input-from-string (s "[n] p=q z=%(p)s [t] ") (let ((c (read-stream (make-config) s))) (when (has-option-p c "n" "p") (remove-option c "n" "p") (null (has-option-p c "n" "p"))))) T) ;; remove-section (deftest basic.remove-section (with-input-from-string (s "[n] p=q z=%(p)s [t] ") (let ((c (read-stream (make-config) s))) (when (has-section-p c "t") (remove-section c "t") (null (has-section-p c "t"))))) T) ;; now the tests that fail (deftest failures.no-header (with-input-from-string (s "option-before = section [header]") (handler-case (progn (read-stream (make-config) s) nil) (missing-section-header-error () T))) T) (deftest failures.no-spaced-option-names (with-input-from-string (s "[n] option with space = not allowed ") (handler-case (progn (read-stream (make-config) s) nil) (parsing-error () T))) T) (deftest failures.recursion (with-input-from-string (s "[n] p=%(z)s z=%(p)s ") (handler-case (get-option (read-stream (make-config) s) "n" ;; section "p" ;; option :expand t) (interpolation-depth-error () T))) T) ;; non-erroring non-parsing tests (deftest miscelaneous (with-input-from-string (s "[n] p=%(__name__)s q=%(z)s z=hello ") (let ((p (read-stream (make-config) s))) (unless (string= (get-option p "n" "p" :expand t) "n") (error "Unexpected output")) (unless (string= (get-option p "n" "q" :expand nil) "%(z)s") (error "Unexpected output")) (unless (string= (get-option p "n" "q" :expand t) "hello") (error "Unexpected output")) (unless (string= (get-option p "n" "z") "hello") (error "Unexpected output")) NIL)) NIL)py-configparser-20131003-svn/tests/py-configparser-tests.asd0000644000175000017500000000067010766556510022432 0ustar xachxach (in-package #:cl-user) (defpackage #:py-configparser-tests-system (:use #:cl #:asdf)) (in-package #:py-configparser-tests-system) (defsystem py-configparser-tests :name "py-configparser-tests" :author "Erik Huelsmann" :version "1.0-dev" :license "MIT" :description "Tests for 'Common Lisp implementation of the Python ConfigParser module'" :depends-on (#:py-configparser) :components ((:file "tests"))) py-configparser-20131003-svn/README0000644000175000017500000000424010766556510015204 0ustar xachxach$URL: svn://common-lisp.net/project/py-configparser/svn/trunk/README $ $Id: README 19 2008-03-14 20:17:12Z ehuelsmann $ py-configparser =============== This package provides the same functionality as the Python configparser module, implemented in pure Common Lisp. Differences between the two =========================== The CL version makes a strong distinction in the parser on one hand and the in-memory storage management on the other hand. Because of it, the CL version doesn't call its objects 'Parser', but 'config' instead. The parser/writer part of the package provides the three functions READ-STREAM, READ-FILES and WRITE-STREAM, which map from the python variants 'readfp', 'read' and 'write'. API mapping =========== The functions provided in the Python module (which are all methods of the ConfigParser class): ConfigParser() -> (make-config) defaults() -> (defaults ) sections() -> (sections ) add_section(name) -> (add-section name) has_section(name) -> (has-section-p name) options(section_name) -> (options section-name) has_option(section_name, name) -> (has-option-p section-name name) read(filenames) -> (read-files filenames) readfd(fp) -> (read-stream stream) get(section, option[, raw[, vars]]) -> (get-option section option &key expand defaults type) getint(section, option) -> [folded into get-option using 'type' key] getfloat(section, option) -> [folded into get-option using 'type' key] getboolean(section, option) -> [folded into get-option using 'type' key] items(section_name[, raw[, vars]]) -> (items section-name &key expand defaults) set(section, option, value) -> (set-option section-name option-name value) write(fp) -> (write-stream stream) remove_option(section, option) -> (remove-option section-name option-name) remove_section(section) -> (remove-section section-name) Note that the above is just a simple mapping table, but is all you need to get you started. Documentation from the ConfigParser module should sufficiently document this package. However minor differences in parameter and method naming may occur. py-configparser-20131003-svn/package.lisp0000644000175000017500000000313411155307143016576 0ustar xachxach ;; This package is actuall two things: ;; 1) a configuration management utility ;; 2) a configuration file parser/writer in the .INI format ;; ;; But in the Python module this distinction hasn't been implemented ;; this stringently, meaning we're stuck to the current naming scheme. ;; There's no reason however that you can't create your own format ;; and parse that, storing it in the config object as defined in this ;; package. (However, if you already use this module, you might as well ;; use the INI format as persistent format.) (cl:defpackage #:py-configparser (:use #:cl) (:export ;; common condition class #:configparser-error ;; configuration storage type #:config ;; Configuration management ;; Error classes #:no-section-error #:duplicate-section-error #:no-option-error #:interpolation-error #:interpolation-depth-error #:interpolation-missing-option-error #:interpolation-syntax-error ;; Functions #:make-config #:defaults #:sections #:has-section-p #:add-section #:options #:has-option-p #:get-option #:set-option #:items #:remove-option #:remove-section ;; Configuration file parsing ;; Error classes #:parsing-error #:missing-section-header-error ;; Functions #:read-stream #:read-files #:write-stream)) py-configparser-20131003-svn/py-configparser.asd0000644000175000017500000000100710766556510020123 0ustar xachxach (in-package #:cl-user) (defpackage #:py-configparser-system (:use #:cl #:asdf)) (in-package #:py-configparser-system) (defsystem py-configparser :name "py-configparser" :author "Erik Huelsmann" :version "1.1-dev" :license "MIT" :description "Common Lisp implementation of the Python ConfigParser module" :depends-on (#:parse-number) :components ((:file "package") (:file "config" :depends-on ("package")) (:file "parser" :depends-on ("config")))) py-configparser-20131003-svn/LICENSE0000644000175000017500000000222010766556510015325 0ustar xachxach(This is the MIT / X Consortium license as taken from http://www.opensource.org/licenses/mit-license.html) Copyright (c) 2008 Erik Huelsmann Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. py-configparser-20131003-svn/parser.lisp0000644000175000017500000001720611024676425016513 0ustar xachxach (cl:in-package #:py-configparser) (declaim (special *line-no* *current-section* *file-name* *current-input*)) ;; Errors for the parsing side (define-condition parsing-error (configparser-error) ((line-no :initarg :line-no :initform *line-no* :reader line) (file :initarg :file :initform *file-name* :reader file) (section :initarg :section :initform *current-section* :reader section) (message :initarg :text :reader message)) (:report (lambda (c stream) (format stream "~A at line ~A" (message c) (line c))))) (define-condition missing-section-header-error (parsing-error) ()) ;; The reader (declaim (inline %read-char %unread-char)) (defun %read-char (stream) (let ((ch (read-char stream nil :eof))) (when (eql ch #\Newline) (incf *line-no*)) (if (eq ch :eof) #\Newline ch))) (defun ensure-section (config section-name) (handler-case (%get-section config section-name) (no-section-error () (add-section config section-name)))) (defun is-whitespace (c) (or (eq c #\Space) (eq c #\Tab) (eq c #\Return))) (defun is-comment-char (c) (or (eq c #\;) (eq c #\#))) (defun skip-whitespace (s) (loop for c = (%read-char s) while (is-whitespace c))) (defun skip-empty-line (s) (loop for c = (%read-char s) if (eq c #\Newline) do (return) else unless (is-whitespace c) do (error 'parsing-error :text "Non-empty line found where empty expected."))) ;; empty line expected (defun skip-to-eol (s) (loop for c = (%read-char s) until (eq c #\Newline))) (defun expect-char (s expect &key skip-whitespace) (let ((ch (%read-char s))) (when (and skip-whitespace (is-whitespace ch)) (loop for c = (%read-char s) while (is-whitespace c) finally (setf ch c))) (unless (eq ch expect) (error 'parsing-error :text (format nil "Character ~A expected, but ~A found instead." expect ch))) ;; character expect expected, but ch found ch)) (defun expect-one-of (s expect-bag &key skip-whitespace) (let ((ch (%read-char s))) (when (and skip-whitespace (is-whitespace ch)) (loop for c = (%read-char s) while (is-whitespace c) finally (setf ch c))) (unless (member ch expect-bag) ;; character ch found, but looking for EXPECT-BAG (error 'parsing-error :text (format nil "Character ~A found, but one of ~A expected." ch expect-bag))) ch)) (defun make-input-buffer (p) (declare (ignore p)) (make-array 20 :element-type 'cl:character :fill-pointer 0 :adjustable t)) (declaim (inline extend-input)) (defun extend-input (p c) (vector-push-extend c *current-input* 20)) (defun finalize-input (p) (let ((cp *current-input*)) (setf *current-input* (make-input-buffer p)) cp)) (defun read-section-name (p s) (expect-char s #\[) (loop for c = (%read-char s) if (eq c #\Newline) do (error 'parsing-error :text "Premature end of line, or end of line in section name.") ;; we can't have newlines in section names! else if (eq c #\]) do (progn (skip-to-eol s) (return (finalize-input p))) else do (extend-input p c))) (defun read-option-name (p s) (loop for c = (%read-char s) if (or (eq c #\:) (eq c #\=)) do (let ((option-name (finalize-input p))) (when (= 0 (length option-name)) (error 'parsing-error :text "No option name found.")) ;; No option name found (return option-name)) else if (is-whitespace c) do (unread-char (expect-one-of s '(#\: #\=) :skip-whitespace t) s) else do (extend-input p c))) (defun read-option-value (p s &key (leading-white :skip)) (let ((leading-mode t) (lead-detected nil)) (loop for c = (%read-char s) unless (or (eql c #\Return) (eql c #\Newline)) do (if (and leading-mode (is-whitespace c)) (setf lead-detected t) (progn (when (and (eq leading-white :fold) leading-mode lead-detected) (extend-input p #\Space)) (setf leading-mode nil) (extend-input p c))) if (and (eql c #\Newline) (let ((ch (peek-char nil s nil nil))) (or (eql ch #\Space) (eql ch #\Tab)))) do (return (read-option-value p s :leading-white :fold)) until (eql c #\Newline) finally (return (finalize-input p))))) (defun reading-driver (p s) (let ((*line-no* 0) (*current-section* nil) (*current-input* (make-input-buffer p))) (loop for c = (peek-char nil s nil :eof) until (eq c :eof) if (eql c #\[) do (setf *current-section* (section-name (ensure-section p (read-section-name p s)))) else if (is-whitespace c) do (skip-empty-line s) else if (is-comment-char c) do (skip-to-eol s) else if (eql c #\Newline) do (%read-char s) ;; skip over the newline character else do (if (null *current-section*) (error 'missing-section-header-error :text (format nil "Missing section header; found ~A instead." c)) (set-option p *current-section* (read-option-name p s) (read-option-value p s)))))) ;; ;; The API ;; (defun read-files (config filenames) "Parses the files given in the list `filenames', if they exist. The list is processed first to last, overwriting any pre-existing values with the last value read. The results are stored in `config' which is modified destructively. Returns as values the configuration and the list of files actually read." (let (files-read) (dolist (filename (remove-if-not #'probe-file filenames) (values config files-read)) (with-open-file (s filename :direction :input :if-does-not-exist :error) (read-stream config s :stream-name filename)) (push filename files-read)))) (defun read-stream (config stream &key (stream-name "an unknown stream")) "Parses the content of `stream' as a configuration file, storing any values in `config' which is modified destructively. This function maps from the python 'readfp()' function." (let ((*file-name* stream-name)) (reading-driver config stream) config)) (defun %format-value (value) (if (and (numberp value) (not (integerp value))) (format nil "~,,,,,,'eE" value) value)) (defun write-stream (config stream) "Writes the configuration file corresponding to the in-memory config state. Reloading the file with `read-stream' or `read-files' will restore config state." (flet ((write-section (section) (format stream "[~a]~%" (section-name section)) (format stream "~:{~A = ~{~A~%~}~}~%" (mapcar #'(lambda (option) (list (car option) (list (%format-value (cdr option))))) (section-options section))))) (let ((*print-radix* nil) (*print-base* 10)) ;; set the printer output as expected by python (when (defaults config) ;; write the defaults too!! (write-section (config-defaults config))) (mapcar #'write-section (config-sections config))))) py-configparser-20131003-svn/config.lisp0000644000175000017500000002657412210625364016466 0ustar xachxach (cl:in-package :py-configparser) ;; The conditions (errors) (define-condition configparser-error (error) ()) ;; Errors for the configuration management side (define-condition config-error (configparser-error) ()) (define-condition no-section-error (config-error) ()) (define-condition duplicate-section-error (config-error) ()) (define-condition no-option-error (config-error) ()) (define-condition interpolation-error (config-error) ()) (define-condition interpolation-depth-error (interpolation-error) ()) (define-condition interpolation-missing-option-error (interpolation-error) ()) (define-condition interpolation-syntax-error (interpolation-error) ()) ;; ;; Configuration storage and management routines ;; ;; The structures ;; Note: because ABCL has issues with its CLOS support ;; (as per 1-1-2008), we use structures below to ;; be maximally portable. (defstruct section name options) (defstruct config (defaults (make-section :name "DEFAULT")) sections (option-name-transform-fn #'string-downcase) (section-name-transform-fn #'identity)) (defun norm-option-name (config option-name) (funcall (config-option-name-transform-fn config) option-name)) (defun norm-section-name (config section-name) (funcall (config-section-name-transform-fn config) section-name)) (defun %validate-section-name (name) (when (or (= 0 (length name)) (find #\] name) (find #\Newline name) (find #\Return name)) (error 'no-section-error)) ;; Invalid section name, signal so. name) (defun %validate-option-name (name) (when (or (= 0 (length name)) (eql (aref name 0) #\[) (find #\Space name) (find #\Tab name) (find #\Return name) (find #\Newline name)) (error 'no-option-error));; No such option error name) ;; non-API (defun %get-section (config section-name) (if (string= "DEFAULT" section-name) (config-defaults config) (let* ((norm-section-name (norm-section-name config section-name)) (section (find norm-section-name (config-sections config) :key #'section-name :test #'string=))) (unless section (error 'no-section-error)) ;; no-such-section error section))) ;; non-API (defun %get-option (config section-name option-name if-does-not-exist) (let* ((section (%get-section config section-name)) (norm-option (norm-option-name config option-name)) (option (or (assoc norm-option (section-options section) :test #'string=) (assoc norm-option (section-options (config-defaults config)) :test #'string=)))) (if (null option) (if (eq if-does-not-exist :error) (error 'no-option-error) ;; no such option error (values (car (push (list (%validate-option-name norm-option)) (section-options section))) section)) (values option section)))) ;; ;; The API ;; (defun defaults (config) "Returns an alist containing instance wide defaults, where the elements are 2-element dotted lists: the CDR is the value associated with the key." (section-options (config-defaults config))) (defun sections (config) "Returns a list of names of defined sections." (mapcar #'section-name (config-sections config))) (defun has-section-p (config section-name) "Returns `NIL' when the section is not added to the config yet, some other value if it is." (handler-case (%get-section config section-name) (no-section-error () nil))) (defun add-section (config section-name) "Adds a new section to the config. If the section exists, the `duplicate-section-error' is raised." (%validate-section-name section-name) (let ((norm-section-name (funcall (config-section-name-transform-fn config) section-name))) (when (has-section-p config section-name) (error 'duplicate-section-error)) (car (push (make-section :name norm-section-name) (config-sections config))))) (defun options (config section-name) "Returns a list of option names which are defined in the given section." (let ((section (%get-section config section-name))) (mapcar #'first (section-options section)))) (defun has-option-p (config section-name option-name) "Returns a generalised boolean with a value of `NIL' when the specified option does not exist in the specified section and some other value otherwise." (handler-case (%get-option config section-name option-name :error) (no-option-error () nil))) ;; non-API (defun %extract-replacement (option-value) ;; Returns: (VALUES replacement-option start end) or NIL (let ((%-pos (position #\% option-value))) (when (and %-pos (< (+ 3 %-pos) (length option-value)) (eql (aref option-value (1+ %-pos)) #\( )) (let ((paren-pos (position #\) option-value :start %-pos))) (unless (and paren-pos (< (1+ paren-pos) (length option-value)) (eql (aref option-value (1+ paren-pos)) #\s)) (error 'interpolation-syntax-error)) ;; syntax error: %(..)s is minimally required (when (<= 0 (- paren-pos %-pos 2)) (let ((replacement-name (make-array (- paren-pos %-pos 2) :element-type (array-element-type option-value) :displaced-to option-value :displaced-index-offset (+ 2 %-pos)))) (when (= 0 (length replacement-name)) ;; some preconditions on replacement-name (error 'interpolation-syntax-error)) (values replacement-name %-pos (1+ paren-pos)))))))) ;; non-API (defun %option-value (config section option-name &key defaults) (if (string= option-name "__name__") (section-name section) (let* ((norm-option-name (norm-option-name config option-name)) (option (has-option-p config (section-name section) option-name))) (if option (cdr option) (labels ((get-value (repositories) (when (null repositories) (error 'interpolation-missing-option-error)) ;; no such option error (let ((value (assoc norm-option-name (car repositories) :test #'string=))) (if value (cdr value) (get-value (cdr repositories)))))) (get-value (list (section-options section) defaults (defaults config)))))))) ;; non-API (defun %expand-option-value (config section option-value defaults &optional dependees) (multiple-value-bind (replacement-name start end) (%extract-replacement option-value) (unless replacement-name ;; nothing to do here... (return-from %expand-option-value option-value)) (let ((norm-replacement (norm-option-name config replacement-name)) (replacement-value (%option-value config section replacement-name :defaults defaults))) (when (member norm-replacement dependees :test #'string=) (error 'interpolation-depth-error)) ;; recursive dependency... (%expand-option-value config section (concatenate 'string (subseq option-value 0 start) (%expand-option-value config section replacement-value defaults (cons norm-replacement dependees)) (subseq option-value (1+ end) (length option-value))) defaults dependees)))) (defun get-option (config section-name option-name &key (expand t) defaults type) "Returns the value of the specified option in the specified section. If `expand' is `NIL', any options which depend on other options won't be expanded and the raw configuration value is returned. When `defaults' is an alist of which the elements are dotted lists of key/value pairs, these values are used in the expansion of option values. `type' may be one of `:boolean', `:number' or it may remain unspecified." (multiple-value-bind (option section) (%get-option config section-name option-name :error) (flet ((convert-boolean (v) (cond ((member v '("1" "yes" "true" "on") :test #'string=) T) ((member v '("0" "no" "false" "off") :test #'string=) NIL) (t (error 'not-a-boolean)))) (convert-number (v) (parse-number:parse-number v))) (let ((string-value (if expand (%expand-option-value config section (cdr option) defaults (list option-name)) (cdr option)))) (cond ((eq type :boolean) (convert-boolean string-value)) ((eq type :number) (convert-number string-value)) ((null type) string-value) (t (error "Illegal `type' parameter value."))))))) (defun set-option (config section-name option-name value) "Sets the value of the specified option in the specified section. If the section does not exist, a `no-section-error' is raised. If the option does not exist, it is created." (let ((option (%get-option config section-name option-name :create))) (setf (cdr option) value))) (defun items (config section-name &key (expand t) defaults) "Returns an alist of which the items are dotted lists of key/value pairs being the option names and values specified in the given section. When `expand' is `NIL', options are returned in raw form. Otherwise option values are expanded. The definition of `defaults' is the same as for `get-option'." (let ((section (%get-section config section-name))) (if expand (mapcar #'(lambda (x) (cons (car x) (get-option config section-name (car x) ;; option-name :expand expand :defaults defaults))) (section-options section)) (section-options section)))) (defun remove-option (config section-name option-name) "Remove the specified option from the given section." (multiple-value-bind (option section) (%get-option config section-name option-name :error) (setf (section-options section) (remove option (section-options section))))) (defun remove-section (config section-name) "Remove the specified section. In case the section name equals the magic name `DEFAULT', an error is raised, since this section can't be removed." (when (string= section-name "DEFAULT") (error 'no-section-error)) ;; no such section error (let ((section (%get-section config section-name))) (setf (config-sections config) (remove section (config-sections config)))))