[clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1212-41-gfd52c5e

Philippe Brochard pbrochard at common-lisp.net
Wed Aug 7 21:11:56 UTC 2013


This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".

The branch, master has been updated
       via  fd52c5eaf5641ef98a23d9233db46ad0bb3878bb (commit)
       via  ae68af20a5e625d7e4762ee050f19651fb919aac (commit)
       via  3a175aaf2f538f17875849947f50974b92217575 (commit)
       via  34d0b45167698365f5b786db8bb9cd9971359a64 (commit)
       via  23bc3eecc83c1ae63cfcd768574d064704d04bfd (commit)
       via  a5198305ba0658608ef5d83d6abb9467cf66d7fb (commit)
       via  ba625cce9a80bb8c1b706ca117aff0ae0752a54c (commit)
       via  223b8f75a512cf7705d2d69c3a4a9f0168278aae (commit)
      from  8fd97bbed3ed7fceff69f22360c9908f56d2f227 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit fd52c5eaf5641ef98a23d9233db46ad0bb3878bb
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Fri Aug 2 14:45:29 2013 +0200

    Always focus from frame

diff --git a/src/clfswm-fastswitch-mode.lisp b/src/clfswm-fastswitch-mode.lisp
index dad4131..f2aa376 100644
--- a/src/clfswm-fastswitch-mode.lisp
+++ b/src/clfswm-fastswitch-mode.lisp
@@ -213,7 +213,6 @@
           (when (and (frame-p from) (frame-p to))
             (remove-child-in-frame window from)
             (pushnew window (frame-child to) :test #'child-equal-p)
-            (when (child-equal-p window (current-child))
-              (focus-all-children window to))))))
+            (focus-all-children from from)))))
     (show-all-children))
   t)

commit ae68af20a5e625d7e4762ee050f19651fb919aac
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Thu Aug 1 23:04:57 2013 +0200

    Add a fastswitch-move-mode to move children from expose shortcuts

