[clfswm-cvs] CVS clfswm

pbrochard pbrochard at common-lisp.net
Thu Jan 3 20:31:25 UTC 2008


Update of /project/clfswm/cvsroot/clfswm
In directory clnet:/tmp/cvs-serv17082

Modified Files:
	ChangeLog README bindings-pager.lisp bindings-second-mode.lisp 
	bindings.lisp clfswm-internal.lisp clfswm-keys.lisp 
	clfswm-second-mode.lisp clfswm-util.lisp clfswm.asd 
	clfswm.lisp config.lisp dot-clfswmrc load.lisp xlib-util.lisp 
Log Message:
Change to make clfswm run with clisp/new-clx.

--- /project/clfswm/cvsroot/clfswm/ChangeLog	2008/01/01 21:44:16	1.12
+++ /project/clfswm/cvsroot/clfswm/ChangeLog	2008/01/03 20:31:24	1.13
@@ -1,3 +1,7 @@
+2008-01-03  Philippe Brochard  <hocwp at free.fr>
+
+	* clfswm*: Change to make clfswm run with clisp/new-clx.
+
 2008-01-01  Philippe Brochard  <hocwp at free.fr>
 
 	* clfswm-util.lisp (query-show-paren): Add show parent matching in
--- /project/clfswm/cvsroot/clfswm/README	2007/12/21 22:38:14	1.2
+++ /project/clfswm/cvsroot/clfswm/README	2008/01/03 20:31:24	1.3
@@ -19,7 +19,7 @@
  keys.html
 
 
-Installation
+* Installation
 
 Boot up a common lisp implementation. I develop it with sbcl, I've
 tested it with cmucl and I use it with clisp (you need the clx/xlib
@@ -39,10 +39,15 @@
   > (clfswm:main)                       ; start the main loop
 
 
-Tweaking
+* Tweaking
 
 To change the default keybinding, have a look at the bindings*.lisp
 files and at the config.lisp file for global variables.
+
+All variables can be overwritten in a user configuration file
+(/etc/clfswmrc or $HOME/.clfswmrc). It's a standard lisp file loaded at
+startup. There is an example in the clfswm source (see dot-clfswmrc).
+
 If you want to add workspaces or groups at startup, tell this to
 clfswm in the init-display function in clfswm.lisp (there is already a
 default workspace and a default group created).
@@ -50,12 +55,19 @@
 In all cases, you can grep the source with 'CONFIG' and 'Alternative'
 keywords to find where you can simply customize clfswm.
 
-All variables can be overwritten in a user configuration file
-(/etc/clfswmrc or ~/.clfswmrc). It's a standard lisp file loaded at
-startup. There is an example in the clfswm source (dot-clfswmrc).
 
 
-License
+* Lisp implementation note
+
+If you are using clisp/new-clx, be sure to use the last version (at
+least 2.43). Older versions are a little bit bogus.
+If you are using clisp/mit-clx or an other clx than clisp/new-clx, you
+may find a speed up with the compress notify event. See the variable
+*have-to-compress-notify* in the configuration file.
+
+
+
+* License
 
  CLFSWM is under the GNU General Public License - GPL license.
  You can find more information in the files COPYING. or on the
--- /project/clfswm/cvsroot/clfswm/bindings-pager.lisp	2007/12/29 15:20:10	1.6
+++ /project/clfswm/cvsroot/clfswm/bindings-pager.lisp	2008/01/03 20:31:24	1.7
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Sat Dec 29 16:00:58 2007
+;;; #Date#: Thu Jan  3 00:26:05 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Bindings keys and mouse for pager mode
@@ -43,7 +43,7 @@
       (pager-draw-display)))
 
 
