1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
4 ;;; --------------------------------------------------------------------------
5 ;;; Documentation: Configuration definitions and Menu generation
7 ;;; --------------------------------------------------------------------------
9 ;;; (C) 2010 Philippe Brochard <hocwp@free.fr>
11 ;;; This program is free software; you can redistribute it and/or modify
12 ;;; it under the terms of the GNU General Public License as published by
13 ;;; the Free Software Foundation; either version 3 of the License, or
14 ;;; (at your option) any later version.
16 ;;; This program is distributed in the hope that it will be useful,
17 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;;; GNU General Public License for more details.
21 ;;; You should have received a copy of the GNU General Public License
22 ;;; along with this program; if not, write to the Free Software
23 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
25 ;;; --------------------------------------------------------------------------
29 (defun find-configuration-variables ()
30 (let ((all-groups nil
)
32 (maphash (lambda (key val
)
33 (pushnew (configvar-group val
) all-groups
:test
#'string-equal
)
34 (push (list key
(configvar-group val
)) all-variables
))
36 (values all-groups all-variables
)))
39 (defun find-symbol-function (function)
40 (with-all-internal-symbols (symbol :clfswm
)
41 (when (and (fboundp symbol
) (equal (symbol-function symbol
) function
))
42 (return-from find-symbol-function symbol
))))
44 (defun escape-conf-value (value)
45 (cond ((or (equal value t
) (equal value nil
))
46 (format nil
"~S" value
))
48 (format nil
"(quote ~S)" value
))
50 (format nil
"'~S" value
))
52 (format nil
"'~S" (find-symbol-function value
)))
54 (format nil
"(->color #x~X)" (color->rgb value
)))
55 (t (format nil
"~S" value
))))
57 (defun escape-conf-symbol-value (symbol)
58 (let ((value (symbol-value symbol
)))
59 (escape-conf-value value
)))
61 (defun get-config-value (value)
62 (ignore-errors (eval (read-from-string value
))))
64 (defun reset-config-to-default-value (symbol)
65 (setf (symbol-value symbol
) (config-default-value symbol
)))
68 ;;; Save configuration variables part
69 (defun temp-conf-file-name ()
70 (let ((name (conf-file-name)))
71 (make-pathname :directory
(pathname-directory name
)
72 :name
(concatenate 'string
(pathname-name name
) "-tmp"))))
75 (defun copy-previous-conf-file-begin (stream-in stream-out
)
76 (loop for line
= (read-line stream-in nil nil
)
78 until
(zerop (or (search ";;; ### Internal variables definitions" line
) -
1))
79 do
(format stream-out
"~A~%" line
)))
81 (defun copy-previous-conf-file-end (stream-in stream-out
)
82 (loop for line
= (read-line stream-in nil nil
)
84 until
(zerop (or (search ";;; ### End of internal variables definitions" line
) -
1)))
85 (loop for line
= (read-line stream-in nil nil
)
87 do
(format stream-out
"~A~%" line
)))
91 (defun save-variables-in-conf-file (stream)
92 (multiple-value-bind (all-groups all-variables
)
93 (find-configuration-variables)
94 (format stream
"~&;;; ### Internal variables definitions ### ;;;~%")
95 (format stream
";;; ### You can edit this part when clfswm is not running ### ;;;~%")
96 (format stream
";;; ### And you can remove this part to revert to the ### ;;;~%")
97 (format stream
";;; ### original configuration variables values. ### ;;;~%")
98 (format stream
"(in-package :clfswm)~2%")
99 (format stream
"(setf~%")
100 (dolist (group all-groups
)
101 (format stream
" ;; ~A:~%" group
)
102 (dolist (var all-variables
)
103 (when (string-equal (second var
) group
)
104 (format stream
" ~A ~A~%" (first var
)
105 (escape-conf-symbol-value (first var
)))))
106 (format stream
"~%"))
107 (format stream
")~%")
108 (format stream
";;; ### End of internal variables definitions ### ;;;~%")))
113 (defun save-configuration-variables ()
114 "Save all configuration variables in clfswmrc"
115 (let ((conffile (conf-file-name))
116 (tempfile (temp-conf-file-name)))
117 (with-open-file (stream-in conffile
:direction
:input
:if-does-not-exist
:create
)
118 (with-open-file (stream-out tempfile
:direction
:output
:if-exists
:supersede
)
119 (copy-previous-conf-file-begin stream-in stream-out
)
120 (save-variables-in-conf-file stream-out
)
121 (copy-previous-conf-file-end stream-in stream-out
)))
122 (delete-file conffile
)
123 (rename-file tempfile conffile
)
127 ;;; Configuration menu definition
129 (defun group->menu
(group)
130 (intern (string-upcase (format nil
"conf-~A" group
)) :clfswm
))
132 (defun group-name (group)
133 (format nil
"~:(~A~) Group" (substitute #\Space
#\-
(string group
))))
135 (defun query-conf-value (var string original
)
136 (labels ((warn-wrong-type (result original
)
137 (if (equal (simple-type-of result
) (simple-type-of original
))
139 (if (query-yes-or-no "~A and ~A are not of the same type (~A and ~A). Do you really want to use this value?"
140 (escape-conf-value result
) (escape-conf-value original
)
141 (type-of result
) (type-of original
))
144 (ask-set-default-value (original-val)
145 (let ((default (config-default-value var
)))
146 (if (query-yes-or-no "Reset ~A from ~A to ~A?" var original
(escape-conf-value default
))
149 (multiple-value-bind (result return
)
150 (query-string (format nil
"Configure ~A - ~A (blank=Default: ~A)" string
151 (documentation var
'variable
)
152 (escape-conf-value (config-default-value var
)))
154 (let ((original-val (get-config-value original
)))
155 (if (equal return
:Return
)
156 (if (string= result
"")
157 (ask-set-default-value original-val
)
158 (let ((result-val (get-config-value result
)))
159 (warn-wrong-type result-val original-val
)))
163 (defun create-conf-function (var)
164 (let* ((string (remove #\
* (format nil
"~A" var
)))
165 (symbol (intern (format nil
"CONFIGURE-~A" string
) :clfswm
)))
166 (setf (symbol-function symbol
) (lambda ()
167 (setf (symbol-value var
) (query-conf-value var string
(escape-conf-symbol-value var
)))
168 (open-menu (find-menu 'configuration-menu
)))
169 (documentation symbol
'function
) (format nil
"Configure ~A" string
))
173 (defun create-configuration-menu (&key clear
)
176 (clear-sub-menu 'main
'configuration-menu
))
177 (multiple-value-bind (all-groups all-variables
)
178 (find-configuration-variables)
179 (loop for group in all-groups
181 do
(let ((menu (group->menu group
)))
182 (add-sub-menu 'configuration-menu
(number->char i
) menu
(group-name group
))
183 (loop for var in all-variables
185 do
(when (equal (second var
) group
)
186 (add-menu-key menu
(number->char
(incf j
))
187 (create-conf-function (first var
))))))))
188 (add-menu-key 'configuration-menu
"F2" 'save-configuration-variables
)
189 (add-menu-key 'configuration-menu
"F3" 'reset-all-config-variables
))
193 (defun reset-all-config-variables ()
194 "Reset all configuration variables to there default values"
195 (when (query-yes-or-no "Do you really want to reset all values to there default?")
196 (maphash (lambda (key val
)
197 (declare (ignore val
))
198 (reset-config-to-default-value key
))
200 (open-menu (find-menu 'configuration-menu
)))