[clfswm-cvs] r204 - clfswm/src
Philippe Brochard
pbrochard at common-lisp.net
Fri Apr 17 20:59:48 UTC 2009
Author: pbrochard
Date: Fri Apr 17 16:59:48 2009
New Revision: 204
Log:
Test user name
Modified:
clfswm/src/bindings.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-keys.lisp
clfswm/src/clfswm-query.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/xlib-util.lisp
Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp (original)
+++ clfswm/src/bindings.lisp Fri Apr 17 16:59:48 2009
@@ -37,10 +37,13 @@
(defun set-default-main-keys ()
(define-main-key ("F1" :mod-1) 'help-on-clfswm)
(define-main-key ("Home" :mod-1 :control :shift) 'exit-clfswm)
+ (define-main-key ("Escape" :mod-2) 'exit-clfswm) ;; PHIL : TO REMOVE
(define-main-key ("Right" :mod-1) 'select-next-brother)
(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"))
(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-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Fri Apr 17 16:59:48 2009
@@ -725,34 +725,6 @@
-
-
-(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))
-
-
(defun select-next-level ()
"Select the next level in frame"
(select-current-frame :maybe)
@@ -771,22 +743,140 @@
-(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)))
+(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 root 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 root 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)
+ (print 'fin-du-tab)))))
+
+(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))
+ (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)))
+;;
+;;
+;;(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))
+
Modified: clfswm/src/clfswm-keys.lisp
==============================================================================
--- clfswm/src/clfswm-keys.lisp (original)
+++ clfswm/src/clfswm-keys.lisp Fri Apr 17 16:59:48 2009
@@ -132,7 +132,7 @@
(maphash #'(lambda (k v)
(declare (ignore v))
(when (consp k)
- (handler-case
+ (handler-case
(let* ((key (first k))
(modifiers (second k))
(keycode (typecase key
@@ -181,15 +181,11 @@
(function-from string)))
(from-string-shift ()
(let* ((modifiers (state->modifiers state))
- (string (keysym->keysym-name (xlib:keycode->keysym *display* code (cond ((member :shift modifiers) 1)
- ((member :mod-5 modifiers) 2)
- (t 0))))))
+ (string (keysym->keysym-name (keycode->keysym code modifiers))))
(function-from string)))
(from-string-no-shift ()
(let* ((modifiers (state->modifiers state))
- (string (keysym->keysym-name (xlib:keycode->keysym *display* code (cond ((member :shift modifiers) 1)
- ((member :mod-5 modifiers) 2)
- (t 0))))))
+ (string (keysym->keysym-name (keycode->keysym code modifiers))))
(function-from string (modifiers->state (remove :shift modifiers))))))
(or (from-code) (from-char) (from-string) (from-string-shift) (from-string-no-shift))))
Modified: clfswm/src/clfswm-query.lisp
==============================================================================
--- clfswm/src/clfswm-query.lisp (original)
+++ clfswm/src/clfswm-query.lisp Fri Apr 17 16:59:48 2009
@@ -28,7 +28,7 @@
(defun query-show-paren (orig-string pos)
"Replace matching parentheses with brackets"
- (let ((string (copy-seq orig-string)))
+ (let ((string (copy-seq orig-string)))
(labels ((have-to-find-right? ()
(and (< pos (length string)) (char= (aref string pos) #\()))
(have-to-find-left? ()
@@ -59,7 +59,7 @@
(defun clear-history ()
"Clear the query-string history"
(setf history nil))
-
+
(defun query-string (msg &optional (default ""))
"Query a string from the keyboard. Display msg as prompt"
(let* ((done nil)
@@ -116,9 +116,7 @@
(handle-query-key (&rest event-slots &key root code state &allow-other-keys)
(declare (ignore event-slots root))
(let* ((modifiers (state->modifiers state))
- (keysym (xlib:keycode->keysym *display* code (cond ((member :shift modifiers) 1)
- ((member :mod-5 modifiers) 2)
- (t 0))))
+ (keysym (keycode->keysym code modifiers))
(char (xlib:keysym->character *display* keysym))
(keysym-name (keysym->keysym-name keysym)))
(setf done (cond ((string-equal keysym-name "Return") :Return)
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Fri Apr 17 16:59:48 2009
@@ -58,7 +58,7 @@
(setf (frame-number *current-child*) number)
(leave-second-mode))))
-
+
(defun add-default-frame ()
@@ -67,7 +67,7 @@
(let ((name (query-string "Frame name")))
(push (create-frame :name name) (frame-child *current-child*))))
(leave-second-mode))
-
+
(defun add-placed-frame ()
"Add a placed frame in the current frame"
@@ -213,7 +213,7 @@
-
+
@@ -257,9 +257,7 @@
(declare (ignore event-slots root))
(let* ((modifiers (state->modifiers state))
(key (keycode->char code state))
- (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code (cond ((member :shift modifiers) 1)
- ((member :mod-5 modifiers) 2)
- (t 0))))))
+ (keysym (keysym->keysym-name (keycode->keysym code modifiers))))
(setf done (and (equal key #\q) (equal modifiers *default-modifiers*)))
(dbg code keysym key modifiers)
(print-key code state keysym key modifiers)
@@ -504,7 +502,7 @@
(frame-h frame) (h-px->fl (xlib:drawable-height window) parent)))
(show-all-children frame)))
-
+
(defun mouse-click-to-focus-generic (window root-x root-y mouse-fn)
"Focus the current frame or focus the current window parent
@@ -672,7 +670,7 @@
*current-child* *current-root*)
(focus-all-children *current-child* *current-child*)
(show-all-children *current-root*))))
-
+
(defun bind-or-jump (n)
"Bind or jump to a slot"
(setf current-slot (- n 1))
@@ -766,7 +764,7 @@
(let ((parent (find-parent-frame *current-child* *current-root*)))
(fill-frame-left *current-child* parent)
(fill-frame-right *current-child* parent))))
-
+
;;; Resize
(defun current-frame-resize-up ()
@@ -1007,7 +1005,7 @@
(setf hidden-children (remove hidden hidden-children)))
(with-slots (child) frame-dest
(pushnew hidden child)))
-
+
(defun unhide-a-child ()
@@ -1058,7 +1056,7 @@
-
+
(let ((last-child nil))
(defun init-last-child ()
(setf last-child nil))
@@ -1084,12 +1082,12 @@
(when (frame-p *current-child*)
(setf (frame-focus-policy *current-child*) focus-policy))
(leave-second-mode))
-
+
(defun current-frame-set-click-focus-policy ()
"Set a click focus policy for the current frame."
(set-focus-policy-generic :click))
-
+
(defun current-frame-set-sloppy-focus-policy ()
"Set a sloppy focus policy for the current frame."
(set-focus-policy-generic :sloppy))
@@ -1108,12 +1106,12 @@
(with-all-frames (*root-frame* frame)
(setf (frame-focus-policy frame) focus-policy))
(leave-second-mode))
-
+
(defun all-frames-set-click-focus-policy ()
"Set a click focus policy for all frames."
(set-focus-policy-generic-for-all :click))
-
+
(defun all-frames-set-sloppy-focus-policy ()
"Set a sloppy focus policy for all frames."
(set-focus-policy-generic-for-all :sloppy))
@@ -1135,9 +1133,9 @@
(number (parse-integer name :junk-allowed t :start pos)))
(values number
(if number (subseq name 0 (1- pos)) name)))))
-
-
+
+
(defun ensure-unique-name ()
"Ensure that all children names are unique"
@@ -1190,7 +1188,7 @@
(add-sub-menu (menu-name menu) :next sec (format nil "~A" sec) menu)
(um-create-section (find-menu sec menu) (rest section-list)))))
menu))
-
+
(defun update-menus (&optional (menu (make-menu :name 'main :doc "Main menu")))
(let ((output (do-shell "update-menus --stdout")))
@@ -1220,4 +1218,3 @@
-
\ No newline at end of file
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Fri Apr 17 16:59:48 2009
@@ -658,6 +658,10 @@
(defun state->modifiers (state)
(xlib:make-state-keys state))
+(defun keycode->keysym (code modifiers)
+ (xlib:keycode->keysym *display* code (cond ((member :shift modifiers) 1)
+ ((member :mod-5 modifiers) 2)
+ (t 0))))
(defmacro with-grab-keyboard-and-pointer ((cursor mask old-cursor old-mask) &body body)
More information about the clfswm-cvs
mailing list