From 76fe57c8cee46fb5e9b6ffff72949fdba0b31934 Mon Sep 17 00:00:00 2001 From: Philippe Brochard Date: Mon, 7 Mar 2011 23:07:03 +0100 Subject: [PATCH] src/clfswm-configuration.lisp (create-configuration-menu): Change the config system with a more lispy one and a less string based one: (defconfig name value group doc). --- ChangeLog | 7 + TODO | 11 +- contrib/volume-mode.lisp | 36 +-- src/clfswm-configuration.lisp | 133 +++------ src/clfswm-internal.lisp | 4 +- src/clfswm-util.lisp | 8 +- src/clfswm.lisp | 1 - src/config.lisp | 652 +++++++++++++++++++++--------------------- src/package.lisp | 76 ++--- src/tools.lisp | 51 ++-- 10 files changed, 463 insertions(+), 516 deletions(-) rewrite src/config.lisp (73%) diff --git a/ChangeLog b/ChangeLog index cd9be80..5927e3a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2011-03-07 Philippe Brochard + + * src/clfswm-configuration.lisp (create-configuration-menu): + Change the config system with a more lispy one and a less string + based one: (defconfig name value group doc). + + 2011-03-06 Philippe Brochard * src/clfswm-internal.lisp (show-all-children): Simplify the diff --git a/TODO b/TODO index acf6732..8ca92ea 100644 --- a/TODO +++ b/TODO @@ -13,15 +13,10 @@ FOR THE NEXT RELEASE - Make frame/window border size variable. -- In show-all-children: add the ability to display all child from - *root-frame* and hide all those who are not in *current-root*. - -> remove hide-all-children when needed. - - Estimate the time to raise/lower a child in show-all-children and - see if there is a need for a rectangular optimization - -- Change the config system with a more lispy one and a less string - base one: (defconfig name value group doc) + see if there is a need for a rectangular optimization: + Result: map-window: 1.2E-5 sec. change stack order: 3.14E-4 sec. + => It maybe useful to optimize this part. MAYBE diff --git a/contrib/volume-mode.lisp b/contrib/volume-mode.lisp index 933d08b..158457d 100644 --- a/contrib/volume-mode.lisp +++ b/contrib/volume-mode.lisp @@ -63,8 +63,8 @@ (format t "Loading Volume mode code... ") (defparameter *volume-keys* nil) -(defparameter *volume-mode-placement* 'bottom-middle-placement - "Config(Placement group): Volume mode window placement") +(defconfig *volume-mode-placement* 'bottom-middle-placement + 'Placement "Volume mode window placement") (defvar *volume-window* nil) @@ -84,22 +84,22 @@ ;;; CONFIG - Volume mode -(defparameter *volume-font-string* *default-font-string* - "Config(Volume mode group): Volume string window font string") -(defparameter *volume-background* "black" - "Config(Volume mode group): Volume string window background color") -(defparameter *volume-foreground* "green" - "Config(Volume mode group): Volume string window foreground color") -(defparameter *volume-border* "red" - "Config(Volume mode group): Volume string window border color") -(defparameter *volume-width* 400 - "Config(Volume mode group): Volume mode window width") -(defparameter *volume-height* 15 - "Config(Volume mode group): Volume mode window height") -(defparameter *volume-text-limit* 30 - "Config(Volume mode group): Maximum text limit in the volume window") -(defparameter *volume-external-mixer-cmd* "/usr/bin/gnome-alsamixer" - "Config(Volume mode group): Command to start an external mixer program") +(defconfig *volume-font-string* *default-font-string* + 'Volume-mode "Volume string window font string") +(defconfig *volume-background* "black" + 'Volume-mode "Volume string window background color") +(defconfig *volume-foreground* "green" + 'Volume-mode "Volume string window foreground color") +(defconfig *volume-border* "red" + 'Volume-mode "Volume string window border color") +(defconfig *volume-width* 400 + 'Volume-mode "Volume mode window width") +(defconfig *volume-height* 15 + 'Volume-mode "Volume mode window height") +(defconfig *volume-text-limit* 30 + 'Volume-mode "Maximum text limit in the volume window") +(defconfig *volume-external-mixer-cmd* "/usr/bin/gnome-alsamixer" + 'Volume-mode "Command to start an external mixer program") (define-init-hash-table-key *volume-keys* "Volume mode keys") (define-define-key "volume" *volume-keys*) diff --git a/src/clfswm-configuration.lisp b/src/clfswm-configuration.lisp index a45702b..2f7aa8f 100644 --- a/src/clfswm-configuration.lisp +++ b/src/clfswm-configuration.lisp @@ -26,48 +26,46 @@ (in-package :clfswm) - (defun find-configuration-variables () (let ((all-groups nil) (all-variables nil)) - (with-all-internal-symbols (symbol :clfswm) - (when (is-config-p symbol) - (pushnew (config-group symbol) all-groups :test #'string-equal) - (push (list symbol (config-group symbol)) all-variables))) + (maphash (lambda (key val) + (pushnew (configvar-group val) all-groups :test #'string-equal) + (push (list key (configvar-group val)) all-variables)) + *config-var-table*) (values all-groups all-variables))) +(defun find-symbol-function (function) + (with-all-internal-symbols (symbol :clfswm) + (when (and (fboundp symbol) (equal (symbol-function symbol) function)) + (return-from find-symbol-function symbol)))) + (defun escape-conf-value (value) - (let ((value (symbol-value value))) - (cond ((or (equal value t) (equal value nil)) - (format nil "~S" value)) - ((consp value) - (format nil "(quote ~S)" value)) - ((symbolp value) - (format nil "'~S" value)) - ((functionp value) - (format nil "'~S" (find-symbol-function value))) - ((xlib:color-p value) - (format nil "(->color #x~X)" (color->rgb value))) - (t (format nil "~S" value))))) - -(defun remove-config-group (documentation) - (let ((pos (position #\: documentation))) - (if pos - (string-trim " " (subseq documentation (1+ pos))) - documentation))) + (cond ((or (equal value t) (equal value nil)) + (format nil "~S" value)) + ((consp value) + (format nil "(quote ~S)" value)) + ((symbolp value) + (format nil "'~S" value)) + ((functionp value) + (format nil "'~S" (find-symbol-function value))) + ((xlib:color-p value) + (format nil "(->color #x~X)" (color->rgb value))) + (t (format nil "~S" value)))) + +(defun escape-conf-symbol-value (symbol) + (let ((value (symbol-value symbol))) + (escape-conf-value value))) (defun get-config-value (value) (ignore-errors (eval (read-from-string value)))) +(defun reset-config-to-default-value (symbol) + (setf (symbol-value symbol) (config-default-value symbol))) -;;; Configuration variables save - -(defun find-symbol-function (function) - (with-all-internal-symbols (symbol :clfswm) - (when (and (fboundp symbol) (equal (symbol-function symbol) function)) - (return-from find-symbol-function symbol)))) +;;; Save configuration variables part (defun temp-conf-file-name () (let ((name (conf-file-name))) (make-pathname :directory (pathname-directory name) @@ -104,7 +102,7 @@ (dolist (var all-variables) (when (string-equal (second var) group) (format stream " ~A ~A~%" (first var) - (escape-conf-value (first var))))) + (escape-conf-symbol-value (first var))))) (format stream "~%")) (format stream ")~%") (format stream ";;; ### End of internal variables definitions ### ;;;~%"))) @@ -129,26 +127,29 @@ ;;; Configuration menu definition (defun group->menu (group) - (intern (string-upcase - (format nil "conf-~A" (substitute #\- #\Space group))) - :clfswm)) + (intern (string-upcase (format nil "conf-~A" group)) :clfswm)) + +(defun group-name (group) + (format nil "~:(~A~) Group" (substitute #\Space #\- (string group)))) (defun query-conf-value (var string original) (labels ((warn-wrong-type (result original) (if (equal (simple-type-of result) (simple-type-of original)) result - (if (query-yes-or-no "~S and ~S are not of the same type (~A and ~A). Do you really want to use this value?" - result original (type-of result) (type-of original)) + (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?" + (escape-conf-value result) (escape-conf-value original) + (type-of result) (type-of original)) result original))) (ask-set-default-value (original-val) - (let ((default (extract-config-default-value var))) - (if (query-yes-or-no "Reset ~A from ~A to ~A?" var original default) - (get-config-value default) + (let ((default (config-default-value var))) + (if (query-yes-or-no "Reset ~A from ~A to ~A?" var original (escape-conf-value default)) + default original-val)))) (multiple-value-bind (result return) - (query-string (format nil "Configure ~A - ~A" string - (remove-config-group (documentation var 'variable))) + (query-string (format nil "Configure ~A - ~A (blank=Default: ~A)" string + (documentation var 'variable) + (escape-conf-value (config-default-value var))) original) (let ((original-val (get-config-value original))) (if (equal return :Return) @@ -163,7 +164,7 @@ (let* ((string (remove #\* (format nil "~A" var))) (symbol (intern (format nil "CONFIGURE-~A" string) :clfswm))) (setf (symbol-function symbol) (lambda () - (setf (symbol-value var) (query-conf-value var string (escape-conf-value var))) + (setf (symbol-value var) (query-conf-value var string (escape-conf-symbol-value var))) (open-menu (find-menu 'configuration-menu))) (documentation symbol 'function) (format nil "Configure ~A" string)) symbol)) @@ -178,7 +179,7 @@ (loop for group in all-groups for i from 0 do (let ((menu (group->menu group))) - (add-sub-menu 'configuration-menu (number->char i) menu group) + (add-sub-menu 'configuration-menu (number->char i) menu (group-name group)) (loop for var in all-variables with j = -1 do (when (equal (second var) group) @@ -189,52 +190,12 @@ -;;; Default documentation string utility -(defparameter *config-default-string* "(blank=Default: ") - -(defmacro with-config-default-value-position ((symbol doc pos1 pos2) &body body) - `(let* ((,doc (documentation ,symbol 'variable)) - (length (length ,doc)) - (,pos2 (and (plusp length) (1- length)))) - (when (and ,pos2 (char= (char ,doc ,pos2) #\))) - (let ((,pos1 (awhen (search *config-default-string* ,doc :from-end t) - (+ it (length *config-default-string*))))) - (when ,pos1 - ,@body))))) - -(defun remove-config-default-value (symbol) - (with-config-default-value-position (symbol doc pos1 pos2) - (setf (documentation symbol 'variable) - (string-trim " " (subseq doc 0 pos1))))) - -(defun extract-config-default-value (symbol) - (with-config-default-value-position (symbol doc pos1 pos2) - (string-trim " " (subseq doc pos1 pos2)))) - - -(defun change-config-default-value (symbol) - (remove-config-default-value symbol) - (setf (documentation symbol 'variable) - (format nil "~A ~A~A)" (documentation symbol 'variable) - *config-default-string* - (escape-conf-value symbol)))) - -(defun reset-config-to-default-value (symbol) - (let ((default (extract-config-default-value symbol))) - (setf (symbol-value symbol) (get-config-value default)))) - - -(defun add-all-config-default-value () - (with-all-internal-symbols (symbol :clfswm) - (when (is-config-p symbol) - (change-config-default-value symbol)))) - - (defun reset-all-config-variables () "Reset all configuration variables to there default values" (when (query-yes-or-no "Do you really want to reset all values to there default?") - (with-all-internal-symbols (symbol :clfswm) - (when (is-config-p symbol) - (reset-config-to-default-value symbol)))) + (maphash (lambda (key val) + (declare (ignore val)) + (reset-config-to-default-value key)) + *config-var-table*)) (open-menu (find-menu 'configuration-menu))) diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp index daa7b66..00a4360 100644 --- a/src/clfswm-internal.lisp +++ b/src/clfswm-internal.lisp @@ -627,8 +627,8 @@ (with-slots (window show-window-p) frame (if show-window-p (when (or *show-root-frame-p* (not (child-equal-p frame *current-root*))) - (map-window window) - (set-child-stack-order window previous) + (map-window window) + (set-child-stack-order window previous) (display-frame-info frame)) (hide-window window)))) diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp index 1e0bca2..d31509c 100644 --- a/src/clfswm-util.lisp +++ b/src/clfswm-util.lisp @@ -1237,10 +1237,10 @@ For window: set current child to window or its parent according to window-parent ;;; Standard menu functions - Based on the XDG specifications -(defparameter *xdg-section-list* (append '(TextEditor FileManager WebBrowser) - '(AudioVideo Audio Video Development Education Game Graphics Network Office Settings System Utility) - '(TerminalEmulator Archlinux Screensaver)) - "Config(Menu group): Standard menu sections") +(defconfig *xdg-section-list* (append '(TextEditor FileManager WebBrowser) + '(AudioVideo Audio Video Development Education Game Graphics Network Office Settings System Utility) + '(TerminalEmulator Archlinux Screensaver)) + 'Menu "Standard menu sections") (defun um-create-xdg-section-list (menu) diff --git a/src/clfswm.lisp b/src/clfswm.lisp index 6855ec3..6657321 100644 --- a/src/clfswm.lisp +++ b/src/clfswm.lisp @@ -252,7 +252,6 @@ (when read-conf-file-p (read-conf-file)) (create-configuration-menu :clear t) - (add-all-config-default-value) (call-hook *main-entrance-hook*) (handler-case (open-display display protocol) diff --git a/src/config.lisp b/src/config.lisp dissimilarity index 73% index 023ec52..b65b33c 100644 --- a/src/config.lisp +++ b/src/config.lisp @@ -1,329 +1,323 @@ -;;; -------------------------------------------------------------------------- -;;; CLFSWM - FullScreen Window Manager -;;; -;;; -------------------------------------------------------------------------- -;;; Documentation: Configuration file -;;; -;;; Change this file to your own needs or update some of this variables in -;;; your ~/.clfswmrc -;;; Some simple hack can be done in the code begining with the word CONFIG -;;; (you can do a 'grep CONFIG *.lisp' to see what you can configure) -;;; -------------------------------------------------------------------------- -;;; -;;; (C) 2010 Philippe Brochard -;;; -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 3 of the License, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software -;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -;;; -;;; -------------------------------------------------------------------------- - -(in-package :clfswm) - - -;;; CONFIG - Compress motion notify ? -;; This variable may be useful to speed up some slow version of CLX. -;; It is particulary useful with CLISP/MIT-CLX. -(setf *have-to-compress-notify* t) - - -;;; CONFIG - Default modifiers -(defparameter *default-modifiers* '() - "Config(): Default modifiers list to append to explicit modifiers -Example: :mod-2 for num_lock, :lock for Caps_lock...") - - - - -;;; CONFIG - Never managed window list -(defparameter *never-managed-window-list* - (list (list (equal-wm-class-fun "ROX-Pinboard") nil) - (list (equal-wm-class-fun "xvkbd") 'raise-window) - (list 'equal-clfswm-terminal-id 'raise-and-focus-window)) - "Config(): CLFSWM will never manage windows of this type. -A list of (list match-function handle-function)") - - - -(defparameter *hide-unmanaged-window* t - "Config(): Hide or not unmanaged windows when a child is deselected.") - -;;; CONFIG - Screen size -(defun get-fullscreen-size () - "Return the size of root child (values rx ry rw rh) -You can tweak this to what you want" - (values -2 -2 (+ (xlib:screen-width *screen*) 2) (+ (xlib:screen-height *screen*) 2))) - ;;(values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*))) -;; (values -1 -1 1024 768)) -;; (values 100 100 800 600)) - - -(defparameter *corner-size* 3 - "Config(Corner group): The size of the corner square") - - -;;; CONFIG: Corner actions - See in clfswm-corner.lisp for -;;; allowed functions -(defparameter *corner-main-mode-left-button* - '((:top-left open-menu) - (:top-right present-virtual-keyboard) - (:bottom-right expose-windows-mode) - (:bottom-left nil)) - "Config(Corner group): Actions on corners in the main mode with the left mouse button") - -(defparameter *corner-main-mode-middle-button* - '((:top-left help-on-clfswm) - (:top-right ask-close/kill-current-window) - (:bottom-right nil) - (:bottom-left nil)) - "Config(Corner group): Actions on corners in the main mode with the middle mouse button") - -(defparameter *corner-main-mode-right-button* - '((:top-left present-clfswm-terminal) - (:top-right ask-close/kill-current-window) - (:bottom-right expose-all-windows-mode) - (:bottom-left nil)) - "Config(Corner group): Actions on corners in the main mode with the right mouse button") - -(defparameter *corner-second-mode-left-button* - '((:top-left nil) - (:top-right nil) - (:bottom-right expose-windows-mode) - (:bottom-left nil)) - "Config(Corner group): Actions on corners in the second mode with the left mouse button") - -(defparameter *corner-second-mode-middle-button* - '((:top-left help-on-clfswm) - (:top-right nil) - (:bottom-right nil) - (:bottom-left nil)) - "Config(Corner group): Actions on corners in the second mode with the middle mouse button") - -(defparameter *corner-second-mode-right-button* - '((:top-left nil) - (:top-right nil) - (:bottom-right expose-all-windows-mode) - (:bottom-left nil)) - "Config(Corner group): Actions on corners in the second mode with the right mouse button") - - -(defparameter *virtual-keyboard-cmd* "xvkbd" - "Config(Corner group): The command to display the virtual keybaord - Here is an ~/.Xresources example for xvkbd: - xvkbd.windowGeometry: 300x100-0-0 - xvkbd*Font: 6x12 - xvkbd.modalKeytop: true - xvkbd.customization: -french - xvkbd.keypad: false - And make it always on top") - -(defparameter *clfswm-terminal-name* "clfswm-terminal" - "Config(Corner group): The clfswm terminal name") -;;(defparameter *clfswm-terminal-cmd* (format nil "xterm -T ~A -e /bin/bash --noprofile --norc" *clfswm-terminal-name*) -;;(defparameter *clfswm-terminal-cmd* (format nil "urxvt -name ~A" *clfswm-terminal-name*) -(defparameter *clfswm-terminal-cmd* (format nil "xterm -T ~A" *clfswm-terminal-name*) - "Config(Corner group): The clfswm terminal command. -This command must set the window title to *clfswm-terminal-name*") - - - - -;;; Hook definitions -;;; -;;; A hook is a function, a symbol or a list of functions with a rest -;;; arguments. -;;; -;;; This hooks are set in clfswm.lisp, you can overwrite them or extend -;;; them with a hook list. -;;; -;;; See clfswm.lisp for hooks examples. - -(defparameter *init-hook* '(default-init-hook display-hello-window) - "Config(Hook group): Init hook. This hook is run just after the first root frame is created") - -(defparameter *close-hook* '(close-notify-window close-clfswm-terminal close-virtual-keyboard) - "Config(Hook group): Close hook. This hook is run just before closing the display") - -(defparameter *default-nw-hook* 'default-frame-nw-hook - "Config(Hook group): Default action to do on newly created windows") - - - - -;;; CONFIG -(defparameter *create-frame-on-root* nil - "Config(): Create frame on root. -Set this variable to true if you want to allow to create a new frame -on the root window in the main mode with the mouse") - - -;;; CONFIG: Main mode colors -(defparameter *color-selected* "Red" - "Config(Main mode group): Color of selected window") -(defparameter *color-unselected* "Blue" - "Config(Main mode group): Color of unselected color") -(defparameter *color-maybe-selected* "Yellow" - "Config(Main mode group): Color of maybe selected windows") - - -;;; CONFIG: Frame colors -(defparameter *frame-background* "Black" - "Config(Frame colors group): Frame background") -(defparameter *frame-foreground* "Green" - "Config(Frame colors group): Frame foreground") -(defparameter *frame-foreground-root* "Red" - "Config(Frame colors group): Frame foreground when the frame is the root frame") -(defparameter *frame-foreground-hidden* "Darkgreen" - "Config(Frame colors group): Frame foreground for hidden windows") - -;;; CONFIG: Default window size -(defparameter *default-window-width* 400 - "Config(): Default window width") -(defparameter *default-window-height* 300 - "Config(): Default window height") - -;;; CONFIG: Second mode colors and fonts -(defparameter *sm-border-color* "Green" - "Config(Second mode group): Second mode window border color") -(defparameter *sm-background-color* "Black" - "Config(Second mode group): Second mode window background color") -(defparameter *sm-foreground-color* "Red" - "Config(Second mode group): Second mode window foreground color") -(defparameter *sm-font-string* *default-font-string* - "Config(Second mode group): Second mode window font string") -(defparameter *sm-width* 300 - "Config(Second mode group): Second mode window width") -(defparameter *sm-height* 25 - "Config(Second mode group): Second mode window height") - - - - - -;;; CONFIG - Identify key colors -(defparameter *identify-font-string* *default-font-string* - "Config(Identify key group): Identify window font string") -(defparameter *identify-background* "black" - "Config(Identify key group): Identify window background color") -(defparameter *identify-foreground* "green" - "Config(Identify key group): Identify window foreground color") -(defparameter *identify-border* "red" - "Config(Identify key group): Identify window border color") - -;;; CONFIG - Query string colors -(defparameter *query-font-string* *default-font-string* - "Config(Query string group): Query string window font string") -(defparameter *query-background* "black" - "Config(Query string group): Query string window background color") -(defparameter *query-message-color* "yellow" - "Config(Query string group): Query string window message color") -(defparameter *query-foreground* "green" - "Config(Query string group): Query string window foreground color") -(defparameter *query-cursor-color* "white" - "Config(Query string group): Query string window foreground cursor color") -(defparameter *query-parent-color* "blue" - "Config(Query string group): Query string window parenthesis color") -(defparameter *query-parent-error-color* "red" - "Config(Query string group): Query string window parenthesis color when no match") -(defparameter *query-border* "red" - "Config(Query string group): Query string window border color") - - -;;; CONFIG - Info mode -(defparameter *info-background* "black" - "Config(Info mode group): Info window background color") -(defparameter *info-foreground* "green" - "Config(Info mode group): Info window foreground color") -(defparameter *info-border* "red" - "Config(Info mode group): Info window border color") -(defparameter *info-line-cursor* "white" - "Config(Info mode group): Info window line cursor color color") -(defparameter *info-selected-background* "blue" - "Config(Info mode group): Info selected item background color") -(defparameter *info-font-string* *default-font-string* - "Config(Info mode group): Info window font string") - -(defparameter *info-click-to-select* t - "Config(Info mode group): If true, click on info window select item. Otherwise, click to drag the menu") - -;;; CONFIG - Circulate string colors -(defparameter *circulate-font-string* *default-font-string* - "Config(Circulate mode group): Circulate string window font string") -(defparameter *circulate-background* "black" - "Config(Circulate mode group): Circulate string window background color") -(defparameter *circulate-foreground* "green" - "Config(Circulate mode group): Circulate string window foreground color") -(defparameter *circulate-border* "red" - "Config(Circulate mode group): Circulate string window border color") -(defparameter *circulate-width* 400 - "Config(Circulate mode group): Circulate mode window width") -(defparameter *circulate-height* 15 - "Config(Circulate mode group): Circulate mode window height") - - -(defparameter *circulate-text-limite* 30 - "Config(Circulate mode group): Maximum text limite in the circulate window") - - -;;; CONFIG - Expose string colors -(defparameter *expose-font-string* *default-font-string* - "Config(Expose mode group): Expose string window font string") -(defparameter *expose-background* "black" - "Config(Expose mode group): Expose string window background color") -(defparameter *expose-foreground* "green" - "Config(Expose mode group): Expose string window foreground color") -(defparameter *expose-border* "red" - "Config(Expose mode group): Expose string window border color") -(defparameter *expose-valid-on-key* t - "Config(Expose mode group): Valid expose mode when an accel key is pressed") -(defparameter *expose-show-window-title* t - "Config(Expose mode group): Show the window title on accel window") - - - -;;; CONFIG - Show key binding colors -(defparameter *info-color-title* "Magenta" - "Config(Info mode group): Colored info title color") -(defparameter *info-color-underline* "Yellow" - "Config(Info mode group): Colored info underline color") -(defparameter *info-color-first* "Cyan" - "Config(Info mode group): Colored info first color") -(defparameter *info-color-second* "lightblue" - "Config(Info mode group): Colored info second color") - - -;;; CONFIG - Menu colors -;;; Set *info-foreground* to change the default menu foreground -(defparameter *menu-color-submenu* "Cyan" - "Config(Menu group): Submenu color in menu") -(defparameter *menu-color-comment* "Yellow" - "Config(Menu group): Comment color in menu") -(defparameter *menu-color-key* "Magenta" - "Config(Menu group): Key color in menu") -(defparameter *menu-color-menu-key* (->color #xFF9AFF) - "Config(Menu group): Menu key color in menu") - - -;;; CONFIG - Notify window string colors -(defparameter *notify-window-font-string* *default-font-string* - "Config(Notify Window mode group): Notify window font string") -(defparameter *notify-window-background* "black" - "Config(Notify Window group): Notify Window background color") -(defparameter *notify-window-foreground* "green" - "Config(Notify Window group): Notify Window foreground color") -(defparameter *notify-window-border* "red" - "Config(Notify Window group): Notify Window border color") -(defparameter *notify-window-delay* 10 - "Config(Notify Window group): Notify Window display delay") - - +;;; -------------------------------------------------------------------------- +;;; CLFSWM - FullScreen Window Manager +;;; +;;; -------------------------------------------------------------------------- +;;; Documentation: Configuration file +;;; +;;; Change this file to your own needs or update some of this variables in +;;; your ~/.clfswmrc +;;; Some simple hack can be done in the code begining with the word CONFIG +;;; (you can do a 'grep CONFIG *.lisp' to see what you can configure) +;;; -------------------------------------------------------------------------- +;;; +;;; (C) 2010 Philippe Brochard +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +;;; +;;; -------------------------------------------------------------------------- + +(in-package :clfswm) + + +;;; CONFIG - Default modifiers +(defconfig *default-modifiers* '() nil + "Default modifiers list to append to explicit modifiers +Example: :mod-2 for num_lock, :lock for Caps_lock...") + + + + +;;; CONFIG - Never managed window list +(defconfig *never-managed-window-list* + (list (list (equal-wm-class-fun "ROX-Pinboard") nil) + (list (equal-wm-class-fun "xvkbd") 'raise-window) + (list 'equal-clfswm-terminal-id 'raise-and-focus-window)) + nil "CLFSWM will never manage windows of this type. +A list of (list match-function handle-function)") + + + +(defconfig *hide-unmanaged-window* t nil + "Hide or not unmanaged windows when a child is deselected.") + +;;; CONFIG - Screen size +(defun get-fullscreen-size () + "Return the size of root child (values rx ry rw rh) +You can tweak this to what you want" + (values -2 -2 (+ (xlib:screen-width *screen*) 2) (+ (xlib:screen-height *screen*) 2))) + ;;(values -1 -1 (xlib:screen-width *screen*) (xlib:screen-height *screen*))) +;; (values -1 -1 1024 768)) +;; (values 100 100 800 600)) + + +(defconfig *corner-size* 3 'Corner + "The size of the corner square") + + +;;; CONFIG: Corner actions - See in clfswm-corner.lisp for +;;; allowed functions +(defconfig *corner-main-mode-left-button* + '((:top-left open-menu) + (:top-right present-virtual-keyboard) + (:bottom-right expose-windows-mode) + (:bottom-left nil)) + 'Corner "Actions on corners in the main mode with the left mouse button") + +(defconfig *corner-main-mode-middle-button* + '((:top-left help-on-clfswm) + (:top-right ask-close/kill-current-window) + (:bottom-right nil) + (:bottom-left nil)) + 'Corner "Actions on corners in the main mode with the middle mouse button") + +(defconfig *corner-main-mode-right-button* + '((:top-left present-clfswm-terminal) + (:top-right ask-close/kill-current-window) + (:bottom-right expose-all-windows-mode) + (:bottom-left nil)) + 'Corner "Actions on corners in the main mode with the right mouse button") + +(defconfig *corner-second-mode-left-button* + '((:top-left nil) + (:top-right nil) + (:bottom-right expose-windows-mode) + (:bottom-left nil)) + 'Corner "Actions on corners in the second mode with the left mouse button") + +(defconfig *corner-second-mode-middle-button* + '((:top-left help-on-clfswm) + (:top-right nil) + (:bottom-right nil) + (:bottom-left nil)) + 'Corner "Actions on corners in the second mode with the middle mouse button") + +(defconfig *corner-second-mode-right-button* + '((:top-left nil) + (:top-right nil) + (:bottom-right expose-all-windows-mode) + (:bottom-left nil)) + 'Corner "Actions on corners in the second mode with the right mouse button") + + +(defconfig *virtual-keyboard-cmd* "xvkbd" + 'Corner "The command to display the virtual keybaord + Here is an ~/.Xresources example for xvkbd: + xvkbd.windowGeometry: 300x100-0-0 + xvkbd*Font: 6x12 + xvkbd.modalKeytop: true + xvkbd.customization: -french + xvkbd.keypad: false + And make it always on top") + +(defconfig *clfswm-terminal-name* "clfswm-terminal" + 'Corner "The clfswm terminal name") +;;(defparameter *clfswm-terminal-cmd* (format nil "xterm -T ~A -e /bin/bash --noprofile --norc" *clfswm-terminal-name*) +;;(defparameter *clfswm-terminal-cmd* (format nil "urxvt -name ~A" *clfswm-terminal-name*) +(defconfig *clfswm-terminal-cmd* (format nil "xterm -T ~A" *clfswm-terminal-name*) + 'Corner "The clfswm terminal command. +This command must set the window title to *clfswm-terminal-name*") + + + + +;;; Hook definitions +;;; +;;; A hook is a function, a symbol or a list of functions with a rest +;;; arguments. +;;; +;;; This hooks are set in clfswm.lisp, you can overwrite them or extend +;;; them with a hook list. +;;; +;;; See clfswm.lisp for hooks examples. + +(defconfig *init-hook* '(default-init-hook display-hello-window) + 'Hook "Init hook. This hook is run just after the first root frame is created") + +(defconfig *close-hook* '(close-notify-window close-clfswm-terminal close-virtual-keyboard) + 'Hook "Close hook. This hook is run just before closing the display") + +(defconfig *default-nw-hook* 'default-frame-nw-hook + 'Hook "Default action to do on newly created windows") + + + + +;;; CONFIG +(defconfig *create-frame-on-root* nil + nil "Create frame on root. +Set this variable to true if you want to allow to create a new frame +on the root window in the main mode with the mouse") + + +;;; CONFIG: Main mode colors +(defconfig *color-selected* "Red" + 'Main-mode "Color of selected window") +(defconfig *color-unselected* "Blue" + 'Main-mode "Color of unselected color") +(defconfig *color-maybe-selected* "Yellow" + 'Main-mode "Color of maybe selected windows") + + +;;; CONFIG: Frame colors +(defconfig *frame-background* "Black" + 'Frame-colors "Frame background") +(defconfig *frame-foreground* "Green" + 'Frame-colors "Frame foreground") +(defconfig *frame-foreground-root* "Red" + 'Frame-colors "Frame foreground when the frame is the root frame") +(defconfig *frame-foreground-hidden* "Darkgreen" + 'Frame-colors "Frame foreground for hidden windows") + +;;; CONFIG: Default window size +(defconfig *default-window-width* 400 + nil "Default window width") +(defconfig *default-window-height* 300 + nil "Default window height") + +;;; CONFIG: Second mode colors and fonts +(defconfig *sm-border-color* "Green" + 'Second-mode "Second mode window border color") +(defconfig *sm-background-color* "Black" + 'Second-mode "Second mode window background color") +(defconfig *sm-foreground-color* "Red" + 'Second-mode "Second mode window foreground color") +(defconfig *sm-font-string* *default-font-string* + 'Second-mode "Second mode window font string") +(defconfig *sm-width* 300 + 'Second-mode "Second mode window width") +(defconfig *sm-height* 25 + 'Second-mode "Second mode window height") + + + + + +;;; CONFIG - Identify key colors +(defconfig *identify-font-string* *default-font-string* + 'Identify-key "Identify window font string") +(defconfig *identify-background* "black" + 'Identify-key "Identify window background color") +(defconfig *identify-foreground* "green" + 'Identify-key "Identify window foreground color") +(defconfig *identify-border* "red" + 'Identify-key "Identify window border color") + +;;; CONFIG - Query string colors +(defconfig *query-font-string* *default-font-string* + 'Query-string "Query string window font string") +(defconfig *query-background* "black" + 'Query-string "Query string window background color") +(defconfig *query-message-color* "yellow" + 'Query-string "Query string window message color") +(defconfig *query-foreground* "green" + 'Query-string "Query string window foreground color") +(defconfig *query-cursor-color* "white" + 'Query-string "Query string window foreground cursor color") +(defconfig *query-parent-color* "blue" + 'Query-string "Query string window parenthesis color") +(defconfig *query-parent-error-color* "red" + 'Query-string "Query string window parenthesis color when no match") +(defconfig *query-border* "red" + 'Query-string "Query string window border color") + + +;;; CONFIG - Info mode +(defconfig *info-background* "black" + 'Info-mode "Info window background color") +(defconfig *info-foreground* "green" + 'Info-mode "Info window foreground color") +(defconfig *info-border* "red" + 'Info-mode "Info window border color") +(defconfig *info-line-cursor* "white" + 'Info-mode "Info window line cursor color color") +(defconfig *info-selected-background* "blue" + 'Info-mode "Info selected item background color") +(defconfig *info-font-string* *default-font-string* + 'Info-mode "Info window font string") + +(defconfig *info-click-to-select* t + 'Info-mode "If true, click on info window select item. Otherwise, click to drag the menu") + +;;; CONFIG - Circulate string colors +(defconfig *circulate-font-string* *default-font-string* + 'Circulate-mode "Circulate string window font string") +(defconfig *circulate-background* "black" + 'Circulate-mode "Circulate string window background color") +(defconfig *circulate-foreground* "green" + 'Circulate-mode "Circulate string window foreground color") +(defconfig *circulate-border* "red" + 'Circulate-mode "Circulate string window border color") +(defconfig *circulate-width* 400 + 'Circulate-mode "Circulate mode window width") +(defconfig *circulate-height* 15 + 'Circulate-mode "Circulate mode window height") + + +(defconfig *circulate-text-limite* 30 + 'Circulate-mode "Maximum text limite in the circulate window") + + +;;; CONFIG - Expose string colors +(defconfig *expose-font-string* *default-font-string* + 'Expose-mode "Expose string window font string") +(defconfig *expose-background* "black" + 'Expose-mode "Expose string window background color") +(defconfig *expose-foreground* "green" + 'Expose-mode "Expose string window foreground color") +(defconfig *expose-border* "red" + 'Expose-mode "Expose string window border color") +(defconfig *expose-valid-on-key* t + 'Expose-mode "Valid expose mode when an accel key is pressed") +(defconfig *expose-show-window-title* t + 'Expose-mode "Show the window title on accel window") + + + +;;; CONFIG - Show key binding colors +(defconfig *info-color-title* "Magenta" + 'Info-mode "Colored info title color") +(defconfig *info-color-underline* "Yellow" + 'Info-mode "Colored info underline color") +(defconfig *info-color-first* "Cyan" + 'Info-mode "Colored info first color") +(defconfig *info-color-second* "lightblue" + 'Info-mode "Colored info second color") + + +;;; CONFIG - Menu colors +;;; Set *info-foreground* to change the default menu foreground +(defconfig *menu-color-submenu* "Cyan" + 'Menu "Submenu color in menu") +(defconfig *menu-color-comment* "Yellow" + 'Menu "Comment color in menu") +(defconfig *menu-color-key* "Magenta" + 'Menu "Key color in menu") +(defconfig *menu-color-menu-key* (->color #xFF9AFF) + 'Menu "Menu key color in menu") + + +;;; CONFIG - Notify window string colors +(defconfig *notify-window-font-string* *default-font-string* + 'Notify-Window "Notify window font string") +(defconfig *notify-window-background* "black" + 'Notify-Window "Notify Window background color") +(defconfig *notify-window-foreground* "green" + 'Notify-Window "Notify Window foreground color") +(defconfig *notify-window-border* "red" + 'Notify-Window "Notify Window border color") +(defconfig *notify-window-delay* 10 + 'Notify-Window "Notify Window display delay") + + diff --git a/src/package.lisp b/src/package.lisp index 49148fe..4f869b9 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -37,12 +37,11 @@ (in-package :clfswm) - - -;;; Compress motion notify ? -;;; Note: this variable is overwriten in config.lisp -(defparameter *have-to-compress-notify* t - "Config(): Compress event notify? +;;; CONFIG - Compress motion notify ? +;; This variable may be useful to speed up some slow version of CLX. +;; It is particulary useful with CLISP/MIT-CLX (and others). +(defconfig *have-to-compress-notify* t nil + "Compress event notify? This variable may be useful to speed up some slow version of CLX. It is particulary useful with CLISP/MIT-CLX.") @@ -59,8 +58,8 @@ It is particulary useful with CLISP/MIT-CLX.") (defparameter *root* nil) (defparameter *no-focus-window* nil) -(defparameter *loop-timeout* 0.1 - "Config(): Maximum time (in seconds) to wait before calling *loop-hook*") +(defconfig *loop-timeout* 0.1 nil + "Maximum time (in seconds) to wait before calling *loop-hook*") (defparameter *pixmap-buffer* nil) @@ -68,26 +67,27 @@ It is particulary useful with CLISP/MIT-CLX.") (defparameter *default-font* nil) ;;(defparameter *default-font-string* "9x15") -(defparameter *default-font-string* "fixed" - "Config(): The default font used in clfswm") +(defconfig *default-font-string* "fixed" nil + "The default font used in clfswm") -(defparameter *color-move-window* "DeepPink" - "Config(Main mode group): Color when moving or resizing a windows") +(defconfig *color-move-window* "DeepPink" 'Main-mode + "Color when moving or resizing a windows") (defparameter *child-selection* nil) ;;; CONFIG - Default frame datas -(defparameter *default-frame-data* +(defconfig *default-frame-data* (list '(:tile-size 0.8) '(:tile-space-size 0.1) '(:fast-layout (tile-left-layout tile-layout)) '(:main-layout-windows nil)) - "Config(): Default slots set in frame date") + nil + "Default slots set in frame date") ;;; CONFIG - Default managed window type for a frame ;;; type can be :all, :normal, :transient, :maxsize, :desktop, :dock, :toolbar, :menu, :utility, :splash, :dialog -(defparameter *default-managed-type* '(:normal) - "Config(): Default managed window types") +(defconfig *default-managed-type* '(:normal) nil + "Default managed window types") ;;(defparameter *default-managed-type* '(:normal :maxsize :transient)) ;;(defparameter *default-managed-type* '(:normal :transient :maxsize :desktop :dock :toolbar :menu :utility :splash :dialog)) ;;(defparameter *default-managed-type* '()) @@ -95,8 +95,8 @@ It is particulary useful with CLISP/MIT-CLX.") ;;; CONFIG - Default focus policy -(defparameter *default-focus-policy* :click - "Config(): Default mouse focus policy. One of :click, :sloppy, :sloppy-strict or :sloppy-select.") +(defconfig *default-focus-policy* :click nil + "Default mouse focus policy. One of :click, :sloppy, :sloppy-strict or :sloppy-select.") (defclass frame () @@ -179,14 +179,14 @@ It is particulary useful with CLISP/MIT-CLX.") -(defparameter *binding-hook* nil - "Config(Hook group): Hook executed when keys/buttons are bounds") +(defconfig *binding-hook* nil 'Hook + "Hook executed when keys/buttons are bounds") -(defparameter *loop-hook* nil - "Config(Hook group): Hook executed on each event loop") +(defconfig *loop-hook* nil 'Hook + "Hook executed on each event loop") -(defparameter *main-entrance-hook* nil - "Config(Hook group): Hook executed on the main function entrance after +(defconfig *main-entrance-hook* nil 'Hook + "Hook executed on the main function entrance after loading configuration file and before opening the display.") @@ -202,20 +202,20 @@ loading configuration file and before opening the display.") ;;; middle-left middle-middle middle-right ;;; bottom-left bottom-middle bottom-right ;;; -(defparameter *banish-pointer-placement* 'bottom-right-placement - "Config(Placement group): Pointer banishment placement") -(defparameter *second-mode-placement* 'top-middle-placement - "Config(Placement group): Second mode window placement") -(defparameter *info-mode-placement* 'top-left-placement - "Config(Placement group): Info mode window placement") -(defparameter *query-mode-placement* 'top-left-placement - "Config(Placement group): Query mode window placement") -(defparameter *circulate-mode-placement* 'bottom-middle-placement - "Config(Placement group): Circulate mode window placement") -(defparameter *expose-mode-placement* 'top-left-child-placement - "Config(Placement group): Expose mode window placement (Selection keys position)") -(defparameter *notify-window-placement* 'bottom-right-placement - "Config(Placement group): Notify window placement") +(defconfig *banish-pointer-placement* 'bottom-right-placement + 'Placement "Pointer banishment placement") +(defconfig *second-mode-placement* 'top-middle-placement + 'Placement "Second mode window placement") +(defconfig *info-mode-placement* 'top-left-placement + 'Placement "Info mode window placement") +(defconfig *query-mode-placement* 'top-left-placement + 'Placement "Query mode window placement") +(defconfig *circulate-mode-placement* 'bottom-middle-placement + 'Placement "Circulate mode window placement") +(defconfig *expose-mode-placement* 'top-left-child-placement + 'Placement "Expose mode window placement (Selection keys position)") +(defconfig *notify-window-placement* 'bottom-right-placement + 'Placement "Notify window placement") diff --git a/src/tools.lisp b/src/tools.lisp index f5bbe79..6ed90c7 100644 --- a/src/tools.lisp +++ b/src/tools.lisp @@ -31,6 +31,7 @@ (:export :it :awhen :aif + :defconfig :*config-var-table* :configvar-value :configvar-group :config-default-value :find-in-hash :nfuncall :pfuncall @@ -55,7 +56,6 @@ :ensure-function :empty-string-p :find-common-string - :is-config-p :config-documentation :config-group :setf/= :create-symbol :number->char @@ -126,6 +126,26 @@ `(let ((it ,test)) (if it ,then ,else))) +;;; Configuration variables +(defstruct configvar value group doc) + +(defparameter *config-var-table* (make-hash-table :test #'equal)) + +(defmacro defconfig (name value group doc) + `(progn + (setf (gethash ',name *config-var-table*) + (make-configvar :value ,value + :group (or ,group 'Miscellaneous))) + (defparameter ,name ,value ,doc))) + +(defun config-default-value (var) + (let ((config (gethash var *config-var-table*))) + (when config + (configvar-value config)))) + + + + (defun find-in-hash (val hashtable &optional (test #'equal)) "Return the key associated to val in the hashtable" (maphash #'(lambda (k v) @@ -372,35 +392,6 @@ Return the result of the last hook" -;;; Auto configuration tools -;;; Syntaxe: (defparameter symbol value "Config(config group): documentation string") -(let* ((start-string "Config(") - (start-len (length start-string)) - (stop-string "):") - (stop-len (length stop-string))) - (defun is-config-p (symbol) - (when (boundp symbol) - (let ((doc (documentation symbol 'variable))) - (and doc - (= (or (search start-string doc :test #'string-equal) -1) 0) - (search stop-string doc) - t)))) - - (defun config-documentation (symbol) - (when (is-config-p symbol) - (let ((doc (documentation symbol 'variable))) - (string-trim " " (subseq doc (+ (search stop-string doc) stop-len)))))) - - (defun config-group (symbol) - (when (is-config-p symbol) - (let* ((doc (documentation symbol 'variable)) - (group (string-trim " " (subseq doc (+ (search start-string doc) start-len) - (search stop-string doc))))) - (if (empty-string-p group) "Miscellaneous group" group))))) - - - - ;;; Tools (defmacro setf/= (var val) "Set var to val only when var not equal to val" -- 2.11.4.GIT