From 58adf4110a8c283110cb0a2572149ffbbe326b7c Mon Sep 17 00:00:00 2001 From: Philippe Brochard Date: Tue, 2 Oct 2012 23:03:12 +0200 Subject: [PATCH] src/xlib-util.lisp (handle-event): Ignore synchronous xlib window-error and drawable-error in event handler. contrib/clfswm: Dump different image from different installation path. --- ChangeLog | 8 ++++++++ contrib/clfswm | 13 +++++++++++-- src/clfswm-internal.lisp | 18 ++++++++++-------- src/clfswm.lisp | 48 +++++++++++++++++++++++++----------------------- src/xlib-util.lisp | 33 ++++++++++++++++++++------------- 5 files changed, 74 insertions(+), 46 deletions(-) diff --git a/ChangeLog b/ChangeLog index 27a9fd1..404c8ef 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2012-10-02 Philippe Brochard + + * src/xlib-util.lisp (handle-event): Ignore synchronous xlib + window-error and drawable-error in event handler. + + * contrib/clfswm: Dump different image from different installation + path. + 2012-09-30 Philippe Brochard * src/clfswm.lisp (configure-request handler): Send a diff --git a/contrib/clfswm b/contrib/clfswm index d8f1001..c433712 100755 --- a/contrib/clfswm +++ b/contrib/clfswm @@ -1,6 +1,6 @@ #!/bin/bash -e # -# (C) 2008 Xavier Maillard +# (C) 2012 Xavier Maillard # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -155,7 +155,8 @@ if [ "x$lisp_bin" == "x" ]; then lisp_bin=$lisp fi -dump_image="$dump_path/clfswm-$(cksum $(type -p $lisp) | cut -d ' ' -f 1).core" +#dump_image="$dump_path/clfswm-$(cksum $(type -p $lisp) | cut -d ' ' -f 1)-$(echo "$clfswm_asd_path"|md5sum|cut -d ' ' -f 1).core" +dump_image="$dump_path/clfswm-$(echo $(cksum $(type -p $lisp)) "$clfswm_asd_path" | md5sum |cut -d ' ' -f 1).core" if test yes = "$force" && test -e "$dump_image" then @@ -176,6 +177,14 @@ done if test ! -e "$dump_image" || test $older_image -eq 1 then echo "Image is nonexistent or older than sources. Rebuilding clfswm." + echo " lisp=$lisp" + echo " lisp_bin=$lisp_bin" + echo " lisp_opt=$lisp_opt" + echo " dump_path=$dump_path" + echo " clfswm_asd_path=$clfswm_asd_path" + echo " asdf_path=$asdf_path" + echo " dump_image=$dump_image" + test -x $(type -p "$lisp") || die "$lisp can't be found." test -e "$clfswm_asd_path"/clfswm.asd || die "can't find clfswm.asd in $clfswm_asd_path" test -e "$asdf_path"/asdf.lisp || die "can't find asdf.lisp in $asdf_path" diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp index 41606c2..1badaaf 100644 --- a/src/clfswm-internal.lisp +++ b/src/clfswm-internal.lisp @@ -967,10 +967,11 @@ XINERAMA version 1.1 opcode: 150 (/= (x-drawable-height window) nh)) (setf change :resized)) (when change - (setf (x-drawable-x window) nx - (x-drawable-y window) ny - (x-drawable-width window) nw - (x-drawable-height window) nh)) + (xlib:with-state (window) + (setf (x-drawable-x window) nx + (x-drawable-y window) ny + (x-drawable-width window) nw + (x-drawable-height window) nh))) change)))) @@ -985,10 +986,11 @@ XINERAMA version 1.1 opcode: 150 (/= (x-drawable-height window) rh)) (setf change :resized)) (when change - (setf (x-drawable-x window) rx - (x-drawable-y window) ry - (x-drawable-width window) rw - (x-drawable-height window) rh)) + (xlib:with-state (window) + (setf (x-drawable-x window) rx + (x-drawable-y window) ry + (x-drawable-width window) rw + (x-drawable-height window) rh))) change))) (defmethod adapt-child-to-parent (child parent) diff --git a/src/clfswm.lisp b/src/clfswm.lisp index f66976a..588b1df 100644 --- a/src/clfswm.lisp +++ b/src/clfswm.lisp @@ -43,6 +43,7 @@ (modifiers->state *default-modifiers*) window root-x root-y *fun-press*))) + (define-handler main-mode :configure-request (stack-mode window x y width height border-width value-mask) (let ((change nil)) (labels ((has-x (mask) (= 1 (logand mask 1))) @@ -60,11 +61,8 @@ change :resized)) (when (has-w value-mask) (setf (x-drawable-width window) width change :resized)))) - (when window + (when (and window (find-child window *root-frame*)) (xlib:with-state (window) - (when (has-bw value-mask) - (setf (x-drawable-border-width window) border-width - change :resized)) (let ((current-root (find-current-root))) (if (find-child window current-root) (let ((parent (find-parent-frame window current-root))) @@ -72,35 +70,38 @@ (setf change (adapt-child-to-parent window parent)) (adjust-from-request))) (adjust-from-request))) + (when (has-bw value-mask) + (setf (x-drawable-border-width window) border-width + change :resized)) (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)) - (setf change :moved) + (setf change (or change :moved)) (raise-window window) (focus-window window) (focus-all-children window (find-parent-frame window (find-current-root))))))))) (unless (eq change :resized) ;; To be ICCCM compliant, send a fake configuration notify event only when ;; the window has moved and not when it has been resized or the border width has changed. - (with-xlib-protect () - (send-configuration-notify window (x-drawable-x window) (x-drawable-y window) - (x-drawable-width window) (x-drawable-height window) - (x-drawable-border-width window)))))))) + (send-configuration-notify window (x-drawable-x window) (x-drawable-y window) + (x-drawable-width window) (x-drawable-height window) + (x-drawable-border-width window))))))) (define-handler main-mode :map-request (window send-event-p) (unless send-event-p - (unhide-window window) - (process-new-window window) - (map-window window) - (unless (null-size-window-p window) - (multiple-value-bind (never-managed raise) - (never-managed-window-p window) - (unless (and never-managed raise) - (show-all-children)))))) + (unless (find-child window *root-frame*) + (unhide-window window) + (process-new-window window) + (map-window window) + (unless (null-size-window-p window) + (multiple-value-bind (never-managed raise) + (never-managed-window-p window) + (unless (and never-managed raise) + (show-all-children))))))) @@ -122,8 +123,8 @@ (xlib:window-equal window event-window)) (when (find-child window *root-frame*) (delete-child-in-all-frames window) - (show-all-children)) - (xlib:destroy-window window))) + (show-all-children) + (xlib:destroy-window window)))) (define-handler main-mode :enter-notify (window root-x root-y) (unless (and (> root-x (- (xlib:screen-width *screen*) 3)) @@ -149,9 +150,6 @@ (awhen (find-frame-window window) (display-frame-info it))) -(define-handler main-mode :resize-request (window) - (dbg :resize-request window)) - (defun error-handler (display error-key &rest key-vals &key asynchronous &allow-other-keys) "Handle X errors" @@ -166,6 +164,8 @@ ;; all other asynchronous errors are printed. (asynchronous #+:xlib-debug (format t "~&Caught Asynchronous X Error: ~s ~s" error-key key-vals)) + ;;((find error-key '(xlib:window-error xlib:drawable-error xlib:match-error)) + ;; (format t "~&Ignoring Xlib error: ~S ~S~%" error-key key-vals)) (t (apply 'error error-key :display display :error-key error-key key-vals)))) @@ -225,12 +225,14 @@ (dbg *display*) (setf (xlib:window-event-mask *root*) (xlib:make-event-mask :substructure-redirect :substructure-notify + :structure-notify :property-change - :resize-redirect + ;;:resize-redirect :exposure :button-press :button-release :pointer-motion)) + (xlib:display-finish-output *display*) ;;(intern-atoms *display*) (netwm-set-properties) (xlib:display-force-output *display*) diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp index 3edacaa..8a76b72 100644 --- a/src/xlib-util.lisp +++ b/src/xlib-util.lisp @@ -75,7 +75,7 @@ Window types are in +WINDOW-TYPES+.") (defmacro with-xlib-protect ((&optional name tag) &body body) - "Prevent Xlib errors" + "Ignore Xlib errors in body." `(handler-case (with-simple-restart (top-level "Return to clfswm's top level") ,@body @@ -100,6 +100,10 @@ Features: ~A" (force-output))))) +;;(defmacro with-xlib-protect ((&optional name tag) &body body) +;; `(progn +;; ,@body)) + (defmacro with-x-pointer (&body body) @@ -274,18 +278,21 @@ they should be windows. So use this function to make a window out of them." #+(or sbcl ecl openmcl) (xlib::make-window :id (slot-value xobject 'xlib::id) :display *display*) #-(or sbcl clisp ecl openmcl) (error 'not-implemented))) - (catch 'exit-handle-event - (let ((win (getf event-slots :window))) - (when (and win (not (xlib:window-p win))) - (dbg "Pixmap Workaround! Should be a window: " win) - (setf (getf event-slots :window) (make-xlib-window win)))) - (let ((hook-symbol (event-hook-name event-key))) - (when (boundp hook-symbol) - (apply #'call-hook (symbol-value hook-symbol) event-slots))) - (if (fboundp event-key) - (apply event-key event-slots) - #+:event-debug (pushnew (list *current-event-mode* event-key) *unhandled-events* :test #'equal)) - (xlib:display-finish-output *display*)) + (handler-case + (catch 'exit-handle-event + (let ((win (getf event-slots :window))) + (when (and win (not (xlib:window-p win))) + (dbg "Pixmap Workaround! Should be a window: " win) + (setf (getf event-slots :window) (make-xlib-window win)))) + (let ((hook-symbol (event-hook-name event-key))) + (when (boundp hook-symbol) + (apply #'call-hook (symbol-value hook-symbol) event-slots))) + (if (fboundp event-key) + (apply event-key event-slots) + #+:event-debug (pushnew (list *current-event-mode* event-key) *unhandled-events* :test #'equal)) + (xlib:display-finish-output *display*)) + ((or xlib:window-error xlib:drawable-error) (c) + #+xlib-debug (format t "Ignore Xlib synchronous error: ~a~%" c))) t)) -- 2.11.4.GIT