xmonad-contrib 0.5 → 0.6
raw patch · 42 files changed
+1099/−255 lines, 42 filesdep ~X11dep ~xmonad
Dependency ranges changed: X11, xmonad
Files
- XMonad/Actions/Commands.hs +2/−2
- XMonad/Actions/ConstrainedResize.hs +3/−3
- XMonad/Actions/CopyWindow.hs +1/−1
- XMonad/Actions/CycleWS.hs +55/−15
- XMonad/Actions/FlexibleManipulate.hs +3/−3
- XMonad/Actions/FlexibleResize.hs +3/−3
- XMonad/Actions/FocusNth.hs +5/−4
- XMonad/Actions/MouseGestures.hs +1/−1
- XMonad/Actions/NoBorders.hs +33/−0
- XMonad/Actions/RotSlaves.hs +4/−4
- XMonad/Actions/Search.hs +138/−0
- XMonad/Actions/SinkAll.hs +1/−1
- XMonad/Actions/Warp.hs +8/−0
- XMonad/Config/Droundy.hs +6/−4
- XMonad/Config/Sjanssen.hs +1/−1
- XMonad/Doc/Developing.hs +27/−2
- XMonad/Doc/Extending.hs +8/−0
- XMonad/Hooks/DynamicLog.hs +30/−32
- XMonad/Hooks/EwmhDesktops.hs +36/−15
- XMonad/Hooks/ManageDocks.hs +54/−44
- XMonad/Hooks/ManageHelpers.hs +130/−0
- XMonad/Layout/DragPane.hs +2/−2
- XMonad/Layout/Grid.hs +1/−1
- XMonad/Layout/LayoutScreens.hs +7/−5
- XMonad/Layout/Magnifier.hs +24/−1
- XMonad/Layout/MultiToggle.hs +10/−5
- XMonad/Layout/PerWorkspace.hs +7/−0
- XMonad/Layout/Reflect.hs +119/−0
- XMonad/Layout/ResizableTile.hs +12/−6
- XMonad/Layout/ShowWName.hs +104/−0
- XMonad/Layout/Tabbed.hs +26/−14
- XMonad/Prompt.hs +38/−5
- XMonad/Prompt/Man.hs +21/−17
- XMonad/Prompt/Shell.hs +2/−10
- XMonad/Util/Dzen.hs +6/−2
- XMonad/Util/Font.cpphs +4/−4
- XMonad/Util/Run.hs +18/−30
- XMonad/Util/Timer.hs +59/−0
- XMonad/Util/WorkspaceCompare.hs +41/−0
- XMonad/Util/XSelection.hs +4/−4
- XMonad/Util/XUtils.hs +27/−11
- xmonad-contrib.cabal +18/−3
XMonad/Actions/Commands.hs view
@@ -88,8 +88,8 @@ , ("expand" , sendMessage Expand ) , ("next-layout" , sendMessage NextLayout ) , ("default-layout" , asks (layoutHook . config) >>= setLayout )- , ("restart-wm" , sr >> restart Nothing True )- , ("restart-wm-no-resume", sr >> restart Nothing False )+ , ("restart-wm" , sr >> restart "xmonad" True )+ , ("restart-wm-no-resume", sr >> restart "xmonad" False ) , ("xterm" , spawn =<< asks (terminal . config) ) , ("run" , spawn "exe=`dmenu_path | dmenu -b` && exec $exe" ) , ("kill" , kill )
XMonad/Actions/ConstrainedResize.hs view
@@ -16,9 +16,9 @@ ----------------------------------------------------------------------------- module XMonad.Actions.ConstrainedResize (- -- * Usage- -- $usage- XMonad.Actions.ConstrainedResize.mouseResizeWindow+ -- * Usage+ -- $usage+ XMonad.Actions.ConstrainedResize.mouseResizeWindow ) where import XMonad
XMonad/Actions/CopyWindow.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fglasgow-exts #-}+{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CopyWindow
XMonad/Actions/CycleWS.hs view
@@ -10,7 +10,7 @@ -- Portability : unportable -- -- Provides bindings to cycle forward or backward through the list--- of workspaces, and to move windows there.+-- of workspaces, and to move windows there, and to cycle between the screens. -- ----------------------------------------------------------------------------- @@ -22,31 +22,38 @@ shiftToNext, shiftToPrev, toggleWS,+ nextScreen,+ prevScreen,+ shiftNextScreen,+ shiftPrevScreen ) where -import Data.List ( sortBy, findIndex )+import Data.List ( findIndex ) import Data.Maybe ( fromMaybe )-import Data.Ord ( comparing ) import XMonad hiding (workspaces)-import qualified XMonad (workspaces) import XMonad.StackSet hiding (filter)+import XMonad.Util.WorkspaceCompare -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Actions.CycleWS ----- > , ((modMask x, xK_Right), nextWS)--- > , ((modMask x, xK_Left), prevWS)--- > , ((modMask x .|. shiftMask, xK_Right), shiftToNext)--- > , ((modMask x .|. shiftMask, xK_Left), shiftToPrev)+-- > , ((modMask x, xK_Down), nextWS)+-- > , ((modMask x, xK_Up), prevWS)+-- > , ((modMask x .|. shiftMask, xK_Down), shiftToNext)+-- > , ((modMask x .|. shiftMask, xK_Up), shiftToPrev)+-- > , ((modMask x, xK_Right), nextScreen)+-- > , ((modMask x, xK_Left), prevScreen)+-- > , ((modMask x .|. shiftMask, xK_Right), shiftNextScreen)+-- > , ((modMask x .|. shiftMask, xK_Left), shiftPrevScreen) -- > , ((modMask x, xK_t), toggleWS) -- -- If you want to follow the moved window, you can use both actions: ----- > , ((modMask x .|. shiftMask, xK_Right), shiftToNext >> nextWS)--- > , ((modMask x .|. shiftMask, xK_Left), shiftToPrev >> prevWS)+-- > , ((modMask x .|. shiftMask, xK_Down), shiftToNext >> nextWS)+-- > , ((modMask x .|. shiftMask, xK_Up), shiftToPrev >> prevWS) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings".@@ -81,14 +88,47 @@ wsBy :: Int -> X (WorkspaceId) wsBy d = do ws <- gets windowset- spaces <- asks (XMonad.workspaces . config)- let orderedWs = sortBy (comparing (wsIndex spaces)) (workspaces ws)+ sort' <- getSortByTag+ let orderedWs = sort' (workspaces ws) let now = fromMaybe 0 $ findWsIndex (workspace (current ws)) orderedWs let next = orderedWs !! ((now + d) `mod` length orderedWs) return $ tag next -wsIndex :: [WorkspaceId] -> WindowSpace -> Maybe Int-wsIndex spaces ws = findIndex (== tag ws) spaces- findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int findWsIndex ws wss = findIndex ((== tag ws) . tag) wss++-- | View next screen+nextScreen :: X ()+nextScreen = switchScreen 1++-- | View prev screen+prevScreen :: X ()+prevScreen = switchScreen (-1)++switchScreen :: Int -> X ()+switchScreen d = do s <- screenBy d+ mws <- screenWorkspace s+ case mws of+ Nothing -> return ()+ Just ws -> windows (view ws)++screenBy :: Int -> X (ScreenId)+screenBy d = do ws <- gets windowset+ --let ss = sortBy screen (screens ws)+ let now = screen (current ws)+ return $ (now + fromIntegral d) `mod` fromIntegral (length (screens ws))++-- | Move focused window to workspace on next screen+shiftNextScreen :: X ()+shiftNextScreen = shiftScreenBy 1++-- | Move focused window to workspace on prev screen+shiftPrevScreen :: X ()+shiftPrevScreen = shiftScreenBy (-1)++shiftScreenBy :: Int -> X ()+shiftScreenBy d = do s <- screenBy d+ mws <- screenWorkspace s+ case mws of+ Nothing -> return ()+ Just ws -> windows (shift ws)
XMonad/Actions/FlexibleManipulate.hs view
@@ -17,9 +17,9 @@ -- Based on the FlexibleResize code by Lukas Mai (mauke). module XMonad.Actions.FlexibleManipulate (- -- * Usage- -- $usage- mouseWindow, discrete, linear, resize, position+ -- * Usage+ -- $usage+ mouseWindow, discrete, linear, resize, position ) where import XMonad
XMonad/Actions/FlexibleResize.hs view
@@ -13,9 +13,9 @@ ----------------------------------------------------------------------------- module XMonad.Actions.FlexibleResize (- -- * Usage- -- $usage- XMonad.Actions.FlexibleResize.mouseResizeWindow+ -- * Usage+ -- $usage+ XMonad.Actions.FlexibleResize.mouseResizeWindow ) where import XMonad
XMonad/Actions/FocusNth.hs view
@@ -38,12 +38,13 @@ focusNth = windows . modify' . focusNth' focusNth' :: Int -> Stack a -> Stack a-focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s- | otherwise = listToStack n (integrate s)+focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s+ | otherwise = listToStack n (integrate s) listToStack :: Int -> [a] -> Stack a listToStack n l = Stack t ls rs- where (t:rs) = drop n l- ls = reverse (take n l)+ where+ (t:rs) = drop n l+ ls = reverse (take n l)
XMonad/Actions/MouseGestures.hs view
@@ -15,7 +15,7 @@ module XMonad.Actions.MouseGestures ( -- * Usage -- $usage- Direction(..),+ Direction(..), mouseGesture ) where
+ XMonad/Actions/NoBorders.hs view
@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Actions.NoBorders+-- Copyright : (c) Lukas Mai+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Lukas Mai <l.mai@web.de>+-- Stability : unstable+-- Portability : unportable+--+-- This module provides helper functions for dealing with window borders.+--+-----------------------------------------------------------------------------++module XMonad.Actions.NoBorders (+ toggleBorder+) where++import XMonad++-- | Toggle the border of the currently focused window. To use it, add a+-- keybinding like so:+--+-- > , ((modMask x, xK_g ), withFocused toggleBorder)+--+toggleBorder :: Window -> X ()+toggleBorder w = do+ bw <- asks (borderWidth . config)+ withDisplay $ \d -> io $ do+ cw <- wa_border_width `fmap` getWindowAttributes d w+ if cw == 0+ then setWindowBorderWidth d w bw+ else setWindowBorderWidth d w 0
XMonad/Actions/RotSlaves.hs view
@@ -12,10 +12,10 @@ -- place. ----------------------------------------------------------------------------- module XMonad.Actions.RotSlaves (- -- $usage- rotSlaves', rotSlavesUp, rotSlavesDown,- rotAll', rotAllUp, rotAllDown- ) where+ -- $usage+ rotSlaves', rotSlavesUp, rotSlavesDown,+ rotAll', rotAllUp, rotAllDown+ ) where import XMonad.StackSet import XMonad
+ XMonad/Actions/Search.hs view
@@ -0,0 +1,138 @@+{- |+ Module : XMonad.Actions.Search+ Copyright : (C) 2007 Gwern Branwen+ License : None; public domain++ Maintainer : <gwern0@gmail.com>+ Stability : unstable+ Portability : unportable++ A module for easily running Internet searches on web sites through XMonad.+ Modeled after the handy Surfraw CLI search tools+ <https://secure.wikimedia.org/wikipedia/en/wiki/Surfraw>.++ Additional sites welcomed.+-}+module XMonad.Actions.Search ( -- * Usage+ -- $usage+ search,+ simpleEngine,+ promptSearch,+ selectSearch,++ amazon,+ google,+ imdb,+ wayback,+ wikipedia,+ hoogle+ ) where++import Data.Char (chr, ord, isAlpha, isMark, isDigit)+import Numeric (showIntAtBase)+import XMonad (X(), MonadIO)+import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig())+import XMonad.Prompt.Shell (getShellCompl)+import XMonad.Util.Run (safeSpawn)+import XMonad.Util.XSelection (getSelection)++{- $usage++ This module is intended to allow easy access to databases on the Internet+ through XMonad's interface. The idea is that one wants to run a search but the+ query string and the browser to use must come from somewhere. There are two+ places the query string can come from - the user can type it into a prompt+ which pops up, or the query could be available already in the X Windows+ copy\/paste buffer (perhaps you just highlighted the string of interest).++ Thus, there are two main functions: 'promptSearch', and 'selectSearch'+ (implemented using the more primitive 'search'). To each of these is passed an+ engine function; this is a function that knows how to search a particular+ site.++ For example, the 'google' function knows how to search Google, and so on. You pass+ promptSearch and selectSearch the engine you want, the browser you want, and+ anything special they might need; this whole line is then bound to a key of+ you choosing in your xmonad.hs. For specific examples, see each function.+ This module is easily extended to new sites by using 'simpleEngine'.+-}++-- A customized prompt.+data Search = Search+instance XPrompt Search where+ showXPrompt Search = "Search: "++-- | Escape the search string so search engines understand it.+-- Note that everything is escaped; we could be smarter and use 'isAllowedInURI'+-- but then that'd be hard enough to copy-and-paste we'd need to depend on 'network'.+escape :: String -> String+escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c)+ where -- Copied from Network.URI.+ escapeURIString ::+ (Char -> Bool) -- a predicate which returns 'False' if should escape+ -> String -- the string to process+ -> String -- the resulting URI string+ escapeURIString p s = concatMap (escapeURIChar p) s+ escapeURIChar :: (Char->Bool) -> Char -> String+ escapeURIChar p c+ | p c = [c]+ | otherwise = '%' : myShowHex (ord c) ""+ where+ myShowHex :: Int -> ShowS+ myShowHex n r = case showIntAtBase 16 (toChrHex) n r of+ [] -> "00"+ [ch] -> ['0',ch]+ cs -> cs+ toChrHex d+ | d < 10 = chr (ord '0' + fromIntegral d)+ | otherwise = chr (ord 'A' + fromIntegral (d - 10))++type Browser = FilePath+type SearchEngine = String -> String++search :: MonadIO m => Browser -> SearchEngine -> String -> m ()+search browser site query = safeSpawn browser $ site query++{- | Given a base URL, create the SearchEngine that escapes the query and+ appends it to the base. You can easily define a new engine locally using simpleEngine+ without needing to modify Search.hs:++ > newEngine = simpleEngine "http://site.com/search="++ The important thing is that the site has a interface which accepts the query+ string as part of the URL. Alas, the exact URL to feed simpleEngine varies+ from site to site, often considerably. Generally, examining the resultant URL+ of a search will allow you to reverse-engineer it if you can't find the+ necessary URL already described in other projects such as Surfraw. -}+simpleEngine :: String -> SearchEngine+simpleEngine site query = site ++ escape query++-- The engines+amazon, google, hoogle, imdb, wayback, wikipedia :: SearchEngine+amazon = simpleEngine "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="+google = simpleEngine "http://www.google.com/search?num=100&q="+hoogle = simpleEngine "http://www.haskell.org/hoogle/?q="+imdb = simpleEngine "http://www.imdb.com/Find?select=all&for="+wikipedia = simpleEngine "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search="+wayback = simpleEngine "http://web.archive.org/"+{- This doesn't seem to work, but nevertheless, it seems to be the official+ method at <http://web.archive.org/collections/web/advanced.html> to get the+ latest backup. -}++{- | Like 'search', but in this case, the string is not specified but grabbed+ from the user's response to a prompt. Example:++ > , ((modm, xK_g ), promptSearch greenXPConfig "firefox" google)++-}+promptSearch :: XPConfig -> Browser -> SearchEngine -> X ()+promptSearch config browser site = mkXPrompt Search config (getShellCompl []) $ search browser site++{- | Like search, but for use with the X selection; it grabs the selection,+ passes it to a given searchEngine and opens it in the given browser. Example:++> , ((modm .|. shiftMask, xK_g ), selectSearch "firefox" google)++-}+selectSearch :: MonadIO m => Browser -> SearchEngine -> m ()+selectSearch browser searchEngine = search browser searchEngine =<< getSelection
XMonad/Actions/SinkAll.hs view
@@ -1,6 +1,6 @@ ----------------------------------------------------------------------------- -- |--- Module : Xmonad.Actions.SinkAll+-- Module : XMonad.Actions.SinkAll -- License : BSD3-style (see LICENSE) -- Stability : unstable -- Portability : unportable
XMonad/Actions/Warp.hs view
@@ -39,6 +39,14 @@ > | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]] Note that warping to a particular screen may change the focus.++'warpToScreen' and 'warpToWindow' can be used in a variety of+ways. Suppose you wanted to emulate Ratpoison's \'banish\' command,+which moves the mouse pointer to a corner; you could define:++> banish :: X ()+> banish = warpToWindow 1 1 -- lower left+ -} -- For detailed instructions on editing your key bindings, see
XMonad/Config/Droundy.hs view
@@ -41,8 +41,8 @@ import XMonad.Actions.DynamicWorkspaces import XMonad.Actions.RotView ---import XMonad.Hooks.ManageDocks---import XMonad.Hooks.UrgencyHook+import XMonad.Hooks.ManageDocks+import XMonad.Hooks.UrgencyHook myXPConfig :: XPConfig myXPConfig = defaultXPConfig {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*"@@ -77,7 +77,7 @@ -- quit, or restart , ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad- , ((modMask x , xK_Escape), broadcastMessage ReleaseResources >> restart (Just "xmonad") True) -- %! Restart xmonad+ , ((modMask x , xK_Escape), restart "xmonad" True) -- %! Restart xmonad , ((modMask x .|. shiftMask, xK_z ), layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768]))@@ -127,13 +127,15 @@ zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..]) config = -- withUrgencyHook FocusUrgencyHook $+ withUrgencyHook NoUrgencyHook $ defaultConfig { borderWidth = 1 -- Width of the window border in pixels. , XMonad.workspaces = ["1:mutt","2:iceweasel"] , layoutHook = workspaceDir "~" $ windowNavigation $- toggleLayouts (noBorders Full) $ -- avoidStruts $+ toggleLayouts (noBorders Full) $ avoidStruts $ Named "tabbed" (noBorders mytab) ||| Named "xclock" (mytab ****//* combineTwo Square mytab mytab) |||+ Named "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) ||| Named "widescreen" ((mytab *||* mytab) ****//* combineTwo Square mytab mytab) -- ||| --mosaic 0.25 0.5
XMonad/Config/Sjanssen.hs view
@@ -20,7 +20,7 @@ sjanssenConfig = do xmobar <- spawnPipe "xmobar" return $ defaultConfig- { terminal = "urxvt"+ { terminal = "urxvtc" , workspaces = ["irc", "web"] ++ map show [3 .. 7 :: Int] ++ ["mail", "im"] , logHook = dynamicLogWithPP $ sjanssenPP { ppOutput = hPutStrLn xmobar } , modMask = mod4Mask
XMonad/Doc/Developing.hs view
@@ -178,7 +178,7 @@ "XMonad.StackSet" (which should usually be imported qualified, to avoid name clashes with Prelude functions such as 'Prelude.delete' and 'Prelude.filter') provides many pure functions to manipulate the-'XMonad.StackSet.StackSet'. These functions are most commonlyq used as+'XMonad.StackSet.StackSet'. These functions are most commonly used as an argument to 'XMonad.Operations.windows', which takes a pure function to manipulate the 'XMonad.Core.WindowSet' and does all the needed operations to refresh the screen and save the modified@@ -246,7 +246,7 @@ * Comment every top level function (particularly exported funtions), and provide a type signature. -* Use Haddock syntax in the comments.+* Use Haddock syntax in the comments (see below). * Follow the coding style of the other modules. @@ -259,6 +259,31 @@ * Any pure function added to the core should have QuickCheck properties precisely defining its behaviour.++For examples of Haddock documentation syntax, have a look at other+extensions. Important points are:++* Every exported function (or even better, every function) should have+ a Haddock comment explaining what it does.++* Literal chunks of code can be written in comments using+ \"birdtrack\" notation (a greater-than symbol at the beginning of+ each line). Be sure to leave a blank line before and after each+ birdtrack-quoted section.++* Link to functions by surrounding the names in single quotes, modules+ in double quotes.++* Literal quote marks and slashes should be escaped with a backslash.++To generate and view the Haddock documentation for your extension, run++> runhaskell Setup haddock++and then point your browser to @\/path\/to\/XMonadContrib\/dist\/doc\/html\/xmonad-contrib\/index.html@.++For more information, see the Haddock documentation:+<http://www.haskell.org/haddock/haddock-html-0.8/index.html>. -}
XMonad/Doc/Extending.hs view
@@ -152,6 +152,9 @@ * "XMonad.Actions.RotView": cycle through non-empty workspaces. +* "XMonad.Actions.Search": provide helpful functions for easily+ running web searchs.+ * "XMonad.Actions.SimpleDate": display the date in a popup menu. * "XMonad.Actions.SinkAll": sink all floating windows.@@ -226,6 +229,9 @@ * "XMonad.Hooks.ManageDocks": handle DOCK and STRUT windows appropriately. +* "XMonad.Hooks.ManageHelpers": provide helper functions to be used+ in @manageHook@.+ * "XMonad.Hooks.SetWMName": set the WM name. Useful when e.g. running Java GUI programs. @@ -306,6 +312,8 @@ * "XMonad.Layout.Roledex": a \"completely pointless layout which acts like Microsoft's Flip 3D\".++* "XMonad.Layout.ShowWName": Show the name of the current workspace when switching. * "XMonad.Layout.Spiral": Fibonacci spiral layout.
XMonad/Hooks/DynamicLog.hs view
@@ -10,17 +10,18 @@ -- -- DynamicLog ----- Log events in:+-- By default, log events in: -- -- > 1 2 [3] 4 8 ----- format. Suitable to pipe into dzen.+-- format, although the format is highly customizable.+-- Suitable to pipe into dzen or xmobar. -- ----------------------------------------------------------------------------- module XMonad.Hooks.DynamicLog ( -- * Usage- -- $usage + -- $usage dynamicLog, dynamicLogDzen, dynamicLogXmobar,@@ -37,7 +38,7 @@ makeSimpleDzenConfig ) where --- +-- -- Useful imports -- import XMonad@@ -45,12 +46,13 @@ import Data.List import Data.Ord ( comparing ) import qualified XMonad.StackSet as S-import Data.Monoid import System.IO+import XMonad.Util.WorkspaceCompare import XMonad.Util.NamedWindows import XMonad.Util.Run+import XMonad.Hooks.UrgencyHook --- $usage +-- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad@@ -67,9 +69,9 @@ , logHook = dynamicLogWithPP dzenPP { ppOutput = hPutStrLn h } } --- | +-- | ----- Run xmonad with a dzen status bar set to some nice defaults. Output +-- Run xmonad with a dzen status bar set to some nice defaults. Output -- is taken from the dynamicLogWithPP hook. -- -- > main = dzen xmonad@@ -104,13 +106,15 @@ -- A log function that uses the 'PP' hooks to customize output. dynamicLogWithPP :: PP -> X () dynamicLogWithPP pp = do- spaces <- asks (workspaces . config)+ winset <- gets windowset+ urgents <- readUrgents+ sort' <- getSortByTag -- layout description- ld <- withWindowSet $ return . description . S.layout . S.workspace . S.current+ let ld = description . S.layout . S.workspace . S.current $ winset -- workspace list- ws <- withWindowSet $ return . pprWindowSet spaces pp+ let ws = pprWindowSet sort' urgents pp winset -- window title- wt <- withWindowSet $ maybe (return "") (fmap show . getName) . S.peek+ wt <- maybe (return "") (fmap show . getName) . S.peek $ winset io . ppOutput pp . sepBy (ppSep pp) . ppOrder pp $ [ ws@@ -124,27 +128,18 @@ dynamicLogDzen :: X () dynamicLogDzen = dynamicLogWithPP dzenPP --pprWindowSet :: [String] -> PP -> WindowSet -> String-pprWindowSet spaces pp s = sepBy (ppWsSep pp) $ map fmt $ sortBy cmp- (map S.workspace (S.current s : S.visible s) ++ S.hidden s)- where f Nothing Nothing = EQ- f (Just _) Nothing = LT- f Nothing (Just _) = GT- f (Just x) (Just y) = compare x y-- wsIndex = flip elemIndex spaces . S.tag-- cmp a b = f (wsIndex a) (wsIndex b) `mappend` compare (S.tag a) (S.tag b)-- this = S.tag (S.workspace (S.current s))+pprWindowSet :: ([WindowSpace] -> [WindowSpace]) -> [Window] -> PP -> WindowSet -> String+pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $+ map S.workspace (S.current s : S.visible s) ++ S.hidden s+ where this = S.tag (S.workspace (S.current s)) visibles = map (S.tag . S.workspace) (S.visible s) fmt w = printer pp (S.tag w)- where printer | S.tag w == this = ppCurrent- | S.tag w `elem` visibles = ppVisible- | isJust (S.stack w) = ppHidden- | otherwise = ppHiddenNoWindows+ where printer | S.tag w == this = ppCurrent+ | S.tag w `elem` visibles = ppVisible+ | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents = \ppC -> ppUrgent ppC . ppHidden ppC+ | isJust (S.stack w) = ppHidden+ | otherwise = ppHiddenNoWindows -- | -- Workspace logger with a format designed for Xinerama:@@ -198,7 +193,8 @@ -- | The 'PP' type allows the user to customize various behaviors of -- dynamicLogPP data PP = PP { ppCurrent, ppVisible- , ppHidden, ppHiddenNoWindows :: WorkspaceId -> String+ , ppHidden, ppHiddenNoWindows+ , ppUrgent :: WorkspaceId -> String , ppSep, ppWsSep :: String , ppTitle :: String -> String , ppLayout :: String -> String@@ -212,6 +208,7 @@ , ppVisible = wrap "<" ">" , ppHidden = id , ppHiddenNoWindows = const ""+ , ppUrgent = id , ppSep = " : " , ppWsSep = " " , ppTitle = shorten 80@@ -226,6 +223,7 @@ , ppVisible = dzenColor "black" "#999999" . pad , ppHidden = dzenColor "black" "#cccccc" . pad , ppHiddenNoWindows = const ""+ , ppUrgent = dzenColor "red" "yellow" , ppWsSep = "" , ppSep = "" , ppLayout = dzenColor "black" "#cccccc" .@@ -247,7 +245,7 @@ -- | These are good defaults to be used with the xmobar status bar dynamicLogXmobar :: X ()-dynamicLogXmobar = +dynamicLogXmobar = dynamicLogWithPP defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" , ppTitle = xmobarColor "green" "" . shorten 40 , ppVisible = wrap "(" ")"
XMonad/Hooks/EwmhDesktops.hs view
@@ -17,15 +17,15 @@ ewmhDesktopsLogHook ) where -import Data.List (elemIndex, sortBy)-import Data.Ord (comparing)-import Data.Maybe (fromMaybe)+import Data.List+import Data.Maybe import XMonad import Control.Monad import qualified XMonad.StackSet as W import XMonad.Hooks.SetWMName+import XMonad.Util.WorkspaceCompare -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -48,9 +48,8 @@ -- of the current state of workspaces and windows. ewmhDesktopsLogHook :: X () ewmhDesktopsLogHook = withWindowSet $ \s -> do- -- Bad hack because xmonad forgets the original order of things, it seems- -- see http://code.google.com/p/xmonad/issues/detail?id=53- let ws = sortBy (comparing W.tag) $ W.workspaces s+ sort' <- getSortByTag+ let ws = sort' $ W.workspaces s let wins = W.allWindows s setSupported@@ -62,18 +61,26 @@ setDesktopNames (map W.tag ws) -- Current desktop- fromMaybe (return ()) $ do- n <- W.lookupWorkspace 0 s- i <- elemIndex n $ map W.tag ws- return $ setCurrentDesktop i+ let curr = fromJust $ elemIndex (W.tag (W.workspace (W.current s))) $ map W.tag ws+ + setCurrentDesktop curr setClientList wins -- Per window Desktop- forM (zip ws [(0::Int)..]) $ \(w, wn) ->- forM (W.integrate' (W.stack w)) $ \win -> do+ -- To make gnome-panel accept our xinerama stuff, we display+ -- all visible windows on the current desktop.+ forM_ (W.current s : W.visible s) $ \x -> + forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do+ setWindowDesktop win curr++ forM_ (W.hidden s) $ \w -> + let wn = fromJust $ elemIndex (W.tag w) (map W.tag ws) in+ forM_ (W.integrate' (W.stack w)) $ \win -> do setWindowDesktop win wn + setActiveWindow+ return () @@ -98,7 +105,7 @@ a <- getAtom "_NET_DESKTOP_NAMES" c <- getAtom "UTF8_STRING" let names' = map (fromIntegral.fromEnum) $- concatMap (("Workspace "++) . (++['\0'])) names+ concatMap (++['\0']) names io $ changeProperty8 dpy r a c propModeReplace names' setClientList :: [Window] -> X ()@@ -122,9 +129,23 @@ r <- asks theRoot a <- getAtom "_NET_SUPPORTED" c <- getAtom "ATOM"- supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"]+ supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"+ ,"_NET_NUMBER_OF_DESKTOPS"+ ,"_NET_CLIENT_LIST"+ ,"_NET_CURRENT_DESKTOP"+ ,"_NET_DESKTOP_NAMES"+ ,"_NET_ACTIVE_WINDOW"+ ,"_NET_WM_DESKTOP"+ ,"_NET_WM_STRUT"+ ] io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp) setWMName "xmonad" -+setActiveWindow :: X ()+setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do+ let w = fromMaybe 0 (W.peek s)+ r <- asks theRoot+ a <- getAtom "_NET_ACTIVE_WINDOW"+ c <- getAtom "WINDOW"+ io $ changeProperty32 dpy r a c propModeReplace [fromIntegral w]
XMonad/Hooks/ManageDocks.hs view
@@ -24,7 +24,9 @@ ----------------------------------------------------------------------------- import XMonad import Foreign.C.Types (CLong)-import Data.Maybe (catMaybes)+-- import Data.Maybe (catMaybes, fromMaybe)+import Control.Monad+ -- $usage -- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: --@@ -40,12 +42,15 @@ -- so-called "gap" support. First, you must add it to your list of layouts: -- -- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...)+-- > where tall = Tall 1 (3/100) (1/2) -- -- 'AvoidStruts' also supports toggling the dock gap, add a keybinding similar -- to: ----- > ,((modMask, xK_b ), sendMessage ToggleStruts)+-- > ,((modMask x, xK_b ), sendMessage ToggleStruts) --+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings". -- | -- Detects if the given window is of type DOCK and if so, reveals it, but does@@ -54,30 +59,36 @@ manageDocks = checkDock --> doIgnore -- |--- Checks if a window is a DOCK window+-- Checks if a window is a DOCK or DESKTOP window checkDock :: Query Bool checkDock = ask >>= \w -> liftX $ do a <- getAtom "_NET_WM_WINDOW_TYPE"- d <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"+ dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"+ desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP" mbr <- getProp a w case mbr of- Just [r] -> return (fromIntegral r == d)+ Just [r] -> return $ elem (fromIntegral r) [dock, desk] _ -> return False -- | -- Gets the STRUT config, if present, in xmonad gap order-getStrut :: Window -> X (Maybe (Int, Int, Int, Int))+getStrut :: Window -> X [Strut] getStrut w = do- a <- getAtom "_NET_WM_STRUT"- mbr <- getProp a w- case mbr of- Just [l,r,t,b] -> return (Just (- fromIntegral t,- fromIntegral b,- fromIntegral l,- fromIntegral r))- _ -> return Nothing+ spa <- getAtom "_NET_WM_STRUT_PARTIAL"+ sa <- getAtom "_NET_WM_STRUT"+ msp <- getProp spa w+ case msp of+ Just sp -> return $ parseStrutPartial sp+ Nothing -> fmap (maybe [] parseStrut) $ getProp sa w+ where+ parseStrut xs@[_, _, _, _] = parseStrutPartial . take 12 $ xs ++ cycle [minBound, maxBound]+ parseStrut _ = [] + parseStrutPartial [l, r, t, b, ly1, ly2, ry1, ry2, tx1, tx2, bx1, bx2]+ = filter (\(_, n, _, _) -> n /= 0)+ [(L, l, ly1, ly2), (R, r, ry1, ry2), (T, t, tx1, tx2), (B, b, bx1, bx2)]+ parseStrutPartial _ = []+ -- | -- Helper to read a property getProp :: Atom -> Window -> X (Maybe [CLong])@@ -86,48 +97,28 @@ -- | -- Goes through the list of windows and find the gap so that all STRUT -- settings are satisfied.-calcGap :: X Rectangle+calcGap :: X (Rectangle -> Rectangle) calcGap = withDisplay $ \dpy -> do rootw <- asks theRoot -- We don't keep track of dock like windows, so we find all of them here (_,_,wins) <- io $ queryTree dpy rootw- struts <- catMaybes `fmap` mapM getStrut wins+ struts <- concat `fmap` mapM getStrut wins -- we grab the window attributes of the root window rather than checking -- the width of the screen because xlib caches this info and it tends to -- be incorrect after RAndR wa <- io $ getWindowAttributes dpy rootw- return $ reduceScreen (foldl max4 (0,0,0,0) struts)- $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)---- |--- Piecewise maximum of a 4-tuple of Ints-max4 :: (Int, Int, Int, Int) -> (Int, Int, Int, Int) -> (Int, Int, Int, Int)-max4 (a1,a2,a3,a4) (b1,b2,b3,b4) = (max a1 b1, max a2 b2, max a3 b3, max a4 b4)+ let screen = r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)+ return $ \r -> c2r $ foldr (reduce screen) (r2c r) struts fi :: (Integral a, Num b) => a -> b fi = fromIntegral --- | Given strut values and the screen rectangle, compute a reduced screen--- rectangle.-reduceScreen :: (Int, Int, Int, Int) -> Rectangle -> Rectangle-reduceScreen (t, b, l, r) (Rectangle rx ry rw rh)- = Rectangle (rx + fi l) (ry + fi t) (rw - fi r) (rh - fi b)--r2c :: Rectangle -> (Position, Position, Position, Position)-r2c (Rectangle x y w h) = (x, y, x + fi w, y + fi h)--c2r :: (Position, Position, Position, Position) -> Rectangle-c2r (x1, y1, x2, y2) = Rectangle x1 y1 (fi $ x2 - x1) (fi $ y2 - y1)+r2c :: Rectangle -> RectC+r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w, fi y + fi h) --- | Given a bounding rectangle 's' and another rectangle 'r', compute a--- rectangle 'r' that fits inside 's'.-fitRect :: Rectangle -> Rectangle -> Rectangle-fitRect s r- = c2r (max sx1 rx1, max sy1 ry1, min sx2 rx2, min sy2 ry2)- where- (sx1, sy1, sx2, sy2) = r2c s- (rx1, ry1, rx2, ry2) = r2c r+c2r :: RectC -> Rectangle+c2r (x1, y1, x2, y2) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1) (fi $ y2 - y1) -- | Adjust layout automagically. avoidStruts :: LayoutClass l a => l a -> AvoidStruts l a@@ -140,7 +131,7 @@ instance LayoutClass l a => LayoutClass (AvoidStruts l) a where doLayout (AvoidStruts True lo) r s =- do rect <- fmap (flip fitRect r) calcGap+ do rect <- fmap ($ r) calcGap (wrs,mlo') <- doLayout lo rect s return (wrs, AvoidStruts True `fmap` mlo') doLayout (AvoidStruts False lo) r s = do (wrs,mlo') <- doLayout lo r s@@ -150,3 +141,22 @@ | otherwise = do ml' <- handleMessage l m return (AvoidStruts b `fmap` ml') description (AvoidStruts _ l) = description l++data Side = L | R | T | B++type Strut = (Side, CLong, CLong, CLong)++type RectC = (CLong, CLong, CLong, CLong)++reduce :: RectC -> Strut -> RectC -> RectC+reduce (sx0, sy0, sx1, sy1) (s, n, l, h) (x0, y0, x1, y1) = case s of+ L | p (y0, y1) -> (mx x0 sx0 , y0 , x1 , y1 )+ R | p (y0, y1) -> (x0 , y0 , mn x1 sx1, y1 )+ T | p (x0, x1) -> (x0 , mx y0 sy0, x1 , y1 )+ B | p (x0, x1) -> (x0 , y0 , x1 , mn y1 sy1)+ _ -> (x0 , y0 , x1 , y1 )+ where+ mx a b = max a (b + n)+ mn a b = min a (b - n)+ inRange (a, b) c = c > a && c < b+ p (a, b) = inRange (a, b) l || inRange (a, b) h || inRange (a, b) l || inRange (l, h) b
+ XMonad/Hooks/ManageHelpers.hs view
@@ -0,0 +1,130 @@+-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Hooks.ManageHelpers+-- Copyright : (c) Lukas Mai+-- License : BSD+--+-- Maintainer : Lukas Mai <l.mai@web.de>+-- Stability : unstable+-- Portability : unportable+--+-- This module provides helper functions to be used in @manageHook@. Here's how you+-- might use this:+--+-- > import XMonad.Hooks.ManageHelpers+-- > main =+-- > xmonad defaultConfig{+-- > ...+-- > manageHook = composeOne [+-- > isKDETrayWindow -?> doIgnore,+-- > transience,+-- > resource =? "stalonetray" -?> doIgnore+-- > ],+-- > ...+-- > }++module XMonad.Hooks.ManageHelpers (+ composeOne,+ (-?>), (/=?), (<==?), (</=?), (-->>), (-?>>),+ isKDETrayWindow,+ transientTo,+ maybeToDefinite,+ MaybeManageHook,+ transience,+ transience'+) where++import XMonad+import qualified XMonad.StackSet as W++import Data.Maybe+import Data.Monoid++-- | A ManageHook that may or may not have been executed; the outcome is embedded in the Maybe+type MaybeManageHook = Query (Maybe (Endo WindowSet))+-- | A grouping type, which can hold the outcome of a predicate Query+-- This is analogous to group types in regular expressions+-- TODO create a better API for aggregating multiple Matches logically+data Match a = Match Bool a++-- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as+-- a candidate returns a 'Just' value, effectively running only the first match+-- (whereas 'composeAll' continues and executes all matching rules).+composeOne :: [MaybeManageHook] -> ManageHook+composeOne = foldr try idHook+ where+ try q z = do+ x <- q+ case x of+ Just h -> return h+ Nothing -> z++infixr 0 -?>, -->>, -?>>++-- | q \/=? x. if the result of q equals x, return False+(/=?) :: Eq a => Query a -> a -> Query Bool+q /=? x = fmap (/= x) q++-- | q <==? x. if the result of q equals x, return True grouped with q+(<==?) :: Eq a => Query a -> a -> Query (Match a)+q <==? x = fmap (`eq` x) q+ where eq q' x' = Match (q' == x') q'++-- | q <\/=? x. if the result of q notequals x, return True grouped with q+(</=?) :: Eq a => Query a -> a -> Query (Match a)+q </=? x = fmap (`neq` x) q+ where neq q' x' = Match (q' /= x') q'++-- | A helper operator for use in 'composeOne'. It takes a condition and an action;+-- if the condition fails, it returns 'Nothing' from the 'Query' so 'composeOne' will+-- go on and try the next rule.+(-?>) :: Query Bool -> ManageHook -> MaybeManageHook+p -?> f = do+ x <- p+ if x then fmap Just f else return Nothing++-- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action. If 'p' is true, it executes the resulting action.+(-->>) :: Query (Match a) -> (a -> ManageHook) -> ManageHook+p -->> f = do Match b m <- p+ if b then (f m) else mempty++-- | A helper operator for use in 'composeOne'. It takes a condition and a function taking a groupdatum to action. If 'p' is true, it executes the resulting action. If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule.+(-?>>) :: Query (Match a) -> (a -> ManageHook) -> MaybeManageHook+p -?>> f = do Match b m <- p+ if b then fmap Just (f m) else return Nothing++-- | A predicate to check whether a window is a KDE system tray icon.+isKDETrayWindow :: Query Bool+isKDETrayWindow = ask >>= \w -> liftX $ do+ dpy <- asks display+ kde_tray <- getAtom "_KDE_NET_WM_SYSTEM_TRAY_WINDOW_FOR"+ r <- io $ getWindowProperty32 dpy kde_tray w+ return $ case r of+ Just [_] -> True+ _ -> False++-- | A predicate to check whether a window is Transient.+-- It holds the result which might be the window it is transient to+-- or it might be 'Nothing'.+transientTo :: Query (Maybe Window)+transientTo = do w <- ask+ d <- (liftX . asks) display+ liftIO $ getTransientForHint d w++-- | A convenience 'MaybeManageHook' that will check to see if a window+-- is transient, and then move it to it's parent.+transience :: MaybeManageHook+transience = transientTo </=? Nothing + -?>> move+ where move :: Maybe Window -> ManageHook+ move mw = maybe idHook (doF . move') mw+ where move' :: Window -> (WindowSet -> WindowSet)+ move' w = \s -> maybe s (`W.shift` s) (W.findTag w s)++-- | 'transience' set to a 'ManageHook'+transience' :: ManageHook+transience' = maybeToDefinite transience++-- | converts 'MaybeManageHook's to 'ManageHook's+maybeToDefinite :: MaybeManageHook -> ManageHook+maybeToDefinite = fmap (fromMaybe mempty)
XMonad/Layout/DragPane.hs view
@@ -107,7 +107,7 @@ mirror $ Rectangle x y (w-halfHandleWidth) h right = case right' of Rectangle x y w h ->- mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h+ mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h handr = case left' of Rectangle x y w h -> mirror $ Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h@@ -131,6 +131,6 @@ newDragWin :: Rectangle -> X Window newDragWin r = do let mask = Just $ exposureMask .|. buttonPressMask- w <- createNewWindow r mask handleColor+ w <- createNewWindow r mask handleColor False showWindow w return w
XMonad/Layout/Grid.hs view
@@ -17,7 +17,7 @@ module XMonad.Layout.Grid ( -- * Usage -- $usage- Grid(..)+ Grid(..) ) where import XMonad
XMonad/Layout/LayoutScreens.hs view
@@ -30,14 +30,16 @@ -- screen and long for greater flexibility (e.g. being able to see your -- email window at all times, a crude mimic of sticky windows). ----- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Layout.LayoutScreens+-- > import XMonad.Layout.TwoPane -- -- Then add some keybindings; for example: ----- > , ((modMask .|. shiftMask, xK_space), layoutScreens 2 (TwoPane 0.5 0.5))--- > , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen)+-- > , ((modMask x .|. shiftMask, xK_space), layoutScreens 2 (TwoPane 0.5 0.5))+-- > , ((modMask x .|. controlMask .|. shiftMask, xK_space), rescreen) -- -- Another example use would be to handle a scenario where xrandr didn't -- work properly (e.g. a VNC X server in my case) and you want to be able@@ -45,9 +47,9 @@ -- -- > import XMonad.Layout.LayoutScreens ----- > , ((modMask .|. shiftMask, xK_space),+-- > , ((modMask x .|. shiftMask, xK_space), -- > layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768]))--- > , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen)+-- > , ((modMask x .|. controlMask .|. shiftMask, xK_space), rescreen) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings".
XMonad/Layout/Magnifier.hs view
@@ -22,6 +22,8 @@ -- $usage magnifier, magnifier',+ magnifiercz,+ magnifiercz', MagnifyMsg (..) ) where @@ -34,12 +36,24 @@ -- -- > import XMonad.Layout.Magnifier ----- Then edit your @layoutHook@ by adding the Magnifier layout modifier+-- Then edit your @layoutHook@ by adding the 'magnifier' layout modifier -- to some layout: -- -- > myLayouts = magnifier (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad defaultConfig { layoutHook = myLayouts } --+-- By default magnifier increases the focused window's size by 1.5.+-- You can also use:+--+-- > magnifiercz (12%10)+--+-- to use a custom level of magnification. You can even make the focused+-- window smaller for a pop in effect. Keep in mind, you must+--+-- > import Data.Ratio+--+-- in order to use rationals (such as @12%10@) in your config.+-- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook"@@ -59,10 +73,19 @@ magnifier :: l a -> ModifiedLayout Magnifier l a magnifier = ModifiedLayout (Mag 1.5 On All) +-- | Change the size of the window that has focus by a custom zoom+magnifiercz :: Rational -> l a -> ModifiedLayout Magnifier l a+magnifiercz cz = ModifiedLayout (Mag ((fromRational cz)*1.0::Double) On All)+ -- | Increase the size of the window that has focus, unless if it is the -- master window. magnifier' :: l a -> ModifiedLayout Magnifier l a magnifier' = ModifiedLayout (Mag 1.5 On NoMaster)++-- | Increase the size of the window that has focus by a custom zoom,+-- unless if it is the master window.+magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a+magnifiercz' cz = ModifiedLayout (Mag ((fromRational cz)*1.0::Double) On NoMaster) data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff deriving ( Typeable ) instance Message MagnifyMsg
XMonad/Layout/MultiToggle.hs view
@@ -23,6 +23,7 @@ Toggle(..), (??), EOT(..),+ single, mkToggle ) where @@ -39,7 +40,7 @@ -- group of radio buttons. -- -- A side effect of this meta-layout is that layout transformers no longer--- receive any messages; any message not handled by SwitchTrans itself will+-- receive any messages; any message not handled by MultiToggle itself will -- undo the current layout transformer, pass the message on to the base -- layout, then reapply the transformer. --@@ -63,7 +64,7 @@ -- -- After changing this to ----- > layout = mkToggle (MIRROR ?? EOT) (tiled ||| Full)+-- > layout = mkToggle (single MIRROR) (tiled ||| Full) -- -- you can now dynamically apply the 'XMonad.Layout.Mirror' transformation: --@@ -81,7 +82,7 @@ -- > data NOBORDERS = NOBORDERS deriving (Read, Show, Eq, Typeable) -- > instance Transformer NOBORDERS Window where -- > transform _ x k = k (noBorders x)--- > +-- > -- > data FULL = FULL deriving (Read, Show, Eq, Typeable) -- > instance Transformer FULL Window where -- > transform _ x k = k Full@@ -90,7 +91,7 @@ -- layout = id -- . 'XMonad.Layout.NoBorders.smartBorders' -- . mkToggle (NOBORDERS ?? FULL ?? EOT)--- . mkToggle (MIRROR ?? EOT)+-- . mkToggle (single MIRROR) -- $ tiled ||| 'XMonad.Layout.Grid.Grid' ||| 'XMonad.Layout.Circle.Circle' -- @ --@@ -164,6 +165,10 @@ (??) :: (HList b w) => a -> b -> HCons a b (??) = HCons +-- | Construct a singleton transformer table.+single :: a -> HCons a EOT+single = (?? EOT)+ class HList c a where find :: (Transformer t a) => c -> t -> Maybe Int resolve :: c -> Int -> b -> (forall t. (Transformer t a) => t -> b) -> b@@ -189,7 +194,7 @@ acceptChange mt f = fmap (f (\x -> mt{ currLayout = EL x })) instance (Typeable a, Show ts, HList ts a, LayoutClass l a) => LayoutClass (MultiToggle ts l) a where- description _ = "MultiToggle"+ description mt = currLayout mt `unEL` \l -> description l pureLayout mt r s = currLayout mt `unEL` \l -> pureLayout l r s
XMonad/Layout/PerWorkspace.hs view
@@ -12,6 +12,13 @@ -- -- Configure layouts on a per-workspace basis. NOTE that this module -- does not (yet) work in conjunction with multiple screens! =(+--+-- Note also that when using PerWorkspace, on initial startup workspaces+-- may not respond to messages properly until a window has been opened.+-- This is due to a limitation inherent in the way PerWorkspace is+-- implemented: it cannot decide which layout to use until actually+-- required to lay out some windows (which does not happen until a window+-- is opened). ----------------------------------------------------------------------------- module XMonad.Layout.PerWorkspace (
+ XMonad/Layout/Reflect.hs view
@@ -0,0 +1,119 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-- for now, use -fglasgow-exts for compatibility with ghc 6.6, which chokes+-- on some of the LANGUAGE pragmas below+{- LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances -}++-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Layout.Reflect+-- Copyright : (c) Brent Yorgey+-- License : BSD-style (see LICENSE)+--+-- Maintainer : <byorgey@gmail.com>+-- Stability : unstable+-- Portability : unportable+--+-- Reflect a layout horizontally or vertically.+-----------------------------------------------------------------------------++module XMonad.Layout.Reflect (+ -- * Usage+ -- $usage++ reflectHoriz, reflectVert,+ REFLECTX(..), REFLECTY(..)++ ) where++import XMonad.Core+import Graphics.X11 (Rectangle(..), Window)+import Control.Arrow ((***), second)+import Control.Applicative ((<$>))++import XMonad.Layout.MultiToggle++-- $usage+-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Layout.Reflect+--+-- and modifying your layoutHook as follows (for example):+--+-- > layoutHook = reflectHoriz $ Tall 1 (3/100) (1/2) -- put master pane on the right+--+-- 'reflectHoriz' and 'reflectVert' can be applied to any sort of+-- layout (including Mirrored layouts) and will simply flip the+-- physical layout of the windows vertically or horizontally.+--+-- "XMonad.Layout.MultiToggle" transformers are also provided for+-- toggling layouts between reflected\/non-reflected with a keybinding.+-- To use this feature, you will also need to import the MultiToggle+-- module:+--+-- > import XMonad.Layout.MultiToggle+--+-- Next, add one or more toggles to your layout. For example, to allow+-- separate toggling of both vertical and horizontal reflection:+--+-- > layoutHook = mkToggle (REFLECTX ?? EOT) $+-- > mkToggle (REFLECTY ?? EOT) $+-- > (tiled ||| Mirror tiled ||| ...) -- whatever layouts you use+--+-- Finally, add some keybindings to do the toggling, for example:+--+-- > , ((modMask x .|. controlMask, xK_x), sendMessage $ Toggle REFLECTX)+-- > , ((modMask x .|. controlMask, xK_y), sendMessage $ Toggle REFLECTY)+--++-- | Apply a horizontal reflection (left \<--\> right) to a+-- layout.+reflectHoriz :: (LayoutClass l a) => (l a) -> Reflect l a+reflectHoriz = Reflect Horiz++-- | Apply a vertical reflection (top \<--\> bottom) to a+-- layout.+reflectVert :: (LayoutClass l a) => (l a) -> Reflect l a+reflectVert = Reflect Vert++data ReflectDir = Horiz | Vert+ deriving (Read, Show)++-- | Given an axis of reflection and the enclosing rectangle which+-- contains all the laid out windows, transform a rectangle+-- representing a window into its flipped counterpart.+reflectRect :: ReflectDir -> Rectangle -> Rectangle -> Rectangle+reflectRect Horiz (Rectangle sx _ sw _) (Rectangle rx ry rw rh) =+ Rectangle (2*sx + fi sw - rx - fi rw) ry rw rh+reflectRect Vert (Rectangle _ sy _ sh) (Rectangle rx ry rw rh) =+ Rectangle rx (2*sy + fi sh - ry - fi rh) rw rh++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral+++data Reflect l a = Reflect ReflectDir (l a) deriving (Show, Read)++instance LayoutClass l a => LayoutClass (Reflect l) a where++ -- do layout l, then reflect all the generated Rectangles.+ doLayout (Reflect d l) r s = (map (second (reflectRect d r)) *** fmap (Reflect d))+ <$> doLayout l r s++ -- pass messages on to the underlying layout+ handleMessage (Reflect d l) = fmap (fmap (Reflect d)) . handleMessage l++ description (Reflect d l) = "Reflect" ++ xy ++ " " ++ description l+ where xy = case d of { Horiz -> "X" ; Vert -> "Y" }+++-------- instances for MultiToggle ------------------++data REFLECTX = REFLECTX deriving (Read, Show, Eq, Typeable)+data REFLECTY = REFLECTY deriving (Read, Show, Eq, Typeable)++instance Transformer REFLECTX Window where+ transform REFLECTX x k = k (reflectHoriz x)++instance Transformer REFLECTY Window where+ transform REFLECTY x k = k (reflectVert x)
XMonad/Layout/ResizableTile.hs view
@@ -24,6 +24,8 @@ import XMonad hiding (splitVertically, splitHorizontallyBy) import qualified XMonad.StackSet as W import Control.Monad+import qualified Data.Map as M+import Data.List ((\\)) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:@@ -58,12 +60,16 @@ ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate handleMessage (ResizableTall nmaster delta frac mfrac) m = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset- case ms of- Nothing -> return Nothing- Just s -> return $ msum [fmap resize (fromMessage m)- ,fmap (\x -> mresize x s) (fromMessage m)- ,fmap incmastern (fromMessage m)]- where resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac+ fs <- (M.keys . W.floating) `fmap` gets windowset+ return $ ms >>= unfloat fs >>= handleMesg+ where handleMesg s = msum [fmap resize (fromMessage m)+ ,fmap (\x -> mresize x s) (fromMessage m)+ ,fmap incmastern (fromMessage m)]+ unfloat fs s = if W.focus s `elem` fs+ then Nothing+ else Just (s { W.up = (W.up s) \\ fs+ , W.down = (W.down s) \\ fs })+ resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac resize Expand = ResizableTall nmaster delta (min 1 $ frac+delta) mfrac mresize MirrorShrink s = mresize' s delta mresize MirrorExpand s = mresize' s (0-delta)
+ XMonad/Layout/ShowWName.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE PatternGuards, TypeSynonymInstances, MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Layout.ShowWName+-- Copyright : (c) Andrea Rossato 2007+-- License : BSD-style (see xmonad/LICENSE)+--+-- Maintainer : andrea.rossato@unibz.it+-- Stability : unstable+-- Portability : unportable+--+-- This is a layout modifier that will show the workspace name+-----------------------------------------------------------------------------++module XMonad.Layout.ShowWName+ ( -- * Usage+ -- $usage+ showWName+ , showWName'+ , defaultSWNConfig+ , SWNConfig(..)+ ) where++import XMonad+import qualified XMonad.StackSet as S+import XMonad.Layout.LayoutModifier+import XMonad.Util.Font+import XMonad.Util.Timer+import XMonad.Util.XUtils++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.ShowWName+-- > myLayout = layoutHook defaultConfig+-- > main = xmonad defaultConfig { layoutHook = showWName myLayout }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++-- | A layout modifier to show the workspace name when switching+showWName :: l a -> ModifiedLayout ShowWName l a+showWName = ModifiedLayout (SWN True defaultSWNConfig Nothing)++-- | A layout modifier to show the workspace name when switching. It+-- is possible to provide a costum configuration.+showWName' :: SWNConfig -> l a -> ModifiedLayout ShowWName l a+showWName' c = ModifiedLayout (SWN True c Nothing)++type ShowWNState = Maybe (TimerId, Window)+data ShowWName a = SWN Bool SWNConfig ShowWNState deriving (Read, Show)++data SWNConfig =+ SWNC { swn_font :: String -- ^ Font name+ , swn_bgcolor :: String -- ^ Backgorund color+ , swn_color :: String -- ^ String color+ , swn_fade :: Rational -- ^ Time in seconds of the name visibility+ } deriving (Read, Show)++defaultSWNConfig :: SWNConfig+defaultSWNConfig =+ SWNC { swn_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"+ , swn_bgcolor = "black"+ , swn_color = "white"+ , swn_fade = 1+ }++instance LayoutModifier ShowWName Window where+ redoLayout (SWN True c (Just (_,w))) r _ wrs = deleteWindow w >> flashName c r wrs+ redoLayout (SWN True c Nothing ) r _ wrs = flashName c r wrs+ redoLayout (SWN False _ _ ) _ _ wrs = return (wrs, Nothing)++ handleMess (SWN _ c (Just (i,w))) m+ | Just e <- fromMessage m = handleTimer i e (deleteWindow w >> return Nothing)+ | Just Hide <- fromMessage m = do deleteWindow w+ return . Just $ SWN True c Nothing++ handleMess (SWN _ c s) m+ | Just Hide <- fromMessage m = return . Just $ SWN True c s+ | otherwise = return Nothing++flashName :: SWNConfig -> Rectangle -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a))+flashName c (Rectangle _ _ wh ht) wrs = do+ d <- asks display+ n <- withWindowSet (return . S.tag . S.workspace . S.current)+ f <- initXMF (swn_font c)+ width <- textWidthXMF d f n+ (_,as,ds,_) <- textExtentsXMF f n+ let hight = as + ds+ y = (fi ht - hight + 2) `div` 2+ x = (fi wh - width + 2) `div` 2+ w <- createNewWindow (Rectangle (fi x) (fi y) (fi width) (fi hight)) Nothing "" True+ showWindow w+ paintAndWrite w f (fi width) (fi hight) 0 "" "" (swn_color c) (swn_bgcolor c) AlignCenter n+ releaseXMF f+ io $ sync d False+ i <- startTimer (swn_fade c)+ return (wrs, Just $ SWN False c $ Just (i,w))++-- | Short-hand for 'fromIntegral'+fi :: (Integral a, Num b) => a -> b+fi = fromIntegral
XMonad/Layout/Tabbed.hs view
@@ -33,6 +33,8 @@ import XMonad.Util.XUtils import XMonad.Util.Font +import XMonad.Hooks.UrgencyHook+ -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --@@ -62,10 +64,13 @@ data TConf = TConf { activeColor :: String , inactiveColor :: String+ , urgentColor :: String , activeBorderColor :: String- , inactiveTextColor :: String , inactiveBorderColor :: String+ , urgentBorderColor :: String , activeTextColor :: String+ , inactiveTextColor :: String+ , urgentTextColor :: String , fontName :: String , tabSize :: Int } deriving (Show, Read)@@ -74,10 +79,13 @@ defaultTConf = TConf { activeColor = "#999999" , inactiveColor = "#666666"+ , urgentColor = "#FFFF00" , activeBorderColor = "#FFFFFF" , inactiveBorderColor = "#BBBBBB"+ , urgentBorderColor = "##00FF00" , activeTextColor = "#FFFFFF" , inactiveTextColor = "#BFBFBF"+ , urgentTextColor = "#FF0000" , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" , tabSize = 20 }@@ -86,7 +94,7 @@ TabState { tabsWindows :: [(Window,Window)] , scr :: Rectangle , font :: XMonadFont- }+ } data Tabbed s a = Tabbed (Invisible Maybe TabState) s TConf@@ -128,8 +136,8 @@ handleEvent :: Shrinker s => s -> TConf -> TabState -> Event -> X () -- button press-handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs})- (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t})+handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs})+ (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t }) | t == buttonPress, tl <- map fst tws, thisw `elem` tl || thisbw `elem` tl = do case lookup thisw tws of Just x -> do focus x@@ -174,7 +182,7 @@ height = fromIntegral $ tabSize c mask = Just (exposureMask .|. buttonPressMask) d <- asks display- w <- createNewWindow (Rectangle x y wid height) mask (inactiveColor c)+ w <- createNewWindow (Rectangle x y wid height) mask (inactiveColor c) True io $ restackWindows d $ w : [ow] ws <- createTabs c (Rectangle (x + fromIntegral wid) y (wh - wid) ht) ows return (w:ws)@@ -182,18 +190,22 @@ updateTab :: Shrinker s => s -> TConf -> XMonadFont -> Dimension -> (Window,Window) -> X () updateTab ishr c fs wh (tabw,ow) = do nw <- getName ow+ ur <- readUrgents let ht = fromIntegral $ tabSize c :: Dimension- focusColor win ic ac = (maybe ic (\focusw -> if focusw == win- then ac else ic) . W.peek)- `fmap` gets windowset+ focusColor win ic ac uc = (maybe ic (\focusw -> case () of+ _ | focusw == win -> ac+ | win `elem` ur -> uc+ | otherwise -> ic) . W.peek)+ `fmap` gets windowset (bc',borderc',tc') <- focusColor ow (inactiveColor c, inactiveBorderColor c, inactiveTextColor c) (activeColor c, activeBorderColor c, activeTextColor c)+ (urgentColor c, urgentBorderColor c, urgentTextColor c) dpy <- asks display let s = shrinkIt ishr name <- shrinkWhile s (\n -> do- size <- io $ textWidthXMF dpy fs n- return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)+ size <- io $ textWidthXMF dpy fs n+ return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw) paintAndWrite tabw fs wh ht 1 bc' borderc' tc' bc' AlignCenter name shrink :: TConf -> Rectangle -> Rectangle@@ -205,10 +217,10 @@ where sw [n] = return n sw [] = return "" sw (n:ns) = do- cond <- p n- if cond- then sw ns- else return n+ cond <- p n+ if cond+ then sw ns+ else return n data CustomShrink = CustomShrink instance Show CustomShrink where show _ = ""
XMonad/Prompt.hs view
@@ -96,6 +96,7 @@ , position :: XPPosition -- ^ Position: 'Top' or 'Bottom' , height :: Dimension -- ^ Window height , historySize :: Int -- ^ The number of history entries to be saved+ , defaultText :: String -- ^ The text by default in the prompt line } deriving (Show, Read) data XPType = forall p . XPrompt p => XPT p@@ -135,6 +136,7 @@ , position = Bottom , height = 18 , historySize = 256+ , defaultText = [] } type ComplFunction = String -> IO [String]@@ -142,7 +144,21 @@ initState :: XPrompt p => Display -> Window -> Window -> Rectangle -> ComplFunction -> GC -> XMonadFont -> p -> [History] -> XPConfig -> XPState initState d rw w s compl gc fonts pt h c =- XPS d rw w s Nothing Nothing compl gc fonts (XPT pt) "" 0 h c+ XPS { dpy = d+ , rootw = rw+ , win = w+ , screen = s+ , complWin = Nothing+ , complWinDim = Nothing+ , completionFunction = compl+ , gcon = gc+ , fontS = fonts+ , xptype = XPT pt+ , command = defaultText c+ , offset = length (defaultText c)+ , history = h+ , config = c+ } -- | Same as 'mkXPrompt', except that the action function can have -- type @String -> X a@, for any @a@, and the final action returned@@ -281,6 +297,8 @@ | ks == xK_a -> startOfLine >> go | ks == xK_e -> endOfLine >> go | ks == xK_y -> pasteString >> go+ | ks == xK_Right -> moveWord Next >> go+ | ks == xK_Left -> moveWord Prev >> go | ks == xK_Delete -> killWord Next >> go | ks == xK_BackSpace -> killWord Prev >> go | ks == xK_g || ks == xK_c -> quit@@ -380,6 +398,21 @@ modify $ \s -> s { offset = o (offset s) (command s)} where o oo c = if d == Prev then max 0 (oo - 1) else min (length c) (oo + 1) +-- | move the cursor one word+moveWord :: Direction -> XP ()+moveWord d = do+ c <- gets command+ o <- gets offset+ let (f,ss) = splitAt o c+ lenToS = length . fst . break isSpace+ ln p s = case p s of+ ' ':x -> 1 + lenToS x+ x -> lenToS x+ newoff = case d of+ Prev -> o - (ln reverse f )+ _ -> o + (ln id ss)+ modify $ \s -> s { offset = newoff }+ moveHistory :: Direction -> XP () moveHistory d = do h <- getHistory@@ -454,7 +487,7 @@ ht = height c fsl <- io $ textWidthXMF (dpy st) fs f psl <- io $ textWidthXMF (dpy st) fs p- (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) fs str+ (_,asc,desc,_) <- io $ textExtentsXMF fs str let y = fi $ ((ht - fi (asc + desc)) `div` 2) + fi asc x = (asc + desc) `div` 2 @@ -521,7 +554,7 @@ (x,y) = case position c of Top -> (0,ht) Bottom -> (0, (0 + rem_height - actual_height))- (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) fs $ head compl+ (_,asc,desc,_) <- io $ textExtentsXMF fs $ head compl let yp = fi $ (ht + fi (asc - desc)) `div` 2 xp = (asc + desc) `div` 2 yy = map fi . take (fi actual_rows) $ [yp,(yp + ht)..]@@ -613,7 +646,7 @@ readHistory :: IO ([History],Handle) readHistory = do home <- getEnv "HOME"- let path = home ++ "/.xmonad_history"+ let path = home ++ "/.xmonad/history" f <- fileExist path if f then do h <- openFile path ReadMode str <- hGetContents h@@ -627,7 +660,7 @@ writeHistory :: [History] -> IO () writeHistory hist = do home <- getEnv "HOME"- let path = home ++ "/.xmonad_history"+ let path = home ++ "/.xmonad/history" catch (writeFile path (show hist)) (\_ -> do putStrLn "error in writing"; return ()) -- $xutils
XMonad/Prompt/Man.hs view
@@ -13,8 +13,6 @@ -- -- * narrow completions by section number, if the one is specified -- (like @\/etc\/bash_completion@ does)------ * write QuickCheck properties ----------------------------------------------------------------------------- module XMonad.Prompt.Man (@@ -58,33 +56,36 @@ -- | Query for manual page to be displayed. manPrompt :: XPConfig -> X ()-manPrompt c = mkXPrompt Man c manCompl $ runInTerm . (++) "man "+manPrompt c = do+ mans <- io getMans+ mkXPrompt Man c (manCompl mans) $ runInTerm . (++) "man " -manCompl :: String -> IO [String]-manCompl str | '/' `elem` str = do- -- XXX It may be better to use readline instead of bash's compgen...- lines `fmap` getCommandOutput ("bash -c 'compgen -A file " ++ str ++ "'")- | otherwise = do- mp <- getCommandOutput "manpath -g 2>/dev/null" `E.catch` \_ -> return []+getMans :: IO [String]+getMans = do+ paths <- getCommandOutput "manpath -g 2>/dev/null" `E.catch` \_ -> return [] let sects = ["man" ++ show n | n <- [1..9 :: Int]]- dirs = [d ++ "/" ++ s | d <- split ':' mp, s <- sects]- stripExt = reverse . drop 1 . dropWhile (/= '.') . reverse+ dirs = [d ++ "/" ++ s | d <- split ':' paths, s <- sects] mans <- forM dirs $ \d -> do exists <- doesDirectoryExist d if exists then map (stripExt . stripSuffixes [".gz", ".bz2"]) `fmap` getDirectoryContents d else return []- mkComplFunFromList (uniqSort $ concat mans) str+ return $ uniqSort $ concat mans +manCompl :: [String] -> String -> IO [String]+manCompl mans s | s == "" || last s == ' ' = return []+ | otherwise = do+ -- XXX readline instead of bash's compgen?+ f <- lines `fmap` getCommandOutput ("bash -c 'compgen -A file " ++ s ++ "'")+ mkComplFunFromList (f ++ mans) s+ -- | Run a command using shell and return its output. ----- XXX merge with 'XMonad.Util.Run.runProcessWithInput'?------ * update documentation of the latter (there is no 'Maybe' in result)+-- XXX Merge into 'XMonad.Util.Run'? ----- * ask \"gurus\" whether @evaluate (length ...)@ approach is--- better\/more idiomatic+-- (Ask \"gurus\" whether @evaluate (length ...)@ approach is+-- better\/more idiomatic.) getCommandOutput :: String -> IO String getCommandOutput s = do (pin, pout, perr, ph) <- runInteractiveCommand s@@ -94,6 +95,9 @@ hClose perr waitForProcess ph return output++stripExt :: String -> String+stripExt = reverse . drop 1 . dropWhile (/= '.') . reverse stripSuffixes :: Eq a => [[a]] -> [a] -> [a] stripSuffixes sufs fn =
XMonad/Prompt/Shell.hs view
@@ -89,20 +89,12 @@ getCommands = do p <- getEnv "PATH" `catch` const (return []) let ds = split ':' p- fp d f = d ++ "/" ++ f es <- forM ds $ \d -> do exists <- doesDirectoryExist d if exists- then getDirectoryContents d >>= filterM (isExecutable . fp d)+ then getDirectoryContents d else return []- return . uniqSort . concat $ es--isExecutable :: FilePath ->IO Bool-isExecutable f = do- fe <- doesFileExist f- if fe- then fmap executable $ getPermissions f- else return False+ return . uniqSort . filter ((/= '.') . head) . concat $ es split :: Eq a => a -> [a] -> [[a]] split _ [] = []
XMonad/Util/Dzen.hs view
@@ -12,8 +12,12 @@ -- ----------------------------------------------------------------------------- -module XMonad.Util.Dzen (dzen, dzenWithArgs, dzenScreen,- seconds) where+module XMonad.Util.Dzen (+ dzen,+ dzenWithArgs,+ dzenScreen,+ seconds+ ) where import XMonad import XMonad.Util.Run (runProcessWithInputAndWait, seconds)
XMonad/Util/Font.cpphs view
@@ -102,10 +102,10 @@ return $ xglyphinfo_width gi #endif -textExtentsXMF :: MonadIO m => Display -> XMonadFont -> String -> m (FontDirection,Int32,Int32,CharStruct)-textExtentsXMF _ (Core fs) s = return $ textExtents fs s+textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (FontDirection,Int32,Int32,CharStruct)+textExtentsXMF (Core fs) s = return $ textExtents fs s #ifdef XFT-textExtentsXMF _ (Xft xftfont) _ = liftIO $ do+textExtentsXMF (Xft xftfont) _ = liftIO $ do ascent <- xftfont_ascent xftfont descent <- xftfont_descent xftfont return (error "Font direction touched", fi ascent, fi descent, error "Font overall size touched")@@ -120,7 +120,7 @@ stringPosition fs (Rectangle _ _ w h) al s = do dpy <- asks display width <- io $ textWidthXMF dpy fs s- (_,a,d,_) <- io $ textExtentsXMF dpy fs s+ (_,a,d,_) <- io $ textExtentsXMF fs s let y = fi $ ((h - fi (a + d)) `div` 2) + fi a; x = case al of AlignCenter -> fi (w `div` 2) - fi (width `div` 2)
XMonad/Util/Run.hs view
@@ -29,11 +29,9 @@ ) where import System.Posix.IO-import System.Posix.Process (createSession, forkProcess, executeFile,- getProcessStatus)+import System.Posix.Process (executeFile) import Control.Concurrent (threadDelay) import Control.Exception (try)-import System.Exit (ExitCode(ExitSuccess), exitWith) import System.IO import System.Process (runInteractiveProcess, waitForProcess) import XMonad@@ -50,7 +48,7 @@ -- For an example usage of 'runProcessWithInputAndWait' see -- "XMonad.Util.Dzen" --- | Returns Just output if the command succeeded, and Nothing if it didn't.+-- | Return output if the command succeeded, otherwise return @()@. -- This corresponds to dmenu's notion of exit code 1 for a cancelled invocation. runProcessWithInput :: FilePath -> [String] -> String -> IO String runProcessWithInput cmd args input = do@@ -67,22 +65,16 @@ -- | Wait is in us runProcessWithInputAndWait :: FilePath -> [String] -> String -> Int -> IO () runProcessWithInputAndWait cmd args input timeout = do- pid <- forkProcess $ do- forkProcess $ do -- double fork it over to init- createSession- (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing- hPutStr pin input- hFlush pin- threadDelay timeout- hClose pin- hClose pout- hClose perr- waitForProcess ph- return ()- exitWith ExitSuccess- return ()- getProcessStatus True False pid- return ()+ doubleFork $ do+ (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing+ hPutStr pin input+ hFlush pin+ threadDelay timeout+ hClose pin+ hClose pout+ hClose perr+ waitForProcess ph+ return () -- | Multiplies by ONE MILLION, for use with -- 'runProcessWithInputAndWait'.@@ -104,16 +96,16 @@ -- unsafeSpawn is an alias for XMonad's 'spawn', to remind one that use -- of it can be, well, unsafe. -- Examples:--- +-- -- > , ((modMask, xK_Print), unsafeSpawn "import -window root png:$HOME/xwd-$(date +%s)$$.png") -- > , ((modMask, xK_d ), safeSpawn "firefox" "")--- +-- -- Note that the unsafeSpawn example must be unsafe and not safe because -- it makes use of shell interpretation by relying on @$HOME@ and -- interpolation, whereas the safeSpawn example can be safe because -- Firefox doesn't need any arguments if it is just being started. safeSpawn :: MonadIO m => FilePath -> String -> m ()-safeSpawn prog arg = liftIO (try (forkProcess $ executeFile prog True [arg] Nothing) >> return ())+safeSpawn prog arg = liftIO (try (doubleFork $ executeFile prog True [arg] Nothing) >> return ()) unsafeSpawn :: MonadIO m => String -> m () unsafeSpawn = spawn@@ -134,11 +126,7 @@ setFdOption wr CloseOnExec True h <- fdToHandle wr hSetBuffering h LineBuffering- pid <- forkProcess $ do- forkProcess $ do- dupTo rd stdInput- createSession- executeFile "/bin/sh" False ["-c", x] Nothing- exitWith ExitSuccess- getProcessStatus True False pid+ doubleFork $ do+ dupTo rd stdInput+ executeFile "/bin/sh" False ["-c", x] Nothing return h
+ XMonad/Util/Timer.hs view
@@ -0,0 +1,59 @@+-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Util.Timer+-- Copyright : (c) Andrea Rossato and David Roundy 2007+-- License : BSD-style (see xmonad/LICENSE)+--+-- Maintainer : andrea.rossato@unibz.it+-- Stability : unstable+-- Portability : unportable+--+-- A module for setting up timers+-----------------------------------------------------------------------------++module XMonad.Util.Timer+ ( -- * Usage+ -- $usage+ startTimer+ , handleTimer+ , TimerId+ ) where++import XMonad+import Control.Applicative+import Control.Concurrent+import Data.Unique++-- $usage+-- This module can be used to setup a timer to handle deferred events.+-- See 'XMonad.Layout.ShowWName' for an usage example.++type TimerId = Int++-- | Start a timer, which will send a ClientMessageEvent after some+-- time (in seconds).+startTimer :: Rational -> X TimerId+startTimer s = io $ do+ u <- hashUnique <$> newUnique+ doubleFork $ do+ d <- openDisplay ""+ rw <- rootWindow d $ defaultScreen d+ threadDelay (fromEnum $ s * 1000000)+ a <- internAtom d "XMONAD_TIMER" False+ allocaXEvent $ \e -> do+ setEventType e clientMessage+ setClientMessageEvent e rw a 32 (fromIntegral u) currentTime+ sendEvent d rw False structureNotifyMask e+ sync d False+ return u++-- | Given a 'TimerId' and an 'Event', run an action when the 'Event'+-- has been sent by the timer specified by the 'TimerId'+handleTimer :: TimerId -> Event -> X (Maybe a) -> X (Maybe a)+handleTimer ti (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) action = do+ d <- asks display+ a <- io $ internAtom d "XMONAD_TIMER" False+ if mt == a && dt /= [] && fromIntegral (head dt) == ti+ then action+ else return Nothing+handleTimer _ _ _ = return Nothing
+ XMonad/Util/WorkspaceCompare.hs view
@@ -0,0 +1,41 @@+-----------------------------------------------------------------------------+-- |+-- Module : XMonad.Util.WorkspaceCompare+-- Copyright : (c) Spencer Janssen <sjanssen@cse.unl.edu>+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Spencer Janssen <sjanssen@cse.unl.edu>+-- Stability : unstable+-- Portability : unportable+--++module XMonad.Util.WorkspaceCompare ( getWsIndex, getWsCompare, getSortByTag ) where++import XMonad+import qualified XMonad.StackSet as S+import Data.List+import Data.Monoid++-- | Lookup the index of a workspace id in the user's config, return Nothing+-- if that workspace does not exist in the config.+getWsIndex :: X (WorkspaceId -> Maybe Int)+getWsIndex = do+ spaces <- asks (workspaces . config)+ return $ flip elemIndex spaces++-- | A comparison function for WorkspaceId+getWsCompare :: X (WorkspaceId -> WorkspaceId -> Ordering)+getWsCompare = do+ wsIndex <- getWsIndex+ return $ \a b -> f (wsIndex a) (wsIndex b) `mappend` compare a b+ where+ f Nothing Nothing = EQ+ f (Just _) Nothing = LT+ f Nothing (Just _) = GT+ f (Just x) (Just y) = compare x y++-- | Sort several workspaces according to the order in getWsCompare+getSortByTag :: X ([WindowSpace] -> [WindowSpace])+getSortByTag = do+ cmp <- getWsCompare+ return $ sortBy (\a b -> cmp (S.tag a) (S.tag b))
XMonad/Util/XSelection.hs view
@@ -57,8 +57,8 @@ -- | Returns a String corresponding to the current mouse selection in X; if there is none, an empty string is returned. Note that this is -- really only reliable for ASCII text and currently escapes or otherwise mangles more complex UTF-8 characters.-getSelection :: IO String-getSelection = do+getSelection :: MonadIO m => m String+getSelection = io $ do dpy <- openDisplay "" let dflt = defaultScreen dpy rootw <- rootWindow dpy dflt@@ -80,8 +80,8 @@ else destroyWindow dpy win >> return "" -- | Set the current X Selection to a given String.-putSelection :: String -> IO ()-putSelection text = do+putSelection :: MonadIO m => String -> m ()+putSelection text = io $ do dpy <- openDisplay "" let dflt = defaultScreen dpy rootw <- rootWindow dpy dflt
XMonad/Util/XUtils.hs view
@@ -3,7 +3,7 @@ -- Module : XMonad.Util.XUtils -- Copyright : (c) 2007 Andrea Rossato -- License : BSD-style (see xmonad/LICENSE)--- +-- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable@@ -12,7 +12,7 @@ -- ----------------------------------------------------------------------------- -module XMonad.Util.XUtils ( +module XMonad.Util.XUtils ( -- * Usage: -- $usage averagePixels@@ -22,7 +22,7 @@ , deleteWindow , paintWindow , paintAndWrite- , stringToPixel+ , stringToPixel ) where @@ -44,15 +44,16 @@ let mn x1 x2 = round (fromIntegral x1 * f + fromIntegral x2 * (1-f)) Color p _ _ _ _ <- io $ allocColor d cm (Color 0 (mn r1 r2) (mn g1 g2) (mn b1 b2) 0) return p+ -- | Create a simple window given a rectangle. If Nothing is given -- only the exposureMask will be set, otherwise the Just value. -- Use 'showWindow' to map and hideWindow to unmap.-createNewWindow :: Rectangle -> Maybe EventMask -> String -> X Window-createNewWindow (Rectangle x y w h) m col = do+createNewWindow :: Rectangle -> Maybe EventMask -> String -> Bool -> X Window+createNewWindow (Rectangle x y w h) m col o = do d <- asks display rw <- asks theRoot- c <- stringToPixel d col- win <- io $ createSimpleWindow d rw x y w h 0 c c+ c <- stringToPixel d col+ win <- io $ mkWindow d (defaultScreenOfDisplay d) rw x y w h c o case m of Just em -> io $ selectInput d win em Nothing -> io $ selectInput d win exposureMask@@ -77,9 +78,9 @@ io $ destroyWindow d w -- | Fill a window with a rectangle and a border-paintWindow :: Window -- ^ The window where to draw +paintWindow :: Window -- ^ The window where to draw -> Dimension -- ^ Window width- -> Dimension -- ^ Window height + -> Dimension -- ^ Window height -> Dimension -- ^ Border width -> String -- ^ Window background color -> String -- ^ Border color@@ -88,10 +89,10 @@ paintWindow' w (Rectangle 0 0 wh ht) bw c bc Nothing -- | Fill a window with a rectangle and a border, and write a string at given position-paintAndWrite :: Window -- ^ The window where to draw +paintAndWrite :: Window -- ^ The window where to draw -> XMonadFont -- ^ XMonad Font for drawing -> Dimension -- ^ Window width- -> Dimension -- ^ Window height + -> Dimension -- ^ Window height -> Dimension -- ^ Border width -> String -- ^ Window background color -> String -- ^ Border color@@ -129,6 +130,21 @@ -- free the pixmap and GC io $ freePixmap d p io $ freeGC d gc++-- | Creates a window with the possibility of setting some attributes.+-- Not exported.+mkWindow :: Display -> Screen -> Window -> Position+ -> Position -> Dimension -> Dimension -> Pixel -> Bool -> IO Window+mkWindow d s rw x y w h p o = do+ let visual = defaultVisualOfScreen s+ attrmask = cWOverrideRedirect .|. cWBackPixel .|. cWBorderPixel+ allocaSetWindowAttributes $+ \attributes -> do+ set_override_redirect attributes o+ set_border_pixel attributes p+ set_background_pixel attributes p+ createWindow d rw x y w h 0 (defaultDepthOfScreen s)+ inputOutput visual attrmask attributes -- | Short-hand for 'fromIntegral' fi :: (Integral a, Num b) => a -> b
xmonad-contrib.cabal view
@@ -1,5 +1,5 @@ name: xmonad-contrib-version: 0.5+version: 0.6 homepage: http://xmonad.org/ synopsis: Third party extensions for xmonad description:@@ -33,6 +33,10 @@ flag use_xft description: Use Xft to render text +flag testing+ description: Testing mode+ default: False+ library if flag(small_base) build-depends: base >= 3, containers, directory, process, random@@ -43,8 +47,12 @@ build-depends: X11-xft >= 0.2 cpp-options: -DXFT - build-depends: mtl, unix, X11>=1.4.0, xmonad==0.5- ghc-options: -Wall -Werror+ build-depends: mtl, unix, X11>=1.4.1, xmonad==0.6+ ghc-options: -Wall++ if flag(testing)+ ghc-options: -Werror+ exposed-modules: XMonad.Doc XMonad.Doc.Configuring XMonad.Doc.Extending@@ -62,8 +70,10 @@ XMonad.Actions.FloatKeys XMonad.Actions.FocusNth XMonad.Actions.MouseGestures+ XMonad.Actions.NoBorders XMonad.Actions.RotSlaves XMonad.Actions.RotView+ XMonad.Actions.Search XMonad.Actions.SimpleDate XMonad.Actions.SinkAll XMonad.Actions.Submap@@ -79,6 +89,7 @@ XMonad.Hooks.DynamicLog XMonad.Hooks.EwmhDesktops XMonad.Hooks.ManageDocks+ XMonad.Hooks.ManageHelpers XMonad.Hooks.SetWMName XMonad.Hooks.UrgencyHook XMonad.Hooks.XPropManage@@ -102,10 +113,12 @@ XMonad.Layout.Named XMonad.Layout.NoBorders XMonad.Layout.PerWorkspace+ XMonad.Layout.Reflect XMonad.Layout.ResizableTile XMonad.Layout.Roledex XMonad.Layout.Spiral XMonad.Layout.Square+ XMonad.Layout.ShowWName XMonad.Layout.Tabbed XMonad.Layout.ThreeColumns XMonad.Layout.ToggleLayouts@@ -133,5 +146,7 @@ XMonad.Util.Invisible XMonad.Util.NamedWindows XMonad.Util.Run+ XMonad.Util.Timer+ XMonad.Util.WorkspaceCompare XMonad.Util.XSelection XMonad.Util.XUtils