[clfswm-cvs] CVS clfswm
pbrochard
pbrochard at common-lisp.net
Sat Jan 5 14:25:29 UTC 2008
Update of /project/clfswm/cvsroot/clfswm
In directory clnet:/tmp/cvs-serv9056
Modified Files:
clfswm.lisp dot-clfswmrc
Log Message:
better configuration error handler/new dot-clfswmrc example
--- /project/clfswm/cvsroot/clfswm/clfswm.lisp 2008/01/03 22:15:48 1.11
+++ /project/clfswm/cvsroot/clfswm/clfswm.lisp 2008/01/05 14:25:29 1.12
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Jan 3 23:10:41 2008
+;;; #Date#: Sat Jan 5 15:16:21 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -297,7 +297,9 @@
(conf (or user-conf etc-conf)))
(if conf
(handler-case (load conf)
- (error (c) (values nil (format nil "~s" c) conf))
+ (error (c)
+ (format t "~2%*** Error loading configurtion file: ~A ***~&~A~%" conf c)
+ (values nil (format nil "~s" c) conf))
(:no-error (&rest args) (declare (ignore args)) (values t nil conf)))
(values t nil nil))))
--- /project/clfswm/cvsroot/clfswm/dot-clfswmrc 2008/01/03 20:31:24 1.6
+++ /project/clfswm/cvsroot/clfswm/dot-clfswmrc 2008/01/05 14:25:29 1.7
@@ -11,16 +11,31 @@
;;;; Uncomment the line above if you want to enable the notify event compression.
;;;; 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)
+;; (setf *have-to-compress-notify* t)
+
;;; Color configuration example
;;;
;;; See in package.lisp for all variables
-;;(setf *color-unselected* "Blue")
+(setf *color-unselected* "Blue")
+
+
+;;(defparameter *fullscreen* '(0 4 800 570))
+(defparameter *fullscreen* '(0 0 1024 750))
+
+
+
+;;; Binding example: Undefine Control-F1 and define Control-F5 as a
+;;; new binding in main mode
+;;;
+;;; See bindings.lisp, bindings-second-mode.lisp and bindings-pager.lisp
+;;; for all default bindings definitions.
+(undefine-main-key ("F1" :mod-1))
+(define-main-key ("F5" :mod-1) 'help-on-clfswm)
-(defparameter *fullscreen* '(0 4 800 592))
+;;; Binding example for apwal
(define-second-key (#\Space)
(defun tpm-apwal ()
"Run Apwal"
@@ -30,31 +45,23 @@
-;;; Binding example: Undefine Control-F1 and define Control-F5 as a
-;;; new binding in main mode
-;;;
-;;; See bindings.lisp, bindings-second-mode.lisp and bindings-pager.lisp
-;;; for all default bindings definitions.
-;;(undefine-main-key ("F1" :mod-1))
-;;(define-main-key ("F5" :mod-1) 'help-on-clfswm)
-
;;;; Reloading example
-;;(defun reload-clfswm ()
-;; "Reload clfswm"
-;; (format t "RELOADING... ")
-;; (ungrab-main-keys)
-;; (setf *main-keys* (make-hash-table :test 'equal))
-;; (asdf:oos 'asdf:load-op :clfswm)
-;; (grab-main-keys)
-;; (format t "Done!~%"))
-;;
-;;
-;;(define-main-key ("F2" :mod-1) 'reload-clfswm)
+(defun reload-clfswm ()
+ "Reload clfswm"
+ (format t "RELOADING... ")
+ (ungrab-main-keys)
+ (setf *main-keys* (make-hash-table :test 'equal))
+ (asdf:oos 'asdf:load-op :clfswm)
+ (grab-main-keys)
+ (format t "Done!~%"))
+
-;;(define-main-key ("F3" :mod-1) (lambda ()
-;; (do-shell "rxvt")))
+(define-main-key ("F2" :mod-1) 'reload-clfswm)
+
+(define-main-key ("F3" :mod-1) (lambda ()
+ (do-shell "rxvt")))
@@ -62,36 +69,79 @@
;;;
;;; See in package.lisp and clfswm.lisp, clfswm-second-mode.lisp
;;; or clfswm-pager.lisp for hook examples
-;;(setf *key-press-hook* (list (lambda (&rest args) ; function 1
-;; (format t "Keyp press (before): ~A~%" args)
-;; (force-output))
-;; #'handle-key-press ; function 2 (default)
-;; (lambda (&rest args) ; function 3
-;; (declare (ignore args))
-;; (format t "Keyp press (after)~%")
-;; (force-output))))
-
-;;(defun key-string (code state)
-;; (let* ((modifiers (make-state-keys state))
-;; (keysym (keysym->keysym-name (keycode->keysym *display* code 0))))
-;; (format nil "~:(~{~A+~}~A~)" modifiers keysym)))
-;;
-;;(defun display-key-osd (&rest event-slots &key code state &allow-other-keys)
-;; (do-shell "pkill osd_cat")
-;; (do-shell (format nil "echo ~A | osd_cat -p bottom -f -*-fixed-*-*-*-*-24-*-*-*-*-*-*-1"
-;; (key-string code state)))
-;; (force-output))
-;;
-;;(defun display-key-pager (&rest event-slots &key code state &allow-other-keys)
-;; (setf (gcontext-background *pager-gc*) (get-color "Black"))
-;; (setf (gcontext-foreground *pager-gc*) (get-color "Red"))
-;; (draw-image-glyphs *pager-window* *pager-gc* 400 600
-;; (format nil "~A" (key-string code state)))
-;; (display-finish-output *display*))
-;;
-;;(setf *key-press-hook* (list #'display-key-osd #'handle-key-press))
-;;(setf *sm-key-press-hook* (list #'display-key-osd #'sm-handle-key-press))
-;;(setf *pager-key-press-hook* (list #'pager-handle-key-press #'display-key-pager))
+(setf *key-press-hook* (list (lambda (&rest args) ; function 1
+ (format t "Keyp press (before): ~A~%" args)
+ (force-output))
+ #'handle-key-press ; function 2 (default)
+ (lambda (&rest args) ; function 3
+ (declare (ignore args))
+ (format t "Keyp press (after)~%")
+ (force-output))))
+
+
+
+;;; A more complex example I use to record my desktop and show
+;;; documentation associated to each key press.
+(defun documentation-key-from-code (hash-key code state)
+ (labels ((doc-from (key)
+ (multiple-value-bind (function foundp)
+ (gethash (list key state) hash-key)
+ (when (and foundp (first function))
+ (documentation (first function) 'function))))
+ (from-code ()
+ (doc-from code))
+ (from-char ()
+ (let ((char (keycode->char code state)))
+ (doc-from char)))
+ (from-string ()
+ (let ((string (keysym->keysym-name (keycode->keysym *display* code 0))))
+ (doc-from string))))
+ (cond ((from-code))
+ ((from-char))
+ ((from-string)))))
+
+
+(defun key-string (hash-key code state)
+ (let* ((modifiers (make-state-keys state))
+ (keysym (keysym->keysym-name (keycode->keysym *display* code 0)))
+ (doc (documentation-key-from-code hash-key code state)))
+ (values (format nil "~:(~{~A+~}~A~) : ~S" modifiers keysym doc)
+ doc)))
+
+(defun display-doc (hash-key code state)
+ (multiple-value-bind (str doc)
+ (key-string hash-key code state)
+ (when doc
+ (do-shell "pkill osd_cat")
+ (do-shell (format nil "echo ~A | osd_cat -d 3 -p bottom -o -45 -f -*-fixed-*-*-*-*-12-*-*-*-*-*-*-1" str))
+ (force-output))))
+
+(defun display-key-osd-main (&rest event-slots &key code state &allow-other-keys)
+ (display-doc *main-keys* code state))
+
+(defun display-key-osd-second (&rest event-slots &key code state &allow-other-keys)
+ (display-doc *second-keys* code state))
+
+(defun display-key-pager (&rest event-slots &key code state &allow-other-keys)
+ (setf (gcontext-background *pager-gc*) (get-color "Black"))
+ (setf (gcontext-foreground *pager-gc*) (get-color "Red"))
+ (multiple-value-bind (str doc)
+ (key-string *pager-keys* code state)
+ (when doc
+ (draw-image-glyphs *pager-window* *pager-gc* 20 570
+ (format nil "~A " str)))
+ (display-finish-output *display*)))
+
+;; Define new hook or add to precedent one
+(if (consp *key-press-hook*)
+ (push #'display-key-osd-main *key-press-hook*)
+ (setf *key-press-hook* (list #'display-key-osd-main #'handle-key-press)))
+(setf *sm-key-press-hook* (list #'display-key-osd-second #'sm-handle-key-press))
+(setf *pager-key-press-hook* (list #'pager-handle-key-press #'display-key-pager))
+
+;;; -- Doc example end --
+
+
;;;; Uncomment the lines below if you want to enable the larswm,
;;;; dwm, wmii... cycling style.
@@ -100,29 +150,31 @@
;;;; on the other side. It can be configured in the rc file or interactively
;;;; with the function 'reconfigure-tile-workspace'.
;;;;
-;;(defun circulate-group-up ()
-;; "Circulate up in group - larswm, dwm, wmii style"
-;; (banish-pointer)
-;; (minimize-group (current-group))
-;; (no-focus)
-;; (setf (workspace-group-list (current-workspace))
-;; (rotate-list (workspace-group-list (current-workspace))))
-;; (funcall *tile-workspace-function* (current-workspace))
-;; (show-all-windows-in-workspace (current-workspace)))
-;;
-;;(defun circulate-group-down ()
-;; "Circulate down in group - larswm, dwm, wmii style"
-;; (banish-pointer)
-;; (minimize-group (current-group))
-;; (no-focus)
-;; (setf (workspace-group-list (current-workspace))
-;; (anti-rotate-list (workspace-group-list (current-workspace))))
-;; (funcall *tile-workspace-function* (current-workspace))
-;; (show-all-windows-in-workspace (current-workspace)))
+(defun circulate-group-up ()
+ "Circulate up in group - larswm, dwm, wmii style"
+ (banish-pointer)
+ (minimize-group (current-group))
+ (no-focus)
+ (setf (workspace-group-list (current-workspace))
+ (rotate-list (workspace-group-list (current-workspace))))
+ (funcall *tile-workspace-function* (current-workspace))
+ (show-all-windows-in-workspace (current-workspace)))
+
+(defun circulate-group-down ()
+ "Circulate down in group - larswm, dwm, wmii style"
+ (banish-pointer)
+ (minimize-group (current-group))
+ (no-focus)
+ (setf (workspace-group-list (current-workspace))
+ (anti-rotate-list (workspace-group-list (current-workspace))))
+ (funcall *tile-workspace-function* (current-workspace))
+ (show-all-windows-in-workspace (current-workspace)))
+
+;;; -- Lasrwm style end --
-;;;; Azerty keyboard configuration (first remove keys, then rebind)
+;;; Azerty keyboard configuration (first remove keys, then rebind)
;; Main mode
;;(undefine-main-key (#\t :mod-1))
;;(undefine-main-key (#\b :mod-1))
@@ -214,5 +266,7 @@
(define-pager-key ("ampersand" :control :mod-1) 'pager-renumber-workspaces)
(define-pager-key ("eacute" :control :mod-1) 'pager-sort-workspaces)
+;;; -- Azerty configuration end --
+
More information about the clfswm-cvs
mailing list