diff --git a/src/bindings.lisp b/src/bindings.lisp
index ba51437..48b78a0 100644
--- a/src/bindings.lisp
+++ b/src/bindings.lisp
@@ -75,7 +75,7 @@
   (define-main-key ("Home" :mod-1) 'switch-to-root-frame)
   (define-main-key ("Home" :mod-1 :shift) 'switch-and-select-root-frame)
   (define-main-key ("Menu") 'fastswitch-mode)
-  (define-main-key (135) 'fastswitch-mode)  ;; Menu hardcoded -> not good!!!
+  (define-main-key ("Menu" :control) 'fastswitch-move-mode)
   (define-main-key ("F10" :mod-1) 'fast-layout-switch)
   (define-main-key ("F10" :shift :control) 'toggle-show-root-frame)
   (define-main-key ("F10") 'expose-windows-mode)
diff --git a/src/clfswm-fastswitch-mode.lisp b/src/clfswm-fastswitch-mode.lisp
index c74d2d5..dad4131 100644
--- a/src/clfswm-fastswitch-mode.lisp
+++ b/src/clfswm-fastswitch-mode.lisp
@@ -33,7 +33,7 @@
 (defparameter *fastswitch-font* nil)
 (defparameter *fastswitch-string* "")
 (defparameter *fastswitch-match-child* nil)
-
+(defparameter *fastswitch-msg* nil)
 
 (defun leave-fastswitch-mode ()
   "Leave the fastswitch mode"
@@ -91,10 +91,18 @@
     (when *fastswitch-adjust-window-p*
       (adjust-window))
     (clear-pixmap-buffer *fastswitch-window* *fastswitch-gc*)
+    (when *fastswitch-msg*
+      (xlib:draw-image-glyphs *pixmap-buffer* *fastswitch-gc*
+                              (xlib:max-char-width *fastswitch-font*)
+                              (+ (xlib:font-ascent *fastswitch-font*) (xlib:font-descent *fastswitch-font*))
+                              *fastswitch-msg*))
     (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-letter*)
                                          :background (get-color *fastswitch-background*))
       (xlib:draw-image-glyphs *pixmap-buffer* *fastswitch-gc*
-                              (xlib:max-char-width *fastswitch-font*)
+                              (* (xlib:max-char-width *fastswitch-font*)
+                                 (if *fastswitch-msg*
+                                     (1+ (length *fastswitch-msg*))
+                                     1))
                               (+ (xlib:font-ascent *fastswitch-font*) (xlib:font-descent *fastswitch-font*))
                               *fastswitch-string*))
     (display-match-child)
@@ -160,7 +168,7 @@
       (fastswitch-draw-window))))
 
 
-(defun fastswitch-do-main ()
+(defun fastswitch-select-child ()
   (with-grab-keyboard-and-pointer (92 93 66 67 t)
     (generic-mode 'fastswitch-mode 'exit-fastswitch-loop
                   :enter-function #'fastswitch-enter-function
@@ -175,7 +183,8 @@
 (defun fastswitch-mode ()
   "Switch between children with expose shortcut"
   (setf *expose-child-list* (expose-associate-keys))
-  (let ((ex-child (fastswitch-do-main)))
+  (setf *fastswitch-msg* "Select child:  ")
+  (let ((ex-child (fastswitch-select-child)))
     (when (and ex-child (expose-child-child ex-child))
       (expose-focus-child (expose-child-child ex-child))))
   (show-all-children)
@@ -183,3 +192,28 @@
 
 
 
+;;; Fastswitch move mode
+(defun fastswitch-move-mode ()
+  "Move children with expose shortcut"
+  (let ((window nil))
+    (with-focus-window (win)
+      (setf window win))
+    (no-focus)
+    (setf *expose-child-list* (expose-associate-keys))
+    (setf *fastswitch-msg* (if window
+                               (format nil "Move focused child [~A] with:  "
+                                       (child-fullname window))
+                               "No child to move...  "))
+    (let ((ex-child (fastswitch-select-child)))
+      (when (and window ex-child (expose-child-child ex-child))
+        (let ((from (find-parent-frame window))
+              (to (typecase (expose-child-child ex-child)
+                    (xlib:window (find-parent-frame (expose-child-child ex-child)))
+                    (frame (expose-child-child ex-child)))))
+          (when (and (frame-p from) (frame-p to))
+            (remove-child-in-frame window from)
+            (pushnew window (frame-child to) :test #'child-equal-p)
+            (when (child-equal-p window (current-child))
+              (focus-all-children window to))))))
+    (show-all-children))
+  t)

commit 3a175aaf2f538f17875849947f50974b92217575
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Wed Jul 31 17:07:36 2013 +0200

    Remove fake screen sizes

diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 73dbcd8..2659413 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -850,7 +850,7 @@ XINERAMA version 1.1 opcode: 150
 
   (defun place-frames-from-xinerama-infos ()
     "Place frames according to xdpyinfo/xinerama informations"
-    (let ((sizes (get-connected-heads-size t)) ;;; PHIL: remove here
+    (let ((sizes (get-connected-heads-size))
           (width (screen-width))
           (height (screen-height)))
       (labels ((update-root-geometry ()

commit 34d0b45167698365f5b786db8bb9cd9971359a64
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Wed Jul 31 17:04:59 2013 +0200

    Ensure query strings and info strings are printable

diff --git a/src/clfswm-info.lisp b/src/clfswm-info.lisp
index 836ce43..ca9983b 100644
--- a/src/clfswm-info.lisp
+++ b/src/clfswm-info.lisp
@@ -96,7 +96,7 @@
                         *pixmap-buffer* (info-gc info)
                         (- (+ (info-ilw info) (* posx (info-ilw info))) (info-x info))
                         (info-y-display-coords info posy)
-                        (format nil "~A" line)))
+                        (ensure-printable (format nil "~A" line))))
 	     (+ posx (length line))))
     (clear-pixmap-buffer (info-window info) (info-gc info))
     (loop for line in (info-list info)
diff --git a/src/clfswm-query.lisp b/src/clfswm-query.lisp
index 091eda5..0181374 100644
--- a/src/clfswm-query.lisp
+++ b/src/clfswm-query.lisp
@@ -137,7 +137,7 @@
     (xlib:draw-glyphs *pixmap-buffer* *query-gc*
 		      (+ 10 dec)
 		      (+ (* 2 (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*))) 5)
-		      *query-string*)
+		      (ensure-printable *query-string*))
     (setf (xlib:gcontext-foreground *query-gc*) (get-color *query-cursor-color*))
     (xlib:draw-line *pixmap-buffer* *query-gc*
 		    (+ 10 (* *query-pos* (xlib:max-char-width *query-font*)) dec)

commit 23bc3eecc83c1ae63cfcd768574d064704d04bfd
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Wed Jul 31 17:01:07 2013 +0200

    Use x-drawable-width/height of *root* instead of xlib:screen-width/height to get the screen size

diff --git a/src/clfswm-corner.lisp b/src/clfswm-corner.lisp
index 2ac28df..9c1597c 100644
--- a/src/clfswm-corner.lisp
+++ b/src/clfswm-corner.lisp
@@ -27,8 +27,8 @@
 
 
 
-(symbol-macrolet ((sw (xlib:screen-width *screen*))
-		  (sh (xlib:screen-height *screen*))
+(symbol-macrolet ((sw (screen-width))
+		  (sh (screen-height))
 		  (cs *corner-size*))
   (defun in-corner (corner x y)
     "Return t if (x, y) is in corner.
@@ -44,8 +44,8 @@ Corner is one of :bottom-right :bottom-left :top-right :top-left"
 	   (<= ymin y ymax)))))
 
 
-(symbol-macrolet ((sw (xlib:screen-width *screen*))
-		  (sh (xlib:screen-height *screen*))
+(symbol-macrolet ((sw (screen-width))
+		  (sh (screen-height))
 		  (cs *corner-size*))
   (defun find-corner (x y)
     (cond ((and (< cs x (- sw cs)) (< cs y (- sh cs))) nil)
diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp
index f4354ba..22c52f8 100644
--- a/src/clfswm-expose-mode.lisp
+++ b/src/clfswm-expose-mode.lisp
@@ -141,8 +141,8 @@
 	*expose-child-list* (expose-associate-keys)
 	*expose-selected-child* nil
         *query-string* "")
-  (xlib:warp-pointer *root* (truncate (/ (xlib:screen-width *screen*) 2))
-		     (truncate (/ (xlib:screen-height *screen*) 2)))
+  (xlib:warp-pointer *root* (truncate (/ (screen-width) 2))
+		     (truncate (/ (screen-height) 2)))
   (add-hook *query-key-press-hook* 'expose-query-key-press-hook)
   (add-hook *query-button-press-hook* 'expose-query-button-press-hook))
 
diff --git a/src/clfswm-fastswitch-mode.lisp b/src/clfswm-fastswitch-mode.lisp
index ea1eb37..c74d2d5 100644
--- a/src/clfswm-fastswitch-mode.lisp
+++ b/src/clfswm-fastswitch-mode.lisp
@@ -71,13 +71,13 @@
                                        (child-fullname (expose-child-child ex-child)))
                      (incf posx (1+ (length (child-fullname (expose-child-child ex-child))))))
                    (when (> (* posx (xlib:max-char-width *fastswitch-font*))
-                            (xlib:drawable-width *fastswitch-window*))
+                            (x-drawable-width *fastswitch-window*))
                      (if *fastswitch-adjust-window-p*
                          (setf posx 1
                                posy (1+ posy))
                          (return)))))))
            (adjust-window ()
-             (setf (xlib:drawable-height *fastswitch-window*) (* (xlib:font-ascent *fastswitch-font*) 3))
+             (setf (x-drawable-height *fastswitch-window*) (* (xlib:font-ascent *fastswitch-font*) 3))
              (let ((posx 1))
                (dolist (ex-child *fastswitch-match-child*)
                  (when (or *fastswitch-show-frame-p* (not (frame-p (expose-child-child ex-child))))
@@ -85,9 +85,9 @@
                    (incf posx)
                    (incf posx (1+ (length (child-fullname (expose-child-child ex-child)))))
                    (when (> (* posx (xlib:max-char-width *fastswitch-font*))
-                            (xlib:drawable-width *fastswitch-window*))
+                            (x-drawable-width *fastswitch-window*))
                      (setf posx 1)
-                     (incf (xlib:drawable-height *fastswitch-window*) (xlib:font-ascent *fastswitch-font*))))))))
+                     (incf (x-drawable-height *fastswitch-window*) (xlib:font-ascent *fastswitch-font*))))))))
     (when *fastswitch-adjust-window-p*
       (adjust-window))
     (clear-pixmap-buffer *fastswitch-window* *fastswitch-gc*)
@@ -106,7 +106,7 @@
   (setf *fastswitch-font* (xlib:open-font *display* *fastswitch-font-string*)
         *fastswitch-string* ""
         *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key))
-  (let* ((width (- (xlib:screen-width *screen*) 2))
+  (let* ((width (- (screen-width) 2))
          (height (* (xlib:font-ascent *fastswitch-font*) 3)))
     (with-placement (*fastswitch-mode-placement* x y width height)
       (setf *fastswitch-window* (xlib:create-window :parent *root*
diff --git a/src/clfswm-info.lisp b/src/clfswm-info.lisp
index 46be718..836ce43 100644
--- a/src/clfswm-info.lisp
+++ b/src/clfswm-info.lisp
@@ -317,10 +317,10 @@ Or ((1_word color) (2_word color) 3_word (4_word color)...)"
 	       (ilh (+ (xlib:max-char-ascent font) (xlib:max-char-descent font) 1))
 	       (width (or width
 			  (min (* (+ (loop for l in info-list maximize (compute-size l)) 2) ilw)
-			       (xlib:screen-width *screen*))))
+			       (screen-width))))
 	       (height (or height
 			   (min (round (+ (* (length info-list) ilh) (/ ilh 2)))
-				(xlib:screen-height *screen*)))))
+				(screen-height)))))
 	  (with-placement (*info-mode-placement* x y width height)
 	    (let* ((window (xlib:create-window :parent *root*
 					       :x x :y y
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index f56de6b..73dbcd8 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -1,4 +1,4 @@
-;; --------------------------------------------------------------------------
+;;; --------------------------------------------------------------------------
 ;;; CLFSWM - FullScreen Window Manager
 ;;;
 ;;; --------------------------------------------------------------------------
@@ -762,7 +762,7 @@
   (unless (get-root-list)
     (let ((frame (create-frame)))
       (add-frame frame *root-frame*)
-      (define-as-root frame 0 0 (xlib:screen-width *screen*) (xlib:screen-height *screen*))
+      (define-as-root frame 0 0 (screen-width) (screen-height))
       (add-frame (create-frame) frame))))
 
 
@@ -850,9 +850,9 @@ XINERAMA version 1.1 opcode: 150
 
   (defun place-frames-from-xinerama-infos ()
     "Place frames according to xdpyinfo/xinerama informations"
-    (let ((sizes (get-connected-heads-size))
-          (width (xlib:screen-width *screen*))
-          (height (xlib:screen-height *screen*)))
+    (let ((sizes (get-connected-heads-size t)) ;;; PHIL: remove here
+          (width (screen-width))
+          (height (screen-height)))
       (labels ((update-root-geometry ()
                  (loop for size in sizes
                     for root in (get-root-list)
@@ -1020,8 +1020,8 @@ XINERAMA version 1.1 opcode: 150
                     (funcall it child parent)
                     (no-layout child parent))
                (values (- (child-border-size child)) (- (child-border-size child))
-                       (xlib:screen-width *screen*)
-                       (xlib:screen-height *screen*)))
+                       (screen-width)
+                       (screen-height)))
            (values (x-drawable-x child) (x-drawable-y child)
                    (x-drawable-width child) (x-drawable-height child)))))
 
@@ -1625,8 +1625,8 @@ managed."
 
 (defun store-root-background ()
   (with-all-mapped-windows *screen* #'hide-window)
-  (setf *background-image* (xlib:create-pixmap :width (xlib:screen-width *screen*)
-                                               :height (xlib:screen-height *screen*)
+  (setf *background-image* (xlib:create-pixmap :width (screen-width)
+                                               :height (screen-height)
                                                :depth (xlib:screen-root-depth *screen*)
                                                :drawable *root*)
         *background-gc* (xlib:create-gcontext :drawable *background-image*
@@ -1635,7 +1635,7 @@ managed."
                                               :font *default-font*
                                               :line-style :solid))
   (xlib:copy-area *root* *background-gc*
-                  0 0 (xlib:screen-width *screen*) (xlib:screen-height *screen*)
+                  0 0 (screen-width) (screen-height)
                   *background-image* 0 0)
   (with-all-mapped-windows *screen* #'unhide-window))
 
diff --git a/src/clfswm-placement.lisp b/src/clfswm-placement.lisp
index cb8efb8..d777d66 100644
--- a/src/clfswm-placement.lisp
+++ b/src/clfswm-placement.lisp
@@ -61,8 +61,8 @@
 ;;; Absolute placement
 ;;;
 (defun root-screen-coord (border-size)
-  (values (- (xlib:screen-width *screen*) (* 2 border-size))
-          (- (xlib:screen-height *screen*) (* 2 border-size))))
+  (values (- (screen-width) (* 2 border-size))
+          (- (screen-height) (* 2 border-size))))
 
 (defmacro with-root-screen-coord ((border-size w h) &body body)
   `(multiple-value-bind (,w ,h)
diff --git a/src/clfswm-query.lisp b/src/clfswm-query.lisp
index e250ee7..091eda5 100644
--- a/src/clfswm-query.lisp
+++ b/src/clfswm-query.lisp
@@ -150,7 +150,7 @@
 
 (defun query-enter-function ()
   (setf *query-font* (xlib:open-font *display* *query-font-string*))
-  (let ((width (- (xlib:screen-width *screen*) 2))
+  (let ((width (- (screen-width) 2))
 	(height (* 3 (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*)))))
     (with-placement (*query-mode-placement* x y width height)
       (setf *query-window* (xlib:create-window :parent *root*
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 4521c0c..2d24a98 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -493,7 +493,7 @@ Write (defparameter *contrib-dir* \"/usr/local/lib/clfswm/\") in ~A.~%"
 	 (font (xlib:open-font *display* *identify-font-string*))
 	 (window (xlib:create-window :parent *root*
 				     :x 0 :y 0
-				     :width (- (xlib:screen-width *screen*) (* *border-size* 2))
+				     :width (- (screen-width) (* *border-size* 2))
 				     :height (* 5 (+ (xlib:max-char-ascent font) (xlib:max-char-descent font)))
 				     :background (get-color *identify-background*)
 				     :border-width *border-size*
@@ -577,7 +577,7 @@ Write (defparameter *contrib-dir* \"/usr/local/lib/clfswm/\") in ~A.~%"
           (let ((ret (info-mode (expand-newline (append (ensure-list (format nil "> ~A" form))
                                                         (ensure-list printed-result)
                                                         (ensure-list result)))
-                                :width (- (xlib:screen-width *screen*) 2))))
+                                :width (- (screen-width) 2))))
             (when (or (search "defparameter" form :test #'string-equal)
                       (search "defvar" form :test #'string-equal))
               (let ((elem (split-string form)))
@@ -1662,7 +1662,7 @@ For window: set current child to window or its parent according to window-parent
 	(reset-if-moved x y)
 	(setf minx x)
 	(add-in-history x y)
-	(setf lx (middle minx (or maxx (xlib:screen-width *screen*))))
+	(setf lx (middle minx (or maxx (screen-width))))
 	(xlib:warp-pointer *root* lx y)))
     (defun speed-mouse-up ()
       "Speed move mouse to up"
@@ -1678,7 +1678,7 @@ For window: set current child to window or its parent according to window-parent
 	(reset-if-moved x y)
 	(setf miny y)
 	(add-in-history x y)
-	(setf ly (middle miny (or maxy (xlib:screen-height *screen*))))
+	(setf ly (middle miny (or maxy (screen-height))))
 	(xlib:warp-pointer *root* x ly)))
     (defun speed-mouse-undo ()
       "Undo last speed mouse move"
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index 090decd..ba8314b 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -124,8 +124,8 @@
 
 
 (define-handler main-mode :enter-notify  (window root-x root-y)
-  (unless (and (> root-x (- (xlib:screen-width *screen*) 3))
-	       (> root-y (- (xlib:screen-height *screen*) 3)))
+  (unless (and (> root-x (- (screen-width) 3))
+	       (> root-y (- (screen-height) 3)))
     (manage-focus window root-x root-y)))
 
 
@@ -198,8 +198,8 @@
 	*root* (xlib:screen-root *screen*)
 	*no-focus-window* (xlib:create-window :parent *root* :x 0 :y 0 :width 1 :height 1)
 	*default-font* (xlib:open-font *display* *default-font-string*)
-	*pixmap-buffer* (xlib:create-pixmap :width (xlib:screen-width *screen*)
-					    :height (xlib:screen-height *screen*)
+	*pixmap-buffer* (xlib:create-pixmap :width (screen-width)
+					    :height (screen-height)
 					    :depth (xlib:screen-root-depth *screen*)
 					    :drawable *root*)
 	*in-second-mode* nil
diff --git a/src/netwm-util.lisp b/src/netwm-util.lisp
index 71689c2..ff747f3 100644
--- a/src/netwm-util.lisp
+++ b/src/netwm-util.lisp
@@ -49,8 +49,8 @@
   ;;  (xlib:change-property *root* :_NET_NUMBER_OF_DESKTOPS
   ;;		   (list (length *workspace-list*)) :cardinal 32)
   ;;  (xlib:change-property *root* :_NET_DESKTOP_GEOMETRY
-  ;;		   (list (xlib:screen-width *screen*)
-  ;;			 (xlib:screen-height *screen*))
+  ;;		   (list (screen-width)
+  ;;			 (screen-height))
   ;;		   :cardinal 32)
   ;;  (xlib:change-property *root* :_NET_DESKTOP_VIEWPORT
   ;;		   (list 0 0) :cardinal 32)
diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp
index 1e305ba..b70f654 100644
--- a/src/xlib-util.lisp
+++ b/src/xlib-util.lisp
@@ -103,6 +103,14 @@ Features: ~A"
 ;;  `(progn
 ;;     , at body))
 
+(defun screen-width ()
+  ;;(xlib:screen-width *screen*))
+  (x-drawable-width *root*))
+
+(defun screen-height ()
+  ;;(xlib:screen-height *screen*))
+  (x-drawable-height *root*))
+
 
 
 (defmacro with-x-pointer (&body body)

commit a5198305ba0658608ef5d83d6abb9467cf66d7fb
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Wed Jul 31 16:31:24 2013 +0200

    Let the ability to adjust fastswitch mini window and show frames names or not

diff --git a/src/clfswm-fastswitch-mode.lisp b/src/clfswm-fastswitch-mode.lisp
index 2acb5a3..ea1eb37 100644
--- a/src/clfswm-fastswitch-mode.lisp
+++ b/src/clfswm-fastswitch-mode.lisp
@@ -43,30 +43,53 @@
 
 (defun fastswitch-draw-window ()
   (labels ((display-match-child ()
-             (let ((pos 1))
+             (let ((posx 1)
+                   (posy 2))
                (dolist (ex-child *fastswitch-match-child*)
-                 (xlib:with-gcontext (*fastswitch-gc*
-                                      :foreground (get-color (if (frame-p (expose-child-child ex-child))
-                                                                 *fastswitch-foreground-letter-second-frame*
-                                                                 *fastswitch-foreground-letter-second*)))
+                 (when (or *fastswitch-show-frame-p* (not (frame-p (expose-child-child ex-child))))
+                   (xlib:with-gcontext (*fastswitch-gc*
+                                        :foreground (get-color (if (frame-p (expose-child-child ex-child))
+                                                                   *fastswitch-foreground-letter-second-frame*
+                                                                   *fastswitch-foreground-letter-second*)))
+                     (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
+                                       (* (xlib:max-char-width *fastswitch-font*) posx)
+                                       (+ (* posy (xlib:font-ascent *fastswitch-font*))
+                                          (xlib:font-descent *fastswitch-font*) 1)
+                                       (expose-child-key ex-child)))
+                   (incf posx (length (expose-child-key ex-child)))
                    (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
-                                     (* (xlib:max-char-width *fastswitch-font*) pos)
-                                     (+ (* 2 (xlib:font-ascent *fastswitch-font*)) (xlib:font-descent *fastswitch-font*) 1)
-                                     (expose-child-key ex-child)))
-                 (incf pos (length (expose-child-key ex-child)))
-                 (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
-                                   (* (xlib:max-char-width *fastswitch-font*) pos)
-                                   (+ (* 2 (xlib:font-ascent *fastswitch-font*)) (xlib:font-descent *fastswitch-font*) 1)
-                                   ":")
-                 (incf pos)
-                 (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-childname*))
-                   (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
-                                     (* (xlib:max-char-width *fastswitch-font*) pos)
-                                     (+ (* 2 (xlib:font-ascent *fastswitch-font*)) (xlib:font-descent *fastswitch-font*) 1)
-                                     (child-fullname (expose-child-child ex-child)))
-                   (incf pos (1+ (length (child-fullname (expose-child-child ex-child))))))
-                 (when (> (* pos (xlib:max-char-width *fastswitch-font*)) (xlib:drawable-width *fastswitch-window*))
-                   (return))))))
+                                     (* (xlib:max-char-width *fastswitch-font*) posx)
+                                     (+ (* posy (xlib:font-ascent *fastswitch-font*))
+                                        (xlib:font-descent *fastswitch-font*) 1)
+                                     ":")
+                   (incf posx)
+                   (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-childname*))
+                     (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
+                                       (* (xlib:max-char-width *fastswitch-font*) posx)
+                                       (+ (* posy (xlib:font-ascent *fastswitch-font*))
+                                          (xlib:font-descent *fastswitch-font*) 1)
+                                       (child-fullname (expose-child-child ex-child)))
+                     (incf posx (1+ (length (child-fullname (expose-child-child ex-child))))))
+                   (when (> (* posx (xlib:max-char-width *fastswitch-font*))
+                            (xlib:drawable-width *fastswitch-window*))
+                     (if *fastswitch-adjust-window-p*
+                         (setf posx 1
+                               posy (1+ posy))
+                         (return)))))))
+           (adjust-window ()
+             (setf (xlib:drawable-height *fastswitch-window*) (* (xlib:font-ascent *fastswitch-font*) 3))
+             (let ((posx 1))
+               (dolist (ex-child *fastswitch-match-child*)
+                 (when (or *fastswitch-show-frame-p* (not (frame-p (expose-child-child ex-child))))
+                   (incf posx (length (expose-child-key ex-child)))
+                   (incf posx)
+                   (incf posx (1+ (length (child-fullname (expose-child-child ex-child)))))
+                   (when (> (* posx (xlib:max-char-width *fastswitch-font*))
+                            (xlib:drawable-width *fastswitch-window*))
+                     (setf posx 1)
+                     (incf (xlib:drawable-height *fastswitch-window*) (xlib:font-ascent *fastswitch-font*))))))))
+    (when *fastswitch-adjust-window-p*
+      (adjust-window))
     (clear-pixmap-buffer *fastswitch-window* *fastswitch-gc*)
     (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-letter*)
                                          :background (get-color *fastswitch-background*))
