[clfswm-cvs] r58 - in clfswm: . src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Fri Mar 28 23:23:47 UTC 2008
Author: pbrochard
Date: Fri Mar 28 18:23:43 2008
New Revision: 58
Modified:
clfswm/ChangeLog
clfswm/TODO
clfswm/clfswm.asd
clfswm/src/bindings-second-mode.lisp
clfswm/src/bindings.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-layout.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/tools.lisp
Log:
Mouse move and resize. New functions for coordinates conversions
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Fri Mar 28 18:23:43 2008
@@ -1,3 +1,13 @@
+2008-03-28 Philippe Brochard <hocwp at free.fr>
+
+ * src/clfswm-util.lisp (mouse-click-to-focus-and-move)
+ (mouse-click-to-focus-and-resize): New functions.
+
+ * src/clfswm-internal.lisp (*-fl->px): Convert float coordinates to pixel.
+ (*-px->fl): Convert pixel coordinates to float.
+
+ * src/tools.lisp (call-hook): Move call-hook to tools.lisp.
+
2008-03-27 Philippe Brochard <hocwp at free.fr>
* src/clfswm-layout.lisp (no-layout): Use :first-only to raise only the
Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO (original)
+++ clfswm/TODO Fri Mar 28 18:23:43 2008
@@ -8,7 +8,9 @@
Should handle these soon.
Rewrote all useful code present in 0801 version.
-- mouse operations [Philippe]
+
+- mouse operations: A beginnig is done. Now in second mode: focus child+ resize/move window's father [Philippe]
+
- Hide a window when its size is less than hint minimal size. [Philippe]
- Bind alt+1/2/3/4... to a particular child: [Philippe]
If bind exist -> focus this child
@@ -21,8 +23,6 @@
- Ensure-unique-number/name (new function) [Philippe]
-- Float->Screen Screen->Float: convert geometry from 0 to 1 to pixel and from pixel to 0 to 1. [Philippe]
-
- Raise/lower frame [Philippe]
- Hide/Unhide frame [Philippe]
@@ -33,8 +33,6 @@
get-frame-by-name (path): return the frame that its own frame has this name if it exists such a frame
get-window-by-name (path): return the window that its own frame that its own frame has this name if it exists such a window.
-- A better algorithm to display all children (ie: raise just needed children and with less filckering)
-
MAYBE
=====
Modified: clfswm/clfswm.asd
==============================================================================
--- clfswm/clfswm.asd (original)
+++ clfswm/clfswm.asd Fri Mar 28 18:23:43 2008
@@ -43,13 +43,13 @@
(:file "clfswm-query"
:depends-on ("package" "config"))
(:file "clfswm-layout"
- :depends-on ("package" "clfswm-util" "clfswm-info"))
+ :depends-on ("package" "clfswm-internal" "clfswm-util" "clfswm-info"))
(:file "clfswm-pack"
:depends-on ("clfswm" "clfswm-util" "clfswm-second-mode"))
(:file "clfswm-nw-hooks"
:depends-on ("package" "clfswm-util" "clfswm-info"))
(:file "bindings"
- :depends-on ("clfswm" "clfswm-internal"))
+ :depends-on ("clfswm" "clfswm-internal" "clfswm-util"))
(:file "bindings-second-mode"
:depends-on ("clfswm" "clfswm-util" "clfswm-query" "bindings" "clfswm-pack"))))))
Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp (original)
+++ clfswm/src/bindings-second-mode.lisp Fri Mar 28 18:23:43 2008
@@ -361,11 +361,20 @@
;;; Mouse action
-(defun sm-mouse-click-to-focus (window root-x root-y)
- "Give the focus to the clicked child"
+(defun sm-mouse-click-to-focus-and-move (window root-x root-y)
+ "Move and focus the current child"
(declare (ignore window))
(let ((win (find-window-under-mouse root-x root-y)))
- (mouse-click-to-focus win root-x root-y)))
+ (unless (equal win (frame-window *current-root*))
+ (mouse-click-to-focus-and-move win root-x root-y))))
+
+
+(defun sm-mouse-click-to-focus-and-resize (window root-x root-y)
+ "Resize and focus the current child"
+ (declare (ignore window))
+ (let ((win (find-window-under-mouse root-x root-y)))
+ (unless (equal win (frame-window *current-root*))
+ (mouse-click-to-focus-and-resize win root-x root-y))))
@@ -400,7 +409,8 @@
-(define-second-mouse (1) 'sm-mouse-click-to-focus)
+(define-second-mouse (1) 'sm-mouse-click-to-focus-and-move)
+(define-second-mouse (3) 'sm-mouse-click-to-focus-and-resize)
(define-second-mouse (4) 'sm-mouse-select-next-level)
(define-second-mouse (5) 'sm-mouse-select-previous-level)
Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp (original)
+++ clfswm/src/bindings.lisp Fri Mar 28 18:23:43 2008
@@ -79,97 +79,8 @@
;;; Mouse actions
-
-;;handle-configure-request
-
-(defun move-frame (frame orig-x orig-y)
- (hide-all-children frame)
- (with-slots (window) frame
- (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 (frame-window frame)) (+ root-x dx)
- (xlib:drawable-y (frame-window frame)) (+ 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)))))
- (when frame
- (loop until done
- do (with-xlib-protect
- (xlib:display-finish-output *display*)
- (xlib:process-event *display* :handler #'handle-event)))))))
- (show-all-children))
-
-
-
-(defun mouse-click-to-focus (window root-x root-y)
- "Focus the current frame or the current window father"
- (let ((to-replay t)
- (child window)
- (father (find-father-frame window *current-root*)))
- (unless father
- (setf child (find-frame-window window *current-root*)
- father (find-father-frame child *current-root*))
- (when child
- (move-frame child root-x root-y)))
- (when (and child father (focus-all-children child father))
- (show-all-children)
- (setf to-replay nil))
- (if to-replay
- (replay-button-event)
- (stop-button-event))))
-
-
-(defun test-mouse-binding (window root-x root-y)
- (dbg window root-x root-y)
- (replay-button-event))
-
-
-
-(defun mouse-select-next-level (window root-x root-y)
- "Select the next level in frame"
- (declare (ignore root-x root-y))
- (let ((frame (find-frame-window window)))
- (when (or frame (xlib:window-equal window *root*))
- (select-next-level))
- (replay-button-event)))
-
-
-
-(defun mouse-select-previous-level (window root-x root-y)
- "Select the previous level in frame"
- (declare (ignore root-x root-y))
- (let ((frame (find-frame-window window)))
- (when (or frame (xlib:window-equal window *root*))
- (select-previous-level))
- (replay-button-event)))
-
-
-
-(defun mouse-enter-frame (window root-x root-y)
- "Enter in the selected frame - ie make it the root frame"
- (declare (ignore root-x root-y))
- (let ((frame (find-frame-window window)))
- (when (or frame (xlib:window-equal window *root*))
- (enter-frame))
- (replay-button-event)))
-
-
-
-(defun mouse-leave-frame (window root-x root-y)
- "Leave the selected frame - ie make its father the root frame"
- (declare (ignore root-x root-y))
- (let ((frame (find-frame-window window)))
- (when (or frame (xlib:window-equal window *root*))
- (leave-frame))
- (replay-button-event)))
-
-
-(define-main-mouse (1) 'mouse-click-to-focus)
+(define-main-mouse (1) 'mouse-click-to-focus-and-move)
+(define-main-mouse (3) 'mouse-click-to-focus-and-resize)
(define-main-mouse (4) 'mouse-select-next-level)
(define-main-mouse (5) 'mouse-select-previous-level)
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Fri Mar 28 18:23:43 2008
@@ -26,19 +26,43 @@
(in-package :clfswm)
-;;; Minimal hook
-(defun call-hook (hook &optional args)
- "Call a hook (a function, a symbol or a list of functions)
-Return the result of the last hook"
- (let ((result nil))
- (labels ((rec (hook)
- (when hook
- (typecase hook
- (cons (dolist (h hook)
- (rec h)))
- (t (setf result (apply hook args)))))))
- (rec hook)
- result)))
+;;; Conversion functions
+;;; Float -> Pixel conversion
+(defun x-fl->px (x father)
+ "Convert float X coordinate to pixel"
+ (round (+ (* x (frame-rw father)) (frame-rx father))))
+
+(defun y-fl->px (y father)
+ "Convert float Y coordinate to pixel"
+ (round (+ (* y (frame-rh father)) (frame-ry father))))
+
+(defun w-fl->px (w father)
+ "Convert float Width coordinate to pixel"
+ (round (* w (frame-rw father))))
+
+(defun h-fl->px (h father)
+ "Convert float Height coordinate to pixel"
+ (round (* h (frame-rh father))))
+
+;;; Pixel -> Float conversion
+(defun x-px->fl (x father)
+ "Convert pixel X coordinate to float"
+ (/ (- x (frame-rx father)) (frame-rw father)))
+
+(defun y-px->fl (y father)
+ "Convert pixel Y coordinate to float"
+ (/ (- y (frame-ry father)) (frame-rh father)))
+
+(defun w-px->fl (w father)
+ "Convert pixel Width coordinate to float"
+ (/ w (frame-rw father)))
+
+(defun h-px->fl (h father)
+ "Convert pixel Height coordinate to float"
+ (/ h (frame-rh father)))
+
+
+
@@ -555,14 +579,21 @@
(rec child father))
change))
-(defun set-current-child (child father)
- "Set *current-child* to child - Return t if something has change"
- (cond ((and (frame-p child) (not (equal *current-child* child)))
- (setf *current-child* child)
- t)
- ((and (frame-p father) (not (equal *current-child* father)))
- (setf *current-child* father)
- t)))
+
+(defgeneric set-current-child (child father))
+
+(defmethod set-current-child ((child xlib:window) father)
+ (unless (equal *current-child* father)
+ (setf *current-child* father)
+ t))
+
+(defmethod set-current-child ((child frame) father)
+ (declare (ignore father))
+ (unless (equal *current-child* child)
+ (setf *current-child* child)
+ t))
+
+
(defun set-current-root (father)
"Set current root if father is not in current root"
@@ -624,22 +655,6 @@
-;;(defun do-all-frames-nw-hook (window)
-;; "Call nw-hook of each frame. A hook must return one value or a list of two values.
-;;If the value or the first value is true then the default nw-hook is not executed.
-;;If the second value is true then no more frame can do an action with the window (ie leave the loop)."
-;; (let ((result nil))
-;; (with-all-frames (*root-frame* frame)
-;; (let ((ret (call-hook (frame-nw-hook frame) (list frame window))))
-;; (typecase ret
-;; (cons (when (first ret)
-;; (setf result t))
-;; (when (second ret)
-;; (return-from do-all-frames-nw-hook result)))
-;; (t (when ret
-;; (setf result t))))))
-;; result))
-
(defun do-all-frames-nw-hook (window)
"Call nw-hook of each frame."
(let ((found nil))
@@ -673,10 +688,10 @@
-;;(defun hide-existing-windows (screen)
-;; "Hide all existing windows in screen"
-;; (dolist (win (xlib:query-tree (xlib:screen-root screen)))
-;; (hide-window win)))
+(defun hide-existing-windows (screen)
+ "Hide all existing windows in screen"
+ (dolist (win (xlib:query-tree (xlib:screen-root screen)))
+ (hide-window win)))
(defun process-existing-windows (screen)
"Windows present when clfswm starts up must be absorbed by clfswm."
Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp (original)
+++ clfswm/src/clfswm-layout.lisp Fri Mar 28 18:23:43 2008
@@ -79,13 +79,13 @@
:first-only)))
(defmethod no-layout ((child frame) father)
- (with-slots ((cx x) (cy y) (cw w) (ch h)) child
- (with-slots ((frx rx) (fry ry) (frw rw) (frh rh)) father
- (values (round (+ (* cx frw) frx))
- (round (+ (* cy frh) fry))
- (round (* cw frw))
- (round (* ch frh))
- :first-only))))
+ (values (x-fl->px (frame-x child) father)
+ (y-fl->px (frame-y child) father)
+ (w-fl->px (frame-w child) father)
+ (h-fl->px (frame-h child) father)
+ :first-only))
+
+
(defun set-no-layout ()
"Maximize windows in there frame - leave frame to there size (no layout)"
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Fri Mar 28 18:23:43 2008
@@ -120,7 +120,7 @@
(defun find-window-under-mouse (x y)
"Return the child window under the mouse"
(with-xlib-protect
- (let ((win nil))
+ (let ((win *root*))
(with-all-windows-frames (*current-root* child)
(when (and (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
(<= (xlib:drawable-y child) y (+ (xlib:drawable-y child) (xlib:drawable-height child))))
@@ -486,6 +486,143 @@
+
+
+;;; Mouse utilities
+(defun move-frame (frame father 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)))
+ 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) father)
+ (frame-y frame) (y-px->fl (xlib:drawable-y window) father))
+ (show-all-children)))))
+
+
+(defun resize-frame (frame father 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)))
+ 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) father)
+ (frame-h frame) (h-px->fl (xlib:drawable-height window) father))
+ (show-all-children)))))
+
+
+
+(defun mouse-click-to-focus-generic (window root-x root-y mouse-fn)
+ "Focus the current frame or focus the current window father
+mouse-fun is #'move-frame or #'resize-frame"
+ (let ((to-replay t)
+ (child window)
+ (father (find-father-frame window *current-root*)))
+ (unless father
+ (setf child (find-frame-window window *current-root*)
+ father (find-father-frame child *current-root*))
+ (when child
+ (funcall mouse-fn child father root-x root-y)))
+ (when (and child father (focus-all-children child father))
+ (show-all-children)
+ (setf to-replay nil))
+ (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 father"
+ (mouse-click-to-focus-generic window root-x root-y #'move-frame))
+
+(defun mouse-click-to-focus-and-resize (window root-x root-y)
+ "Resize and focus the current frame or focus the current window father"
+ (mouse-click-to-focus-generic window root-x root-y #'resize-frame))
+
+
+
+(defun test-mouse-binding (window root-x root-y)
+ (dbg window root-x root-y)
+ (replay-button-event))
+
+
+
+(defun mouse-select-next-level (window root-x root-y)
+ "Select the next level in frame"
+ (declare (ignore root-x root-y))
+ (let ((frame (find-frame-window window)))
+ (when (or frame (xlib:window-equal window *root*))
+ (select-next-level))
+ (replay-button-event)))
+
+
+
+(defun mouse-select-previous-level (window root-x root-y)
+ "Select the previous level in frame"
+ (declare (ignore root-x root-y))
+ (let ((frame (find-frame-window window)))
+ (when (or frame (xlib:window-equal window *root*))
+ (select-previous-level))
+ (replay-button-event)))
+
+
+
+(defun mouse-enter-frame (window root-x root-y)
+ "Enter in the selected frame - ie make it the root frame"
+ (declare (ignore root-x root-y))
+ (let ((frame (find-frame-window window)))
+ (when (or frame (xlib:window-equal window *root*))
+ (enter-frame))
+ (replay-button-event)))
+
+
+
+(defun mouse-leave-frame (window root-x root-y)
+ "Leave the selected frame - ie make its father the root frame"
+ (declare (ignore root-x root-y))
+ (let ((frame (find-frame-window window)))
+ (when (or frame (xlib:window-equal window *root*))
+ (leave-frame))
+ (replay-button-event)))
+
+
+
;;;;;,-----
;;;;;| Various definitions
;;;;;`-----
@@ -496,369 +633,10 @@
;; *arrow-action* nil
;; *pager-arrow-action* nil))
;;
-;;(defun rotate-window-up ()
-;; "Rotate up windows in the current frame"
-;; (setf (frame-window-list (current-frame))
-;; (rotate-list (frame-window-list (current-frame))))
-;; (adapt-window-to-frame (current-window) (current-frame))
-;; (focus-window (current-window))
-;; (show-all-frame (current-workspace)))
-;;
-;;(defun rotate-window-down ()
-;; "Rotate down windows in the current frame"
-;; (setf (frame-window-list (current-frame))
-;; (anti-rotate-list (frame-window-list (current-frame))))
-;; (adapt-window-to-frame (current-window) (current-frame))
-;; (focus-window (current-window))
-;; (show-all-frame (current-workspace)))
-;;
-;;
-;;(defun maximize-frame (frame)
-;; "Maximize the frame"
-;; (when frame
-;; (unless (frame-fullscreenp frame)
-;; (setf (frame-fullscreenp frame) t)
-;; (show-all-windows-in-workspace (current-workspace)))))
-;;
-;;(defun minimize-frame (frame)
-;; "Minimize the frame"
-;; (when frame
-;; (when (frame-fullscreenp frame)
-;; (setf (frame-fullscreenp frame) nil)
-;; (show-all-windows-in-workspace (current-workspace)))))
-;;
-;;(defun toggle-maximize-frame (frame)
-;; "Maximize/minimize a frame"
-;; (if (frame-fullscreenp frame)
-;; (minimize-frame frame)
-;; (maximize-frame frame)))
-;;
-;;
-;;(defun toggle-maximize-current-frame ()
-;; "Maximize/minimize the current frame"
-;; (toggle-maximize-frame (current-frame)))
-;;
-;;
-;;(defun renumber-workspaces ()
-;; "Reset workspaces numbers (1 for current workspace, 2 for the second...) "
-;; (hide-all-windows-in-workspace (current-workspace))
-;; (setf *current-workspace-number* 0)
-;; (loop for workspace in *workspace-list* do
-;; (setf (workspace-number workspace) (incf *current-workspace-number*)))
-;; (show-all-windows-in-workspace (current-workspace)))
-;;
-;;
-;;(defun sort-workspaces ()
-;; "Sort workspaces by numbers"
-;; (hide-all-windows-in-workspace (current-workspace))
-;; (setf *workspace-list* (sort *workspace-list*
-;; #'(lambda (x y)
-;; (< (workspace-number x) (workspace-number y)))))
-;; (show-all-windows-in-workspace (current-workspace)))
-;;
-;;
-;;
-;;
-;;(defun circulate-frame-up ()
-;; "Circulate up in frame"
-;; (banish-pointer)
-;; (minimize-frame (current-frame))
-;; (no-focus)
-;; (setf (workspace-frame-list (current-workspace))
-;; (rotate-list (workspace-frame-list (current-workspace))))
-;; (adapt-window-to-frame (current-window) (current-frame))
-;; (focus-window (current-window))
-;; (show-all-frame (current-workspace)))
-;;
-;;
-;;(defun circulate-frame-up-move-window ()
-;; "Circulate up in frame moving the current window in the next frame"
-;; (banish-pointer)
-;; (minimize-frame (current-frame))
-;; (no-focus)
-;; (let ((window (current-window)))
-;; (remove-window-in-frame window (current-frame))
-;; (focus-window (current-window))
-;; (setf (workspace-frame-list (current-workspace))
-;; (rotate-list (workspace-frame-list (current-workspace))))
-;; (add-window-in-frame window (current-frame)))
-;; (adapt-window-to-frame (current-window) (current-frame))
-;; (focus-window (current-window))
-;; (show-all-frame (current-workspace)))
-;;
-;;(defun circulate-frame-up-copy-window ()
-;; "Circulate up in frame copying the current window in the next frame"
-;; (banish-pointer)
-;; (minimize-frame (current-frame))
-;; (no-focus)
-;; (let ((window (current-window)))
-;; (setf (workspace-frame-list (current-workspace))
-;; (rotate-list (workspace-frame-list (current-workspace))))
-;; (unless (window-already-in-workspace window (current-workspace))
-;; (add-window-in-frame window (current-frame))))
-;; (adapt-window-to-frame (current-window) (current-frame))
-;; (focus-window (current-window))
-;; (show-all-frame (current-workspace)))
-;;
-;;
-;;
-;;(defun circulate-frame-down ()
-;; "Circulate down in frame"
-;; (banish-pointer)
-;; (minimize-frame (current-frame))
-;; (no-focus)
-;; (setf (workspace-frame-list (current-workspace))
-;; (anti-rotate-list (workspace-frame-list (current-workspace))))
-;; (adapt-window-to-frame (current-window) (current-frame))
-;; (focus-window (current-window))
-;; (show-all-frame (current-workspace)))
-;;
-;;(defun circulate-frame-down-move-window ()
-;; "Circulate down in frame moving the current window in the next frame"
-;; (banish-pointer)
-;; (minimize-frame (current-frame))
-;; (no-focus)
-;; (let ((window (current-window)))
-;; (remove-window-in-frame window (current-frame))
-;; (focus-window (current-window))
-;; (setf (workspace-frame-list (current-workspace))
-;; (anti-rotate-list (workspace-frame-list (current-workspace))))
-;; (add-window-in-frame window (current-frame)))
-;; (adapt-window-to-frame (current-window) (current-frame))
-;; (focus-window (current-window))
-;; (show-all-frame (current-workspace)))
-;;
-;;(defun circulate-frame-down-copy-window ()
-;; "Circulate down in frame copying the current window in the next frame"
-;; (banish-pointer)
-;; (minimize-frame (current-frame))
-;; (no-focus)
-;; (let ((window (current-window)))
-;; (setf (workspace-frame-list (current-workspace))
-;; (anti-rotate-list (workspace-frame-list (current-workspace))))
-;; (unless (window-already-in-workspace window (current-workspace))
-;; (add-window-in-frame window (current-frame))))
-;; (adapt-window-to-frame (current-window) (current-frame))
-;; (focus-window (current-window))
-;; (show-all-frame (current-workspace)))
-;;
-;;
-;;
-;;
-;;
-;;(defun circulate-workspace-by-number (number)
-;; "Focus a workspace given its number"
-;; (no-focus)
-;; (hide-all-windows-in-workspace (current-workspace))
-;; (dotimes (i (length *workspace-list*))
-;; (when (= (workspace-number (current-workspace)) number)
-;; (return))
-;; (setf *workspace-list* (rotate-list *workspace-list*)))
-;; (show-all-windows-in-workspace (current-workspace)))
-;;
-;;
-;;(defun circulate-workspace-up ()
-;; "Circulate up in workspace"
-;; (no-focus)
-;; (hide-all-windows-in-workspace (current-workspace))
-;; (setf *workspace-list* (rotate-list *workspace-list*))
-;; (show-all-windows-in-workspace (current-workspace)))
-;;
-;;(defun circulate-workspace-up-move-frame ()
-;; "Circulate up in workspace moving current frame in the next workspace"
-;; (no-focus)
-;; (hide-all-windows-in-workspace (current-workspace))
-;; (let ((frame (current-frame)))
-;; (remove-frame-in-workspace frame (current-workspace))
-;; (setf *workspace-list* (rotate-list *workspace-list*))
-;; (add-frame-in-workspace (copy-frame frame) (current-workspace)))
-;; (show-all-windows-in-workspace (current-workspace)))
-;;
-;;(defun circulate-workspace-up-copy-frame ()
-;; "Circulate up in workspace copying current frame in the next workspace"
-;; (no-focus)
-;; (hide-all-windows-in-workspace (current-workspace))
-;; (let ((frame (current-frame)))
-;; (setf *workspace-list* (rotate-list *workspace-list*))
-;; (unless (frame-windows-already-in-workspace frame (current-workspace))
-;; (add-frame-in-workspace (copy-frame frame) (current-workspace))))
-;; (show-all-windows-in-workspace (current-workspace)))
-;;
-;;
-;;
-;;(defun circulate-workspace-down ()
-;; "Circulate down in workspace"
-;; (no-focus)
-;; (hide-all-windows-in-workspace (current-workspace))
-;; (setf *workspace-list* (anti-rotate-list *workspace-list*))
-;; (show-all-windows-in-workspace (current-workspace)))
-;;
-;;(defun circulate-workspace-down-move-frame ()
-;; "Circulate down in workspace moving current frame in the next workspace"
-;; (no-focus)
-;; (hide-all-windows-in-workspace (current-workspace))
-;; (let ((frame (current-frame)))
-;; (remove-frame-in-workspace frame (current-workspace))
-;; (setf *workspace-list* (anti-rotate-list *workspace-list*))
-;; (add-frame-in-workspace (copy-frame frame) (current-workspace)))
-;; (show-all-windows-in-workspace (current-workspace)))
-;;
-;;(defun circulate-workspace-down-copy-frame ()
-;; "Circulate down in workspace copying current frame in the next workspace"
-;; (no-focus)
-;; (hide-all-windows-in-workspace (current-workspace))
-;; (let ((frame (current-frame)))
-;; (setf *workspace-list* (anti-rotate-list *workspace-list*))
-;; (unless (frame-windows-already-in-workspace frame (current-workspace))
-;; (add-frame-in-workspace (copy-frame frame) (current-workspace))))
-;; (show-all-windows-in-workspace (current-workspace)))
-;;
-;;
-;;
-;;(defun delete-current-window ()
-;; "Delete the current window in all frames and workspaces"
-;; (let ((window (current-window)))
-;; (when window
-;; (no-focus)
-;; (remove-window-in-all-workspace window)
-;; (send-client-message window :WM_PROTOCOLS
-;; (intern-atom *display* "WM_DELETE_WINDOW"))))
-;; (focus-window (current-window))
-;; (show-all-frame (current-workspace)))
-;;
-;;
-;;(defun destroy-current-window ()
-;; "Destroy the current window in all frames and workspaces"
-;; (let ((window (current-window)))
-;; (when window
-;; (no-focus)
-;; (remove-window-in-all-workspace window)
-;; (kill-client *display* (xlib:window-id window))))
-;; (focus-window (current-window))
-;; (show-all-frame (current-workspace)))
-;;
-;;(defun remove-current-window ()
-;; "Remove the current window in the current frame"
-;; (let ((window (current-window)))
-;; (when window
-;; (no-focus)
-;; (hide-window window)
-;; (remove-window-in-frame (current-window) (current-frame))))
-;; (focus-window (current-window))
-;; (show-all-frame (current-workspace)))
-;;
-;;(defun remove-current-frame ()
-;; "Remove the current frame in the current workspace"
-;; (minimize-frame (current-frame))
-;; (let ((frame (current-frame)))
-;; (when frame
-;; (no-focus)
-;; (dolist (window (frame-window-list frame))
-;; (when window
-;; (hide-window window)))
-;; (remove-frame-in-workspace frame (current-workspace))))
-;; (focus-window (current-window))
-;; (show-all-frame (current-workspace)))
-;;
-;;(defun remove-current-workspace ()
-;; "Remove the current workspace"
-;; (let ((workspace (current-workspace)))
-;; (when workspace
-;; (hide-all-windows-in-workspace workspace)
-;; (remove-workspace workspace)
-;; (show-all-windows-in-workspace (current-workspace)))))
-;;
-;;
-;;(defun unhide-all-windows-in-current-frame ()
-;; "Unhide all hidden windows into the current frame"
-;; (let ((all-windows (get-all-windows))
-;; (hidden-windows (remove-if-not #'window-hidden-p
-;; (copy-list (xlib:query-tree *root*))))
-;; (current-frame (current-frame)))
-;; (dolist (window (set-difference hidden-windows all-windows))
-;; (unhide-window window)
-;; (process-new-window window)
-;; (xlib:map-window window)
-;; (adapt-window-to-frame window current-frame)))
-;; (focus-window (current-window))
-;; (show-all-frame (current-workspace)))
-;;
-;;
-;;
-;;
-;;(defun create-new-default-frame ()
-;; "Create a new default frame"
-;; (minimize-frame (current-frame))
-;; (add-frame-in-workspace (copy-frame *default-frame*)
-;; (current-workspace))
-;; (show-all-windows-in-workspace (current-workspace)))
-;;
-;;
-;;(defun create-new-default-workspace ()
-;; "Create a new default workspace"
-;; (hide-all-windows-in-workspace (current-workspace))
-;; (add-workspace (create-default-workspace))
-;; (show-all-windows-in-workspace (current-workspace)))
-;;
-;;
-;;
-;;
-;;;;;,-----
-;;;;;| Frame moving
-;;;;;`-----
-;;(defun move-frame (frame dx dy)
-;; "Move frame"
-;; (setf (frame-x frame) (+ (frame-x frame) dx)
-;; (frame-y frame) (+ (frame-y frame) dy))
-;; (dolist (window (frame-window-list frame))
-;; (adapt-window-to-frame window frame))
-;; (show-all-frame (current-workspace)))
-;;
-;;(defun move-frame-to (frame x y)
-;; "Move frame to"
-;; (setf (frame-x frame) x
-;; (frame-y frame) y)
-;; (dolist (window (frame-window-list frame))
-;; (adapt-window-to-frame window frame))
-;; (focus-window (current-window))
-;; (show-all-frame (current-workspace)))
-;;
-;;
-;;(defun resize-frame (frame dx dy)
-;; "Resize frame"
-;; (setf (frame-width frame) (max (+ (frame-width frame) dx) 100)
-;; (frame-height frame) (max (+ (frame-height frame) dy) 100))
-;; (dolist (window (frame-window-list frame))
-;; (adapt-window-to-frame window frame))
-;; (show-all-frame (current-workspace)))
-;;
-;;(defun force-window-in-frame ()
-;; "Force the current window to move in the frame (Useful only for transient windows)"
-;; (let ((frame (current-frame))
-;; (window (current-window)))
-;; (when window
-;; (setf (xlib:drawable-x window) (frame-x frame)
-;; (xlib:drawable-y window) (frame-y frame))
-;; (show-all-windows-in-workspace (current-workspace)))))
-;;
-;;(defun force-window-center-in-frame ()
-;; "Force the current window to move in the center of the frame (Useful only for transient windows)"
-;; (let ((frame (current-frame))
-;; (window (current-window)))
-;; (when window
-;; (setf (xlib:drawable-x window) (truncate (+ (frame-x frame)
-;; (/ (- (frame-width frame) (xlib:drawable-width window)) 2)))
-;; (xlib:drawable-y window) (truncate (+ (frame-y frame)
-;; (/ (- (frame-height frame) (xlib:drawable-height window)) 2))))
-;; (show-all-windows-in-workspace (current-workspace)))))
-;;
-;;
-;;
-;;
-;;
-;;(defun show-help (&optional (browser "dillo") (tempfile "/tmp/clfswm.html"))
-;; "Show current keys and buttons bindings"
-;; (ignore-errors
-;; (produce-doc-html-in-file tempfile))
-;; (sleep 1)
-;; (do-shell (format nil "~A ~A" browser tempfile)))
+
+(defun show-help (&optional (browser "dillo") (tempfile "/tmp/clfswm.html"))
+ "Show current keys and buttons bindings"
+ (ignore-errors
+ (produce-doc-html-in-file tempfile))
+ (sleep 1)
+ (do-shell (format nil "~A ~A" browser tempfile)))
Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp (original)
+++ clfswm/src/tools.lisp Fri Mar 28 18:23:43 2008
@@ -31,6 +31,7 @@
(:export :it
:awhen
:aif
+ :call-hook
:dbg
:dbgnl
:setf/=
@@ -93,6 +94,24 @@
;;;,-----
+;;;| Minimal hook
+;;;`-----
+(defun call-hook (hook &optional args)
+ "Call a hook (a function, a symbol or a list of functions)
+Return the result of the last hook"
+ (let ((result nil))
+ (labels ((rec (hook)
+ (when hook
+ (typecase hook
+ (cons (dolist (h hook)
+ (rec h)))
+ (t (setf result (apply hook args)))))))
+ (rec hook)
+ result)))
+
+
+
+;;;,-----
;;;| Debuging tools
;;;`-----
(defvar *%dbg-name%* "dbg")
More information about the clfswm-cvs
mailing list