From pbrochard at common-lisp.net Mon Jul 29 20:42:53 2013 From: pbrochard at common-lisp.net (Philippe Brochard) Date: Mon, 29 Jul 2013 13:42:53 -0700 (PDT) Subject: [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch master updated. R-1212-33-g8fd97bb Message-ID: <20130729204253.5FD913566B4@mail.common-lisp.net> 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 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 -;; Copyright (C) 2012 Martin Bishop +;; Copyright (C) 2005-2013 Xavier Maillard +;; 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 +;;; (C) 2005-2013 Philippe Brochard ;;; ;;; 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 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 +;;; +;;; 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 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