[clfswm-cvs] r212 - clfswm/src
Philippe Brochard
pbrochard at common-lisp.net
Mon Apr 20 21:13:55 UTC 2009
Author: pbrochard
Date: Mon Apr 20 17:13:55 2009
New Revision: 212
Log:
Transitional: revert to old circulate behaviour
Modified:
clfswm/src/bindings.lisp
clfswm/src/clfswm-info.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-second-mode.lisp
Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp (original)
+++ clfswm/src/bindings.lisp Mon Apr 20 17:13:55 2009
@@ -41,8 +41,9 @@
(define-main-key ("Left" :mod-1) 'select-previous-brother)
(define-main-key ("Down" :mod-1) 'select-previous-level)
(define-main-key ("Up" :mod-1) 'select-next-level)
- (define-circulate-modifier "Alt_L")
- (define-circulate-reverse-modifier '("Shift_L" "Shift_R"))
+ ;; Work in progress
+ ;; (define-circulate-modifier "Alt_L")
+ ;; (define-circulate-reverse-modifier '("Shift_L" "Shift_R"))
(define-main-key ("Tab" :mod-1) 'select-next-child)
(define-main-key ("Tab" :mod-1 :shift) 'select-previous-child)
(define-main-key ("Tab" :shift) 'switch-to-last-child)
Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp (original)
+++ clfswm/src/clfswm-info.lisp Mon Apr 20 17:13:55 2009
@@ -256,7 +256,10 @@
(xgrab-keyboard *root*))
(unwind-protect
(catch 'exit-info-loop
- (generic-mode :button-press-hook #'handle-button-press
+ (generic-mode :loop-function (lambda ()
+ (raise-window (info-window info))
+ (draw-info-window info))
+ :button-press-hook #'handle-button-press
:button-release-hook #'handle-button-release
:motion-notify-hook #'handle-motion-notify
:key-press-hook #'handle-key))
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Mon Apr 20 17:13:55 2009
@@ -744,138 +744,135 @@
-
-(let ((modifier nil)
- (reverse-modifiers nil))
- (defun define-circulate-modifier (keysym)
- (setf modifier (multiple-value-list (xlib:keysym->keycodes *display* (keysym-name->keysym keysym)))))
- (defun define-circulate-reverse-modifier (keysym-list)
- (setf reverse-modifiers keysym-list))
- (defun select-next-* (orig direction set-fun)
- (let ((done nil)
- (hit 0))
- (labels ((is-reverse-modifier (code state)
- (member (keysym->keysym-name (keycode->keysym code (state->modifiers state)))
- reverse-modifiers :test #'string=))
- (reorder ()
- (let ((elem (nth (mod (incf hit direction) (length orig)) orig)))
- (funcall set-fun (nconc (list elem) (remove elem orig)))))
- (handle-key-press (&rest event-slots &key code state &allow-other-keys)
- (declare (ignore event-slots))
- ;;(dbg 'press root code state)
- ;;(dbg (first reverse-modifiers) (state->modifiers state))
- (if (is-reverse-modifier code state)
- (setf direction -1)
- (reorder)))
- (handle-key-release (&rest event-slots &key code state &allow-other-keys)
- (declare (ignore event-slots))
- ;;(dbg 'release root code state)
- (when (is-reverse-modifier code state)
- (setf direction 1))
- (when (member code modifier)
- (setf done t)))
- (handle-select-next-child-event (&rest event-slots &key display event-key &allow-other-keys)
- (declare (ignore display))
- (with-xlib-protect
- (case event-key
- (:key-press (apply #'handle-key-press event-slots))
- (:key-release (apply #'handle-key-release event-slots))))
- t))
- (ungrab-main-keys)
- (xgrab-keyboard *root*)
- (reorder)
- (loop until done do
- (with-xlib-protect
- (xlib:display-finish-output *display*)
- (xlib:process-event *display* :handler #'handle-select-next-child-event)))
- (xungrab-keyboard)
- (grab-main-keys)))))
-
-(defun set-select-next-child (new)
- (setf (frame-child *current-child*) new)
- (show-all-children))
-
-(defun select-next-child ()
- "Select the next child"
- (select-next-* (frame-child *current-child*) 1 #'set-select-next-child))
-
-(defun select-previous-child ()
- "Select the previous child"
- (select-next-* (frame-child *current-child*) -1 #'set-select-next-child))
-
-
-(let ((parent nil))
- (defun set-select-next-brother (new)
- (let ((frame-is-root? (and (equal *current-root* *current-child*)
- (not (equal *current-root* *root-frame*)))))
- (if frame-is-root?
- (hide-all *current-root*)
- (select-current-frame nil))
- (setf (frame-child parent) new
- *current-child* (frame-selected-child parent))
- (when frame-is-root?
- (setf *current-root* *current-child*))
- (show-all-children *current-root*)))
-
- (defun select-next-brother ()
- "Select the next brother frame"
- (setf parent (find-parent-frame *current-child*))
- (when (frame-p parent)
- (select-next-* (frame-child parent) 1 #'set-select-next-brother)))
-
- (defun select-previous-brother ()
- "Select the previous brother frame"
- (setf parent (find-parent-frame *current-child*))
- (when (frame-p parent)
- (select-next-* (frame-child parent) -1 #'set-select-next-brother))))
-
-
-
-
-;;(defun select-next/previous-child (fun-rotate)
-;; "Select the next/previous child"
-;; (when (frame-p *current-child*)
-;; (unselect-all-frames)
-;; (with-slots (child) *current-child*
-;; (setf child (funcall fun-rotate child)))
-;; (show-all-children)))
+;; New circulate mode - work in progress
+;;(let ((modifier nil)
+;; (reverse-modifiers nil))
+;; (defun define-circulate-modifier (keysym)
+;; (setf modifier (multiple-value-list (xlib:keysym->keycodes *display* (keysym-name->keysym keysym)))))
+;; (defun define-circulate-reverse-modifier (keysym-list)
+;; (setf reverse-modifiers keysym-list))
+;; (defun select-next-* (orig direction set-fun)
+;; (let ((done nil)
+;; (hit 0))
+;; (labels ((is-reverse-modifier (code state)
+;; (member (keysym->keysym-name (keycode->keysym code (state->modifiers state)))
+;; reverse-modifiers :test #'string=))
+;; (reorder ()
+;; (let ((elem (nth (mod (incf hit direction) (length orig)) orig)))
+;; (funcall set-fun (nconc (list elem) (remove elem orig)))))
+;; (handle-key-press (&rest event-slots &key code state &allow-other-keys)
+;; (declare (ignore event-slots))
+;; ;;(dbg 'press root code state)
+;; ;;(dbg (first reverse-modifiers) (state->modifiers state))
+;; (if (is-reverse-modifier code state)
+;; (setf direction -1)
+;; (reorder)))
+;; (handle-key-release (&rest event-slots &key code state &allow-other-keys)
+;; (declare (ignore event-slots))
+;; ;;(dbg 'release root code state)
+;; (when (is-reverse-modifier code state)
+;; (setf direction 1))
+;; (when (member code modifier)
+;; (setf done t)))
+;; (handle-select-next-child-event (&rest event-slots &key display event-key &allow-other-keys)
+;; (declare (ignore display))
+;; (with-xlib-protect
+;; (case event-key
+;; (:key-press (apply #'handle-key-press event-slots))
+;; (:key-release (apply #'handle-key-release event-slots))))
+;; t))
+;; (ungrab-main-keys)
+;; (xgrab-keyboard *root*)
+;; (reorder)
+;; (loop until done do
+;; (with-xlib-protect
+;; (xlib:display-finish-output *display*)
+;; (xlib:process-event *display* :handler #'handle-select-next-child-event)))
+;; (xungrab-keyboard)
+;; (grab-main-keys)))))
;;
+;;(defun set-select-next-child (new)
+;; (setf (frame-child *current-child*) new)
+;; (show-all-children))
;;
;;(defun select-next-child ()
;; "Select the next child"
-;; (select-next/previous-child #'rotate-list))
+;; (select-next-* (frame-child *current-child*) 1 #'set-select-next-child))
;;
;;(defun select-previous-child ()
;; "Select the previous child"
-;; (select-next/previous-child #'anti-rotate-list))
-
-
-
-;;(defun select-next/previous-brother (fun-rotate)
-;; "Select the next/previous brother frame"
-;; (let ((frame-is-root? (and (equal *current-root* *current-child*)
-;; (not (equal *current-root* *root-frame*)))))
-;; (if frame-is-root?
-;; (hide-all *current-root*)
-;; (select-current-frame nil))
-;; (let ((parent (find-parent-frame *current-child*)))
-;; (when (frame-p parent)
-;; (with-slots (child) parent
-;; (setf child (funcall fun-rotate child))
-;; (setf *current-child* (frame-selected-child parent)))))
-;; (when frame-is-root?
-;; (setf *current-root* *current-child*))
-;; (show-all-children *current-root*)))
+;; (select-next-* (frame-child *current-child*) -1 #'set-select-next-child))
;;
+;;(let ((parent nil))
+;; (defun set-select-next-brother (new)
+;; (let ((frame-is-root? (and (equal *current-root* *current-child*)
+;; (not (equal *current-root* *root-frame*)))))
+;; (if frame-is-root?
+;; (hide-all *current-root*)
+;; (select-current-frame nil))
+;; (setf (frame-child parent) new
+;; *current-child* (frame-selected-child parent))
+;; (when frame-is-root?
+;; (setf *current-root* *current-child*))
+;; (show-all-children *current-root*)))
;;
-;;(defun select-next-brother ()
-;; "Select the next brother frame"
-;; (select-next/previous-brother #'anti-rotate-list))
+;; (defun select-next-brother ()
+;; "Select the next brother frame"
+;; (setf parent (find-parent-frame *current-child*))
+;; (when (frame-p parent)
+;; (select-next-* (frame-child parent) 1 #'set-select-next-brother)))
;;
-;;(defun select-previous-brother ()
-;; "Select the previous brother frame"
-;; (select-next/previous-brother #'rotate-list))
+;; (defun select-previous-brother ()
+;; "Select the previous brother frame"
+;; (setf parent (find-parent-frame *current-child*))
+;; (when (frame-p parent)
+;; (select-next-* (frame-child parent) -1 #'set-select-next-brother))))
+
+
+;;; This is only transitional
+(defun select-next/previous-child (fun-rotate)
+ "Select the next/previous child"
+ (when (frame-p *current-child*)
+ (unselect-all-frames)
+ (with-slots (child) *current-child*
+ (setf child (funcall fun-rotate child)))
+ (show-all-children)))
+
+
+(defun select-next-child ()
+ "Select the next child"
+ (select-next/previous-child #'rotate-list))
+
+(defun select-previous-child ()
+ "Select the previous child"
+ (select-next/previous-child #'anti-rotate-list))
+
+
+(defun select-next/previous-brother (fun-rotate)
+ "Select the next/previous brother frame"
+ (let ((frame-is-root? (and (equal *current-root* *current-child*)
+ (not (equal *current-root* *root-frame*)))))
+ (if frame-is-root?
+ (hide-all *current-root*)
+ (select-current-frame nil))
+ (let ((parent (find-parent-frame *current-child*)))
+ (when (frame-p parent)
+ (with-slots (child) parent
+ (setf child (funcall fun-rotate child))
+ (setf *current-child* (frame-selected-child parent)))))
+ (when frame-is-root?
+ (setf *current-root* *current-child*))
+ (show-all-children *current-root*)))
+
+(defun select-next-brother ()
+ "Select the next brother frame"
+ (select-next/previous-brother #'anti-rotate-list))
+
+(defun select-previous-brother ()
+ "Select the previous brother frame"
+ (select-next/previous-brother #'rotate-list))
+;;; end transitional part
Modified: clfswm/src/clfswm-second-mode.lisp
==============================================================================
--- clfswm/src/clfswm-second-mode.lisp (original)
+++ clfswm/src/clfswm-second-mode.lisp Mon Apr 20 17:13:55 2009
@@ -63,7 +63,8 @@
(defun sm-handle-motion-notify (&rest event-slots &key window root-x root-y &allow-other-keys)
(declare (ignore event-slots))
(unless (compress-motion-notify)
- (funcall-button-from-code *second-mouse* 'motion 0 window root-x root-y *fun-press*)))
+ (funcall-button-from-code *second-mouse* 'motion 0 window root-x root-y *fun-press*)
+ (draw-second-mode-window)))
(defun sm-handle-button-press (&rest event-slots &key window root-x root-y code state &allow-other-keys)
(declare (ignore event-slots))
More information about the clfswm-cvs
mailing list