[clfswm-cvs] r154 - in clfswm: . src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Sat Aug 30 20:46:13 UTC 2008
Author: pbrochard
Date: Sat Aug 30 16:46:12 2008
New Revision: 154
Modified:
clfswm/ChangeLog
clfswm/TODO
clfswm/src/clfswm-layout.lisp
clfswm/src/clfswm-menu.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/clfswm.lisp
clfswm/src/config.lisp
clfswm/src/menu-def.lisp
clfswm/src/package.lisp
Log:
Different focus policy by frame. A possible GIMP layout
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Sat Aug 30 16:46:12 2008
@@ -1,3 +1,14 @@
+2008-08-30 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-layout.lisp (main-window-right-layout): A possible
+ GIMP layout: one or more main windows on one side of the
+ frame. Others on the other size.
+
+ * src/clfswm-util.lisp
+ (current-frame-set-click/sloppy-focus-policy): Each frame can have
+ a different focus policy (one of :click or :sloppy).
+ The default focus policy is set with *default-focus-policy*.
+
2008-08-23 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-info.lisp (show-config-variable): New function.
Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO (original)
+++ clfswm/TODO Sat Aug 30 16:46:12 2008
@@ -10,6 +10,8 @@
- Factorize layout
- A Gimp layout example (a main window and all others on the left) [Philippe]
+ + Alt-Tab cycle only on non-main windows
+ + Focus policy to sloppy focus.
- Hook to open next window in named/numbered frame [Philippe]
Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp (original)
+++ clfswm/src/clfswm-layout.lisp Sat Aug 30 16:46:12 2008
@@ -38,7 +38,7 @@
-(defparameter *layout-current-key* (char-code #\a))
+(defparameter *layout-current-key* (1- (char-code #\a)))
;;; Generic functions
@@ -73,9 +73,8 @@
(fixe-real-size-current-child)
(set-layout-dont-leave #'no-layout)))
(setf (documentation once-name 'function) (documentation layout 'function))
- (add-menu-key 'frame-layout-menu (code-char *layout-current-key*) layout)
- (add-menu-key 'frame-layout-once-menu (code-char *layout-current-key*) once-name)
- (incf *layout-current-key*)))
+ (add-menu-key 'frame-layout-menu (code-char (incf *layout-current-key*)) layout)
+ (add-menu-key 'frame-layout-once-menu (code-char *layout-current-key*) once-name)))
@@ -291,7 +290,7 @@
(defun set-tile-right-layout ()
- " Tile Right: main child on right and others on left"
+ " Tile Right: main child on right and others on left"
(layout-ask-size "Tile size in percent (%)" :tile-size)
(set-layout #'tile-right-layout))
@@ -324,7 +323,7 @@
(defun set-tile-top-layout ()
- " Tile Top: main child on top and others on bottom"
+ " Tile Top: main child on top and others on bottom"
(layout-ask-size "Tile size in percent (%)" :tile-size)
(set-layout #'tile-top-layout))
@@ -356,7 +355,7 @@
(defun set-tile-bottom-layout ()
- " Tile Bottom: main child on bottom and others on top"
+ " Tile Bottom: main child on bottom and others on top"
(layout-ask-size "Tile size in percent (%)" :tile-size)
(set-layout #'tile-bottom-layout))
@@ -410,3 +409,73 @@
(set-layout #'tile-left-space-layout))
(register-layout 'set-tile-left-space-layout)
+
+
+
+
+;;; Main windows layout - A possible GIMP layout
+;;; The windows in the main list are tiled on the frame
+;;; others windows are on one side of the frame.
+(defun main-window-right-layout (child parent)
+ "Main window right: Main windows on the right. Others on the left."
+ (with-slots (rx ry rw rh) parent
+ (let* ((main-windows (frame-data-slot parent :main-window-list))
+ (len (length main-windows))
+ (size (or (frame-data-slot parent :tile-size) 0.8)))
+ (if (zerop len)
+ (no-layout child parent)
+ (if (member child main-windows)
+ (let* ((dy (/ rh len))
+ (pos (position child main-windows)))
+ (values (1+ (round (+ rx (* rw (- 1 size)))))
+ (1+ (round (+ ry (* dy pos))))
+ (- (round (* rw size)) 2)
+ (- (round dy) 2)))
+ (values (1+ rx)
+ (1+ ry)
+ (- (round (* rw (- 1 size))) 2)
+ (- rh 2)))))))
+
+(defun set-main-window-right-layout ()
+ "Main window right: Main windows on the right. Others on the left."
+ (layout-ask-size "Split size in percent (%)" :tile-size)
+ (set-layout #'main-window-right-layout))
+
+
+(defun add-in-main-window-list ()
+ "Add the current window in the main window list"
+ (when (frame-p *current-child*)
+ (with-current-window
+ (when (member window (get-managed-child *current-child*))
+ (pushnew window (frame-data-slot *current-child* :main-window-list)))))
+ (leave-second-mode))
+
+
+(defun remove-in-main-window-list ()
+ "Remove the current window from the main window list"
+ (when (frame-p *current-child*)
+ (with-current-window
+ (when (member window (get-managed-child *current-child*))
+ (setf (frame-data-slot *current-child* :main-window-list)
+ (remove window (frame-data-slot *current-child* :main-window-list))))))
+ (leave-second-mode))
+
+(defun clear-main-window-list ()
+ "Clear the main window list"
+ (when (frame-p *current-child*)
+ (setf (frame-data-slot *current-child* :main-window-list) nil))
+ (leave-second-mode))
+
+
+(add-sub-menu 'frame-layout-menu (code-char (incf *layout-current-key*))
+ 'frame-main-window-layout-menu "Main window layout menu")
+
+
+(add-menu-key 'frame-main-window-layout-menu "r" 'set-main-window-right-layout)
+(add-menu-key 'frame-main-window-layout-menu "l" 'set-main-window-right-layout)
+(add-menu-key 'frame-main-window-layout-menu "t" 'set-main-window-right-layout)
+(add-menu-key 'frame-main-window-layout-menu "b" 'set-main-window-right-layout)
+(add-menu-comment 'frame-main-window-layout-menu "-=- Actions on main windows list -=-")
+(add-menu-key 'frame-main-window-layout-menu "a" 'add-in-main-window-list)
+(add-menu-key 'frame-main-window-layout-menu "v" 'remove-in-main-window-list)
+(add-menu-key 'frame-main-window-layout-menu "c" 'clear-main-window-list)
Modified: clfswm/src/clfswm-menu.lisp
==============================================================================
--- clfswm/src/clfswm-menu.lisp (original)
+++ clfswm/src/clfswm-menu.lisp Sat Aug 30 16:46:12 2008
@@ -94,6 +94,13 @@
+(defun add-menu-comment (menu-name &optional (comment "---"))
+ (add-item (make-menu-item :key nil :value comment) (find-menu menu-name)))
+
+
+
+
+
;;; Display menu functions
(defun open-menu (&optional (menu *menu*))
@@ -105,14 +112,16 @@
(push (typecase value
(menu (list (list (format nil "~A" (menu-item-key item)) *menu-color-menu-key*)
(list (format nil ": < ~A >" (menu-doc value)) *menu-color-submenu*)))
+ (string (list (list (format nil "~A" (menu-item-value item)) *menu-color-comment*)))
(t (list (list (format nil "~A" (menu-item-key item)) *menu-color-key*)
(format nil ": ~A" (documentation value 'function)))))
info-list)
- (define-info-key-fun (list (menu-item-key item) 0)
- (lambda (&optional args)
- (declare (ignore args))
- (setf action value)
- (throw 'exit-info-loop nil)))))
+ (when (menu-item-key item)
+ (define-info-key-fun (list (menu-item-key item) 0)
+ (lambda (&optional args)
+ (declare (ignore args))
+ (setf action value)
+ (throw 'exit-info-loop nil))))))
(info-mode (nreverse info-list))
(dolist (item (menu-item menu))
(undefine-info-key-fun (list (menu-item-key item) 0)))
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Sat Aug 30 16:46:12 2008
@@ -1066,3 +1066,15 @@
+;;; Focus policy functions
+(defun current-frame-set-click-focus-policy ()
+ "Set a click focus policy for the current frame"
+ (when (frame-p *current-child*)
+ (setf (frame-focus-policy *current-child*) :click))
+ (leave-second-mode))
+
+(defun current-frame-set-sloppy-focus-policy ()
+ "Set a sloppy focus policy for the current frame"
+ (when (frame-p *current-child*)
+ (setf (frame-focus-policy *current-child*) :sloppy))
+ (leave-second-mode))
Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Sat Aug 30 16:46:12 2008
@@ -119,8 +119,14 @@
-(defun handle-enter-notify (&rest event-slots &key root-x root-y &allow-other-keys)
- (declare (ignore event-slots root-x root-y)))
+(defun handle-enter-notify (&rest event-slots &key window root-x root-y &allow-other-keys)
+ (declare (ignore event-slots))
+ (when (eql :sloppy (if (frame-p *current-child*)
+ (frame-focus-policy *current-child*)
+ *default-focus-policy*))
+ (unless (and (> root-x (- (xlib:screen-width *screen*) 3))
+ (> root-y (- (xlib:screen-height *screen*) 3)))
+ (focus-window window))))
Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp (original)
+++ clfswm/src/config.lisp Sat Aug 30 16:46:12 2008
@@ -38,6 +38,8 @@
+
+
;;; CONFIG - Never managed window list
(defparameter *never-managed-window-list*
'((xlib:get-wm-class "ROX-Pinboard")
Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp (original)
+++ clfswm/src/menu-def.lisp Sat Aug 30 16:46:12 2008
@@ -76,10 +76,12 @@
(add-sub-menu 'frame-menu "o" 'frame-layout-once-menu "Frame layout menu (Only once)")
(add-sub-menu 'frame-menu "n" 'frame-nw-hook-menu "Frame new window hook menu")
(add-sub-menu 'frame-menu "m" 'frame-movement-menu "Frame movement menu")
-(add-sub-menu 'frame-menu "w" 'managed-window-menu "Managed window type menu")
+(add-sub-menu 'frame-menu "f" 'frame-focus-policy "Frame focus policy menu")
+(add-sub-menu 'frame-menu "w" 'frame-managed-window-menu "Managed window type menu")
(add-sub-menu 'frame-menu "s" 'frame-miscellaneous-menu "Frame miscallenous menu")
+
(add-menu-key 'frame-adding-menu "a" 'add-default-frame)
(add-menu-key 'frame-adding-menu "p" 'add-placed-frame)
@@ -112,10 +114,13 @@
(add-menu-key 'frame-resize-menu #\a 'current-frame-resize-all-dir-minimal)
-(add-menu-key 'managed-window-menu "m" 'current-frame-manage-window-type)
-(add-menu-key 'managed-window-menu "a" 'current-frame-manage-all-window-type)
-(add-menu-key 'managed-window-menu "n" 'current-frame-manage-only-normal-window-type)
-(add-menu-key 'managed-window-menu "u" 'current-frame-manage-no-window-type)
+(add-menu-key 'frame-focus-policy "c" 'current-frame-set-click-focus-policy)
+(add-menu-key 'frame-focus-policy "s" 'current-frame-set-sloppy-focus-policy)
+
+(add-menu-key 'frame-managed-window-menu "m" 'current-frame-manage-window-type)
+(add-menu-key 'frame-managed-window-menu "a" 'current-frame-manage-all-window-type)
+(add-menu-key 'frame-managed-window-menu "n" 'current-frame-manage-only-normal-window-type)
+(add-menu-key 'frame-managed-window-menu "u" 'current-frame-manage-no-window-type)
(add-menu-key 'frame-miscellaneous-menu "s" 'show-all-frames-info)
Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp (original)
+++ clfswm/src/package.lisp Sat Aug 30 16:46:12 2008
@@ -65,7 +65,8 @@
;;; CONFIG - Default frame datas
(defparameter *default-frame-data*
(list '(:tile-size 0.8) '(:tile-space-size 0.1)
- '(:fast-layout (tile-left-layout tile-layout)))
+ '(:fast-layout (tile-left-layout tile-layout))
+ '(:main-layout-windows nil))
"Config(): Default slots set in frame date")
@@ -79,6 +80,12 @@
;;(defparameter *default-managed-type* '(:all))
+;;; CONFIG - Default focus policy
+(defparameter *default-focus-policy* :click
+ "Config(): Default mouse focus policy. One of :click or :sloppy")
+
+
+
(defclass frame ()
((name :initarg :name :accessor frame-name :initform nil)
@@ -114,6 +121,8 @@
:documentation "A list of hidden children")
(selected-pos :initarg :selected-pos :accessor frame-selected-pos :initform 0
:documentation "The position in the child list of the selected child")
+ (focus-policy :initarg :focus-ploicy :accessor frame-focus-policy
+ :initform *default-focus-policy*)
(window :initarg :window :accessor frame-window :initform nil)
(gc :initarg :gc :accessor frame-gc :initform nil)
(child :initarg :child :accessor frame-child :initform nil)
More information about the clfswm-cvs
mailing list