[clfswm-cvs] r33 - clfswm

[pbrochard at common-lisp.net]

Author: pbrochard
Date: Tue Mar 11 06:40:18 2008
New Revision: 33

Modified:
   clfswm/ChangeLog
   clfswm/clfswm-keys.lisp
   clfswm/clfswm-util.lisp
Log:
Display the documentation associated to keys when identifying a key.


Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Tue Mar 11 06:40:18 2008
@@ -1,3 +1,8 @@
+2008-03-11  Philippe Brochard  <hocwp at free.fr>
+
+	* clfswm-util.lisp (identify-key): Display the documentation
+	associated to keys when identifying a key.
+
 2008-03-10  Xavier Maillard  <xma at gnu.org>
 
 	* contrib/clfswm: Complete rewrite of the script. Detect error and

Modified: clfswm/clfswm-keys.lisp
==============================================================================
--- clfswm/clfswm-keys.lisp	(original)
+++ clfswm/clfswm-keys.lisp	Tue Mar 11 06:40:18 2008
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Thu Mar  6 16:47:42 2008
+;;; #Date#: Tue Mar 11 12:23:23 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Keys functions definition
@@ -129,27 +129,33 @@
 
 
 
-
-
-
-
-(defun funcall-key-from-code (hash-table-key code state &optional args)
-  (labels ((funcall-from (key)
+(defun find-key-from-code (hash-table-key code state)
+  "Return the function associated to code/state"
+  (labels ((function-from (key)
 	     (multiple-value-bind (function foundp)
 		 (gethash (list key state) hash-table-key)
 	       (when (and foundp (first function))
-		 (if args
-		     (funcall (first function) args)
-		     (funcall (first function)))
-		 t)))
+		 (first function))))
 	   (from-code ()
-	     (funcall-from code))
+	     (function-from code))
 	   (from-char ()
 	     (let ((char (keycode->char code state)))
-	       (funcall-from char)))
+	       (function-from char)))
 	   (from-string ()
 	     (let ((string (keysym->keysym-name (xlib:keycode->keysym *display* code 0))))
-	       (funcall-from string))))
+	       (function-from string))))
+    (or (from-code) (from-char) (from-string))))
+
+
+
+(defun funcall-key-from-code (hash-table-key code state &optional args)
+  (let ((function (find-key-from-code hash-table-key code state)))
+    (when function
+      (apply function args)
+      t)))
+
+       
+  (labels 
     (cond ((from-code))
 	  ((from-char))
 	  ((from-string)))))

Modified: clfswm/clfswm-util.lisp
==============================================================================
--- clfswm/clfswm-util.lisp	(original)
+++ clfswm/clfswm-util.lisp	Tue Mar 11 06:40:18 2008
@@ -1,7 +1,7 @@
 ;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
-;;; #Date#: Fri Mar  7 23:07:03 2008
+;;; #Date#: Tue Mar 11 12:35:53 2008
 ;;;
 ;;; --------------------------------------------------------------------------
 ;;; Documentation: Utility
@@ -208,7 +208,7 @@
 	 (window (xlib:create-window :parent *root*
 				     :x 0 :y 0
 				     :width (- (xlib:screen-width *screen*) 2)
-				     :height (* 3 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font)))
+				     :height (* 5 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font)))
 				     :background (get-color *identify-background*)
 				     :border-width 1
 				     :border (get-color *identify-border*)
@@ -219,7 +219,12 @@
 				   :background (get-color *identify-background*)
 				   :font font
 				   :line-style :solid)))
-    (labels ((print-key (code keysym key modifiers)
+    (labels ((print-doc (msg hash-table-key pos code state)
+	       (let ((function (find-key-from-code hash-table-key code state)))
+		 (when function
+		   (xlib:draw-image-glyphs window gc 10 (+ (* pos (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
+					   (format nil "~A ~A" msg (documentation function 'function))))))
+	     (print-key (code state keysym key modifiers)
 	       (xlib:clear-area window)
 	       (setf (xlib:gcontext-foreground gc) (get-color *identify-foreground*))
 	       (xlib:draw-image-glyphs window gc 5 (+ (xlib:max-char-ascent font) 5)
@@ -227,7 +232,9 @@
 	       (when code
 		 (xlib:draw-image-glyphs window gc 10 (+ (* 2 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font))) 5)
 					 (format nil "Code=~A  KeySym=~A  Key=~S  Modifiers=~A"
-						 code keysym key modifiers))))
+						 code keysym key modifiers))
+		 (print-doc "Main mode  : " *main-keys* 3 code state)
+		 (print-doc "Second mode: " *second-keys* 4 code state)))
 	     (handle-identify-key (&rest event-slots &key root code state &allow-other-keys)
 	       (declare (ignore event-slots root))
 	       (let* ((modifiers (xlib:make-state-keys state))
@@ -235,18 +242,18 @@
 		      (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code 0))))
 		 (setf done (and (equal key #\q) (null modifiers)))
 		 (dbg code keysym key modifiers)
-		 (print-key code keysym key modifiers)
+		 (print-key code state keysym key modifiers)
 		 (force-output)))
 	     (handle-identify (&rest event-slots &key display event-key &allow-other-keys)
 	       (declare (ignore display))
 	       (case event-key
 		 (:key-press (apply #'handle-identify-key event-slots) t)
-		 (:exposure (print-key nil nil nil nil)))
+		 (:exposure (print-key nil nil nil nil nil)))
 	       t))
       (xgrab-pointer *root* 92 93)
       (xlib:map-window window)
       (format t "~&Press 'q' to stop the identify loop~%")
-      (print-key nil nil nil nil)
+      (print-key nil nil nil nil nil)
       (force-output)
       (unwind-protect
 	   (loop until done do