-(define-pager-key (#\Return) 'leave-pager-mode)
+(define-pager-key ("Return") 'leave-pager-mode)
 (define-pager-key ("Escape") 'leave-pager-mode)
 
 (define-pager-key (#\b) 'banish-pointer)
--- /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/01/01 19:13:45	1.9
+++ /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp	2008/01/03 20:31:24	1.10
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Jan  1 19:23:19 2008
+;;; #Date#: Thu Jan  3 00:25:33 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Bindings keys and mouse for second mode
@@ -68,12 +68,12 @@
 
 
 (define-second-key (#\t) 'leave-second-mode-maximize)
-(define-second-key (#\Return) 'leave-second-mode-maximize)
+(define-second-key ("Return") 'leave-second-mode-maximize)
 (define-second-key ("Escape") 'leave-second-mode)
 
 
 (define-second-key (#\< :control) 'leave-second-mode)
-(define-second-key (#\Return :control) 'leave-second-mode)
+(define-second-key ("Return" :control) 'leave-second-mode)
 
 ;; Escape
 (define-second-key ("Escape" :control :shift) 'delete-current-window)
@@ -131,8 +131,8 @@
 
 
 
-(define-second-key (#\Tab :mod-1) 'rotate-window-up)
-(define-second-key (#\Tab :mod-1 :shift) 'rotate-window-down)
+(define-second-key ("Tab" :mod-1) 'rotate-window-up)
+(define-second-key ("Tab" :mod-1 :shift) 'rotate-window-down)
 
 (define-second-key (#\b) 'banish-pointer)
 
--- /project/clfswm/cvsroot/clfswm/bindings.lisp	2007/12/22 22:55:26	1.5
+++ /project/clfswm/cvsroot/clfswm/bindings.lisp	2008/01/03 20:31:24	1.6
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Sat Dec 22 23:30:51 2007
+;;; #Date#: Thu Jan  3 19:23:24 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Bindings keys and mouse
@@ -44,9 +44,10 @@
 (define-main-key ("Home" :mod-1 :control :shift) 'quit-clfswm)
 
 (define-main-key (#\t :mod-1) 'second-key-mode)
+(define-main-key ("less" :control) 'second-key-mode)
 
-(define-main-key (#\Tab :mod-1) 'rotate-window-up)
-(define-main-key (#\Tab :mod-1 :shift) 'rotate-window-down)
+(define-main-key ("Tab" :mod-1) 'rotate-window-up)
+(define-main-key ("Tab" :mod-1 :shift) 'rotate-window-down)
 
 (define-main-key (#\b :mod-1) 'banish-pointer)
 (define-main-key (#\b :mod-1 :control) 'toggle-maximize-current-group)
--- /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/01/01 16:32:45	1.11
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp	2008/01/03 20:31:24	1.12
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Jan  1 17:30:30 2008
+;;; #Date#: Thu Jan  3 00:25:14 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Main functions
--- /project/clfswm/cvsroot/clfswm/clfswm-keys.lisp	2007/12/22 22:55:26	1.4
+++ /project/clfswm/cvsroot/clfswm/clfswm-keys.lisp	2008/01/03 20:31:24	1.5
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Sat Dec 22 22:52:07 2007
+;;; #Date#: Thu Jan  3 19:24:00 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Keys functions definition
@@ -119,8 +119,8 @@
 			     (,function *root* keycode :modifiers (second k))
 			     (format t "~&Grabbing error: Can't find key '~A'~%" key)))
 		     (error (c)
-		       (declare (ignore c))
-		       (format t "~&Grabbing error: Can't grab key '~A'~%" k)))
+		       ;;(declare (ignore c))
+		       (format t "~&Grabbing error: Can't grab key '~A' (~A)~%" k c)))
 		   (force-output)))
      ,hashtable)))
 
--- /project/clfswm/cvsroot/clfswm/clfswm-second-mode.lisp	2008/01/01 19:13:45	1.9
+++ /project/clfswm/cvsroot/clfswm/clfswm-second-mode.lisp	2008/01/03 20:31:24	1.10
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Jan  1 20:12:23 2008
+;;; #Date#: Thu Jan  3 00:14:39 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Second mode functions
@@ -69,8 +69,7 @@
 
 (defun sm-handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
   (declare (ignore event-slots))
-  (unless (event-case (*display* :discard-p nil :peek-p t :timeout 0)
-	    (:motion-notify () t))
+  (unless (compress-motion-notify)
     (funcall-button-from-code *mouse-action* 'motion 0 root-x root-y #'first)))
 
 (defun sm-handle-button-press (&rest event-slots &key root-x root-y code state &allow-other-keys)
--- /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/01/01 21:44:16	1.9
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp	2008/01/03 20:31:24	1.10
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Jan  1 22:39:40 2008
+;;; #Date#: Wed Jan  2 23:45:31 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility
@@ -618,6 +618,7 @@
 	(xgrab-pointer *root* 92 93)
 	(map-window window)
 	(print-string)
+	(wait-no-key-or-button-press)
 	(unwind-protect
 	     (loop until (or (eq done :Return) (eq done :Escape)) do
 		   (display-finish-output *display*)
--- /project/clfswm/cvsroot/clfswm/clfswm.asd	2007/12/29 15:20:10	1.5
+++ /project/clfswm/cvsroot/clfswm/clfswm.asd	2008/01/03 20:31:24	1.6
@@ -2,7 +2,7 @@
 ;;;; Author: Philippe Brochard <hocwp at free.fr>
 ;;;; ASDF System Definition
 ;;;
-;;; #date#: Sat Dec 29 15:08:01 2007
+;;; #date#: Wed Jan  2 23:30:31 2008
 
 (in-package #:asdf)
 
@@ -18,12 +18,12 @@
 		  :depends-on ("my-html" "tools"))
 		 (:file "config"
 		  :depends-on ("package"))
-		 (:file "xlib-util"
+		 (:file "keysyms"
 		  :depends-on ("package"))
+		 (:file "xlib-util"
+		  :depends-on ("package" "keysyms" "config"))
 		 (:file "netwm-util"
 		  :depends-on ("package" "xlib-util"))
-		 (:file "keysyms"
-		  :depends-on ("package"))
 		 (:file "clfswm-keys"
 		  :depends-on ("package" "config" "xlib-util" "keysyms"))
 		 (:file "clfswm-internal"
--- /project/clfswm/cvsroot/clfswm/clfswm.lisp	2008/01/01 16:32:45	1.9
+++ /project/clfswm/cvsroot/clfswm/clfswm.lisp	2008/01/03 20:31:24	1.10
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Tue Jan  1 17:26:34 2008
+;;; #Date#: Thu Jan  3 19:24:03 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Main functions
--- /project/clfswm/cvsroot/clfswm/config.lisp	2007/12/26 22:49:35	1.6
+++ /project/clfswm/cvsroot/clfswm/config.lisp	2008/01/03 20:31:24	1.7
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Wed Dec 26 20:22:26 2007
+;;; #Date#: Wed Jan  2 23:40:41 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Configuration file
@@ -33,6 +33,13 @@
 (in-package :clfswm)
 
 
+;;; CONFIG - Compress motion notify ?
+(defparameter *have-to-compress-notify* nil
+  "This variable may be useful to speed up some slow version of CLX.
+It is particulary useful with CLISP/MIT-CLX.")
+  
+
+
 ;;; CONFIG - Screen size
 ;;(defparameter *fullscreen* '(0 0 1024 600))
 (defparameter *fullscreen* '(0 0 1024 768))
--- /project/clfswm/cvsroot/clfswm/dot-clfswmrc	2007/12/29 15:24:44	1.5
+++ /project/clfswm/cvsroot/clfswm/dot-clfswmrc	2008/01/03 20:31:24	1.6
@@ -7,6 +7,12 @@
 
 (in-package :clfswm)
 
+
+;;;; 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)
+
 ;;; Color configuration example
 ;;;
 ;;; See in package.lisp for all variables
--- /project/clfswm/cvsroot/clfswm/load.lisp	2007/12/21 22:01:14	1.3
+++ /project/clfswm/cvsroot/clfswm/load.lisp	2008/01/03 20:31:24	1.4
@@ -37,6 +37,9 @@
 #+SBCL
 (require :asdf)
 
+#+SBCL
+(require :clx)
+
 #-ASDF
 (load (make-pathname :host (pathname-host *base-dir*)
 		     :device (pathname-device *base-dir*)
--- /project/clfswm/cvsroot/clfswm/xlib-util.lisp	2007/12/21 22:01:14	1.4
+++ /project/clfswm/cvsroot/clfswm/xlib-util.lisp	2008/01/03 20:31:24	1.5
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Fri Dec 21 23:00:46 2007
+;;; #Date#: Thu Jan  3 17:50:59 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility functions
@@ -247,6 +247,45 @@
   (alloc-color (screen-default-colormap *screen*) color))
 
 
+
+
+
+#+CLISP
+(unless (fboundp 'xlib:character->keysyms)
+  (ext:without-package-lock ("XLIB")
+    (defun character->keysyms (ch)
+      "Convert a char to a keysym"
+      ;; XLIB:CHARACTER->KEYSYMS should probably be implemented in NEW-CLX
+      ;; some day.  Or just copied from MIT-CLX or some other CLX
+      ;; implementation (see translate.lisp and keysyms.lisp).  For now,
+      ;; we do like this.  It suffices for modifiers and ASCII symbols.
+      (list
+       (case ch
+	 (:character-set-switch #xFF7E)
+	 (:left-shift #xFFE1)
+	 (:right-shift #xFFE2)
+	 (:left-control #xFFE3)
+	 (:right-control #xFFE4)
+	 (:caps-lock #xFFE5)
+	 (:shift-lock #xFFE6)
+	 (:left-meta #xFFE7)
+	 (:right-meta #xFFE8)
+	 (:left-alt #xFFE9)
+	 (:right-alt #xFFEA)
+	 (:left-super #xFFEB)
+	 (:right-super #xFFEC)
+	 (:left-hyper #xFFED)
+	 (:right-hyper #xFFEE)
+	 (t
+	  (etypecase ch
+	    (character
+	     ;; Latin-1 characters have their own value as keysym
+	     (if (< 31 (char-code ch) 256)
+		 (char-code ch)
+		 (error "Don't know how to get keysym from ~A" ch))))))))))
+
+
+
 (defun char->keycode (char)
   "Convert a character to a keycode"
   (keysym->keycodes *display* (first (character->keysyms char))))
@@ -278,3 +317,10 @@
 		     (t nil)))
        (return-from wait-no-key-or-button-press nil)))))
 
+
+
+(defun compress-motion-notify ()
+  (when *have-to-compress-notify*
+    (event-case (*display* :discard-p nil :peek-p t :timeout 0)
+		(:motion-notify () t))))
+




More information about the clfswm-cvs mailing list