[clfswm-cvs] r313 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Tue Sep 7 20:18:34 UTC 2010
Author: pbrochard
Date: Tue Sep 7 16:18:34 2010
New Revision: 313
Log:
src/clfswm.lisp (error-handler): New function do handle asynchronous errors and ignore them. (open-display): Install the new error-handler on display.
Modified:
clfswm/ChangeLog
clfswm/src/clfswm-generic-mode.lisp
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 Tue Sep 7 16:18:34 2010
@@ -1,3 +1,9 @@
+2010-09-07 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm.lisp (error-handler): New function do handle
+ asynchronous errors and ignore them.
+ (open-display): Install the new error-handler on display.
+
2010-09-05 Philippe Brochard <pbrochard at common-lisp.net>
* src/xlib-util.lisp (with-xlib-protect): Add a
Modified: clfswm/src/clfswm-generic-mode.lisp
==============================================================================
--- clfswm/src/clfswm-generic-mode.lisp (original)
+++ clfswm/src/clfswm-generic-mode.lisp Tue Sep 7 16:18:34 2010
@@ -41,7 +41,6 @@
(loop
(call-hook loop-hook)
(nfuncall loop-function)
- (xlib:display-finish-output *display*)
(when (xlib:event-listen *display* *loop-timeout*)
(xlib:process-event *display* :handler #'handle-event))
(xlib:display-finish-output *display*))
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Tue Sep 7 16:18:34 2010
@@ -135,14 +135,12 @@
(if (frame-p frame)
(with-slots ((managed forced-managed-window)
(unmanaged forced-unmanaged-window)) frame
- (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))
+ (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))))
t))
@@ -326,7 +324,8 @@
x (x-px->fl prx parent)
y (y-px->fl pry parent)
w (w-px->fl prw parent)
- h (h-px->fl prh parent)))))
+ h (h-px->fl prh parent))
+ (xlib:display-finish-output *display*))))
(defun fixe-real-size (frame parent)
"Fixe real (pixel) coordinates in float coordinates"
@@ -912,7 +911,8 @@
(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)))))
+ (xlib:drawable-y window) (truncate (/ (- (xlib:screen-height *screen*) (+ (xlib:drawable-height window) 2)) 2)))
+ (xlib:display-finish-output *display*)))
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Tue Sep 7 16:18:34 2010
@@ -316,7 +316,6 @@
(force-output)
(unwind-protect
(loop until done do
- (xlib:display-finish-output *display*)
(when (xlib:event-listen *display* *loop-timeout*)
(xlib:process-event *display* :handler #'handle-identify))
(xlib:display-finish-output *display*))
@@ -931,7 +930,8 @@
(with-current-window
(let ((parent (find-parent-frame window)))
(setf (xlib:drawable-x window) (frame-rx parent)
- (xlib:drawable-y window) (frame-ry parent))))
+ (xlib:drawable-y window) (frame-ry parent))
+ (xlib:display-finish-output *display*)))
(leave-second-mode))
@@ -944,7 +944,8 @@
(xlib:drawable-width window)) 2)))
(xlib:drawable-y window) (truncate (+ (frame-ry parent)
(/ (- (frame-rh parent)
- (xlib:drawable-height window)) 2))))))
+ (xlib:drawable-height window)) 2))))
+ (xlib:display-finish-output *display*)))
(leave-second-mode))
Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Tue Sep 7 16:18:34 2010
@@ -126,16 +126,29 @@
(display-frame-info it)))
+(defun error-handler (display error-key &rest key-vals &key asynchronous &allow-other-keys)
+ "Handle X errors"
+ (cond
+ ;; ignore asynchronous window errors
+ ((and asynchronous
+ (find error-key '(xlib:window-error xlib:drawable-error xlib:match-error)))
+ (format t "Ignoring XLib asynchronous error: ~s~%" error-key))
+ ((eq error-key 'xlib:access-error)
+ (write-line "Another window manager is running.")
+ (throw :exit-clfswm nil))
+ ;; all other asynchronous errors are printed.
+ (asynchronous
+ (format t "Caught Asynchronous X Error: ~s ~s" error-key key-vals))
+ (t
+ (apply 'error error-key :display display :error-key error-key key-vals))))
+
+
(defun main-loop ()
(loop
(call-hook *loop-hook*)
(with-xlib-protect
- (xlib:display-finish-output *display*))
- (when (with-xlib-protect
- (xlib:event-listen *display* *loop-timeout*))
- (with-xlib-protect
- (xlib:process-event *display* :handler #'handle-event)))
- (with-xlib-protect
+ (when (xlib:event-listen *display* *loop-timeout*)
+ (xlib:process-event *display* :handler #'handle-event))
(xlib:display-finish-output *display*))))
@@ -143,6 +156,7 @@
(defun open-display (display-str protocol)
(multiple-value-bind (host display-num) (parse-display-string display-str)
(setf *display* (xlib:open-display host :display display-num :protocol protocol)
+ (xlib:display-error-handler *display*) 'error-handler
(getenv "DISPLAY") display-str)))
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Tue Sep 7 16:18:34 2010
@@ -63,7 +63,6 @@
"Alist mapping NETWM window types to keywords.")
-
(defmacro with-xlib-protect (&body body)
"Prevent Xlib errors"
`(handler-case
@@ -77,6 +76,8 @@
+
+
;;;
;;; Events management functions.
;;;
@@ -151,7 +152,8 @@
(with-xlib-protect
(if (fboundp event-key)
(apply event-key event-slots)
- #+:event-debug (pushnew (list *current-event-mode* event-key) *unhandled-events* :test #'equal)))
+ #+:event-debug (pushnew (list *current-event-mode* event-key) *unhandled-events* :test #'equal))
+ (xlib:display-finish-output *display*))
t)
More information about the clfswm-cvs
mailing list