|
|
@@ -1,10 +1,14 @@
|
|
|
;;;; config-parser.lisp
|
|
|
|
|
|
+#+quicklisp (ql:quickload :parse-number)
|
|
|
+
|
|
|
(defpackage #:config-parser
|
|
|
(:use :esrap
|
|
|
:cl)
|
|
|
(:import-from #:parse-number
|
|
|
- #:parse-number))
|
|
|
+ #:parse-number)
|
|
|
+ (:export open-configuration-file
|
|
|
+ write-configuration-file))
|
|
|
|
|
|
(in-package #:config-parser)
|
|
|
|
|
|
@@ -81,6 +85,49 @@
|
|
|
(loop for block in blocks
|
|
|
append block)))
|
|
|
|
|
|
-(defun open-configuration-file (filename))
|
|
|
-
|
|
|
-(defun write-configuration-file (filename))
|
|
|
+(defun open-configuration-file (filename)
|
|
|
+ (parse 'file
|
|
|
+ (concatenate 'string
|
|
|
+ (with-open-file (input-file filename)
|
|
|
+ (loop for char = (read-char input-file nil 'foo)
|
|
|
+ until (eq char 'foo)
|
|
|
+ collect char)))))
|
|
|
+
|
|
|
+(defun write-identifier (identifier alist stream)
|
|
|
+ (format stream "~a" (getf alist identifier)))
|
|
|
+
|
|
|
+(defun write-string-out (string stream)
|
|
|
+ (format stream "\"~a\"" string))
|
|
|
+
|
|
|
+(defun write-block-title (identifier alist stream)
|
|
|
+ (format stream "~%[")
|
|
|
+ (write-identifier identifier alist stream)
|
|
|
+ (format stream "]~&"))
|
|
|
+
|
|
|
+(defun write-path (id1 id2 alist stream)
|
|
|
+ (write-identifier id1 alist stream)
|
|
|
+ (format stream "/")
|
|
|
+ (write-identifier id2 alist stream))
|
|
|
+
|
|
|
+(defun write-expression (lhs rhs alist stream)
|
|
|
+ (format stream "~&")
|
|
|
+ (write-identifier lhs alist stream)
|
|
|
+ (format stream " = ")
|
|
|
+ (if (typep rhs 'string)
|
|
|
+ (write-string-out rhs stream)
|
|
|
+ (if (typep rhs 'list)
|
|
|
+ (write-path (car rhs) (cadr rhs) alist stream)
|
|
|
+ (format stream "~a" rhs)))
|
|
|
+ (format stream "~&"))
|
|
|
+
|
|
|
+(defun write-correct (stream alist toplevel-p config-list)
|
|
|
+ (if toplevel-p
|
|
|
+ (if (listp (car config-list))
|
|
|
+ (write-correct stream alist nil (cdr config-list))
|
|
|
+ (write-block-title (car config) alist stream))
|
|
|
+ (loop for (lhs rhs) in config-list
|
|
|
+ do (write-expression lhs rhs alist config-list))))
|
|
|
+
|
|
|
+(defun write-configuration-file (filename config key-to-text-alist)
|
|
|
+ (with-open-file (output-file filename :direction :output :if-exists :overwrite :if-does-not-exist :create)
|
|
|
+ (write-correct output-file key-to-text-alist t config)))
|
