[clfswm-cvs] r458 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Sat May 7 19:35:07 UTC 2011
Author: pbrochard
Date: Sat May 7 15:35:07 2011
New Revision: 458
Log:
src/clfswm-nw-hooks.lisp (make-permanent-nw-hook-frame): New function. Prevent to add or delete a new window hook for this frame.
Modified:
clfswm/ChangeLog
clfswm/TODO
clfswm/src/bindings-second-mode.lisp
clfswm/src/clfswm-nw-hooks.lisp
clfswm/src/clfswm-util.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Sat May 7 15:35:07 2011
@@ -1,5 +1,9 @@
2011-05-07 Philippe Brochard <pbrochard at common-lisp.net>
+ * src/clfswm-nw-hooks.lisp (make-permanent-nw-hook-frame): New
+ function. Prevent to add or delete a new window hook for this
+ frame.
+
* src/clfswm-layout.lisp (update-layout-managed-children-position):
New function.
Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO (original)
+++ clfswm/TODO Sat May 7 15:35:07 2011
@@ -7,7 +7,7 @@
===============
Should handle these soon.
-Stop all pending actions
+-> Nothing here yet.
FOR THE NEXT RELEASE
Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp (original)
+++ clfswm/src/bindings-second-mode.lisp Sat May 7 15:35:07 2011
@@ -68,6 +68,13 @@
(set-layout-once #'tile-layout)
(leave-second-mode))
+
+(defun stop-all-pending-actions ()
+ "Stop all pending actions"
+ (clear-all-nw-hooks)
+ (leave-second-mode))
+
+
;;; default shell programs
(defmacro define-shell (key name docstring cmd)
"Define a second key to start a shell command"
@@ -93,13 +100,12 @@
(define-second-key ("l") 'open-frame-fill-menu)
(define-second-key ("r") 'open-frame-resize-menu)
(define-second-key ("x") 'update-layout-managed-children-position)
- (define-second-key (#\g :control) 'stop-all-pending-actions)
+ (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 ("g" :control) '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-brother)
@@ -131,10 +137,10 @@
(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-parent-frame-nw-hook)
- (define-second-key (#\o :control) 'set-open-in-new-frame-in-root-frame-nw-hook)
- (define-second-key (#\a) 'add-default-frame)
+ (define-second-key ("b" :mod-1) 'banish-pointer)
+ (define-second-key ("o") 'set-open-in-new-frame-in-parent-frame-nw-hook)
+ (define-second-key ("o" :control) 'set-open-in-new-frame-in-root-frame-nw-hook)
+ (define-second-key ("a") 'add-default-frame)
;; Escape
(define-second-key ("Escape" :control) 'ask-close/kill-current-window)
;; Selection
@@ -145,12 +151,12 @@
(define-second-key ("v" :control :shift) 'paste-selection-no-clear)
(define-second-key ("Delete" :control) 'remove-current-child)
(define-second-key ("Delete") 'delete-current-child)
- (define-shell (#\c) b-start-xterm "start an xterm" "cd $HOME && exec xterm")
- (define-shell (#\e) b-start-emacs "start emacs" "cd $HOME && exec emacs")
- (define-shell (#\e :control) b-start-emacsremote
+ (define-shell ("c") b-start-xterm "start an xterm" "cd $HOME && exec xterm")
+ (define-shell ("e") b-start-emacs "start emacs" "cd $HOME && 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-shell ("h") b-start-xclock "start an xclock" "exec xclock -d")
(define-second-key ("F10" :mod-1) 'fast-layout-switch)
(define-second-key ("F10" :shift :control) 'toggle-show-root-frame)
(define-second-key ("F10") 'expose-windows-current-child-mode)
Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp (original)
+++ clfswm/src/clfswm-nw-hooks.lisp Sat May 7 15:35:07 2011
@@ -38,6 +38,7 @@
(defparameter *nw-hook-current-key* (char-code #\a))
+(defparameter *permanent-nw-hook-frames* nil)
(defun set-nw-hook (hook)
@@ -45,8 +46,9 @@
(let ((frame (if (xlib:window-p *current-child*)
(find-parent-frame *current-child*)
*current-child*)))
- (setf (frame-nw-hook frame) hook)
- (leave-second-mode)))
+ (unless (child-member frame *permanent-nw-hook-frames*)
+ (setf (frame-nw-hook frame) hook)
+ (leave-second-mode))))
(defun register-nw-hook (hook)
(add-menu-key 'frame-nw-hook-menu (code-char *nw-hook-current-key*) hook)
@@ -60,13 +62,15 @@
(defun leave-if-not-frame (child)
"Leave the child if it's not a frame"
- (when (xlib:window-p child)
+ (unless (frame-p child)
(leave-frame)
(select-previous-level)))
(defun clear-nw-hook (frame)
"Clear the frame new window hook"
- (setf (frame-nw-hook frame) nil))
+ (unless (child-member frame *permanent-nw-hook-frames*)
+ (setf (frame-nw-hook frame) nil)))
+
(defun clear-all-nw-hooks ()
"Clear all new window hooks for all frames"
@@ -74,6 +78,11 @@
(clear-nw-hook frame)))
+(defun make-permanent-nw-hook-frame (frame)
+ "Prevent to add or delete a new window hook for this frame"
+ (when (frame-p frame)
+ (push frame *permanent-nw-hook-frames*)))
+
;;; Default frame new window hook
(defun default-frame-nw-hook (frame window)
@@ -238,7 +247,7 @@
;;; Absorb window.
-;;; The frame absorb the new window if it match the absorb-nw-test
+;;; The frame absorb the new window if it match the nw-absorb-test
;;; frame data slot.
(defun absorb-window-nw-hook (frame window)
(let ((absorb-nw-test (frame-data-slot frame :nw-absorb-test)))
@@ -256,7 +265,7 @@
nil)
(defun set-absorb-window-nw-hook ()
- "Open the window in this frame if it match absorb-nw-test"
+ "Open the window in this frame if it match nw-absorb-test"
(set-nw-hook #'absorb-window-nw-hook))
(register-nw-hook 'set-absorb-window-nw-hook)
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Sat May 7 15:35:07 2011
@@ -71,13 +71,6 @@
(char= (char rep 0) #\Y))))
-;;(error "stop-all-pending-actions: TODO")
-(defun stop-all-pending-actions ()
- "Stop all pending actions"
- ())
- ;;(error "TODO"))
-
-
(defun rename-current-child ()
"Rename the current child"
More information about the clfswm-cvs
mailing list