@@ -83,7 +106,7 @@
   (setf *fastswitch-font* (xlib:open-font *display* *fastswitch-font-string*)
         *fastswitch-string* ""
         *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key))
-  (let* ((width (- (xlib:screen-width *screen*) 2)) ;;(* (xlib:max-char-width *fastswitch-font*) 3))
+  (let* ((width (- (xlib:screen-width *screen*) 2))
          (height (* (xlib:font-ascent *fastswitch-font*) 3)))
     (with-placement (*fastswitch-mode-placement* x y width height)
       (setf *fastswitch-window* (xlib:create-window :parent *root*
diff --git a/src/config.lisp b/src/config.lisp
index 91c5ee7..72eeddd 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -357,7 +357,10 @@ on the root window in the main mode with the mouse")
   'Fastswitch-mode "Fastswitch string window border color")
 (defconfig *fastswitch-transparency* 0.9
   'Fastswitch-mode "Fastswitch string window background transparency")
-
+(defconfig *fastswitch-show-frame-p* t
+  'Fastswitch-mode "Fastswitch show frame in mini window")
+(defconfig *fastswitch-adjust-window-p* t
+  'Fastswitch-mode "Fastswitch adjust window to show all children names")
 
 
 

commit ba625cce9a80bb8c1b706ca117aff0ae0752a54c
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Tue Jul 30 19:05:38 2013 +0200

    Use different colors for windows and frames in fastswitch-mode. Limit drawing area when there is a lot of children.

diff --git a/src/clfswm-fastswitch-mode.lisp b/src/clfswm-fastswitch-mode.lisp
index 5894798..2acb5a3 100644
--- a/src/clfswm-fastswitch-mode.lisp
+++ b/src/clfswm-fastswitch-mode.lisp
@@ -45,7 +45,10 @@
   (labels ((display-match-child ()
              (let ((pos 1))
                (dolist (ex-child *fastswitch-match-child*)
-                 (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-letter-second*))
+                 (xlib:with-gcontext (*fastswitch-gc*
+                                      :foreground (get-color (if (frame-p (expose-child-child ex-child))
+                                                                 *fastswitch-foreground-letter-second-frame*
+                                                                 *fastswitch-foreground-letter-second*)))
                    (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
                                      (* (xlib:max-char-width *fastswitch-font*) pos)
                                      (+ (* 2 (xlib:font-ascent *fastswitch-font*)) (xlib:font-descent *fastswitch-font*) 1)
@@ -61,7 +64,9 @@
                                      (* (xlib:max-char-width *fastswitch-font*) pos)
                                      (+ (* 2 (xlib:font-ascent *fastswitch-font*)) (xlib:font-descent *fastswitch-font*) 1)
                                      (child-fullname (expose-child-child ex-child)))
-                   (incf pos (1+ (length (child-fullname (expose-child-child ex-child))))))))))
+                   (incf pos (1+ (length (child-fullname (expose-child-child ex-child))))))
+                 (when (> (* pos (xlib:max-char-width *fastswitch-font*)) (xlib:drawable-width *fastswitch-window*))
+                   (return))))))
     (clear-pixmap-buffer *fastswitch-window* *fastswitch-gc*)
     (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-letter*)
                                          :background (get-color *fastswitch-background*))
diff --git a/src/config.lisp b/src/config.lisp
index 09f4dad..91c5ee7 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -349,6 +349,8 @@ on the root window in the main mode with the mouse")
   'Fastswitch-mode "Fastswitch string window foreground color for letters")
 (defconfig *fastswitch-foreground-letter-second* "magenta"
   'Fastswitch-mode "Fastswitch string window foreground color for letters")
+(defconfig *fastswitch-foreground-letter-second-frame* "yellow"
+  'Fastswitch-mode "Fastswitch string window foreground color for letters for frames")
 (defconfig *fastswitch-foreground-childname* "grey70"
   'Fastswitch-mode "Fastswitch string window foreground color for childname")
 (defconfig *fastswitch-border* "grey20"

commit 223b8f75a512cf7705d2d69c3a4a9f0168278aae
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date:   Tue Jul 30 18:50:01 2013 +0200

    Use a global counter for expose letters instead of a sort based on window Xid.

diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index 6d8a765..8f1a1bd 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -44,7 +44,8 @@
 	 (len (length text)))
     (xlib:draw-glyphs *pixmap-buffer* *circulate-gc*
 		      (truncate (/ (- *circulate-width* (* (xlib:max-char-width *circulate-font*) len)) 2))
-		      (truncate (/ (+ *circulate-height* (- (xlib:font-ascent *circulate-font*) (xlib:font-descent *circulate-font*))) 2))
+		      (truncate (/ (+ *circulate-height* (- (xlib:font-ascent *circulate-font*)
+                                                            (xlib:font-descent *circulate-font*))) 2))
 		      text))
   (copy-pixmap-buffer *circulate-window* *circulate-gc*))
 
diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp
index fbbb7d0..f4354ba 100644
--- a/src/clfswm-expose-mode.lisp
+++ b/src/clfswm-expose-mode.lisp
@@ -26,7 +26,6 @@
 (in-package :clfswm)
 
 (defparameter *expose-font* nil)
-(defparameter *expose-child-list* nil)
 (defparameter *expose-selected-child* nil)
 
 (defstruct expose-child child key window gc string)
@@ -50,25 +49,18 @@
   (throw 'exit-expose-loop t))
 
 
-
-
-(defun expose-sort (predicate type)
-  (lambda (x y)
-    (funcall predicate (funcall type x) (funcall type y))))
-
 (defun expose-associate-keys ()
-  (let* ((acc nil)
-         (n 0)
-         (win-list (sort (get-all-windows) (expose-sort #'< #'xlib:window-id)))
-         (frame-list (sort (get-all-frames) (expose-sort #'< #'frame-number))))
-    (loop for c in win-list
-       do (push (make-expose-child :child c :key (number->letter n)) acc)
-         (incf n))
-    (loop for c in frame-list
-       do (unless (child-equal-p c *root-frame*)
-            (push (make-expose-child :child c :key (number->letter n)) acc)
-            (incf n)))
-    (nreverse acc)))
+  (let* ((all nil)
+         (new nil))
+    (with-all-children-reversed (*root-frame* child)
+      (unless (child-equal-p child *root-frame*)
+        (push child all)
+        (unless (member child *expose-child-list* :test #'child-equal-p :key #'expose-child-child)
+          (push (make-expose-child :child child :key (number->letter *expose-current-number*)) new)
+          (incf *expose-current-number*))))
+    (append (remove-if-not (lambda (x) (member x all :test #'child-equal-p)) *expose-child-list*
+                           :key #'expose-child-child)
+            (nreverse new))))
 
 
 
@@ -206,8 +198,7 @@
       (xlib:destroy-window it)))
   (when *expose-font*
     (xlib:close-font *expose-font*))
-  (expose-unpresent-windows)
-  (setf *expose-child-list* nil))
+  (expose-unpresent-windows))
 
 (defun expose-focus-child (child)
   (let ((parent (typecase child
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index cbecb5e..090decd 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -203,7 +203,9 @@
 					    :depth (xlib:screen-root-depth *screen*)
 					    :drawable *root*)
 	*in-second-mode* nil
-        *x-error-count* 0)
+        *x-error-count* 0
+        *expose-current-number* 0
+        *expose-child-list* nil)
   (store-root-background)
   (init-modifier-list)
   (xgrab-init-pointer)
diff --git a/src/package.lisp b/src/package.lisp
index f45bcc1..5149953 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -81,6 +81,9 @@ It is particulary useful with CLISP/MIT-CLX.")
 (defparameter *background-image* nil)
 (defparameter *background-gc* nil)
 
+(defparameter *expose-current-number* 0)
+(defparameter *expose-child-list* nil)
+
 (defconfig *loop-timeout* 1 nil
            "Maximum time (in seconds) to wait before calling *loop-hook*")
 

-----------------------------------------------------------------------

Summary of changes:
 src/bindings.lisp               |    2 +-
 src/clfswm-circulate-mode.lisp  |    3 +-
 src/clfswm-corner.lisp          |    8 +--
 src/clfswm-expose-mode.lisp     |   37 ++++++--------
 src/clfswm-fastswitch-mode.lisp |  105 +++++++++++++++++++++++++++++++--------
 src/clfswm-info.lisp            |    6 +--
 src/clfswm-internal.lisp        |   18 +++----
 src/clfswm-placement.lisp       |    4 +-
 src/clfswm-query.lisp           |    4 +-
 src/clfswm-util.lisp            |    8 +--
 src/clfswm.lisp                 |   12 +++--
 src/config.lisp                 |    7 ++-
 src/netwm-util.lisp             |    4 +-
 src/package.lisp                |    3 ++
 src/xlib-util.lisp              |    8 +++
 15 files changed, 150 insertions(+), 79 deletions(-)


hooks/post-receive
-- 
CLFSWM - A(nother) Common Lisp FullScreen Window Manager



More information about the clfswm-cvs mailing list