[clfswm-cvs] CVS clfswm
pbrochard
pbrochard at common-lisp.net
Fri Feb 29 23:05:57 UTC 2008
Update of /project/clfswm/cvsroot/clfswm
In directory clnet:/tmp/cvs-serv23352
Modified Files:
bindings-second-mode.lisp clfswm-internal.lisp
clfswm-util.lisp clfswm.lisp xlib-util.lisp
Log Message:
rename focus-all-child to focus-all-childs
--- /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp 2008/02/28 20:36:26 1.15
+++ /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp 2008/02/29 23:05:56 1.16
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Feb 28 21:30:15 2008
+;;; #Date#: Thu Feb 28 21:38:00 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Bindings keys and mouse for second mode
@@ -41,12 +41,12 @@
;; Menu entry
;;;;;;;;;;;;;;;
(defun group-adding-menu ()
- "Open the adding group menu"
+ "Adding group menu"
(info-mode-menu '((#\a add-default-group)
(#\p add-placed-group))))
(defun group-layout-menu ()
- "Open the group layout menu"
+ "Group layout menu"
(info-mode-menu (loop for l in *layout-list*
for i from 0
collect (list (code-char (+ (char-code #\a) i)) l))))
@@ -56,13 +56,13 @@
(defun group-pack-menu ()
- "Open the group pack menu"
+ "Group pack menu"
(info-mode-menu '(("Up" group-pack-up)
("Down" group-pack-down))))
(defun group-movement-menu ()
- "Open the movement menu"
+ "Group movement menu"
(info-mode-menu '((#\p group-pack-menu)
(#\f group-fill-menu)
(#\r group-resize-menu))))
@@ -128,7 +128,7 @@
(defun main-menu ()
"Open the main menu"
(info-mode-menu '((#\g group-menu)
- (#\w window-menu)
+ ;;(#\w window-menu)
(#\s selection-menu)
(#\n action-by-name-menu)
(#\u action-by-number-menu)
--- /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp 2008/02/28 20:36:26 1.17
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp 2008/02/29 23:05:56 1.18
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Feb 28 21:18:23 2008
+;;; #Date#: Sat Mar 1 00:03:14 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -227,10 +227,10 @@
(defun get-hidden-windows ()
"Return all hiddens windows"
- (let ((all-windows (get-all-windows))
- (hidden-windows (remove-if-not #'window-hidden-p
- (copy-list (xlib:query-tree *root*)))))
- (set-difference hidden-windows all-windows)))
+ (let ((all-windows (get-all-windows))
+ (hidden-windows (remove-if-not #'window-hidden-p
+ (copy-list (xlib:query-tree *root*)))))
+ (set-difference hidden-windows all-windows)))
@@ -286,25 +286,25 @@
(defmethod adapt-child-to-father ((window xlib:window) father)
(with-xlib-protect
- (multiple-value-bind (nx ny nw nh raise-p)
- (get-father-layout window father)
- (setf (xlib:drawable-x window) nx
- (xlib:drawable-y window) ny
- (xlib:drawable-width window) nw
- (xlib:drawable-height window) nh)
- raise-p)))
+ (multiple-value-bind (nx ny nw nh raise-p)
+ (get-father-layout window father)
+ (setf (xlib:drawable-x window) nx
+ (xlib:drawable-y window) ny
+ (xlib:drawable-width window) nw
+ (xlib:drawable-height window) nh)
+ raise-p)))
(defmethod adapt-child-to-father ((group group) father)
(with-xlib-protect
- (multiple-value-bind (nx ny nw nh raise-p)
- (get-father-layout group father)
- (with-slots (rx ry rw rh window) group
- (setf rx nx ry ny rw nw rh nh)
- (setf (xlib:drawable-x window) rx
- (xlib:drawable-y window) ry
- (xlib:drawable-width window) rw
- (xlib:drawable-height window) rh)
- raise-p))))
+ (multiple-value-bind (nx ny nw nh raise-p)
+ (get-father-layout group father)
+ (with-slots (rx ry rw rh window) group
+ (setf rx nx ry ny rw nw rh nh)
+ (setf (xlib:drawable-x window) rx
+ (xlib:drawable-y window) ry
+ (xlib:drawable-width window) rw
+ (xlib:drawable-height window) rh)
+ raise-p))))
@@ -313,30 +313,30 @@
(defmethod show-child ((group group) father)
(with-xlib-protect
- (with-slots (window) group
- (let ((raise-p (adapt-child-to-father group father)))
- (when (or *show-root-group-p* (not (equal group *current-root*)))
- (setf (xlib:window-background window) (get-color "Black"))
- (xlib:map-window window)
- (when raise-p
- (raise-window window))
- (display-group-info group))))))
+ (with-slots (window) group
+ (let ((raise-p (adapt-child-to-father group father)))
+ (when (or *show-root-group-p* (not (equal group *current-root*)))
+ (setf (xlib:window-background window) (get-color "Black"))
+ (xlib:map-window window)
+ (when raise-p
+ (raise-window window))
+ (display-group-info group))))))
(defmethod hide-child ((group group))
(with-xlib-protect
- (with-slots (window) group
- (xlib:unmap-window window))))
+ (with-slots (window) group
+ (xlib:unmap-window window))))
(defmethod show-child ((window xlib:window) father)
(with-xlib-protect
- (let ((raise-p nil))
- (when (eql (window-type window) :normal)
- (setf raise-p (adapt-child-to-father window father)))
- (xlib:map-window window)
- (when raise-p
- (raise-window window)))))
+ (let ((raise-p nil))
+ (when (eql (window-type window) :normal)
+ (setf raise-p (adapt-child-to-father window father)))
+ (xlib:map-window window)
+ (when raise-p
+ (raise-window window)))))
(defmethod hide-child ((window xlib:window))
(hide-window window))
@@ -350,18 +350,18 @@
(defmethod select-child ((group group) selected)
(with-xlib-protect
- (when (and (group-p group) (group-window group))
- (setf (xlib:window-border (group-window group))
- (get-color (cond ((equal selected :maybe) *color-maybe-selected*)
- ((equal selected nil) *color-unselected*)
- (selected *color-selected*)))))))
+ (when (and (group-p group) (group-window group))
+ (setf (xlib:window-border (group-window group))
+ (get-color (cond ((equal selected :maybe) *color-maybe-selected*)
+ ((equal selected nil) *color-unselected*)
+ (selected *color-selected*)))))))
(defmethod select-child ((window xlib:window) selected)
(with-xlib-protect
- (setf (xlib:window-border window)
- (get-color (cond ((equal selected :maybe) *color-maybe-selected*)
- ((equal selected nil) *color-unselected*)
- (selected *color-selected*))))))
+ (setf (xlib:window-border window)
+ (get-color (cond ((equal selected :maybe) *color-maybe-selected*)
+ ((equal selected nil) *color-unselected*)
+ (selected *color-selected*))))))
(defun select-current-group (selected)
(select-child *current-child* selected))
@@ -436,7 +436,7 @@
(select-current-group nil)
(when (group-p *current-child*)
(awhen (first (group-child *current-child*))
- (setf *current-child* it)))
+ (setf *current-child* it)))
(show-all-childs))
(defun select-previous-level ()
@@ -444,7 +444,7 @@
(unless (equal *current-child* *current-root*)
(select-current-group nil)
(awhen (find-father-group *current-child*)
- (setf *current-child* it))
+ (setf *current-child* it))
(show-all-childs)))
@@ -476,8 +476,8 @@
"Leave the selected group - ie make its father the root group"
(hide-all-childs *current-root*)
(awhen (find-father-group *current-root*)
- (when (group-p it)
- (setf *current-root* it)))
+ (when (group-p it)
+ (setf *current-root* it)))
(show-all-childs))
@@ -537,7 +537,7 @@
(setf *current-root* father)))
-(defun focus-all-child (child father)
+(defun focus-all-childs (child father)
"Focus child and its fathers - Set current group to father"
(let ((new-focus (focus-child-rec child father))
(new-current-child (set-current-child child father))
@@ -582,7 +582,7 @@
;;(create-group-on-request)
;; PHIL: TODO: add a hook here
(with-xlib-protect
- (setf (xlib:window-event-mask window) *window-events*)
+ (setf (xlib:window-event-mask window) *window-events*)
(set-window-state window +normal-state+)
(setf (xlib:drawable-border-width window) (case (window-type window)
(:normal 1)
@@ -594,9 +594,9 @@
(leave-group)
(select-previous-level))
;;(unless (eql (window-type window) :maxsize) ;; PHIL: this is sufficient for the ROX panel
- (pushnew window (group-child *current-child*));)
+ (pushnew window (group-child *current-child*)) ;)
(unhide-window window)
- ;;(dbg (window-type window) (xlib:wm-name window)) ;;; PHIL
+ ;;(dbg (xlib:wm-name window) (xlib:get-wm-class window) (window-type window)) ;;; PHIL
(case (window-type window)
(:normal (adapt-child-to-father window *current-child*))
(t (let* ((hints (xlib:wm-normal-hints window))
@@ -624,17 +624,19 @@
(defun process-existing-windows (screen)
"Windows present when clfswm starts up must be absorbed by clfswm."
- (let ((id-list nil))
+ (let ((id-list nil)
+ (all-windows (get-all-windows)))
(dolist (win (xlib:query-tree (xlib:screen-root screen)))
- (let ((map-state (xlib:window-map-state win))
- (wm-state (window-state win)))
- (unless (or (eql (xlib:window-override-redirect win) :on)
- (eql win *no-focus-window*))
- (when (or (eql map-state :viewable)
- (eql wm-state +iconic-state+))
- (format t "Processing ~S: type=~A ~S~%" (xlib:wm-name win) (window-type win)win)
- ;; (unhide-window win)
- (process-new-window win)
- (xlib:map-window win)
- (push (xlib:window-id win) id-list)))))
+ (unless (member win all-windows)
+ (let ((map-state (xlib:window-map-state win))
+ (wm-state (window-state win)))
+ (unless (or (eql (xlib:window-override-redirect win) :on)
+ (eql win *no-focus-window*))
+ (when (or (eql map-state :viewable)
+ (eql wm-state +iconic-state+))
+ (format t "Processing ~S: type=~A ~S~%" (xlib:wm-name win) (window-type win)win)
+ ;; (unhide-window win)
+ (process-new-window win)
+ (xlib:map-window win)
+ (pushnew (xlib:window-id win) id-list))))))
(netwm-set-client-list id-list)))
--- /project/clfswm/cvsroot/clfswm/clfswm-util.lisp 2008/02/28 20:36:26 1.14
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp 2008/02/29 23:05:56 1.15
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Feb 28 21:23:55 2008
+;;; #Date#: Sat Mar 1 00:03:08 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Utility
@@ -83,10 +83,10 @@
(defun unhide-all-windows-in-current-child ()
"Unhide all hidden windows into the current child"
(with-xlib-protect
- (dolist (window (get-hidden-windows))
- (unhide-window window)
- (process-new-window window)
- (xlib:map-window window)))
+ (dolist (window (get-hidden-windows))
+ (unhide-window window)
+ (process-new-window window)
+ (xlib:map-window window)))
(show-all-childs))
@@ -95,15 +95,15 @@
(defun find-child-under-mouse (x y)
"Return the child window under the mouse"
(with-xlib-protect
- (let ((win nil))
- (with-all-windows-groups (*current-root* child)
- (when (and (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
- (<= (xlib:drawable-y child) y (+ (xlib:drawable-y child) (xlib:drawable-height child))))
- (setf win child))
- (when (and (<= (group-rx child) x (+ (group-rx child) (group-rw child)))
- (<= (group-ry child) y (+ (group-ry child) (group-rh child))))
- (setf win (group-window child))))
- win)))
+ (let ((win nil))
+ (with-all-windows-groups (*current-root* child)
+ (when (and (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
+ (<= (xlib:drawable-y child) y (+ (xlib:drawable-y child) (xlib:drawable-height child))))
+ (setf win child))
+ (when (and (<= (group-rx child) x (+ (group-rx child) (group-rw child)))
+ (<= (group-ry child) y (+ (group-ry child) (group-rh child))))
+ (setf win (group-window child))))
+ win)))
@@ -445,9 +445,9 @@
;;; Focus by functions
(defun focus-group-by (group)
(when (group-p group)
- (focus-all-child group (or (find-father-group group *current-root*)
- (find-father-group group)
- *root-group*))))
+ (focus-all-childs group (or (find-father-group group *current-root*)
+ (find-father-group group)
+ *root-group*))))
(defun focus-group-by-name ()
@@ -505,7 +505,7 @@
(when (and child (group-p group-dest))
(remove-child-in-group child (find-father-group child))
(pushnew child (group-child group-dest))
- (focus-all-child child group-dest)))
+ (focus-all-childs child group-dest)))
(defun move-current-child-by-name ()
"Move current child in a named group"
@@ -526,7 +526,7 @@
(defun copy-current-child-by (child group-dest)
(when (and child (group-p group-dest))
(pushnew child (group-child group-dest))
- (focus-all-child child group-dest)))
+ (focus-all-childs child group-dest)))
(defun copy-current-child-by-name ()
"Copy current child in a named group"
--- /project/clfswm/cvsroot/clfswm/clfswm.lisp 2008/02/27 22:34:55 1.15
+++ /project/clfswm/cvsroot/clfswm/clfswm.lisp 2008/02/29 23:05:56 1.16
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Wed Feb 27 20:52:03 2008
+;;; #Date#: Sat Mar 1 00:02:34 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -54,18 +54,18 @@
(when (has-h value-mask) (setf (xlib:drawable-height window) height))
(when (has-w value-mask) (setf (xlib:drawable-width window) width))))
(with-xlib-protect
- (xlib:with-state (window)
- (when (has-bw value-mask)
- (setf (xlib:drawable-border-width window) border-width))
- (if (find-child window *current-root*)
- (case (window-type window)
- (:normal (adapt-child-to-father window (find-father-group window *current-root*))
- (send-configuration-notify window))
- (t (adjust-from-request)))
- (adjust-from-request))
- (when (has-stackmode value-mask)
- (case stack-mode
- (:above (raise-window window))))))))
+ (xlib:with-state (window)
+ (when (has-bw value-mask)
+ (setf (xlib:drawable-border-width window) border-width))
+ (if (find-child window *current-root*)
+ (case (window-type window)
+ (:normal (adapt-child-to-father window (find-father-group window *current-root*))
+ (send-configuration-notify window))
+ (t (adjust-from-request)))
+ (adjust-from-request))
+ (when (has-stackmode value-mask)
+ (case stack-mode
+ (:above (raise-window window))))))))
@@ -79,10 +79,10 @@
(defun handle-map-request (&rest event-slots &key window send-event-p &allow-other-keys)
(declare (ignore event-slots))
(unless send-event-p
-;; (unhide-window window)
+ ;; (unhide-window window)
(process-new-window window)
(xlib:map-window window)
-;; (focus-window window)
+ ;; (focus-window window)
(show-all-childs)))
@@ -113,7 +113,7 @@
(defun handle-exposure (&rest event-slots &key window &allow-other-keys)
(declare (ignore event-slots))
(awhen (find-group-window window *current-root*)
- (display-group-info it)))
+ (display-group-info it)))
(defun handle-create-notify (&rest event-slots)
@@ -130,7 +130,7 @@
(unless father
(setf child (find-group-window window *current-root*)
father (find-father-group child *current-root*)))
- (when (and child father (focus-all-child child father))
+ (when (and child father (focus-all-childs child father))
(show-all-childs)
(setf to-replay nil))
(if to-replay (replay-button-event) (stop-button-event))))
@@ -166,20 +166,20 @@
(declare (ignore display))
;;(dbg event-key)
(with-xlib-protect
- (case event-key
- (:button-press (call-hook *button-press-hook* event-slots))
- (:motion-notify (call-hook *button-motion-notify-hook* event-slots))
- (:key-press (call-hook *key-press-hook* event-slots))
- (:configure-request (call-hook *configure-request-hook* event-slots))
- (:configure-notify (call-hook *configure-notify-hook* event-slots))
- (:map-request (call-hook *map-request-hook* event-slots))
- (:unmap-notify (call-hook *unmap-notify-hook* event-slots))
- (:destroy-notify (call-hook *destroy-notify-hook* event-slots))
- (:mapping-notify (call-hook *mapping-notify-hook* event-slots))
- (:property-notify (call-hook *property-notify-hook* event-slots))
- (:create-notify (call-hook *create-notify-hook* event-slots))
- (:enter-notify (call-hook *enter-notify-hook* event-slots))
- (:exposure (call-hook *exposure-hook* event-slots))))
+ (case event-key
+ (:button-press (call-hook *button-press-hook* event-slots))
+ (:motion-notify (call-hook *button-motion-notify-hook* event-slots))
+ (:key-press (call-hook *key-press-hook* event-slots))
+ (:configure-request (call-hook *configure-request-hook* event-slots))
+ (:configure-notify (call-hook *configure-notify-hook* event-slots))
+ (:map-request (call-hook *map-request-hook* event-slots))
+ (:unmap-notify (call-hook *unmap-notify-hook* event-slots))
+ (:destroy-notify (call-hook *destroy-notify-hook* event-slots))
+ (:mapping-notify (call-hook *mapping-notify-hook* event-slots))
+ (:property-notify (call-hook *property-notify-hook* event-slots))
+ (:create-notify (call-hook *create-notify-hook* event-slots))
+ (:enter-notify (call-hook *enter-notify-hook* event-slots))
+ (:exposure (call-hook *exposure-hook* event-slots))))
t)
@@ -187,7 +187,7 @@
(defun main-loop ()
(loop
(with-xlib-protect
- (xlib:display-finish-output *display*)
+ (xlib:display-finish-output *display*)
(xlib:process-event *display* :handler #'handle-event))))
;;(dbg "Main loop finish" c)))))
--- /project/clfswm/cvsroot/clfswm/xlib-util.lisp 2008/02/24 20:53:37 1.6
+++ /project/clfswm/cvsroot/clfswm/xlib-util.lisp 2008/02/29 23:05:56 1.7
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Sun Feb 24 11:24:46 2008
+;;; #Date#: Thu Feb 28 21:55:00 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Utility functions
@@ -57,17 +57,15 @@
Window types are in +WINDOW-TYPES+.")
(defparameter +netwm-window-types+
- '(
- ;; (:_NET_WM_WINDOW_TYPE_DESKTOP . :desktop)
- ;; (:_NET_WM_WINDOW_TYPE_DOCK . :dock)
- ;; (:_NET_WM_WINDOW_TYPE_TOOLBAR . :toolbar)
- ;; (:_NET_WM_WINDOW_TYPE_MENU . :menu)
- ;; (:_NET_WM_WINDOW_TYPE_UTILITY . :utility)
- ;; (:_NET_WM_WINDOW_TYPE_SPLASH . :splash)
+ '((:_NET_WM_WINDOW_TYPE_DESKTOP . :desktop)
+ (:_NET_WM_WINDOW_TYPE_DOCK . :dock)
+ (:_NET_WM_WINDOW_TYPE_TOOLBAR . :toolbar)
+ (:_NET_WM_WINDOW_TYPE_MENU . :menu)
+ (:_NET_WM_WINDOW_TYPE_UTILITY . :utility)
+ (:_NET_WM_WINDOW_TYPE_SPLASH . :splash)
(:_NET_WM_WINDOW_TYPE_DIALOG . :dialog)
(:_NET_WM_WINDOW_TYPE_NORMAL . :normal))
- "Alist mapping NETWM window types to keywords.
-Include only those we are ready to support.")
+ "Alist mapping NETWM window types to keywords.")
(defmacro with-xlib-protect (&body body)
@@ -254,18 +252,27 @@
(defun window-type (window)
- "Return one of :maxsize, :transient, or :normal."
- (or (and (xlib:get-property window :WM_TRANSIENT_FOR)
- :transient)
- (and (let ((hints (xlib:wm-normal-hints window)))
- (and hints (or (xlib:wm-size-hints-max-width hints)
- (xlib:wm-size-hints-max-height hints))))
- :maxsize)
+ "Return one of :desktop, :dock, :toolbar, :utility, :splash,
+:dialog, :transient, :maxsize and :normal."
+ (or (and (let ((hints (xlib:wm-normal-hints window)))
+ (and hints (or (xlib:wm-size-hints-max-width hints)
+ (xlib:wm-size-hints-max-height hints)
+ (xlib:wm-size-hints-min-aspect hints)
+ (xlib:wm-size-hints-max-aspect hints))))
+ :maxsize)
+ (let ((net-wm-window-type (xlib:get-property window :_NET_WM_WINDOW_TYPE)))
+ (when net-wm-window-type
+ (dolist (type-atom net-wm-window-type)
+ (when (assoc (xlib:atom-name *display* type-atom) +netwm-window-types+)
+ (return (cdr (assoc (xlib:atom-name *display* type-atom) +netwm-window-types+)))))))
+ (and (xlib:get-property window :WM_TRANSIENT_FOR)
+ :transient)
:normal))
+
;; Stolen from Eclipse
(defun send-configuration-notify (window)
"Send a synthetic configure notify event to the given window (ICCCM 4.1.5)"
More information about the clfswm-cvs
mailing list