85 lines
3.4 KiB
Common Lisp
85 lines
3.4 KiB
Common Lisp
(uiop:define-package :sextant/files/config
|
|
(:use :cl :sextant/files/paths)
|
|
(:export #:set-config-package
|
|
#:defconfig
|
|
#:load-config-file
|
|
#:save-config-file))
|
|
(in-package :sextant/files/config)
|
|
|
|
(defvar config-package nil)
|
|
(defvar config-probe ";;; Auto generated from here, do not edit")
|
|
|
|
(defun set-config-package (package)
|
|
(setf config-package package))
|
|
|
|
(defmacro defconfig (symbol default &key get set validate doc)
|
|
`(prog2
|
|
(declaim (special ,symbol))
|
|
(setf ,symbol ,default)
|
|
(export ',symbol)
|
|
,(let ((getter (intern (concatenate 'string "GET-" (symbol-name symbol)))))
|
|
`(progn
|
|
,(if get
|
|
`(defun ,getter ,(first get)
|
|
,@(rest get))
|
|
`(defun ,getter () ,symbol))
|
|
(export ',getter)))
|
|
,(let ((setter (intern (concatenate 'string "SET-" (symbol-name symbol)))))
|
|
`(progn
|
|
,(if set
|
|
`(defun ,setter ,(first set)
|
|
,@(rest set))
|
|
`(defun ,setter (value) (setf ,symbol value)))
|
|
(export ',setter)))
|
|
,(let ((validator (intern (concatenate 'string "VALIDATE-" (symbol-name symbol)))))
|
|
`(progn
|
|
,(if validate
|
|
`(defun ,validator ,(first validate)
|
|
,@(rest validate))
|
|
`(defun ,validator (value) (declare (ignore value))t))
|
|
(export ',validator)))
|
|
,(when doc
|
|
`(setf (documentation ,symbol 'variable) ,doc))))
|
|
|
|
(defun load-config-file (filename)
|
|
"Load `filename' from standard config path."
|
|
(let ((config-pathname (config-filepath filename)))
|
|
(when (probe-file config-pathname)
|
|
(load config-pathname))))
|
|
|
|
(defun save-config-file (filename)
|
|
"Save config values to `filename'."
|
|
(let* ((config-pathname (config-filepath filename))
|
|
(config-string (with-open-file (stream config-pathname :if-does-not-exist nil)
|
|
(when stream
|
|
(let ((str (make-string (file-length stream))))
|
|
(read-sequence str stream)
|
|
str)))))
|
|
(with-open-file (stream (ensure-directories-exist config-pathname)
|
|
:direction :output :if-exists :supersede)
|
|
(if config-string
|
|
(let ((pos (search config-probe config-string)))
|
|
(princ (subseq config-string 0 pos) stream))
|
|
(progn
|
|
(princ (concatenate 'string ";;; Configuration file for Sextant") stream)
|
|
(terpri stream)
|
|
(princ ";;; You are free to edit this section" stream)
|
|
(terpri stream)
|
|
(terpri stream)))
|
|
(princ config-probe stream)
|
|
(terpri stream)
|
|
(format stream "(in-package :~(~a~))~%" config-package)
|
|
(terpri stream)
|
|
(do-external-symbols (symbol (find-package config-package))
|
|
(when (boundp symbol)
|
|
(let ((value (symbol-value symbol)))
|
|
(cond
|
|
((null value)
|
|
(format stream "(setf ~(~a~) nil)~%" (symbol-name symbol)))
|
|
((eq value t)
|
|
(format stream "(setf ~(~a~) t)~%" (symbol-name symbol)))
|
|
((or (listp value) (consp value) (symbolp value))
|
|
(format stream "(setf ~(~a~) '~s)~%" (symbol-name symbol) value))
|
|
(t
|
|
(format stream "(setf ~(~a~) ~s)~%" (symbol-name symbol) value))))))
|
|
(terpri stream))))
|