From 62245955bc752166c993829a400c5a23fff68fd3 Mon Sep 17 00:00:00 2001 From: Norbert Zeh Date: Mon, 10 May 2010 10:14:12 +0200 Subject: New module XMonad.Actions.GroupNavigation Ignore-this: c286dbd1b365326fa25a9c5c0e564af7 This module adds two related facilities. The first one allows cycling through the windows in a window group. A group is defined as the set of windows for which a given Boolean Query returns True. The second one keeps track of the history of focused windows and allows returning to the most recently focused window in a given window group before the currently focused window. darcs-hash:20100510081412-18a2b-f3a46acd1883a5b74f70ab2457694a05d5568c5d.gz --- XMonad/Actions/GroupNavigation.hs | 210 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 210 insertions(+) create mode 100644 XMonad/Actions/GroupNavigation.hs (limited to 'XMonad/Actions/GroupNavigation.hs') diff --git a/XMonad/Actions/GroupNavigation.hs b/XMonad/Actions/GroupNavigation.hs new file mode 100644 index 0000000..adde3f9 --- /dev/null +++ b/XMonad/Actions/GroupNavigation.hs @@ -0,0 +1,210 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +---------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.GroupNavigation +-- Copyright : (c) nzeh@cs.dal.ca +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : nzeh@cs.dal.ca +-- Stability : unstable +-- Portability : unportable +-- +-- Provides methods for cycling through groups of windows across +-- workspaces, ignoring windows that do not belong to this group. A +-- group consists of all windows matching a user-provided boolean +-- query. +-- +-- Also provides a method for jumping back to the most recently used +-- window in any given group. +-- +---------------------------------------------------------------------- + +module XMonad.Actions.GroupNavigation ( -- * Usage + -- $usage + Direction (..) + , nextMatch + , nextMatchOrDo + , nextMatchWithThis + , historyHook + ) where + +import Control.Monad +import Control.Monad.Reader +import Data.Foldable +import Data.Map as Map +import Data.Maybe +import Data.Sequence as Seq +import Data.Set as Set +import Graphics.X11.Types +import Prelude hiding (concatMap, drop, elem, filter, null, reverse) +import XMonad.Core +import XMonad.ManageHook +import XMonad.Operations +import qualified XMonad.StackSet as SS +import qualified XMonad.Util.ExtensibleState as XS + +{- $usage + +Import the module into your @~\/.xmonad\/xmonad.hs@: + +> import XMonad.Actions,GroupNavigation + +To support cycling forward and backward through all xterm windows, add +something like this to your keybindings: + +> , ((modm , xK_t), nextMatch Forward (className =? "XTerm")) +> , ((modm .|. shiftMask, xK_t), nextMatch Backward (className =? "XTerm")) + +These key combinations do nothing if there is no xterm window open. +If you rather want to open a new xterm window if there is no open +xterm window, use 'nextMatchOrDo' instead: + +> , ((modm , xK_t), nextMatchOrDo Forward (className =? "XTerm") (spawn "xterm")) +> , ((modm .|. shiftMask, xK_t), nextMatchOrDo Backward (className =? "XTerm") (spawn "xterm")) + +You can use 'nextMatchWithThis' with an arbitrary query to cycle +through all windows for which this query returns the same value as the +current window. For example, to cycle through all windows in the same +window class as the current window use: + +> , ((modm , xK_f), nextMatchWithThis Forward className) +> , ((modm , xK_b), nextMatchWithThis Backward className) + +Finally, you can define keybindings to jump to the most recent window +matching a certain Boolean query. To do this, you need to add +'historyHook' to your logHook: + +> main = xmonad $ defaultConfig { logHook = historyHook } + +Then the following keybindings, for example, allow you to return to +the most recent xterm or emacs window or to simply to the most recent +window: + +> , ((modm .|. controlMask, xK_e), nextMatch History (className =? "Emacs")) +> , ((modm .|. controlMask, xK_t), nextMatch History (className =? "XTerm")) +> , ((modm , xK_BackSpace), nextMatch History (return True)) + +Again, you can use 'nextMatchOrDo' instead of 'nextMatch' if you want +to execute an action if no window matching the query exists. -} + +--- Basic cyclic navigation based on queries ------------------------- + +-- | The direction in which to look for the next match +data Direction = Forward -- ^ Forward from current window or workspace + | Backward -- ^ Backward from current window or workspace + | History -- ^ Backward in history + +-- | Focuses the next window for which the given query produces the +-- same result as the currently focused window. Does nothing if there +-- is no focused window (i.e., the current workspace is empty). +nextMatchWithThis :: Eq a => Direction -> Query a -> X () +nextMatchWithThis dir qry = withFocused $ \win -> do + prop <- runQuery qry win + nextMatch dir (qry =? prop) + +-- | Focuses the next window that matches the given boolean query. +-- Does nothing if there is no such window. This is the same as +-- 'nextMatchOrDo' with alternate action @return ()@. +nextMatch :: Direction -> Query Bool -> X () +nextMatch dir qry = nextMatchOrDo dir qry (return ()) + +-- | Focuses the next window that matches the given boolean query. If +-- there is no such window, perform the given action instead. +nextMatchOrDo :: Direction -> Query Bool -> X () -> X () +nextMatchOrDo dir qry act = orderedWindowList dir + >>= focusNextMatchOrDo qry act + +-- Produces the action to perform depending on whether there's a +-- matching window +focusNextMatchOrDo :: Query Bool -> X () -> Seq Window -> X () +focusNextMatchOrDo qry act = findM (runQuery qry) + >=> maybe act (windows . SS.focusWindow) + +-- Returns the list of windows ordered by workspace as specified in +-- ~/.xmonad/xmonad.hs +orderedWindowList :: Direction -> X (Seq Window) +orderedWindowList History = liftM (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get +orderedWindowList dir = withWindowSet $ \ss -> do + wsids <- asks (Seq.fromList . workspaces . config) + let wspcs = orderedWorkspaceList ss wsids + wins = dirfun dir + $ foldl' (><) Seq.empty + $ fmap (Seq.fromList . SS.integrate' . SS.stack) wspcs + cur = currentWindow ss + return $ maybe wins (rotfun wins) cur + where + dirfun Backward = Seq.reverse + dirfun _ = id + rotfun wins x = rotate $ rotateTo (== x) wins + +-- Returns the currently focused window or Nothing if no window is +-- currently focused. +currentWindow :: WindowSet -> Maybe Window +currentWindow = liftM SS.focus . SS.stack . SS.workspace . SS.current + +-- Returns the ordered workspace list as specified in ~/.xmonad/xmonad.hs +orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace +orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs' + where + wspcs = SS.workspaces ss + wspcsMap = foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs + wspcs' = fmap (\wsid -> wspcsMap ! wsid) wsids + isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss) + +--- History navigation, requires a layout modifier ------------------- + +-- The state extension that holds the history information +data HistoryDB = HistoryDB (Maybe Window) -- currently focused window + (Seq Window) -- previously focused windows + deriving (Read, Show, Typeable) + +instance ExtensionClass HistoryDB where + + initialValue = HistoryDB Nothing Seq.empty + extensionType = PersistentExtension + +-- | Action that needs to be executed as a logHook to maintain the +-- focus history of all windows as the WindowSet changes. +historyHook :: X () +historyHook = XS.get >>= updateHistory >>= XS.put + +-- Updates the history in response to a WindowSet change +updateHistory :: HistoryDB -> X HistoryDB +updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do + let newcur = currentWindow ss + wins = Set.fromList $ SS.allWindows ss + newhist = Seq.filter (flip Set.member wins) oldhist + return $ HistoryDB newcur (del newcur $ ins oldcur newhist) + where + ins x xs = maybe xs (<| xs) x + del x xs = maybe xs (\x' -> Seq.filter (/= x') xs) x + +--- Some sequence helpers -------------------------------------------- + +-- Rotates the sequence by one position +rotate :: Seq a -> Seq a +rotate xs = rotate' (viewl xs) + where + rotate' EmptyL = Seq.empty + rotate' (x' :< xs') = xs' |> x' + +-- Rotates the sequence until an element matching the given condition +-- is at the beginning of the sequence. +rotateTo :: (a -> Bool) -> Seq a -> Seq a +rotateTo cond xs = let (lxs, rxs) = breakl cond xs in rxs >< lxs + +--- A monadic find --------------------------------------------------- + +-- Applies the given action to every sequence element in turn until +-- the first element is found for which the action returns true. The +-- remaining elements in the sequence are ignored. +findM :: Monad m => (a -> m Bool) -> Seq a -> m (Maybe a) +findM cond xs = findM' cond (viewl xs) + where + findM' _ EmptyL = return Nothing + findM' qry (x' :< xs') = do + isMatch <- qry x' + if isMatch + then return (Just x') + else findM qry xs' -- cgit v1.2.3