[clfswm-cvs] r339 - in clfswm: . src

[Philippe Brochard]

Author: pbrochard
Date: Thu Sep 30 08:23:19 2010
New Revision: 339

Log:
src/clfswm-expose-mode.lisp (expose-create-window): Show window title in accel window.

Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/src/clfswm-expose-mode.lisp
   clfswm/src/config.lisp
   clfswm/src/package.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Thu Sep 30 08:23:19 2010
@@ -1,3 +1,8 @@
+2010-09-30  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-expose-mode.lisp (expose-create-window): Show window
+	title in accel window.
+
 2010-09-29  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* configure: Use the Xavier Maillard clfswm script in contrib to

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Thu Sep 30 08:23:19 2010
@@ -7,8 +7,6 @@
 ===============
 Should handle these soon.
 
-- Add a expose-(all-)windows menu.
-
 - Add a binding/functions to circulate over children of the current child.
 
 MAYBE

Modified: clfswm/src/clfswm-expose-mode.lisp
==============================================================================
--- clfswm/src/clfswm-expose-mode.lisp	(original)
+++ clfswm/src/clfswm-expose-mode.lisp	Thu Sep 30 08:23:19 2010
@@ -97,33 +97,39 @@
 
 
 (defun expose-draw-letter ()
-  (loop for lwin in *expose-windows-list*
-       for n from 0 do
+  (loop for lwin in *expose-windows-list* do
        (xlib:draw-glyphs (first lwin) (second lwin)
 			 (xlib:max-char-width *expose-font*)
 			 (+ (xlib:font-ascent *expose-font*) (xlib:font-descent *expose-font*))
-			 (format nil "~A" (number->char n)))))
+			 (third lwin))))
 
 (defun expose-create-window (child n)
-  (declare (ignore n))
-  (with-placement (*expose-mode-placement* x y (child-width child) (child-height child))
-    (let* ((window (xlib:create-window :parent *root*
-				       :x (+ (child-x child) x)
-				       :y (+ (child-y child) y)
-				       :width (* (xlib:max-char-width *expose-font*) 3)
-				       :height (* (xlib:font-ascent *expose-font*) 2)
+  (let* ((*current-child* child)
+	 (string (format nil "~A~A" (number->char n)
+			 (if *expose-show-window-title*
+			     (format nil " - ~A" (child-fullname child))
+			     "")))
+	 (width (if *expose-show-window-title*
+		    (min (* (xlib:max-char-width *expose-font*) (+ (length string) 2))
+			 (- (child-width child) 4))
+		    (* (xlib:max-char-width *expose-font*) 3)))
+	 (height (* (xlib:font-ascent *expose-font*) 2)))
+    (with-placement (*expose-mode-placement* x y width height)
+      (let* ((window (xlib:create-window :parent *root*
+					 :x x   :y y
+					 :width width   :height height
+					 :background (get-color *expose-background*)
+					 :border-width 1
+					 :border (get-color *expose-border*)
+					 :colormap (xlib:screen-default-colormap *screen*)
+					 :event-mask '(:exposure :key-press)))
+	     (gc (xlib:create-gcontext :drawable window
+				       :foreground (get-color *expose-foreground*)
 				       :background (get-color *expose-background*)
-				       :border-width 1
-				       :border (get-color *expose-border*)
-				       :colormap (xlib:screen-default-colormap *screen*)
-				       :event-mask '(:exposure :key-press)))
-	   (gc (xlib:create-gcontext :drawable window
-				     :foreground (get-color *expose-foreground*)
-				     :background (get-color *expose-background*)
-				     :font *expose-font*
-				     :line-style :solid)))
-      (map-window window)
-      (push (list window gc) *expose-windows-list*))))
+				       :font *expose-font*
+				       :line-style :solid)))
+	(map-window window)
+	(push (list window gc string) *expose-windows-list*)))))
 
 
 

Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp	(original)
+++ clfswm/src/config.lisp	Thu Sep 30 08:23:19 2010
@@ -274,6 +274,8 @@
   "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")
 
 
 

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Thu Sep 30 08:23:19 2010
@@ -206,7 +206,7 @@
   "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-placement
+(defparameter *expose-mode-placement* 'top-left-child-placement
   "Config(Placement group): Expose mode window placement (Selection keys position)")