[clfswm-cvs] r190 - in clfswm: . doc src
Philippe Brochard
pbrochard at common-lisp.net
Sat Oct 25 22:11:39 UTC 2008
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 <pbrochard at common-lisp.net>
+
+ * src/clfswm-keys.lisp (with-capslock, without-capslock)
+ (with-numlock, without-cnumlock): New functions.
+
+2008-10-25 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * 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 <pbrochard at common-lisp.net>
* 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
More information about the clfswm-cvs
mailing list