[clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1212-33-g8fd97bb
Philippe Brochard
pbrochard at common-lisp.net
Mon Jul 29 20:42:53 UTC 2013
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".
The branch, master has been updated
via 8fd97bbed3ed7fceff69f22360c9908f56d2f227 (commit)
via b138cebe5651ee266a3d7f0ea3d6c26b9d4908e4 (commit)
via 3f8ef0cc3fb7194398064ee9686515e06c342702 (commit)
from d5e80bb911b496f1a1a9836cb2884cf64b532fb5 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 8fd97bbed3ed7fceff69f22360c9908f56d2f227
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Mon Jul 29 22:22:44 2013 +0200
Copyright date update
diff --git a/src/bindings-second-mode.lisp b/src/bindings-second-mode.lisp
index 93620a2..1bf0ea0 100644
--- a/src/bindings-second-mode.lisp
+++ b/src/bindings-second-mode.lisp
@@ -7,7 +7,7 @@
;;; Note: Mod-1 is the Alt or Meta key, Mod-2 is the Numlock key.
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/bindings.lisp b/src/bindings.lisp
index fca2a22..ba51437 100644
--- a/src/bindings.lisp
+++ b/src/bindings.lisp
@@ -7,7 +7,7 @@
;;; Note: Mod-1 is the Alt or Meta key, Mod-2 is the Numlock key.
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-autodoc.lisp b/src/clfswm-autodoc.lisp
index 642ed2c..d6ba4ba 100644
--- a/src/clfswm-autodoc.lisp
+++ b/src/clfswm-autodoc.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Auto documentation tools
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index 720d456..6d8a765 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Main functions
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-configuration.lisp b/src/clfswm-configuration.lisp
index c52cf13..201e270 100644
--- a/src/clfswm-configuration.lisp
+++ b/src/clfswm-configuration.lisp
@@ -6,7 +6,7 @@
;;;
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-corner.lisp b/src/clfswm-corner.lisp
index 4d89b81..2ac28df 100644
--- a/src/clfswm-corner.lisp
+++ b/src/clfswm-corner.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Corner functions
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp
index c3a9814..fbbb7d0 100644
--- a/src/clfswm-expose-mode.lisp
+++ b/src/clfswm-expose-mode.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Expose functions - An expose like.
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-fastswitch-mode.lisp b/src/clfswm-fastswitch-mode.lisp
index 4ecb73e..5894798 100644
--- a/src/clfswm-fastswitch-mode.lisp
+++ b/src/clfswm-fastswitch-mode.lisp
@@ -8,7 +8,7 @@
;;; A window or a frame will always have the same shortcut.
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-generic-mode.lisp b/src/clfswm-generic-mode.lisp
index bc3d586..b840278 100644
--- a/src/clfswm-generic-mode.lisp
+++ b/src/clfswm-generic-mode.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Main functions
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-info.lisp b/src/clfswm-info.lisp
index 707b65e..46be718 100644
--- a/src/clfswm-info.lisp
+++ b/src/clfswm-info.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Info function (see the end of this file for user definition
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 99598be..f56de6b 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Main functions
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-keys.lisp b/src/clfswm-keys.lisp
index 465cfa1..687ab78 100644
--- a/src/clfswm-keys.lisp
+++ b/src/clfswm-keys.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Keys functions definition
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-layout.lisp b/src/clfswm-layout.lisp
index ef1ce73..0e646c7 100644
--- a/src/clfswm-layout.lisp
+++ b/src/clfswm-layout.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Layout functions
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-menu.lisp b/src/clfswm-menu.lisp
index e4ae010..58a730e 100644
--- a/src/clfswm-menu.lisp
+++ b/src/clfswm-menu.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Menu functions
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-nw-hooks.lisp b/src/clfswm-nw-hooks.lisp
index 9d703f6..13a0e98 100644
--- a/src/clfswm-nw-hooks.lisp
+++ b/src/clfswm-nw-hooks.lisp
@@ -8,7 +8,7 @@
;;; mapped.
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-pack.lisp b/src/clfswm-pack.lisp
index b6c42e7..7177dae 100644
--- a/src/clfswm-pack.lisp
+++ b/src/clfswm-pack.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Tile, pack and fill functions
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-placement.lisp b/src/clfswm-placement.lisp
index 4c558a1..cb8efb8 100644
--- a/src/clfswm-placement.lisp
+++ b/src/clfswm-placement.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Placement functions
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-query.lisp b/src/clfswm-query.lisp
index d70e8b4..e250ee7 100644
--- a/src/clfswm-query.lisp
+++ b/src/clfswm-query.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Query utility
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-second-mode.lisp b/src/clfswm-second-mode.lisp
index b8d4ac4..a3ff5e7 100644
--- a/src/clfswm-second-mode.lisp
+++ b/src/clfswm-second-mode.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Second mode functions
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 0187a9f..4521c0c 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Utility
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index 884372b..cbecb5e 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Main functions
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/config.lisp b/src/config.lisp
index 09fa5b5..09f4dad 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -10,7 +10,7 @@
;;; (you can do a 'grep CONFIG *.lisp' to see what you can configure)
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/menu-def.lisp b/src/menu-def.lisp
index 403aeb3..005e128 100644
--- a/src/menu-def.lisp
+++ b/src/menu-def.lisp
@@ -7,7 +7,7 @@
;;; Note: Mod-1 is the Alt or Meta key, Mod-2 is the Numlock key.
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/my-html.lisp b/src/my-html.lisp
index d809755..46cc436 100644
--- a/src/my-html.lisp
+++ b/src/my-html.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Html generator helper
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/netwm-util.lisp b/src/netwm-util.lisp
index 9d5eea9..71689c2 100644
--- a/src/netwm-util.lisp
+++ b/src/netwm-util.lisp
@@ -6,7 +6,7 @@
;;; http://freedesktop.org/wiki/Specifications_2fwm_2dspec
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/package.lisp b/src/package.lisp
index f67dd03..f45bcc1 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Package definition
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/tools.lisp b/src/tools.lisp
index 8fd23f4..03a9d67 100644
--- a/src/tools.lisp
+++ b/src/tools.lisp
@@ -5,7 +5,7 @@
;;; Documentation: General tools
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
diff --git a/src/version.lisp b/src/version.lisp
index 80d8d1d..05284ed 100644
--- a/src/version.lisp
+++ b/src/version.lisp
@@ -1,5 +1,5 @@
-;; Copyright (C) 2012 Xavier Maillard <xma at gnu.org>
-;; Copyright (C) 2012 Martin Bishop
+;; Copyright (C) 2005-2013 Xavier Maillard <xma at gnu.org>
+;; Copyright (C) 2005-2013 Martin Bishop
;;
;; Borrowed from Stumpwm
;; This file is part of clfswm.
diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp
index 8748db3..1e305ba 100644
--- a/src/xlib-util.lisp
+++ b/src/xlib-util.lisp
@@ -5,7 +5,7 @@
;;; Documentation: Utility functions
;;; --------------------------------------------------------------------------
;;;
-;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;; (C) 2005-2013 Philippe Brochard <pbrochard at common-lisp.net>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
commit b138cebe5651ee266a3d7f0ea3d6c26b9d4908e4
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Mon Jul 29 22:12:42 2013 +0200
Add a fastswitch mode to quickly switch in children from expose mode
diff --git a/clfswm.asd b/clfswm.asd
index adcef17..8c185dc 100644
--- a/clfswm.asd
+++ b/clfswm.asd
@@ -54,6 +54,10 @@
:depends-on ("package" "config" "clfswm-internal" "xlib-util" "tools"
"clfswm-keys" "clfswm-generic-mode" "clfswm-placement"
"clfswm-query"))
+ (:file "clfswm-fastswitch-mode"
+ :depends-on ("package" "config" "clfswm-internal" "xlib-util" "tools"
+ "clfswm-keys" "clfswm-generic-mode" "clfswm-placement"
+ "clfswm-expose-mode"))
(:file "clfswm-corner"
:depends-on ("package" "config" "clfswm-internal" "clfswm-expose-mode" "xlib-util"))
(:file "clfswm-info"
diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp
index 3083dad..c3a9814 100644
--- a/src/clfswm-expose-mode.lisp
+++ b/src/clfswm-expose-mode.lisp
@@ -52,15 +52,15 @@
-(defun fastswitch-sort (predicate type)
+(defun expose-sort (predicate type)
(lambda (x y)
(funcall predicate (funcall type x) (funcall type y))))
-(defun fastswitch-associate-keys ()
+(defun expose-associate-keys ()
(let* ((acc nil)
(n 0)
- (win-list (sort (get-all-windows) (fastswitch-sort #'< #'xlib:window-id)))
- (frame-list (sort (get-all-frames) (fastswitch-sort #'< #'frame-number))))
+ (win-list (sort (get-all-windows) (expose-sort #'< #'xlib:window-id)))
+ (frame-list (sort (get-all-frames) (expose-sort #'< #'frame-number))))
(loop for c in win-list
do (push (make-expose-child :child c :key (number->letter n)) acc)
(incf n))
@@ -146,7 +146,7 @@
(defun expose-init ()
(setf *expose-font* (xlib:open-font *display* *expose-font-string*)
- *expose-child-list* (fastswitch-associate-keys)
+ *expose-child-list* (expose-associate-keys)
*expose-selected-child* nil
*query-string* "")
(xlib:warp-pointer *root* (truncate (/ (xlib:screen-width *screen*) 2))
@@ -246,14 +246,3 @@
(expose-focus-child child)))
(show-all-children)
t)
-
-
-
-;;;
-;;; Fast switch mode
-;;;
-;;; Expose shortcut
-;;;
-
-(defun fastswitch-mode ()
- (dbg 'todo))
diff --git a/src/clfswm-fastswitch-mode.lisp b/src/clfswm-fastswitch-mode.lisp
new file mode 100644
index 0000000..4ecb73e
--- /dev/null
+++ b/src/clfswm-fastswitch-mode.lisp
@@ -0,0 +1,157 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Fast switch mode - Like expose mode but faster since
+;;; children are not moved/resized. Shortcut key is associated to Xid for
+;;; windows and to numbers for frames.
+;;; A window or a frame will always have the same shortcut.
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2012 Philippe Brochard <pbrochard at common-lisp.net>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(defparameter *fastswitch-window* nil)
+(defparameter *fastswitch-gc* nil)
+(defparameter *fastswitch-font* nil)
+(defparameter *fastswitch-string* "")
+(defparameter *fastswitch-match-child* nil)
+
+
+(defun leave-fastswitch-mode ()
+ "Leave the fastswitch mode"
+ (throw 'exit-fastswitch-loop nil))
+
+
+
+(defun fastswitch-draw-window ()
+ (labels ((display-match-child ()
+ (let ((pos 1))
+ (dolist (ex-child *fastswitch-match-child*)
+ (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-letter-second*))
+ (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
+ (* (xlib:max-char-width *fastswitch-font*) pos)
+ (+ (* 2 (xlib:font-ascent *fastswitch-font*)) (xlib:font-descent *fastswitch-font*) 1)
+ (expose-child-key ex-child)))
+ (incf pos (length (expose-child-key ex-child)))
+ (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
+ (* (xlib:max-char-width *fastswitch-font*) pos)
+ (+ (* 2 (xlib:font-ascent *fastswitch-font*)) (xlib:font-descent *fastswitch-font*) 1)
+ ":")
+ (incf pos)
+ (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-childname*))
+ (xlib:draw-glyphs *pixmap-buffer* *fastswitch-gc*
+ (* (xlib:max-char-width *fastswitch-font*) pos)
+ (+ (* 2 (xlib:font-ascent *fastswitch-font*)) (xlib:font-descent *fastswitch-font*) 1)
+ (child-fullname (expose-child-child ex-child)))
+ (incf pos (1+ (length (child-fullname (expose-child-child ex-child))))))))))
+ (clear-pixmap-buffer *fastswitch-window* *fastswitch-gc*)
+ (xlib:with-gcontext (*fastswitch-gc* :foreground (get-color *fastswitch-foreground-letter*)
+ :background (get-color *fastswitch-background*))
+ (xlib:draw-image-glyphs *pixmap-buffer* *fastswitch-gc*
+ (xlib:max-char-width *fastswitch-font*)
+ (+ (xlib:font-ascent *fastswitch-font*) (xlib:font-descent *fastswitch-font*))
+ *fastswitch-string*))
+ (display-match-child)
+ (copy-pixmap-buffer *fastswitch-window* *fastswitch-gc*)))
+
+
+
+(defun fastswitch-init ()
+ (setf *fastswitch-font* (xlib:open-font *display* *fastswitch-font-string*)
+ *fastswitch-string* ""
+ *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key))
+ (let* ((width (- (xlib:screen-width *screen*) 2)) ;;(* (xlib:max-char-width *fastswitch-font*) 3))
+ (height (* (xlib:font-ascent *fastswitch-font*) 3)))
+ (with-placement (*fastswitch-mode-placement* x y width height)
+ (setf *fastswitch-window* (xlib:create-window :parent *root*
+ :x x :y y
+ :width width :height height
+ :background (get-color *fastswitch-background*)
+ :border-width *border-size*
+ :border (get-color *fastswitch-border*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :event-mask '(:exposure :key-press))
+ *fastswitch-gc* (xlib:create-gcontext :drawable *fastswitch-window*
+ :foreground (get-color *fastswitch-foreground*)
+ :background (get-color *fastswitch-background*)
+ :font *fastswitch-font*
+ :line-style :solid))
+ (setf (window-transparency *fastswitch-window*) *fastswitch-transparency*)
+ (map-window *fastswitch-window*)))
+ (fastswitch-draw-window))
+
+
+(defun fastswitch-enter-function ()
+ (stop-button-event)
+ (fastswitch-init))
+
+
+(defun fastswitch-leave-function ()
+ (when *fastswitch-gc*
+ (xlib:free-gcontext *fastswitch-gc*))
+ (when *fastswitch-window*
+ (xlib:destroy-window *fastswitch-window*))
+ (when *expose-font*
+ (xlib:close-font *expose-font*))
+ (setf *fastswitch-window* nil
+ *fastswitch-gc* nil
+ *fastswitch-font* nil)
+ (xlib:display-finish-output *display*))
+
+
+(defun fastswitch-loop-function ()
+ (unless (is-a-key-pressed-p)
+ (leave-fastswitch-mode)))
+
+(define-handler fastswitch-mode :key-press (code state)
+ (let ((char (keycode->char code state)))
+ (when char
+ (setf *fastswitch-string* (format nil "~A~A" *fastswitch-string* char)
+ *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key))
+ (unless *fastswitch-match-child*
+ (setf *fastswitch-string* ""
+ *fastswitch-match-child* (string-match *fastswitch-string* *expose-child-list* #'expose-child-key)))
+ (fastswitch-draw-window))))
+
+
+(defun fastswitch-do-main ()
+ (with-grab-keyboard-and-pointer (92 93 66 67 t)
+ (generic-mode 'fastswitch-mode 'exit-fastswitch-loop
+ :enter-function #'fastswitch-enter-function
+ :loop-function #'fastswitch-loop-function
+ :leave-function #'fastswitch-leave-function
+ :original-mode '(main-mode))
+ (fastswitch-leave-function))
+ (expose-find-child-from-letters *fastswitch-string*))
+
+
+
+(defun fastswitch-mode ()
+ "Switch between children with expose shortcut"
+ (setf *expose-child-list* (expose-associate-keys))
+ (let ((ex-child (fastswitch-do-main)))
+ (when (and ex-child (expose-child-child ex-child))
+ (expose-focus-child (expose-child-child ex-child))))
+ (show-all-children)
+ t)
+
+
+
diff --git a/src/config.lisp b/src/config.lisp
index 3cd3c35..09fa5b5 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -338,6 +338,27 @@ on the root window in the main mode with the mouse")
'Expose-mode "Immediately select child if they can be directly accessed")
+;;; CONFIG - Fastswitch string colors
+(defconfig *fastswitch-font-string* *default-font-string*
+ 'Fastswitch-mode "Fastswitch string window font string")
+(defconfig *fastswitch-background* "grey10"
+ 'Fastswitch-mode "Fastswitch string window background color")
+(defconfig *fastswitch-foreground* "grey50"
+ 'Fastswitch-mode "Fastswitch string window foreground color")
+(defconfig *fastswitch-foreground-letter* "red"
+ 'Fastswitch-mode "Fastswitch string window foreground color for letters")
+(defconfig *fastswitch-foreground-letter-second* "magenta"
+ 'Fastswitch-mode "Fastswitch string window foreground color for letters")
+(defconfig *fastswitch-foreground-childname* "grey70"
+ 'Fastswitch-mode "Fastswitch string window foreground color for childname")
+(defconfig *fastswitch-border* "grey20"
+ 'Fastswitch-mode "Fastswitch string window border color")
+(defconfig *fastswitch-transparency* 0.9
+ 'Fastswitch-mode "Fastswitch string window background transparency")
+
+
+
+
;;; CONFIG - Show key binding colors
(defconfig *info-color-title* "Magenta"
'Info-mode "Colored info title color")
diff --git a/src/package.lisp b/src/package.lisp
index b7d9970..f67dd03 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -251,6 +251,8 @@ loading configuration file and before opening the display.")
'Placement "Expose mode window placement (Selection keys position)")
(defconfig *expose-query-placement* 'bottom-left-root-placement
'Placement "Expose mode query window placement")
+(defconfig *fastswitch-mode-placement* 'top-left-root-placement
+ 'Placement "Fastswitch mode window placement")
(defconfig *notify-window-placement* 'bottom-right-root-placement
'Placement "Notify window placement")
(defconfig *ask-close/kill-placement* 'top-right-root-placement
diff --git a/src/tools.lisp b/src/tools.lisp
index f3920f7..8fd23f4 100644
--- a/src/tools.lisp
+++ b/src/tools.lisp
@@ -567,13 +567,15 @@ Return the result of the last hook"
(defun substring-equal (substring string)
(string-equal substring (subseq string 0 (min (length substring) (length string)))))
-(defun string-match (match list)
+(defun string-match (match list &optional key)
"Return the string in list witch match the match string"
(let ((len (length match)))
(remove-duplicates (remove-if-not (lambda (x)
(string-equal match (subseq x 0 (min len (length x)))))
- list)
- :test #'string-equal)))
+ list
+ :key key)
+ :test #'string-equal
+ :key key)))
(defun extented-alphanumericp (char)
commit 3f8ef0cc3fb7194398064ee9686515e06c342702
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Fri Jul 26 18:46:23 2013 +0200
Always bind the same shortcuts for children in expose mode
diff --git a/clfswm.asd b/clfswm.asd
index 9dd9344..adcef17 100644
--- a/clfswm.asd
+++ b/clfswm.asd
@@ -57,7 +57,8 @@
(:file "clfswm-corner"
:depends-on ("package" "config" "clfswm-internal" "clfswm-expose-mode" "xlib-util"))
(:file "clfswm-info"
- :depends-on ("package" "version" "xlib-util" "config" "clfswm-keys" "clfswm" "clfswm-internal"
+ :depends-on ("package" "version" "xlib-util" "config" "clfswm-keys" "clfswm"
+ "clfswm-internal"
"clfswm-autodoc" "clfswm-corner"
"clfswm-generic-mode" "clfswm-placement"))
(:file "clfswm-menu"
diff --git a/src/bindings.lisp b/src/bindings.lisp
index 45d40d6..fca2a22 100644
--- a/src/bindings.lisp
+++ b/src/bindings.lisp
@@ -74,6 +74,8 @@
(define-main-key ("Page_Down" :mod-1 :control) '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") 'fastswitch-mode)
+ (define-main-key (135) 'fastswitch-mode) ;; Menu hardcoded -> not good!!!
(define-main-key ("F10" :mod-1) 'fast-layout-switch)
(define-main-key ("F10" :shift :control) 'toggle-show-root-frame)
(define-main-key ("F10") 'expose-windows-mode)
diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp
index c6422bd..3083dad 100644
--- a/src/clfswm-expose-mode.lisp
+++ b/src/clfswm-expose-mode.lisp
@@ -26,9 +26,11 @@
(in-package :clfswm)
(defparameter *expose-font* nil)
-(defparameter *expose-windows-list* nil)
+(defparameter *expose-child-list* nil)
(defparameter *expose-selected-child* nil)
+(defstruct expose-child child key window gc string)
+
(defun leave-expose-mode ()
"Leave the expose mode"
(throw 'exit-expose-loop nil))
@@ -48,55 +50,83 @@
(throw 'exit-expose-loop t))
+
+
+(defun fastswitch-sort (predicate type)
+ (lambda (x y)
+ (funcall predicate (funcall type x) (funcall type y))))
+
+(defun fastswitch-associate-keys ()
+ (let* ((acc nil)
+ (n 0)
+ (win-list (sort (get-all-windows) (fastswitch-sort #'< #'xlib:window-id)))
+ (frame-list (sort (get-all-frames) (fastswitch-sort #'< #'frame-number))))
+ (loop for c in win-list
+ do (push (make-expose-child :child c :key (number->letter n)) acc)
+ (incf n))
+ (loop for c in frame-list
+ do (unless (child-equal-p c *root-frame*)
+ (push (make-expose-child :child c :key (number->letter n)) acc)
+ (incf n)))
+ (nreverse acc)))
+
+
+
+
+
(defun expose-draw-letter ()
- (dolist (lwin *expose-windows-list*)
- (destructuring-bind (window gc string child letter) lwin
- (declare (ignore child))
- (clear-pixmap-buffer window gc)
- (xlib:with-gcontext (gc :foreground (get-color (if (substring-equal *query-string* letter)
- *expose-foreground-letter*
- *expose-foreground-letter-nok*))
- :background (get-color (if (string-equal *query-string* letter)
- *expose-background-letter-match*
- *expose-background*)))
- (xlib:draw-image-glyphs *pixmap-buffer* gc
- (xlib:max-char-width *expose-font*)
- (+ (xlib:font-ascent *expose-font*) (xlib:font-descent *expose-font*))
- letter))
- (xlib:draw-glyphs *pixmap-buffer* gc
- (xlib:max-char-width *expose-font*)
- (+ (* 2 (xlib:font-ascent *expose-font*)) (xlib:font-descent *expose-font*) 1)
- string)
- (copy-pixmap-buffer window gc))))
-
-(defun expose-create-window (child n)
- (with-current-child (child)
- (let* ((string (format nil "~A"
- (if *expose-show-window-title*
- (ensure-printable (child-fullname child))
- "")))
- (width (if *expose-show-window-title*
- (min (* (xlib:max-char-width *expose-font*) (+ (length string) 2))
- (- (child-width child) 4))
- (* (xlib:max-char-width *expose-font*) 3)))
- (height (* (xlib:font-ascent *expose-font*) 3)))
- (with-placement (*expose-mode-placement* x y width height)
- (let* ((window (xlib:create-window :parent *root*
- :x x :y y
- :width width :height height
+ (dolist (ex-child *expose-child-list*)
+ (let ((window (expose-child-window ex-child))
+ (gc (expose-child-gc ex-child)))
+ (when (and window gc)
+ (clear-pixmap-buffer window gc)
+ (xlib:with-gcontext (gc :foreground (get-color (if (substring-equal *query-string* (expose-child-key ex-child))
+ *expose-foreground-letter*
+ *expose-foreground-letter-nok*))
+ :background (get-color (if (string-equal *query-string* (expose-child-key ex-child))
+ *expose-background-letter-match*
+ *expose-background*)))
+ (xlib:draw-image-glyphs *pixmap-buffer* gc
+ (xlib:max-char-width *expose-font*)
+ (+ (xlib:font-ascent *expose-font*) (xlib:font-descent *expose-font*))
+ (expose-child-key ex-child)))
+ (xlib:draw-glyphs *pixmap-buffer* gc
+ (xlib:max-char-width *expose-font*)
+ (+ (* 2 (xlib:font-ascent *expose-font*)) (xlib:font-descent *expose-font*) 1)
+ (expose-child-string ex-child))
+ (copy-pixmap-buffer window gc)))))
+
+(defun expose-create-window (ex-child)
+ (let ((child (expose-child-child ex-child)))
+ (with-current-child (child)
+ (let* ((string (format nil "~A"
+ (if *expose-show-window-title*
+ (ensure-printable (child-fullname child))
+ "")))
+ (width (if *expose-show-window-title*
+ (min (* (xlib:max-char-width *expose-font*) (+ (length string) 2))
+ (- (child-width child) 4))
+ (* (xlib:max-char-width *expose-font*) 3)))
+ (height (* (xlib:font-ascent *expose-font*) 3)))
+ (with-placement (*expose-mode-placement* x y width height)
+ (let* ((window (xlib:create-window :parent *root*
+ :x x :y y
+ :width width :height height
+ :background (get-color *expose-background*)
+ :border-width *border-size*
+ :border (get-color *expose-border*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :event-mask '(:exposure :key-press)))
+ (gc (xlib:create-gcontext :drawable window
+ :foreground (get-color *expose-foreground*)
:background (get-color *expose-background*)
- :border-width *border-size*
- :border (get-color *expose-border*)
- :colormap (xlib:screen-default-colormap *screen*)
- :event-mask '(:exposure :key-press)))
- (gc (xlib:create-gcontext :drawable window
- :foreground (get-color *expose-foreground*)
- :background (get-color *expose-background*)
- :font *expose-font*
- :line-style :solid)))
- (setf (window-transparency window) *expose-transparency*)
- (map-window window)
- (push (list window gc string child (number->letter n)) *expose-windows-list*))))))
+ :font *expose-font*
+ :line-style :solid)))
+ (setf (window-transparency window) *expose-transparency*)
+ (map-window window)
+ (setf (expose-child-window ex-child) window
+ (expose-child-gc ex-child) gc
+ (expose-child-string ex-child) string)))))))
@@ -104,7 +134,7 @@
(defun expose-query-key-press-hook (code state)
(declare (ignore code state))
(expose-draw-letter)
- (when (and *expose-direct-select* (<= (length *expose-windows-list*) 26))
+ (when (and *expose-direct-select* (<= (length *expose-child-list*) 26))
(leave-query-mode :return)))
(defun expose-query-button-press-hook (code state x y)
@@ -116,7 +146,7 @@
(defun expose-init ()
(setf *expose-font* (xlib:open-font *display* *expose-font-string*)
- *expose-windows-list* nil
+ *expose-child-list* (fastswitch-associate-keys)
*expose-selected-child* nil
*query-string* "")
(xlib:warp-pointer *root* (truncate (/ (xlib:screen-width *screen*) 2))
@@ -125,51 +155,59 @@
(add-hook *query-button-press-hook* 'expose-query-button-press-hook))
(defun expose-present-windows ()
- (with-all-root-child (root)
- (with-all-frames (root frame)
- (setf (frame-data-slot frame :old-layout) (frame-layout frame)
- (frame-layout frame) #'tile-space-layout)))
+ (dolist (ex-child *expose-child-list*)
+ (let ((child (expose-child-child ex-child)))
+ (when (frame-p child)
+ (setf (frame-data-slot child :old-layout) (frame-layout child)
+ (frame-layout child) #'tile-space-layout))))
(show-all-children t))
+(defun expose-unpresent-windows ()
+ (dolist (ex-child *expose-child-list*)
+ (let ((child (expose-child-child ex-child)))
+ (when (frame-p child)
+ (setf (frame-layout child) (frame-data-slot child :old-layout)
+ (frame-data-slot child :old-layout) nil)))))
+
(defun expose-mode-display-accel-windows ()
- (let ((n -1))
- (with-all-root-child (root)
- (with-all-children-reversed (root child)
- (if (or (frame-p child)
- (managed-window-p child (find-parent-frame child *root-frame*)))
- (expose-create-window child (incf n))
- (hide-child child))))
- (setf *expose-windows-list* (nreverse *expose-windows-list*))
- (expose-draw-letter)))
+ (with-all-root-child (root)
+ (with-all-children-reversed (root child)
+ (let ((ex-child (find child *expose-child-list* :test #'child-equal-p :key #'expose-child-child)))
+ (when ex-child
+ (if (or (frame-p (expose-child-child ex-child))
+ (managed-window-p (expose-child-child ex-child)
+ (find-parent-frame (expose-child-child ex-child) *root-frame*)))
+ (expose-create-window ex-child)
+ (hide-child (expose-child-child ex-child)))))))
+ (expose-draw-letter))
+
(defun expose-find-child-from-letters (letters)
- (fourth (find letters *expose-windows-list* :test #'string-equal :key #'fifth)))
+ (find letters *expose-child-list* :test #'string-equal :key #'expose-child-key))
(defun expose-select-child ()
(let ((*query-mode-placement* *expose-query-placement*))
(multiple-value-bind (letters return)
(query-string "Which child ?")
- (let ((child (case return
+ (let ((ex-child (case return
(:return (expose-find-child-from-letters letters))
(:click *expose-selected-child*))))
- (when (find-child-in-all-root child)
- child)))))
+ (when ex-child
+ (expose-child-child ex-child))))))
+
(defun expose-restore-windows ()
(remove-hook *query-key-press-hook* 'expose-query-key-press-hook)
(remove-hook *query-button-press-hook* 'expose-query-button-press-hook)
- (dolist (lwin *expose-windows-list*)
- (awhen (first lwin)
- (xlib:destroy-window it))
- (awhen (second lwin)
- (xlib:free-gcontext it)))
+ (dolist (ex-child *expose-child-list*)
+ (awhen (expose-child-gc ex-child)
+ (xlib:free-gcontext it))
+ (awhen (expose-child-window ex-child)
+ (xlib:destroy-window it)))
(when *expose-font*
(xlib:close-font *expose-font*))
- (setf *expose-windows-list* nil)
- (with-all-root-child (root)
- (with-all-frames (root frame)
- (setf (frame-layout frame) (frame-data-slot frame :old-layout)
- (frame-data-slot frame :old-layout) nil))))
+ (expose-unpresent-windows)
+ (setf *expose-child-list* nil))
(defun expose-focus-child (child)
(let ((parent (typecase child
@@ -211,3 +249,11 @@
+;;;
+;;; Fast switch mode
+;;;
+;;; Expose shortcut
+;;;
+
+(defun fastswitch-mode ()
+ (dbg 'todo))
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index bf1c3f6..99598be 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -919,6 +919,20 @@ XINERAMA version 1.1 opcode: 150
(push (frame-window frame) acc))
acc))
+(defun get-all-frames (&optional (root *root-frame*))
+ "Return all frame in root and in its children"
+ (let ((acc nil))
+ (with-all-frames (root frame)
+ (push frame acc))
+ acc))
+
+(defun get-all-children (&optional (root *root-frame*))
+ "Return a list of all children in root"
+ (let ((acc nil))
+ (with-all-children (root child)
+ (push child acc))
+ acc))
+
(defun get-hidden-windows ()
"Return all hiddens windows"
-----------------------------------------------------------------------
Summary of changes:
clfswm.asd | 7 +-
src/bindings-second-mode.lisp | 2 +-
src/bindings.lisp | 4 +-
src/clfswm-autodoc.lisp | 2 +-
src/clfswm-circulate-mode.lisp | 2 +-
src/clfswm-configuration.lisp | 2 +-
src/clfswm-corner.lisp | 2 +-
src/clfswm-expose-mode.lisp | 197 +++++++++++++++++++++++----------------
src/clfswm-fastswitch-mode.lisp | 157 +++++++++++++++++++++++++++++++
src/clfswm-generic-mode.lisp | 2 +-
src/clfswm-info.lisp | 2 +-
src/clfswm-internal.lisp | 16 +++-
src/clfswm-keys.lisp | 2 +-
src/clfswm-layout.lisp | 2 +-
src/clfswm-menu.lisp | 2 +-
src/clfswm-nw-hooks.lisp | 2 +-
src/clfswm-pack.lisp | 2 +-
src/clfswm-placement.lisp | 2 +-
src/clfswm-query.lisp | 2 +-
src/clfswm-second-mode.lisp | 2 +-
src/clfswm-util.lisp | 2 +-
src/clfswm.lisp | 2 +-
src/config.lisp | 23 ++++-
src/menu-def.lisp | 2 +-
src/my-html.lisp | 2 +-
src/netwm-util.lisp | 2 +-
src/package.lisp | 4 +-
src/tools.lisp | 10 +-
src/version.lisp | 4 +-
src/xlib-util.lisp | 2 +-
30 files changed, 351 insertions(+), 113 deletions(-)
create mode 100644 src/clfswm-fastswitch-mode.lisp
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list