API enhancements
This commit is contained in:
@@ -10,16 +10,16 @@
|
||||
ini-get
|
||||
ini-set!
|
||||
make-ini
|
||||
get-ini-file
|
||||
get-ini-file
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Supporting functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (get-ini-file f)
|
||||
(if (symbol? f)
|
||||
(let* ((pref-dir (find-system-path 'pref-dir)))
|
||||
(build-path pref-dir (string-append (symbol->string f) ".ini")))
|
||||
(build-path f)))
|
||||
|
||||
(define-struct ini-cfg
|
||||
(contents #:mutable #t)
|
||||
)
|
||||
|
||||
(define (output-value v out)
|
||||
(cond
|
||||
@@ -47,6 +47,49 @@
|
||||
(define (key=? key inp-key)
|
||||
(section=? key inp-key))
|
||||
|
||||
|
||||
(define re-num #px"^([+]|[-])?([0-9]+([.]([0-9]+))?)$")
|
||||
(define re-bool #px"^(#f|#t|true|false)$")
|
||||
(define re-value #px"^VALUE:(.*)$")
|
||||
(define re-serialize #px"^SER:(.*)$")
|
||||
(define re-path #px"^PATH:(.*)$")
|
||||
|
||||
(define (interpret s)
|
||||
(let ((sr (regexp-match re-serialize s)))
|
||||
(if (eq? sr #f)
|
||||
(let ((m (regexp-match re-value s)))
|
||||
(if (eq? m #f)
|
||||
(let ((p (regexp-match re-path s)))
|
||||
(if (eq? p #f)
|
||||
(let ((ss (string-downcase (string-trim s))))
|
||||
(let ((m-num (regexp-match re-num ss)))
|
||||
(if (eq? m-num #f)
|
||||
(let ((m-b (regexp-match re-bool ss)))
|
||||
(if (eq? m-b #f)
|
||||
s
|
||||
(if (or (string=? ss "#t") (string=? ss "true"))
|
||||
#t
|
||||
#f)
|
||||
))
|
||||
(string->number (car m-num)))))
|
||||
(string->path (cadr p))))
|
||||
(let* ((content (cadr m)))
|
||||
(with-handlers ([exn? (λ (e) content)])
|
||||
(with-input-from-string content read)))))
|
||||
(let ((content (cadr sr)))
|
||||
(deserialize (with-input-from-string content read))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Public API
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (get-ini-file f)
|
||||
(if (symbol? f)
|
||||
(let* ((pref-dir (find-system-path 'pref-dir)))
|
||||
(build-path pref-dir (string-append (symbol->string f) ".ini")))
|
||||
(build-path f)))
|
||||
|
||||
|
||||
(define (ini->file ini file #:private? [private? #f])
|
||||
(let* ((file (get-ini-file file))
|
||||
(_ (make-parent-directory* file))
|
||||
@@ -91,40 +134,10 @@
|
||||
lines))))
|
||||
(mcdr ini)))
|
||||
(close-output-port out)))
|
||||
|
||||
(define (make-ini)
|
||||
(mcons 'ini (list)))
|
||||
|
||||
(define re-num #px"^([+]|[-])?([0-9]+([.]([0-9]+))?)$")
|
||||
(define re-bool #px"^(#f|#t|true|false)$")
|
||||
(define re-value #px"^VALUE:(.*)$")
|
||||
(define re-serialize #px"^SER:(.*)$")
|
||||
(define re-path #px"^PATH:(.*)$")
|
||||
|
||||
(define (interpret s)
|
||||
(let ((sr (regexp-match re-serialize s)))
|
||||
(if (eq? sr #f)
|
||||
(let ((m (regexp-match re-value s)))
|
||||
(if (eq? m #f)
|
||||
(let ((p (regexp-match re-path s)))
|
||||
(if (eq? p #f)
|
||||
(let ((ss (string-downcase (string-trim s))))
|
||||
(let ((m-num (regexp-match re-num ss)))
|
||||
(if (eq? m-num #f)
|
||||
(let ((m-b (regexp-match re-bool ss)))
|
||||
(if (eq? m-b #f)
|
||||
s
|
||||
(if (or (string=? ss "#t") (string=? ss "true"))
|
||||
#t
|
||||
#f)
|
||||
))
|
||||
(string->number (car m-num)))))
|
||||
(string->path (cadr p))))
|
||||
(let* ((content (cadr m)))
|
||||
(with-handlers ([exn? (λ (e) content)])
|
||||
(with-input-from-string content read)))))
|
||||
(let ((content (cadr sr)))
|
||||
(deserialize (with-input-from-string content read))))))
|
||||
|
||||
(define (file->ini file*)
|
||||
(let* ((file (get-ini-file file*))
|
||||
(lines (if (file-exists? file) (file->lines file) '()))
|
||||
|
||||
Reference in New Issue
Block a user