diff --git a/system/desktop/home-manager/xmonad.nix b/system/desktop/home-manager/xmonad.nix index 3897f42..ca0d50a 100644 --- a/system/desktop/home-manager/xmonad.nix +++ b/system/desktop/home-manager/xmonad.nix @@ -29,5 +29,6 @@ in { home.file.".xmonad/lib/SolarizedDark.hs".source = ./xmonad/SolarizedDark.hs; home.file.".xmonad/lib/FloatKeys.hs".source = ./xmonad/FloatKeys.hs; home.file.".xmonad/lib/TabbedFix.hs".source = ./xmonad/TabbedFix.hs; + home.file.".xmonad/lib/BoringWindows.hs".source = ./xmonad/BoringWindows.hs; }; } diff --git a/system/desktop/home-manager/xmonad/BoringWindows.hs b/system/desktop/home-manager/xmonad/BoringWindows.hs new file mode 100644 index 0000000..065ab7c --- /dev/null +++ b/system/desktop/home-manager/xmonad/BoringWindows.hs @@ -0,0 +1,153 @@ +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-} +{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances #-} + +-- copy because +-- * export IsBoring + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.BoringWindows +-- Copyright : (c) 2008 David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Adam Vogt +-- Stability : unstable +-- Portability : unportable +-- +-- BoringWindows is an extension to allow windows to be marked boring +-- +----------------------------------------------------------------------------- + +module BoringWindows ( + -- * Usage + -- $usage + boringWindows, boringAuto, + markBoring, clearBoring, + focusUp, focusDown, focusMaster, + + UpdateBoring(UpdateBoring), + BoringMessage(Replace,Merge,IsBoring), + BoringWindows() + + -- * Tips + -- ** variant of 'Full' + -- $simplest + ) where + +import XMonad.Layout.LayoutModifier(ModifiedLayout(..), + LayoutModifier(handleMessOrMaybeModifyIt, redoLayout)) +import XMonad(Typeable, LayoutClass, Message, X, fromMessage, + sendMessage, windows, withFocused, Window) +import Control.Applicative((<$>)) +import Data.List((\\), union) +import Data.Maybe(fromMaybe, listToMaybe, maybeToList) +import qualified Data.Map as M +import qualified XMonad.StackSet as W + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.BoringWindows +-- +-- Then edit your @layoutHook@ by adding the layout modifier: +-- +-- > myLayout = boringWindows (Full ||| etc..) +-- > main = xmonad def { layoutHook = myLayout } +-- +-- Then to your keybindings, add: +-- +-- > , ((modm, xK_j), focusUp) +-- > , ((modm, xK_k), focusDown) +-- > , ((modm, xK_m), focusMaster) +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + + +data BoringMessage = FocusUp | FocusDown | FocusMaster | IsBoring Window | ClearBoring + | Replace String [Window] + | Merge String [Window] + deriving ( Read, Show, Typeable ) + +instance Message BoringMessage + +-- | UpdateBoring is sent before attempting to view another boring window, so +-- that layouts have a chance to mark boring windows. +data UpdateBoring = UpdateBoring + deriving (Typeable) +instance Message UpdateBoring + +markBoring, clearBoring, focusUp, focusDown, focusMaster :: X () +markBoring = withFocused (sendMessage . IsBoring) +clearBoring = sendMessage ClearBoring +focusUp = sendMessage UpdateBoring >> sendMessage FocusUp +focusDown = sendMessage UpdateBoring >> sendMessage FocusDown +focusMaster = sendMessage UpdateBoring >> sendMessage FocusMaster + +data BoringWindows a = BoringWindows + { namedBoring :: M.Map String [a] -- ^ store borings with a specific source + , chosenBoring :: [a] -- ^ user-chosen borings + , hiddenBoring :: Maybe [a] -- ^ maybe mark hidden windows + } deriving (Show,Read,Typeable) + +boringWindows :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a +boringWindows = ModifiedLayout (BoringWindows M.empty [] Nothing) + +-- | Mark windows that are not given rectangles as boring +boringAuto :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a +boringAuto = ModifiedLayout (BoringWindows M.empty [] (Just [])) + +instance LayoutModifier BoringWindows Window where + redoLayout (b@BoringWindows { hiddenBoring = bs }) _r mst arrs = do + let bs' = W.integrate' mst \\ map fst arrs + return (arrs, Just $ b { hiddenBoring = const bs' <$> bs } ) + + handleMessOrMaybeModifyIt bst@(BoringWindows nbs cbs lbs) m + | Just (Replace k ws) <- fromMessage m + , maybe True (ws/=) (M.lookup k nbs) = + let nnb = if null ws then M.delete k nbs + else M.insert k ws nbs + in rjl bst { namedBoring = nnb } + | Just (Merge k ws) <- fromMessage m + , maybe True (not . null . (ws \\)) (M.lookup k nbs) = + rjl bst { namedBoring = M.insertWith union k ws nbs } + | Just (IsBoring w) <- fromMessage m , w `notElem` cbs = + rjl bst { chosenBoring = w:cbs } + | Just ClearBoring <- fromMessage m, not (null cbs) = + rjl bst { namedBoring = M.empty, chosenBoring = []} + | Just FocusUp <- fromMessage m = + do windows $ W.modify' $ skipBoring W.focusUp' + return Nothing + | Just FocusDown <- fromMessage m = + do windows $ W.modify' $ skipBoring W.focusDown' + return Nothing + | Just FocusMaster <- fromMessage m = + do windows $ W.modify' + $ skipBoring W.focusDown' -- wiggle focus to make sure + . skipBoring W.focusUp' -- no boring window gets the focus + . focusMaster' + return Nothing + where skipBoring f st = fromMaybe st $ listToMaybe + $ filter ((`notElem` W.focus st:bs) . W.focus) + $ take (length $ W.integrate st) + $ iterate f st + bs = concat $ cbs:maybeToList lbs ++ M.elems nbs + rjl = return . Just . Left + handleMessOrMaybeModifyIt _ _ = return Nothing + +-- | Variant of 'focusMaster' that works on a +-- 'Stack' rather than an entire 'StackSet'. +focusMaster' :: W.Stack a -> W.Stack a +focusMaster' c@(W.Stack _ [] _) = c +focusMaster' (W.Stack t ls rs) = W.Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls + +{- $simplest + +An alternative to 'Full' is "XMonad.Layout.Simplest". Less windows are +ignored by 'focusUp' and 'focusDown'. This may be helpful when you want windows +to be uninteresting by some other layout modifier (ex. +"XMonad.Layout.Minimize") + +-} diff --git a/system/desktop/home-manager/xmonad/Main.hs b/system/desktop/home-manager/xmonad/Main.hs index 49df781..387a0da 100644 --- a/system/desktop/home-manager/xmonad/Main.hs +++ b/system/desktop/home-manager/xmonad/Main.hs @@ -2,7 +2,10 @@ module Main where - +import BoringWindows (BoringMessage (..), + boringWindows, clearBoring, + focusDown, focusUp, + markBoring) import qualified Data.Map as M import Data.Monoid (All, Endo) import Data.Ratio ((%)) @@ -24,14 +27,12 @@ import XMonad.Actions.UpdatePointer (updatePointer) import XMonad.Actions.Warp (warpToScreen) import XMonad.Hooks.DynamicLog (PP (..), dynamicLog, shorten, statusBar, wrap) +import XMonad.Hooks.ManageDebug (debugManageHook) import XMonad.Hooks.ManageHelpers (doCenterFloat) import XMonad.Hooks.SetWMName (setWMName) import XMonad.Hooks.UrgencyHook (BorderUrgencyHook (..), SpawnUrgencyHook (..), withUrgencyHook) -import XMonad.Layout.BoringWindows (boringWindows, clearBoring, - focusDown, focusUp, - markBoring) import XMonad.Layout.Mosaic (Aspect (Reset), mosaic) import XMonad.Layout.NoBorders (noBorders, smartBorders) import XMonad.Layout.ResizableTile (MirrorResize (MirrorExpand, MirrorShrink), @@ -232,7 +233,8 @@ myAdditionaKeys then do killAllOtherCopies clearBoring else do windows copyToAll - markBoring) + withFocused (\w -> broadcastMessage (IsBoring w) ) + ) -- rename workspace but make sure myWorkspaces still exist , ( "r" , do renameWorkspace myXPConfig @@ -473,7 +475,10 @@ startUp -- main :: IO () main = do - xmonad $ withUrgencyHook (SpawnUrgencyHook "echo emit Urgency ") $ dynamicProjects projects $ defaults + xmonad $ withUrgencyHook (SpawnUrgencyHook "echo emit Urgency ") $ + dynamicProjects projects $ + -- debugManageHook $ + defaults myTerm :: FilePath myTerm = nixStartTerminal