[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1106-22-g5821973
Philippe Brochard
pbrochard at common-lisp.net
Sat Feb 25 20:30:24 UTC 2012
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 58219730464bd626c1aacc93c925d51a5905e8b9 (commit)
from 2fc480c62e57ae1f6fd1e47bc7448d88f93dbe07 (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 58219730464bd626c1aacc93c925d51a5905e8b9
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Sat Feb 25 21:30:17 2012 +0100
src/clfswm-util.lisp (place-frames-from-xrandr, swap-frame-geometry, rotate-frame-geometry): New helper functions for multiple physical screen.
diff --git a/ChangeLog b/ChangeLog
index 8d10c79..4002d68 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2012-02-25 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-util.lisp (place-frames-from-xrandr)
+ (swap-frame-geometry, rotate-frame-geometry): New helper functions
+ for multiple physical screen.
+
2012-01-18 Philippe Brochard <pbrochard at common-lisp.net>
* src/*.lisp: Use create-symbol and create-symbol-in-package
diff --git a/src/bindings-second-mode.lisp b/src/bindings-second-mode.lisp
index dd3eef9..cdeea62 100644
--- a/src/bindings-second-mode.lisp
+++ b/src/bindings-second-mode.lisp
@@ -118,6 +118,9 @@
(define-second-key ("Right" :control :mod-1) 'select-brother-spatial-move-right)
(define-second-key ("Up" :control :mod-1) 'select-brother-spatial-move-up)
(define-second-key ("Down" :control :mod-1) 'select-brother-spatial-move-down)
+ (define-second-key ("j") 'swap-frame-geometry)
+ (define-second-key ("h") 'rotate-frame-geometry)
+ (define-second-key ("h" :shift) 'anti-rotate-frame-geometry)
(define-second-key ("Right") 'speed-mouse-right)
(define-second-key ("Left") 'speed-mouse-left)
@@ -133,6 +136,7 @@
(define-second-key ("Tab") 'switch-to-last-child)
(define-second-key ("Return" :mod-1) 'enter-frame)
(define-second-key ("Return" :mod-1 :shift) 'leave-frame)
+ (define-second-key ("Return" :mod-1 :control) 'frame-toggle-maximize)
(define-second-key ("Return" :mod-5) 'frame-toggle-maximize)
(define-second-key ("Page_Up" :mod-1) 'frame-lower-child)
(define-second-key ("Page_Down" :mod-1) 'frame-raise-child)
@@ -163,7 +167,6 @@
(define-shell ("e" :control) b-start-emacsremote
"start an emacs for another user"
"exec xterm -e emacsremote")
- (define-shell ("h") b-start-xclock "start an xclock" "exec xclock -d")
(define-second-key ("F10" :mod-1) 'fast-layout-switch)
(define-second-key ("F10" :shift :control) 'toggle-show-root-frame)
(define-second-key ("F10") 'expose-windows-current-child-mode)
diff --git a/src/bindings.lisp b/src/bindings.lisp
index 142d9f2..2777983 100644
--- a/src/bindings.lisp
+++ b/src/bindings.lisp
@@ -56,6 +56,7 @@
(define-main-key ("Tab" :mod-1 :control) 'select-next-subchild)
(define-main-key ("Return" :mod-1) 'enter-frame)
(define-main-key ("Return" :mod-1 :shift) 'leave-frame)
+ (define-main-key ("Return" :mod-1 :control) 'frame-toggle-maximize)
(define-main-key ("Return" :mod-5) 'frame-toggle-maximize)
(define-main-key ("Page_Up" :mod-1) 'frame-select-previous-child)
(define-main-key ("Page_Down" :mod-1) 'frame-select-next-child)
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 029e445..85d5ca8 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -1654,3 +1654,76 @@ For window: set current child to window or its parent according to window-parent
(with-current-window
(decf (child-transparency window) 0.1)))
+;;; Multiple physical screen helper
+
+(defun get-xrandr-connected-size ()
+ (let ((output (do-shell "xrandr"))
+ (sizes '()))
+ (loop for line = (read-line output nil nil)
+ while line
+ do
+ (awhen (search " connected " line)
+ (incf it (length " connected "))
+ (push (mapcar #'parse-integer
+ (split-string (substitute #\space #\x
+ (substitute #\space #\+
+ (subseq line it (position #\space line :start it))))))
+ sizes)))
+ sizes))
+
+
+(defun place-frames-from-xrandr ()
+ "Place frames according to xrandr informations"
+ (let ((sizes (get-xrandr-connected-size))
+ (width (xlib:screen-width *screen*))
+ (height (xlib:screen-height *screen*)))
+ (loop while (< (length (frame-child *root-frame*)) (length sizes))
+ do (add-frame (create-frame) *root-frame*))
+ (loop for size in sizes
+ for frame in (frame-child *root-frame*)
+ do (setf (frame-w frame) (float (/ (first size) width))
+ (frame-h frame) (float (/ (second size) height))
+ (frame-x frame) (float (/ (third size) width))
+ (frame-y frame) (float (/ (fourth size) height))))))
+
+
+
+
+(defun swap-frame-geometry ()
+ "Swap current brother frame geometry"
+ (when (frame-p *current-child*)
+ (let ((parent (find-parent-frame *current-child*)))
+ (when (frame-p parent)
+ (let ((brother (second (frame-child parent))))
+ (when (frame-p brother)
+ (rotatef (frame-x *current-child*) (frame-x brother))
+ (rotatef (frame-y *current-child*) (frame-y brother))
+ (rotatef (frame-w *current-child*) (frame-w brother))
+ (rotatef (frame-h *current-child*) (frame-h brother))
+ (show-all-children t)
+ (leave-second-mode)))))))
+
+(defun rotate-frame-geometry-generic (fun)
+ "(Rotate brother frame geometry"
+ (when (frame-p *current-child*)
+ (let ((parent (find-parent-frame *current-child*)))
+ (when (frame-p parent)
+ (let* ((child-list (funcall fun (frame-child parent)))
+ (first (first child-list)))
+ (dolist (child (rest child-list))
+ (when (and (frame-p first) (frame-p child))
+ (rotatef (frame-x first) (frame-x child))
+ (rotatef (frame-y first) (frame-y child))
+ (rotatef (frame-w first) (frame-w child))
+ (rotatef (frame-h first) (frame-h child))
+ (setf first child)))
+ (show-all-children t))))))
+
+
+(defun rotate-frame-geometry ()
+ "Rotate brother frame geometry"
+ (rotate-frame-geometry-generic #'identity))
+
+(defun anti-rotate-frame-geometry ()
+ "Anti rotate brother frame geometry"
+ (rotate-frame-geometry-generic #'reverse))
diff --git a/src/config.lisp b/src/config.lisp
index d142b52..163becf 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -164,7 +164,7 @@ This command must set the window title to *clfswm-terminal-name*")
;;;
;;; See clfswm.lisp for hooks examples.
-(defconfig *init-hook* '(default-init-hook display-hello-window)
+(defconfig *init-hook* '(default-init-hook place-frames-from-xrandr display-hello-window)
'Hook "Init hook. This hook is run just after the first root frame is created")
(defconfig *close-hook* '(close-notify-window close-clfswm-terminal close-virtual-keyboard)
diff --git a/src/package.lisp b/src/package.lisp
index 2291007..068c09b 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -220,24 +220,24 @@ loading configuration file and before opening the display.")
;;; middle-left middle-middle middle-right
;;; bottom-left bottom-middle bottom-right
;;;
-(defconfig *banish-pointer-placement* 'bottom-right-placement
+(defconfig *banish-pointer-placement* 'bottom-right-child-placement
'Placement "Pointer banishment placement")
-(defconfig *second-mode-placement* 'top-middle-placement
+(defconfig *second-mode-placement* 'top-middle-child-placement
'Placement "Second mode window placement")
-(defconfig *info-mode-placement* 'top-left-placement
+(defconfig *info-mode-placement* 'top-left-child-placement
'Placement "Info mode window placement")
-(defconfig *query-mode-placement* 'top-left-placement
+(defconfig *query-mode-placement* 'top-left-child-placement
'Placement "Query mode window placement")
-(defconfig *circulate-mode-placement* 'bottom-middle-placement
+(defconfig *circulate-mode-placement* 'bottom-middle-child-placement
'Placement "Circulate mode window placement")
(defconfig *expose-mode-placement* 'top-left-child-placement
'Placement "Expose mode window placement (Selection keys position)")
-(defconfig *notify-window-placement* 'bottom-right-placement
+(defconfig *notify-window-placement* 'bottom-right-child-placement
'Placement "Notify window placement")
-(defconfig *ask-close/kill-placement* 'top-right-placement
+(defconfig *ask-close/kill-placement* 'top-right-child-placement
'Placement "Ask close/kill window placement")
(defconfig *unmanaged-window-placement* 'middle-middle-child-placement
- 'PLACEMENT "Unmanager window placement")
+ 'Placement "Unmanager window placement")
(defparameter *in-process-existing-windows* nil)
-----------------------------------------------------------------------
Summary of changes:
ChangeLog | 6 +++
src/bindings-second-mode.lisp | 5 ++-
src/bindings.lisp | 1 +
src/clfswm-util.lisp | 73 +++++++++++++++++++++++++++++++++++++++++
src/config.lisp | 2 +-
src/package.lisp | 16 ++++----
6 files changed, 93 insertions(+), 10 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list