diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Phil Lindberg + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Phil Lindberg nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/XMonad/Actions/WindowNames.hs b/src/XMonad/Actions/WindowNames.hs new file mode 100644 --- /dev/null +++ b/src/XMonad/Actions/WindowNames.hs @@ -0,0 +1,191 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.WindowNames +-- Copyright : (c) 2015 Phil Lindberg +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Phil Lindberg +-- Stability : experimental +-- Portability : unportable +-- +-- A library to automatically put named windows into the DynamicLog. It +-- provides a modification of 'XMonad.Hooks.DynamicLog.dynamicLogWithPP' and +-- some helper functions. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.WindowNames ( + -- * Usage + -- $usage + + -- * Modified dynamic log functions + dynamicLogStringMap + , dynamicLogWithPPMap + -- * Helper functions + , evalLookup + , filterShortNames + -- * Stack and StackSet functions + , getTagStack + , getWindowNames + , integrateM + -- * Pretty-printer functions + , pprWindowSetMap + -- * To Do + -- $todo + ) where + +import Codec.Binary.UTF8.String (encodeString) +import Control.Monad (mapM, MonadPlus(mplus)) +import Data.List (intercalate) +import Data.Maybe (listToMaybe, catMaybes, fromMaybe, isJust) +import XMonad +import XMonad.Hooks.DynamicLog (PP(..)) +import XMonad.Hooks.UrgencyHook (readUrgents) +import XMonad.Util.NamedWindows (getName) +import XMonad.Util.WorkspaceCompare (WorkspaceSort) + +import qualified Data.Map as M +import qualified XMonad.StackSet as W + + +-- $usage +-- You can add this to your @~\/.xmonad\/xmonad.hs@: +-- +-- > import Data.List (isSuffixOf) +-- > import System.IO +-- > import WindowNames +-- > import XMonad +-- > import XMonad.Hooks.DynamicLog +-- > import XMonad.Util.Run(spawnPipe) +-- +-- A simple example is a follows (the example uses xmobar but feel free to +-- substitute dzen or anything else): +-- +-- > myShortNames :: [(String -> Bool, String -> String)] +-- > myShortNames = [ (("Pentadactyl" `isSuffixOf`), const "ff" ) +-- > , ((=="Library"), const "ffdl") +-- > , (const True, take 4 ) -- catch all +-- > ] +-- > +-- > main = do +-- > h <- spawnPipe "xmobar -options -foo -bar" +-- > xmonad $ myXmonadConfig h +-- > +-- > myXmonadConfig h = defaultConfig { +-- > ... +-- > logHook = dynamicLogWithPPMap (getWindowNames (foc . filt) filt filt) xmobarPP { ppOutput = hPutStrLn h } +-- > ... +-- > } +-- > where foc = wrap "" "" -- xmobar font 1 (additionalFonts!!0) +-- > filt = filterShortNames myShortNames +-- +-- This works nicely with named tmux sessions or screens. You can use it in +-- conjunction with other dynamicLog string modifiers. + +-- $todo +-- * Incorporate with 'XMonad.Actions.TagWindows' +-- * Efficiency (ExtensionClass?) +-- * Make sure it works with the newest XMonad + +-- | Helper function used by 'filterShortNames' which run the first function in +-- the tuple on the value. If it evalutes to true, the output of the second +-- function if returned. +evalLookup :: MonadPlus m => a -> [(a -> Bool, a -> b)] -> m b +evalLookup n ((f,g):xs) | f n = return (g n) `mplus` evalLookup n xs + | otherwise = evalLookup n xs + +-- | Example filter short name function. +filterShortNames :: [(String -> Bool, String -> String)] -> String -> String +filterShortNames filterList s = fromMaybe "" $ evalLookup s filterList + +-- | Get a Map of window tag to strings in the format "wsId:w1,w2,...,wN" where +-- w1,...,wn represent the names of windows according to +-- 'XMonad.Util.NamedWindows.getName' after being run through the respective +-- focus, up, and down functions +getWindowNames :: (String -> String) -- ^ Function to apply to the focused window's name. + -> (String -> String) -- ^ Function to apply to the up windows' names. + -> (String -> String) -- ^ Function to apply to the down windows' names. + -> W.StackSet WorkspaceId l Window sid sd -- ^ Stack set + -> X (M.Map WorkspaceId String) +getWindowNames f u d w = fmap M.fromList $ mapM returnNameStr $ getTagStack w + where joinWinNames x _ = fmap (((x ++ ":") ++) . intercalate "," . filter (not . null)) . + integrateM (nameFunc f) (nameFunc u) (nameFunc d) + + returnNameStr (x, y) = maybe (return x) (joinWinNames x y) y >>= \z -> return (x, z) + nameFunc f = fmap (f . show) . getName + +-- | Run a monadic function on 'XMonad.StackSet.Stack' components. +integrateM :: Monad m => + (a -> m b) -- ^ Monadic function to run on focused components. + -> (a -> m b) -- ^ Monadic function to run on up components. + -> (a -> m b) -- ^ Monadic function to run on down components. + -> W.Stack a -- ^ Current StackSet + -> m [b] +integrateM f u d (W.Stack x l r) = do + r2 <- mapM u r + x2 <- f x + l2 <- mapM d l + return $ reverse l2 ++ x2 : r2 + +-- | Get a list of tag and maybe Stack. +getTagStack :: W.StackSet t l a sid sd -> [(t, Maybe (W.Stack a))] +getTagStack w = [ (i, a) | W.Workspace i _ a <- (W.workspace . W.current) w : map W.workspace (W.visible w) ++ W.hidden w ] + +-- | Modified 'XMonad.Hooks.DynamicLog.dynamicLogWithPP' which takes an +-- additional WindowSet to Map of WorkspaceId to String. +dynamicLogWithPPMap :: (WindowSet -> X (M.Map WorkspaceId String)) -> PP -> X () +dynamicLogWithPPMap wsIdMap pp = dynamicLogStringMap wsIdMap pp >>= io . ppOutput pp + +-- | Modifed 'XMonad.Hooks.DynamicLog.dynamicLogString' which takes an +-- additional WindowSet to Map of WorkspaceId to String. +dynamicLogStringMap :: (WindowSet -> X (M.Map WorkspaceId String)) -> PP -> X String +dynamicLogStringMap wsIdMap pp = do + winset <- gets windowset + urgents <- readUrgents + sort' <- ppSort pp + + -- layout description + let ld = description . W.layout . W.workspace . W.current $ winset + + -- workspace list + ws <- pprWindowSetMap wsIdMap sort' urgents pp winset + + -- window title + wt <- maybe (return "") (fmap show . getName) . W.peek $ winset + + -- run extra loggers, ignoring any that generate errors. + extras <- mapM (`catchX` return Nothing) $ ppExtras pp + + return $ encodeString . sepBy (ppSep pp) . ppOrder pp $ + [ ws + , ppLayout pp ld + , ppTitle pp $ ppTitleSanitize pp wt + ] + ++ catMaybes extras + +-- | Format the workspace information +pprWindowSetMap :: (WindowSet -> X (M.Map WorkspaceId String)) -- ^ Map of WorkspaceId to a string to be displayed. + -> WorkspaceSort -- ^ A workspace sorting function + -> [Window] -- ^ A list of urgent windows + -> PP -- ^ pretty-printer format + -> WindowSet -- ^ current WindowSet + -> X String +pprWindowSetMap wsIdFunc sort' urgents pp s = do + wsIdMap <- wsIdFunc s + return $ sepBy (ppWsSep pp) . map (fmt wsIdMap) . sort' $ map W.workspace (W.current s : W.visible s) ++ W.hidden s + where this = W.currentTag s + visibles = map (W.tag . W.workspace) (W.visible s) + + fmt wsIdMap w = printer pp (fromMaybe "" $ M.lookup (W.tag w) wsIdMap) + where printer | any (\x -> maybe False (== W.tag w) (W.findTag x s)) urgents = ppUrgent + | W.tag w == this = ppCurrent + | W.tag w `elem` visibles = ppVisible + | isJust (W.stack w) = ppHidden + | otherwise = ppHiddenNoWindows + +-- | Output a list of strings, ignoring empty ones and separating the +-- rest with the given separator. +sepBy :: String -- ^ separator + -> [String] -- ^ fields to output + -> String +sepBy sep = intercalate sep . filter (not . null) diff --git a/xmonad-windownames.cabal b/xmonad-windownames.cabal new file mode 100644 --- /dev/null +++ b/xmonad-windownames.cabal @@ -0,0 +1,23 @@ +name: xmonad-windownames +version: 0.1.0.0 +synopsis: A library to automatically put named windows into the DynamicLog. +homepage: https://github.com/plindbe2/xmonad-windownames +license: BSD3 +license-file: LICENSE +author: Phil Lindberg +maintainer: plindbe2@gmail.com +category: XMonad +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: XMonad.Actions.WindowNames + + build-depends: base >=4.7 && <4.8, + utf8-string >=0.3 && <0.4, + xmonad >=0.11 && <0.12, + xmonad-contrib >=0.11 && <0.12, + containers >=0.5 && <0.6 + + hs-source-dirs: src + default-language: Haskell2010