[clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1212-46-g76d69f1
Philippe Brochard
pbrochard at common-lisp.net
Sat Aug 17 21:03:59 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 76d69f19dc7489700606a8d7ee3397fe0be8f592 (commit)
via 7da85e9e5a4bc8212c5501a473907be37ddc1053 (commit)
via 8b91a7fc55ed5dd89b713562b8471590805e0f4e (commit)
via 87dedbf167dec01265e2a3ad57213447713c2b3c (commit)
from 8bf8472697116ad5649be7b7889cd28d28d1c550 (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 76d69f19dc7489700606a8d7ee3397fe0be8f592
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Sat Aug 17 23:04:16 2013 +0200
Remove an unneeded no-focus.
diff --git a/src/clfswm-corner.lisp b/src/clfswm-corner.lisp
index 5669c49..1f9904f 100644
--- a/src/clfswm-corner.lisp
+++ b/src/clfswm-corner.lisp
@@ -91,7 +91,6 @@ stop the button event"
(defun generic-present-body (cmd wait-test win &optional focus-p)
(stop-button-event)
- (no-focus)
(unless (find-window-in-query-tree win)
(do-shell cmd)
(setf win (wait-window-in-query-tree wait-test))
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 183bfa9..19af51c 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -1747,60 +1747,81 @@ managed."
(rec c (+ space 2))))))
(rec root 0)))
-
-(defun window-list->xid-list (list)
- (loop for win in list
- collect (xlib:window-id win)))
-
-
-(defun copy-frame (frame)
- (with-slots (name number x y w h layout nw-hook managed-type
- forced-managed-window forced-unmanaged-window
- show-window-p hidden-children selected-pos
- focus-policy data)
- frame
- (make-instance 'frame :name name :number number
- :x x :y y :w w :h h
- :layout layout :nw-hook nw-hook
- :managed-type (if (consp managed-type)
- (copy-list managed-type)
- managed-type)
- :forced-managed-window (window-list->xid-list forced-managed-window)
- :forced-unmanaged-window (window-list->xid-list forced-unmanaged-window)
- :show-window-p show-window-p
- :hidden-children (window-list->xid-list hidden-children)
- :selected-pos selected-pos
- :focus-policy focus-policy
- :data (copy-tree data))))
-
-(defun dump-frame-tree ()
- "Return a tree list of frame dimensions and name"
- (let ((root (make-instance 'frame :name "root")))
+(defmethod print-object ((frame frame) stream)
+ (format stream "~A - ~F ~F ~F ~F ~A ~A ~A ~X ~X ~A ~A ~A ~A"
+ (child-fullname frame)
+ (frame-x frame) (frame-y frame) (frame-w frame) (frame-h frame)
+ (frame-layout frame) (frame-nw-hook frame)
+ (frame-managed-type frame)
+ (frame-forced-managed-window frame)
+ (frame-forced-unmanaged-window frame)
+ (frame-show-window-p frame)
+ (frame-hidden-children frame)
+ (frame-selected-pos frame)
+ (frame-focus-policy frame)
+ ;;(frame-data frame))
+ ))
+
+
+(defun window->xid (window)
+ (when (xlib:window-p window)
+ (xlib:window-id window)))
+
+(defun xid->window (xid)
+ (dolist (win (xlib:query-tree *root*))
+ (when (equal xid (xlib:window-id win))
+ (return-from xid->window win))))
+
+
+
+(defun copy-frame (frame &optional (window-fun #'window->xid))
+ (labels ((handle-window-list (list)
+ (loop for win in list
+ collect (funcall window-fun win))))
+ (with-slots (name number x y w h layout nw-hook managed-type
+ forced-managed-window forced-unmanaged-window
+ show-window-p hidden-children selected-pos
+ focus-policy data)
+ frame
+ (make-instance 'frame :name name :number number
+ :x x :y y :w w :h h
+ :layout layout :nw-hook nw-hook
+ :managed-type (if (consp managed-type)
+ (copy-list managed-type)
+ managed-type)
+ :forced-managed-window (handle-window-list forced-managed-window)
+ :forced-unmanaged-window (handle-window-list forced-unmanaged-window)
+ :show-window-p show-window-p
+ :hidden-children (handle-window-list hidden-children)
+ :selected-pos selected-pos
+ :focus-policy focus-policy
+ :data (copy-tree data)))))
+
+(defun dump-frame-tree (root &optional (window-fun #'window->xid))
+ "Return a tree of frames."
+ (let ((new-root (copy-frame root window-fun)))
(labels ((store (from root)
(when (frame-p from)
- (dolist (c (frame-child from))
+ (dolist (c (reverse (frame-child from)))
(push (if (frame-p c)
- (let ((new-root (copy-frame c)))
+ (let ((new-root (copy-frame c window-fun)))
(store c new-root)
new-root)
- (format nil "~A (#x~X)" (child-fullname c) (xlib:window-id c)))
+ (funcall window-fun c))
(frame-child root))))))
- (store *root-frame* root)
- (print-frame-tree root #'(lambda (x)
- (if (frame-p x)
- (format nil "~A - ~F ~F ~F ~F ~A ~A ~A ~X ~X ~A ~A ~A ~A ~A"
- (child-fullname x)
- (frame-x x) (frame-y x) (frame-w x) (frame-h x)
- (frame-layout x) (frame-nw-hook x)
- (frame-managed-type x)
- (frame-forced-managed-window x)
- (frame-forced-unmanaged-window x)
- (frame-show-window-p x)
- (frame-hidden-children x)
- (frame-selected-pos x)
- (frame-focus-policy x)
- (frame-data x))
- x))))))
+ (store root new-root)
+ new-root)))
+
+(defun test-dump-frame-tree ()
+ (let ((store (dump-frame-tree *root-frame*)))
+ (print-frame-tree store
+ #'(lambda (x)
+ (format nil "~A" x)))
+ (format t "~&--------------------------------------------------~2%")
+ (print-frame-tree (dump-frame-tree store #'xid->window)
+ #'(lambda (x)
+ (format nil "~A" (if (frame-p x) x (child-fullname x)))))))
+
commit 7da85e9e5a4bc8212c5501a473907be37ddc1053
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Sun Aug 11 23:19:48 2013 +0200
Use a more general method to not activate child under clfswm terminal (or xvkbd virtual keyboard)
diff --git a/src/clfswm-corner.lisp b/src/clfswm-corner.lisp
index 1f9904f..5669c49 100644
--- a/src/clfswm-corner.lisp
+++ b/src/clfswm-corner.lisp
@@ -91,6 +91,7 @@ stop the button event"
(defun generic-present-body (cmd wait-test win &optional focus-p)
(stop-button-event)
+ (no-focus)
(unless (find-window-in-query-tree win)
(do-shell cmd)
(setf win (wait-window-in-query-tree wait-test))
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 43ce372..183bfa9 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -230,6 +230,11 @@
(return (values t (second type)))))))
+(defun never-managed-window-and-handled-p (window)
+ (multiple-value-bind (never-managed handle)
+ (never-managed-window-p window)
+ (and never-managed handle)))
+
(defgeneric child-name (child))
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index b9d59a2..2acb2d3 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -786,10 +786,10 @@ mouse-fun is #'move-frame or #'resize-frame"
(when (and root-p *create-frame-on-root*)
(add-new-frame))
(when (and (frame-p child) (not (child-root-p child))
- (not (equal-clfswm-terminal window)))
+ (not (never-managed-window-and-handled-p window)))
(funcall mouse-fn child parent root-x root-y))
(when (and child parent
- (not (equal-clfswm-terminal window))
+ (not (never-managed-window-and-handled-p window))
(focus-all-children child parent (not (child-root-p child))))
(when (show-all-children)
(setf to-replay nil)))
commit 8b91a7fc55ed5dd89b713562b8471590805e0f4e
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Sun Aug 11 23:02:25 2013 +0200
Add a tree view (default) for fastswitch mode
diff --git a/src/clfswm-fastswitch-mode.lisp b/src/clfswm-fastswitch-mode.lisp
index f2aa376..310cb89 100644
--- a/src/clfswm-fastswitch-mode.lisp
+++ b/src/clfswm-fastswitch-mode.lisp
@@ -40,6 +40,30 @@
(throw 'exit-fastswitch-loop nil))
+(defun fastswitch-draw-child-name (posx posy ex-child)
+ (let ((placey (* posy (+ (xlib:font-ascent *fastswitch-font*)
+ (xlib:font-descent *fastswitch-font*) 1))))
+ (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)
+ placey
+ (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*) posx)
+ placey
+ ":")
+ (incf posx 1)
+ (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)
+ placey
+ (child-fullname (expose-child-child ex-child)))
+ (incf posx (1+ (length (child-fullname (expose-child-child ex-child))))))
+ posx))
(defun fastswitch-draw-window ()
(labels ((display-match-child ()
@@ -47,29 +71,7 @@
(posy 2))
(dolist (ex-child *fastswitch-match-child*)
(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*) 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))))))
+ (setf posx (fastswitch-draw-child-name posx posy ex-child))
(when (> (* posx (xlib:max-char-width *fastswitch-font*))
(x-drawable-width *fastswitch-window*))
(if *fastswitch-adjust-window-p*
@@ -78,7 +80,8 @@
(return)))))))
(adjust-window ()
(setf (x-drawable-height *fastswitch-window*) (* (xlib:font-ascent *fastswitch-font*) 3))
- (let ((posx 1))
+ (let ((posx 1)
+ (inc 0))
(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)))
@@ -87,7 +90,9 @@
(when (> (* posx (xlib:max-char-width *fastswitch-font*))
(x-drawable-width *fastswitch-window*))
(setf posx 1)
- (incf (x-drawable-height *fastswitch-window*) (xlib:font-ascent *fastswitch-font*))))))))
+ (incf inc (+ (xlib:font-ascent *fastswitch-font*)
+ (xlib:font-descent *fastswitch-font*) 1)))))
+ (incf (x-drawable-height *fastswitch-window*) inc))))
(when *fastswitch-adjust-window-p*
(adjust-window))
(clear-pixmap-buffer *fastswitch-window* *fastswitch-gc*)
@@ -108,6 +113,45 @@
(display-match-child)
(copy-pixmap-buffer *fastswitch-window* *fastswitch-gc*)))
+(defun fastswitch-draw-window-tree ()
+ (let ((posy 2))
+ (labels ((display-match-child (child space)
+ (let ((ex-child (find child *expose-child-list* :test #'child-equal-p :key #'expose-child-child)))
+ (when ex-child
+ (fastswitch-draw-child-name space posy ex-child)
+ (incf posy)))
+ (when (frame-p child)
+ (dolist (c (frame-child child))
+ (display-match-child c (+ space 2))))))
+ (setf (x-drawable-height *fastswitch-window*)
+ (+ (* (xlib:font-ascent *fastswitch-font*) 3)
+ (* (1- (length *expose-child-list*))
+ (+ (xlib:font-ascent *fastswitch-font*)
+ (xlib:font-descent *fastswitch-font*) 1))))
+ (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*)
+ (if *fastswitch-msg*
+ (1+ (length *fastswitch-msg*))
+ 1))
+ (+ (xlib:font-ascent *fastswitch-font*) (xlib:font-descent *fastswitch-font*))
+ *fastswitch-string*))
+ (display-match-child *root-frame* 0)
+ (copy-pixmap-buffer *fastswitch-window* *fastswitch-gc*))))
+
+
+(defun fastswitch-draw-window-generic ()
+ (if (eq *fastswitch-display-mode* 'TREE)
+ (fastswitch-draw-window-tree)
+ (fastswitch-draw-window)))
+
(defun fastswitch-init ()
@@ -132,7 +176,7 @@
:line-style :solid))
(setf (window-transparency *fastswitch-window*) *fastswitch-transparency*)
(map-window *fastswitch-window*)))
- (fastswitch-draw-window))
+ (fastswitch-draw-window-generic))
(defun fastswitch-enter-function ()
@@ -165,7 +209,7 @@
(unless *fastswitch-match-child*
(setf *fastswitch-string* ""
*fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key)))
- (fastswitch-draw-window))))
+ (fastswitch-draw-window-generic))))
(defun fastswitch-select-child ()
diff --git a/src/clfswm-layout.lisp b/src/clfswm-layout.lisp
index 0e646c7..ba00eec 100644
--- a/src/clfswm-layout.lisp
+++ b/src/clfswm-layout.lisp
@@ -847,7 +847,7 @@ Or do actions on corners - Skip windows in main window list"
(if (and (frame-p (current-child))
(child-member window (frame-data-slot (current-child) :main-window-list)))
(replay-button-event)
- (mouse-click-to-focus-generic root-x root-y #'move-frame))))
+ (mouse-click-to-focus-generic window root-x root-y #'move-frame))))
diff --git a/src/config.lisp b/src/config.lisp
index 72eeddd..f025589 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -361,6 +361,8 @@ on the root window in the main mode with the mouse")
'Fastswitch-mode "Fastswitch show frame in mini window")
(defconfig *fastswitch-adjust-window-p* t
'Fastswitch-mode "Fastswitch adjust window to show all children names")
+(defconfig *fastswitch-display-mode* 'Tree
+ 'Fastswitch-mode "Fastswitch display mode (one of LINE or TREE)")
commit 87dedbf167dec01265e2a3ad57213447713c2b3c
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Sat Aug 10 23:12:20 2013 +0200
Do not activate/handle child under the clfswm terminal when it is present
diff --git a/contrib/moc.lisp b/contrib/moc.lisp
index 3a66bde..9e604e1 100644
--- a/contrib/moc.lisp
+++ b/contrib/moc.lisp
@@ -40,7 +40,7 @@
(defun start-mocp ()
"Start mocp"
- (do-shell "exec xterm -e 'mocp 2> /dev/null'"))
+ (do-shell "xterm -e 'mocp 2> /dev/null'"))
(defun show-moc-info ()
diff --git a/src/clfswm-corner.lisp b/src/clfswm-corner.lisp
index 9c1597c..1f9904f 100644
--- a/src/clfswm-corner.lisp
+++ b/src/clfswm-corner.lisp
@@ -130,7 +130,7 @@ stop the button event"
(let (win)
(defun equal-clfswm-terminal (window)
- (when win
+ (when (and win (xlib:window-p window))
(xlib:window-equal window win)))
(defun close-clfswm-terminal ()
(when win
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 2d24a98..b9d59a2 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -767,7 +767,7 @@ Write (defparameter *contrib-dir* \"/usr/local/lib/clfswm/\") in ~A.~%"
-(defun mouse-click-to-focus-generic (root-x root-y mouse-fn)
+(defun mouse-click-to-focus-generic (window root-x root-y mouse-fn)
"Focus the current frame or focus the current window parent
mouse-fun is #'move-frame or #'resize-frame"
(let* ((to-replay t)
@@ -785,9 +785,11 @@ mouse-fun is #'move-frame or #'resize-frame"
(pushnew child (frame-child parent)))))
(when (and root-p *create-frame-on-root*)
(add-new-frame))
- (when (and (frame-p child) (not (child-root-p child)))
+ (when (and (frame-p child) (not (child-root-p child))
+ (not (equal-clfswm-terminal window)))
(funcall mouse-fn child parent root-x root-y))
(when (and child parent
+ (not (equal-clfswm-terminal window))
(focus-all-children child parent (not (child-root-p child))))
(when (show-all-children)
(setf to-replay nil)))
@@ -799,16 +801,15 @@ mouse-fun is #'move-frame or #'resize-frame"
(defun mouse-click-to-focus-and-move (window root-x root-y)
"Move and focus the current frame or focus the current window parent.
Or do actions on corners"
- (declare (ignore window))
(or (do-corner-action root-x root-y *corner-main-mode-left-button*)
- (mouse-click-to-focus-generic root-x root-y #'move-frame)))
+ (mouse-click-to-focus-generic window root-x root-y #'move-frame)))
(defun mouse-click-to-focus-and-resize (window root-x root-y)
"Resize and focus the current frame or focus the current window parent.
Or do actions on corners"
- (declare (ignore window))
+ ;;(declare (ignore window))
(or (do-corner-action root-x root-y *corner-main-mode-right-button*)
- (mouse-click-to-focus-generic root-x root-y #'resize-frame)))
+ (mouse-click-to-focus-generic window root-x root-y #'resize-frame)))
(defun mouse-middle-click (window root-x root-y)
"Do actions on corners"
-----------------------------------------------------------------------
Summary of changes:
contrib/moc.lisp | 2 +-
src/clfswm-corner.lisp | 2 +-
src/clfswm-fastswitch-mode.lisp | 98 ++++++++++++++++++++++---------
src/clfswm-internal.lisp | 122 ++++++++++++++++++++++++---------------
src/clfswm-layout.lisp | 2 +-
src/clfswm-util.lisp | 13 +++--
src/config.lisp | 2 +
7 files changed, 157 insertions(+), 84 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list