[clfswm-cvs] r98 - in clfswm: . src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Sun Apr 27 21:30:09 UTC 2008
Author: pbrochard
Date: Sun Apr 27 17:30:08 2008
New Revision: 98
Modified:
clfswm/ChangeLog
clfswm/TODO
clfswm/src/clfswm-util.lisp
clfswm/src/xlib-util.lisp
Log:
Unmanaged windows are now allowed to be moved or resized.
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Sun Apr 27 17:30:08 2008
@@ -1,3 +1,10 @@
+2008-04-27 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-util.lisp (mouse-focus-move/resize-generic): Allow to
+ move/resize unmanaged windows.
+
+ * src/xlib-util.lisp (move-window, resize-window): New functions.
+
2008-04-25 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-util.lisp (current-frame-manage-window-type): Let the
Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO (original)
+++ clfswm/TODO Sun Apr 27 17:30:08 2008
@@ -7,13 +7,10 @@
===============
Should handle these soon.
-- Allow to move/resize unmanaged windows (Alt+button 1/3) [Philippe]
-
- forced-managed-window/forced-unmanaged-window: new frame parameter [Philippe]
- Move window over frame (Alt+Control+B1) [Philippe]
-
LESS URGENT TODO
================
@@ -32,6 +29,7 @@
- Add boundaries in the info window [Philippe]
+- Show unmanaged windows only for *current-child* [Philippe]
MAYBE
=====
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Sun Apr 27 17:30:08 2008
@@ -497,80 +497,21 @@
;;; Mouse utilities
(defun move-frame (frame parent orig-x orig-y)
- (hide-all-children frame)
- (with-slots (window) frame
- (raise-window window)
- (let ((done nil)
- (dx (- (xlib:drawable-x window) orig-x))
- (dy (- (xlib:drawable-y window) orig-y)))
- (labels ((motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
- (declare (ignore event-slots))
- (setf (xlib:drawable-x window) (+ root-x dx)
- (xlib:drawable-y window) (+ root-y dy))
- (display-frame-info frame))
- (handle-event (&rest event-slots &key event-key &allow-other-keys)
- (case event-key
- (:motion-notify (apply #'motion-notify event-slots))
- (:button-release (setf done t))
- (:configure-request (call-hook *configure-request-hook* event-slots))
- (:configure-notify (call-hook *configure-notify-hook* event-slots))
- (:map-request (call-hook *map-request-hook* event-slots))
- (:unmap-notify (call-hook *unmap-notify-hook* event-slots))
- (:destroy-notify (call-hook *destroy-notify-hook* event-slots))
- (:mapping-notify (call-hook *mapping-notify-hook* event-slots))
- (:property-notify (call-hook *property-notify-hook* event-slots))
- (:create-notify (call-hook *create-notify-hook* event-slots))
- (:enter-notify (call-hook *enter-notify-hook* event-slots))
- (:exposure (call-hook *exposure-hook* event-slots)))
- t))
- (when frame
- (loop until done
- do (with-xlib-protect
- (xlib:display-finish-output *display*)
- (xlib:process-event *display* :handler #'handle-event))))
- (setf (frame-x frame) (x-px->fl (xlib:drawable-x window) parent)
- (frame-y frame) (y-px->fl (xlib:drawable-y window) parent))))))
+ (when frame
+ (hide-all-children frame)
+ (with-slots (window) frame
+ (move-window window orig-x orig-y #'display-frame-info (list frame))
+ (setf (frame-x frame) (x-px->fl (xlib:drawable-x window) parent)
+ (frame-y frame) (y-px->fl (xlib:drawable-y window) parent)))))
(defun resize-frame (frame parent orig-x orig-y)
- (hide-all-children frame)
- (with-slots (window) frame
- (raise-window window)
- (let ((done nil)
- (dx (- (xlib:drawable-x window) orig-x))
- (dy (- (xlib:drawable-y window) orig-y))
- (lx orig-x)
- (ly orig-y))
- (labels ((motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
- (declare (ignore event-slots))
- (setf (xlib:drawable-width window) (max (+ (xlib:drawable-width window) (- root-x lx)) 10)
- (xlib:drawable-height window) (max (+ (xlib:drawable-height window) (- root-y ly)) 10)
- dx (- dx (- root-x lx))
- dy (- dy (- root-y ly))
- lx root-x ly root-y)
- (display-frame-info frame))
- (handle-event (&rest event-slots &key event-key &allow-other-keys)
- (case event-key
- (:motion-notify (apply #'motion-notify event-slots))
- (:button-release (setf done t))
- (:configure-request (call-hook *configure-request-hook* event-slots))
- (:configure-notify (call-hook *configure-notify-hook* event-slots))
- (:map-request (call-hook *map-request-hook* event-slots))
- (:unmap-notify (call-hook *unmap-notify-hook* event-slots))
- (:destroy-notify (call-hook *destroy-notify-hook* event-slots))
- (:mapping-notify (call-hook *mapping-notify-hook* event-slots))
- (:property-notify (call-hook *property-notify-hook* event-slots))
- (:create-notify (call-hook *create-notify-hook* event-slots))
- (:enter-notify (call-hook *enter-notify-hook* event-slots))
- (:exposure (call-hook *exposure-hook* event-slots)))
- t))
- (when frame
- (loop until done
- do (with-xlib-protect
- (xlib:display-finish-output *display*)
- (xlib:process-event *display* :handler #'handle-event))))
- (setf (frame-w frame) (w-px->fl (xlib:drawable-width window) parent)
- (frame-h frame) (h-px->fl (xlib:drawable-height window) parent))))))
+ (when frame
+ (hide-all-children frame)
+ (with-slots (window) frame
+ (resize-window window orig-x orig-y #'display-frame-info (list frame))
+ (setf (frame-w frame) (w-px->fl (xlib:drawable-width window) parent)
+ (frame-h frame) (h-px->fl (xlib:drawable-height window) parent)))))
@@ -629,7 +570,12 @@
(xlib:map-window (frame-window child))
(pushnew child (frame-child *current-root*)))
(typecase child
- (xlib:window (funcall mouse-fn parent (find-parent-frame parent) root-x root-y))
+ (xlib:window
+ (if (managed-window-p child parent)
+ (funcall mouse-fn parent (find-parent-frame parent) root-x root-y)
+ (funcall(cond ((eql mouse-fn #'move-frame) #'move-window)
+ ((eql mouse-fn #'resize-frame) #'resize-window))
+ 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)))
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Sun Apr 27 17:30:08 2008
@@ -353,13 +353,15 @@
(setf pointer-grabbed t)
(let* ((white (xlib:make-color :red 1.0 :green 1.0 :blue 1.0))
(black (xlib:make-color :red 0.0 :green 0.0 :blue 0.0)))
- (setf cursor-font (xlib:open-font *display* "cursor")
- cursor (xlib:create-glyph-cursor :source-font cursor-font
- :source-char cursor-char
- :mask-font cursor-font
- :mask-char cursor-mask-char
- :foreground black
- :background white))
+ (if cursor-char
+ (setf cursor-font (xlib:open-font *display* "cursor")
+ cursor (xlib:create-glyph-cursor :source-font cursor-font
+ :source-char cursor-char
+ :mask-font cursor-font
+ :mask-char cursor-mask-char
+ :foreground black
+ :background white))
+ (setf cursor nil))
(xlib:grab-pointer root pointer-mask
:owner-p owner-p :sync-keyboard-p nil :sync-pointer-p nil :cursor cursor)))
@@ -443,6 +445,92 @@
+
+
+;;; Mouse action on window
+(defun move-window (window orig-x orig-y &optional additional-fn additional-arg)
+ (raise-window window)
+ (let ((done nil)
+ (dx (- (xlib:drawable-x window) orig-x))
+ (dy (- (xlib:drawable-y window) orig-y))
+ (pointer-grabbed-p (xgrab-pointer-p)))
+ (labels ((motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
+ (declare (ignore event-slots))
+ (setf (xlib:drawable-x window) (+ root-x dx)
+ (xlib:drawable-y window) (+ root-y dy))
+ (when additional-fn
+ (apply additional-fn additional-arg)))
+ (my-handle-event (&rest event-slots &key event-key &allow-other-keys)
+ (case event-key
+ (:motion-notify (apply #'motion-notify event-slots))
+ (:button-release (setf done t))
+ (:configure-request (call-hook *configure-request-hook* event-slots))
+ (:configure-notify (call-hook *configure-notify-hook* event-slots))
+ (:map-request (call-hook *map-request-hook* event-slots))
+ (:unmap-notify (call-hook *unmap-notify-hook* event-slots))
+ (:destroy-notify (call-hook *destroy-notify-hook* event-slots))
+ (:mapping-notify (call-hook *mapping-notify-hook* event-slots))
+ (:property-notify (call-hook *property-notify-hook* event-slots))
+ (:create-notify (call-hook *create-notify-hook* event-slots))
+ (:enter-notify (call-hook *enter-notify-hook* event-slots))
+ (:exposure (call-hook *exposure-hook* event-slots)))
+ t))
+ (unless pointer-grabbed-p
+ (xgrab-pointer *root* nil nil))
+ (loop until done
+ do (with-xlib-protect
+ (xlib:display-finish-output *display*)
+ (xlib:process-event *display* :handler #'my-handle-event)))
+ (unless pointer-grabbed-p
+ (xungrab-pointer)))))
+
+
+(defun resize-window (window orig-x orig-y &optional additional-fn additional-arg)
+ (raise-window window)
+ (let ((done nil)
+ (dx (- (xlib:drawable-x window) orig-x))
+ (dy (- (xlib:drawable-y window) orig-y))
+ (lx orig-x)
+ (ly orig-y)
+ (pointer-grabbed-p (xgrab-pointer-p)))
+ (labels ((motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
+ (declare (ignore event-slots))
+ (setf (xlib:drawable-width window) (max (+ (xlib:drawable-width window) (- root-x lx)) 10)
+ (xlib:drawable-height window) (max (+ (xlib:drawable-height window) (- root-y ly)) 10)
+ dx (- dx (- root-x lx))
+ dy (- dy (- root-y ly))
+ lx root-x ly root-y)
+ (when additional-fn
+ (apply additional-fn additional-arg)))
+ (handle-event (&rest event-slots &key event-key &allow-other-keys)
+ (case event-key
+ (:motion-notify (apply #'motion-notify event-slots))
+ (:button-release (setf done t))
+ (:configure-request (call-hook *configure-request-hook* event-slots))
+ (:configure-notify (call-hook *configure-notify-hook* event-slots))
+ (:map-request (call-hook *map-request-hook* event-slots))
+ (:unmap-notify (call-hook *unmap-notify-hook* event-slots))
+ (:destroy-notify (call-hook *destroy-notify-hook* event-slots))
+ (:mapping-notify (call-hook *mapping-notify-hook* event-slots))
+ (:property-notify (call-hook *property-notify-hook* event-slots))
+ (:create-notify (call-hook *create-notify-hook* event-slots))
+ (:enter-notify (call-hook *enter-notify-hook* event-slots))
+ (:exposure (call-hook *exposure-hook* event-slots)))
+ t))
+ (unless pointer-grabbed-p
+ (xgrab-pointer *root* nil nil))
+ (loop until done
+ do (with-xlib-protect
+ (xlib:display-finish-output *display*)
+ (xlib:process-event *display* :handler #'handle-event)))
+ (unless pointer-grabbed-p
+ (xungrab-pointer)))))
+
+
+
+
+
+
(defun get-color (color)
(xlib:alloc-color (xlib:screen-default-colormap *screen*) color))
More information about the clfswm-cvs
mailing list