[clfswm-cvs] r310 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Sat Sep 4 11:31:09 UTC 2010
Author: pbrochard
Date: Sat Sep 4 07:31:08 2010
New Revision: 310
Log:
src/xlib-util.lisp (handle-event): use with-xlib-protect only in handle-event. Add a with-simple-restart to prevent a clisp/new-lisp infinite loop.
Modified:
clfswm/ChangeLog
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/clfswm.lisp
clfswm/src/xlib-util.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Sat Sep 4 07:31:08 2010
@@ -1,3 +1,9 @@
+2010-09-04 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/xlib-util.lisp (handle-event): use with-xlib-protect only in
+ handle-event. Add a with-simple-restart to prevent a
+ clisp/new-lisp infinite loop.
+
2010-08-30 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-corner.lisp (present-clfswm-terminal): Make the
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Sat Sep 4 07:31:08 2010
@@ -135,12 +135,14 @@
(if (frame-p frame)
(with-slots ((managed forced-managed-window)
(unmanaged forced-unmanaged-window)) frame
- (and (not (child-member window unmanaged))
- (not (member (xlib:wm-name window) unmanaged :test #'string-equal-p))
- (or (member :all (frame-managed-type frame))
- (member (window-type window) (frame-managed-type frame))
- (child-member window managed)
- (member (xlib:wm-name window) managed :test #'string-equal-p))))
+ (xlib:display-finish-output *display*)
+ (let ((ret (and (not (child-member window unmanaged))
+ (not (member (xlib:wm-name window) unmanaged :test #'string-equal-p))
+ (or (member :all (frame-managed-type frame))
+ (member (window-type window) (frame-managed-type frame))
+ (child-member window managed)
+ (member (xlib:wm-name window) managed :test #'string-equal-p)))))
+ ret))
t))
@@ -486,41 +488,39 @@
(defgeneric adapt-child-to-parent (child parent))
(defmethod adapt-child-to-parent ((window xlib:window) parent)
- (with-xlib-protect
- (when (managed-window-p window parent)
- (multiple-value-bind (nx ny nw nh)
- (get-parent-layout window parent)
- (setf nw (max nw 1) nh (max nh 1))
- (let ((change (or (/= (xlib:drawable-x window) nx)
- (/= (xlib:drawable-y window) ny)
- (/= (xlib:drawable-width window) nw)
- (/= (xlib:drawable-height window) nh))))
- (setf (xlib:drawable-x window) nx
- (xlib:drawable-y window) ny
- (xlib:drawable-width window) nw
- (xlib:drawable-height window) nh)
- (xlib:display-finish-output *display*)
- change)))))
+ (when (managed-window-p window parent)
+ (multiple-value-bind (nx ny nw nh)
+ (get-parent-layout window parent)
+ (setf nw (max nw 1) nh (max nh 1))
+ (let ((change (or (/= (xlib:drawable-x window) nx)
+ (/= (xlib:drawable-y window) ny)
+ (/= (xlib:drawable-width window) nw)
+ (/= (xlib:drawable-height window) nh))))
+ (setf (xlib:drawable-x window) nx
+ (xlib:drawable-y window) ny
+ (xlib:drawable-width window) nw
+ (xlib:drawable-height window) nh)
+ (xlib:display-finish-output *display*)
+ change))))
(defmethod adapt-child-to-parent ((frame frame) parent)
- (with-xlib-protect
- (multiple-value-bind (nx ny nw nh)
- (get-parent-layout frame parent)
- (with-slots (rx ry rw rh window) frame
- (setf rx nx ry ny
- rw (max nw 1)
- rh (max nh 1))
- (let ((change (or (/= (xlib:drawable-x window) rx)
- (/= (xlib:drawable-y window) ry)
- (/= (xlib:drawable-width window) rw)
- (/= (xlib:drawable-height window) rh))))
- (setf (xlib:drawable-x window) rx
- (xlib:drawable-y window) ry
- (xlib:drawable-width window) rw
- (xlib:drawable-height window) rh)
- (xlib:display-finish-output *display*)
- change)))))
+ (multiple-value-bind (nx ny nw nh)
+ (get-parent-layout frame parent)
+ (with-slots (rx ry rw rh window) frame
+ (setf rx nx ry ny
+ rw (max nw 1)
+ rh (max nh 1))
+ (let ((change (or (/= (xlib:drawable-x window) rx)
+ (/= (xlib:drawable-y window) ry)
+ (/= (xlib:drawable-width window) rw)
+ (/= (xlib:drawable-height window) rh))))
+ (setf (xlib:drawable-x window) rx
+ (xlib:drawable-y window) ry
+ (xlib:drawable-width window) rw
+ (xlib:drawable-height window) rh)
+ (xlib:display-finish-output *display*)
+ change))))
(defmethod adapt-child-to-parent (child parent)
(declare (ignore child parent))
@@ -533,25 +533,23 @@
(defmethod show-child ((frame frame) parent raise-p)
(declare (ignore parent))
- (with-xlib-protect
- (with-slots (window show-window-p) frame
- (if show-window-p
- (when (or *show-root-frame-p* (not (child-equal-p frame *current-root*)))
- (setf (xlib:window-background window) (get-color "Black"))
- (map-window window)
- (when raise-p (raise-window window)))
- (hide-window window)))
- (display-frame-info frame)))
+ (with-slots (window show-window-p) frame
+ (if show-window-p
+ (when (or *show-root-frame-p* (not (child-equal-p frame *current-root*)))
+ (setf (xlib:window-background window) (get-color "Black"))
+ (map-window window)
+ (when raise-p (raise-window window)))
+ (hide-window window)))
+ (display-frame-info frame))
(defmethod show-child ((window xlib:window) parent raise-p)
- (with-xlib-protect
- (if (or (managed-window-p window parent)
- (child-equal-p parent *current-child*))
- (progn
- (map-window window)
- (when raise-p (raise-window window)))
- (hide-window window))))
+ (if (or (managed-window-p window parent)
+ (child-equal-p parent *current-child*))
+ (progn
+ (map-window window)
+ (when raise-p (raise-window window)))
+ (hide-window window)))
(defmethod show-child (child parent raise-p)
(declare (ignore child parent raise-p))
@@ -561,9 +559,8 @@
(defgeneric hide-child (child))
(defmethod hide-child ((frame frame))
- (with-xlib-protect
- (with-slots (window) frame
- (xlib:unmap-window window))))
+ (with-slots (window) frame
+ (xlib:unmap-window window)))
(defmethod hide-child ((window xlib:window))
(hide-window window))
@@ -598,20 +595,18 @@
(defgeneric select-child (child selected))
(defmethod select-child ((frame frame) selected)
- (with-xlib-protect
- (when (and (frame-p frame) (frame-window frame))
- (setf (xlib:window-border (frame-window frame))
- (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)
+ (when (and (frame-p frame) (frame-window frame))
+ (setf (xlib:window-border (frame-window frame))
(get-color (cond ((equal selected :maybe) *color-maybe-selected*)
((equal selected nil) *color-unselected*)
(selected *color-selected*))))))
+(defmethod select-child ((window xlib:window) selected)
+ (setf (xlib:window-border window)
+ (get-color (cond ((equal selected :maybe) *color-maybe-selected*)
+ ((equal selected nil) *color-unselected*)
+ (selected *color-selected*)))))
+
(defmethod select-child (child selected)
(declare (ignore child selected))
())
@@ -905,20 +900,19 @@
(defun place-window-from-hints (window)
"Place a window from its hints"
- (with-xlib-protect
- (let* ((hints (xlib:wm-normal-hints window))
- (min-width (or (and hints (xlib:wm-size-hints-min-width hints)) 0))
- (min-height (or (and hints (xlib:wm-size-hints-min-height hints)) 0))
- (max-width (or (and hints (xlib:wm-size-hints-max-width hints)) (xlib:drawable-width *root*)))
- (max-height (or (and hints (xlib:wm-size-hints-max-height hints)) (xlib:drawable-height *root*)))
- (rwidth (or (and hints (or (xlib:wm-size-hints-width hints) (xlib:wm-size-hints-base-width hints)))
- (xlib:drawable-width window)))
- (rheight (or (and hints (or (xlib:wm-size-hints-height hints) (xlib:wm-size-hints-base-height hints)))
- (xlib:drawable-height window))))
- (setf (xlib:drawable-width window) (min (max min-width rwidth *default-window-width*) max-width)
- (xlib:drawable-height window) (min (max min-height rheight *default-window-height*) max-height))
- (setf (xlib:drawable-x window) (truncate (/ (- (xlib:screen-width *screen*) (+ (xlib:drawable-width window) 2)) 2))
- (xlib:drawable-y window) (truncate (/ (- (xlib:screen-height *screen*) (+ (xlib:drawable-height window) 2)) 2))))))
+ (let* ((hints (xlib:wm-normal-hints window))
+ (min-width (or (and hints (xlib:wm-size-hints-min-width hints)) 0))
+ (min-height (or (and hints (xlib:wm-size-hints-min-height hints)) 0))
+ (max-width (or (and hints (xlib:wm-size-hints-max-width hints)) (xlib:drawable-width *root*)))
+ (max-height (or (and hints (xlib:wm-size-hints-max-height hints)) (xlib:drawable-height *root*)))
+ (rwidth (or (and hints (or (xlib:wm-size-hints-width hints) (xlib:wm-size-hints-base-width hints)))
+ (xlib:drawable-width window)))
+ (rheight (or (and hints (or (xlib:wm-size-hints-height hints) (xlib:wm-size-hints-base-height hints)))
+ (xlib:drawable-height window))))
+ (setf (xlib:drawable-width window) (min (max min-width rwidth *default-window-width*) max-width)
+ (xlib:drawable-height window) (min (max min-height rheight *default-window-height*) max-height))
+ (setf (xlib:drawable-x window) (truncate (/ (- (xlib:screen-width *screen*) (+ (xlib:drawable-width window) 2)) 2))
+ (xlib:drawable-y window) (truncate (/ (- (xlib:screen-height *screen*) (+ (xlib:drawable-height window) 2)) 2)))))
@@ -937,19 +931,18 @@
"When a new window is created (or when we are scanning initial
windows), this function dresses the window up and gets it ready to be
managed."
- (with-xlib-protect
- (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)
- (:maxsize 1)
- (:transient 1)
- (t 1)))
- (grab-all-buttons window)
- (unless (never-managed-window-p window)
- (unless (do-all-frames-nw-hook window)
- (call-hook *default-nw-hook* (list *root-frame* window))))
- (netwm-add-in-client-list window)))
+ (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)
+ (:maxsize 1)
+ (:transient 1)
+ (t 1)))
+ (grab-all-buttons window)
+ (unless (never-managed-window-p window)
+ (unless (do-all-frames-nw-hook window)
+ (call-hook *default-nw-hook* (list *root-frame* window))))
+ (netwm-add-in-client-list window))
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Sat Sep 4 07:31:08 2010
@@ -134,11 +134,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)
- (map-window window)))
+ (dolist (window (get-hidden-windows))
+ (unhide-window window)
+ (process-new-window window)
+ (map-window window))
(show-all-children))
@@ -146,36 +145,34 @@
(defun find-window-under-mouse (x y)
"Return the child window under the mouse"
- (with-xlib-protect
- (let ((win *root*))
- (with-all-windows-frames-and-parent (*current-root* child parent)
- (when (and (or (managed-window-p child parent) (child-equal-p parent *current-child*))
- (<= (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 (<= (frame-rx child) x (+ (frame-rx child) (frame-rw child)))
- (<= (frame-ry child) y (+ (frame-ry child) (frame-rh child))))
- (setf win (frame-window child))))
- win)))
+ (let ((win *root*))
+ (with-all-windows-frames-and-parent (*current-root* child parent)
+ (when (and (or (managed-window-p child parent) (child-equal-p parent *current-child*))
+ (<= (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 (<= (frame-rx child) x (+ (frame-rx child) (frame-rw child)))
+ (<= (frame-ry child) y (+ (frame-ry child) (frame-rh child))))
+ (setf win (frame-window child))))
+ win))
(defun find-child-under-mouse (x y &optional first-foundp)
"Return the child under the mouse"
- (with-xlib-protect
- (let ((ret nil))
- (with-all-windows-frames-and-parent (*current-root* child parent)
- (when (and (or (managed-window-p child parent) (child-equal-p parent *current-child*))
- (<= (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))))
- (if first-foundp
- (return-from find-child-under-mouse child)
- (setf ret child)))
- (when (and (<= (frame-rx child) x (+ (frame-rx child) (frame-rw child)))
- (<= (frame-ry child) y (+ (frame-ry child) (frame-rh child))))
- (if first-foundp
- (return-from find-child-under-mouse child)
- (setf ret child))))
- ret)))
+ (let ((ret nil))
+ (with-all-windows-frames-and-parent (*current-root* child parent)
+ (when (and (or (managed-window-p child parent) (child-equal-p parent *current-child*))
+ (<= (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))))
+ (if first-foundp
+ (return-from find-child-under-mouse child)
+ (setf ret child)))
+ (when (and (<= (frame-rx child) x (+ (frame-rx child) (frame-rw child)))
+ (<= (frame-ry child) y (+ (frame-ry child) (frame-rh child))))
+ (if first-foundp
+ (return-from find-child-under-mouse child)
+ (setf ret child))))
+ ret))
@@ -933,9 +930,8 @@
"Force the current window to move in the frame (Useful only for unmanaged windows)"
(with-current-window
(let ((parent (find-parent-frame window)))
- (with-xlib-protect
- (setf (xlib:drawable-x window) (frame-rx parent)
- (xlib:drawable-y window) (frame-ry parent)))))
+ (setf (xlib:drawable-x window) (frame-rx parent)
+ (xlib:drawable-y window) (frame-ry parent))))
(leave-second-mode))
@@ -943,13 +939,12 @@
"Force the current window to move in the center of the frame (Useful only for unmanaged windows)"
(with-current-window
(let ((parent (find-parent-frame window)))
- (with-xlib-protect
- (setf (xlib:drawable-x window) (truncate (+ (frame-rx parent)
- (/ (- (frame-rw parent)
- (xlib:drawable-width window)) 2)))
- (xlib:drawable-y window) (truncate (+ (frame-ry parent)
- (/ (- (frame-rh parent)
- (xlib:drawable-height window)) 2)))))))
+ (setf (xlib:drawable-x window) (truncate (+ (frame-rx parent)
+ (/ (- (frame-rw parent)
+ (xlib:drawable-width window)) 2)))
+ (xlib:drawable-y window) (truncate (+ (frame-ry parent)
+ (/ (- (frame-rh parent)
+ (xlib:drawable-height window)) 2))))))
(leave-second-mode))
Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Sat Sep 4 07:31:08 2010
@@ -55,28 +55,27 @@
(when (has-y value-mask) (setf (xlib:drawable-y window) y))
(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*)
- (let ((parent (find-parent-frame window *current-root*)))
- (if (and parent (managed-window-p window parent))
- (adapt-child-to-parent window parent)
- (adjust-from-request)))
- (adjust-from-request))
- (send-configuration-notify window (xlib:drawable-x window) (xlib:drawable-y window)
- (xlib:drawable-width window) (xlib:drawable-height window)
- (xlib:drawable-border-width window))
- (when (has-stackmode value-mask)
- (case stack-mode
- (:above
- (unless (null-size-window-p window)
- (when (or (child-equal-p window *current-child*)
- (is-in-current-child-p window))
- (raise-window window)
- (focus-window window)
- (focus-all-children window (find-parent-frame window *current-root*)))))))))))
+ (xlib:with-state (window)
+ (when (has-bw value-mask)
+ (setf (xlib:drawable-border-width window) border-width))
+ (if (find-child window *current-root*)
+ (let ((parent (find-parent-frame window *current-root*)))
+ (if (and parent (managed-window-p window parent))
+ (adapt-child-to-parent window parent)
+ (adjust-from-request)))
+ (adjust-from-request))
+ (send-configuration-notify window (xlib:drawable-x window) (xlib:drawable-y window)
+ (xlib:drawable-width window) (xlib:drawable-height window)
+ (xlib:drawable-border-width window))
+ (when (has-stackmode value-mask)
+ (case stack-mode
+ (:above
+ (unless (null-size-window-p window)
+ (when (or (child-equal-p window *current-child*)
+ (is-in-current-child-p window))
+ (raise-window window)
+ (focus-window window)
+ (focus-all-children window (find-parent-frame window *current-root*))))))))))
(define-handler main-mode :map-request (window send-event-p)
@@ -129,13 +128,12 @@
(defun main-loop ()
(loop
- (with-xlib-protect
- (call-hook *loop-hook*)
- (xlib:display-finish-output *display*)
- (when (xlib:event-listen *display* *loop-timeout*)
- (xlib:process-event *display* :handler #'handle-event))
- (xlib:display-finish-output *display*))))
-;;(dbg "Main loop finish" c)))))
+ (call-hook *loop-hook*)
+ (xlib:display-finish-output *display*)
+ (when (xlib:event-listen *display* *loop-timeout*)
+ (xlib:process-event *display* :handler #'handle-event))
+ (xlib:display-finish-output *display*)))
+
(defun open-display (display-str protocol)
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Sat Sep 4 07:31:08 2010
@@ -63,22 +63,15 @@
"Alist mapping NETWM window types to keywords.")
+
(defmacro with-xlib-protect (&body body)
"Prevent Xlib errors"
`(handler-case
(progn
, at body)
((or xlib:match-error xlib:window-error xlib:drawable-error) (c)
- ;;(dbg c))))
- ;;(declare (ignore c)))))
- (format t "~&Xlib-error: ~A~%Body:~%~A~%" c ',body)
- (force-output))))
- ;;(dbg c ',body))))
-
-;;(defmacro with-xlib-protect (&body body)
-;; "Prevent Xlib errors"
-;; `(progn
-;; , at body))
+ (dbg 'Ignore-xlib-error c))))
+
@@ -153,10 +146,12 @@
, at body))
+
(defun handle-event (&rest event-slots &key event-key &allow-other-keys)
(with-xlib-protect
(if (fboundp event-key)
- (apply event-key event-slots)
+ (with-simple-restart (top-level "Return to clfswm's top level")
+ (apply event-key event-slots))
#+:event-debug (pushnew (list *current-event-mode* event-key) *unhandled-events* :test #'equal)))
t)
@@ -217,19 +212,17 @@
(defun unhide-window (window)
(when window
- (with-xlib-protect
- (when (window-hidden-p window)
- (xlib:map-window window)
- (setf (window-state window) +normal-state+
- (xlib:window-event-mask window) *window-events*))))
+ (when (window-hidden-p window)
+ (xlib:map-window window)
+ (setf (window-state window) +normal-state+
+ (xlib:window-event-mask window) *window-events*)))
(xlib:display-finish-output *display*))
(defun map-window (window)
(when window
- (with-xlib-protect
- (xlib:map-window window)
- (xlib:display-finish-output *display*))))
+ (xlib:map-window window)
+ (xlib:display-finish-output *display*)))
(defun delete-window (window)
(send-client-message window :WM_PROTOCOLS
@@ -333,11 +326,10 @@
(defun hide-window (window)
(when window
- (with-xlib-protect
- (setf (window-state window) +iconic-state+
- (xlib:window-event-mask window) (remove :structure-notify *window-events*))
- (xlib:unmap-window window)
- (setf (xlib:window-event-mask window) *window-events*)))
+ (setf (window-state window) +iconic-state+
+ (xlib:window-event-mask window) (remove :structure-notify *window-events*))
+ (xlib:unmap-window window)
+ (setf (xlib:window-event-mask window) *window-events*))
(xlib:display-finish-output *display*))
@@ -394,17 +386,15 @@
(defun raise-window (window)
"Map the window if needed and bring it to the top of the stack. Does not affect focus."
(when window
- (with-xlib-protect
- (when (window-hidden-p window)
- (unhide-window window))
- (setf (xlib:window-priority window) :top-if)))
+ (when (window-hidden-p window)
+ (unhide-window window))
+ (setf (xlib:window-priority window) :top-if))
(xlib:display-finish-output *display*))
(defun focus-window (window)
"Give the window focus."
(when window
- (with-xlib-protect
- (xlib:set-input-focus *display* window :parent)))
+ (xlib:set-input-focus *display* window :parent))
(xlib:display-finish-output *display*))
@@ -465,6 +455,7 @@
"Remove the grab on the cursor and restore the cursor shape."
(setf pointer-grabbed nil)
(xlib:ungrab-pointer *display*)
+ (xlib:display-finish-output *display*)
(free-grab-pointer)))
More information about the clfswm-cvs
mailing list