[clfswm-cvs] CVS clfswm
pbrochard
pbrochard at common-lisp.net
Sun Dec 30 12:03:37 UTC 2007
Update of /project/clfswm/cvsroot/clfswm
In directory clnet:/tmp/cvs-serv17417
Modified Files:
ChangeLog clfswm-internal.lisp clfswm-util.lisp clfswm.lisp
Log Message:
Adapt window only when necessary+speed up
--- /project/clfswm/cvsroot/clfswm/ChangeLog 2007/12/29 15:20:09 1.6
+++ /project/clfswm/cvsroot/clfswm/ChangeLog 2007/12/30 12:03:36 1.7
@@ -1,3 +1,17 @@
+2007-12-30 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm-internal.lisp (process-new-window): Do not crop transient
+ window to group size.
+ (adapt-window-to-group): Do not crop transient window to group
+ size.
+
+ * clfswm.lisp (handle-configure-request): Adapt just the window to
+ its group and don't take care of the configure request. Remove the
+ bug with the Gimp outside the group and speed up the window
+ manipulation.
+ (handle-exposure): Remove show-all-group on exposure event
+ -> Speed up.
+
2007-12-29 Philippe Brochard <hocwp at free.fr>
* clfswm-util.lisp (circulate-group-up-copy-window)
--- /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp 2007/12/29 15:20:10 1.6
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp 2007/12/30 12:03:36 1.7
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Sat Dec 29 15:36:43 2007
+;;; #Date#: Sun Dec 30 12:40:58 2007
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -72,25 +72,10 @@
(get-group-size group)
(case (window-type window)
(:normal
- ;;(dbg "adapt 1" (wm-name window) (drawable-height window)) ;;; PHIL
(setf/= (drawable-x window) x)
(setf/= (drawable-y window) y)
(setf/= (drawable-width window) width)
- (setf/= (drawable-height window) height)
- ;;(dbg "adapt 2" (drawable-height window))
- )
- (t (let* ((hints (xlib:wm-normal-hints window))
- (hints-width (or (and hints (xlib:wm-size-hints-max-width hints))
- most-positive-fixnum))
- (hints-height (or (and hints (xlib:wm-size-hints-max-height hints))
- most-positive-fixnum)))
- ;;; Adapt only windows with width and heigth outside group
- (when (> hints-width width)
- (setf/= (drawable-width window) width)
- (setf/= (drawable-x window) x))
- (when (> hints-height height)
- (setf/= (drawable-height window) height)
- (setf/= (drawable-y window) y)))))))
+ (setf/= (drawable-height window) height)))))
((or match-error window-error drawable-error) (c)
(declare (ignore c)))))
;;(dbg "Adapt error" c))))
@@ -320,19 +305,19 @@
(:maxsize 1)
(:transient 1)
(t 0)))
- (if (equal (window-type window) :normal)
- (adapt-window-to-group window (current-group))
- (let* ((hints (xlib:wm-normal-hints window))
- (hints-width (or (and hints (xlib:wm-size-hints-max-width hints))
- most-positive-fixnum))
- (hints-height (or (and hints (xlib:wm-size-hints-max-height hints))
- most-positive-fixnum)))
- (multiple-value-bind (x y width height)
- (get-group-size (current-group))
- (setf (drawable-width window) (min hints-width width)
- (drawable-height window) (min hints-height height))
- (setf (drawable-x window) (truncate (+ x (/ (- width (drawable-width window)) 2)))
- (drawable-y window) (truncate (+ y (/ (- height (drawable-height window)) 2)))))))
+ (case (window-type window)
+ (:normal (adapt-window-to-group window (current-group)))
+ (t (let* ((hints (xlib:wm-normal-hints window))
+ (hints-width (or (and hints (xlib:wm-size-hints-max-width hints))
+ most-positive-fixnum))
+ (hints-height (or (and hints (xlib:wm-size-hints-max-height hints))
+ most-positive-fixnum)))
+ (multiple-value-bind (x y width height)
+ (get-group-size (current-group))
+ (setf (drawable-width window) hints-width
+ (drawable-height window) hints-height)
+ (setf (drawable-x window) (truncate (+ x (/ (- width (drawable-width window)) 2)))
+ (drawable-y window) (truncate (+ y (/ (- height (drawable-height window)) 2))))))))
(add-window-in-group window (current-group))
(netwm-add-in-client-list window))
--- /project/clfswm/cvsroot/clfswm/clfswm-util.lisp 2007/12/29 15:20:10 1.6
+++ /project/clfswm/cvsroot/clfswm/clfswm-util.lisp 2007/12/30 12:03:36 1.7
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Sat Dec 29 15:41:24 2007
+;;; #Date#: Sun Dec 30 12:59:59 2007
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Utility
@@ -82,10 +82,11 @@
(defun banish-pointer ()
- "Move the pointer to the lower right corner of the screen"
+ "Move the pointer to the lower right corner of the screen and redraw all groups"
(warp-pointer *root*
(1- (screen-width *screen*))
- (1- (screen-height *screen*))))
+ (1- (screen-height *screen*)))
+ (show-all-group (current-workspace)))
(defun renumber-workspaces ()
--- /project/clfswm/cvsroot/clfswm/clfswm.lisp 2007/12/29 15:20:10 1.5
+++ /project/clfswm/cvsroot/clfswm/clfswm.lisp 2007/12/30 12:03:36 1.6
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Sat Dec 29 15:33:46 2007
+;;; #Date#: Sun Dec 30 12:45:01 2007
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -38,34 +38,68 @@
+;;(defun handle-configure-request (&rest event-slots &key stack-mode #|parent|# window #|above-sibling|#
+;; x y width height border-width value-mask &allow-other-keys)
+;; (declare (ignore event-slots))
+;; (labels ((has-x (mask) (= 1 (logand mask 1)))
+;; (has-y (mask) (= 2 (logand mask 2)))
+;; (has-w (mask) (= 4 (logand mask 4)))
+;; (has-h (mask) (= 8 (logand mask 8)))
+;; (has-bw (mask) (= 16 (logand mask 16)))
+;; (has-stackmode (mask) (= 64 (logand mask 64))))
+;; (handler-case
+;; (progn
+;; (with-state (window)
+;; (when (has-x value-mask)
+;; (setf (drawable-x window) x))
+;; (when (has-y value-mask)
+;; (setf (drawable-y window) y))
+;; (when (has-h value-mask)
+;; (setf (drawable-height window) height))
+;; (when (has-w value-mask)
+;; (setf (drawable-width window) width))
+;; (when (has-bw value-mask)
+;; (setf (drawable-border-width window) border-width)))
+;; ;; The ICCCM says with have to send a fake configure-notify if
+;; ;; the window is moved but not resized.
+;; (when (member window (group-window-list (current-group)))
+;; (unless (or (logbitp 2 value-mask) (logbitp 3 value-mask))
+;; (send-configuration-notify window))
+;; (adapt-window-to-group window (current-group))
+;; (when (has-stackmode value-mask)
+;; (case stack-mode
+;; (:above (raise-window window))))))
+;; ((or match-error window-error drawable-error) (c)
+;; (declare (ignore c))))))
+;; ;;(dbg "Configure Error" c)))))
+;;
+;;
+;;
+;;(defun handle-configure-notify (&rest event-slots)
+;; (declare (ignore event-slots))
+;; (adapt-all-window-in-workspace (current-workspace)))
+
(defun handle-configure-request (&rest event-slots &key stack-mode #|parent|# window #|above-sibling|#
x y width height border-width value-mask &allow-other-keys)
(declare (ignore event-slots))
(labels ((has-x (mask) (= 1 (logand mask 1)))
- (has-y (mask) (= 2 (logand mask 2)))
- (has-w (mask) (= 4 (logand mask 4)))
- (has-h (mask) (= 8 (logand mask 8)))
- (has-bw (mask) (= 16 (logand mask 16)))
+ (has-y (mask) (= 2 (logand mask 2)))
+ (has-w (mask) (= 4 (logand mask 4)))
+ (has-h (mask) (= 8 (logand mask 8)))
+ (has-bw (mask) (= 16 (logand mask 16)))
(has-stackmode (mask) (= 64 (logand mask 64))))
(handler-case
(progn
(with-state (window)
- (when (has-x value-mask)
- (setf (drawable-x window) x))
- (when (has-y value-mask)
- (setf (drawable-y window) y))
- (when (has-h value-mask)
- (setf (drawable-height window) height))
- (when (has-w value-mask)
- (setf (drawable-width window) width))
(when (has-bw value-mask)
- (setf (drawable-border-width window) border-width)))
- ;; The ICCCM says with have to send a fake configure-notify if
- ;; the window is moved but not resized.
- (when (member window (group-window-list (current-group)))
- (unless (or (logbitp 2 value-mask) (logbitp 3 value-mask))
- (send-configuration-notify window))
- (adapt-window-to-group window (current-group))
+ (setf (drawable-border-width window) border-width))
+ (when (member window (group-window-list (current-group)))
+ (case (window-type window)
+ (:normal (adapt-window-to-group window (current-group)))
+ (t (when (has-x value-mask) (setf (drawable-x window) x))
+ (when (has-y value-mask) (setf (drawable-y window) y))
+ (when (has-h value-mask) (setf (drawable-height window) height))
+ (when (has-w value-mask) (setf (drawable-width window) width)))))
(when (has-stackmode value-mask)
(case stack-mode
(:above (raise-window window))))))
@@ -76,8 +110,9 @@
(defun handle-configure-notify (&rest event-slots)
- (declare (ignore event-slots))
- (adapt-all-window-in-workspace (current-workspace)))
+ (declare (ignore event-slots)))
+;; (adapt-all-window-in-workspace (current-workspace)))
+
(defun handle-map-request (&rest event-slots &key window send-event-p &allow-other-keys)
@@ -118,8 +153,8 @@
(focus-group-under-mouse root-x root-y)))
(defun handle-exposure (&rest event-slots)
- (declare (ignore event-slots))
- (show-all-group (current-workspace)))
+ (declare (ignore event-slots)))
+;; (show-all-group (current-workspace)))
@@ -139,7 +174,7 @@
(defun handle-event (&rest event-slots &key display event-key &allow-other-keys)
(declare (ignore display))
- ;;(dbg event-slots)
+;; (dbg event-key)
(handler-case
(case event-key
(:button-press (call-hook *button-press-hook* event-slots))
More information about the clfswm-cvs
mailing list