From pbrochard at common-lisp.net Sun Oct 12 19:48:48 2008 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Sun, 12 Oct 2008 19:48:48 +0000 Subject: [clfswm-cvs] r187 - clfswm Message-ID: Author: pbrochard Date: Sun Oct 12 19:48:48 2008 New Revision: 187 Log: test sender Modified: clfswm/TODO clfswm/load.lisp Modified: clfswm/TODO ============================================================================== --- clfswm/TODO (original) +++ clfswm/TODO Sun Oct 12 19:48:48 2008 @@ -10,6 +10,9 @@ - Handle numlock properly (add :mod-2 in bindings if necessary) (with-numlock) -> add :mod-2 in *default-modifiers* (without-numlock) + alias :mod-1 -> :alt :mod-2 -> :numlock + +- hook to create bindings and menu - Show config -> list and display documentation for all tweakable global variables. [Philippe] TODO : Modified: clfswm/load.lisp ============================================================================== --- clfswm/load.lisp (original) +++ clfswm/load.lisp Sun Oct 12 19:48:48 2008 @@ -23,6 +23,8 @@ ;;; ;;; -------------------------------------------------------------------------- +;;test + (defparameter *base-dir* (directory-namestring *load-truename*)) (export '*base-dir*) From pbrochard at common-lisp.net Tue Oct 14 21:22:52 2008 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Tue, 14 Oct 2008 21:22:52 +0000 Subject: [clfswm-cvs] r188 - in clfswm: . src Message-ID: Author: pbrochard Date: Tue Oct 14 21:22:47 2008 New Revision: 188 Log: src/clfswm-keys.lisp: Add a default modifiers list before bindings keys. This allow the use of Numlock or Caps_Lock while using clfswm. Modified: clfswm/TODO clfswm/load.lisp clfswm/src/bindings.lisp clfswm/src/clfswm-info.lisp clfswm/src/clfswm-keys.lisp clfswm/src/clfswm-menu.lisp clfswm/src/clfswm-util.lisp clfswm/src/clfswm.lisp clfswm/src/config.lisp clfswm/src/xlib-util.lisp Modified: clfswm/TODO ============================================================================== --- clfswm/TODO (original) +++ clfswm/TODO Tue Oct 14 21:22:47 2008 @@ -11,8 +11,9 @@ (with-numlock) -> add :mod-2 in *default-modifiers* (without-numlock) alias :mod-1 -> :alt :mod-2 -> :numlock + => *default-modifiers* is done. <= -- hook to create bindings and menu +- hook to create bindings and menu -> build keys and menu at runtime. - Show config -> list and display documentation for all tweakable global variables. [Philippe] TODO : Modified: clfswm/load.lisp ============================================================================== --- clfswm/load.lisp (original) +++ clfswm/load.lisp Tue Oct 14 21:22:47 2008 @@ -23,8 +23,6 @@ ;;; ;;; -------------------------------------------------------------------------- -;;test - (defparameter *base-dir* (directory-namestring *load-truename*)) (export '*base-dir*) Modified: clfswm/src/bindings.lisp ============================================================================== --- clfswm/src/bindings.lisp (original) +++ clfswm/src/bindings.lisp Tue Oct 14 21:22:47 2008 @@ -31,6 +31,8 @@ ;;;| CONFIG - Bindings main mode ;;;`----- +(with-numlock) + (define-main-key ("F1" :mod-1) 'help-on-clfswm) (define-main-key ("Home" :mod-1 :control :shift) 'exit-clfswm) Modified: clfswm/src/clfswm-info.lisp ============================================================================== --- clfswm/src/clfswm-info.lisp (original) +++ clfswm/src/clfswm-info.lisp Tue Oct 14 21:22:47 2008 @@ -305,7 +305,7 @@ (let ((info-list nil) (action nil)) (labels ((define-key (key function) - (define-info-key-fun (list key 0) + (define-info-key-fun (list key (modifiers->state *default-modifiers*)) (lambda (&optional args) (declare (ignore args)) (setf action function) @@ -328,7 +328,7 @@ (dolist (item item-list) (when (consp item) (let ((key (first item))) - (undefine-info-key-fun (list key 0))))) + (undefine-info-key-fun (list key (modifiers->state *default-modifiers*)))))) (typecase action (function (funcall action)) (symbol (when (fboundp action) Modified: clfswm/src/clfswm-keys.lisp ============================================================================== --- clfswm/src/clfswm-keys.lisp (original) +++ clfswm/src/clfswm-keys.lisp Tue Oct 14 21:22:47 2008 @@ -30,6 +30,8 @@ (defparameter *fun-release* #'second) + + (defun define-hash-table-key-name (hash-table name) (setf (gethash 'name hash-table) name)) @@ -49,20 +51,21 @@ (undefine-name (create-symbol "undefine-" name "-key")) (undefine-multi-name (create-symbol "undefine-" name "-multi-keys"))) `(progn - (defun ,name-key-fun (key function &rest args) - "Define a new key, a key is '(char '(modifier list))" - (setf (gethash key ,hashtable) (list function args))) + (defun ,name-key-fun (key function &rest args) + "Define a new key, a key is '(char '(modifier list))" + (setf (gethash key ,hashtable) (list function args))) - (defmacro ,name-key ((key &rest modifiers) function &rest args) - `(,',name-key-fun (list ,key ,(modifiers->state modifiers)) ,function , at args)) + (defmacro ,name-key ((key &rest modifiers) function &rest args) + `(,',name-key-fun (list ,key ,(modifiers->state (append modifiers *default-modifiers*))) ,function , at args)) - (defmacro ,undefine-name ((key &rest modifiers)) - `(remhash (list ,key ,(modifiers->state modifiers)) ,',hashtable)) + (defmacro ,undefine-name ((key &rest modifiers)) + `(remhash (list ,key ,(modifiers->state (append modifiers *default-modifiers*))) ,',hashtable)) + + (defmacro ,undefine-multi-name (&rest keys) + `(progn + ,@(loop for k in keys + collect `(,',undefine-name ,k))))))) - (defmacro ,undefine-multi-name (&rest keys) - `(progn - ,@(loop for k in keys - collect `(,',undefine-name ,k))))))) (defmacro define-define-mouse (name hashtable) @@ -75,10 +78,10 @@ (setf (gethash button ,hashtable) (list function-press function-release args))) (defmacro ,name-mouse ((button &rest modifiers) function-press &optional function-release &rest args) - `(,',name-mouse-fun (list ,button ,(modifiers->state modifiers)) ,function-press ,function-release , at args)) + `(,',name-mouse-fun (list ,button ,(modifiers->state (append modifiers *default-modifiers*))) ,function-press ,function-release , at args)) (defmacro ,undefine-name ((key &rest modifiers)) - `(remhash (list ,key ,(modifiers->state modifiers)) ,',hashtable))))) + `(remhash (list ,key ,(modifiers->state (append modifiers *default-modifiers*))) ,',hashtable))))) Modified: clfswm/src/clfswm-menu.lisp ============================================================================== --- clfswm/src/clfswm-menu.lisp (original) +++ clfswm/src/clfswm-menu.lisp Tue Oct 14 21:22:47 2008 @@ -129,14 +129,14 @@ (format nil ": ~A" (documentation value 'function))))) info-list) (when (menu-item-key item) - (define-info-key-fun (list (menu-item-key item) 0) + (define-info-key-fun (list (menu-item-key item) (modifiers->state *default-modifiers*)) (lambda (&optional args) (declare (ignore args)) (setf action value) (throw 'exit-info-loop nil)))))) (info-mode (nreverse info-list)) (dolist (item (menu-item menu)) - (undefine-info-key-fun (list (menu-item-key item) 0))) + (undefine-info-key-fun (list (menu-item-key item) (modifiers->state *default-modifiers*)))) (typecase action (menu (open-menu action (cons menu parent))) (null (awhen (first parent) Modified: clfswm/src/clfswm-util.lisp ============================================================================== --- clfswm/src/clfswm-util.lisp (original) +++ clfswm/src/clfswm-util.lisp Tue Oct 14 21:22:47 2008 @@ -260,7 +260,7 @@ (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code (cond ((member :shift modifiers) 1) ((member :mod-5 modifiers) 2) (t 0)))))) - (setf done (and (equal key #\q) (null modifiers))) + (setf done (and (equal key #\q) (equal modifiers *default-modifiers*))) (dbg code keysym key modifiers) (print-key code state keysym key modifiers) (force-output))) Modified: clfswm/src/clfswm.lisp ============================================================================== --- clfswm/src/clfswm.lisp (original) +++ clfswm/src/clfswm.lisp Tue Oct 14 21:22:47 2008 @@ -231,6 +231,7 @@ *in-second-mode* nil *clfswm-terminal* nil *vt-keyboard-on* nil) + (init-modifier-list) (xgrab-init-pointer) (xgrab-init-keyboard) (init-last-child) Modified: clfswm/src/config.lisp ============================================================================== --- clfswm/src/config.lisp (original) +++ clfswm/src/config.lisp Tue Oct 14 21:22:47 2008 @@ -38,6 +38,12 @@ +;;; CONFIG - Default modifiers +(defparameter *default-modifiers* '() + "Config(): Default modifiers list to append to explicit modifiers +Example: :mod-2 for num_lock, :lock for Caps_lock...") + + ;;; CONFIG - Never managed window list Modified: clfswm/src/xlib-util.lisp ============================================================================== --- clfswm/src/xlib-util.lisp (original) +++ clfswm/src/xlib-util.lisp Tue Oct 14 21:22:47 2008 @@ -656,21 +656,39 @@ (xungrab-keyboard)))) + + + + +(let ((modifier-list nil)) + (defun init-modifier-list () + (dolist (name '("Shift_L" "Shift_R" "Control_L" "Control_R" + "Alt_L" "Alt_R" "Meta_L" "Meta_R" "Hyper_L" "Hyper_R" + "Mode_switch" "script_switch" "ISO_Level3_Shift" + "Caps_Lock" "Scroll_Lock" "Num_Lock")) + (awhen (xlib:keysym->keycodes *display* (keysym-name->keysym name)) + (push it modifier-list)))) + + (defun modifier-p (code) + (member code modifier-list))) + (defun wait-no-key-or-button-press () (with-grab-keyboard-and-pointer (66 67 66 67) (loop - (let ((key (loop for k across (xlib:query-keymap *display*) - unless (zerop k) return t)) - (button (plusp (nth-value 4 (xlib:query-pointer *root*))))) - (when (and (not key) (not button)) - (loop while (xlib:event-case (*display* :discard-p t :peek-p nil :timeout 0) - (:motion-notify () t) - (:key-press () t) - (:key-release () t) - (:button-press () t) - (:button-release () t) - (t nil))) - (return)))))) + (let ((key (loop for k across (xlib:query-keymap *display*) + for code from 0 + when (and (plusp k) (not (modifier-p code))) return t)) + (button (member (nth-value 4 (xlib:query-pointer *root*)) + '(:button-1 :button-2 :button-3 :button-4 :button-5)))) + (when (and (not key) (not button)) + (loop while (xlib:event-case (*display* :discard-p t :peek-p nil :timeout 0) + (:motion-notify () t) + (:key-press () t) + (:key-release () t) + (:button-press () t) + (:button-release () t) + (t nil))) + (return)))))) (defun wait-a-key-or-button-press () From pbrochard at common-lisp.net Tue Oct 14 21:23:57 2008 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Tue, 14 Oct 2008 21:23:57 +0000 Subject: [clfswm-cvs] r189 - clfswm/src Message-ID: Author: pbrochard Date: Tue Oct 14 21:23:56 2008 New Revision: 189 Log: Remove a with-numlock not yet defined Modified: clfswm/src/bindings.lisp Modified: clfswm/src/bindings.lisp ============================================================================== --- clfswm/src/bindings.lisp (original) +++ clfswm/src/bindings.lisp Tue Oct 14 21:23:56 2008 @@ -31,8 +31,6 @@ ;;;| CONFIG - Bindings main mode ;;;`----- -(with-numlock) - (define-main-key ("F1" :mod-1) 'help-on-clfswm) (define-main-key ("Home" :mod-1 :control :shift) 'exit-clfswm) From pbrochard at common-lisp.net Sat Oct 25 22:11:39 2008 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Sat, 25 Oct 2008 22:11:39 +0000 Subject: [clfswm-cvs] r190 - in clfswm: . doc src Message-ID: Author: pbrochard Date: Sat Oct 25 22:11:38 2008 New Revision: 190 Log: Use the *binding-hook* to create main/second/info keys and mouse bindings. with-capslock, without-capslock, with-numlock, without-cnumlock: New functions. Modified: clfswm/ChangeLog clfswm/doc/dot-clfswmrc clfswm/src/bindings-second-mode.lisp clfswm/src/bindings.lisp clfswm/src/clfswm-info.lisp clfswm/src/clfswm-keys.lisp clfswm/src/clfswm-menu.lisp clfswm/src/clfswm-second-mode.lisp clfswm/src/clfswm.lisp clfswm/src/package.lisp clfswm/src/tools.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Sat Oct 25 22:11:38 2008 @@ -1,3 +1,19 @@ +2008-10-26 Philippe Brochard + + * src/clfswm-keys.lisp (with-capslock, without-capslock) + (with-numlock, without-cnumlock): New functions. + +2008-10-25 Philippe Brochard + + * src/clfswm-info.lisp: Use the *binding-hook* to create info + keys and mouse bindings. + + * src/bindings-second-mode.lisp: Use the *binding-hook* to create + second keys and mouse bindings. + + * src/bindings.lisp: Use the *binding-hook* to create main keys + and mouse bindings. + 2008-10-10 Philippe Brochard * src/clfswm-menu.lisp (open-menu): Remember parent menu to undo Modified: clfswm/doc/dot-clfswmrc ============================================================================== --- clfswm/doc/dot-clfswmrc (original) +++ clfswm/doc/dot-clfswmrc Sat Oct 25 22:11:38 2008 @@ -8,6 +8,13 @@ (in-package :clfswm) + +;;;; Uncomment the line above if you need default modifiers (or not) +;;(with-capslock) +;;(with-numlock) +;;(without-capslock) +;;(without-cnumlock) + ;;;; Uncomment the line above if you want to enable the notify event compression. ;;;; This variable may be useful to speed up some slow version of CLX ;;;; It is particulary useful with CLISP/MIT-CLX. Modified: clfswm/src/bindings-second-mode.lisp ============================================================================== --- clfswm/src/bindings-second-mode.lisp (original) +++ clfswm/src/bindings-second-mode.lisp Sat Oct 25 22:11:38 2008 @@ -32,9 +32,7 @@ ;;;| ;;;| CONFIG - Second mode bindings ;;;`----- - - -(define-second-key ("F1" :mod-1) 'help-on-second-mode) +(add-hook *binding-hook* 'init-*second-keys* 'init-*second-mouse*) (defun open-frame-menu () "Open the frame menu" @@ -64,90 +62,11 @@ "Open the frame resize menu" (open-menu (find-menu 'frame-resize-menu))) - -(define-second-key ("m") 'open-menu) -(define-second-key ("less") 'open-menu) -(define-second-key ("less" :control) 'open-menu) - -(define-second-key ("f") 'open-frame-menu) -(define-second-key ("w") 'open-window-menu) -(define-second-key ("n") 'open-action-by-name-menu) -(define-second-key ("u") 'open-action-by-number-menu) - -(define-second-key ("p") 'open-frame-pack-menu) -(define-second-key ("l") 'open-frame-fill-menu) -(define-second-key ("r") 'open-frame-resize-menu) - - - -;;(define-second-key (#\g :control) 'stop-all-pending-actions) - -(define-second-key ("i") 'identify-key) -(define-second-key ("colon") 'eval-from-query-string) - -(define-second-key ("exclam") 'run-program-from-query-string) - - -(define-second-key ("Return") 'leave-second-mode) -(define-second-key ("Escape") 'leave-second-mode) - - (defun tile-current-frame () "Tile the current frame" (set-layout-once #'tile-layout) (leave-second-mode)) -(define-second-key ("t") 'tile-current-frame) - -(define-second-key ("Home" :mod-1 :control :shift) 'exit-clfswm) - -(define-second-key ("Right" :mod-1) 'select-next-sister) -(define-second-key ("Left" :mod-1) 'select-previous-sister) - -(define-second-key ("Down" :mod-1) 'select-previous-level) -(define-second-key ("Up" :mod-1) 'select-next-level) - -(define-second-key ("Tab" :mod-1) 'select-next-child) -(define-second-key ("Tab" :mod-1 :shift) 'select-previous-child) -(define-second-key (#\Tab :shift) 'switch-to-last-child) - -(define-second-key ("Return" :mod-1) 'enter-frame) -(define-second-key ("Return" :mod-1 :shift) 'leave-frame) - - -(define-second-key ("Page_Up" :mod-1) 'frame-lower-child) -(define-second-key ("Page_Down" :mod-1) 'frame-raise-child) - - -(define-second-key ("Home" :mod-1) 'switch-to-root-frame) -(define-second-key ("Home" :mod-1 :shift) 'switch-and-select-root-frame) - -(define-second-key ("Menu") 'toggle-show-root-frame) - -(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 :control) 'set-open-in-new-frame-in-parent-frame-nw-hook) - -(define-second-key (#\a) 'add-default-frame) - -;;;; Escape -(define-second-key ("Escape" :control :shift) 'delete-focus-window) -(define-second-key ("Escape" :mod-1 :control :shift) 'destroy-focus-window) -(define-second-key ("Escape" :control) 'remove-focus-window) -(define-second-key ("Escape" :shift) 'unhide-all-windows-in-current-child) - - -;;; Selection -(define-second-key ("x" :control) 'cut-current-child) -(define-second-key ("x" :control :mod-1) 'clear-selection) -(define-second-key ("c" :control) 'copy-current-child) -(define-second-key ("v" :control) 'paste-selection) -(define-second-key ("v" :control :shift) 'paste-selection-no-clear) -(define-second-key ("Delete") 'remove-current-child) - - - ;;; default shell programs (defmacro define-shell (key name docstring cmd) "Define a second key to start a shell command" @@ -157,30 +76,80 @@ (setf *second-mode-program* ,cmd) (leave-second-mode)))) -(define-shell (#\c) b-start-xterm "start an xterm" "exec xterm") -(define-shell (#\e) b-start-emacs "start emacs" "exec emacs") -(define-shell (#\e :control) b-start-emacsremote - "start an emacs for another user" - "exec xterm -e emacsremote") -(define-shell (#\h) b-start-xclock "start an xclock" "exec xclock -d") - - -(define-second-key ("Menu") 'show-all-frames-info-key) -(define-second-key ("Menu" :shift) 'show-all-frames-info) -(define-second-key ("Menu" :control) 'toggle-show-root-frame) - - -;;; Bind or jump functions -(define-second-key ("1" :mod-1) 'bind-or-jump 1) -(define-second-key ("2" :mod-1) 'bind-or-jump 2) -(define-second-key ("3" :mod-1) 'bind-or-jump 3) -(define-second-key ("4" :mod-1) 'bind-or-jump 4) -(define-second-key ("5" :mod-1) 'bind-or-jump 5) -(define-second-key ("6" :mod-1) 'bind-or-jump 6) -(define-second-key ("7" :mod-1) 'bind-or-jump 7) -(define-second-key ("8" :mod-1) 'bind-or-jump 8) -(define-second-key ("9" :mod-1) 'bind-or-jump 9) -(define-second-key ("0" :mod-1) 'bind-or-jump 10) + + +(defun set-default-second-keys () + (define-second-key ("F1" :mod-1) 'help-on-second-mode) + (define-second-key ("m") 'open-menu) + (define-second-key ("less") 'open-menu) + (define-second-key ("less" :control) 'open-menu) + (define-second-key ("f") 'open-frame-menu) + (define-second-key ("w") 'open-window-menu) + (define-second-key ("n") 'open-action-by-name-menu) + (define-second-key ("u") 'open-action-by-number-menu) + (define-second-key ("p") 'open-frame-pack-menu) + (define-second-key ("l") 'open-frame-fill-menu) + (define-second-key ("r") 'open-frame-resize-menu) + ;;(define-second-key (#\g :control) 'stop-all-pending-actions) + (define-second-key ("i") 'identify-key) + (define-second-key ("colon") 'eval-from-query-string) + (define-second-key ("exclam") 'run-program-from-query-string) + (define-second-key ("Return") 'leave-second-mode) + (define-second-key ("Escape") 'leave-second-mode) + (define-second-key ("t") 'tile-current-frame) + (define-second-key ("Home" :mod-1 :control :shift) 'exit-clfswm) + (define-second-key ("Right" :mod-1) 'select-next-sister) + (define-second-key ("Left" :mod-1) 'select-previous-sister) + (define-second-key ("Down" :mod-1) 'select-previous-level) + (define-second-key ("Up" :mod-1) 'select-next-level) + (define-second-key ("Tab" :mod-1) 'select-next-child) + (define-second-key ("Tab" :mod-1 :shift) 'select-previous-child) + (define-second-key (#\Tab :shift) 'switch-to-last-child) + (define-second-key ("Return" :mod-1) 'enter-frame) + (define-second-key ("Return" :mod-1 :shift) 'leave-frame) + (define-second-key ("Page_Up" :mod-1) 'frame-lower-child) + (define-second-key ("Page_Down" :mod-1) 'frame-raise-child) + (define-second-key ("Home" :mod-1) 'switch-to-root-frame) + (define-second-key ("Home" :mod-1 :shift) 'switch-and-select-root-frame) + (define-second-key ("Menu") 'toggle-show-root-frame) + (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 :control) 'set-open-in-new-frame-in-parent-frame-nw-hook) + (define-second-key (#\a) 'add-default-frame) + ;; Escape + (define-second-key ("Escape" :control :shift) 'delete-focus-window) + (define-second-key ("Escape" :mod-1 :control :shift) 'destroy-focus-window) + (define-second-key ("Escape" :control) 'remove-focus-window) + (define-second-key ("Escape" :shift) 'unhide-all-windows-in-current-child) + ;; Selection + (define-second-key ("x" :control) 'cut-current-child) + (define-second-key ("x" :control :mod-1) 'clear-selection) + (define-second-key ("c" :control) 'copy-current-child) + (define-second-key ("v" :control) 'paste-selection) + (define-second-key ("v" :control :shift) 'paste-selection-no-clear) + (define-second-key ("Delete") 'remove-current-child) + (define-shell (#\c) b-start-xterm "start an xterm" "exec xterm") + (define-shell (#\e) b-start-emacs "start emacs" "exec emacs") + (define-shell (#\e :control) b-start-emacsremote + "start an emacs for another user" + "exec xterm -e emacsremote") + (define-shell (#\h) b-start-xclock "start an xclock" "exec xclock -d") + (define-second-key ("Menu") 'show-all-frames-info-key) + (define-second-key ("Menu" :shift) 'show-all-frames-info) + (define-second-key ("Menu" :control) 'toggle-show-root-frame) + ;; Bind or jump functions + (define-second-key ("1" :mod-1) 'bind-or-jump 1) + (define-second-key ("2" :mod-1) 'bind-or-jump 2) + (define-second-key ("3" :mod-1) 'bind-or-jump 3) + (define-second-key ("4" :mod-1) 'bind-or-jump 4) + (define-second-key ("5" :mod-1) 'bind-or-jump 5) + (define-second-key ("6" :mod-1) 'bind-or-jump 6) + (define-second-key ("7" :mod-1) 'bind-or-jump 7) + (define-second-key ("8" :mod-1) 'bind-or-jump 8) + (define-second-key ("9" :mod-1) 'bind-or-jump 9) + (define-second-key ("0" :mod-1) 'bind-or-jump 10)) + +(add-hook *binding-hook* 'set-default-second-keys) ;; For a French azery keyboard: @@ -265,535 +234,16 @@ +(defun set-default-second-mouse () + (define-second-mouse (1) 'sm-mouse-click-to-focus-and-move) + (define-second-mouse (2) 'sm-mouse-middle-click) + (define-second-mouse (3) 'sm-mouse-click-to-focus-and-resize) + (define-second-mouse (1 :mod-1) 'sm-mouse-click-to-focus-and-move-window) + (define-second-mouse (3 :mod-1) 'sm-mouse-click-to-focus-and-resize-window) + (define-second-mouse (1 :control :mod-1) 'mouse-move-window-over-frame) + (define-second-mouse (4) 'sm-mouse-select-next-level) + (define-second-mouse (5) 'sm-mouse-select-previous-level) + (define-second-mouse (4 :mod-1) 'sm-mouse-enter-frame) + (define-second-mouse (5 :mod-1) 'sm-mouse-leave-frame)) -(define-second-mouse (1) 'sm-mouse-click-to-focus-and-move) -(define-second-mouse (2) 'sm-mouse-middle-click) -(define-second-mouse (3) 'sm-mouse-click-to-focus-and-resize) - -(define-second-mouse (1 :mod-1) 'sm-mouse-click-to-focus-and-move-window) -(define-second-mouse (3 :mod-1) 'sm-mouse-click-to-focus-and-resize-window) - -(define-second-mouse (1 :control :mod-1) 'mouse-move-window-over-frame) - -(define-second-mouse (4) 'sm-mouse-select-next-level) -(define-second-mouse (5) 'sm-mouse-select-previous-level) - -(define-second-mouse (4 :mod-1) 'sm-mouse-enter-frame) -(define-second-mouse (5 :mod-1) 'sm-mouse-leave-frame) - - - - - - -;;;; Escape -;;(define-second-key ("Escape" :control :shift) 'delete-current-window) -;;(define-second-key ("Escape" :mod-1 :control :shift) 'destroy-current-window) -;;(define-second-key ("Escape" :control) 'remove-current-window) -;;(define-second-key ("Escape" :shift) 'unhide-all-windows-in-current-frame) -;; -;; -;;;; Up -;;(define-second-key ("Up" :mod-1) 'circulate-frame-up) -;;(define-second-key ("Up" :mod-1 :shift) 'circulate-frame-up-move-window) -;;(define-second-key ("Up" :mod-1 :shift :control) 'circulate-frame-up-copy-window) -;; -;; -;;;; Down -;;(define-second-key ("Down" :mod-1) 'circulate-frame-down) -;;(define-second-key ("Down" :mod-1 :shift) 'circulate-frame-down-move-window) -;;(define-second-key ("Down" :mod-1 :shift :control) 'circulate-frame-down-copy-window) -;; -;; -;;;; Right -;;(define-second-key ("Right" :mod-1) 'circulate-workspace-up) -;;(define-second-key ("Right" :mod-1 :shift) 'circulate-workspace-up-move-frame) -;;(define-second-key ("Right" :mod-1 :shift :control) 'circulate-workspace-up-copy-frame) -;; -;; -;;;; Left -;;(define-second-key ("Left" :mod-1) 'circulate-workspace-down) -;;(define-second-key ("Left" :mod-1 :shift) 'circulate-workspace-down-move-frame) -;;(define-second-key ("Left" :mod-1 :shift :control) 'circulate-workspace-down-copy-frame) -;; -;; -;;(defmacro define-second-focus-workspace-by-number (key number) -;; "Define a second key to focus a workspace by its number" -;; `(define-second-key ,key -;; (defun ,(create-symbol (format nil "b-second-focus-workspace-~A" number)) () -;; ,(format nil "Focus workspace ~A" number) -;; (circulate-workspace-by-number ,number)))) -;; -;;(define-second-focus-workspace-by-number (#\1 :mod-1) 1) -;;(define-second-focus-workspace-by-number (#\2 :mod-1) 2) -;;(define-second-focus-workspace-by-number (#\3 :mod-1) 3) -;;(define-second-focus-workspace-by-number (#\4 :mod-1) 4) -;;(define-second-focus-workspace-by-number (#\5 :mod-1) 5) -;;(define-second-focus-workspace-by-number (#\6 :mod-1) 6) -;;(define-second-focus-workspace-by-number (#\7 :mod-1) 7) -;;(define-second-focus-workspace-by-number (#\8 :mod-1) 8) -;;(define-second-focus-workspace-by-number (#\9 :mod-1) 9) -;;(define-second-focus-workspace-by-number (#\0 :mod-1) 10) -;; -;;(define-second-key (#\1 :control :mod-1) 'renumber-workspaces) -;;(define-second-key (#\2 :control :mod-1) 'sort-workspaces) -;; -;; -;; -;; -;; -;;(define-second-key ("Tab" :mod-1) 'rotate-window-up) -;;(define-second-key ("Tab" :mod-1 :shift) 'rotate-window-down) -;; -;;(define-second-key (#\b) 'banish-pointer) -;; -;;(define-second-key (#\b :mod-1) 'toggle-maximize-current-frame) -;; -;;(define-second-key (#\x) 'pager-mode) -;; -;; -;;(define-second-key (#\k :mod-1) 'destroy-current-window) -;;(define-second-key (#\k) 'remove-current-window) -;; -;; -;;(define-second-key (#\g) 'create-new-default-frame) -;;(define-second-key (#\g :mod-1) 'remove-current-frame) -;; -;;(define-second-key (#\w) 'create-new-default-workspace) -;;(define-second-key (#\w :mod-1) 'remove-current-workspace) -;; -;;(define-second-key (#\o) -;; (defun b-open-next-window-in-new-workspace () -;; "Open the next window in a new workspace" -;; (setf *open-next-window-in-new-workspace* t) -;; (leave-second-mode))) -;; -;;(define-second-key (#\o :control) -;; (defun b-open-next-window-in-workspace-numbered () -;; "Open the next window in a numbered workspace" -;; (let ((number (parse-integer (or (query-string "Open next window in workspace:") "") -;; :junk-allowed t))) -;; (when (numberp number) -;; (setf *open-next-window-in-new-workspace* number))) -;; (leave-second-mode))) -;; -;; -;;(define-second-key (#\o :mod-1) -;; (defun b-open-next-window-in-new-frame-once () -;; "Open the next window in a new frame and all others in the same frame" -;; (setf *open-next-window-in-new-frame* :once) -;; (leave-second-mode))) -;; -;;(define-second-key (#\o :mod-1 :control) -;; (defun b-open-next-window-in-new-frame () -;; "Open each next window in a new frame" -;; (setf *open-next-window-in-new-frame* t) -;; (leave-second-mode))) -;; -;; -;; -;;(defmacro define-shell (key name docstring cmd) -;; "Define a second key to start a shell command" -;; `(define-second-key ,key -;; (defun ,name () -;; ,docstring -;; (setf *second-mode-program* ,cmd) -;; (leave-second-mode)))) -;; -;;(define-shell (#\c) b-start-xterm "start an xterm" "exec xterm") -;;(define-shell (#\e) b-start-emacs "start emacs" "exec emacs") -;;(define-shell (#\e :control) b-start-emacsremote -;; "start an emacs for another user" -;; "exec emacsremote-Eterm") -;;(define-shell (#\h) b-start-xclock "start an xclock" "exec xclock -d") -;; -;; -;;(define-second-key (#\a) 'force-window-center-in-frame) -;;(define-second-key (#\a :mod-1) 'force-window-in-frame) -;; -;; -;;(define-second-key (#\d :mod-1) -;; (defun b-show-debuging-info () -;; "Show debuging info" -;; (dbg *workspace-list*) -;; (dbg *screen*) -;; (dbg (xlib:query-tree *root*)))) -;; -;;(define-second-key (#\t :control) 'tile-current-workspace-vertically) -;;(define-second-key (#\t :shift :control) 'tile-current-workspace-horizontally) -;; -;;(define-second-key (#\y) 'tile-current-workspace-to) -;;(define-second-key (#\y :mod-1) 'reconfigure-tile-workspace) -;;(define-second-key (#\y :control) 'explode-current-frame) -;;(define-second-key (#\y :control :shift) 'implode-current-frame) -;; -;;;;;,----- -;;;;;| Moving/Resizing frames -;;;;;`----- -;;(define-second-key (#\p) -;; (defun b-pack-frame-on-next-arrow () -;; "Pack frame on next arrow action" -;; (setf *arrow-action* :pack))) -;; -;; -;;(defun fill-frame-in-all-directions () -;; "Fill frame in all directions" -;; (fill-current-frame-up) -;; (fill-current-frame-left) -;; (fill-current-frame-right) -;; (fill-current-frame-down)) -;; -;; -;;(define-second-key (#\f) -;; (defun b-fill-frame () -;; "Fill frame on next arrow action (fill in all directions on second f keypress)" -;; (case *arrow-action* -;; (:fill (fill-frame-in-all-directions) -;; (setf *arrow-action* nil)) -;; (t (setf *arrow-action* :fill))))) -;; -;;(define-second-key (#\f :mod-1) 'fill-frame-in-all-directions) -;; -;;(define-second-key (#\f :shift) -;; (defun b-fill-frame-vert () -;; "Fill frame vertically" -;; (fill-current-frame-up) -;; (fill-current-frame-down))) -;; -;;(define-second-key (#\f :control) -;; (defun b-fill-frame-horiz () -;; "Fill frame horizontally" -;; (fill-current-frame-left) -;; (fill-current-frame-right))) -;; -;; -;;(define-second-key (#\r) -;; (defun b-resize-half () -;; "Resize frame to its half width or heigth on next arraw action" -;; (setf *arrow-action* :resize-half))) -;; -;; -;;(define-second-key (#\l) 'resize-minimal-current-frame) -;;(define-second-key (#\l :mod-1) 'resize-down-current-frame) -;; -;; -;;(define-second-key (#\m) 'center-current-frame) -;; -;; -;;(define-second-key ("Up") -;; (defun b-move-or-pack-up () -;; "Move, pack, fill or resize frame up" -;; (case *arrow-action* -;; (:pack (pack-current-frame-up)) -;; (:fill (fill-current-frame-up)) -;; (:resize-half (resize-half-height-up-current-frame)) -;; (t (move-frame (current-frame) 0 -10))) -;; (setf *arrow-action* nil))) -;; -;;(define-second-key ("Down") -;; (defun b-move-or-pack-down () -;; "Move, pack, fill or resize frame down" -;; (case *arrow-action* -;; (:pack (pack-current-frame-down)) -;; (:fill (fill-current-frame-down)) -;; (:resize-half (resize-half-height-down-current-frame)) -;; (t (move-frame (current-frame) 0 +10))) -;; (setf *arrow-action* nil))) -;; -;;(define-second-key ("Right") -;; (defun b-move-or-pack-right () -;; "Move, pack, fill or resize frame right" -;; (case *arrow-action* -;; (:pack (pack-current-frame-right)) -;; (:fill (fill-current-frame-right)) -;; (:resize-half (resize-half-width-right-current-frame)) -;; (t (move-frame (current-frame) +10 0))) -;; (setf *arrow-action* nil))) -;; -;;(define-second-key ("Left") -;; (defun b-move-or-pack-left () -;; "Move, pack, fill or resize frame left" -;; (case *arrow-action* -;; (:pack (pack-current-frame-left)) -;; (:fill (fill-current-frame-left)) -;; (:resize-half (resize-half-width-left-current-frame)) -;; (t (move-frame (current-frame) -10 0))) -;; (setf *arrow-action* nil))) -;; -;; -;;(define-second-key ("Up" :shift) -;; (defun b-resize-up () -;; "Resize frame up" -;; (resize-frame (current-frame) 0 -10))) -;; -;;(define-second-key ("Down" :shift) -;; (defun b-resize-down () -;; "Resize frame down" -;; (resize-frame (current-frame) 0 +10))) -;; -;;(define-second-key ("Right" :shift) -;; (defun b-resize-right () -;; "Resize frame right" -;; (resize-frame (current-frame) +10 0))) -;; -;;(define-second-key ("Left" :shift) -;; (defun b-resize-left () -;; "Resize frame left" -;; (resize-frame (current-frame) -10 0))) -;; -;; -;;;;;,----- -;;;;;| Mouse second mode functions -;;;;;`----- -;;(defun select-frame-under-mouse (root-x root-y) -;; (let ((frame (find-frame-under-mouse root-x root-y))) -;; (when frame -;; (no-focus) -;; (focus-frame frame (current-workspace)) -;; (focus-window (current-window)) -;; (show-all-frame (current-workspace) nil)))) -;; -;;(defun mouse-leave-second-mode-maximize (root-x root-y) -;; "Leave second mode and maximize current frame" -;; (select-frame-under-mouse root-x root-y) -;; (maximize-frame (current-frame)) -;; (show-all-windows-in-workspace (current-workspace)) -;; (throw 'exit-second-loop nil)) -;; -;;(defun mouse-leave-second-mode (root-x root-y) -;; "Leave second mode" -;; (select-frame-under-mouse root-x root-y) -;; (show-all-windows-in-workspace (current-workspace)) -;; (throw 'exit-second-loop nil)) -;; -;; -;; -;; -;;(defun mouse-circulate-window-up (root-x root-y) -;; "Rotate window up" -;; (declare (ignore root-x root-y)) -;; (rotate-window-up)) -;; -;; -;;(defun mouse-circulate-window-down (root-x root-y) -;; "Rotate window down" -;; (declare (ignore root-x root-y)) -;; (rotate-window-down)) -;; -;; -;; -;;(defun mouse-circulate-workspace-up (root-x root-y) -;; "Circulate up in workspaces" -;; (declare (ignore root-x root-y)) -;; (circulate-workspace-up)) -;; -;; -;;(defun mouse-circulate-workspace-down (root-x root-y) -;; "Circulate down in workspaces" -;; (declare (ignore root-x root-y)) -;; (circulate-workspace-down)) -;; -;; -;; -;; -;;(defun init-motion-vars () -;; (setf *motion-action* nil -;; *motion-object* nil -;; *motion-start-frame* nil -;; *motion-dx* nil -;; *motion-dy* nil)) -;; -;; -;;(let ((accept-motion t) -;; (selected-frame nil)) -;; (defun mouse-motion (root-x root-y) -;; "Move or resize frame. Move window from a frame to another. -;;Go to top left or rigth corner to change workspaces." -;; (let ((frame (find-frame-under-mouse root-x root-y))) -;; (unless (equal selected-frame frame) -;; (select-frame-under-mouse root-x root-y) -;; (setf selected-frame frame))) -;; (if (<= root-y 5) -;; (cond ((and accept-motion (<= root-x 5)) -;; (case *motion-action* -;; (:move-frame -;; (remove-frame-in-workspace *motion-object* (current-workspace)))) -;; (circulate-workspace-down) -;; (minimize-frame (current-frame)) -;; (case *motion-action* -;; (:move-frame -;; (add-frame-in-workspace *motion-object* (current-workspace)))) -;; (warp-pointer *root* (1- (xlib:screen-width *screen*)) 100) -;; (setf accept-motion nil)) -;; ((and accept-motion (>= root-x (- (xlib:screen-width *screen*) 5))) -;; (case *motion-action* -;; (:move-frame -;; (remove-frame-in-workspace *motion-object* (current-workspace)))) -;; (circulate-workspace-up) -;; (minimize-frame (current-frame)) -;; (case *motion-action* -;; (:move-frame -;; (add-frame-in-workspace *motion-object* (current-workspace)))) -;; (warp-pointer *root* 0 100) -;; (setf accept-motion nil)) -;; (t (setf accept-motion t))) -;; (setf accept-motion t)) -;; (case *motion-action* -;; (:move-frame -;; (hide-frame *root* *motion-object*) -;; (setf (frame-x *motion-object*) (+ root-x *motion-dx*) -;; (frame-y *motion-object*) (+ root-y *motion-dy*)) -;; (show-frame *root* *root-gc* *motion-object*) -;; (adapt-all-window-in-frame *motion-object*) -;; (show-all-frame (current-workspace) nil)) -;; (:resize-frame -;; (hide-frame *root* *motion-object*) -;; (setf (frame-width *motion-object*) (max (+ (frame-width *motion-object*) (- root-x *motion-dx*)) 100) -;; (frame-height *motion-object*) (max (+ (frame-height *motion-object*) (- root-y *motion-dy*)) 100) -;; *motion-dx* root-x *motion-dy* root-y) -;; (show-frame *root* *root-gc* *motion-object*) -;; (adapt-all-window-in-frame *motion-object*) -;; (show-all-frame (current-workspace) nil))))) -;; -;; -;; -;;(defun move-selected-frame (root-x root-y) -;; "Move selected frame or create a new frame on the root window" -;; (select-frame-under-mouse root-x root-y) -;; (setf *motion-object* (find-frame-under-mouse root-x root-y)) -;; (if *motion-object* -;; (setf *motion-action* :move-frame -;; *motion-dx* (- (frame-x *motion-object*) root-x) -;; *motion-dy* (- (frame-y *motion-object*) root-y)) -;; (progn -;; (setf *motion-object* (make-frame :x root-x :y root-y :width 100 :height 100 :fullscreenp nil)) -;; (warp-pointer *root* (+ root-x 100) (+ root-y 100)) -;; (add-frame-in-workspace *motion-object* (current-workspace)) -;; (show-all-frame (current-workspace)) -;; (setf *motion-action* :resize-frame -;; *motion-dx* (+ root-x 100) -;; *motion-dy* (+ root-y 100))))) -;; -;; -;; -;;(defun copy-selected-frame (root-x root-y) -;; "Copy selected frame" -;; (xgrab-pointer *root* 50 51) -;; (select-frame-under-mouse root-x root-y) -;; (setf *motion-object* (find-frame-under-mouse root-x root-y)) -;; (when *motion-object* -;; (setf *motion-action* :copy-frame -;; *motion-object* (copy-frame *motion-object*) -;; *motion-dx* (- (frame-x *motion-object*) root-x) -;; *motion-dy* (- (frame-y *motion-object*) root-y)))) -;;;; (add-frame-in-workspace *motion-object* (current-workspace)))) -;; -;; -;; -;;(defun release-move-selected-frame (root-x root-y) -;; "Release button" -;; (when *motion-object* -;; (case *motion-action* -;; (:move-frame -;; (move-frame-to *motion-object* (+ root-x *motion-dx*) (+ root-y *motion-dy*))) -;; (:resize-frame -;; (resize-frame *motion-object* 0 0)))) -;; (init-motion-vars) -;; (select-frame-under-mouse root-x root-y)) -;; -;; -;;(defun release-copy-selected-frame (root-x root-y) -;; "Release button" -;; (xgrab-pointer *root* 66 67) -;; (when *motion-object* -;; (unless (frame-windows-already-in-workspace *motion-object* (current-workspace)) -;; (add-frame-in-workspace *motion-object* (current-workspace)) -;; (move-frame-to *motion-object* (+ root-x *motion-dx*) (+ root-y *motion-dy*)))) -;; (init-motion-vars) -;; (select-frame-under-mouse root-x root-y) -;; (show-all-windows-in-workspace (current-workspace))) -;; -;; -;; -;;(defun resize-selected-frame (root-x root-y) -;; "Resize selected frame" -;; (select-frame-under-mouse root-x root-y) -;; (setf *motion-object* (find-frame-under-mouse root-x root-y)) -;; (when *motion-object* -;; (setf *motion-action* :resize-frame -;; *motion-dx* root-x -;; *motion-dy* root-y))) -;; -;; -;;(defun release-resize-selected-frame (root-x root-y) -;; "Release button" -;; (when *motion-object* -;; (resize-frame *motion-object* 0 0)) -;; (init-motion-vars) -;; (select-frame-under-mouse root-x root-y)) -;; -;; -;; -;;(defun move-selected-window (root-x root-y) -;; "Move selected window" -;; (xgrab-pointer *root* 50 51) -;; (select-frame-under-mouse root-x root-y) -;; (setf *motion-object* (current-window) -;; *motion-action* :move-window) -;; (when *motion-object* -;; (setf *motion-start-frame* (current-frame)))) -;; -;; -;;(defun release-move-selected-window (root-x root-y) -;; "Release button" -;; (xgrab-pointer *root* 66 67) -;; (select-frame-under-mouse root-x root-y) -;; (when *motion-object* -;; (remove-window-in-frame *motion-object* *motion-start-frame*) -;; (add-window-in-frame *motion-object* (current-frame))) -;; (init-motion-vars) -;; (select-frame-under-mouse root-x root-y) -;; (show-all-windows-in-workspace (current-workspace))) -;; -;; -;; -;;(defun copy-selected-window (root-x root-y) -;; "Copy selected window" -;; (move-selected-window root-x root-y) -;; (setf *motion-action* :copy-window)) -;; -;;(defun release-copy-selected-window (root-x root-y) -;; "Release button" -;; (xgrab-pointer *root* 66 67) -;; (select-frame-under-mouse root-x root-y) -;; (when *motion-object* -;; (unless (window-already-in-workspace *motion-object* (current-workspace)) -;; (add-window-in-frame *motion-object* (current-frame)))) -;; (init-motion-vars) -;; (select-frame-under-mouse root-x root-y) -;; (show-all-windows-in-workspace (current-workspace))) -;; -;; -;; -;; -;; -;; -;;(define-second-mouse (1) 'move-selected-frame 'release-move-selected-frame) -;;(define-second-mouse (1 :mod-1) 'resize-selected-frame 'release-resize-selected-frame) -;;(define-second-mouse (1 :control) 'copy-selected-frame 'release-copy-selected-frame) -;; -;;(define-second-mouse (2) nil 'mouse-leave-second-mode-maximize) -;;(define-second-mouse (2 :control) nil 'mouse-leave-second-mode) -;; -;;(define-second-mouse (3) 'move-selected-window 'release-move-selected-window) -;;(define-second-mouse (3 :control) 'copy-selected-window 'release-copy-selected-window) -;; -;; -;;(define-second-mouse (4) 'mouse-circulate-window-up nil) -;;(define-second-mouse (5) 'mouse-circulate-window-down nil) -;; -;;(define-second-mouse (4 :mod-1) 'mouse-circulate-workspace-up nil) -;;(define-second-mouse (5 :mod-1) 'mouse-circulate-workspace-down nil) -;; -;;(define-second-mouse ('Motion) 'mouse-motion nil) - +(add-hook *binding-hook* 'set-default-second-mouse) Modified: clfswm/src/bindings.lisp ============================================================================== --- clfswm/src/bindings.lisp (original) +++ clfswm/src/bindings.lisp Sat Oct 25 22:11:38 2008 @@ -31,65 +31,50 @@ ;;;| CONFIG - Bindings main mode ;;;`----- -(define-main-key ("F1" :mod-1) 'help-on-clfswm) -(define-main-key ("Home" :mod-1 :control :shift) 'exit-clfswm) +(add-hook *binding-hook* 'init-*main-keys* 'init-*main-mouse*) -(define-main-key ("Right" :mod-1) 'select-next-sister) -(define-main-key ("Left" :mod-1) 'select-previous-sister) +(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 ("Right" :mod-1) 'select-next-sister) + (define-main-key ("Left" :mod-1) 'select-previous-sister) + (define-main-key ("Down" :mod-1) 'select-previous-level) + (define-main-key ("Up" :mod-1) 'select-next-level) + (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) + (define-main-key ("Return" :mod-1) 'enter-frame) + (define-main-key ("Return" :mod-1 :shift) 'leave-frame) + (define-main-key ("Page_Up" :mod-1) 'frame-lower-child) + (define-main-key ("Page_Down" :mod-1) 'frame-raise-child) + (define-main-key ("Home" :mod-1) 'switch-to-root-frame) + (define-main-key ("Home" :mod-1 :shift) 'switch-and-select-root-frame) + (define-main-key ("Menu") 'fast-layout-switch) + (define-main-key ("Menu" :mod-1) 'show-all-frames-info-key) + (define-main-key ("Menu" :shift) 'show-all-frames-info) + (define-main-key ("Menu" :control) 'toggle-show-root-frame) + (define-main-key (#\b :mod-1) 'banish-pointer) + ;; Escape + (define-main-key ("Escape" :control :shift) 'delete-focus-window) + (define-main-key ("Escape" :mod-1 :control :shift) 'destroy-focus-window) + (define-main-key ("Escape" :control) 'remove-focus-window) + (define-main-key ("Escape" :shift) 'unhide-all-windows-in-current-child) + (define-main-key (#\t :mod-1) 'second-key-mode) + (define-main-key ("less" :control) 'second-key-mode) + ;; Bind or jump functions + (define-main-key ("1" :mod-1) 'bind-or-jump 1) + (define-main-key ("2" :mod-1) 'bind-or-jump 2) + (define-main-key ("3" :mod-1) 'bind-or-jump 3) + (define-main-key ("4" :mod-1) 'bind-or-jump 4) + (define-main-key ("5" :mod-1) 'bind-or-jump 5) + (define-main-key ("6" :mod-1) 'bind-or-jump 6) + (define-main-key ("7" :mod-1) 'bind-or-jump 7) + (define-main-key ("8" :mod-1) 'bind-or-jump 8) + (define-main-key ("9" :mod-1) 'bind-or-jump 9) + (define-main-key ("0" :mod-1) 'bind-or-jump 10)) -(define-main-key ("Down" :mod-1) 'select-previous-level) -(define-main-key ("Up" :mod-1) 'select-next-level) - -(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) - -(define-main-key ("Return" :mod-1) 'enter-frame) -(define-main-key ("Return" :mod-1 :shift) 'leave-frame) - -(define-main-key ("Page_Up" :mod-1) 'frame-lower-child) -(define-main-key ("Page_Down" :mod-1) 'frame-raise-child) - - -(define-main-key ("Home" :mod-1) 'switch-to-root-frame) -(define-main-key ("Home" :mod-1 :shift) 'switch-and-select-root-frame) - -(define-main-key ("Menu") 'fast-layout-switch) - -(define-main-key ("Menu" :mod-1) 'show-all-frames-info-key) -(define-main-key ("Menu" :shift) 'show-all-frames-info) -(define-main-key ("Menu" :control) 'toggle-show-root-frame) - -(define-main-key (#\b :mod-1) 'banish-pointer) - - -;;;; Escape -(define-main-key ("Escape" :control :shift) 'delete-focus-window) -(define-main-key ("Escape" :mod-1 :control :shift) 'destroy-focus-window) -(define-main-key ("Escape" :control) 'remove-focus-window) -(define-main-key ("Escape" :shift) 'unhide-all-windows-in-current-child) - - -(define-main-key (#\t :mod-1) 'second-key-mode) -(define-main-key ("less" :control) 'second-key-mode) - - - - - - -;;; Bind or jump functions -(define-main-key ("1" :mod-1) 'bind-or-jump 1) -(define-main-key ("2" :mod-1) 'bind-or-jump 2) -(define-main-key ("3" :mod-1) 'bind-or-jump 3) -(define-main-key ("4" :mod-1) 'bind-or-jump 4) -(define-main-key ("5" :mod-1) 'bind-or-jump 5) -(define-main-key ("6" :mod-1) 'bind-or-jump 6) -(define-main-key ("7" :mod-1) 'bind-or-jump 7) -(define-main-key ("8" :mod-1) 'bind-or-jump 8) -(define-main-key ("9" :mod-1) 'bind-or-jump 9) -(define-main-key ("0" :mod-1) 'bind-or-jump 10) +(add-hook *binding-hook* 'set-default-main-keys) ;; For an azery keyboard: @@ -125,121 +110,18 @@ (stop-button-event) (mouse-focus-move/resize-generic root-x root-y #'resize-frame t)) +(defun set-default-main-mouse () + (define-main-mouse (1) 'mouse-click-to-focus-and-move) + (define-main-mouse (2) 'mouse-middle-click) + (define-main-mouse (3) 'mouse-click-to-focus-and-resize) + (define-main-mouse (1 :mod-1) 'mouse-click-to-focus-and-move-window) + (define-main-mouse (3 :mod-1) 'mouse-click-to-focus-and-resize-window) + (define-main-mouse (1 :control :mod-1) 'mouse-move-window-over-frame) + (define-main-mouse (4) 'mouse-select-next-level) + (define-main-mouse (5) 'mouse-select-previous-level) + (define-main-mouse (4 :mod-1) 'mouse-enter-frame) + (define-main-mouse (5 :mod-1) 'mouse-leave-frame)) + +(add-hook *binding-hook* 'set-default-main-mouse) -(define-main-mouse (1) 'mouse-click-to-focus-and-move) -(define-main-mouse (2) 'mouse-middle-click) -(define-main-mouse (3) 'mouse-click-to-focus-and-resize) - -(define-main-mouse (1 :mod-1) 'mouse-click-to-focus-and-move-window) -(define-main-mouse (3 :mod-1) 'mouse-click-to-focus-and-resize-window) - -(define-main-mouse (1 :control :mod-1) 'mouse-move-window-over-frame) - -(define-main-mouse (4) 'mouse-select-next-level) -(define-main-mouse (5) 'mouse-select-previous-level) - -(define-main-mouse (4 :mod-1) 'mouse-enter-frame) -(define-main-mouse (5 :mod-1) 'mouse-leave-frame) - -;;(define-main-mouse (1) 'handle-click-to-focus 'test-mouse-binding) -;;(define-main-mouse ('motion) 'test-mouse-binding) - - -;;(define-main-key ("a") (lambda () -;; (dbg 'key-a) -;; (show-all-children *root-frame*))) -;; -;;(define-main-key ("b") (lambda () -;; (dbg 'key-b) -;; (let* ((window (xlib:create-window :parent *root* -;; :x 300 -;; :y 200 -;; :width 400 -;; :height 300 -;; :background (get-color "Black") -;; :colormap (xlib:screen-default-colormap *screen*) -;; :border-width 1 -;; :border (get-color "Red") -;; :class :input-output -;; :event-mask '(:exposure))) -;; (gc (xlib:create-gcontext :drawable window -;; :foreground (get-color "Green") -;; :background (get-color "Red") -;; :font *default-font* -;; :line-style :solid))) -;; (xlib:map-window window) -;; (draw-line window gc 10 10 200 200) -;; (xlib:display-finish-output *display*) -;; (xlib:draw-glyphs window gc 10 10 (format nil "~A" 10)) -;; (dbg 'ici)))) -;; -;; -;;;;(define-main-key ("F1" :mod-1) 'help-on-clfswm) -;;;; -;;(defun exit-clfswm () -;; "Quit clfswm" -;; (throw 'exit-main-loop nil)) -;; -;; -;; -;;(define-main-key ("Home" :mod-1 :control :shift) 'exit-clfswm) -;; -;;(define-main-key (#\t :mod-1) 'second-key-mode) -;;(define-main-key ("less" :control) 'second-key-mode) -;; -;;(define-main-key ("Tab" :mod-1) 'rotate-window-up) -;;(define-main-key ("Tab" :mod-1 :shift) 'rotate-window-down) -;; -;;(define-main-key (#\b :mod-1) 'banish-pointer) -;;(define-main-key (#\b :mod-1 :control) 'toggle-maximize-current-frame) -;; -;;;; Escape -;;(define-main-key ("Escape" :control :shift) 'delete-current-window) -;;(define-main-key ("Escape" :mod-1 :control :shift) 'destroy-current-window) -;;(define-main-key ("Escape" :control) 'remove-current-window) -;;(define-main-key ("Escape" :shift) 'unhide-all-windows-in-current-frame) -;; -;; -;;;; Up -;;(define-main-key ("Up" :mod-1) 'circulate-frame-up) -;;(define-main-key ("Up" :mod-1 :shift) 'circulate-frame-up-move-window) -;;(define-main-key ("Up" :mod-1 :shift :control) 'circulate-frame-up-copy-window) -;; -;; -;;;; Down -;;(define-main-key ("Down" :mod-1) 'circulate-frame-down) -;;(define-main-key ("Down" :mod-1 :shift) 'circulate-frame-down-move-window) -;;(define-main-key ("Down" :mod-1 :shift :control) 'circulate-frame-down-copy-window) -;; -;; -;;;; Right -;;(define-main-key ("Right" :mod-1) 'circulate-workspace-up) -;;(define-main-key ("Right" :mod-1 :shift) 'circulate-workspace-up-move-frame) -;;(define-main-key ("Right" :mod-1 :shift :control) 'circulate-workspace-up-copy-frame) -;; -;; -;;;; Left -;;(define-main-key ("Left" :mod-1) 'circulate-workspace-down) -;;(define-main-key ("Left" :mod-1 :shift) 'circulate-workspace-down-move-frame) -;;(define-main-key ("Left" :mod-1 :shift :control) 'circulate-workspace-down-copy-frame) -;; -;; -;; -;;(defmacro define-main-focus-workspace-by-number (key number) -;; "Define a main key to focus a workspace by its number" -;; `(define-main-key ,key -;; (defun ,(create-symbol (format nil "b-main-focus-workspace-~A" number)) () -;; ,(format nil "Focus workspace ~A" number) -;; (circulate-workspace-by-number ,number)))) -;; -;;(define-main-focus-workspace-by-number (#\1 :mod-1) 1) -;;(define-main-focus-workspace-by-number (#\2 :mod-1) 2) -;;(define-main-focus-workspace-by-number (#\3 :mod-1) 3) -;;(define-main-focus-workspace-by-number (#\4 :mod-1) 4) -;;(define-main-focus-workspace-by-number (#\5 :mod-1) 5) -;;(define-main-focus-workspace-by-number (#\6 :mod-1) 6) -;;(define-main-focus-workspace-by-number (#\7 :mod-1) 7) -;;(define-main-focus-workspace-by-number (#\8 :mod-1) 8) -;;(define-main-focus-workspace-by-number (#\9 :mod-1) 9) -;;(define-main-focus-workspace-by-number (#\0 :mod-1) 10) Modified: clfswm/src/clfswm-info.lisp ============================================================================== --- clfswm/src/clfswm-info.lisp (original) +++ clfswm/src/clfswm-info.lisp Sat Oct 25 22:11:38 2008 @@ -72,67 +72,61 @@ ;;;| Key binding ;;;`----- -(define-info-key (#\q) 'leave-info-mode) -(define-info-key ("Return") 'leave-info-mode) -(define-info-key ("Escape") 'leave-info-mode) - -(define-info-key ("twosuperior") - (defun info-banish-pointer (info) - "Move the pointer to the lower right corner of the screen" - (declare (ignore info)) - (banish-pointer))) - -(define-info-key ("Down") - (defun info-next-line (info) - "Move one line down" - (setf (info-y info) (min (+ (info-y info) (info-ilh info)) (info-max-y info))) - (draw-info-window info))) - -(define-info-key ("Up") - (defun info-previous-line (info) - "Move one line up" - (setf (info-y info) (max (- (info-y info) (info-ilh info)) 0)) - (draw-info-window info))) - -(define-info-key ("Left") - (defun info-previous-char (info) - "Move one char left" - (setf (info-x info) (max (- (info-x info) (info-ilw info)) 0)) - (draw-info-window info))) - -(define-info-key ("Right") - (defun info-next-char (info) - "Move one char right" - (setf (info-x info) (min (+ (info-x info) (info-ilw info)) (info-max-x info))) - (draw-info-window info))) - - -(define-info-key ("Home") - (defun info-first-line (info) - "Move to first line" - (setf (info-x info) 0 - (info-y info) 0) - (draw-info-window info))) - -(define-info-key ("End") - (defun info-end-line (info) - "Move to last line" - (setf (info-x info) 0 - (info-y info) (- (* (length (info-list info)) (info-ilh info)) (xlib:drawable-height (info-window info)))) - (draw-info-window info))) - - -(define-info-key ("Page_Down") - (defun info-next-ten-lines (info) - "Move ten lines down" - (setf (info-y info) (min (+ (info-y info) (* (info-ilh info) 10)) (info-max-y info))) - (draw-info-window info))) - -(define-info-key ("Page_Up") - (defun info-previous-ten-lines (info) - "Move ten lines up" - (setf (info-y info) (max (- (info-y info) (* (info-ilh info) 10)) 0)) - (draw-info-window info))) +(add-hook *binding-hook* 'init-*info-keys* 'init-*info-mouse*) + +(defun set-default-info-keys () + (define-info-key (#\q) 'leave-info-mode) + (define-info-key ("Return") 'leave-info-mode) + (define-info-key ("Escape") 'leave-info-mode) + (define-info-key ("twosuperior") + (defun info-banish-pointer (info) + "Move the pointer to the lower right corner of the screen" + (declare (ignore info)) + (banish-pointer))) + (define-info-key ("Down") + (defun info-next-line (info) + "Move one line down" + (setf (info-y info) (min (+ (info-y info) (info-ilh info)) (info-max-y info))) + (draw-info-window info))) + (define-info-key ("Up") + (defun info-previous-line (info) + "Move one line up" + (setf (info-y info) (max (- (info-y info) (info-ilh info)) 0)) + (draw-info-window info))) + (define-info-key ("Left") + (defun info-previous-char (info) + "Move one char left" + (setf (info-x info) (max (- (info-x info) (info-ilw info)) 0)) + (draw-info-window info))) + (define-info-key ("Right") + (defun info-next-char (info) + "Move one char right" + (setf (info-x info) (min (+ (info-x info) (info-ilw info)) (info-max-x info))) + (draw-info-window info))) + (define-info-key ("Home") + (defun info-first-line (info) + "Move to first line" + (setf (info-x info) 0 + (info-y info) 0) + (draw-info-window info))) + (define-info-key ("End") + (defun info-end-line (info) + "Move to last line" + (setf (info-x info) 0 + (info-y info) (- (* (length (info-list info)) (info-ilh info)) (xlib:drawable-height (info-window info)))) + (draw-info-window info))) + (define-info-key ("Page_Down") + (defun info-next-ten-lines (info) + "Move ten lines down" + (setf (info-y info) (min (+ (info-y info) (* (info-ilh info) 10)) (info-max-y info))) + (draw-info-window info))) + (define-info-key ("Page_Up") + (defun info-previous-ten-lines (info) + "Move ten lines up" + (setf (info-y info) (max (- (info-y info) (* (info-ilh info) 10)) 0)) + (draw-info-window info)))) + +(add-hook *binding-hook* 'set-default-info-keys) @@ -180,12 +174,14 @@ +(defun set-default-info-mouse () + (define-info-mouse (1) 'info-begin-grab 'info-end-grab) + (define-info-mouse (2) 'mouse-leave-info-mode) + (define-info-mouse (4) 'info-mouse-previous-line) + (define-info-mouse (5) 'info-mouse-next-line) + (define-info-mouse ('Motion) 'info-mouse-motion nil)) -(define-info-mouse (1) 'info-begin-grab 'info-end-grab) -(define-info-mouse (2) 'mouse-leave-info-mode) -(define-info-mouse (4) 'info-mouse-previous-line) -(define-info-mouse (5) 'info-mouse-next-line) -(define-info-mouse ('Motion) 'info-mouse-motion nil) +(add-hook *binding-hook* 'set-default-info-mouse) ;;;,----- @@ -305,7 +301,7 @@ (let ((info-list nil) (action nil)) (labels ((define-key (key function) - (define-info-key-fun (list key (modifiers->state *default-modifiers*)) + (define-info-key-fun (list key) (lambda (&optional args) (declare (ignore args)) (setf action function) @@ -328,7 +324,7 @@ (dolist (item item-list) (when (consp item) (let ((key (first item))) - (undefine-info-key-fun (list key (modifiers->state *default-modifiers*)))))) + (undefine-info-key-fun (list key))))) (typecase action (function (funcall action)) (symbol (when (fboundp action) Modified: clfswm/src/clfswm-keys.lisp ============================================================================== --- clfswm/src/clfswm-keys.lisp (original) +++ clfswm/src/clfswm-keys.lisp Sat Oct 25 22:11:38 2008 @@ -31,43 +31,63 @@ +(defun with-capslock () + (pushnew :lock *default-modifiers*)) + +(defun without-capslock () + (setf *default-modifiers* (remove :lock *default-modifiers*))) + +(defun with-numlock () + (pushnew :mod-2 *default-modifiers*)) + +(defun without-cnumlock () + (setf *default-modifiers* (remove :mod-2 *default-modifiers*))) + -(defun define-hash-table-key-name (hash-table name) - (setf (gethash 'name hash-table) name)) ;;; CONFIG - Key mode names +(defmacro define-init-hash-table-key (hash-table name) + (let ((init-name (create-symbol "init-" (format nil "~A" hash-table)))) + `(progn + (defun ,init-name () + (setf ,hash-table (make-hash-table :test 'equal)) + (setf (gethash 'name ,hash-table) ,name)) + (,init-name)))) + +(define-init-hash-table-key *main-keys* "Main mode keys") +(define-init-hash-table-key *main-mouse* "Mouse buttons actions in main mode") +(define-init-hash-table-key *second-keys* "Second mode keys") +(define-init-hash-table-key *second-mouse* "Mouse buttons actions in second mode") +(define-init-hash-table-key *info-keys* "Info mode keys") +(define-init-hash-table-key *info-mouse* "Mouse buttons actions in info mode") -(define-hash-table-key-name *main-keys* "Main mode keys") -(define-hash-table-key-name *main-mouse* "Mouse buttons actions in main mode") -(define-hash-table-key-name *second-keys* "Second mode keys") -(define-hash-table-key-name *second-mouse* "Mouse buttons actions in second mode") -(define-hash-table-key-name *info-keys* "Info mode keys") -(define-hash-table-key-name *info-mouse* "Mouse buttons actions in info mode") +(defun key->list (key) + (list (first key) (modifiers->state (append (rest key) *default-modifiers*)))) (defmacro define-define-key (name hashtable) (let ((name-key-fun (create-symbol "define-" name "-key-fun")) (name-key (create-symbol "define-" name "-key")) + (undefine-name-fun (create-symbol "undefine-" name "-key-fun")) (undefine-name (create-symbol "undefine-" name "-key")) (undefine-multi-name (create-symbol "undefine-" name "-multi-keys"))) `(progn (defun ,name-key-fun (key function &rest args) - "Define a new key, a key is '(char '(modifier list))" - (setf (gethash key ,hashtable) (list function args))) - + "Define a new key, a key is '(char modifier1 modifier2...))" + (setf (gethash (key->list key) ,hashtable) (list function args))) (defmacro ,name-key ((key &rest modifiers) function &rest args) - `(,',name-key-fun (list ,key ,(modifiers->state (append modifiers *default-modifiers*))) ,function , at args)) - + `(,',name-key-fun (list ,key , at modifiers) ,function , at args)) + (defun ,undefine-name-fun (key) + "Undefine a new key, a key is '(char modifier1 modifier2...))" + (remhash (key->list key) ,hashtable)) (defmacro ,undefine-name ((key &rest modifiers)) - `(remhash (list ,key ,(modifiers->state (append modifiers *default-modifiers*))) ,',hashtable)) - + `(,',undefine-name-fun (list ,key , at modifiers))) (defmacro ,undefine-multi-name (&rest keys) `(progn ,@(loop for k in keys collect `(,',undefine-name ,k))))))) - (defmacro define-define-mouse (name hashtable) (let ((name-mouse-fun (create-symbol "define-" name "-fun")) (name-mouse (create-symbol "define-" name)) @@ -75,13 +95,11 @@ `(progn (defun ,name-mouse-fun (button function-press &optional function-release &rest args) "Define a new mouse button action, a button is '(button number '(modifier list))" - (setf (gethash button ,hashtable) (list function-press function-release args))) - + (setf (gethash (key->list button) ,hashtable) (list function-press function-release args))) (defmacro ,name-mouse ((button &rest modifiers) function-press &optional function-release &rest args) - `(,',name-mouse-fun (list ,button ,(modifiers->state (append modifiers *default-modifiers*))) ,function-press ,function-release , at args)) - + `(,',name-mouse-fun (list ,button , at modifiers) ,function-press ,function-release , at args)) (defmacro ,undefine-name ((key &rest modifiers)) - `(remhash (list ,key ,(modifiers->state (append modifiers *default-modifiers*))) ,',hashtable))))) + `(remhash (list ,key , at modifiers) ,',hashtable))))) @@ -89,11 +107,6 @@ (define-define-key "second" *second-keys*) (define-define-key "info" *info-keys*) - - -(defun undefine-info-key-fun (key) - (remhash key *info-keys*)) - (define-define-mouse "main-mouse" *main-mouse*) (define-define-mouse "second-mouse" *second-mouse*) (define-define-mouse "info-mouse" *info-mouse*) Modified: clfswm/src/clfswm-menu.lisp ============================================================================== --- clfswm/src/clfswm-menu.lisp (original) +++ clfswm/src/clfswm-menu.lisp Sat Oct 25 22:11:38 2008 @@ -129,14 +129,14 @@ (format nil ": ~A" (documentation value 'function))))) info-list) (when (menu-item-key item) - (define-info-key-fun (list (menu-item-key item) (modifiers->state *default-modifiers*)) + (define-info-key-fun (list (menu-item-key item)) (lambda (&optional args) (declare (ignore args)) (setf action value) (throw 'exit-info-loop nil)))))) (info-mode (nreverse info-list)) (dolist (item (menu-item menu)) - (undefine-info-key-fun (list (menu-item-key item) (modifiers->state *default-modifiers*)))) + (undefine-info-key-fun (list (menu-item-key item)))) (typecase action (menu (open-menu action (cons menu parent))) (null (awhen (first parent) Modified: clfswm/src/clfswm-second-mode.lisp ============================================================================== --- clfswm/src/clfswm-second-mode.lisp (original) +++ clfswm/src/clfswm-second-mode.lisp Sat Oct 25 22:11:38 2008 @@ -33,24 +33,6 @@ "Execute the program string if not nil") -;;(defun draw-second-mode-window () -;; (xlib:clear-area *sm-window*) -;; (let* ((text (format nil "Workspace ~A ~:(~A~) ~A ~A ~A" -;; (workspace-number (current-workspace)) -;; (if *arrow-action* *arrow-action* "") -;; (if *motion-action* *motion-action* "") -;; (cond ((numberp *open-next-window-in-new-workspace*) -;; (format nil ">W:~A" *open-next-window-in-new-workspace*)) -;; (*open-next-window-in-new-workspace* ">W") -;; (t "")) -;; (cond ((equal *open-next-window-in-new-frame* :once) ">G") -;; (*open-next-window-in-new-frame* ">G+") -;; (t "")))) -;; (len (length text))) -;; (xlib:draw-image-glyphs *sm-window* *sm-gc* -;; (truncate (/ (- *sm-width* (* (xlib:max-char-width *sm-font*) len)) 2)) -;; (truncate (/ (+ *sm-height* (- (font-ascent *sm-font*) (font-descent *sm-font*))) 2)) -;; text))) (defun draw-second-mode-window () Modified: clfswm/src/clfswm.lisp ============================================================================== --- clfswm/src/clfswm.lisp (original) +++ clfswm/src/clfswm.lisp Sat Oct 25 22:11:38 2008 @@ -235,6 +235,7 @@ (xgrab-init-pointer) (xgrab-init-keyboard) (init-last-child) + (call-hook *binding-hook*) (xlib:map-window *no-focus-window*) (dbg *display*) (setf (xlib:window-event-mask *root*) (xlib:make-event-mask :substructure-redirect Modified: clfswm/src/package.lisp ============================================================================== --- clfswm/src/package.lisp (original) +++ clfswm/src/package.lisp Sat Oct 25 22:11:38 2008 @@ -145,12 +145,12 @@ (defparameter *show-root-frame-p* nil) -(defparameter *main-keys* (make-hash-table :test 'equal)) -(defparameter *main-mouse* (make-hash-table :test 'equal)) -(defparameter *second-keys* (make-hash-table :test 'equal)) -(defparameter *second-mouse* (make-hash-table :test 'equal)) -(defparameter *info-keys* (make-hash-table :test 'equal)) -(defparameter *info-mouse* (make-hash-table :test 'equal)) +(defparameter *main-keys* nil) +(defparameter *main-mouse* nil) +(defparameter *second-keys* nil) +(defparameter *second-mouse* nil) +(defparameter *info-keys* nil) +(defparameter *info-mouse* nil) @@ -222,6 +222,10 @@ "Config(Hook group):") +(defparameter *binding-hook* nil + "Config(Hook group):") + + (defparameter *in-second-mode* nil) Modified: clfswm/src/tools.lisp ============================================================================== --- clfswm/src/tools.lisp (original) +++ clfswm/src/tools.lisp Sat Oct 25 22:11:38 2008 @@ -32,6 +32,7 @@ :awhen :aif :call-hook + :add-hook :dbg :dbgnl :with-all-internal-symbols @@ -124,6 +125,10 @@ result))) +(defmacro add-hook (hook &rest value) + `(setf ,hook (append ,hook (list , at value)))) + + ;;;,----- ;;;| Debuging tools From pbrochard at common-lisp.net Sun Oct 26 13:37:36 2008 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Sun, 26 Oct 2008 13:37:36 +0000 Subject: [clfswm-cvs] r191 - in clfswm: . doc Message-ID: Author: pbrochard Date: Sun Oct 26 13:37:36 2008 New Revision: 191 Log: TODO and configuration file update Modified: clfswm/TODO clfswm/doc/dot-clfswmrc Modified: clfswm/TODO ============================================================================== --- clfswm/TODO (original) +++ clfswm/TODO Sun Oct 26 13:37:36 2008 @@ -7,11 +7,7 @@ =============== Should handle these soon. -- Handle numlock properly (add :mod-2 in bindings if necessary) - (with-numlock) -> add :mod-2 in *default-modifiers* - (without-numlock) - alias :mod-1 -> :alt :mod-2 -> :numlock - => *default-modifiers* is done. <= +- Make alias for :mod-1 -> :alt :mod-2 -> :numlock - hook to create bindings and menu -> build keys and menu at runtime. Modified: clfswm/doc/dot-clfswmrc ============================================================================== --- clfswm/doc/dot-clfswmrc (original) +++ clfswm/doc/dot-clfswmrc Sun Oct 26 13:37:36 2008 @@ -21,23 +21,64 @@ ;; (setf *have-to-compress-notify* t) + +;;; -- Azerty configuration -- +;;; For the main mode +;;(defun my-binding () +;; (define-main-key ("twosuperior") 'banish-pointer) +;; (undefine-main-multi-keys (#\t :mod-1) (#\b :mod-1) (#\b :mod-1 :control)) +;; (undefine-main-multi-keys ("1" :mod-1) ("2" :mod-1) ("3" :mod-1) +;; ("4" :mod-1) ("5" :mod-1) ("6" :mod-1) +;; ("7" :mod-1) ("8" :mod-1) ("9" :mod-1) ("0" :mod-1)) +;; (define-main-key ("ampersand" :mod-1) 'bind-or-jump 1) +;; (define-main-key ("eacute" :mod-1) 'bind-or-jump 2) +;; (define-main-key ("quotedbl" :mod-1) 'bind-or-jump 3) +;; (define-main-key ("quoteright" :mod-1) 'bind-or-jump 4) +;; (define-main-key ("parenleft" :mod-1) 'bind-or-jump 5) +;; (define-main-key ("minus" :mod-1) 'bind-or-jump 6) +;; (define-main-key ("egrave" :mod-1) 'bind-or-jump 7) +;; (define-main-key ("underscore" :mod-1) 'bind-or-jump 8) +;; (define-main-key ("ccedilla" :mod-1) 'bind-or-jump 9) +;; (define-main-key ("agrave" :mod-1) 'bind-or-jump 10) +;; ;; For the second mode +;; (undefine-second-multi-keys ("1" :mod-1) ("2" :mod-1) ("3" :mod-1) +;; ("4" :mod-1) ("5" :mod-1) ("6" :mod-1) +;; ("7" :mod-1) ("8" :mod-1) ("9" :mod-1) ("0" :mod-1)) +;; (define-second-key ("ampersand" :mod-1) 'bind-or-jump 1) +;; (define-second-key ("eacute" :mod-1) 'bind-or-jump 2) +;; (define-second-key ("quotedbl" :mod-1) 'bind-or-jump 3) +;; (define-second-key ("quoteright" :mod-1) 'bind-or-jump 4) +;; (define-second-key ("parenleft" :mod-1) 'bind-or-jump 5) +;; (define-second-key ("minus" :mod-1) 'bind-or-jump 6) +;; (define-second-key ("egrave" :mod-1) 'bind-or-jump 7) +;; (define-second-key ("underscore" :mod-1) 'bind-or-jump 8) +;; (define-second-key ("ccedilla" :mod-1) 'bind-or-jump 9) +;; (define-second-key ("agrave" :mod-1) 'bind-or-jump 10)) +;; +;;(add-hook *binding-hook* 'my-binding) +;; +;;(dbg *binding-hook*) +;;;;; -- Azerty configuration end -- + + + ;;; Color configuration example ;;; ;;; See in package.lisp for all variables -(setf *color-unselected* "Blue") +;;(setf *color-unselected* "Blue") ;;; How to change the default fullscreen size -(defun get-fullscreen-size () - "Return the size of root child (values rx ry rw rh) -You can tweak this to what you want" - (values -2 -2 (+ (xlib:screen-width *screen*) 2) (- (xlib:screen-height *screen*) 20))) +;;(defun get-fullscreen-size () +;; "Return the size of root child (values rx ry rw rh) +;;You can tweak this to what you want" +;; (values -2 -2 (+ (xlib:screen-width *screen*) 2) (- (xlib:screen-height *screen*) 20))) ;;; Contributed code example ;;; See in the clfswm/contrib directory to find some contributed code ;;; and se load-contrib to load them. For example: -(load-contrib "contrib-example.lisp") +;;(load-contrib "contrib-example.lisp") @@ -46,38 +87,18 @@ ;;; ;;; See bindings.lisp, bindings-second-mode.lisp and bindings-pager.lisp ;;; for all default bindings definitions. -(undefine-main-key ("F1" :mod-1)) -(define-main-key ("F5" :mod-1) 'help-on-clfswm) - - - -;;; Binding example for apwal -(define-second-key (#\Space) - (defun tpm-apwal () - "Run Apwal" - (do-shell "exec apwal") - (show-all-windows-in-workspace (current-workspace)) - (throw 'exit-second-loop nil))) - - - - - -;;;; Reloading example -(defun my-reload-clfswm () - "Reload clfswm" - (format t "RELOADING... ") - (ungrab-main-keys) - (setf *main-keys* (make-hash-table :test 'equal)) - (asdf:oos 'asdf:load-op :clfswm) - (grab-main-keys) - (format t "Done!~%")) - - -(define-main-key ("F2" :mod-1) 'my-reload-clfswm) - -(define-main-key ("F3" :mod-1) (lambda () - (do-shell "rxvt"))) +;;(defun binding-example () +;; (undefine-main-key ("F1" :mod-1)) +;; (define-main-key ("F5" :mod-1) 'help-on-clfswm) +;; ;; Binding example for apwal +;; (define-second-key (#\Space) +;; (defun tpm-apwal () +;; "Run Apwal" +;; (do-shell "exec apwal") +;; (show-all-windows-in-workspace (current-workspace)) +;; (throw 'exit-second-loop nil)))) +;; +;;(add-hook *binding-hook* 'binding-example) @@ -85,197 +106,158 @@ ;;; ;;; See in package.lisp and clfswm.lisp, clfswm-second-mode.lisp ;;; for hook examples -(setf *key-press-hook* (list (lambda (&rest args) ; function 1 - (format t "Keyp press (before): ~A~%" args) - (force-output)) - #'handle-key-press ; function 2 (default) - (lambda (&rest args) ; function 3 - (declare (ignore args)) - (format t "Keyp press (after)~%") - (force-output)))) +;;(setf *key-press-hook* (list (lambda (&rest args) ; function 1 +;; (format t "Keyp press (before): ~A~%" args) +;; (force-output)) +;; #'handle-key-press ; function 2 (default) +;; (lambda (&rest args) ; function 3 +;; (declare (ignore args)) +;; (format t "Keyp press (after)~%") +;; (force-output)))) ;;; A more complex example I use to record my desktop and show ;;; documentation associated to each key press. -(defun display-osd (formatter &rest args) - (do-shell "pkill osd_cat") - (do-shell (format nil "echo ~A | osd_cat -d 3 -p bottom -o -60 -f -*-fixed-*-*-*-*-16-*-*-*-*-*-*-1" - (apply #'format nil formatter args))) - (force-output)) - -(defun documentation-key-from-code (hash-key code state) - (documentation (first (find-key-from-code hash-key code state)) 'function)) - - -(defun key-string (hash-key code state) - (let* ((modifiers (xlib:make-state-keys state)) - (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code 0))) - (doc (documentation-key-from-code hash-key code state))) - (values (format nil "~:(~{~A+~}~A~) : ~S" modifiers keysym doc) - doc))) - -(defun display-doc (hash-key code state) - (multiple-value-bind (str doc) - (key-string hash-key code state) - (when doc - (display-osd "~A" str)))) - -(defun display-key-osd-main (&rest event-slots &key code state &allow-other-keys) - (declare (ignore event-slots)) - (display-doc *main-keys* code state)) - -(defun display-key-osd-second (&rest event-slots &key code state &allow-other-keys) - (declare (ignore event-slots)) - (display-doc *second-keys* code state)) - -;; Define new hook or add to precedent one -(if (consp *key-press-hook*) - (push #'display-key-osd-main *key-press-hook*) - (setf *key-press-hook* (list #'display-key-osd-main #'handle-key-press))) -(setf *sm-key-press-hook* (list #'display-key-osd-second #'sm-handle-key-press)) - - -;;; Display menu functions -(defun open-menu (&optional (menu *menu*)) - "Open the main menu" - (let ((info-list nil) - (action nil)) - (dolist (item (menu-item menu)) - (let ((value (menu-item-value item))) - (push (typecase value - (menu (list (list (format nil "~A" (menu-item-key item)) *menu-color-menu-key*) - (list (format nil ": < ~A >" (menu-doc value)) *menu-color-submenu*))) - (string (list (list (format nil "~A" (menu-item-value item)) *menu-color-comment*))) - (t (list (list (format nil "~A" (menu-item-key item)) *menu-color-key*) - (format nil ": ~A" (documentation value 'function))))) - info-list) - (when (menu-item-key item) - (define-info-key-fun (list (menu-item-key item) 0) - (lambda (&optional args) - (declare (ignore args)) - (setf action value) - (throw 'exit-info-loop nil)))))) - (info-mode (nreverse info-list)) - (dolist (item (menu-item menu)) - (undefine-info-key-fun (list (menu-item-key item) 0))) - (typecase action - (menu - (display-osd "Open Menu: ~A" (menu-doc action)) ;; <- Display here - (open-menu action)) - (t (when (fboundp action) - (display-osd "~A" (documentation action 'function)) ;; <- Display here - (funcall action)))))) - - - -(defun get-fullscreen-size () - "Return the size of root child (values rx ry rw rh) -You can tweak this to what you want" - (values -2 -2 (+ (xlib:screen-width *screen*) 2) (- (xlib:screen-height *screen*) 20))) - -;;; -- Doc example end -- - - -;;; -- Azerty configuration -- -;;; For the main mode -(define-main-key ("twosuperior") 'banish-pointer) - -(undefine-main-multi-keys (#\t :mod-1) (#\b :mod-1) (#\b :mod-1 :control)) - -(undefine-main-multi-keys ("1" :mod-1) ("2" :mod-1) ("3" :mod-1) - ("4" :mod-1) ("5" :mod-1) ("6" :mod-1) - ("7" :mod-1) ("8" :mod-1) ("9" :mod-1) ("0" :mod-1)) -(define-main-key ("ampersand" :mod-1) 'bind-or-jump 1) -(define-main-key ("eacute" :mod-1) 'bind-or-jump 2) -(define-main-key ("quotedbl" :mod-1) 'bind-or-jump 3) -(define-main-key ("quoteright" :mod-1) 'bind-or-jump 4) -(define-main-key ("parenleft" :mod-1) 'bind-or-jump 5) -(define-main-key ("minus" :mod-1) 'bind-or-jump 6) -(define-main-key ("egrave" :mod-1) 'bind-or-jump 7) -(define-main-key ("underscore" :mod-1) 'bind-or-jump 8) -(define-main-key ("ccedilla" :mod-1) 'bind-or-jump 9) -(define-main-key ("agrave" :mod-1) 'bind-or-jump 10) - - -;;; For the second mode -(undefine-second-multi-keys ("1" :mod-1) ("2" :mod-1) ("3" :mod-1) - ("4" :mod-1) ("5" :mod-1) ("6" :mod-1) - ("7" :mod-1) ("8" :mod-1) ("9" :mod-1) ("0" :mod-1)) -(define-second-key ("ampersand" :mod-1) 'bind-or-jump 1) -(define-second-key ("eacute" :mod-1) 'bind-or-jump 2) -(define-second-key ("quotedbl" :mod-1) 'bind-or-jump 3) -(define-second-key ("quoteright" :mod-1) 'bind-or-jump 4) -(define-second-key ("parenleft" :mod-1) 'bind-or-jump 5) -(define-second-key ("minus" :mod-1) 'bind-or-jump 6) -(define-second-key ("egrave" :mod-1) 'bind-or-jump 7) -(define-second-key ("underscore" :mod-1) 'bind-or-jump 8) -(define-second-key ("ccedilla" :mod-1) 'bind-or-jump 9) -(define-second-key ("agrave" :mod-1) 'bind-or-jump 10) -;;; -- Azerty configuration end -- - - - -;;; Init hook examples: -(defun my-init-hook-1 () - (dbg 'my-init-hook) - ;;(add-frame (create-frame :name "Default" :layout #'tile-left-layout :data (list '(:tile-size 0.6))) *root-frame*) - (add-frame (create-frame :name "The Gimp" :x 0.6 :y 0 :w 0.3 :h 0.2) *root-frame*) - (add-frame (create-frame :name "Net" :x 0.52 :y 0.3 :w 0.4 :h 0.3) *root-frame*) - (add-frame (create-frame :x 0.4 :y 0 :w 0.2 :h 0.3) (first (frame-child *root-frame*))) - (add-frame (create-frame :x 0.6 :y 0.4 :w 0.4 :h 0.2) (first (frame-child *root-frame*))) - (add-frame (create-frame :x 0.4 :y 0.7 :w 0.2 :h 0.3) (first (frame-child *root-frame*))) - (let ((frame (create-frame :name "The Qiv" :x 0 :y 0.4 :w 0.4 :h 0.2))) - (add-frame frame (first (frame-child *root-frame*))) - (add-frame (create-frame) frame)) - (add-frame (create-frame :x 0.1 :y 0.55 :w 0.8 :h 0.43) *root-frame*) - (add-frame (create-frame :x 0.2 :y 0.1 :w 0.6 :h 0.4) (first (frame-child *root-frame*))) - (add-frame (create-frame :x 0.3 :y 0.55 :w 0.4 :h 0.3) (first (frame-child *root-frame*))) - (add-frame (create-frame :x 0.1 :y 0.1 :w 0.3 :h 0.6) (first (frame-child (first (frame-child *root-frame*))))) - (setf *current-child* (first (frame-child *current-root*))) - (setf (frame-layout *current-child*) #'tile-layout)) - -(defun my-init-hook-2 () - (dbg 'my-init-hook) - (add-frame (create-frame :name "Default" :layout #'tile-left-layout :data (list '(:tile-size 0.6))) *root-frame*) - (setf *current-child* (first (frame-child *current-root*))) - (setf (frame-layout *current-child*) #'tile-layout)) - - -(defun my-init-hook-3 () - (dbg 'my-init-hook) - (add-frame (create-frame :name "plop" :x 0.1 :y 0.4 :w 0.7 :h 0.3) *root-frame*) - (add-frame (create-frame :name "Default" :layout nil :x 0.1 :y 0.5 :w 0.8 :h 0.5) - *root-frame*) - (setf *current-child* (first (frame-child *current-root*))) - (setf (frame-layout *root-frame*) nil)) - - - -(defun my-init-hook-4 () - (let ((frame (add-frame (create-frame :name "Default" - :layout #'tile-left-layout - :x 0.05 :y 0.05 :w 0.9 :h 0.9) - *root-frame*))) - (setf *current-child* frame))) - - -;;; Use this hook and prevent yourself to create a new frame to emulate -;;; the MS Windows desktop style :) -(defun my-init-hook-ms-windows-style () - (setf (frame-managed-type *root-frame*) nil)) - - -;;; Here is another example useful with the ROX filer: Only the -;;; root frame fullscreen with some space on the left for icons. -(defun my-init-hook-rox-filer () - (setf (frame-layout *root-frame*) #'tile-left-space-layout - (frame-data-slot *root-frame* :tile-size) 0.9)) - - - - -(setf *init-hook* #'my-init-hook-4) ;; <- choose one in 1 to 4 -;;(setf *init-hook* nil) -;;; Init hook end +;;(defun display-osd (formatter &rest args) +;; (do-shell "pkill osd_cat") +;; (do-shell (format nil "echo ~A | osd_cat -d 3 -p bottom -o -60 -f -*-fixed-*-*-*-*-16-*-*-*-*-*-*-1" +;; (apply #'format nil formatter args))) +;; (force-output)) +;; +;;(defun documentation-key-from-code (hash-key code state) +;; (documentation (first (find-key-from-code hash-key code state)) 'function)) +;; +;; +;;(defun key-string (hash-key code state) +;; (let* ((modifiers (xlib:make-state-keys state)) +;; (keysym (keysym->keysym-name (xlib:keycode->keysym *display* code 0))) +;; (doc (documentation-key-from-code hash-key code state))) +;; (values (format nil "~:(~{~A+~}~A~) : ~S" modifiers keysym doc) +;; doc))) +;; +;;(defun display-doc (hash-key code state) +;; (multiple-value-bind (str doc) +;; (key-string hash-key code state) +;; (when doc +;; (display-osd "~A" str)))) +;; +;;(defun display-key-osd-main (&rest event-slots &key code state &allow-other-keys) +;; (declare (ignore event-slots)) +;; (display-doc *main-keys* code state)) +;; +;;(defun display-key-osd-second (&rest event-slots &key code state &allow-other-keys) +;; (declare (ignore event-slots)) +;; (display-doc *second-keys* code state)) +;; +;;;; Define new hook or add to precedent one +;;(if (consp *key-press-hook*) +;; (push #'display-key-osd-main *key-press-hook*) +;; (setf *key-press-hook* (list #'display-key-osd-main #'handle-key-press))) +;;(setf *sm-key-press-hook* (list #'display-key-osd-second #'sm-handle-key-press)) +;; +;; +;;;;; Display menu functions +;;(defun open-menu (&optional (menu *menu*)) +;; "Open the main menu" +;; (let ((info-list nil) +;; (action nil)) +;; (dolist (item (menu-item menu)) +;; (let ((value (menu-item-value item))) +;; (push (typecase value +;; (menu (list (list (format nil "~A" (menu-item-key item)) *menu-color-menu-key*) +;; (list (format nil ": < ~A >" (menu-doc value)) *menu-color-submenu*))) +;; (string (list (list (format nil "~A" (menu-item-value item)) *menu-color-comment*))) +;; (t (list (list (format nil "~A" (menu-item-key item)) *menu-color-key*) +;; (format nil ": ~A" (documentation value 'function))))) +;; info-list) +;; (when (menu-item-key item) +;; (define-info-key-fun (list (menu-item-key item) 0) +;; (lambda (&optional args) +;; (declare (ignore args)) +;; (setf action value) +;; (throw 'exit-info-loop nil)))))) +;; (info-mode (nreverse info-list)) +;; (dolist (item (menu-item menu)) +;; (undefine-info-key-fun (list (menu-item-key item) 0))) +;; (typecase action +;; (menu +;; (display-osd "Open Menu: ~A" (menu-doc action)) ;; <- Display here +;; (open-menu action)) +;; (t (when (fboundp action) +;; (display-osd "~A" (documentation action 'function)) ;; <- Display here +;; (funcall action)))))) +;; +;; +;; +;;(defun get-fullscreen-size () +;; "Return the size of root child (values rx ry rw rh) +;;You can tweak this to what you want" +;; (values -2 -2 (+ (xlib:screen-width *screen*) 2) (- (xlib:screen-height *screen*) 20))) +;; +;;;;; -- Doc example end -- + + +;;;;; Init hook examples: +;;(defun my-init-hook-1 () +;; (dbg 'my-init-hook) +;; ;;(add-frame (create-frame :name "Default" :layout #'tile-left-layout :data (list '(:tile-size 0.6))) *root-frame*) +;; (add-frame (create-frame :name "The Gimp" :x 0.6 :y 0 :w 0.3 :h 0.2) *root-frame*) +;; (add-frame (create-frame :name "Net" :x 0.52 :y 0.3 :w 0.4 :h 0.3) *root-frame*) +;; (add-frame (create-frame :x 0.4 :y 0 :w 0.2 :h 0.3) (first (frame-child *root-frame*))) +;; (add-frame (create-frame :x 0.6 :y 0.4 :w 0.4 :h 0.2) (first (frame-child *root-frame*))) +;; (add-frame (create-frame :x 0.4 :y 0.7 :w 0.2 :h 0.3) (first (frame-child *root-frame*))) +;; (let ((frame (create-frame :name "The Qiv" :x 0 :y 0.4 :w 0.4 :h 0.2))) +;; (add-frame frame (first (frame-child *root-frame*))) +;; (add-frame (create-frame) frame)) +;; (add-frame (create-frame :x 0.1 :y 0.55 :w 0.8 :h 0.43) *root-frame*) +;; (add-frame (create-frame :x 0.2 :y 0.1 :w 0.6 :h 0.4) (first (frame-child *root-frame*))) +;; (add-frame (create-frame :x 0.3 :y 0.55 :w 0.4 :h 0.3) (first (frame-child *root-frame*))) +;; (add-frame (create-frame :x 0.1 :y 0.1 :w 0.3 :h 0.6) (first (frame-child (first (frame-child *root-frame*))))) +;; (setf *current-child* (first (frame-child *current-root*))) +;; (setf (frame-layout *current-child*) #'tile-layout)) +;; +;;(defun my-init-hook-2 () +;; (dbg 'my-init-hook) +;; (add-frame (create-frame :name "Default" :layout #'tile-left-layout :data (list '(:tile-size 0.6))) *root-frame*) +;; (setf *current-child* (first (frame-child *current-root*))) +;; (setf (frame-layout *current-child*) #'tile-layout)) +;; +;; +;;(defun my-init-hook-3 () +;; (dbg 'my-init-hook) +;; (add-frame (create-frame :name "plop" :x 0.1 :y 0.4 :w 0.7 :h 0.3) *root-frame*) +;; (add-frame (create-frame :name "Default" :layout nil :x 0.1 :y 0.5 :w 0.8 :h 0.5) +;; *root-frame*) +;; (setf *current-child* (first (frame-child *current-root*))) +;; (setf (frame-layout *root-frame*) nil)) +;; +;; +;; +;;(defun my-init-hook-4 () +;; (let ((frame (add-frame (create-frame :name "Default" +;; :layout #'tile-left-layout +;; :x 0.05 :y 0.05 :w 0.9 :h 0.9) +;; *root-frame*))) +;; (setf *current-child* frame))) +;; +;; +;;;;; Use this hook and prevent yourself to create a new frame to emulate +;;;;; the MS Windows desktop style :) +;;(defun my-init-hook-ms-windows-style () +;; (setf (frame-managed-type *root-frame*) nil)) +;; +;; +;;;;; Here is another example useful with the ROX filer: Only the +;;;;; root frame fullscreen with some space on the left for icons. +;;(defun my-init-hook-rox-filer () +;; (setf (frame-layout *root-frame*) #'tile-left-space-layout +;; (frame-data-slot *root-frame* :tile-size) 0.9)) +;; +;; +;; +;; +;;(setf *init-hook* #'my-init-hook-4) ;; <- choose one in 1 to 4 +;;;;(setf *init-hook* nil) +;;;;; Init hook end From pbrochard at common-lisp.net Sun Oct 26 20:19:45 2008 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Sun, 26 Oct 2008 20:19:45 +0000 Subject: [clfswm-cvs] r192 - in clfswm: . src Message-ID: Author: pbrochard Date: Sun Oct 26 20:19:45 2008 New Revision: 192 Log: remove-hook: New function. TODO update. Fix a typo in without-numlock Modified: clfswm/ChangeLog clfswm/TODO clfswm/src/clfswm-keys.lisp clfswm/src/tools.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Sun Oct 26 20:19:45 2008 @@ -1,5 +1,7 @@ 2008-10-26 Philippe Brochard + * src/tools.lisp (remove-hook): New function. + * src/clfswm-keys.lisp (with-capslock, without-capslock) (with-numlock, without-cnumlock): New functions. Modified: clfswm/TODO ============================================================================== --- clfswm/TODO (original) +++ clfswm/TODO Sun Oct 26 20:19:45 2008 @@ -9,8 +9,6 @@ - Make alias for :mod-1 -> :alt :mod-2 -> :numlock -- hook to create bindings and menu -> build keys and menu at runtime. - - Show config -> list and display documentation for all tweakable global variables. [Philippe] TODO : In ~/.clfswmrc: @@ -19,21 +17,18 @@ ... ;;;; AUTO-CONFIG End : You can add your configurations below this line. -- Remote access to the clfswm REPL [Philippe] - Protocol: Server: Ask: random-number - Client: Reply: associated random-number - Server: Ok - Client: a lisp form (+ 2 2) - ... - Random-number at compile time: '((rnd-1-server rnd-1-client) (rnd-1-server rnd-1-client) (rnd-1-server rnd-1-client) ...) - - Support clisp/new-clx and prevent to crash clisp with this CLX version. +- Mouse support in menu + +- Remote access to the clfswm REPL [Philippe] + this can be done with net.lisp or via xprop (ie the Stumpwm way). + MAYBE ===== -- cd/pwd a la shell to navigate throw frames. [Philippe] +- cd/pwd a la shell to navigate through frames. [Philippe] - Zoom @@ -51,5 +46,4 @@ - Undo/redo (any idea to implement this is welcome) -- Mouse support in menu? Modified: clfswm/src/clfswm-keys.lisp ============================================================================== --- clfswm/src/clfswm-keys.lisp (original) +++ clfswm/src/clfswm-keys.lisp Sun Oct 26 20:19:45 2008 @@ -40,7 +40,7 @@ (defun with-numlock () (pushnew :mod-2 *default-modifiers*)) -(defun without-cnumlock () +(defun without-numlock () (setf *default-modifiers* (remove :mod-2 *default-modifiers*))) Modified: clfswm/src/tools.lisp ============================================================================== --- clfswm/src/tools.lisp (original) +++ clfswm/src/tools.lisp Sun Oct 26 20:19:45 2008 @@ -33,6 +33,7 @@ :aif :call-hook :add-hook + :remove-hook :dbg :dbgnl :with-all-internal-symbols @@ -128,6 +129,11 @@ (defmacro add-hook (hook &rest value) `(setf ,hook (append ,hook (list , at value)))) +(defmacro remove-hook (hook &rest value) + (let ((i (gensym))) + `(dolist (,i (list , at value)) + (setf ,hook (remove ,i ,hook))))) + ;;;,----- From pbrochard at common-lisp.net Sun Oct 26 20:47:48 2008 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Sun, 26 Oct 2008 20:47:48 +0000 Subject: [clfswm-cvs] r193 - in clfswm: . src Message-ID: Author: pbrochard Date: Sun Oct 26 20:47:48 2008 New Revision: 193 Log: unalias-modifiers: Convert a modifier alias in a real modifier. For example: :alt is :mod-1, :numlock is :mod-2... Modified: clfswm/ChangeLog clfswm/TODO clfswm/src/clfswm-keys.lisp clfswm/src/package.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Sun Oct 26 20:47:48 2008 @@ -1,5 +1,11 @@ 2008-10-26 Philippe Brochard + * src/clfswm-keys.lisp (unalias-modifiers): Convert a modifier + alias in a real modifier. + + * src/package.lisp (*modifier-alias*): New list of modifier alias + For example: :alt is :mod-1, :numlock is :mod-2... + * src/tools.lisp (remove-hook): New function. * src/clfswm-keys.lisp (with-capslock, without-capslock) Modified: clfswm/TODO ============================================================================== --- clfswm/TODO (original) +++ clfswm/TODO Sun Oct 26 20:47:48 2008 @@ -7,8 +7,6 @@ =============== Should handle these soon. -- Make alias for :mod-1 -> :alt :mod-2 -> :numlock - - Show config -> list and display documentation for all tweakable global variables. [Philippe] TODO : In ~/.clfswmrc: Modified: clfswm/src/clfswm-keys.lisp ============================================================================== --- clfswm/src/clfswm-keys.lisp (original) +++ clfswm/src/clfswm-keys.lisp Sun Oct 26 20:47:48 2008 @@ -62,8 +62,15 @@ (define-init-hash-table-key *info-mouse* "Mouse buttons actions in info mode") + +(defun unalias-modifiers (list) + (dolist (mod *modifier-alias*) + (setf list (substitute (second mod) (first mod) list))) + list) + (defun key->list (key) - (list (first key) (modifiers->state (append (rest key) *default-modifiers*)))) + (list (first key) (modifiers->state (append (unalias-modifiers (rest key)) + (unalias-modifiers *default-modifiers*))))) (defmacro define-define-key (name hashtable) (let ((name-key-fun (create-symbol "define-" name "-key-fun")) Modified: clfswm/src/package.lisp ============================================================================== --- clfswm/src/package.lisp (original) +++ clfswm/src/package.lisp Sun Oct 26 20:47:48 2008 @@ -46,6 +46,12 @@ This variable may be useful to speed up some slow version of CLX. It is particulary useful with CLISP/MIT-CLX.") +(defparameter *modifier-alias* '((:alt :mod-1) (:alt-l :mod-1) + (:numlock :mod-2) + (:super_l :mod-4) + (:alt-r :mod-5) (:alt-gr :mod-5) + (:capslock :lock)) + "Syntax: (modifier-alias effective-modifier)") (defparameter *display* nil) From pbrochard at common-lisp.net Sun Oct 26 21:20:49 2008 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Sun, 26 Oct 2008 21:20:49 +0000 Subject: [clfswm-cvs] r194 - in clfswm: . doc src Message-ID: Author: pbrochard Date: Sun Oct 26 21:20:49 2008 New Revision: 194 Log: Rename sister frame to brother frame. Doc update Modified: clfswm/ChangeLog clfswm/README clfswm/doc/keys.html clfswm/doc/keys.txt clfswm/doc/menu.html clfswm/doc/menu.txt clfswm/src/bindings-second-mode.lisp clfswm/src/bindings.lisp clfswm/src/clfswm-internal.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Sun Oct 26 21:20:49 2008 @@ -1,5 +1,7 @@ 2008-10-26 Philippe Brochard + * *: Rename 'sister' frame to 'brother' frame. + * src/clfswm-keys.lisp (unalias-modifiers): Convert a modifier alias in a real modifier. Modified: clfswm/README ============================================================================== --- clfswm/README (original) +++ clfswm/README Sun Oct 26 21:20:49 2008 @@ -21,7 +21,7 @@ Here is the default key binding to navigate throw this tree: * Alt-Tab: circulate throw children of the current child. - * Alt-Left/Right: circulate throw brother children (ie: this is like + * Alt-Left/Right: circulate through brother children (ie: this is like workspaces for a more conventional window manager) * Alt-Up: select the first child of the current frame. * Alt-Down: select the parent of the current child. Modified: clfswm/doc/keys.html ============================================================================== --- clfswm/doc/keys.html (original) +++ clfswm/doc/keys.html Sun Oct 26 21:20:49 2008 @@ -60,7 +60,7 @@ Right - Select the next sister frame + Select the next brother frame @@ -71,7 +71,7 @@ Left - Select the previous sister frame + Select the previous brother frame @@ -123,7 +123,7 @@ Shift - Tab + Tab Store the current child and switch to the previous one @@ -780,7 +780,7 @@ Right - Select the next sister frame + Select the next brother frame @@ -791,7 +791,7 @@ Left - Select the previous sister frame + Select the previous brother frame Modified: clfswm/doc/keys.txt ============================================================================== --- clfswm/doc/keys.txt (original) +++ clfswm/doc/keys.txt Sun Oct 26 21:20:49 2008 @@ -8,8 +8,8 @@ Mod-1 F1 Open the help and info window Mod-1 Control Shift Home Exit clfswm - Mod-1 Right Select the next sister frame - Mod-1 Left Select the previous sister frame + Mod-1 Right Select the next brother frame + Mod-1 Left Select the previous brother frame Mod-1 Down Select the previous level in frame Mod-1 Up Select the next level in frame Mod-1 Tab Select the next child @@ -82,8 +82,8 @@ Escape Leave second mode T Tile the current frame Mod-1 Control Shift Home Exit clfswm - Mod-1 Right Select the next sister frame - Mod-1 Left Select the previous sister frame + Mod-1 Right Select the next brother frame + Mod-1 Left Select the previous brother frame Mod-1 Down Select the previous level in frame Mod-1 Up Select the next level in frame Mod-1 Tab Select the next child Modified: clfswm/doc/menu.html ============================================================================== --- clfswm/doc/menu.html (original) +++ clfswm/doc/menu.html Sun Oct 26 21:20:49 2008 @@ -18,6 +18,9 @@ Main

+ d: < Standard menu > +

+

c: < Child menu >

@@ -43,6 +46,510 @@

+ Standard-Menu +

+

+ a: < GAMES > +

+

+ b: < APPS > +

+

+ c: < XSHELLS > +

+

+ d: < HELP > +

+
+

+ Games +

+

+ a: < PUZZLES > +

+

+ b: < ARCADE > +

+

+ c: < BOARD > +

+

+ d: < TETRIS-LIKE > +

+
+

+ Puzzles +

+

+ a: LMarbles +

+

+ b: Glotski +

+

+ c: Fish Fillets +

+

+ d: Pathological +

+

+ e: Einstein +

+
+

+ Arcade +

+

+ a: Thrust +

+

+ b: Thrust +

+

+ c: lbreakout2 +

+

+ d: Ri-li +

+

+ e: xmoto +

+

+ f: Toppler +

+

+ g: Childsplay +

+

+ h: Barrage +

+

+ i: trackballs +

+

+ j: rrootage +

+

+ k: Abuse +

+
+

+ Board +

+

+ a: eboard +

+
+

+ Tetris-Like +

+

+ a: LTris +

+

+ b: Frozen-Bubble +

+
+

+ Apps +

+

+ a: < NET > +

+

+ b: < SYSTEM > +

+

+ c: < VIEWERS > +

+

+ d: < PROGRAMMING > +

+

+ e: < EMULATORS > +

+

+ f: < EDITORS > +

+

+ g: < MATH > +

+

+ h: < GRAPHICS > +

+

+ i: < TOOLS > +

+

+ j: < DATABASES > +

+

+ k: < EDUCATION > +

+

+ l: < SOUND > +

+

+ m: < SHELLS > +

+
+

+ Net +

+

+ a: Lynx +

+

+ b: Lynx Manual +

+

+ c: Iceweasel +

+

+ d: Icedove Mail +

+

+ e: Mutt +

+

+ f: Links 2 +

+

+ g: Links 2 (text) +

+

+ h: w3m +

+

+ i: Licq +

+

+ j: Telnet +

+
+

+ System +

+

+ a: X-Terminal as root (GKsu) +

+

+ b: Aptitude +

+

+ c: RT2500 configuration utility +

+

+ d: Top +

+

+ e: Pstree +

+

+ f: Pstree +

+

+ g: reportbug +

+

+ h: KControl +

+

+ i: KInfoCenter +

+

+ j: Task selector +

+

+ k: < LANGUAGE-ENVIRONMENT > +

+

+ l: ROX Filer +

+

+ m: KDebugDialog +

+

+ n: KDCOP +

+

+ o: GDM flexiserver +

+

+ p: GDM flexiserver in Xnest +

+

+ q: GDM Photo Setup +

+

+ r: GDM Setup +

+

+ s: Kicker +

+

+ t: < ADMIN > +

+
+

+ Language-Environment +

+

+ a: Native Language Environment +

+

+ b: Native Language Environment - remove +

+

+ c: Japanese environment +

+

+ d: Thai environment +

+

+ e: Korean environment +

+

+ f: Danish environment +

+

+ g: German environment +

+

+ h: Spanish environment +

+

+ i: French environment +

+

+ j: Russian environment +

+

+ k: Belarusian environment +

+

+ l: Bulgarian environment +

+

+ m: Macedonian environment +

+

+ n: Serbian environment +

+

+ o: Ukrainian environment +

+

+ p: Polish environment +

+

+ q: Catalan environment +

+

+ r: Lithuanian environment +

+

+ s: Turkish environment +

+
+

+ Admin +

+

+ a: alsaconf - Configure your soundcards for the ALSA system +

+
+

+ Viewers +

+

+ a: GV +

+

+ b: gmplayer +

+

+ c: Xpdf +

+

+ d: VLC media player +

+

+ e: ImageMagick +

+
+

+ Programming +

+

+ a: Tclsh8.4 +

+

+ b: TkWish8.4 +

+

+ c: Python (v2.4) +

+

+ d: BeanShell (text) +

+

+ e: BeanShell (windowed) +

+

+ f: Guile 1.8 +

+

+ g: GDB +

+
+

+ Emulators +

+

+ a: hatari +

+
+

+ Editors +

+

+ a: Emacs 21 (X11) +

+

+ b: Emacs 21 (text) +

+

+ c: Nano +

+

+ d: AbiWord Word Processor +

+

+ e: OpenOffice.org Writer +

+
+

+ Math +

+

+ a: OpenOffice.org Math +

+

+ b: Bc +

+

+ c: Dc +

+

+ d: OpenOffice.org Calc +

+
+

+ Graphics +

+

+ a: tuxpaint +

+

+ b: tuxpaint-config +

+

+ c: xfig - XFig is a menu-driven tool that allows the user to draw and manipulate objects interactively in an X window. The resulting pictures can be saved, printed on postscript printers, or converted to a variety of other formats (e.g. to allow inclusion in LaTeX documents or web pages) using the transfig program. +

+

+ d: The GIMP +

+

+ e: OpenOffice.org Draw +

+

+ f: OpenOffice.org Impress +

+
+

+ Tools +

+

+ a: k3b +

+

+ b: xvkbd +

+

+ c: Rclock +

+
+

+ Databases +

+

+ a: OpenOffice.org Base +

+

+ b: HSQLDB Database Manager +

+

+ c: HSQLDB Database Manager (Swing) +

+

+ d: HSQLDB Query Tool +

+

+ e: HSQLDB Transfer Tool +

+
+

+ Education +

+

+ a: gcompris +

+

+ b: gcompris profile editor +

+
+

+ Sound +

+

+ a: Alsamixergui +

+
+

+ Shells +

+

+ a: Bash +

+

+ b: Sh +

+

+ c: tcsh +

+
+

+ Xshells +

+

+ a: XTerm +

+

+ b: XTerm (Unicode) +

+

+ c: Rxvt +

+
+

+ Help +

+

+ a: Info +

+
+

Child-Menu

Modified: clfswm/doc/menu.txt ============================================================================== --- clfswm/doc/menu.txt (original) +++ clfswm/doc/menu.txt Sun Oct 26 21:20:49 2008 @@ -2,6 +2,7 @@ (By default it is bound on second-mode + m) Main +d: < Standard menu > c: < Child menu > f: < Frame menu > w: < Window menu > @@ -11,6 +12,190 @@ y: < Utility menu > m: < CLFSWM menu > +Standard-Menu +a: < GAMES > +b: < APPS > +c: < XSHELLS > +d: < HELP > + +Games +a: < PUZZLES > +b: < ARCADE > +c: < BOARD > +d: < TETRIS-LIKE > + +Puzzles +a: LMarbles +b: Glotski +c: Fish Fillets +d: Pathological +e: Einstein + +Arcade +a: Thrust +b: Thrust +c: lbreakout2 +d: Ri-li +e: xmoto +f: Toppler +g: Childsplay +h: Barrage +i: trackballs +j: rrootage +k: Abuse + +Board +a: eboard + +Tetris-Like +a: LTris +b: Frozen-Bubble + +Apps +a: < NET > +b: < SYSTEM > +c: < VIEWERS > +d: < PROGRAMMING > +e: < EMULATORS > +f: < EDITORS > +g: < MATH > +h: < GRAPHICS > +i: < TOOLS > +j: < DATABASES > +k: < EDUCATION > +l: < SOUND > +m: < SHELLS > + +Net +a: Lynx +b: Lynx Manual +c: Iceweasel +d: Icedove Mail +e: Mutt +f: Links 2 +g: Links 2 (text) +h: w3m +i: Licq +j: Telnet + +System +a: X-Terminal as root (GKsu) +b: Aptitude +c: RT2500 configuration utility +d: Top +e: Pstree +f: Pstree +g: reportbug +h: KControl +i: KInfoCenter +j: Task selector +k: < LANGUAGE-ENVIRONMENT > +l: ROX Filer +m: KDebugDialog +n: KDCOP +o: GDM flexiserver +p: GDM flexiserver in Xnest +q: GDM Photo Setup +r: GDM Setup +s: Kicker +t: < ADMIN > + +Language-Environment +a: Native Language Environment +b: Native Language Environment - remove +c: Japanese environment +d: Thai environment +e: Korean environment +f: Danish environment +g: German environment +h: Spanish environment +i: French environment +j: Russian environment +k: Belarusian environment +l: Bulgarian environment +m: Macedonian environment +n: Serbian environment +o: Ukrainian environment +p: Polish environment +q: Catalan environment +r: Lithuanian environment +s: Turkish environment + +Admin +a: alsaconf - Configure your soundcards for the ALSA system + +Viewers +a: GV +b: gmplayer +c: Xpdf +d: VLC media player +e: ImageMagick + +Programming +a: Tclsh8.4 +b: TkWish8.4 +c: Python (v2.4) +d: BeanShell (text) +e: BeanShell (windowed) +f: Guile 1.8 +g: GDB + +Emulators +a: hatari + +Editors +a: Emacs 21 (X11) +b: Emacs 21 (text) +c: Nano +d: AbiWord Word Processor +e: OpenOffice.org Writer + +Math +a: OpenOffice.org Math +b: Bc +c: Dc +d: OpenOffice.org Calc + +Graphics +a: tuxpaint +b: tuxpaint-config +c: xfig - XFig is a menu-driven tool that allows the user to draw and manipulate objects interactively in an X window. The resulting pictures can be saved, printed on postscript printers, or converted to a variety of other formats (e.g. to allow inclusion in LaTeX documents or web pages) using the transfig program. +d: The GIMP +e: OpenOffice.org Draw +f: OpenOffice.org Impress + +Tools +a: k3b +b: xvkbd +c: Rclock + +Databases +a: OpenOffice.org Base +b: HSQLDB Database Manager +c: HSQLDB Database Manager (Swing) +d: HSQLDB Query Tool +e: HSQLDB Transfer Tool + +Education +a: gcompris +b: gcompris profile editor + +Sound +a: Alsamixergui + +Shells +a: Bash +b: Sh +c: tcsh + +Xshells +a: XTerm +b: XTerm (Unicode) +c: Rxvt + +Help +a: Info + Child-Menu r: Rename the current child e: Ensure that all children names are unique Modified: clfswm/src/bindings-second-mode.lisp ============================================================================== --- clfswm/src/bindings-second-mode.lisp (original) +++ clfswm/src/bindings-second-mode.lisp Sun Oct 26 21:20:49 2008 @@ -98,8 +98,8 @@ (define-second-key ("Escape") 'leave-second-mode) (define-second-key ("t") 'tile-current-frame) (define-second-key ("Home" :mod-1 :control :shift) 'exit-clfswm) - (define-second-key ("Right" :mod-1) 'select-next-sister) - (define-second-key ("Left" :mod-1) 'select-previous-sister) + (define-second-key ("Right" :mod-1) 'select-next-brother) + (define-second-key ("Left" :mod-1) 'select-previous-brother) (define-second-key ("Down" :mod-1) 'select-previous-level) (define-second-key ("Up" :mod-1) 'select-next-level) (define-second-key ("Tab" :mod-1) 'select-next-child) Modified: clfswm/src/bindings.lisp ============================================================================== --- clfswm/src/bindings.lisp (original) +++ clfswm/src/bindings.lisp Sun Oct 26 21:20:49 2008 @@ -37,8 +37,8 @@ (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 ("Right" :mod-1) 'select-next-sister) - (define-main-key ("Left" :mod-1) 'select-previous-sister) + (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-main-key ("Tab" :mod-1) 'select-next-child) Modified: clfswm/src/clfswm-internal.lisp ============================================================================== --- clfswm/src/clfswm-internal.lisp (original) +++ clfswm/src/clfswm-internal.lisp Sun Oct 26 21:20:49 2008 @@ -727,8 +727,8 @@ -(defun select-next/previous-sister (fun-rotate) - "Select the next/previous sister frame" +(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? @@ -744,13 +744,13 @@ (show-all-children *current-root*))) -(defun select-next-sister () - "Select the next sister frame" - (select-next/previous-sister #'anti-rotate-list)) - -(defun select-previous-sister () - "Select the previous sister frame" - (select-next/previous-sister #'rotate-list)) +(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 () From pbrochard at common-lisp.net Tue Oct 28 21:48:57 2008 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Tue, 28 Oct 2008 21:48:57 +0000 Subject: [clfswm-cvs] r195 - in clfswm: . src Message-ID: Author: pbrochard Date: Tue Oct 28 21:48:46 2008 New Revision: 195 Log: Add children navigation menu in the movement menu (select next/previous child/brother/level). - clisp/new-clx is supported with a least the 2.48 version (not yet released) Modified: clfswm/ChangeLog clfswm/TODO clfswm/src/clfswm-util.lisp clfswm/src/menu-def.lisp clfswm/src/xlib-util.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Tue Oct 28 21:48:46 2008 @@ -1,3 +1,8 @@ +2008-10-28 Philippe Brochard + + * src/menu-def.lisp: Add children navigation menu in the movement + menu (select next/previous child/brother/level). + 2008-10-26 Philippe Brochard * *: Rename 'sister' frame to 'brother' frame. Modified: clfswm/TODO ============================================================================== --- clfswm/TODO (original) +++ clfswm/TODO Tue Oct 28 21:48:46 2008 @@ -15,8 +15,6 @@ ... ;;;; AUTO-CONFIG End : You can add your configurations below this line. -- Support clisp/new-clx and prevent to crash clisp with this CLX version. - - Mouse support in menu - Remote access to the clfswm REPL [Philippe] Modified: clfswm/src/clfswm-util.lisp ============================================================================== --- clfswm/src/clfswm-util.lisp (original) +++ clfswm/src/clfswm-util.lisp Tue Oct 28 21:48:46 2008 @@ -794,6 +794,28 @@ (with-movement (resize-minimal-frame *current-child*))) +;;; Children navigation +(defun with-movement-select-next-brother () + "Select the next brother frame" + (with-movement (select-next-brother))) + +(defun with-movement-select-previous-brother () + "Select the previous brother frame" + (with-movement (select-previous-brother))) + +(defun with-movement-select-next-level () + "Select the next level" + (with-movement (select-next-level))) + +(defun with-movement-select-previous-level () + "Select the previous levelframe" + (with-movement (select-previous-level))) + +(defun with-movement-select-next-child () + "Select the next child" + (with-movement (select-next-child))) + + ;;; Adapt frame functions (defun adapt-current-frame-to-window-hints-generic (width-p height-p) Modified: clfswm/src/menu-def.lisp ============================================================================== --- clfswm/src/menu-def.lisp (original) +++ clfswm/src/menu-def.lisp Tue Oct 28 21:48:46 2008 @@ -94,6 +94,11 @@ (add-sub-menu 'frame-movement-menu "f" 'frame-fill-menu "Frame fill menu") (add-sub-menu 'frame-movement-menu "r" 'frame-resize-menu "Frame resize menu") (add-menu-key 'frame-movement-menu "c" 'center-current-frame) +(add-menu-key 'frame-movement-menu "Right" 'with-movement-select-next-brother) +(add-menu-key 'frame-movement-menu "Left" 'with-movement-select-previous-brother) +(add-menu-key 'frame-movement-menu "Up" 'with-movement-select-next-level) +(add-menu-key 'frame-movement-menu "Down" 'with-movement-select-previous-level) +(add-menu-key 'frame-movement-menu "Tab" 'with-movement-select-next-child) (add-menu-key 'frame-pack-menu "Up" 'current-frame-pack-up) Modified: clfswm/src/xlib-util.lisp ============================================================================== --- clfswm/src/xlib-util.lisp (original) +++ clfswm/src/xlib-util.lisp Tue Oct 28 21:48:46 2008 @@ -405,6 +405,16 @@ :sync-pointer-p t :sync-keyboard-p nil)) +;;(dbg "todo: confirm this") +;;(defun grab-all-buttons (window) +;; (ungrab-all-buttons window) +;; (dotimes (i 5) +;; (xlib:grab-button window i '(:button-press :button-release :pointer-motion) +;; :modifiers :any +;; :owner-p nil +;; :sync-pointer-p t +;; :sync-keyboard-p nil))) + (defun ungrab-all-keys (window) (xlib:ungrab-key window :any :modifiers :any)) @@ -520,8 +530,8 @@ t)) (unless pointer-grabbed-p (xgrab-pointer *root* nil nil)) -; (when additional-fn -; (apply additional-fn additional-arg)) + (when additional-fn + (apply additional-fn additional-arg)) (loop until done do (with-xlib-protect (xlib:display-finish-output *display*) From pbrochard at common-lisp.net Thu Oct 30 21:26:46 2008 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Thu, 30 Oct 2008 21:26:46 +0000 Subject: [clfswm-cvs] r196 - in clfswm: . src Message-ID: Author: pbrochard Date: Thu Oct 30 21:26:45 2008 New Revision: 196 Log: wait-no-key-or-button-press, wait-a-key-or-button-press: Check buttons press/release correctly Modified: clfswm/ChangeLog clfswm/src/xlib-util.lisp Modified: clfswm/ChangeLog ============================================================================== --- clfswm/ChangeLog (original) +++ clfswm/ChangeLog Thu Oct 30 21:26:45 2008 @@ -1,3 +1,8 @@ +2008-10-30 Philippe Brochard + + * src/xlib-util.lisp (wait-no-key-or-button-press) + (wait-a-key-or-button-press): Check buttons press/release correctly" + 2008-10-28 Philippe Brochard * src/menu-def.lisp: Add children navigation menu in the movement Modified: clfswm/src/xlib-util.lisp ============================================================================== --- clfswm/src/xlib-util.lisp (original) +++ clfswm/src/xlib-util.lisp Thu Oct 30 21:26:45 2008 @@ -405,17 +405,6 @@ :sync-pointer-p t :sync-keyboard-p nil)) -;;(dbg "todo: confirm this") -;;(defun grab-all-buttons (window) -;; (ungrab-all-buttons window) -;; (dotimes (i 5) -;; (xlib:grab-button window i '(:button-press :button-release :pointer-motion) -;; :modifiers :any -;; :owner-p nil -;; :sync-pointer-p t -;; :sync-keyboard-p nil))) - - (defun ungrab-all-keys (window) (xlib:ungrab-key window :any :modifiers :any)) @@ -688,8 +677,9 @@ (let ((key (loop for k across (xlib:query-keymap *display*) for code from 0 when (and (plusp k) (not (modifier-p code))) return t)) - (button (member (nth-value 4 (xlib:query-pointer *root*)) - '(:button-1 :button-2 :button-3 :button-4 :button-5)))) + (button (loop for b in (xlib:make-state-keys (nth-value 4 (xlib:query-pointer *root*))) + when (member b '(:button-1 :button-2 :button-3 :button-4 :button-5)) + return t))) (when (and (not key) (not button)) (loop while (xlib:event-case (*display* :discard-p t :peek-p nil :timeout 0) (:motion-notify () t) @@ -704,11 +694,13 @@ (defun wait-a-key-or-button-press () (with-grab-keyboard-and-pointer (24 25 66 67) (loop - (let ((key (loop for k across (xlib:query-keymap *display*) - unless (zerop k) return t)) - (button (plusp (nth-value 4 (xlib:query-pointer *root*))))) - (when (or key button) - (return)))))) + (let ((key (loop for k across (xlib:query-keymap *display*) + unless (zerop k) return t)) + (button (loop for b in (xlib:make-state-keys (nth-value 4 (xlib:query-pointer *root*))) + when (member b '(:button-1 :button-2 :button-3 :button-4 :button-5)) + return t))) + (when (or key button) + (return))))))