[clfswm-cvs] r100 - in clfswm: . src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Mon Apr 28 21:14:49 UTC 2008
Author: pbrochard
Date: Mon Apr 28 17:14:48 2008
New Revision: 100
Modified:
clfswm/ChangeLog
clfswm/TODO
clfswm/src/bindings-second-mode.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/package.lisp
clfswm/src/tools.lisp
clfswm/src/xlib-util.lisp
Log:
manage-current-window, unmanage-current-window: New functions: Allow to force to manage or unmanage a window by its parent frame.
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Mon Apr 28 17:14:48 2008
@@ -1,3 +1,21 @@
+2008-04-28 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-util.lisp (manage-current-window)
+ (unmanage-current-window): New functions: Allow to force to manage
+ or unmanage a window by its parent frame.
+
+ * src/bindings-second-mode.lisp (#\o): binded to
+ set-open-in-new-frame-in-parent-frame-nw-hook and
+ (#\o :control) to set-open-in-new-frame-in-root-frame-nw-hook
+
+ * src/clfswm-util.lisp (with-current-window): New macro.
+
+ * src/xlib-util.lisp (move-window, resize-window): Remove uneeded
+ exposure and enter-window handle event.
+
+ * src/clfswm-util.lisp (move-frame, resize-frame): Show all
+ children for the current child after the move/resize.
+
2008-04-27 Philippe Brochard <pbrochard at common-lisp.net>
* src/xlib-util.lisp (resize-window): Take care of window size
Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO (original)
+++ clfswm/TODO Mon Apr 28 17:14:48 2008
@@ -61,3 +61,5 @@
- Hide/Unhide frame [Philippe]
- Undo/redo (any idea to implement this is welcome)
+
+- Double buffering for all text windows.
Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp (original)
+++ clfswm/src/bindings-second-mode.lisp Mon Apr 28 17:14:48 2008
@@ -141,6 +141,8 @@
(add-menu-key 'window-menu "i" 'display-current-window-info)
(add-menu-key 'window-menu "f" 'force-window-in-frame)
(add-menu-key 'window-menu "c" 'force-window-center-in-frame)
+(add-menu-key 'window-menu "m" 'manage-current-window)
+(add-menu-key 'window-menu "u" 'unmanage-current-window)
(add-menu-key 'window-menu "a" 'adapt-current-frame-to-window-hints)
(add-menu-key 'window-menu "w" 'adapt-current-frame-to-window-width-hint)
(add-menu-key 'window-menu "h" 'adapt-current-frame-to-window-height-hint)
@@ -239,7 +241,8 @@
(define-second-key (#\b :mod-1) 'banish-pointer)
-(define-second-key (#\o) 'set-open-in-new-frame-in-root-frame-nw-hook)
+(define-second-key (#\o) 'set-open-in-new-frame-in-parent-frame-nw-hook)
+(define-second-key (#\o :control) 'set-open-in-new-frame-in-root-frame-nw-hook)
;;;; Escape
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Mon Apr 28 17:14:48 2008
@@ -96,8 +96,14 @@
(defun managed-window-p (window frame)
"Return t only if window is managed by frame"
- (or (member :all (frame-managed-type frame))
- (member (window-type window) (frame-managed-type frame))))
+ (with-slots ((managed forced-managed-window)
+ (unmanaged forced-unmanaged-window)) frame
+ (and (not (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))
+ (member window managed)
+ (member (xlib:wm-name window) managed :test #'string-equal-p)))))
@@ -319,22 +325,22 @@
+;;; TODO: Double buffering for frame window
(defun display-frame-info (frame)
(let ((dy (+ (xlib:max-char-ascent *default-font*) (xlib:max-char-descent *default-font*))))
(with-slots (name number gc window child) frame
- (when (equal frame *current-root*)
- (xlib:clear-area window))
+ (xlib:clear-area window)
(setf (xlib:gcontext-foreground gc) (get-color (if (and (equal frame *current-root*)
(equal frame *current-child*))
"Red" "Green")))
(xlib:draw-image-glyphs window gc 5 dy
- (format nil "Frame: ~A~A "
+ (format nil "Frame: ~A~A"
number
(if name (format nil " - ~A" name) "")))
(let ((pos dy))
(when (equal frame *current-root*)
(xlib:draw-image-glyphs window gc 5 (incf pos dy)
- (format nil "~A hidden windows " (length (get-hidden-windows))))
+ (format nil "~A hidden windows" (length (get-hidden-windows))))
(when *child-selection*
(xlib:draw-image-glyphs window gc 5 (incf pos dy)
(with-output-to-string (str)
@@ -343,8 +349,7 @@
(typecase child
(xlib:window (format str "~A " (xlib:wm-name child)))
(frame (format str "frame:~A[~A] " (frame-number child)
- (aif (frame-name child) it "")))))
- (format str " ")))))
+ (aif (frame-name child) it "")))))))))
(dolist (ch child)
(when (xlib:window-p ch)
(xlib:draw-glyphs window gc 5 (incf pos dy) (ensure-printable (xlib:wm-name ch)))))))))
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Mon Apr 28 17:14:48 2008
@@ -443,32 +443,6 @@
-
-;;; Force window functions
-(defun force-window-in-frame ()
- "Force the current window to move in the frame (Useful only for transient windows)"
- (when (xlib:window-p *current-child*)
- (let ((parent (find-parent-frame *current-child*)))
- (with-xlib-protect
- (setf (xlib:drawable-x *current-child*) (frame-rx parent)
- (xlib:drawable-y *current-child*) (frame-ry parent)))))
- (leave-second-mode))
-
-(defun force-window-center-in-frame ()
- "Force the current window to move in the center of the frame (Useful only for transient windows)"
- (when (xlib:window-p *current-child*)
- (let ((parent (find-parent-frame *current-child*)))
- (with-xlib-protect
- (setf (xlib:drawable-x *current-child*) (truncate (+ (frame-rx parent)
- (/ (- (frame-rw parent)
- (xlib:drawable-width *current-child*)) 2)))
- (xlib:drawable-y *current-child*) (truncate (+ (frame-ry parent)
- (/ (- (frame-rh parent)
- (xlib:drawable-height *current-child*)) 2)))))))
- (leave-second-mode))
-
-
-
;;; Show frame info
(defun show-all-frames-info ()
"Show all frames info windows"
@@ -502,7 +476,8 @@
(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)))))
+ (frame-y frame) (y-px->fl (xlib:drawable-y window) parent)))
+ (show-all-children frame)))
(defun resize-frame (frame parent orig-x orig-y)
@@ -511,7 +486,8 @@
(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)))))
+ (frame-h frame) (h-px->fl (xlib:drawable-height window) parent)))
+ (show-all-children frame)))
@@ -850,15 +826,80 @@
+
+
+
+;;; Current window utilities
+(defun get-current-window ()
+ (typecase *current-child*
+ (xlib:window *current-child*)
+ (frame (first (frame-child *current-child*)))))
+
+(defmacro with-current-window (&body body)
+ "Bind 'window' to the current window"
+ `(let ((window (get-current-window)))
+ (when window
+ , at body)))
+
+
+
+
+
+;;; Force window functions
+(defun force-window-in-frame ()
+ "Force the current window to move in the frame (Useful only for transient 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)))))
+ (leave-second-mode))
+
+
+(defun force-window-center-in-frame ()
+ "Force the current window to move in the center of the frame (Useful only for transient 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)))))))
+ (leave-second-mode))
+
+
+
(defun display-current-window-info ()
"Display information on the current window"
- (let ((window (typecase *current-child*
- (xlib:window *current-child*)
- (frame (first (frame-child *current-child*))))))
- (when window
- (info-mode (list (format nil "Window: ~A" window)
- (format nil "Window name: ~A" (xlib:wm-name window))
- (format nil "Window class: ~A" (xlib:get-wm-class window))
- (format nil "Window type: ~:(~A~)" (window-type window))))))
+ (with-current-window
+ (info-mode (list (format nil "Window: ~A" window)
+ (format nil "Window name: ~A" (xlib:wm-name window))
+ (format nil "Window class: ~A" (xlib:get-wm-class window))
+ (format nil "Window type: ~:(~A~)" (window-type window)))))
+ (leave-second-mode))
+
+
+(defun manage-current-window ()
+ "Force to manage the current window by its parent frame"
+ (with-current-window
+ (let ((parent (find-parent-frame window)))
+ (with-slots ((managed forced-managed-window)
+ (unmanaged forced-unmanaged-window)) parent
+ (setf unmanaged (remove window unmanaged)
+ unmanaged (remove (xlib:wm-name window) unmanaged :test #'string-equal-p))
+ (pushnew window managed))))
+ (leave-second-mode))
+
+(defun unmanage-current-window ()
+ "Force to not manage the current window by its parent frame"
+ (with-current-window
+ (let ((parent (find-parent-frame window)))
+ (with-slots ((managed forced-managed-window)
+ (unmanaged forced-unmanaged-window)) parent
+ (setf managed (remove window managed)
+ managed (remove (xlib:wm-name window) managed :test #'string-equal-p))
+ (pushnew window unmanaged))))
(leave-second-mode))
Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp (original)
+++ clfswm/src/package.lisp Mon Apr 28 17:14:48 2008
@@ -90,6 +90,14 @@
(managed-type :initarg :managed-type :accessor frame-managed-type
:initform *default-managed-type*
:documentation "Managed window type")
+ (forced-managed-window :initarg :forced-managed-window
+ :accessor frame-forced-managed-window
+ :initform nil
+ :documentation "A list of forced managed windows (wm-name or window)")
+ (forced-unmanaged-window :initarg :forced-unmanaged-window
+ :accessor frame-forced-unmanaged-window
+ :initform nil
+ :documentation "A list of forced unmanaged windows (wm-name or window)")
(window :initarg :window :accessor frame-window :initform nil)
(gc :initarg :gc :accessor frame-gc :initform nil)
(child :initarg :child :accessor frame-child :initform nil)
Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp (original)
+++ clfswm/src/tools.lisp Mon Apr 28 17:14:48 2008
@@ -41,6 +41,7 @@
:ensure-list
:ensure-printable
:ensure-n-elems
+ :string-equal-p
:find-assoc-word
:print-space
:escape-string
@@ -207,7 +208,9 @@
(cond ((= length n) list)
((< length n) (ensure-n-elems (append list '(nil)) n))
((> length n) (ensure-n-elems (butlast list) n)))))
-
+
+(defun string-equal-p (x y)
+ (when (stringp y) (string-equal x y)))
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Mon Apr 28 17:14:48 2008
@@ -459,7 +459,7 @@
(setf (xlib:drawable-x window) (+ root-x dx)
(xlib:drawable-y window) (+ root-y dy))
(when additional-fn
- (apply additional-fn additional-arg)))
+ (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))
@@ -471,9 +471,7 @@
(: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)))
+ (:create-notify (call-hook *create-notify-hook* event-slots)))
t))
(unless pointer-grabbed-p
(xgrab-pointer *root* nil nil))
@@ -506,7 +504,7 @@
dy (- dy (- root-y ly))
lx root-x ly root-y)
(when additional-fn
- (apply additional-fn additional-arg)))
+ (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))
@@ -518,9 +516,7 @@
(: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)))
+ (:create-notify (call-hook *create-notify-hook* event-slots)))
t))
(unless pointer-grabbed-p
(xgrab-pointer *root* nil nil))
More information about the clfswm-cvs
mailing list