[clfswm-cvs] CVS clfswm
pbrochard
pbrochard at common-lisp.net
Mon Dec 31 16:32:41 UTC 2007
Update of /project/clfswm/cvsroot/clfswm
In directory clnet:/tmp/cvs-serv2747
Modified Files:
ChangeLog bindings-second-mode.lisp clfswm-internal.lisp
clfswm-second-mode.lisp clfswm.lisp
Log Message:
Send a configure notify event- Do not crop transient windows
--- /project/clfswm/cvsroot/clfswm/ChangeLog 2007/12/30 12:03:36 1.7
+++ /project/clfswm/cvsroot/clfswm/ChangeLog 2007/12/31 16:32:41 1.8
@@ -1,3 +1,12 @@
+2007-12-31 Philippe Brochard <hocwp at free.fr>
+
+ * clfswm.lisp (handle-configure-request): Send an Configuration
+ Notify event. This solve a bug with xterm and rxvt who takes some
+ times to be mapped. Now there is no delay.
+
+ * bindings-second-mode.lisp (define-shell): Run programs after
+ living the second mode.
+
2007-12-30 Philippe Brochard <hocwp at free.fr>
* clfswm-internal.lisp (process-new-window): Do not crop transient
--- /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp 2007/12/29 15:20:10 1.7
+++ /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp 2007/12/31 16:32:41 1.8
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Sat Dec 29 15:38:21 2007
+;;; #Date#: Mon Dec 31 00:14:27 2007
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Bindings keys and mouse for second mode
@@ -61,7 +61,7 @@
"Run a program from the query input"
(let ((program (query-string "Run:")))
(when (and program (not (equal program "")))
- (do-shell program)
+ (setf *second-mode-program* program)
(leave-second-mode))))
(define-second-key (#\!) 'run-program-from-query-string)
@@ -186,7 +186,7 @@
`(define-second-key ,key
(defun ,name ()
,docstring
- (do-shell ,cmd)
+ (setf *second-mode-program* ,cmd)
(leave-second-mode))))
(define-shell (#\c) b-start-xterm "start an xterm" "exec xterm")
@@ -431,14 +431,14 @@
(hide-group *root* *motion-object*)
(setf (group-x *motion-object*) (+ root-x *motion-dx*)
(group-y *motion-object*) (+ root-y *motion-dy*))
- ;;(adapt-all-window-in-group *motion-object*) PHIL
+ (adapt-all-window-in-group *motion-object*)
(show-all-group (current-workspace) *root* *root-gc* nil))
(:resize-group
(hide-group *root* *motion-object*)
(setf (group-width *motion-object*) (max (+ (group-width *motion-object*) (- root-x *motion-dx*)) 100)
(group-height *motion-object*) (max (+ (group-height *motion-object*) (- root-y *motion-dy*)) 100)
*motion-dx* root-x *motion-dy* root-y)
- ;;(adapt-all-window-in-group *motion-object*) PHIL
+ (adapt-all-window-in-group *motion-object*)
(show-all-group (current-workspace) *root* *root-gc* nil)))))
--- /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp 2007/12/30 12:03:36 1.7
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp 2007/12/31 16:32:41 1.8
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Sun Dec 30 12:40:58 2007
+;;; #Date#: Sun Dec 30 22:50:43 2007
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -307,15 +307,13 @@
(t 0)))
(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)
+ (t (multiple-value-bind (x y width height)
+ (get-group-size (current-group))
+ (let* ((hints (xlib:wm-normal-hints window))
+ (min-width (or (and hints (xlib:wm-size-hints-max-width hints)) 0))
+ (min-height (or (and hints (xlib:wm-size-hints-max-height hints)) 0)))
+ (setf (drawable-width window) (max min-width (drawable-width window))
+ (drawable-height window) (max min-height (drawable-height window)))
(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))
--- /project/clfswm/cvsroot/clfswm/clfswm-second-mode.lisp 2007/12/29 15:20:10 1.6
+++ /project/clfswm/cvsroot/clfswm/clfswm-second-mode.lisp 2007/12/31 16:32:41 1.7
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Fri Dec 28 22:38:00 2007
+;;; #Date#: Mon Dec 31 00:03:50 2007
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Second mode functions
@@ -31,6 +31,9 @@
(defparameter *sm-font* nil)
(defparameter *sm-gc* nil)
+(defparameter *second-mode-program* nil
+ "Execute the program string if not nil")
+
(defun draw-second-mode-window ()
(clear-area *sm-window*)
(let* ((text (format nil "Workspace ~A ~:(~A~) ~A ~A"
@@ -196,7 +199,9 @@
(adapt-window-to-group (current-window) (current-group))
(focus-window (current-window))
(show-all-group (current-workspace))
- (wait-no-key-or-button-press))
+ (wait-no-key-or-button-press)
+ (when *second-mode-program*
+ (do-shell *second-mode-program*)))
--- /project/clfswm/cvsroot/clfswm/clfswm.lisp 2007/12/30 12:03:36 1.6
+++ /project/clfswm/cvsroot/clfswm/clfswm.lisp 2007/12/31 16:32:41 1.7
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Sun Dec 30 12:45:01 2007
+;;; #Date#: Mon Dec 31 00:10:03 2007
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -100,6 +100,7 @@
(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)))))
+ (send-configuration-notify window)
(when (has-stackmode value-mask)
(case stack-mode
(:above (raise-window window))))))
@@ -157,6 +158,10 @@
;; (show-all-group (current-workspace)))
+(defun handle-create-notify (&rest event-slots)
+ (declare (ignore event-slots)))
+
+
;;; CONFIG: Main mode hooks
(setf *key-press-hook* #'handle-key-press
@@ -166,7 +171,8 @@
*enter-notify-hook* #'handle-enter-notify
*exposure-hook* #'handle-exposure
*map-request-hook* #'handle-map-request
- *unmap-notify-hook* #'handle-unmap-notify)
+ *unmap-notify-hook* #'handle-unmap-notify
+ *create-notify-hook* #'handle-create-notify)
@@ -174,7 +180,7 @@
(defun handle-event (&rest event-slots &key display event-key &allow-other-keys)
(declare (ignore display))
-;; (dbg event-key)
+ ;;(dbg event-key)
(handler-case
(case event-key
(:button-press (call-hook *button-press-hook* event-slots))
@@ -214,10 +220,10 @@
(dolist (win children)
(let ((map-state (window-map-state win))
(wm-state (window-state win)))
- (unless (or (eq (window-override-redirect win) :on)
- (eq win *no-focus-window*))
+ (unless (or (eql (window-override-redirect win) :on)
+ (eql win *no-focus-window*))
(when (or (eql map-state :viewable)
- (eql wm-state +iconic-state+))
+ (eql wm-state +iconic-state+))
(format t "Processing ~S ~S~%" (wm-name win) win)
(unhide-window win)
(process-new-window win)
More information about the clfswm-cvs
mailing list