[clfswm-cvs] r397 - in clfswm: . doc src
Philippe Brochard
pbrochard at common-lisp.net
Tue Feb 1 22:08:03 UTC 2011
Author: pbrochard
Date: Tue Feb 1 17:08:02 2011
New Revision: 397
Log:
src/clfswm-util.lisp (run-or-raise): New function (thanks to Desmond O. Chang).
Modified:
clfswm/ChangeLog
clfswm/doc/dot-clfswmrc
clfswm/src/clfswm-circulate-mode.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-util.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Tue Feb 1 17:08:02 2011
@@ -1,3 +1,10 @@
+2011-02-01 Desmond O. Chang <dochang at gmail.com>
+
+ * src/clfswm-util.lisp (run-or-raise): New function (thanks to
+ Desmond O. Chang).
+
+ * src/clfswm-internal.lisp (with-all-*): add a nil block.
+
2011-01-28 Desmond O. Chang <dochang at gmail.com>
* src/clfswm-util.lisp (xdg-config-home): XDG_CONFIG_HOME should
Modified: clfswm/doc/dot-clfswmrc
==============================================================================
--- clfswm/doc/dot-clfswmrc (original)
+++ clfswm/doc/dot-clfswmrc Tue Feb 1 17:08:02 2011
@@ -57,11 +57,31 @@
;;; Binding example: Undefine Control-F1 and define Control-F5 as a
;;; new binding in main mode
;;;
-;;; See bindings.lisp, bindings-second-mode.lisp and bindings-pager.lisp
-;;; for all default bindings definitions.
+;;; See bindings.lisp, bindings-second-mode.lisp for all default bindings definitions.
+;;
+;;(defun $start-emacs ()
+;; "Run or raise emacs"
+;; (setf *second-mode-leave-function*
+;; (lambda ()
+;; (run-or-raise (lambda (win) (string-equal "emacs"
+;; (xlib:get-wm-class win)))
+;; (lambda () (do-shell "cd $HOME && exec emacsclient -c")))))
+;; (leave-second-mode))
+;;
+;;(defun $start-conkeror ()
+;; "Run or raise conkeror"
+;; (setf *second-mode-leave-function*
+;; (lambda ()
+;; (run-or-raise (lambda (win) (string-equal "Navigator"
+;; (xlib:get-wm-class win)))
+;; (lambda () (do-shell "cd $HOME && exec conkeror")))))
+;; (leave-second-mode))
+;;
;;(defun binding-example ()
;; (undefine-main-key ("F1" :mod-1))
;; (define-main-key ("F5" :mod-1) 'help-on-clfswm)
+;; (define-second-key ("e") '$start-emacs)
+;; (define-second-key ("c") '$start-conkeror)
;; ;; Binding example for apwal
;; (define-second-key (#\Space)
;; (defun tpm-apwal ()
Modified: clfswm/src/clfswm-circulate-mode.lisp
==============================================================================
--- clfswm/src/clfswm-circulate-mode.lisp (original)
+++ clfswm/src/clfswm-circulate-mode.lisp Tue Feb 1 17:08:02 2011
@@ -76,7 +76,7 @@
(let ((len (length *circulate-orig*)))
(when (plusp len)
(let ((elem (nth (mod (incf *circulate-hit* direction) len) *circulate-orig*)))
- (setf child (nconc (list elem) (child-remove elem *circulate-orig*)))))
+ (setf child (cons elem (child-remove elem *circulate-orig*)))))
(show-all-children)
(draw-circulate-mode-window))))
@@ -94,7 +94,7 @@
(when (plusp len)
(when (frame-p *circulate-parent*)
(let ((elem (nth (mod (incf *circulate-hit* direction) len) *circulate-orig*)))
- (setf (frame-child *circulate-parent*) (nconc (list elem) (child-remove elem *circulate-orig*))
+ (setf (frame-child *circulate-parent*) (cons elem (child-remove elem *circulate-orig*))
*current-child* (frame-selected-child *circulate-parent*))))
(when frame-is-root?
(setf *current-root* *current-child*))))
@@ -111,7 +111,7 @@
(no-focus)
(with-slots (child) selected-child
(let ((elem (first (last child))))
- (setf child (nconc (list elem) (child-remove elem child)))
+ (setf child (cons elem (child-remove elem child)))
(show-all-children selected-child)
(draw-circulate-mode-window)))))))
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Tue Feb 1 17:08:02 2011
@@ -260,49 +260,53 @@
(defmacro with-all-children ((root child) &body body)
(let ((rec (gensym))
(sub-child (gensym)))
- `(labels ((,rec (,child)
- , at body
- (when (frame-p ,child)
- (dolist (,sub-child (reverse (frame-child ,child)))
- (,rec ,sub-child)))))
- (,rec ,root))))
+ `(block nil
+ (labels ((,rec (,child)
+ , at body
+ (when (frame-p ,child)
+ (dolist (,sub-child (reverse (frame-child ,child)))
+ (,rec ,sub-child)))))
+ (,rec ,root)))))
;; (with-all-children (*root-frame* child) (typecase child (xlib:window (print child)) (frame (print (frame-number child)))))
(defmacro with-all-children-reversed ((root child) &body body)
(let ((rec (gensym))
(sub-child (gensym)))
- `(labels ((,rec (,child)
- , at body
- (when (frame-p ,child)
- (dolist (,sub-child (frame-child ,child))
- (,rec ,sub-child)))))
- (,rec ,root))))
+ `(block nil
+ (labels ((,rec (,child)
+ , at body
+ (when (frame-p ,child)
+ (dolist (,sub-child (frame-child ,child))
+ (,rec ,sub-child)))))
+ (,rec ,root)))))
;; (with-all-frames (*root-frame* frame) (print (frame-number frame)))
(defmacro with-all-frames ((root frame) &body body)
(let ((rec (gensym))
(child (gensym)))
- `(labels ((,rec (,frame)
- (when (frame-p ,frame)
- , at body
- (dolist (,child (reverse (frame-child ,frame)))
- (,rec ,child)))))
- (,rec ,root))))
+ `(block nil
+ (labels ((,rec (,frame)
+ (when (frame-p ,frame)
+ , at body
+ (dolist (,child (reverse (frame-child ,frame)))
+ (,rec ,child)))))
+ (,rec ,root)))))
;; (with-all-windows (*root-frame* window) (print window))
(defmacro with-all-windows ((root window) &body body)
(let ((rec (gensym))
(child (gensym)))
- `(labels ((,rec (,window)
- (when (xlib:window-p ,window)
- , at body)
- (when (frame-p ,window)
- (dolist (,child (reverse (frame-child ,window)))
- (,rec ,child)))))
- (,rec ,root))))
+ `(block nil
+ (labels ((,rec (,window)
+ (when (xlib:window-p ,window)
+ , at body)
+ (when (frame-p ,window)
+ (dolist (,child (reverse (frame-child ,window)))
+ (,rec ,child)))))
+ (,rec ,root)))))
@@ -310,24 +314,26 @@
(defmacro with-all-windows-frames ((root child) body-window body-frame)
(let ((rec (gensym))
(sub-child (gensym)))
- `(labels ((,rec (,child)
- (typecase ,child
- (xlib:window ,body-window)
- (frame ,body-frame
- (dolist (,sub-child (reverse (frame-child ,child)))
- (,rec ,sub-child))))))
- (,rec ,root))))
+ `(block nil
+ (labels ((,rec (,child)
+ (typecase ,child
+ (xlib:window ,body-window)
+ (frame ,body-frame
+ (dolist (,sub-child (reverse (frame-child ,child)))
+ (,rec ,sub-child))))))
+ (,rec ,root)))))
(defmacro with-all-windows-frames-and-parent ((root child parent) body-window body-frame)
(let ((rec (gensym))
(sub-child (gensym)))
- `(labels ((,rec (,child ,parent)
- (typecase ,child
- (xlib:window ,body-window)
- (frame ,body-frame
- (dolist (,sub-child (reverse (frame-child ,child)))
- (,rec ,sub-child ,child))))))
- (,rec ,root nil))))
+ `(block nil
+ (labels ((,rec (,child ,parent)
+ (typecase ,child
+ (xlib:window ,body-window)
+ (frame ,body-frame
+ (dolist (,sub-child (reverse (frame-child ,child)))
+ (,rec ,sub-child ,child))))))
+ (,rec ,root nil)))))
@@ -1057,3 +1063,19 @@
(pushnew (xlib:window-id win) id-list))))))
(netwm-set-client-list id-list))
(setf *in-process-existing-windows* nil))
+
+
+;;; Child order manipulation functions
+(defun put-child-on-top (child parent)
+ "Put the child on top of its parent children"
+ (when (frame-p parent)
+ (setf (frame-child parent) (cons child (child-remove child (frame-child parent)))
+ (frame-selected-pos parent) 0)))
+
+(defun put-child-on-bottom (child parent)
+ "Put the child at the bottom of its parent children"
+ (when (frame-p parent)
+ (setf (frame-child parent) (append (child-remove child (frame-child parent)) (list child))
+ (frame-selected-pos parent) 0)))
+
+
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Tue Feb 1 17:08:02 2011
@@ -1512,3 +1512,22 @@
(open-notify-window '(("Welcome to CLFSWM" "yellow")
"Press Alt+F1 for help"))
(add-timer *notify-window-delay* #'close-notify-window))
+
+
+;;; Run or raise functions
+(defun run-or-raise (raisep run-fn &key (maximized nil))
+ (let ((window (with-all-windows (*root-frame* win)
+ (when (funcall raisep win)
+ (return win)))))
+ (if window
+ (let ((parent (find-parent-frame window)))
+ (hide-all-children *current-root*)
+ (setf *current-child* parent)
+ (put-child-on-top window parent)
+ (when maximized
+ (setf *current-root* parent))
+ (focus-all-children window parent)
+ (show-all-children *current-root*))
+ (funcall run-fn))))
+
+
More information about the clfswm-cvs
mailing list