From pbrochard at common-lisp.net Fri Jul 16 20:34:19 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Fri, 16 Jul 2010 16:34:19 -0400 Subject: [clfswm-cvs] r276 - in clfswm: . src Message-ID: Author: pbrochard Date: Fri Jul 16 16:34:18 2010 New Revision: 276 Log: identify-key, move-window, resize-window, wait-mouse-button-release: Add a timeout in xlib:process-event. Modified: clfswm/ChangeLog clfswm/load.lisp clfswm/src/bindings.lisp clfswm/src/clfswm-util.lisp clfswm/src/xlib-util.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Fri Jul 16 16:34:18 2010 @@ -1,3 +1,11 @@ +2010-07-16 Philippe Brochard + + * src/clfswm-util.lisp (identify-key): Add a timeout in + xlib:process-event. + + * src/xlib-util.lisp (move-window, resize-window) + (wait-mouse-button-release): Add a timeout in xlib:process-event. + 2010-04-11 Philippe Brochard * src/clfswm-util.lisp (run-other-window-manager): Add the ability Modified: clfswm/load.lisp ============================================================================== --- clfswm/load.lisp (original) +++ clfswm/load.lisp Fri Jul 16 16:34:18 2010 @@ -63,6 +63,7 @@ ;;; For debuging: start Xnest or Zephyr and ;;; add the lines above in a dot-clfswmrc-debug file +;;; mod-2 is the numlock key on some keyboards. ;;(setf *default-modifiers* '(:mod-2)) ;; ;;(defun my-add-escape () Modified: clfswm/src/bindings.lisp ============================================================================== --- clfswm/src/bindings.lisp (original) +++ clfswm/src/bindings.lisp Fri Jul 16 16:34:18 2010 @@ -116,6 +116,8 @@ (stop-button-event) (mouse-focus-move/resize-generic root-x root-y #'resize-frame t)) + + (defun set-default-main-mouse () (define-main-mouse (1) 'mouse-click-to-focus-and-move) (define-main-mouse (2) 'mouse-middle-click) Modified: clfswm/src/clfswm-util.lisp ============================================================================== --- clfswm/src/clfswm-util.lisp (original) +++ clfswm/src/clfswm-util.lisp Fri Jul 16 16:34:18 2010 @@ -39,7 +39,7 @@ (etc-conf (probe-file #p"/etc/clfswmrc")) (config-user-conf (probe-file (make-pathname :directory (append (xdg-config-home) '("clfswm")) :name "clfswmrc"))) - (alternate-conf (probe-file alternate-name))) + (alternate-conf (and alternate-name (probe-file alternate-name)))) (setf saved-conf-name (or alternate-conf config-user-conf user-conf etc-conf)))) (print saved-conf-name) saved-conf-name)) @@ -320,7 +320,7 @@ (unwind-protect (loop until done do (xlib:display-finish-output *display*) - (xlib:process-event *display* :handler #'handle-identify)) + (xlib:process-event *display* :handler #'handle-identify :timeout *loop-timeout*)) (xlib:destroy-window window) (xlib:close-font font) (xgrab-pointer *root* 66 67))))) Modified: clfswm/src/xlib-util.lisp ============================================================================== --- clfswm/src/xlib-util.lisp (original) +++ clfswm/src/xlib-util.lisp Fri Jul 16 16:34:18 2010 @@ -500,7 +500,7 @@ (loop until done do (with-xlib-protect (xlib:display-finish-output *display*) - (xlib:process-event *display* :handler #'handle-event))) + (xlib:process-event *display* :handler #'handle-event :timeout *loop-timeout*))) (unless pointer-grabbed-p (xungrab-pointer))))) @@ -543,7 +543,7 @@ (loop until done do (with-xlib-protect (xlib:display-finish-output *display*) - (xlib:process-event *display* :handler #'handle-event))) + (xlib:process-event *display* :handler #'handle-event :timeout *loop-timeout*))) (unless pointer-grabbed-p (xungrab-pointer))))) @@ -571,7 +571,7 @@ (loop until done do (with-xlib-protect (xlib:display-finish-output *display*) - (xlib:process-event *display* :handler #'handle-event))) + (xlib:process-event *display* :handler #'handle-event :timeout *loop-timeout*))) (unless pointer-grabbed-p (xungrab-pointer))))) From pbrochard at common-lisp.net Fri Jul 16 21:38:06 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Fri, 16 Jul 2010 17:38:06 -0400 Subject: [clfswm-cvs] r277 - in clfswm: . src Message-ID: Author: pbrochard Date: Fri Jul 16 17:38:05 2010 New Revision: 277 Log: clfswm-util.lisp (mouse-click-to-focus-generic): Use find-child-under-mouse instead of the window passed by xlib:process-event. Modified: clfswm/ChangeLog clfswm/src/clfswm-util.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Fri Jul 16 17:38:05 2010 @@ -2,6 +2,8 @@ * src/clfswm-util.lisp (identify-key): Add a timeout in xlib:process-event. + (mouse-click-to-focus-generic): Use find-child-under-mouse instead + of the window passed by xlib:process-event. * src/xlib-util.lisp (move-window, resize-window) (wait-mouse-button-release): Add a timeout in xlib:process-event. Modified: clfswm/src/clfswm-util.lisp ============================================================================== --- clfswm/src/clfswm-util.lisp (original) +++ clfswm/src/clfswm-util.lisp Fri Jul 16 17:38:05 2010 @@ -553,31 +553,35 @@ "Focus the current frame or focus the current window parent mouse-fun is #'move-frame or #'resize-frame" (let* ((to-replay t) - (child window) - (parent (find-parent-frame child *current-root*)) + (child (find-child-under-mouse root-x root-y)) + (parent (find-parent-frame child)) (root-p (or (equal window *root*) (and (frame-p *current-root*) (equal child (frame-window *current-root*)))))) - (when (or (not root-p) *create-frame-on-root*) - (unless parent - (if root-p - (progn - (setf child (create-frame) - parent *current-root* - mouse-fn #'resize-frame) - (place-frame child parent root-x root-y 10 10) - (map-window (frame-window child)) - (pushnew child (frame-child *current-root*))) - (setf child (find-frame-window window *current-root*) - parent (find-parent-frame child *current-root*))) - (when child + (labels ((add-new-frame () + (setf child (create-frame) + parent *current-root* + mouse-fn #'resize-frame) + (place-frame child parent root-x root-y 10 10) + (map-window (frame-window child)) + (pushnew child (frame-child *current-root*)))) + (when (or (not root-p) *create-frame-on-root*) + (unless parent + (if root-p + (add-new-frame) + (progn + (unless (equal (type-of child) 'frame) + (setf child (find-frame-window child *current-root*))) + (setf parent (find-parent-frame child))))) + (when (and child parent (focus-all-children child parent)) + (when (show-all-children) + (setf to-replay nil))) + (when (equal (type-of child) 'frame) (funcall mouse-fn child parent root-x root-y))) - (when (and child parent (focus-all-children child parent)) - (when (show-all-children) - (setf to-replay nil)))) - (if to-replay - (replay-button-event) - (stop-button-event)))) + (if to-replay + (replay-button-event) + (stop-button-event))))) + (defun mouse-click-to-focus-and-move (window root-x root-y) "Move and focus the current frame or focus the current window parent. From pbrochard at common-lisp.net Sun Jul 18 21:07:06 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Sun, 18 Jul 2010 17:07:06 -0400 Subject: [clfswm-cvs] r278 - in clfswm: . src Message-ID: Author: pbrochard Date: Sun Jul 18 17:07:03 2010 New Revision: 278 Log: clfswm-util.lisp (delete-focus-window, destroy-focus-window): Remove child in parent frame before stopping it. Modified: clfswm/ChangeLog clfswm/src/clfswm-util.lisp clfswm/src/clfswm.lisp clfswm/src/xlib-util.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Sun Jul 18 17:07:03 2010 @@ -1,3 +1,9 @@ +2010-07-18 Philippe Brochard + + * src/clfswm-util.lisp (delete-focus-window) + (destroy-focus-window): Remove child in parent frame before + stopping it. + 2010-07-16 Philippe Brochard * src/clfswm-util.lisp (identify-key): Add a timeout in Modified: clfswm/src/clfswm-util.lisp ============================================================================== --- clfswm/src/clfswm-util.lisp (original) +++ clfswm/src/clfswm-util.lisp Sun Jul 18 17:07:03 2010 @@ -111,8 +111,11 @@ (when (and window (not (xlib:window-equal window *no-focus-window*))) (when (equal window *current-child*) (setf *current-child* *current-root*)) + (hide-child window) + (remove-child-in-frame window (find-parent-frame window)) (send-client-message window :WM_PROTOCOLS (xlib:intern-atom *display* "WM_DELETE_WINDOW")) + (xlib:display-finish-output *display*) (show-all-children)))) (defun destroy-focus-window () @@ -121,7 +124,10 @@ (when (and window (not (xlib:window-equal window *no-focus-window*))) (when (equal window *current-child*) (setf *current-child* *current-root*)) + (hide-child window) + (remove-child-in-frame window (find-parent-frame window)) (xlib:kill-client *display* (xlib:window-id window)) + (xlib:display-finish-output *display*) (show-all-children)))) (defun remove-focus-window () Modified: clfswm/src/clfswm.lisp ============================================================================== --- clfswm/src/clfswm.lisp (original) +++ clfswm/src/clfswm.lisp Sun Jul 18 17:07:03 2010 @@ -76,11 +76,12 @@ (if (find-child window *current-root*) (let ((parent (find-parent-frame window *current-root*))) (if (and parent (managed-window-p window parent)) - (progn - (adapt-child-to-parent window parent) - (send-configuration-notify window)) + (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 (raise-window window)))))))) @@ -161,7 +162,6 @@ - ;;; CONFIG: Main mode hooks (setf *key-press-hook* 'handle-key-press *configure-request-hook* 'handle-configure-request Modified: clfswm/src/xlib-util.lisp ============================================================================== --- clfswm/src/xlib-util.lisp (original) +++ clfswm/src/xlib-util.lisp Sun Jul 18 17:07:03 2010 @@ -70,7 +70,7 @@ , at body) ((or xlib:match-error xlib:window-error xlib:drawable-error) (c) (declare (ignore c))))) - ;;(dbg c ',body)))) + ;;(dbg c ',body)))) @@ -128,16 +128,18 @@ (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-subwindows 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-subwindows window) (xlib:map-window window) (xlib:display-finish-output *display*)))) @@ -286,21 +288,18 @@ -;; Stolen from Eclipse -(defun send-configuration-notify (window) +;;; Stolen from Eclipse +(defun send-configuration-notify (window x y w h bw) "Send a synthetic configure notify event to the given window (ICCCM 4.1.5)" - (multiple-value-bind (x y) - (xlib:translate-coordinates window 0 0 (xlib:drawable-root window)) - (xlib:send-event window - :configure-notify - (xlib:make-event-mask :structure-notify) - :event-window window :window window - :x x :y y - :override-redirect-p nil - :border-width (xlib:drawable-border-width window) - :width (xlib:drawable-width window) - :height (xlib:drawable-height window) - :propagate-p nil))) + (xlib:send-event window :configure-notify (xlib:make-event-mask :structure-notify) + :event-window window + :window window + :x x :y y + :width w + :height h + :border-width bw + :propagate-p nil)) + (defun send-client-message (window type &rest data) From pbrochard at common-lisp.net Mon Jul 19 22:11:29 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Mon, 19 Jul 2010 18:11:29 -0400 Subject: [clfswm-cvs] r279 - in clfswm: . src Message-ID: Author: pbrochard Date: Mon Jul 19 18:11:29 2010 New Revision: 279 Log: src/clfswm-util.lisp (mouse-click-to-focus-generic): Redisplay all children in *current-root* after moving/resizing a frame. Modified: clfswm/ChangeLog clfswm/load.lisp clfswm/src/clfswm-util.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Mon Jul 19 18:11:29 2010 @@ -1,3 +1,8 @@ +2010-07-20 Philippe Brochard + + * src/clfswm-util.lisp (mouse-click-to-focus-generic): Redisplay + all children in *current-root* after moving/resizing a frame. + 2010-07-18 Philippe Brochard * src/clfswm-util.lisp (delete-focus-window) Modified: clfswm/load.lisp ============================================================================== --- clfswm/load.lisp (original) +++ clfswm/load.lisp Mon Jul 19 18:11:29 2010 @@ -56,7 +56,7 @@ #-BUILD (ignore-errors - (main :read-conf-file-p t)) + (main-unprotected :read-conf-file-p t)) ;;(produce-all-docs) Modified: clfswm/src/clfswm-util.lisp ============================================================================== --- clfswm/src/clfswm-util.lisp (original) +++ clfswm/src/clfswm-util.lisp Mon Jul 19 18:11:29 2010 @@ -579,11 +579,13 @@ (unless (equal (type-of child) 'frame) (setf child (find-frame-window child *current-root*))) (setf parent (find-parent-frame child))))) - (when (and child parent (focus-all-children child parent)) - (when (show-all-children) - (setf to-replay nil))) + (when (and child parent) + (focus-all-children child parent) + (show-all-children)) (when (equal (type-of child) 'frame) - (funcall mouse-fn child parent root-x root-y))) + (funcall mouse-fn child parent root-x root-y)) + (when (show-all-children *current-root*) + (setf to-replay nil))) (if to-replay (replay-button-event) (stop-button-event))))) @@ -634,7 +636,7 @@ child root-x root-y))) (frame (funcall mouse-fn child parent root-x root-y))) (focus-all-children child parent window-parent) - (show-all-children))) + (show-all-children *current-root*))) @@ -1005,6 +1007,7 @@ "Move the window under the mouse cursor to another frame" (declare (ignore window)) (let ((child (find-child-under-mouse root-x root-y))) + (dbg child (frame-child child)) (unless (equal child *current-root*) (hide-child child) (remove-child-in-frame child (find-parent-frame child)) @@ -1015,7 +1018,13 @@ (when (xlib:window-p dest) (setf dest (find-parent-frame dest))) (unless (equal child dest) - (move-child-to child dest)))))) + ;;(move-child-to child dest)))))) + (dbg dest (frame-child dest)) + (pushnew child (frame-child dest)) + (dbg dest (frame-child dest)) + (dbg child (frame-child child)) + ;;(focus-all-children child dest) + (show-all-children *current-root*)))))) (stop-button-event)) From pbrochard at common-lisp.net Tue Jul 20 21:33:25 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Tue, 20 Jul 2010 17:33:25 -0400 Subject: [clfswm-cvs] r280 - in clfswm: . src Message-ID: Author: pbrochard Date: Tue Jul 20 17:33:24 2010 New Revision: 280 Log: src/clfswm-internal.lisp (remove-child-in-frame): Do not destroy the frame window and the frame gc. Close a very annoying bug when cuting/pasting a frame or moving a child over frames with the mouse. Modified: clfswm/ChangeLog clfswm/load.lisp clfswm/src/bindings.lisp clfswm/src/clfswm-internal.lisp clfswm/src/clfswm-util.lisp clfswm/src/clfswm.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Tue Jul 20 17:33:24 2010 @@ -1,5 +1,10 @@ 2010-07-20 Philippe Brochard + * src/clfswm-internal.lisp (remove-child-in-frame): Do not destroy + the frame window and the frame gc. Close a very annoying bug when + cuting/pasting a frame or moving a child over frames with the + mouse. + * src/clfswm-util.lisp (mouse-click-to-focus-generic): Redisplay all children in *current-root* after moving/resizing a frame. Modified: clfswm/load.lisp ============================================================================== --- clfswm/load.lisp (original) +++ clfswm/load.lisp Tue Jul 20 17:33:24 2010 @@ -56,7 +56,7 @@ #-BUILD (ignore-errors - (main-unprotected :read-conf-file-p t)) + (main :read-conf-file-p t)) ;;(produce-all-docs) Modified: clfswm/src/bindings.lisp ============================================================================== --- clfswm/src/bindings.lisp (original) +++ clfswm/src/bindings.lisp Tue Jul 20 17:33:24 2010 @@ -124,7 +124,7 @@ (define-main-mouse (3) 'mouse-click-to-focus-and-resize) (define-main-mouse (1 :mod-1) 'mouse-click-to-focus-and-move-window) (define-main-mouse (3 :mod-1) 'mouse-click-to-focus-and-resize-window) - (define-main-mouse (1 :control :mod-1) 'mouse-move-window-over-frame) + (define-main-mouse (1 :control :mod-1) 'mouse-move-child-over-frame) (define-main-mouse (4) 'mouse-select-next-level) (define-main-mouse (5) 'mouse-select-previous-level) (define-main-mouse (4 :mod-1) 'mouse-enter-frame) Modified: clfswm/src/clfswm-internal.lisp ============================================================================== --- clfswm/src/clfswm-internal.lisp (original) +++ clfswm/src/clfswm-internal.lisp Tue Jul 20 17:33:24 2010 @@ -815,19 +815,12 @@ (defun remove-child-in-frame (child frame) "Remove the child in frame" (when (frame-p frame) - (setf (frame-child frame) (remove child (frame-child frame) :test #'equal)) - (with-all-frames (child fr) - (unless (find-frame-window (frame-window fr)) - (awhen (frame-gc fr) (xlib:free-gcontext it) (setf it nil)) - (awhen (frame-window fr) (xlib:destroy-window it) (setf it nil)))))) + (setf (frame-child frame) (remove child (frame-child frame) :test #'equal)))) (defun remove-child-in-frames (child root) "Remove child in the frame root and in all its children" (with-all-frames (root frame) - (remove-child-in-frame child frame)) - (when (xlib:window-p child) - (netwm-remove-in-client-list child))) - + (remove-child-in-frame child frame))) (defun remove-child-in-all-frames (child) @@ -839,6 +832,27 @@ (remove-child-in-frames child *root-frame*)) +(defun delete-child-in-frames (child root) + "Delete child in the frame root and in all its children +Warning:frame window and gc are freeed." + (with-all-frames (root frame) + (remove-child-in-frame child frame) + (unless (find-frame-window (frame-window frame)) + (awhen (frame-gc frame) (xlib:free-gcontext it) (setf it nil)) + (awhen (frame-window frame) (xlib:destroy-window it) (setf it nil)))) + (when (xlib:window-p child) + (netwm-remove-in-client-list child))) + + +(defun delete-child-in-all-frames (child) + "Delete child in all frames from *root-frame*" + (when (equal child *current-root*) + (setf *current-root* (find-parent-frame child))) + (when (equal child *current-child*) + (setf *current-child* *current-root*)) + (delete-child-in-frames child *root-frame*)) + + Modified: clfswm/src/clfswm-util.lisp ============================================================================== --- clfswm/src/clfswm-util.lisp (original) +++ clfswm/src/clfswm-util.lisp Tue Jul 20 17:33:24 2010 @@ -1002,14 +1002,13 @@ -;;; Moving window with the mouse function -(defun mouse-move-window-over-frame (window root-x root-y) - "Move the window under the mouse cursor to another frame" +;;; Moving child with the mouse button +(defun mouse-move-child-over-frame (window root-x root-y) + "Move the child under the mouse cursor to another frame" (declare (ignore window)) (let ((child (find-child-under-mouse root-x root-y))) - (dbg child (frame-child child)) (unless (equal child *current-root*) - (hide-child child) + (hide-all child) (remove-child-in-frame child (find-parent-frame child)) (wait-mouse-button-release 50 51) (multiple-value-bind (x y) @@ -1018,12 +1017,7 @@ (when (xlib:window-p dest) (setf dest (find-parent-frame dest))) (unless (equal child dest) - ;;(move-child-to child dest)))))) - (dbg dest (frame-child dest)) - (pushnew child (frame-child dest)) - (dbg dest (frame-child dest)) - (dbg child (frame-child child)) - ;;(focus-all-children child dest) + (move-child-to child dest) (show-all-children *current-root*)))))) (stop-button-event)) Modified: clfswm/src/clfswm.lisp ============================================================================== --- clfswm/src/clfswm.lisp (original) +++ clfswm/src/clfswm.lisp Tue Jul 20 17:33:24 2010 @@ -111,7 +111,7 @@ (unless (and (not send-event-p) (not (xlib:window-equal window event-window))) (when (find-child window *root-frame*) - (remove-child-in-all-frames window) + (delete-child-in-all-frames window) (show-all-children)))) @@ -120,7 +120,7 @@ (unless (or send-event-p (xlib:window-equal window event-window)) (when (find-child window *root-frame*) - (remove-child-in-all-frames window) + (delete-child-in-all-frames window) (show-all-children)))) From pbrochard at common-lisp.net Tue Jul 20 21:36:37 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Tue, 20 Jul 2010 17:36:37 -0400 Subject: [clfswm-cvs] r281 - clfswm/src Message-ID: Author: pbrochard Date: Tue Jul 20 17:36:36 2010 New Revision: 281 Log: bindings-second-mode.lisp (set-default-second-mouse): Use mouse-move-child-over-frame instead of mouse-move-window-over-frame Modified: clfswm/src/bindings-second-mode.lisp Modified: clfswm/src/bindings-second-mode.lisp ============================================================================== --- clfswm/src/bindings-second-mode.lisp (original) +++ clfswm/src/bindings-second-mode.lisp Tue Jul 20 17:36:36 2010 @@ -240,7 +240,7 @@ (define-second-mouse (3) 'sm-mouse-click-to-focus-and-resize) (define-second-mouse (1 :mod-1) 'sm-mouse-click-to-focus-and-move-window) (define-second-mouse (3 :mod-1) 'sm-mouse-click-to-focus-and-resize-window) - (define-second-mouse (1 :control :mod-1) 'mouse-move-window-over-frame) + (define-second-mouse (1 :control :mod-1) 'mouse-move-child-over-frame) (define-second-mouse (4) 'sm-mouse-select-next-level) (define-second-mouse (5) 'sm-mouse-select-previous-level) (define-second-mouse (4 :mod-1) 'sm-mouse-enter-frame) From pbrochard at common-lisp.net Wed Jul 21 13:06:42 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Wed, 21 Jul 2010 09:06:42 -0400 Subject: [clfswm-cvs] r282 - in clfswm: . src Message-ID: Author: pbrochard Date: Wed Jul 21 09:06:42 2010 New Revision: 282 Log: src/clfswm-internal.lisp (delete-child-and-children-in-all-frames): New function and binding: Second mode - Control+Delete delete the current child and its children in all frames (ie: close the current child and its children). Modified: clfswm/ChangeLog clfswm/TODO clfswm/src/bindings-second-mode.lisp clfswm/src/clfswm-internal.lisp clfswm/src/clfswm-util.lisp clfswm/src/menu-def.lisp clfswm/src/package.lisp clfswm/src/xlib-util.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Wed Jul 21 09:06:42 2010 @@ -1,3 +1,11 @@ +2010-07-21 Philippe Brochard + + * src/clfswm-internal.lisp + (delete-child-and-children-in-all-frames): New function and + binding: Second mode - Control+Delete delete the current child and + its children in all frames (ie: close the current child and its + children). + 2010-07-20 Philippe Brochard * src/clfswm-internal.lisp (remove-child-in-frame): Do not destroy Modified: clfswm/TODO ============================================================================== --- clfswm/TODO (original) +++ clfswm/TODO Wed Jul 21 09:06:42 2010 @@ -7,6 +7,8 @@ =============== Should handle these soon. +- Bind control+g to escape all actions like emacs. + - Remote access to the clfswm REPL [Philippe] this can be done with net.lisp or via xprop (ie the Stumpwm way). Protocol: Modified: clfswm/src/bindings-second-mode.lisp ============================================================================== --- clfswm/src/bindings-second-mode.lisp (original) +++ clfswm/src/bindings-second-mode.lisp Wed Jul 21 09:06:42 2010 @@ -127,6 +127,7 @@ (define-second-key ("v" :control) 'paste-selection) (define-second-key ("v" :control :shift) 'paste-selection-no-clear) (define-second-key ("Delete") 'remove-current-child) + (define-second-key ("Delete" :control) 'delete-current-child) (define-shell (#\c) b-start-xterm "start an xterm" "exec xterm") (define-shell (#\e) b-start-emacs "start emacs" "exec emacs") (define-shell (#\e :control) b-start-emacsremote Modified: clfswm/src/clfswm-internal.lisp ============================================================================== --- clfswm/src/clfswm-internal.lisp (original) +++ clfswm/src/clfswm-internal.lisp Wed Jul 21 09:06:42 2010 @@ -853,6 +853,23 @@ (delete-child-in-frames child *root-frame*)) +(defun delete-child-and-children-in-frames (child root &optional (close-methode 'delete-window)) + "Delete child and its children in the frame root and in all its children +Warning:frame window and gc are freeed." + (when (and (frame-p child) (frame-child child)) + (dolist (ch (frame-child child)) + (delete-child-and-children-in-frames ch root close-methode))) + (delete-child-in-frames child root) + (when (xlib:window-p child) + (funcall close-methode child))) + +(defun delete-child-and-children-in-all-frames (child &optional (close-methode 'delete-window)) + "Delete child and its children in all frames from *root-frame*" + (when (equal child *current-root*) + (setf *current-root* (find-parent-frame child))) + (when (equal child *current-child*) + (setf *current-child* *current-root*)) + (delete-child-and-children-in-frames child *root-frame* close-methode)) Modified: clfswm/src/clfswm-util.lisp ============================================================================== --- clfswm/src/clfswm-util.lisp (original) +++ clfswm/src/clfswm-util.lisp Wed Jul 21 09:06:42 2010 @@ -105,30 +105,22 @@ -(defun delete-focus-window () - "Close focus window: Delete the focus window in all frames and workspaces" +(defun delete-focus-window-generic (close-fun) (let ((window (xlib:input-focus *display*))) (when (and window (not (xlib:window-equal window *no-focus-window*))) (when (equal window *current-child*) (setf *current-child* *current-root*)) (hide-child window) - (remove-child-in-frame window (find-parent-frame window)) - (send-client-message window :WM_PROTOCOLS - (xlib:intern-atom *display* "WM_DELETE_WINDOW")) - (xlib:display-finish-output *display*) + (delete-child-and-children-in-all-frames window) (show-all-children)))) +(defun delete-focus-window () + "Close focus window: Delete the focus window in all frames and workspaces" + (delete-focus-window-generic 'delete-window)) + (defun destroy-focus-window () "Kill focus window: Destroy the focus window in all frames and workspaces" - (let ((window (xlib:input-focus *display*))) - (when (and window (not (xlib:window-equal window *no-focus-window*))) - (when (equal window *current-child*) - (setf *current-child* *current-root*)) - (hide-child window) - (remove-child-in-frame window (find-parent-frame window)) - (xlib:kill-client *display* (xlib:window-id window)) - (xlib:display-finish-output *display*) - (show-all-children)))) + (delete-focus-window-generic 'destroy-window)) (defun remove-focus-window () "Remove the focus window from the current frame" @@ -213,15 +205,13 @@ (setf *current-child* *current-root*) (leave-second-mode)) - -(defun remove-current-child-from-tree () - "Remove the current child from the CLFSWM tree" - (remove-child-in-frame *current-child* (find-parent-frame *current-child* *current-root*)) - (setf *current-child* *current-root*) +(defun delete-current-child () + "Delete the current child and its children" + (hide-all *current-child*) + (delete-child-and-children-in-all-frames *current-child*) (leave-second-mode)) - (defun paste-selection-no-clear () "Paste the selection in the current frame - Do not clear the selection after paste" (let ((frame-dest (typecase *current-child* Modified: clfswm/src/menu-def.lisp ============================================================================== --- clfswm/src/menu-def.lisp (original) +++ clfswm/src/menu-def.lisp Wed Jul 21 09:06:42 2010 @@ -78,8 +78,8 @@ (add-menu-key 'child-menu "r" 'rename-current-child) (add-menu-key 'child-menu "e" 'ensure-unique-name) (add-menu-key 'child-menu "n" 'ensure-unique-number) -(add-menu-key 'child-menu "x" 'remove-current-child-from-tree) (add-menu-key 'child-menu "Delete" 'remove-current-child) +(add-menu-key 'child-menu "X" 'delete-current-child) (add-menu-key 'child-menu "h" 'hide-current-child) (add-menu-key 'child-menu "u" 'unhide-a-child) (add-menu-key 'child-menu "f" 'unhide-a-child-from-all-frames) Modified: clfswm/src/package.lisp ============================================================================== --- clfswm/src/package.lisp (original) +++ clfswm/src/package.lisp Wed Jul 21 09:06:42 2010 @@ -262,11 +262,11 @@ ;;; middle-left middle-middle middle-right ;;; bottom-left bottom-middle bottom-right ;;; -(defparameter *banish-pointer-placement* 'bottom-right-child-placement) -(defparameter *second-mode-placement* 'top-middle-child-placement) -(defparameter *info-mode-placement* 'top-left-child-placement) -(defparameter *query-mode-placement* 'top-left-child-placement) -(defparameter *circulate-mode-placement* 'bottom-middle-child-placement) +(defparameter *banish-pointer-placement* 'bottom-right-placement) +(defparameter *second-mode-placement* 'top-middle-placement) +(defparameter *info-mode-placement* 'top-left-placement) +(defparameter *query-mode-placement* 'top-left-placement) +(defparameter *circulate-mode-placement* 'bottom-middle-placement) Modified: clfswm/src/xlib-util.lisp ============================================================================== --- clfswm/src/xlib-util.lisp (original) +++ clfswm/src/xlib-util.lisp Wed Jul 21 09:06:42 2010 @@ -143,11 +143,14 @@ (xlib:map-window window) (xlib:display-finish-output *display*)))) +(defun delete-window (window) + (send-client-message window :WM_PROTOCOLS + (xlib:intern-atom *display* "WM_DELETE_WINDOW")) + (xlib:display-finish-output *display*)) - - - - +(defun destroy-window (window) + (xlib:kill-client *display* (xlib:window-id window)) + (xlib:display-finish-output *display*)) From pbrochard at common-lisp.net Wed Jul 21 13:11:11 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Wed, 21 Jul 2010 09:11:11 -0400 Subject: [clfswm-cvs] r283 - in clfswm: . src Message-ID: Author: pbrochard Date: Wed Jul 21 09:11:10 2010 New Revision: 283 Log: src/binding*.lisp: Bind control+g to escape the current action like emacs. Modified: clfswm/ChangeLog clfswm/TODO clfswm/src/bindings-second-mode.lisp clfswm/src/clfswm-info.lisp clfswm/src/clfswm-query.lisp clfswm/src/clfswm-util.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Wed Jul 21 09:11:10 2010 @@ -1,5 +1,8 @@ 2010-07-21 Philippe Brochard + * src/binding*.lisp: Bind control+g to escape the current action + like emacs. + * src/clfswm-internal.lisp (delete-child-and-children-in-all-frames): New function and binding: Second mode - Control+Delete delete the current child and Modified: clfswm/TODO ============================================================================== --- clfswm/TODO (original) +++ clfswm/TODO Wed Jul 21 09:11:10 2010 @@ -7,8 +7,6 @@ =============== Should handle these soon. -- Bind control+g to escape all actions like emacs. - - Remote access to the clfswm REPL [Philippe] this can be done with net.lisp or via xprop (ie the Stumpwm way). Protocol: Modified: clfswm/src/bindings-second-mode.lisp ============================================================================== --- clfswm/src/bindings-second-mode.lisp (original) +++ clfswm/src/bindings-second-mode.lisp Wed Jul 21 09:11:10 2010 @@ -97,6 +97,7 @@ (define-second-key ("exclam") 'run-program-from-query-string) (define-second-key ("Return") 'leave-second-mode) (define-second-key ("Escape") 'leave-second-mode) + (define-second-key ("g" :control) 'leave-second-mode) (define-second-key ("t") 'tile-current-frame) (define-second-key ("Home" :mod-1 :control :shift) 'exit-clfswm) (define-second-key ("Right" :mod-1) 'select-next-brother) Modified: clfswm/src/clfswm-info.lisp ============================================================================== --- clfswm/src/clfswm-info.lisp (original) +++ clfswm/src/clfswm-info.lisp Wed Jul 21 09:11:10 2010 @@ -124,6 +124,7 @@ (define-info-key ("Return") 'leave-info-mode-and-valid) (define-info-key ("space") 'leave-info-mode-and-valid) (define-info-key ("Escape") 'leave-info-mode) + (define-info-key ("g" :control) 'leave-info-mode) (define-info-key ("twosuperior") (defun info-banish-pointer (info) "Move the pointer to the lower right corner of the screen" Modified: clfswm/src/clfswm-query.lisp ============================================================================== --- clfswm/src/clfswm-query.lisp (original) +++ clfswm/src/clfswm-query.lisp Wed Jul 21 09:11:10 2010 @@ -230,6 +230,7 @@ (defun set-default-query-keys () (define-query-key ("Return") 'leave-query-mode-valid) (define-query-key ("Escape") 'leave-query-mode) + (define-query-key ("g" :control) 'leave-query-mode) (define-query-key ("Tab") 'leave-query-mode-complet) (define-query-key ("BackSpace") 'query-backspace) (define-query-key ("BackSpace" :control) 'query-backspace-word) Modified: clfswm/src/clfswm-util.lisp ============================================================================== --- clfswm/src/clfswm-util.lisp (original) +++ clfswm/src/clfswm-util.lisp Wed Jul 21 09:11:10 2010 @@ -111,7 +111,7 @@ (when (equal window *current-child*) (setf *current-child* *current-root*)) (hide-child window) - (delete-child-and-children-in-all-frames window) + (delete-child-and-children-in-all-frames window close-fun) (show-all-children)))) (defun delete-focus-window () From pbrochard at common-lisp.net Wed Jul 21 20:39:30 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Wed, 21 Jul 2010 16:39:30 -0400 Subject: [clfswm-cvs] r284 - in clfswm: . src Message-ID: Author: pbrochard Date: Wed Jul 21 16:39:30 2010 New Revision: 284 Log: src/package.lisp: Add a placement configuration group. Modified: clfswm/ChangeLog clfswm/src/package.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Wed Jul 21 16:39:30 2010 @@ -1,5 +1,7 @@ 2010-07-21 Philippe Brochard + * src/package.lisp: Add a placement configuration group. + * src/binding*.lisp: Bind control+g to escape the current action like emacs. Modified: clfswm/src/package.lisp ============================================================================== --- clfswm/src/package.lisp (original) +++ clfswm/src/package.lisp Wed Jul 21 16:39:30 2010 @@ -243,7 +243,7 @@ "Config(Hook group): Hook executed when keys/buttons are bounds") (defparameter *loop-hook* nil - "Config(Hook group): Kook executed on each event loop") + "Config(Hook group): Hook executed on each event loop") (defparameter *in-second-mode* nil) @@ -262,11 +262,16 @@ ;;; middle-left middle-middle middle-right ;;; bottom-left bottom-middle bottom-right ;;; -(defparameter *banish-pointer-placement* 'bottom-right-placement) -(defparameter *second-mode-placement* 'top-middle-placement) -(defparameter *info-mode-placement* 'top-left-placement) -(defparameter *query-mode-placement* 'top-left-placement) -(defparameter *circulate-mode-placement* 'bottom-middle-placement) +(defparameter *banish-pointer-placement* 'bottom-right-placement + "Config(Placement group): Pointer banishment placement") +(defparameter *second-mode-placement* 'top-middle-placement + "Config(Placement group): Second mode window placement") +(defparameter *info-mode-placement* 'top-left-placement + "Config(Placement group): Info mode window placement") +(defparameter *query-mode-placement* 'top-left-placement + "Config(Placement group): Query mode window placement") +(defparameter *circulate-mode-placement* 'bottom-middle-placement + "Config(Placement group): Circulate mode window placement") From pbrochard at common-lisp.net Fri Jul 23 21:28:22 2010 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Fri, 23 Jul 2010 17:28:22 -0400 Subject: [clfswm-cvs] r285 - in clfswm: . src Message-ID: Author: pbrochard Date: Fri Jul 23 17:28:21 2010 New Revision: 285 Log: src/clfswm-util.lisp (delete-current-child): Invert bindings and menu entry between delete-current-child and remove-current-child. ie: Delete a child and its children in all frames by default. Modified: clfswm/ChangeLog clfswm/src/bindings-second-mode.lisp clfswm/src/clfswm-query.lisp clfswm/src/clfswm-util.lisp clfswm/src/menu-def.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Fri Jul 23 17:28:21 2010 @@ -1,3 +1,9 @@ +2010-07-23 Philippe Brochard + + * src/clfswm-util.lisp (delete-current-child): Invert bindings and + menu entry between delete-current-child and remove-current-child. + ie: Delete a child and its children in all frames by default. + 2010-07-21 Philippe Brochard * src/package.lisp: Add a placement configuration group. Modified: clfswm/src/bindings-second-mode.lisp ============================================================================== --- clfswm/src/bindings-second-mode.lisp (original) +++ clfswm/src/bindings-second-mode.lisp Fri Jul 23 17:28:21 2010 @@ -127,8 +127,8 @@ (define-second-key ("c" :control) 'copy-current-child) (define-second-key ("v" :control) 'paste-selection) (define-second-key ("v" :control :shift) 'paste-selection-no-clear) - (define-second-key ("Delete") 'remove-current-child) - (define-second-key ("Delete" :control) 'delete-current-child) + (define-second-key ("Delete" :control) 'remove-current-child) + (define-second-key ("Delete") 'delete-current-child) (define-shell (#\c) b-start-xterm "start an xterm" "exec xterm") (define-shell (#\e) b-start-emacs "start emacs" "exec emacs") (define-shell (#\e :control) b-start-emacsremote Modified: clfswm/src/clfswm-query.lisp ============================================================================== --- clfswm/src/clfswm-query.lisp (original) +++ clfswm/src/clfswm-query.lisp Fri Jul 23 17:28:21 2010 @@ -296,6 +296,7 @@ (xgrab-pointer *root* 66 67) (xungrab-pointer))) (when (member *query-return* '(:Return :Complet)) + (pushnew default *query-history* :test #'equal) (push *query-string* *query-history*)) (values *query-string* *query-return*)) Modified: clfswm/src/clfswm-util.lisp ============================================================================== --- clfswm/src/clfswm-util.lisp (original) +++ clfswm/src/clfswm-util.lisp Fri Jul 23 17:28:21 2010 @@ -206,7 +206,7 @@ (leave-second-mode)) (defun delete-current-child () - "Delete the current child and its children" + "Delete the current child and its children in all frames" (hide-all *current-child*) (delete-child-and-children-in-all-frames *current-child*) (leave-second-mode)) Modified: clfswm/src/menu-def.lisp ============================================================================== --- clfswm/src/menu-def.lisp (original) +++ clfswm/src/menu-def.lisp Fri Jul 23 17:28:21 2010 @@ -78,8 +78,8 @@ (add-menu-key 'child-menu "r" 'rename-current-child) (add-menu-key 'child-menu "e" 'ensure-unique-name) (add-menu-key 'child-menu "n" 'ensure-unique-number) -(add-menu-key 'child-menu "Delete" 'remove-current-child) -(add-menu-key 'child-menu "X" 'delete-current-child) +(add-menu-key 'child-menu "Delete" 'delete-current-child) +(add-menu-key 'child-menu "X" 'remove-current-child) (add-menu-key 'child-menu "h" 'hide-current-child) (add-menu-key 'child-menu "u" 'unhide-a-child) (add-menu-key 'child-menu "f" 'unhide-a-child-from-all-frames)