forked from Shirakumo/trial
-
Notifications
You must be signed in to change notification settings - Fork 0
/
settings.lisp
122 lines (109 loc) · 4.53 KB
/
settings.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
#|
This file is a part of trial
(c) 2019 Shirakumo http://tymoon.eu ([email protected])
Author: Nicolas Hafner <[email protected]>
|#
(in-package #:org.shirakumo.fraf.trial)
(defvar *save-settings* T)
(define-global +settings-observers+ (make-hash-table :test 'equal))
(define-global +settings+ '(:language "eng"))
(defun setting-file-path ()
(make-pathname :name "settings" :type "lisp"
:defaults (config-directory)))
(defun keymap-path ()
(make-pathname :name "keymap" :type "lisp"
:defaults (config-directory)))
(defun map-leaf-settings (function &optional (settings +settings+))
(labels ((recurse (node rpath)
(loop for (k v) on node by #'cddr
do (if (and (consp v) (keywordp (car v)))
(recurse v (list* k rpath))
(funcall function (reverse (list* k rpath)) v)))))
(recurse settings ())))
(defun load-keymap (&optional path)
(unless path
(setf path (keymap-path))
(ensure-directories-exist path)
(when (or (not (probe-file path))
(< (file-write-date path)
(file-write-date (merge-pathnames "keymap.lisp" (root)))))
(uiop:copy-file (merge-pathnames "keymap.lisp" (root)) path)))
(load-mapping path))
(defmethod load-settings (&optional (path (setting-file-path)))
(with-error-logging (:trial.settings)
(v:info :trial.settings "Loading settings from ~a" path)
(with-open-file (stream path :direction :input
:element-type 'character
:if-does-not-exist NIL)
(when stream
(with-trial-io-syntax ()
(let ((*save-settings* NIL))
(map-leaf-settings
(lambda (path value)
(apply #'(setf setting) value path))
(loop for k = (read stream NIL '#1=#:eof)
until (eq k '#1#)
collect k)))))))
+settings+)
(defmethod save-settings (&optional (path (setting-file-path)))
(ignore-errors
(with-error-logging (:trial.settings)
(v:info :trial.settings "Saving settings to ~a" path)
(with-open-file (stream path :direction :output
:element-type 'character
:if-exists :supersede)
(with-trial-io-syntax ()
(labels ((plist (indent part)
(loop for (k v) on part by #'cddr
do (format stream "~&~v{ ~}~s " (* indent 2) '(0) k)
(serialise indent v)))
(serialise (indent part)
(typecase part
(cons
(cond ((keywordp (car part))
(format stream "(")
(plist (1+ indent) part)
(format stream ")"))
(T
(prin1 part stream))))
(null
(format stream "NIL"))
(T
(prin1 part stream)))))
(plist 0 +settings+))))))
+settings+)
(defun setting (&rest path)
(loop with node = (or +settings+ (load-settings))
for key in path
for next = (getf node key '#1=#:not-found)
do (if (eq next '#1#)
(return (values NIL NIL))
(setf node next))
finally (return (values node T))))
(defun (setf setting) (value &rest path)
(labels ((update (node key path)
(setf (getf node key)
(if path
(update (getf node key) (first path) (rest path))
value))
node))
(setf +settings+ (update +settings+ (first path) (rest path)))
(loop for i from 0 below (length path)
for sub = (butlast path i)
do (loop for (k v) on (gethash sub +settings-observers+) by #'cddr
do (funcall v (apply #'setting sub))))
(when *save-settings*
(save-settings))
value))
(defun observe-setting (setting name function)
(setf (getf (gethash setting +settings-observers+) name) function))
(defun remove-setting-observer (setting name)
(remf (gethash setting +settings-observers+) name))
(defmacro define-setting-observer (name &rest setting)
(let ((setting (loop for part = (first setting)
until (listp part)
collect (pop setting)))
(args (pop setting))
(body setting))
`(observe-setting ',setting ',name
(lambda ,args ,@body))))