adddir ./examples adddir ./examples/dzen-status addfile ./examples/dzen-status/Config.hs hunk ./examples/dzen-status/Config.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : Config.hs +-- Copyright : (c) Spencer Janssen 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : dons@cse.unsw.edu.au +-- Stability : stable +-- Portability : portable +-- +----------------------------------------------------------------------------- + +module Config where + +-- +-- xmonad bindings follow mostly the dwm/wmii conventions: +-- +-- key combination action +-- +-- mod-shift-return new xterm +-- mod-p launch dmenu +-- mod-shift-p launch gmrun +-- +-- mod-space switch tiling mode +-- +-- mod-tab raise next window in stack +-- mod-j +-- mod-k +-- +-- mod-h decrease the size of the master area +-- mod-l increase the size of the master area +-- +-- mod-shift-c kill client +-- mod-shift-q exit window manager +-- mod-shift-ctrl-q restart window manager ('xmonad' must be in $PATH) +-- +-- mod-return cycle the current tiling order +-- +-- mod-1..9 switch to workspace N +-- mod-shift-1..9 move client to workspace N +-- +-- mod-w,e,r switch to physical/Xinerama screen 1, 2 or 3. +-- +-- xmonad places each window into a "workspace." Each workspace can have +-- any number of windows, which you can cycle though with mod-j and mod-k. +-- Windows are either displayed full screen, tiled horizontally, or tiled +-- vertically. You can toggle the layout mode with mod-space, which will +-- cycle through the available modes. +-- +-- You can switch to workspace N with mod-N. For example, to switch to +-- workspace 5, you would press mod-5. Similarly, you can move the current +-- window to another workspace with mod-shift-N. +-- +-- When running with multiple monitors (Xinerama), each screen has exactly +-- 1 workspace visible. When xmonad starts, workspace 1 is on screen 1, +-- workspace 2 is on screen 2, etc. If you switch to a workspace which is +-- currently visible on another screen, xmonad simply switches focus to +-- that screen. If you switch to a workspace which is *not* visible, xmonad +-- replaces the workspace on the *current* screen with the workspace you +-- selected. +-- +-- For example, if you have the following configuration: +-- +-- Screen 1: Workspace 2 +-- Screen 2: Workspace 5 (current workspace) +-- +-- and you wanted to view workspace 7 on screen 1, you would press: +-- +-- mod-2 (to select workspace 2, and make screen 1 the current screen) +-- mod-7 (to select workspace 7) +-- +-- Since switching to the workspace currently visible on a given screen is +-- such a common operation, shortcuts are provided: mod-{w,e,r} switch to +-- the workspace currently visible on screens 1, 2, and 3 respectively. +-- Likewise, shift-mod-{w,e,r} moves the current window to the workspace on +-- that screen. Using these keys, the above example would become mod-w +-- mod-7. +-- + +import Data.Ratio +import Data.Bits +import qualified Data.Map as M +import System.Exit +import Graphics.X11.Xlib +import XMonad +import Operations + +-- The number of workspaces: +workspaces :: Int +workspaces = 9 + +-- modMask lets you easily change which modkey you use. The default is mod1Mask +-- ("left alt"). You may also consider using mod3Mask ("right alt"), which +-- does not conflict with emacs keybindings. The "windows key" is usually +-- mod4Mask. +modMask :: KeyMask +modMask = mod1Mask + +-- How much to change the horizontal/vertical split bar by defalut. +defaultDelta :: Rational +defaultDelta = 3%100 + +-- The mask for the numlock key. You may need to change this on some systems. +-- You can find the numlock modifier by running "xmodmap" and looking for a +-- modifier with Num_Lock bound to it. +numlockMask :: KeyMask +numlockMask = mod2Mask + +-- What layout to start in, and what the default proportion for the +-- left pane should be in the tiled layout. See LayoutDesc and +-- friends in XMonad.hs for options. +startingLayoutDesc :: LayoutDesc +startingLayoutDesc = + LayoutDesc { layoutType = Full + , tileFraction = 1%2 } + +-- The keys list. +keys :: M.Map (KeyMask, KeySym) (X ()) +keys = M.fromList $ + [ ((modMask .|. shiftMask, xK_Return), spawn "xterm") + , ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && exec $exe") + , ((modMask .|. shiftMask, xK_p ), spawn "gmrun") + , ((modMask, xK_space ), switchLayout) + + , ((modMask, xK_Tab ), raise GT) + , ((modMask, xK_j ), raise GT) + , ((modMask, xK_k ), raise LT) + + , ((modMask, xK_h ), changeSplit (negate defaultDelta)) + , ((modMask, xK_l ), changeSplit defaultDelta) + + , ((modMask .|. shiftMask, xK_c ), kill) + + , ((modMask .|. shiftMask, xK_q ), io $ exitWith ExitSuccess) + , ((modMask .|. shiftMask .|. controlMask, xK_q ), io restart) + + -- Cycle the current tiling order + , ((modMask, xK_Return), promote) + + , ((modMask, xK_s ), spawn "/home/dons/bin/status") + + ] ++ + -- Keybindings to get to each workspace: + [((m .|. modMask, k), f i) + | (i, k) <- zip [0 .. fromIntegral workspaces - 1] [xK_1 ..] + , (f, m) <- [(view, 0), (tag, shiftMask)]] + + -- Keybindings to each screen : + -- mod-wer (underneath 123) switches to physical/Xinerama screens 1 2 and 3 + ++ + [((m .|. modMask, key), screenWorkspace sc >>= f) + | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..] + , (f, m) <- [(view, 0), (tag, shiftMask)]] + addfile ./examples/dzen-status/readme hunk ./examples/dzen-status/readme 1 +Use dzen2 for an external pop-up status bar. + +status + A shell script printing some strings into dzen2. In this case, it + extracts some openbsd settings. + +Config.hs + , ((modMask, xK_s ), spawn "/home/dons/bin/status") + + mod-s pops up a 10 second status bar. mouse button 3 closes it + explicitly. + +dzen2 is available from: + http://gotmor.googlepages.com/dzen + addfile ./examples/dzen-status/status hunk ./examples/dzen-status/status 1 +#!/bin/sh +au=`date +"%H.%M %a %b %d"` +uk=`TZ=GMT date +"UK %H.%M"` +us=`TZ=America/New_York date +"NY %H.%M"` +ca=`TZ=America/Los_Angeles date +"SF %H.%M"` +hw=`/sbin/sysctl hw.setperf | sed "s/.*=//" | perl -anle 'print (0.6 + ($F[0]) / 100)'` +ut=`uptime | sed 's/.*://; s/,//g'` +bt=`/usr/sbin/apm | sed -n 's/.*: \([^ ]*\).*$/\1/;2p;4p' | xargs printf "apm %s%%, AC %s\n"` +(printf "%s : %s : %s : %s : %s Ghz : %s :%s\n" "$au" "$uk" "$us" "$ca" "$hw" "$bt" "$ut"; sleep 10) | dzen2 addfile ./README hunk ./README 1 +3rd party xmonad extensions and contributions. + +This repository can be overlayed on an xmonad repository. +Users may then import Haskell src from here, to extend their config +files. + +examples/ contains further external programs useful with xmonad. hunk ./README 9 +Haskell code contributed to this repo should live under the + + XMonadContrib. + +name space. For example: + + XMonadContrib.Mosaic + addfile ./SimpleDate.hs hunk ./SimpleDate.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Example +-- Copyright : (c) Don Stewart 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : dons@cse.unsw.edu.au +-- Stability : stable +-- Portability : portable +-- +----------------------------------------------------------------------------- +-- +-- An example external contrib module for xmonad. +-- +-- Provides a simple binding to dzen2 to print the date as a popup menu. +-- +-- To use, modify your Config.hs to: +-- +-- import XMonadContrib.SimpleDate +-- +-- and add a keybinding: +-- +-- , ((modMask, xK_d ), date) +-- +-- a popup date menu will now be bound to mod-d +-- + +module XMonadContrib.SimpleDate where + +import XMonad + +date :: X () +date = spawn "(date; sleep 10) | dzen2" addfile ./DwmPromote.hs hunk ./DwmPromote.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.DwmPromote +-- Copyright : (c) Miikka Koskinen 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : arcatan@kapsi.fi +-- +----------------------------------------------------------------------------- +-- +-- Dwm-like promote function for xmonad. +-- +-- Swaps focused window with the master window. If focus is in the +-- master, swap it with the next window in the stack. Focus stays in the +-- master. +-- +-- To use, modify your Config.hs to: +-- +-- import XMonadContrib.DwmPromote +-- +-- and add a keybinding or substitute promote with dwmpromote: +-- +-- , ((modMask, xK_Return), dwmpromote) +-- + +module XMonadContrib.DwmPromote (dwmpromote) where + +import XMonad +import Operations (windows) +import StackSet hiding (promote) +import qualified Data.Map as M + +dwmpromote :: X () +dwmpromote = windows promote + +promote :: (Integral i, Ord a) => StackSet i j a -> StackSet i j a +promote w = maybe w id $ do + a <- peek w -- fail if null + let stack = index (current w) w + let newstack = swap a (next stack a) stack + return $ w { stacks = M.insert (current w) newstack (stacks w), + focus = M.insert (current w) (head newstack) (focus w) } + where + next s a | head s /= a = head s -- focused is not master + | length s > 1 = s !! 1 + | otherwise = a addfile ./RotView.hs hunk ./RotView.hs 1 +module XMonad.RotView ( rotView ) where + +-- To use: +-- include XMonad.RotView + +-- , ((modMask .|. shiftMask, xK_Right), rotView True) +-- , ((modMask .|. shiftMask, xK_Left), rotView False) + +import qualified Data.Map as M +import Control.Monad.State + +import Operations ( view ) +import XMonad ( X, WorkspaceId, workspace ) +import StackSet ( StackSet, focus ) +import qualified StackSet as W ( current ) + +rotView :: Bool -> X m () +rotView b = do ws <- gets workspace + let m = W.current ws + allws = if b then allWorkspaces ws else reverse $ allWorkspaces ws + n1 = safehead allws m + rot (f:fs) | f == m = safehead fs n1 + | otherwise = rot fs + rot [] = n1 + safehead fs f = case fs of { [] -> f; f':_ -> f'; } + view (rot allws) + +-- | A list of all the workspaces. +allWorkspaces :: StackSet WorkspaceId j a -> [WorkspaceId] +allWorkspaces = M.keys . focus addfile ./Dmenu.hs hunk ./Dmenu.hs 1 +module XMonadContrib.Dmenu (dmenu, dmenuXinerama, runProcessWithInput) where + +import XMonad +import qualified StackSet as W +import System.Process +import System.IO +import Control.Monad +import Control.Monad.State +import Data.Maybe +import qualified Data.Map as M + +runProcessWithInput :: FilePath -> [String] -> String -> IO String +runProcessWithInput cmd args input = do + (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing + hPutStr pin input + hClose pin + output <- hGetContents pout + when (output==output) $ return () + hClose pout + hClose perr + waitForProcess ph + return output + +dmenuXinerama :: [String] -> X String +dmenuXinerama opts = do + ws <- gets workspace + let curscreen = fromIntegral $ fromMaybe 0 (M.lookup (W.current ws) (W.ws2screen ws)) :: Int + io $ runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts) + +dmenu :: [String] -> IO String +dmenu opts = runProcessWithInput "dmenu" [] (unlines opts) + hunk ./Dmenu.hs 30 -dmenu :: [String] -> IO String -dmenu opts = runProcessWithInput "dmenu" [] (unlines opts) +dmenu :: [String] -> X String +dmenu opts = io $ runProcessWithInput "dmenu" [] (unlines opts) hunk ./Dmenu.hs 24 +-- Starts dmenu on the current screen. Requires this patch to dmenu: +-- http://www.jcreigh.com/dmenu/dmenu-2.8-xinerama.patch hunk ./RotView.hs 1 -module XMonad.RotView ( rotView ) where +module XMonadContrib.RotView ( rotView ) where + +-- Provides bindings to cycle through non-empty workspaces. hunk ./RotView.hs 19 -rotView :: Bool -> X m () +rotView :: Bool -> X () hunk ./Dmenu.hs 7 -import Control.Monad addfile ./Mosaic.hs hunk ./Mosaic.hs 1 +module XMonadContrib.Mosaic ( mosaic, expandWindow, shrinkWindow, squareWindow ) where + +-- This module defines a "mosaic" layout, which tries to give all windows +-- equal area, while also trying to give them a user-defined (and run-time +-- adjustable) aspect ratio. You can use mod-l and mod-h to adjust the +-- aspect ratio (which probably won't have a very interesting effect unless +-- you've got a number of windows upen. + +-- My intent is to extend this layout to optimize various constraints, such +-- as windows that should have a different aspect ratio, a fixed size, or +-- minimum dimensions in certain directions. + +-- You can use this module with the following in your config file: + +-- import XMonad.Mosaic +-- import Control.Monad.State ( gets ) +-- import qualified StackSet as W ( peek ) + +-- defaultLayouts :: [Layout LayoutMsg] +-- defaultLayouts = [ mosaic (1%4) (1%2) M.empty M.empty, full, +-- tall defaultDelta (1%2), wide defaultDelta (1%2) ] + +-- In the key-bindings, do something like: + +-- , ((modMask .|. shiftMask, xK_h ), do ws <- gets workspace +-- whenJust (W.peek ws) $ \w -> +-- layoutMsg (shrinkWindow w)) +-- , ((modMask .|. shiftMask, xK_l ), do ws <- gets workspace +-- whenJust (W.peek ws) $ \w -> +-- layoutMsg (expandWindow w)) +-- , ((modMask .|. shiftMask, xK_s ), do ws <- gets workspace +-- whenJust (W.peek ws) $ \w -> +-- layoutMsg (squareWindow w)) + +import Data.Ratio +import Graphics.X11.Xlib +import XMonad +import Operations ( ShrinkOrExpand (Shrink, Expand) ) +import qualified Data.Map as M +import Data.List ( sort ) +import Data.Dynamic ( Typeable, fromDynamic ) +import Control.Monad ( mplus ) + +import System.IO.Unsafe + +data HandleWindow = ExpandWindow Window | ShrinkWindow Window | SquareWindow Window + deriving ( Typeable, Eq ) +expandWindow, shrinkWindow, squareWindow :: Window -> HandleWindow +expandWindow = ExpandWindow +shrinkWindow = ShrinkWindow +squareWindow = SquareWindow + +mosaic :: Rational -> Rational -> M.Map Window WindowRater -> M.Map Window Area -> Layout +mosaic delta tileFrac raters areas = Layout { doLayout = mosaicL tileFrac raters areas + , modifyLayout = mlayout } + where mlayout x = (m1 `fmap` fromDynamic x) `mplus` (m2 `fmap` fromDynamic x) + m1 Shrink = mosaic delta (tileFrac/(1+delta)) raters areas + m1 Expand = mosaic delta (tileFrac*(1+delta)) raters areas + m2 (ExpandWindow w) = mosaic delta tileFrac raters + -- (add_rater (\_ (Rectangle _ _ wid h) -> delta*(1-wid///h)) w raters) + (multiply_area (1+delta) w areas) + m2 (ShrinkWindow w) = mosaic delta tileFrac raters + -- (add_rater (\_ (Rectangle _ _ wid h) -> delta*(wid///h-1)) w raters) + (multiply_area (1/(1+ delta)) w areas) + m2 (SquareWindow w) = mosaic delta tileFrac (M.insert w force_square raters) areas + force_square _ (Rectangle _ _ a b) = 100*(sqr(a///b) + sqr(b///a)) + sqr a = a * a + +mytrace :: String -> a -> a +mytrace s a = seq foo a + where foo = unsafePerformIO $ appendFile "/tmp/xmonad.trace" (s++"\n") + +myerror :: String -> a +myerror s = seq foo $ error s + where foo = unsafePerformIO $ appendFile "/tmp/xmonad.trace" (s++"\n") + +multiply_area :: Area -> Window -> M.Map Window Area -> M.Map Window Area +multiply_area a w = M.alter (Just . f) w where f Nothing = a + f (Just a') = a'*a + +add_rater :: WindowRater -> Window -> M.Map Window WindowRater -> M.Map Window WindowRater +add_rater r w = M.alter f w where f Nothing= Just r + f (Just r') = Just $ \foo bar -> r foo bar + r' foo bar + +type WindowRater = Window -> Rectangle -> Rational + +mosaicL :: Rational -> M.Map Window WindowRater -> M.Map Window Area + -> Rectangle -> [Window] -> [(Window, Rectangle)] +mosaicL _ _ _ _ [] = [] +mosaicL f raters areas origRect origws + = flattenMosaic $ the_value $ if myv < myh then myv else myh + where mean_area = area origRect / fromIntegral (length origws) + myv = my_mosaic origRect Vertical sortedws + myh = my_mosaic origRect Horizontal sortedws + sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) origws + + my_mosaic :: Rectangle -> CutDirection -> [Window] + -> Rated Rational (Mosaic (Window, Rectangle)) + my_mosaic _ _ [] = Rated 0 $ M [] + my_mosaic r _ [w] = Rated (rating w r) $ OM (w,r) + my_mosaic r d ws = minL $ + map (fmap M . catRated . + map (\(ws',r') -> my_mosaic r' (otherDirection d) ws')) $ + map (\ws' -> zip ws' $ partitionR d r $ map sumareas ws') $ + init $ allsplits ws + where minL [] = myerror "minL on empty list" + minL [a] = a + minL (a:b:c) = minL (min a b:c) + + partitionR :: CutDirection -> Rectangle -> [Area] -> [Rectangle] + partitionR _ _ [] = [] + partitionR _ r [_] = [r] + partitionR d r (a:ars) = r1 : partitionR d r2 ars + where totarea = sum (a:ars) + (r1,r2) = split d (a/totarea) r + + rating :: WindowRater + rating w r = (M.findWithDefault default_preferences w raters) w r + default_preferences :: WindowRater + default_preferences _ r@(Rectangle _ _ w h) + | fr <- w /// h = sqr(fr/f)+sqr(f/fr)-2+ toRational (mean_area/area r) + sqr a = a * a + sumareas ws = sum $ map (\w -> M.findWithDefault 1 w areas) ws + + + +catRated :: Num v => [Rated v a] -> Rated v [a] +catRated xs = Rated (sum $ map the_rating xs) (map the_value xs) + +data Rated a b = Rated !a !b +instance Functor (Rated a) where + f `fmap` (Rated v a) = Rated v (f a) + +the_value :: Rated a b -> b +the_value (Rated _ b) = b +the_rating :: Rated a b -> a +the_rating (Rated a _) = a + +instance Eq a => Eq (Rated a b) where + (Rated a _) == (Rated a' _) = a == a' +instance Ord a => Ord (Rated a b) where + compare (Rated a _) (Rated a' _) = compare a a' + +type Area = Rational + +area :: Rectangle -> Area +area (Rectangle _ _ w h) = fromIntegral w * fromIntegral h + +(///) :: (Integral a, Integral b) => a -> b -> Rational +a /// b = fromIntegral a / fromIntegral b + + +split :: CutDirection -> Rational -> Rectangle -> (Rectangle, Rectangle) +split Vertical frac (Rectangle sx sy sw sh) = (Rectangle sx sy sw h, + Rectangle sx (sy+fromIntegral h) sw (sh-h)) + where h = floor $ fromIntegral sh * frac +split Horizontal frac (Rectangle sx sy sw sh) = (Rectangle sx sy w sh, + Rectangle (sx+fromIntegral w) sy (sw-w) sh) + where w = floor $ fromIntegral sw * frac + +data CutDirection = Vertical | Horizontal +otherDirection :: CutDirection -> CutDirection +otherDirection Vertical = Horizontal +otherDirection Horizontal = Vertical + +data Mosaic a where + M :: [Mosaic a] -> Mosaic a + OM :: a -> Mosaic a + +flattenMosaic :: Mosaic a -> [a] +flattenMosaic (OM a) = [a] +flattenMosaic (M xs) = concatMap flattenMosaic xs + +allsplits :: [a] -> [[[a]]] +allsplits [] = [[[]]] +allsplits [a] = [[[a]]] +allsplits (x:xs) = (map ([x]:) splitsrest) ++ + (map (maphead (x:)) splitsrest) + where splitsrest = allsplits xs + +maphead :: (a->a) -> [a] -> [a] +maphead f (x:xs) = f x : xs +maphead _ [] = [] hunk ./Mosaic.hs 15 --- import XMonad.Mosaic +-- import XMonadContrib.Mosaic hunk ./Mosaic.hs 19 --- defaultLayouts :: [Layout LayoutMsg] +-- defaultLayouts :: [Layout] hunk ./Mosaic.hs 38 -import Operations ( ShrinkOrExpand (Shrink, Expand) ) +import Operations ( Resize(Shrink, Expand) ) hunk ./Mosaic.hs 41 -import Data.Dynamic ( Typeable, fromDynamic ) +import Data.Typeable ( Typeable ) hunk ./Mosaic.hs 48 + +instance Message HandleWindow + hunk ./Mosaic.hs 59 - where mlayout x = (m1 `fmap` fromDynamic x) `mplus` (m2 `fmap` fromDynamic x) + where mlayout x = (m1 `fmap` fromMessage x) `mplus` (m2 `fmap` fromMessage x) hunk ./RotView.hs 6 --- include XMonad.RotView +-- import XMonadContrib.RotView hunk ./RotView.hs 15 -import XMonad ( X, WorkspaceId, workspace ) -import StackSet ( StackSet, focus ) -import qualified StackSet as W ( current ) +import XMonad ( X, WorkspaceId, workspace, whenJust ) +import StackSet ( StackSet ) +import Data.Maybe ( listToMaybe ) +import qualified StackSet as W ( stacks, current, visibleWorkspaces, index ) hunk ./RotView.hs 23 + vis = W.visibleWorkspaces ws hunk ./RotView.hs 25 - n1 = safehead allws m - rot (f:fs) | f == m = safehead fs n1 - | otherwise = rot fs - rot [] = n1 - safehead fs f = case fs of { [] -> f; f':_ -> f'; } - view (rot allws) + pivoted = uncurry (flip (++)) . span (/=m) $ allws + interesting i = not (i `elem` vis) && not (isEmpty i ws) + nextws = listToMaybe . filter interesting $ pivoted + whenJust nextws view hunk ./RotView.hs 32 -allWorkspaces = M.keys . focus +allWorkspaces = M.keys . W.stacks + +isEmpty :: WorkspaceId -> StackSet WorkspaceId j a -> Bool +isEmpty i = maybe True null . W.index i addfile ./SwapFocus.hs hunk ./SwapFocus.hs 1 +module XMonadContrib.SwapFocus ( swapFocus ) where + +-- swaps focus with last-focussed window. + +-- To use: +-- import XMonadContrib.SwapFocus ( swapFocus ) + +-- , ((modMask .|. shiftMask, xK_Tab), swapFocus) + +import Control.Monad.State + +import Operations ( refresh ) +import XMonad ( X, WindowSet, workspace ) +import StackSet ( StackSet, peekStack, popFocus, pushFocus, current ) + +sf :: (Integral i, Integral j, Ord a) => StackSet i j a -> Maybe (StackSet i j a) +sf w = do let i = current w + f1 <- peekStack i w + f2 <- peekStack i $ popFocus i f1 w + return $ pushFocus i f2 $ pushFocus i f1 w + +swapFocus :: X () +swapFocus = smartwindows sf + +-- | smartwindows. Modify the current window list with a pure function, and only refresh if necesary +smartwindows :: (WindowSet -> Maybe WindowSet) -> X () +smartwindows f = do w <- gets workspace + case (f w) of Just f' -> do modify $ \s -> s { workspace = f' } + refresh + Nothing -> return () hunk ./DwmPromote.hs 40 - let newstack = swap a (next stack a) stack - return $ w { stacks = M.insert (current w) newstack (stacks w), + newstack = swap a (next stack a) stack + return $ w { stacks = M.adjust (\(f,_) -> (f, newstack)) (current w) (stacks w), hunk ./DwmPromote.hs 39 - let stack = index (current w) w - newstack = swap a (next stack a) stack + stack <- index (current w) w + let newstack = swap a (next stack a) stack hunk ./DwmPromote.hs 36 -promote :: (Integral i, Ord a) => StackSet i j a -> StackSet i j a +promote :: (Integral i, Integral j, Ord a) => StackSet i j a -> StackSet i j a hunk ./DwmPromote.hs 41 - return $ w { stacks = M.adjust (\(f,_) -> (f, newstack)) (current w) (stacks w), - focus = M.insert (current w) (head newstack) (focus w) } + return . raiseFocus (head newstack) $ + w { stacks = M.adjust (\(f,_) -> (f, newstack)) (current w) (stacks w) } addfile ./FindEmptyWorkspace.hs hunk ./FindEmptyWorkspace.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.FindEmptyWorkspace +-- Copyright : (c) Miikka Koskinen 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : arcatan@kapsi.fi +-- +----------------------------------------------------------------------------- +-- +-- Find an empty workspace in xmonad. +-- +-- To use, modify your Config.hs to: +-- +-- import XMonadContrib.FindEmptyWorkspace +-- +-- and add a keybinding: +-- +-- , ((modMask, xK_m ), viewEmptyWorkspace) +-- , ((modMask .|. shiftMask, xK_m ), tagToEmptyWorkspace) +-- +-- Now you can jump to an empty workspace with mod-n. Mod-shift-n will +-- tag the current window to an empty workspace and view it. +-- + +module XMonadContrib.FindEmptyWorkspace ( + viewEmptyWorkspace, tagToEmptyWorkspace + ) where + +import Control.Monad.State +import qualified Data.Map as M + +import XMonad +import Operations +import qualified StackSet as W + +-- | Find the first empty workspace in a WindowSet. Returns Nothing if +-- all workspaces are in use. +findEmptyWorkspace :: WindowSet -> Maybe WorkspaceId +findEmptyWorkspace = findKey (([],[]) ==) . W.stacks + +withEmptyWorkspace :: (WorkspaceId -> X ()) -> X () +withEmptyWorkspace f = do + ws <- gets workspace + whenJust (findEmptyWorkspace ws) f + +-- | Find and view an empty workspace. Do nothing if all workspaces are +-- in use. +viewEmptyWorkspace :: X () +viewEmptyWorkspace = withEmptyWorkspace view + +-- | Tag current window to an empty workspace and view it. Do nothing if +-- all workspaces are in use. +tagToEmptyWorkspace :: X () +tagToEmptyWorkspace = withEmptyWorkspace $ \w -> tag w >> view w + +-- Thanks to mauke on #haskell +findKey :: (a -> Bool) -> M.Map k a -> Maybe k +findKey f = M.foldWithKey (\k a -> mplus (if f a then Just k else Nothing)) Nothing hunk ./Mosaic.hs 1 -module XMonadContrib.Mosaic ( mosaic, expandWindow, shrinkWindow, squareWindow ) where +module XMonadContrib.Mosaic ( mosaic, expandWindow, shrinkWindow, squareWindow, + getName, withNamedWindow ) where hunk ./Mosaic.hs 17 --- import Control.Monad.State ( gets ) --- import qualified StackSet as W ( peek ) hunk ./Mosaic.hs 24 --- , ((modMask .|. shiftMask, xK_h ), do ws <- gets workspace --- whenJust (W.peek ws) $ \w -> --- layoutMsg (shrinkWindow w)) --- , ((modMask .|. shiftMask, xK_l ), do ws <- gets workspace --- whenJust (W.peek ws) $ \w -> --- layoutMsg (expandWindow w)) --- , ((modMask .|. shiftMask, xK_s ), do ws <- gets workspace --- whenJust (W.peek ws) $ \w -> --- layoutMsg (squareWindow w)) +-- , ((modMask .|. shiftMask, xK_h ), withNamedWindow (sendMessage . shrinkWindow)) +-- , ((modMask .|. shiftMask, xK_l ), withNamedWindow (sendMessage . expandWindow)) +-- , ((modMask .|. shiftMask, xK_s ), withNamedWindow (sendMessage . squareWindow)) hunk ./Mosaic.hs 28 +import Control.Monad.Reader ( asks ) +import Control.Monad.State ( gets ) +import qualified StackSet as W ( peek ) hunk ./Mosaic.hs 33 +import Graphics.X11.Xlib.Extras ( fetchName ) hunk ./Mosaic.hs 43 -data HandleWindow = ExpandWindow Window | ShrinkWindow Window | SquareWindow Window +data HandleWindow = ExpandWindow NamedWindow | ShrinkWindow NamedWindow | SquareWindow NamedWindow hunk ./Mosaic.hs 48 -expandWindow, shrinkWindow, squareWindow :: Window -> HandleWindow +expandWindow, shrinkWindow, squareWindow :: NamedWindow -> HandleWindow hunk ./Mosaic.hs 53 -mosaic :: Rational -> Rational -> M.Map Window WindowRater -> M.Map Window Area -> Layout +mosaic :: Rational -> Rational -> M.Map NamedWindow WindowRater -> M.Map NamedWindow Area -> Layout hunk ./Mosaic.hs 77 -multiply_area :: Area -> Window -> M.Map Window Area -> M.Map Window Area +multiply_area :: Area -> NamedWindow -> M.Map NamedWindow Area -> M.Map NamedWindow Area hunk ./Mosaic.hs 81 -add_rater :: WindowRater -> Window -> M.Map Window WindowRater -> M.Map Window WindowRater +add_rater :: WindowRater -> NamedWindow -> M.Map NamedWindow WindowRater -> M.Map NamedWindow WindowRater hunk ./Mosaic.hs 85 -type WindowRater = Window -> Rectangle -> Rational +type WindowRater = NamedWindow -> Rectangle -> Rational hunk ./Mosaic.hs 87 -mosaicL :: Rational -> M.Map Window WindowRater -> M.Map Window Area - -> Rectangle -> [Window] -> [(Window, Rectangle)] -mosaicL _ _ _ _ [] = [] +data NamedWindow = NW !String !Window +instance Eq NamedWindow where + (NW s _) == (NW s' _) = s == s' +instance Ord NamedWindow where + compare (NW s _) (NW s' _) = compare s s' + +mosaicL :: Rational -> M.Map NamedWindow WindowRater -> M.Map NamedWindow Area + -> Rectangle -> [Window] -> X [(Window, Rectangle)] +mosaicL _ _ _ _ [] = return [] hunk ./Mosaic.hs 97 - = flattenMosaic $ the_value $ if myv < myh then myv else myh + = do namedws <- mapM getName origws + let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) namedws + myv = my_mosaic origRect Vertical sortedws + myh = my_mosaic origRect Horizontal sortedws + return $ map (\(nw,r)->(unName nw,r)) $ flattenMosaic $ the_value $ if myv < myh then myv else myh hunk ./Mosaic.hs 103 - myv = my_mosaic origRect Vertical sortedws - myh = my_mosaic origRect Horizontal sortedws - sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) origws hunk ./Mosaic.hs 104 - my_mosaic :: Rectangle -> CutDirection -> [Window] - -> Rated Rational (Mosaic (Window, Rectangle)) + my_mosaic :: Rectangle -> CutDirection -> [NamedWindow] + -> Rated Rational (Mosaic (NamedWindow, Rectangle)) hunk ./Mosaic.hs 192 +getName :: Window -> X NamedWindow +getName w = asks display >>= \d -> do n <- maybe "" id `fmap` io (fetchName d w) + return $ NW n w + +unName :: NamedWindow -> Window +unName (NW _ w) = w + +withNamedWindow :: (NamedWindow -> X ()) -> X () +withNamedWindow f = do ws <- gets workspace + whenJust (W.peek ws) $ \w -> getName w >>= f + hunk ./Mosaic.hs 53 +largeNumber :: Int +largeNumber = 1000 + hunk ./Mosaic.hs 115 - init $ allsplits ws + take largeNumber $ init $ allsplits ws addfile ./TwoPane.hs hunk ./TwoPane.hs 1 +-- A layout that splits the screen horizontally and shows two windows. The +-- left window is always the master window, and the right is either the +-- currently focused window or the second window in layout order. + +module XMonadContrib.TwoPane where + +import XMonad +import Operations +import qualified StackSet as W +import Control.Monad.State (gets) + +twoPane :: Rational -> Rational -> Layout +twoPane delta split = Layout { doLayout = arrange, modifyLayout = message } + where + arrange rect (w:x:_) = do + (Just f) <- gets (W.peek . workspace) -- safe because of pattern match above + let (left, right) = splitHorizontallyBy split rect + return [(w, left), (if f == w then x else f, right)] + -- there are one or zero windows + arrange rect ws = return . map (\w -> (w, rect)) $ ws + + message x = case fromMessage x of + Just Shrink -> Just (twoPane delta (split - delta)) + Just Expand -> Just (twoPane delta (split + delta)) + _ -> Nothing hunk ./TwoPane.hs 4 +-- +-- To use this layout, 'import XMonadContrib.TwoPane'and add +-- 'twoPane defaultDelta (1%2)' to the list of layouts hunk ./TwoPane.hs 5 --- To use this layout, 'import XMonadContrib.TwoPane'and add +-- To use this layout, 'import XMonadContrib.TwoPane' and add hunk ./Mosaic.hs 1 -module XMonadContrib.Mosaic ( mosaic, expandWindow, shrinkWindow, squareWindow, +module XMonadContrib.Mosaic ( mosaic, expandWindow, shrinkWindow, squareWindow, myclearWindow, hunk ./Mosaic.hs 27 +-- , ((modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . clearWindow)) hunk ./Mosaic.hs 44 -data HandleWindow = ExpandWindow NamedWindow | ShrinkWindow NamedWindow | SquareWindow NamedWindow +data HandleWindow = ExpandWindow NamedWindow | ShrinkWindow NamedWindow + | SquareWindow NamedWindow | ClearWindow NamedWindow hunk ./Mosaic.hs 50 -expandWindow, shrinkWindow, squareWindow :: NamedWindow -> HandleWindow +expandWindow, shrinkWindow, squareWindow, myclearWindow :: NamedWindow -> HandleWindow hunk ./Mosaic.hs 54 +myclearWindow = ClearWindow hunk ./Mosaic.hs 72 + m2 (ClearWindow w) = mosaic delta tileFrac (M.delete w raters) (M.delete w areas) hunk ./Mosaic.hs 57 -largeNumber = 1000 +largeNumber = 100 hunk ./TwoPane.hs 18 - arrange rect (w:x:_) = do + arrange rect ws@(w:x:_) = do hunk ./TwoPane.hs 20 - let (left, right) = splitHorizontallyBy split rect - return [(w, left), (if f == w then x else f, right)] + let y = if f == w then x else f + (left, right) = splitHorizontallyBy split rect + mapM_ hide . filter (\a -> a /= w && a /= y) $ ws + return [(w, left), (y, right)] hunk ./TwoPane.hs 25 - arrange rect ws = return . map (\w -> (w, rect)) $ ws + arrange rect ws = return . map (\w -> (w, rect)) $ ws hunk ./Dmenu.hs 27 - ws <- gets workspace + ws <- gets windowset hunk ./FindEmptyWorkspace.hs 44 - ws <- gets workspace + ws <- gets windowset hunk ./Mosaic.hs 207 -withNamedWindow f = do ws <- gets workspace +withNamedWindow f = do ws <- gets windowset hunk ./RotView.hs 21 -rotView b = do ws <- gets workspace +rotView b = do ws <- gets windowset hunk ./SwapFocus.hs 13 -import XMonad ( X, WindowSet, workspace ) +import XMonad ( X, WindowSet, windowset ) hunk ./SwapFocus.hs 27 -smartwindows f = do w <- gets workspace - case (f w) of Just f' -> do modify $ \s -> s { workspace = f' } +smartwindows f = do w <- gets windowset + case (f w) of Just f' -> do modify $ \s -> s { windowset = f' } hunk ./TwoPane.hs 19 - (Just f) <- gets (W.peek . workspace) -- safe because of pattern match above + (Just f) <- gets (W.peek . windowset) -- safe because of pattern match above addfile ./Rescreen.hs hunk ./Rescreen.hs 1 +-- Grabs new screen information. Useful for randr setups. +-- To use rescreen, add a keybinding in Config.hs. For example: +-- , ((modMask .|. shiftMask, xK_F12 ), rescreen) + +-- TODO Get this code into xmonad when it is ready for randr support. +-- Make it happen automatically on randr events. It's currently 20 loc, but I +-- believe it can be shrunk a bit. + +module XMonadContrib.Rescreen (rescreen) where + +import qualified StackSet as W +import XMonad +import Operations + +import Graphics.X11.Xlib +import Graphics.X11.Xinerama + +import Control.Monad.State +import Control.Monad.Reader +import Data.List (partition) + +rescreen :: X () +rescreen = do + dpy <- asks display + xinesc <- io $ getScreenInfo dpy + -- TODO: This stuff is necessary because Xlib apparently caches screen + -- width/height. Find a better solution later. I hate Xlib. + let sx = maximum $ map (\r -> rect_x r + fromIntegral (rect_width r)) xinesc + sy = maximum $ map (\r -> rect_y r + fromIntegral (rect_height r)) xinesc + modify (\s -> s { xineScreens = xinesc, dimensions = (sx, sy) }) + ws <- gets windowset + let s = W.current ws : W.visible ws + t = zipWith const [0 :: ScreenId ..] xinesc + (stay, hide) = partition (\x -> fromIntegral (W.screen x) < length t) s + newsids = filter (\x -> fromIntegral x >= length s) t + (newvis, newinvis) = splitAt (length newsids) (map W.workspace hide ++ W.hidden ws) + (newcurr : xs) = stay ++ zipWith W.Screen newvis newsids + windows $ const $ ws { W.current = newcurr + , W.visible = xs + , W.hidden = newinvis + } addfile ./GreedyView.hs hunk ./GreedyView.hs 1 +-- greedyView is an alternative to standard workspace switching. When a +-- workspace is already visible on another screen, greedyView swaps the +-- contents of that other screen with the current screen. + +module XMonadContrib.GreedyView (greedyView) where + +import StackSet as W +import XMonad +import Operations +import Data.List (find) + +greedyView :: WorkspaceId -> X () +greedyView = windows . greedyView' + +greedyView' :: WorkspaceId -> WindowSet -> WindowSet +greedyView' w ws + | any wTag (hidden ws) = W.view w ws + | (Just s) <- find (wTag . workspace) (visible ws) = ws { current = setScreen s (screen $ current ws) + , visible = setScreen (current ws) (screen s) + : filter (not . wTag . workspace) (visible ws) + } + | otherwise = ws + where + setScreen s i = s { screen = i } + wTag = (w == ) . tag hunk ./Dmenu.hs 8 -import Data.Maybe -import qualified Data.Map as M hunk ./Dmenu.hs 25 - ws <- gets windowset - let curscreen = fromIntegral $ fromMaybe 0 (M.lookup (W.current ws) (W.ws2screen ws)) :: Int + curscreen <- (fromIntegral . W.screen . W.current) `liftM` gets windowset :: X Int hunk ./DwmPromote.hs 11 --- Dwm-like promote function for xmonad. +-- Dwm-like swap function for xmonad. hunk ./DwmPromote.hs 30 -import StackSet hiding (promote) +import StackSet hiding (swap) hunk ./DwmPromote.hs 34 -dwmpromote = windows promote +dwmpromote = windows swap hunk ./DwmPromote.hs 36 -promote :: (Integral i, Integral j, Ord a) => StackSet i j a -> StackSet i j a -promote w = maybe w id $ do - a <- peek w -- fail if null - stack <- index (current w) w - let newstack = swap a (next stack a) stack - return . raiseFocus (head newstack) $ - w { stacks = M.adjust (\(f,_) -> (f, newstack)) (current w) (stacks w) } - where - next s a | head s /= a = head s -- focused is not master - | length s > 1 = s !! 1 - | otherwise = a +swap :: StackSet i a s -> StackSet i a s +swap = modify Empty $ \c -> case c of + Node t [] (x:rs) -> Node x [] (t:rs) + Node t ls rs -> Node t [] (ys ++ x : rs) where (x:ys) = reverse ls hunk ./FindEmptyWorkspace.hs 31 -import qualified Data.Map as M +import Data.List hunk ./FindEmptyWorkspace.hs 34 -import Operations -import qualified StackSet as W +import StackSet hunk ./FindEmptyWorkspace.hs 36 --- | Find the first empty workspace in a WindowSet. Returns Nothing if --- all workspaces are in use. -findEmptyWorkspace :: WindowSet -> Maybe WorkspaceId -findEmptyWorkspace = findKey (([],[]) ==) . W.stacks +import qualified Operations as O + +-- | Find the first hidden empty workspace in a StackSet. Returns +-- Nothing if all workspaces are in use. Function searches currently +-- focused workspace, other visible workspaces (when in Xinerama) and +-- hidden workspaces in this order. +findEmptyWorkspace :: StackSet i a s -> Maybe (Workspace i a) +findEmptyWorkspace = find (isEmpty . stack) . allWorkspaces + where + isEmpty Empty = True + isEmpty _ = False + allWorkspaces ss = (workspace . current) ss : + (map workspace . visible) ss ++ hidden ss hunk ./FindEmptyWorkspace.hs 53 - whenJust (findEmptyWorkspace ws) f + whenJust (findEmptyWorkspace ws) (f . tag) hunk ./FindEmptyWorkspace.hs 58 -viewEmptyWorkspace = withEmptyWorkspace view +viewEmptyWorkspace = withEmptyWorkspace O.view hunk ./FindEmptyWorkspace.hs 63 -tagToEmptyWorkspace = withEmptyWorkspace $ \w -> tag w >> view w - --- Thanks to mauke on #haskell -findKey :: (a -> Bool) -> M.Map k a -> Maybe k -findKey f = M.foldWithKey (\k a -> mplus (if f a then Just k else Nothing)) Nothing +tagToEmptyWorkspace = withEmptyWorkspace $ \w -> O.shift w >> O.view w hunk ./DwmPromote.hs 30 -import StackSet hiding (swap) -import qualified Data.Map as M +import StackSet hunk ./DwmPromote.hs 37 + Node _ [] [] -> c hunk ./RotView.hs 11 -import qualified Data.Map as M -import Control.Monad.State - -import Operations ( view ) -import XMonad ( X, WorkspaceId, workspace, whenJust ) -import StackSet ( StackSet ) +import Control.Monad.State ( gets ) +import Data.List ( sortBy ) hunk ./RotView.hs 14 -import qualified StackSet as W ( stacks, current, visibleWorkspaces, index ) hunk ./RotView.hs 15 -rotView :: Bool -> X () -rotView b = do ws <- gets windowset - let m = W.current ws - vis = W.visibleWorkspaces ws - allws = if b then allWorkspaces ws else reverse $ allWorkspaces ws - pivoted = uncurry (flip (++)) . span (/=m) $ allws - interesting i = not (i `elem` vis) && not (isEmpty i ws) - nextws = listToMaybe . filter interesting $ pivoted - whenJust nextws view +import XMonad +import StackSet +import qualified Operations as O hunk ./RotView.hs 19 --- | A list of all the workspaces. -allWorkspaces :: StackSet WorkspaceId j a -> [WorkspaceId] -allWorkspaces = M.keys . W.stacks +rotView :: Bool -> X () +rotView b = do + ws <- gets windowset + let m = tag . workspace . current $ ws + sortWs = sortBy (\x y -> compare (tag x) (tag y)) + pivoted = uncurry (flip (++)) . span ((< m) . tag) . sortWs . hidden $ ws + nextws = listToMaybe . filter (not.isEmpty) . (if b then id else reverse) $ pivoted + whenJust nextws (O.view . tag) hunk ./RotView.hs 28 -isEmpty :: WorkspaceId -> StackSet WorkspaceId j a -> Bool -isEmpty i = maybe True null . W.index i +isEmpty :: Workspace i a -> Bool +isEmpty ws = case stack ws of + Empty -> True + _ -> False addfile ./Spiral.hs hunk ./Spiral.hs 1 +module Spiral (spiral) where + +import Graphics.X11.Xlib +import Operations +import Data.Ratio +import XMonad + +-- +-- Spiral layout +-- +-- eg, +-- defaultLayouts :: [Layout] +-- defaultLayouts = [ full, +-- tall defaultWindowsInMaster defaultDelta (1%2), +-- wide defaultWindowsInMaster defaultDelta (1%2), +-- spiral (1000 % 1618) ] +-- +spiral :: Rational -> Layout +spiral rat = Layout { doLayout = \sc ws -> return $ zip ws (divideRects rat (length ws) East $ sc), + modifyLayout = \m -> fmap resize (fromMessage m)} + + where resize Expand = let newRat = ((numerator rat + 10) % (denominator rat)) + normRat = if numerator newRat > denominator newRat then rat else newRat in + spiral normRat + resize Shrink = let newRat = ((numerator rat - 10) % (denominator rat)) + normRat = if numerator newRat < 0 then rat else newRat in + spiral normRat + +data Direction = East | South | West | North + +nextDir :: Direction -> Direction +nextDir East = South +nextDir South = West +nextDir West = North +nextDir North = East + +divideRects :: Rational -> Int -> Direction -> Rectangle -> [Rectangle] +divideRects r n dir rect | n <= 1 = [rect] + | otherwise = case divideRect r dir rect of + (r1, r2) -> r1 : (divideRects r (n - 1) (nextDir dir) r2) + +divideRect :: Rational -> Direction -> Rectangle -> (Rectangle, Rectangle) +divideRect ratio East (Rectangle x y w h) = let (w1, w2) = chop ratio (fromIntegral w) in + (Rectangle x y (fromIntegral w1) h, + Rectangle (x + (fromIntegral w1)) y (fromIntegral w2) h) +divideRect ratio South (Rectangle x y w h) = let (h1, h2) = chop ratio (fromIntegral h) in + (Rectangle x y w (fromIntegral h1), + Rectangle x (y + (fromIntegral h1)) w (fromIntegral h2)) +divideRect ratio West (Rectangle x y w h) = let (w1, w2) = chop (1 - ratio) (fromIntegral w) in + (Rectangle (x + (fromIntegral w1)) y (fromIntegral w2) h, + Rectangle x y (fromIntegral w1) h) +divideRect ratio North (Rectangle x y w h) = let (h1, h2) = chop (1 - ratio) (fromIntegral h) in + (Rectangle x (y + (fromIntegral h1)) w (fromIntegral h2), + Rectangle x y w (fromIntegral h1)) + +chop :: Rational -> Integer -> (Integer, Integer) +chop rat n = let f = ((fromIntegral n) * (numerator rat)) `div` (denominator rat) in + (f, n - f) hunk ./Spiral.hs 1 -module Spiral (spiral) where +module XMonadContrib.Spiral (spiral) where hunk ./SwapFocus.hs 1 -module XMonadContrib.SwapFocus ( swapFocus ) where - --- swaps focus with last-focussed window. - --- To use: --- import XMonadContrib.SwapFocus ( swapFocus ) - --- , ((modMask .|. shiftMask, xK_Tab), swapFocus) - -import Control.Monad.State - -import Operations ( refresh ) -import XMonad ( X, WindowSet, windowset ) -import StackSet ( StackSet, peekStack, popFocus, pushFocus, current ) - -sf :: (Integral i, Integral j, Ord a) => StackSet i j a -> Maybe (StackSet i j a) -sf w = do let i = current w - f1 <- peekStack i w - f2 <- peekStack i $ popFocus i f1 w - return $ pushFocus i f2 $ pushFocus i f1 w - -swapFocus :: X () -swapFocus = smartwindows sf - --- | smartwindows. Modify the current window list with a pure function, and only refresh if necesary -smartwindows :: (WindowSet -> Maybe WindowSet) -> X () -smartwindows f = do w <- gets windowset - case (f w) of Just f' -> do modify $ \s -> s { windowset = f' } - refresh - Nothing -> return () rmfile ./SwapFocus.hs hunk ./Mosaic.hs 29 -import Control.Monad.Reader ( asks ) -import Control.Monad.State ( gets ) -import qualified StackSet as W ( peek ) hunk ./Mosaic.hs 31 -import Graphics.X11.Xlib.Extras ( fetchName ) hunk ./Mosaic.hs 38 +import XMonadContrib.NamedWindows + hunk ./Mosaic.hs 92 -data NamedWindow = NW !String !Window -instance Eq NamedWindow where - (NW s _) == (NW s' _) = s == s' -instance Ord NamedWindow where - compare (NW s _) (NW s' _) = compare s s' - hunk ./Mosaic.hs 191 -getName :: Window -> X NamedWindow -getName w = asks display >>= \d -> do n <- maybe "" id `fmap` io (fetchName d w) - return $ NW n w - -unName :: NamedWindow -> Window -unName (NW _ w) = w - -withNamedWindow :: (NamedWindow -> X ()) -> X () -withNamedWindow f = do ws <- gets windowset - whenJust (W.peek ws) $ \w -> getName w >>= f - addfile ./NamedWindows.hs hunk ./NamedWindows.hs 1 +module XMonadContrib.NamedWindows ( NamedWindow, getName, withNamedWindow, unName ) where + +-- This module allows you to associate the X titles of windows with +-- them. See XMonadContrib.Mosaic for an example of its use. + +import Control.Monad.Reader ( asks ) +import Control.Monad.State ( gets ) + +import qualified StackSet as W ( peek ) + +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras ( fetchName ) + +import XMonad + +data NamedWindow = NW !String !Window +instance Eq NamedWindow where + (NW s _) == (NW s' _) = s == s' +instance Ord NamedWindow where + compare (NW s _) (NW s' _) = compare s s' + +getName :: Window -> X NamedWindow +getName w = asks display >>= \d -> do n <- maybe "" id `fmap` io (fetchName d w) + return $ NW n w + +unName :: NamedWindow -> Window +unName (NW _ w) = w + +withNamedWindow :: (NamedWindow -> X ()) -> X () +withNamedWindow f = do ws <- gets windowset + whenJust (W.peek ws) $ \w -> getName w >>= f addfile ./Dzen.hs hunk ./Dzen.hs 1 +module XMonadContrib.Dzen (dzen, dzenScreen) where + +import System.Posix.Process (forkProcess, getProcessStatus, createSession) +import System.IO +import System.Process +import System.Exit +import Control.Concurrent (threadDelay) +import Control.Monad.State + +import qualified StackSet as W +import XMonad + +-- 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 + -- output <- hGetContents pout + -- when (output==output) $ return () + hClose pout + hClose perr + waitForProcess ph + return () + exitWith ExitSuccess + return () + getProcessStatus True False pid + return () + + +curScreen :: X ScreenId +curScreen = (W.screen . W.current) `liftM` gets windowset + +toXineramaArg :: ScreenId -> String +toXineramaArg n = show ( ((fromIntegral n)+1)::Int ) + +-- requires glasser's xinerama patch to dzen + +dzen :: String -> X () +dzen str = curScreen >>= \sc -> dzenScreen sc str + +dzenScreen :: ScreenId -> String -> X() +dzenScreen sc str = io $ (runProcessWithInputAndWait "dzen2" ["-xs", screen] str 5000000) + where screen = toXineramaArg sc hunk ./NamedWindows.hs 1 -module XMonadContrib.NamedWindows ( NamedWindow, getName, withNamedWindow, unName ) where +module XMonadContrib.NamedWindows ( NamedWindow, getName, withNamedWindow, unName, name ) where hunk ./NamedWindows.hs 29 +name :: NamedWindow -> String +name (NW n _) = n + hunk ./Spiral.hs 1 -module XMonadContrib.Spiral (spiral) where +module XMonadContrib.Spiral (spiral, fibSpiral) where hunk ./Spiral.hs 19 -spiral rat = Layout { doLayout = \sc ws -> return $ zip ws (divideRects rat (length ws) East $ sc), +spiral rat = Layout { doLayout = \sc ws -> return $ zip ws (divideRects (repeat rat) (length ws) East $ sc), hunk ./Spiral.hs 29 +fibs :: [Integer] +fibs = 1 : 1 : (zipWith (+) fibs (tail fibs)) + +fibRatios :: [Rational] +fibRatios = ratios fibs + where + ratios (x:y:rs) = (x % y) : ratios (y:rs) + ratios _ = [] + +fibSpiral :: Rational -> Layout +fibSpiral scale = Layout { doLayout = fibLayout, + modifyLayout = \m -> fmap resize (fromMessage m) } + where + fibLayout sc ws = return $ zip ws (divideRects (map (* scale) . reverse . take len $ fibRatios) len East sc) + where len = length ws + resize Expand = fibSpiral $ (11 % 10) * scale + resize Shrink = fibSpiral $ (10 % 11) * scale + hunk ./Spiral.hs 55 -divideRects :: Rational -> Int -> Direction -> Rectangle -> [Rectangle] -divideRects r n dir rect | n <= 1 = [rect] - | otherwise = case divideRect r dir rect of - (r1, r2) -> r1 : (divideRects r (n - 1) (nextDir dir) r2) +divideRects :: [Rational] -> Int -> Direction -> Rectangle -> [Rectangle] +divideRects [] _ _ _ = [] +divideRects (r:rs) n dir rect | n <= 1 = [rect] + | otherwise = case divideRect r dir rect of + (r1, r2) -> r1 : (divideRects rs (n - 1) (nextDir dir) r2) hunk ./Spiral.hs 1 -module XMonadContrib.Spiral (spiral, fibSpiral) where +module XMonadContrib.Spiral (spiral) where hunk ./Spiral.hs 16 --- spiral (1000 % 1618) ] +-- spiral (1 % 1) ] hunk ./Spiral.hs 18 -spiral :: Rational -> Layout -spiral rat = Layout { doLayout = \sc ws -> return $ zip ws (divideRects (repeat rat) (length ws) East $ sc), - modifyLayout = \m -> fmap resize (fromMessage m)} - - where resize Expand = let newRat = ((numerator rat + 10) % (denominator rat)) - normRat = if numerator newRat > denominator newRat then rat else newRat in - spiral normRat - resize Shrink = let newRat = ((numerator rat - 10) % (denominator rat)) - normRat = if numerator newRat < 0 then rat else newRat in - spiral normRat - hunk ./Spiral.hs 27 -fibSpiral :: Rational -> Layout -fibSpiral scale = Layout { doLayout = fibLayout, +spiral :: Rational -> Layout +spiral scale = Layout { doLayout = fibLayout, hunk ./Spiral.hs 33 - resize Expand = fibSpiral $ (11 % 10) * scale - resize Shrink = fibSpiral $ (10 % 11) * scale + resize Expand = spiral $ (11 % 10) * scale + resize Shrink = spiral $ (10 % 11) * scale hunk ./Spiral.hs 21 -fibRatios :: [Rational] -fibRatios = ratios fibs - where - ratios (x:y:rs) = (x % y) : ratios (y:rs) - ratios _ = [] +mkRatios :: [Integer] -> [Rational] +mkRatios (x1:x2:xs) = (x1 % x2) : mkRatios (x2:xs) +mkRatios _ = [] hunk ./Spiral.hs 27 - modifyLayout = \m -> fmap resize (fromMessage m) } + modifyLayout = \m -> fmap resize (fromMessage m) } hunk ./Spiral.hs 29 - fibLayout sc ws = return $ zip ws (divideRects (map (* scale) . reverse . take len $ fibRatios) len East sc) + fibLayout sc ws = return $ zip ws rects hunk ./Spiral.hs 31 + ratios = map (* scale) . reverse . take len . mkRatios $ fibs + rects = divideRects ratios len East sc + hunk ./Spiral.hs 25 +data Direction = East | South | West | North deriving (Enum) + hunk ./Spiral.hs 34 - rects = divideRects ratios len East sc - - resize Expand = spiral $ (11 % 10) * scale - resize Shrink = spiral $ (10 % 11) * scale - -data Direction = East | South | West | North + rects = divideRects ratios (cycle [East .. North]) len sc hunk ./Spiral.hs 36 -nextDir :: Direction -> Direction -nextDir East = South -nextDir South = West -nextDir West = North -nextDir North = East + resize Expand = spiral $ (21 % 20) * scale + resize Shrink = spiral $ (20 % 21) * scale hunk ./Spiral.hs 39 -divideRects :: [Rational] -> Int -> Direction -> Rectangle -> [Rectangle] +divideRects :: [Rational] -> [Direction] -> Int -> Rectangle -> [Rectangle] hunk ./Spiral.hs 41 -divideRects (r:rs) n dir rect | n <= 1 = [rect] - | otherwise = case divideRect r dir rect of - (r1, r2) -> r1 : (divideRects rs (n - 1) (nextDir dir) r2) +divideRects _ [] _ _ = [] +divideRects (r:rs) (d:ds) n rect | n <= 1 = [rect] + | otherwise = case divideRect r d rect of + (r1, r2) -> r1 : (divideRects rs ds (n - 1) r2) hunk ./Spiral.hs 29 - modifyLayout = \m -> fmap resize (fromMessage m) } + modifyLayout = \m -> fmap resize $ fromMessage m } hunk ./Spiral.hs 32 - where len = length ws - ratios = map (* scale) . reverse . take len . mkRatios $ fibs - rects = divideRects ratios (cycle [East .. North]) len sc + where ratios = map (* scale) . reverse . take (length ws) . mkRatios $ fibs + rects = divideRects (zip ratios (cycle [East .. North])) sc hunk ./Spiral.hs 38 -divideRects :: [Rational] -> [Direction] -> Int -> Rectangle -> [Rectangle] -divideRects [] _ _ _ = [] -divideRects _ [] _ _ = [] -divideRects (r:rs) (d:ds) n rect | n <= 1 = [rect] - | otherwise = case divideRect r d rect of - (r1, r2) -> r1 : (divideRects rs ds (n - 1) r2) +divideRects :: [(Rational, Direction)] -> Rectangle -> [Rectangle] +divideRects [] _ = [] +divideRects ((r,d):xs) rect = case divideRect r d rect of + (r1, r2) -> r1 : (divideRects xs r2) + +-- It's much simpler if we work with all Integers and convert to +-- Rectangle at the end. +data Rect = Rect Integer Integer Integer Integer + +fromRect :: Rect -> Rectangle +fromRect (Rect x y w h) = Rectangle (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) + +toRect :: Rectangle -> Rect +toRect (Rectangle x y w h) = Rect (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) hunk ./Spiral.hs 54 -divideRect ratio East (Rectangle x y w h) = let (w1, w2) = chop ratio (fromIntegral w) in - (Rectangle x y (fromIntegral w1) h, - Rectangle (x + (fromIntegral w1)) y (fromIntegral w2) h) -divideRect ratio South (Rectangle x y w h) = let (h1, h2) = chop ratio (fromIntegral h) in - (Rectangle x y w (fromIntegral h1), - Rectangle x (y + (fromIntegral h1)) w (fromIntegral h2)) -divideRect ratio West (Rectangle x y w h) = let (w1, w2) = chop (1 - ratio) (fromIntegral w) in - (Rectangle (x + (fromIntegral w1)) y (fromIntegral w2) h, - Rectangle x y (fromIntegral w1) h) -divideRect ratio North (Rectangle x y w h) = let (h1, h2) = chop (1 - ratio) (fromIntegral h) in - (Rectangle x (y + (fromIntegral h1)) w (fromIntegral h2), - Rectangle x y w (fromIntegral h1)) +divideRect r d rect = let (r1, r2) = divideRect' r d $ toRect rect in + (fromRect r1, fromRect r2) + +divideRect' :: Rational -> Direction -> Rect -> (Rect, Rect) +divideRect' ratio dir (Rect x y w h) = + case dir of + East -> let (w1, w2) = chop ratio w in (Rect x y w1 h, Rect (x + w1) y w2 h) + South -> let (h1, h2) = chop ratio h in (Rect x y w h1, Rect x (y + h1) w h2) + West -> let (w1, w2) = chop (1 - ratio) w in (Rect (x + w1) y w2 h, Rect x y w1 h) + North -> let (h1, h2) = chop (1 - ratio) h in (Rect x (y + h1) w h2, Rect x y w h1) hunk ./Spiral.hs 40 +divideRects [_] r = [r] hunk ./Spiral.hs 27 +blend :: Rational -> [Rational] -> [Rational] +blend scale ratios = zipWith (+) ratios scaleFactors + where + len = length ratios + step = (scale - (1 % 1)) / (fromIntegral len) + scaleFactors = map (* step) . reverse . take len $ [0..] + hunk ./Spiral.hs 39 - where ratios = map (* scale) . reverse . take (length ws) . mkRatios $ fibs + where ratios = blend scale . reverse . take (length ws - 1) . mkRatios $ tail fibs hunk ./Spiral.hs 45 +-- This will produce one more rectangle than there are splits details hunk ./Spiral.hs 47 -divideRects [] _ = [] -divideRects [_] r = [r] +divideRects [] r = [r] hunk ./NamedWindows.hs 1 -module XMonadContrib.NamedWindows ( NamedWindow, getName, withNamedWindow, unName, name ) where +module XMonadContrib.NamedWindows ( NamedWindow, getName, withNamedWindow, unName ) where hunk ./NamedWindows.hs 21 +instance Show NamedWindow where + show (NW n _) = n hunk ./NamedWindows.hs 31 -name :: NamedWindow -> String -name (NW n _) = n - hunk ./Rescreen.hs 1 --- Grabs new screen information. Useful for randr setups. --- To use rescreen, add a keybinding in Config.hs. For example: --- , ((modMask .|. shiftMask, xK_F12 ), rescreen) - --- TODO Get this code into xmonad when it is ready for randr support. --- Make it happen automatically on randr events. It's currently 20 loc, but I --- believe it can be shrunk a bit. - -module XMonadContrib.Rescreen (rescreen) where - -import qualified StackSet as W -import XMonad -import Operations - -import Graphics.X11.Xlib -import Graphics.X11.Xinerama - -import Control.Monad.State -import Control.Monad.Reader -import Data.List (partition) - -rescreen :: X () -rescreen = do - dpy <- asks display - xinesc <- io $ getScreenInfo dpy - -- TODO: This stuff is necessary because Xlib apparently caches screen - -- width/height. Find a better solution later. I hate Xlib. - let sx = maximum $ map (\r -> rect_x r + fromIntegral (rect_width r)) xinesc - sy = maximum $ map (\r -> rect_y r + fromIntegral (rect_height r)) xinesc - modify (\s -> s { xineScreens = xinesc, dimensions = (sx, sy) }) - ws <- gets windowset - let s = W.current ws : W.visible ws - t = zipWith const [0 :: ScreenId ..] xinesc - (stay, hide) = partition (\x -> fromIntegral (W.screen x) < length t) s - newsids = filter (\x -> fromIntegral x >= length s) t - (newvis, newinvis) = splitAt (length newsids) (map W.workspace hide ++ W.hidden ws) - (newcurr : xs) = stay ++ zipWith W.Screen newvis newsids - windows $ const $ ws { W.current = newcurr - , W.visible = xs - , W.hidden = newinvis - } rmfile ./Rescreen.hs hunk ./Dzen.hs 42 --- requires glasser's xinerama patch to dzen +-- Requires dzen >= 0.2.4. addfile ./Commands.hs hunk ./Commands.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Commands +-- Copyright : (c) David Glasser 2007 +-- +-- Maintainer : glasser@mit.edu +-- Stability : stable +-- Portability : portable +-- +----------------------------------------------------------------------------- +-- +-- Allows you to run internal xmonad commands (X () actions) using +-- a dmenu menu in addition to key bindings. Requires dmenu and +-- the Dmenu XMonadContrib module. +-- +-- To use, modify your Config.hs to: +-- +-- import XMonadContrib.Commands +-- +-- and add a keybinding to the runCommand action: +-- +-- , ((modMask .|. controlMask, xK_y), runCommand) +-- +-- and define the list commands: +-- +-- commands = defaultCommands +-- +-- Finally, add the following lines to Config.hs-boot: +-- +-- import XMonad (X) +-- workspaces :: Int +-- commands :: [(String, X ())] +-- +-- A popup menu of internal xmonad commands will appear. You can +-- change the commands by changing the contents of the list +-- 'commands'. (If you like it enough, you may even want to get rid +-- of many of your other key bindings!) + +module XMonadContrib.Commands where + +import XMonad +import Operations +import {-# SOURCE #-} Config (workspaces, commands) +import XMonadContrib.Dmenu (dmenu) + +import qualified Data.Map as M +import System.Exit +import Data.Maybe + +commandMap :: M.Map String (X ()) +commandMap = M.fromList commands + +workspaceCommands :: [(String, X ())] +workspaceCommands = [((m ++ show i), f i) + | i <- [0 .. fromIntegral workspaces - 1] + , (f, m) <- [(view, "view"), (shift, "shift")] + ] + +screenCommands :: [(String, X ())] +screenCommands = [((m ++ show sc), screenWorkspace sc >>= f) + | sc <- [0, 1] -- TODO: adapt to screen changes + , (f, m) <- [(view, "screen"), (shift, "screen-to-")] + ] + +defaultCommands :: [(String, X ())] +defaultCommands = workspaceCommands ++ screenCommands + ++ [ ("shrink", sendMessage Shrink) + , ("expand", sendMessage Expand) + , ("restart-wm", restart Nothing True) + , ("restart-wm-no-resume", restart Nothing False) + , ("layout", switchLayout) + , ("xterm", spawn "xterm") + , ("run", spawn "exe=`dmenu_path | dmenu -b` && exec $exe") + , ("kill", kill) + , ("refresh", refresh) + , ("focus-up", focusUp) + , ("focus-down", focusDown) + , ("swap-up", swapUp) + , ("swap-down", swapDown) + , ("swap-master", swapMaster) + , ("sink", withFocused sink) + , ("quit-wm", io $ exitWith ExitSuccess) + ] + +runCommand :: X () +runCommand = do + choice <- dmenu (M.keys commandMap) + fromMaybe (return ()) (M.lookup choice commandMap) hunk ./Commands.hs 54 -workspaceCommands = [((m ++ show i), f i) - | i <- [0 .. fromIntegral workspaces - 1] +workspaceCommands = [((m ++ show i), f (fromIntegral i)) + | i <- [0 .. workspaces - 1] hunk ./Commands.hs 60 -screenCommands = [((m ++ show sc), screenWorkspace sc >>= f) - | sc <- [0, 1] -- TODO: adapt to screen changes +screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= f) + | sc <- [0, 1]::[Int] -- TODO: adapt to screen changes addfile ./Warp.hs hunk ./Warp.hs 1 +module XMonadContrib.Warp where + +{- Usage: + - This can be used to make a keybinding that warps the pointer to a given + - window or screen. For example, I've added the following keybindings to + - my Config.hs: + - + - , ((modMask, xK_z ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window + - + - -- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3 + - ++ + - [((modMask .|. controlMask, key), warpToScreen sc (1%2) (1%2)) + - | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]] + - + - Note that warping to a particular screen may change the focus. + -} + +import Data.Ratio +import Data.Maybe +import Control.Monad.RWS +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras +import Operations +import XMonad + +fraction :: (Integral a, Integral b) => Rational -> a -> b +fraction f x = floor (f * fromIntegral x) + +ix :: Int -> [a] -> Maybe a +ix n = listToMaybe . take 1 . drop n + +warp :: Window -> Position -> Position -> X () +warp w x y = withDisplay $ \d -> io $ warpPointer d none w 0 0 0 0 x y + +warpToWindow :: Rational -> Rational -> X () +warpToWindow h v = + withDisplay $ \d -> + withFocused $ \w -> do + wa <- io $ getWindowAttributes d w + warp w (fraction h (wa_width wa)) (fraction v (wa_height wa)) + +warpToScreen :: Int -> Rational -> Rational -> X () +warpToScreen n h v = do + xScreens <- gets xineScreens + root <- asks theRoot + whenJust (ix n xScreens) $ \r -> + warp root (rect_x r + fraction h (rect_width r)) + (rect_y r + fraction v (rect_height r)) addfile ./ReadMap.hs hunk ./ReadMap.hs 1 +module XMonadContrib.ReadMap () where + +{- An instance of Read for Data.Map.Map's; useful for people that are still + - compiling under 6.4. To use it, add the following line to StackSet.hs: + - import XMonadContrib.ReadMap + -} + +import Data.Map (Map, fromList) +import GHC.Read + +instance (Ord k, Read k, Read e) => Read (Map k e) where + readsPrec _ = \s1 -> do + ("{", s2) <- lex s1 + (xs, s3) <- readPairs s2 + ("}", s4) <- lex s3 + return (fromList xs, s4) + +-- parses a pair of things with the syntax a:=b +-- stolen from the GHC 6.6 sources +readPair :: (Read a, Read b) => ReadS (a,b) +readPair s = do (a, ct1) <- reads s + (":=", ct2) <- lex ct1 + (b, ct3) <- reads ct2 + return ((a,b), ct3) + +readPairs :: (Read a, Read b) => ReadS [(a,b)] +readPairs s1 = case readPair s1 of + [(p, s2)] -> case s2 of + (',':s3) -> do + (ps, s4) <- readPairs s3 + return (p:ps, s4) + _ -> [([p], s2)] + _ -> [([],s1)] move ./ReadMap.hs ./BackCompat.hs hunk ./BackCompat.hs 1 -module XMonadContrib.ReadMap () where +module XMonadContrib.BackCompat (forM, forM_) where hunk ./BackCompat.hs 3 -{- An instance of Read for Data.Map.Map's; useful for people that are still - - compiling under 6.4. To use it, add the following line to StackSet.hs: - - import XMonadContrib.ReadMap +{- This file will contain all the things GHC 6.4 users need to compile xmonad. + - Currently, the steps to get compilation are: + - add the following line to StackSet.hs, Operations.hs, and Main.hs: + - import XMonadContrib.BackCompat hunk ./BackCompat.hs 12 +forM_ :: (Monad m) => [a] -> (a -> m b) -> m () +forM_ = flip mapM_ + +-- not used yet, but just in case +forM :: (Monad m) => [a] -> (a -> m b) -> m [b] +forM = flip mapM + addfile ./HintedTile.hs hunk ./HintedTile.hs 1 +module XMonadContrib.HintedTile (tall, wide) where + +import XMonad +import Operations (Resize(..), IncMasterN(..), applySizeHints) +import {-# SOURCE #-} Config (borderWidth) +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras +import Control.Monad + +-- this sucks +addBorder, substractBorder :: (Dimension, Dimension) -> (Dimension, Dimension) +addBorder (w, h) = (w + 2 * borderWidth, h + 2 * borderWidth) +substractBorder (w, h) = (w - 2 * borderWidth, h - 2 * borderWidth) + + +tall, wide :: Int -> Rational -> Rational -> Layout +wide = tile splitVertically divideHorizontally +tall = tile splitHorizontally divideVertically + +tile split divide nmaster delta frac = + Layout { doLayout = \r w -> do { hints <- sequence (map getHints w) + ; return $ zip w (tiler frac r `uncurry` splitAt nmaster hints) } + , modifyLayout = \m -> fmap resize (fromMessage m) `mplus` + fmap incmastern (fromMessage m) } + + where resize Shrink = tile split divide nmaster delta (frac-delta) + resize Expand = tile split divide nmaster delta (frac+delta) + incmastern (IncMasterN d) = tile split divide (max 0 (nmaster+d)) delta frac + + tiler f r masters slaves = if null masters || null slaves + then divide (masters ++ slaves) r + else split f r (divide masters) (divide slaves) + +getHints :: Window -> X SizeHints +getHints w = withDisplay $ \d -> io $ getWMNormalHints d w + +-- +-- Divide the screen vertically (horizontally) into n subrectangles +-- +divideVertically, divideHorizontally :: [SizeHints] -> Rectangle -> [Rectangle] +divideVertically [] _ = [] -- there's a fold here, struggling to get out +divideVertically (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : + (divideVertically rest (Rectangle sx (sy + fromIntegral h) sw (sh - h))) + where (w, h) = addBorder $ applySizeHints hints $ substractBorder + (sw, sh `div` fromIntegral (1 + (length rest))) + +divideHorizontally [] _ = [] +divideHorizontally (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : + (divideHorizontally rest (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) + where (w, h) = addBorder $ applySizeHints hints $ substractBorder + (sw `div` fromIntegral (1 + (length rest)), sh) + + +-- Split the screen into two rectangles, using a rational to specify the ratio +splitHorizontally, splitVertically :: Rational -> Rectangle -> (Rectangle -> [Rectangle]) -> (Rectangle -> [Rectangle]) -> [Rectangle] +splitHorizontally f (Rectangle sx sy sw sh) left right = leftRects ++ rightRects + where leftw = floor $ fromIntegral sw * f + leftRects = left $ Rectangle sx sy leftw sh + rightx = (maximum . map rect_width) leftRects + rightRects = right $ Rectangle (sx + fromIntegral rightx) sy (sw - rightx) sh + +splitVertically f (Rectangle sx sy sw sh) top bottom = topRects ++ bottomRects + where toph = floor $ fromIntegral sh * f + topRects = top $ Rectangle sx sy sw toph + bottomy = (maximum . map rect_height) topRects + bottomRects = bottom $ Rectangle sx (sy + fromIntegral bottomy) sw (sh - bottomy) adddir ./scripts addfile ./scripts/xmonad-status.hs hunk ./scripts/xmonad-status.hs 1 +{-# OPTIONS -fglasgow-exts #-} +----------------------------------------------------------------------------- +-- | +-- Module : xmonad-status.hs +-- Copyright : (c) Don Stewart 2007 +-- License : BSD3-style +-- Maintainer : dons@cse.unsw.edu.au +-- +-- An external statusbar-client for xmonad. +-- +-- Prints the workspaces in a simple form, read from the logging output +-- of xmonad. +-- +-- An example use: +-- +-- xmonad | mux | dzen2 -ta l -fg '#a8a3f7' -bg '#3f3c6d' +-- +-- Creates a workspace table on the left side of the screen. +-- +-- A version that perfectly emulates wmii or dwm could be distributed. +-- +----------------------------------------------------------------------------- + +import Data.List +import StackSet +import XMonad +import System.IO +import Text.PrettyPrint +import Graphics.X11.Types (Window) + +-- +-- parse the StackSet output, and print it in the form: +-- +-- *[1] 2 *3 *4 5 6 7 8 +-- +-- It's an example of how to write a Haskell script to hack +-- the structure defined in StackSet.hs +-- + +main = forever $ getLine >>= readIO >>= draw + where + forever a = a >> forever a + +-- +-- All the magic is in the 'ppr' instances, below. +-- +draw :: WindowSet -> IO () +draw s = do putStrLn . render . ppr $ s + hFlush stdout + +-- --------------------------------------------------------------------- +-- +-- A simple recursive descent pretty printer for the StackSet type. +-- +class Pretty a where + ppr :: a -> Doc + +-- +-- And instances for the StackSet layers +-- +instance Pretty WindowSet where + ppr (StackSet { current = cws -- the different workspaces + , visible = vws + , hidden = hws }) = ppr (sortBy tags workspaces) + where + -- tag each workspace with its flavour + workspaces = C (workspace cws) : map (V . workspace) vws ++ map H hws + + -- sort them by their tags + tags a b = (tag.unWrap) a `compare` (tag.unWrap) b + +-- +-- How to print each workspace kind +-- +instance Pretty TaggedW where + ppr (C w) = brackets (ppr w) -- [1] + ppr (V w) = parens (ppr w) -- <2> + ppr (H w) = char ' ' <> ppr w <> char ' ' -- 3 + +-- tags are printed as integers (or map them to strings) +instance Pretty W where +-- Just print int tags: + ppr (Workspace i s) = int (1 + fromIntegral i) <> ppr s + +{- + ppr (Workspace i s) = + hcat [ppr s + ,int (1 + fromIntegral i) + ,char ':' + ,text tag] + where + tag | Just t <- lookup i tags = t + | otherwise = "dev" + + tags = zip [0..8] ["irc","web","ghc"] +-} + + +-- non-empty stacks get a '*' +instance Pretty (Stack Window) where + ppr Empty = empty + ppr _ = char '*' + +-- lists are printed with whitespace +instance Pretty a => Pretty [a] where + ppr [] = empty + ppr (x:xs) = ppr x <> ppr xs + + +-- --------------------------------------------------------------------- +-- Some type information for the pretty printer + +-- We have a fixed workspace type +type W = Workspace WorkspaceId Window + +-- Introduce a newtype to distinguish different workspace flavours +data TaggedW = C W -- current + | V W -- visible + | H W -- hidden + +-- And the ability to unwrap tagged workspaces +unWrap :: TaggedW -> W +unWrap (C w) = w +unWrap (V w) = w +unWrap (H w) = w hunk ./scripts/xmonad-status.hs 16 --- xmonad | mux | dzen2 -ta l -fg '#a8a3f7' -bg '#3f3c6d' +-- xmonad | xmonad-status | dzen2 -ta l -fg '#a8a3f7' -bg '#3f3c6d' addfile ./scripts/xmonad-dynamic-workspaces.hs hunk ./scripts/xmonad-dynamic-workspaces.hs 1 +{-# OPTIONS -fglasgow-exts #-} +----------------------------------------------------------------------------- +-- | +-- Module : xmonad-status.hs +-- Copyright : (c) Don Stewart 2007 +-- License : BSD3-style +-- Maintainer : dons@cse.unsw.edu.au +-- +-- An external statusbar-client for xmonad. +-- +-- Prints the workspaces in a simple form, read from the logging output +-- of xmonad. +-- +-- An example use: +-- +-- +-- #!/bin/sh +-- # +-- # launch xmonad, with a couple of dzens to run the status bar +-- # send xmonad state over a named pipe +-- # +-- FG='#a8a3f7' +-- BG='#3f3c6d' +-- FONT="-xos4-terminus-medium-r-normal--16-160-72-72-c-80-iso8859-1" +-- +-- PATH=/home/dons/bin:$PATH +-- +-- # clean up and old status bar pipe +-- rm -f ~/.xmonad.pipe +-- +-- # create a new one +-- /sbin/mkfifo -m 600 ~/.xmonad.pipe +-- +-- xmonad-status < ~/.xmonad.pipe | dzen2 -ta l -fg $FG -bg $BG -fn $FONT & +-- exec xmonad > ~/.xmonad.pipe +-- +-- Creates a workspace table on the left side of the screen. +-- +-- A version that perfectly emulates wmii or dwm could be distributed. +-- +----------------------------------------------------------------------------- + +import Data.List +import StackSet +import XMonad +import System.IO +import Text.PrettyPrint +import Graphics.X11.Types (Window) + +-- +-- parse the StackSet output, and print it in the form: +-- +-- *[1] 2 *3 *4 5 6 7 8 +-- +-- It's an example of how to write a Haskell script to hack +-- the structure defined in StackSet.hs +-- + +main = forever $ getLine >>= readIO >>= draw + where + forever a = a >> forever a + +-- +-- All the magic is in the 'ppr' instances, below. +-- +draw :: WindowSet -> IO () +draw s = do putStrLn . render . ppr $ s + hFlush stdout + +-- --------------------------------------------------------------------- +-- +-- A simple recursive descent pretty printer for the StackSet type. +-- +class Pretty a where + ppr :: a -> Doc + +-- +-- And instances for the StackSet layers +-- +instance Pretty WindowSet where + ppr (StackSet { current = cws -- the different workspaces + , visible = vws + , hidden = hws }) = ppr (sortBy tags workspaces) + where + -- tag each workspace with its flavour + workspaces = C (workspace cws) : map (V . workspace) vws ++ map H hws + + -- sort them by their tags + tags a b = (tag.unWrap) a `compare` (tag.unWrap) b + +-- +-- How to print each workspace kind +-- +instance Pretty TaggedW where + ppr (C w) = brackets (int (1 + fromIntegral (tag w))) -- [1] + ppr (V w) = parens (ppr w) -- <2> + ppr (H w) = char ' ' <> ppr w <> char ' ' -- 3 + +-- tags are printed as integers (or map them to strings) +instance Pretty W where +-- Just print int tags: + ppr (Workspace i s) = + case s of + Empty -> empty + _ -> int (1 + fromIntegral i) + +instance Pretty a => Pretty [a] where + ppr [] = empty + ppr (x:xs) = ppr x <> ppr xs + + +-- --------------------------------------------------------------------- +-- Some type information for the pretty printer + +-- We have a fixed workspace type +type W = Workspace WorkspaceId Window + +-- Introduce a newtype to distinguish different workspace flavours +data TaggedW = C W -- current + | V W -- visible + | H W -- hidden + +-- And the ability to unwrap tagged workspaces +unWrap :: TaggedW -> W +unWrap (C w) = w +unWrap (V w) = w +unWrap (H w) = w hunk ./scripts/xmonad-dynamic-workspaces.hs 48 -import Graphics.X11.Types (Window) hunk ./scripts/xmonad-dynamic-workspaces.hs 65 -draw :: WindowSet -> IO () +draw :: WS -> IO () hunk ./scripts/xmonad-dynamic-workspaces.hs 79 -instance Pretty WindowSet where +instance Pretty WS where hunk ./scripts/xmonad-dynamic-workspaces.hs 96 - ppr (H w) = char ' ' <> ppr w <> char ' ' -- 3 + ppr (H w) = ppr w hunk ./scripts/xmonad-dynamic-workspaces.hs 104 - _ -> int (1 + fromIntegral i) + _ -> char ' ' <> int (1 + fromIntegral i) <> char ' ' hunk ./scripts/xmonad-dynamic-workspaces.hs 115 -type W = Workspace WorkspaceId Window +type W = Workspace WorkspaceId Int +type WS = StackSet WorkspaceId Int ScreenId addfile ./Submap.hs hunk ./Submap.hs 1 +{- +Allows you to create a sub-mapping of keys. Example: + + , ((modMask, xK_a), submap . M.fromList $ + [ ((0, xK_n), spawn "mpc next") + , ((0, xK_p), spawn "mpc prev") + , ((0, xK_z), spawn "mpc random") + , ((0, xK_space), spawn "mpc toggle") + ]) + +So, for example, to run 'spawn "mpc next"', you would hit mod-a (to trigger the +submapping) and then 'n' to run that action. (0 means "no modifier"). You are, +of course, free to use any combination of modifiers in the submapping. However, +anyModifier will not work, because that is a special value passed to XGrabKey() +and not an actual modifier. +-} + +module XMonadContrib.Submap where + +import Control.Monad.Reader + +import XMonad +import Operations (cleanMask) +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras +import qualified Data.Map as M + +submap :: M.Map (KeyMask, KeySym) (X ()) -> X () +submap keys = do + XConf { theRoot = root, display = d } <- ask + + io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime + + keyspec <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do + maskEvent d keyPressMask p + KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p + keysym <- keycodeToKeysym d code 0 + if isModifierKey keysym + then nextkey + else return (cleanMask m, keysym) + + io $ ungrabKeyboard d currentTime + + whenJust (M.lookup keyspec keys) id addfile ./Circle.hs hunk ./Circle.hs 1 +module XMonadContrib.Circle (circle) where -- actually it's an ellipse + +import Graphics.X11.Xlib +import XMonad + +circle :: Layout +circle = Layout { doLayout = circleLayout, + modifyLayout = const Nothing } + +circleLayout :: Rectangle -> [Window] -> X [(Window, Rectangle)] +circleLayout _ [] = return [] +circleLayout r (w:ws) = return $ (w, center r) : (zip ws sats) + where sats = map (satellite r) $ take (length ws) [0, pi * 2 / fromIntegral (length ws) ..] + +center :: Rectangle -> Rectangle +center (Rectangle sx sy sw sh) = Rectangle x y w h + where w = round ((fromIntegral sw / sqrt 2) :: Double) + h = round ((fromIntegral sh / sqrt 2) :: Double) + x = sx + fromIntegral (sw - w) `div` 2 + y = sy + fromIntegral (sh - h) `div` 2 + +satellite :: Rectangle -> Double -> Rectangle +satellite (Rectangle sx sy sw sh) a = Rectangle (sx + round (rx + rx * cos a)) + (sy + round (ry + ry * sin a)) + w h + where rx = fromIntegral (sw - w) / 2 + ry = fromIntegral (sh - h) / 2 + w = sw * 10 `div` 25 + h = sh * 10 `div` 25 + hunk ./scripts/xmonad-status.hs 1 -{-# OPTIONS -fglasgow-exts #-} ------------------------------------------------------------------------------ --- | --- Module : xmonad-status.hs --- Copyright : (c) Don Stewart 2007 --- License : BSD3-style --- Maintainer : dons@cse.unsw.edu.au --- --- An external statusbar-client for xmonad. --- --- Prints the workspaces in a simple form, read from the logging output --- of xmonad. --- --- An example use: --- --- xmonad | xmonad-status | dzen2 -ta l -fg '#a8a3f7' -bg '#3f3c6d' --- --- Creates a workspace table on the left side of the screen. --- --- A version that perfectly emulates wmii or dwm could be distributed. --- ------------------------------------------------------------------------------ - -import Data.List -import StackSet -import XMonad -import System.IO -import Text.PrettyPrint -import Graphics.X11.Types (Window) - --- --- parse the StackSet output, and print it in the form: --- --- *[1] 2 *3 *4 5 6 7 8 --- --- It's an example of how to write a Haskell script to hack --- the structure defined in StackSet.hs --- - -main = forever $ getLine >>= readIO >>= draw - where - forever a = a >> forever a - --- --- All the magic is in the 'ppr' instances, below. --- -draw :: WindowSet -> IO () -draw s = do putStrLn . render . ppr $ s - hFlush stdout - --- --------------------------------------------------------------------- --- --- A simple recursive descent pretty printer for the StackSet type. --- -class Pretty a where - ppr :: a -> Doc - --- --- And instances for the StackSet layers --- -instance Pretty WindowSet where - ppr (StackSet { current = cws -- the different workspaces - , visible = vws - , hidden = hws }) = ppr (sortBy tags workspaces) - where - -- tag each workspace with its flavour - workspaces = C (workspace cws) : map (V . workspace) vws ++ map H hws - - -- sort them by their tags - tags a b = (tag.unWrap) a `compare` (tag.unWrap) b - --- --- How to print each workspace kind --- -instance Pretty TaggedW where - ppr (C w) = brackets (ppr w) -- [1] - ppr (V w) = parens (ppr w) -- <2> - ppr (H w) = char ' ' <> ppr w <> char ' ' -- 3 - --- tags are printed as integers (or map them to strings) -instance Pretty W where --- Just print int tags: - ppr (Workspace i s) = int (1 + fromIntegral i) <> ppr s - -{- - ppr (Workspace i s) = - hcat [ppr s - ,int (1 + fromIntegral i) - ,char ':' - ,text tag] - where - tag | Just t <- lookup i tags = t - | otherwise = "dev" - - tags = zip [0..8] ["irc","web","ghc"] --} - - --- non-empty stacks get a '*' -instance Pretty (Stack Window) where - ppr Empty = empty - ppr _ = char '*' - --- lists are printed with whitespace -instance Pretty a => Pretty [a] where - ppr [] = empty - ppr (x:xs) = ppr x <> ppr xs - - --- --------------------------------------------------------------------- --- Some type information for the pretty printer - --- We have a fixed workspace type -type W = Workspace WorkspaceId Window - --- Introduce a newtype to distinguish different workspace flavours -data TaggedW = C W -- current - | V W -- visible - | H W -- hidden - --- And the ability to unwrap tagged workspaces -unWrap :: TaggedW -> W -unWrap (C w) = w -unWrap (V w) = w -unWrap (H w) = w rmfile ./scripts/xmonad-status.hs move ./scripts/xmonad-dynamic-workspaces.hs ./scripts/xmonad-status.hs addfile ./scripts/run-xmonad.sh hunk ./scripts/run-xmonad.sh 1 +#!/bin/sh +# +# launch xmonad, with a couple of dzens to run the status bar +# send xmonad state over a named pipe +# + +FG='#a8a3f7' +BG='#3f3c6d' +FONT="-xos4-terminus-medium-r-normal--16-160-72-72-c-80-iso8859-1" + +PATH=/home/dons/bin:$PATH + +# simple xmonad use, no interactive status bar. +# +#clock | dzen2 -ta r -fg $FG -bg $BG -fn $FONT & +#exec xmonad + +# +# with a pipe talking to an external program +# +PIPE=$HOME/.xmonad-status +rm -f $PIPE +/sbin/mkfifo -m 600 $PIPE +[ -p $PIPE ] || exit + +# launch the external 60 second clock, and launch the workspace status bar +clock | dzen2 -e '' -x 300 -w 768 -ta r -fg $FG -bg $BG -fn $FONT & +xmonad-status < $PIPE | dzen2 -e '' -w 300 -ta l -fg $FG -bg $BG -fn $FONT & + +# now go for it +xmonad > $PIPE & + +# wait for xmonad +wait $! + +pkill -HUP dzen2 +pkill -HUP ssh-agent +pkill -HUP -f clock +pkill -HUP -f xmonad-status + +wait hunk ./scripts/xmonad-status.hs 17 --- #!/bin/sh --- # --- # launch xmonad, with a couple of dzens to run the status bar --- # send xmonad state over a named pipe --- # --- FG='#a8a3f7' --- BG='#3f3c6d' --- FONT="-xos4-terminus-medium-r-normal--16-160-72-72-c-80-iso8859-1" --- --- PATH=/home/dons/bin:$PATH --- --- # clean up and old status bar pipe --- rm -f ~/.xmonad.pipe --- --- # create a new one --- /sbin/mkfifo -m 600 ~/.xmonad.pipe --- --- xmonad-status < ~/.xmonad.pipe | dzen2 -ta l -fg $FG -bg $BG -fn $FONT & --- exec xmonad > ~/.xmonad.pipe +{- + +#!/bin/sh +# +# launch xmonad, with a couple of dzens to run the status bar +# send xmonad state over a named pipe +# + +FG='#a8a3f7' +BG='#3f3c6d' +FONT="-xos4-terminus-medium-r-normal--16-160-72-72-c-80-iso8859-1" + +PATH=/home/dons/bin:$PATH + +# simple xmonad use, no interactive status bar. +# +#clock | dzen2 -ta r -fg $FG -bg $BG -fn $FONT & +#exec xmonad + +# +# with a pipe talking to an external program +# +PIPE=$HOME/.xmonad-status +rm -f $PIPE +/sbin/mkfifo -m 600 $PIPE +[ -p $PIPE ] || exit + +# launch the external 60 second clock, and launch the workspace status bar +clock | dzen2 -e '' -x 300 -w 768 -ta r -fg $FG -bg $BG -fn $FONT & +xmonad-status < $PIPE | dzen2 -e '' -w 300 -ta l -fg $FG -bg $BG -fn $FONT & + +# now go for it +xmonad > $PIPE & + +# wait for xmonad +wait $! + +pkill -HUP dzen2 +pkill -HUP ssh-agent +pkill -HUP -f clock +pkill -HUP -f xmonad-status + +# wait for all clients +wait + +-} + hunk ./scripts/xmonad-status.hs 76 +import Control.Exception hunk ./scripts/xmonad-status.hs 81 --- *[1] 2 *3 *4 5 6 7 8 +-- 1 [2] 4 8 hunk ./scripts/xmonad-status.hs 87 -main = forever $ getLine >>= readIO >>= draw +main :: IO () +main = forever $ do s <- getLine + handle (\e -> throwDyn (show e ++ show s)) + (readIO s >>= draw) hunk ./scripts/xmonad-status.hs 92 - forever a = a >> forever a + forever a = catchDyn (loop a) (debug a) >> forever a + where + loop a = a >> loop a + debug a e = hPutStrLn stderr e >> forever a hunk ./scripts/xmonad-status.hs 130 - ppr (V w) = parens (ppr w) -- <2> + ppr (V w) = parens (ppr w) -- <2> hunk ./scripts/xmonad-status.hs 145 - hunk ./scripts/xmonad-status.hs 153 -data TaggedW = C W -- current - | V W -- visible - | H W -- hidden +data TaggedW = C !W -- current + | V !W -- visible + | H !W -- hidden hunk ./examples/dzen-status/Config.hs 1 ------------------------------------------------------------------------------ --- | --- Module : Config.hs --- Copyright : (c) Spencer Janssen 2007 --- License : BSD3-style (see LICENSE) --- --- Maintainer : dons@cse.unsw.edu.au --- Stability : stable --- Portability : portable --- ------------------------------------------------------------------------------ - -module Config where - --- --- xmonad bindings follow mostly the dwm/wmii conventions: --- --- key combination action --- --- mod-shift-return new xterm --- mod-p launch dmenu --- mod-shift-p launch gmrun --- --- mod-space switch tiling mode --- --- mod-tab raise next window in stack --- mod-j --- mod-k --- --- mod-h decrease the size of the master area --- mod-l increase the size of the master area --- --- mod-shift-c kill client --- mod-shift-q exit window manager --- mod-shift-ctrl-q restart window manager ('xmonad' must be in $PATH) --- --- mod-return cycle the current tiling order --- --- mod-1..9 switch to workspace N --- mod-shift-1..9 move client to workspace N --- --- mod-w,e,r switch to physical/Xinerama screen 1, 2 or 3. --- --- xmonad places each window into a "workspace." Each workspace can have --- any number of windows, which you can cycle though with mod-j and mod-k. --- Windows are either displayed full screen, tiled horizontally, or tiled --- vertically. You can toggle the layout mode with mod-space, which will --- cycle through the available modes. --- --- You can switch to workspace N with mod-N. For example, to switch to --- workspace 5, you would press mod-5. Similarly, you can move the current --- window to another workspace with mod-shift-N. --- --- When running with multiple monitors (Xinerama), each screen has exactly --- 1 workspace visible. When xmonad starts, workspace 1 is on screen 1, --- workspace 2 is on screen 2, etc. If you switch to a workspace which is --- currently visible on another screen, xmonad simply switches focus to --- that screen. If you switch to a workspace which is *not* visible, xmonad --- replaces the workspace on the *current* screen with the workspace you --- selected. --- --- For example, if you have the following configuration: --- --- Screen 1: Workspace 2 --- Screen 2: Workspace 5 (current workspace) --- --- and you wanted to view workspace 7 on screen 1, you would press: --- --- mod-2 (to select workspace 2, and make screen 1 the current screen) --- mod-7 (to select workspace 7) --- --- Since switching to the workspace currently visible on a given screen is --- such a common operation, shortcuts are provided: mod-{w,e,r} switch to --- the workspace currently visible on screens 1, 2, and 3 respectively. --- Likewise, shift-mod-{w,e,r} moves the current window to the workspace on --- that screen. Using these keys, the above example would become mod-w --- mod-7. --- - -import Data.Ratio -import Data.Bits -import qualified Data.Map as M -import System.Exit -import Graphics.X11.Xlib -import XMonad -import Operations - --- The number of workspaces: -workspaces :: Int -workspaces = 9 - --- modMask lets you easily change which modkey you use. The default is mod1Mask --- ("left alt"). You may also consider using mod3Mask ("right alt"), which --- does not conflict with emacs keybindings. The "windows key" is usually --- mod4Mask. -modMask :: KeyMask -modMask = mod1Mask - --- How much to change the horizontal/vertical split bar by defalut. -defaultDelta :: Rational -defaultDelta = 3%100 - --- The mask for the numlock key. You may need to change this on some systems. --- You can find the numlock modifier by running "xmodmap" and looking for a --- modifier with Num_Lock bound to it. -numlockMask :: KeyMask -numlockMask = mod2Mask - --- What layout to start in, and what the default proportion for the --- left pane should be in the tiled layout. See LayoutDesc and --- friends in XMonad.hs for options. -startingLayoutDesc :: LayoutDesc -startingLayoutDesc = - LayoutDesc { layoutType = Full - , tileFraction = 1%2 } - --- The keys list. -keys :: M.Map (KeyMask, KeySym) (X ()) -keys = M.fromList $ - [ ((modMask .|. shiftMask, xK_Return), spawn "xterm") - , ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && exec $exe") - , ((modMask .|. shiftMask, xK_p ), spawn "gmrun") - , ((modMask, xK_space ), switchLayout) - - , ((modMask, xK_Tab ), raise GT) - , ((modMask, xK_j ), raise GT) - , ((modMask, xK_k ), raise LT) - - , ((modMask, xK_h ), changeSplit (negate defaultDelta)) - , ((modMask, xK_l ), changeSplit defaultDelta) - - , ((modMask .|. shiftMask, xK_c ), kill) - - , ((modMask .|. shiftMask, xK_q ), io $ exitWith ExitSuccess) - , ((modMask .|. shiftMask .|. controlMask, xK_q ), io restart) - - -- Cycle the current tiling order - , ((modMask, xK_Return), promote) - - , ((modMask, xK_s ), spawn "/home/dons/bin/status") - - ] ++ - -- Keybindings to get to each workspace: - [((m .|. modMask, k), f i) - | (i, k) <- zip [0 .. fromIntegral workspaces - 1] [xK_1 ..] - , (f, m) <- [(view, 0), (tag, shiftMask)]] - - -- Keybindings to each screen : - -- mod-wer (underneath 123) switches to physical/Xinerama screens 1 2 and 3 - ++ - [((m .|. modMask, key), screenWorkspace sc >>= f) - | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..] - , (f, m) <- [(view, 0), (tag, shiftMask)]] - rmfile ./examples/dzen-status/Config.hs hunk ./examples/dzen-status/readme 1 -Use dzen2 for an external pop-up status bar. - -status - A shell script printing some strings into dzen2. In this case, it - extracts some openbsd settings. - -Config.hs - , ((modMask, xK_s ), spawn "/home/dons/bin/status") - - mod-s pops up a 10 second status bar. mouse button 3 closes it - explicitly. - -dzen2 is available from: - http://gotmor.googlepages.com/dzen - rmfile ./examples/dzen-status/readme hunk ./examples/dzen-status/status 1 -#!/bin/sh -au=`date +"%H.%M %a %b %d"` -uk=`TZ=GMT date +"UK %H.%M"` -us=`TZ=America/New_York date +"NY %H.%M"` -ca=`TZ=America/Los_Angeles date +"SF %H.%M"` -hw=`/sbin/sysctl hw.setperf | sed "s/.*=//" | perl -anle 'print (0.6 + ($F[0]) / 100)'` -ut=`uptime | sed 's/.*://; s/,//g'` -bt=`/usr/sbin/apm | sed -n 's/.*: \([^ ]*\).*$/\1/;2p;4p' | xargs printf "apm %s%%, AC %s\n"` -(printf "%s : %s : %s : %s : %s Ghz : %s :%s\n" "$au" "$uk" "$us" "$ca" "$hw" "$bt" "$ut"; sleep 10) | dzen2 rmfile ./examples/dzen-status/status rmdir ./examples/dzen-status rmdir ./examples addfile ./scripts/clock.c hunk ./scripts/clock.c 1 +/* +dwm status bar provider. use as ~/.xinitrc or call it in your xinitrc +or xsession in place of dwm. + +to compile: gcc -Os -s -o dwm-status dwm-status.c + +Copyright (c) 2007, Tom Menari +Copyright (c) 2007, Don Stewart + +Permission to use, copy, modify, and distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +*/ + +#include +#include +#include +#include +#include + +/* configuration */ +#define REFRESH_RATE 60 +#define TIME_FORMAT "%H.%M %a %b %d" +#define TIME_FORMAT2 "PDT %H.%M" + +int main(void) { + char b[34]; + char c[34]; + time_t epochtime; + struct tm *realtime; + + time_t pdttime; + struct tm *pdtrealtime; + + double load; + + signal(SIGPIPE, SIG_IGN); + + for(;;) { + getloadavg(&load, 1); + + epochtime = time(NULL); + realtime = localtime(&epochtime); + strftime(b, sizeof(b), TIME_FORMAT, realtime); + + setenv("TZ","America/Los_Angeles", 1); + pdttime = time(NULL); + pdtrealtime = localtime(&pdttime); + strftime(c, sizeof(c), TIME_FORMAT2, pdtrealtime); + + fprintf(stdout, "%s | %s | %.2f | xmonad 0.3 \n", b, c, load); + fflush(stdout); + sleep(REFRESH_RATE); + } + return EXIT_SUCCESS; +} move ./scripts/clock.c ./scripts/xmonad-clock.c hunk ./scripts/xmonad-clock.c 2 -dwm status bar provider. use as ~/.xinitrc or call it in your xinitrc -or xsession in place of dwm. + +dwm/xmonad status bar provider. launch from your .xinitrc, and pipe +into dzen2. hunk ./scripts/xmonad-clock.c 6 -to compile: gcc -Os -s -o dwm-status dwm-status.c +to compile: gcc -Os -s -o xmonad-status xmonad-status.c hunk ./scripts/xmonad-clock.c 59 + unsetenv("TZ"); hunk ./scripts/run-xmonad.sh 27 -clock | dzen2 -e '' -x 300 -w 768 -ta r -fg $FG -bg $BG -fn $FONT & +xmonad-clock | dzen2 -e '' -x 300 -w 768 -ta r -fg $FG -bg $BG -fn $FONT & addfile ./scripts/xmonad-status.c hunk ./scripts/xmonad-status.c 1 +/* + Module : xmonad-workspace.c + Copyright : (c) Don Stewart 2007 + License : BSD3-style (see LICENSE) + + Maintainer : dons@cse.unsw.edu.au + Stability : stable + Portability : portable + + C parser for new workspace format + +*/ + +#include +#include +#include +#include + +#define WORKSPACES 9 + +int main(void) { + + size_t len; + char workspaces[WORKSPACES]; + char buf[1024]; + char *s, *p, *q, current, *rest; + int n, i = 0; + + signal(SIGPIPE, SIG_IGN); + + while (fgets(buf, sizeof(buf), stdin) != NULL) { + + n = strlen(buf); + buf[n-1] = '\0'; + s = buf; + + /* extract tag of current workspace */ + current = *(char *)strsep(&s,"|"); + rest = s; + + /* split up workspace list */ + /* extract just the tags of the workspace list */ + while (i < WORKSPACES) { + workspaces[i++] = *(char *)strsep(&rest, ","); + } + + /* now print out list */ + for (i = 0; i < WORKSPACES; i++) { + printf(((workspaces[i] == current) ? "[%c]" : " %c "), workspaces[i]); + } + + putchar('\n'); + fflush(stdout); + } + return EXIT_SUCCESS; +} hunk ./scripts/xmonad-status.c 15 +#include hunk ./scripts/xmonad-status.c 24 - size_t len; - char workspaces[WORKSPACES]; hunk ./scripts/xmonad-status.c 25 - char *s, *p, *q, current, *rest; - int n, i = 0; + char *s, current, *rest; + int i; hunk ./scripts/xmonad-status.c 32 - n = strlen(buf); - buf[n-1] = '\0'; + i = strlen(buf); + buf[i-1] = '\0'; hunk ./scripts/xmonad-status.c 42 - while (i < WORKSPACES) { - workspaces[i++] = *(char *)strsep(&rest, ","); - } - - /* now print out list */ hunk ./scripts/xmonad-status.c 43 - printf(((workspaces[i] == current) ? "[%c]" : " %c "), workspaces[i]); + s = (char *)strsep(&rest, ","); + + if (*s == current) { + printf("[%c]", *s); + } else if (s[2] != ':') { /* filter empty workspaces */ + printf(" %c ", *s); + } + addfile ./LayoutHints.hs hunk ./LayoutHints.hs 1 +module XMonadContrib.LayoutHints ( layoutHints ) where + +-- to use: +-- defaultLayouts = [ layoutHints tiled, layoutHints $ mirror tiled , full ] + +import Operations ( applySizeHints ) +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras ( getWMNormalHints ) +import XMonad hiding ( trace ) + +layoutHints :: Layout -> Layout +layoutHints l = Layout { doLayout = \r x -> doLayout l r x >>= applyHints + , modifyLayout = \x -> layoutHints `fmap` modifyLayout l x } + +applyHints :: [(Window, Rectangle)] -> X [(Window, Rectangle)] +applyHints xs = mapM applyHint xs + where applyHint (w,Rectangle a b c d) = + withDisplay $ \disp -> + do sh <- io $ getWMNormalHints disp w + let (c',d') = applySizeHints sh (c,d) + return (w, Rectangle a b c' d') hunk ./scripts/xmonad-status.hs 1 -{-# OPTIONS -fglasgow-exts #-} ------------------------------------------------------------------------------ --- | --- Module : xmonad-status.hs --- Copyright : (c) Don Stewart 2007 --- License : BSD3-style --- Maintainer : dons@cse.unsw.edu.au --- --- An external statusbar-client for xmonad. --- --- Prints the workspaces in a simple form, read from the logging output --- of xmonad. --- --- An example use: --- --- -{- - -#!/bin/sh -# -# launch xmonad, with a couple of dzens to run the status bar -# send xmonad state over a named pipe -# - -FG='#a8a3f7' -BG='#3f3c6d' -FONT="-xos4-terminus-medium-r-normal--16-160-72-72-c-80-iso8859-1" - -PATH=/home/dons/bin:$PATH - -# simple xmonad use, no interactive status bar. -# -#clock | dzen2 -ta r -fg $FG -bg $BG -fn $FONT & -#exec xmonad - -# -# with a pipe talking to an external program -# -PIPE=$HOME/.xmonad-status -rm -f $PIPE -/sbin/mkfifo -m 600 $PIPE -[ -p $PIPE ] || exit - -# launch the external 60 second clock, and launch the workspace status bar -clock | dzen2 -e '' -x 300 -w 768 -ta r -fg $FG -bg $BG -fn $FONT & -xmonad-status < $PIPE | dzen2 -e '' -w 300 -ta l -fg $FG -bg $BG -fn $FONT & - -# now go for it -xmonad > $PIPE & - -# wait for xmonad -wait $! - -pkill -HUP dzen2 -pkill -HUP ssh-agent -pkill -HUP -f clock -pkill -HUP -f xmonad-status - -# wait for all clients -wait - --} - --- --- Creates a workspace table on the left side of the screen. --- --- A version that perfectly emulates wmii or dwm could be distributed. --- ------------------------------------------------------------------------------ - -import Data.List -import StackSet -import XMonad -import System.IO -import Text.PrettyPrint -import Control.Exception - --- --- parse the StackSet output, and print it in the form: --- --- 1 [2] 4 8 --- --- It's an example of how to write a Haskell script to hack --- the structure defined in StackSet.hs --- - -main :: IO () -main = forever $ do s <- getLine - handle (\e -> throwDyn (show e ++ show s)) - (readIO s >>= draw) - where - forever a = catchDyn (loop a) (debug a) >> forever a - where - loop a = a >> loop a - debug a e = hPutStrLn stderr e >> forever a - --- --- All the magic is in the 'ppr' instances, below. --- -draw :: WS -> IO () -draw s = do putStrLn . render . ppr $ s - hFlush stdout - --- --------------------------------------------------------------------- --- --- A simple recursive descent pretty printer for the StackSet type. --- -class Pretty a where - ppr :: a -> Doc - --- --- And instances for the StackSet layers --- -instance Pretty WS where - ppr (StackSet { current = cws -- the different workspaces - , visible = vws - , hidden = hws }) = ppr (sortBy tags workspaces) - where - -- tag each workspace with its flavour - workspaces = C (workspace cws) : map (V . workspace) vws ++ map H hws - - -- sort them by their tags - tags a b = (tag.unWrap) a `compare` (tag.unWrap) b - --- --- How to print each workspace kind --- -instance Pretty TaggedW where - ppr (C w) = brackets (int (1 + fromIntegral (tag w))) -- [1] - ppr (V w) = parens (ppr w) -- <2> - ppr (H w) = ppr w - --- tags are printed as integers (or map them to strings) -instance Pretty W where --- Just print int tags: - ppr (Workspace i s) = - case s of - Empty -> empty - _ -> char ' ' <> int (1 + fromIntegral i) <> char ' ' - -instance Pretty a => Pretty [a] where - ppr [] = empty - ppr (x:xs) = ppr x <> ppr xs - --- --------------------------------------------------------------------- --- Some type information for the pretty printer - --- We have a fixed workspace type -type W = Workspace WorkspaceId Int -type WS = StackSet WorkspaceId Int ScreenId - --- Introduce a newtype to distinguish different workspace flavours -data TaggedW = C !W -- current - | V !W -- visible - | H !W -- hidden - --- And the ability to unwrap tagged workspaces -unWrap :: TaggedW -> W -unWrap (C w) = w -unWrap (V w) = w -unWrap (H w) = w rmfile ./scripts/xmonad-status.hs hunk ./LayoutHints.hs 12 -layoutHints l = Layout { doLayout = \r x -> doLayout l r x >>= applyHints - , modifyLayout = \x -> layoutHints `fmap` modifyLayout l x } +layoutHints l = l { doLayout = \r x -> doLayout l r x >>= applyHints + , modifyLayout = \x -> layoutHints `fmap` modifyLayout l x } addfile ./DynamicLog.hs hunk ./DynamicLog.hs 1 +-- +-- DynamicLog +-- +-- Log events in: +-- +-- 1 2 [3] 4 8 +-- +-- format. suitable to pipe into dzen. +-- +-- To use, set: +-- +-- import XMonadContrib.DynamicLog +-- logHook = dynamicLog +-- +-- Don Stewart + +module XMonadContrib.DynamicLog where + +-- +-- Useful imports +-- +import XMonad +import Data.List +import qualified StackSet as S + +-- +-- Perform an arbitrary action on each state change. +-- Examples include: +-- * do nothing +-- * log the state to stdout + +-- +-- An example logger, print a status bar output to dzen, in the form: +-- +-- 1 2 [3] 4 7 +-- + +dynamicLog :: X () +dynamicLog = withWindowSet $ io . putStrLn . ppr + where + ppr s = concatMap fmt $ sortBy tags + (map S.workspace (S.current s : S.visible s) ++ S.hidden s) + + where tags a b = S.tag a `compare` S.tag b + this = S.tag (S.workspace (S.current s)) + pprTag = show . (+(1::Int)) . fromIntegral . S.tag + fmt w | S.tag w == this = "[" ++ pprTag w ++ "]" + | S.stack w /= S.Empty = " " ++ pprTag w ++ " " + | otherwise = "" hunk ./scripts/run-xmonad.sh 27 -xmonad-clock | dzen2 -e '' -x 300 -w 768 -ta r -fg $FG -bg $BG -fn $FONT & -xmonad-status < $PIPE | dzen2 -e '' -w 300 -ta l -fg $FG -bg $BG -fn $FONT & +xmonad-clock | dzen2 -e '' -x 300 -w 768 -ta r -fg $FG -bg $BG -fn $FONT & hunk ./scripts/run-xmonad.sh 29 -# now go for it -xmonad > $PIPE & +# and a workspace status bar (this `cat' shouldn't be needed!) +dzen2 -e '' -w 300 -ta l -fg $FG -bg $BG -fn $FONT < $PIPE & + +# go forit +xmonad > $PIPE & hunk ./scripts/xmonad-status.c 1 -/* - Module : xmonad-workspace.c - Copyright : (c) Don Stewart 2007 - License : BSD3-style (see LICENSE) - - Maintainer : dons@cse.unsw.edu.au - Stability : stable - Portability : portable - - C parser for new workspace format - -*/ - -#include -#include -#include -#include -#include - -#define WORKSPACES 9 - -int main(void) { - - char buf[1024]; - char *s, current, *rest; - int i; - - signal(SIGPIPE, SIG_IGN); - - while (fgets(buf, sizeof(buf), stdin) != NULL) { - - i = strlen(buf); - buf[i-1] = '\0'; - s = buf; - - /* extract tag of current workspace */ - current = *(char *)strsep(&s,"|"); - rest = s; - - /* split up workspace list */ - /* extract just the tags of the workspace list */ - for (i = 0; i < WORKSPACES; i++) { - s = (char *)strsep(&rest, ","); - - if (*s == current) { - printf("[%c]", *s); - } else if (s[2] != ':') { /* filter empty workspaces */ - printf(" %c ", *s); - } - - } - - putchar('\n'); - fflush(stdout); - } - return EXIT_SUCCESS; -} rmfile ./scripts/xmonad-status.c hunk ./scripts/run-xmonad.sh 29 -# and a workspace status bar (this `cat' shouldn't be needed!) +# and a workspace status bar hunk ./scripts/run-xmonad.sh 32 -# go forit +# go for it addfile ./scripts/xinitrc hunk ./scripts/xinitrc 1 +# .xinitrc + +xrdb $HOME/.Xresources +xsetroot -cursor_name left_ptr + +xpmroot ~/.bg/ISS013-E-54329_lrg.xpm & + +# if we have private ssh key(s), start ssh-agent and add the key(s) +id1=$HOME/.ssh/identity +id2=$HOME/.ssh/id_dsa +id3=$HOME/.ssh/id_rsa +if [ -x /usr/bin/ssh-agent ] && [ -f $id1 -o -f $id2 -o -f $id3 ]; +then + eval `ssh-agent -s` + ssh-add < /dev/null +fi + +# some other things +tpb -d & +unclutter -idle 1 & + +xset fp+ /usr/local/lib/X11/fonts/terminus +xset fp+ /usr/local/lib/X11/fonts/ghostscript +# xset fp+ /usr/local/lib/X11/fonts/bitstream-vera +# xset fp+ /usr/local/lib/X11/fonts/mscorefonts + +xset fp rehash +xset b 100 0 0 +xset r rate 140 200 + +xmodmap -e "keycode 233 = Page_Down" +xmodmap -e "keycode 234 = Page_Up" +xmodmap -e "remove Lock = Caps_Lock" +xmodmap -e "keysym Caps_Lock = Control_L" +xmodmap -e "add Control = Control_L" + +exec /home/dons/bin/run-xmonad.sh addfile ./scripts/xmonad-acpi.c hunk ./scripts/xmonad-acpi.c 1 +/* + +dwm/xmonad status bar provider. launch from your .xinitrc, and pipe +into dzen2. + +to compile: gcc -Os -s -o xmonad-acpi xmonad-acpi.c + +Copyright (c) 2007, Tom Menari +Copyright (c) 2007, Don Stewart + +Permission to use, copy, modify, and distribute this software for any +purpose with or without fee is hereby granted, provided that the above +copyright notice and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +*/ + +#include +#include +#include +#include +#include + +/* configuration */ +#define REFRESH_RATE 2 +#define TIME_FORMAT "%a %b %d %H:%M:%S" +#define BATTERY_INFO "/proc/acpi/battery/BAT0/info" +#define BATTERY_STATE "/proc/acpi/battery/BAT0/state" + +int main(void) { + FILE *acpi; + char b[34]; + time_t epochtime; + struct tm *realtime; + int last_full, remaining; + + double load[3]; + + signal(SIGPIPE, SIG_IGN); + + if ((acpi = fopen(BATTERY_INFO, "r")) == NULL) { + perror("couldn't open "BATTERY_INFO); + exit(-1); + } + while (fgets(b, sizeof(b), acpi)) + if (sscanf(b, "last full capacity: %d", &last_full) == 1) + break; + fclose(acpi); + + for(;;) { + /* Load */ + getloadavg(load, 3); + + /* Battery */ + if ((acpi = fopen(BATTERY_STATE, "r")) == NULL) { + perror("couldn't open "BATTERY_STATE); + exit(-1); + } + while (fgets(b, sizeof(b), acpi)) + if (sscanf(b, "remaining capacity: %d", &remaining) == 1) + break; + fclose(acpi); + + /* Time */ + epochtime = time(NULL); + realtime = localtime(&epochtime); + strftime(b, sizeof(b), TIME_FORMAT, realtime); + + + fprintf(stdout, "%s | %.2f %.2f %.2f | %.1f%% \n", b, load[0], load[1], + load[2], (float) (remaining * 100) / last_full); + fflush(stdout); + sleep(REFRESH_RATE); + } + return EXIT_SUCCESS; +} hunk ./scripts/xmonad-clock.c 44 - double load; + double load[3]; hunk ./scripts/xmonad-clock.c 49 - getloadavg(&load, 1); + getloadavg(load, 3); hunk ./scripts/xmonad-clock.c 61 - fprintf(stdout, "%s | %s | %.2f | xmonad 0.3 \n", b, c, load); + fprintf(stdout, "%s | %s | %.2f %.2f %.2f | xmonad 0.3 \n", b, c, load[0], load[1], load[2]); + hunk ./GreedyView.hs 4 +-- +-- To use GreedyView as your default workspace switcher, +-- +-- Add this import : +-- +-- import XMonadContrib.GreedyView +-- +-- And replace the function call used to switch workspaces, +-- +-- this : +-- +-- [((m .|. modMask, k), f i) +-- | (i, k) <- zip [0 .. fromIntegral workspaces - 1] [xK_1 ..] +-- , (f, m) <- [(view, 0), (shift, shiftMask)]] +-- +-- becomes this : +-- +-- [((m .|. modMask, k), f i) +-- | (i, k) <- zip [0 .. fromIntegral workspaces - 1] [xK_1 ..] +-- , (f, m) <- [(greedyView, 0), (shift, shiftMask)]] +-- hunk ./scripts/run-xmonad.sh 39 -pkill -HUP ssh-agent -pkill -HUP -f clock -pkill -HUP -f xmonad-status +pkill -HUP -f xmonad-clock hunk ./DynamicLog.hs 43 - hunk ./DynamicLog.hs 46 - fmt w | S.tag w == this = "[" ++ pprTag w ++ "]" - | S.stack w /= S.Empty = " " ++ pprTag w ++ " " - | otherwise = "" + visibles = map (S.tag . S.workspace) (S.visible s) + + fmt w | S.tag w == this = "[" ++ pprTag w ++ "]" + | S.tag w `elem` visibles = "<" ++ pprTag w ++ ">" + | S.stack w /= S.Empty = " " ++ pprTag w ++ " " + | otherwise = "" hunk ./LayoutHints.hs 13 - , modifyLayout = \x -> layoutHints `fmap` modifyLayout l x } + , modifyLayout = \x -> fmap layoutHints `fmap` modifyLayout l x } addfile ./Tabbed.hs hunk ./Tabbed.hs 1 +module XMonadContrib.Tabbed ( tabbed ) where + +-- This module defines a tabbed layout. + +-- You can use this module with the following in your config file: + +-- import XMonadContrib.Tabbed + +-- defaultLayouts :: [Layout] +-- defaultLayouts = [ tabbed +-- , ... ] + +import Control.Monad ( forM ) + +import Graphics.X11.Xlib +import XMonad +import XMonadContrib.Decoration +import Operations ( focus ) + +tabbed :: Layout +tabbed = Layout { doLayout = dolay, modifyLayout = const (return Nothing) } + +dolay :: Rectangle -> [Window] -> X [(Window, Rectangle)] +dolay sc [w] = return [(w,sc)] +dolay sc@(Rectangle x _ wid _) ws = + do let ts = gentabs x wid (length ws) + tws = zip ts ws + forM tws $ \(t,w) -> newDecoration t 1 0xFF0000 0x00FFFF (trace "draw") (focus w) + return [ (w,shrink sc) | w <- ws ] + +shrink :: Rectangle -> Rectangle +shrink (Rectangle x y w h) = Rectangle x (y+tabsize) w (h-tabsize) + +gentabs :: Position -> Dimension -> Int -> [Rectangle] +gentabs _ _ 0 = [] +gentabs x1 w num = Rectangle x1 0 (wid - 2) (tabsize - 2) + : gentabs (x1 + fromIntegral wid) (w - wid) (num - 1) + where wid = w `div` (fromIntegral num) + +tabsize :: Integral a => a +tabsize = 30 addfile ./Decoration.hs hunk ./Decoration.hs 1 - +module XMonadContrib.Decoration ( newDecoration ) where + +import qualified Data.Map as M + +import Control.Monad.Reader ( asks ) +import Control.Monad.State ( modify, gets ) +import Graphics.X11.Xlib ( Window, Rectangle(Rectangle), Pixel + , createSimpleWindow, mapWindow, destroyWindow + , buttonPress ) +import Graphics.X11.Xlib.Extras ( Event(AnyEvent,ButtonEvent), ev_subwindow, ev_event_type, ev_window ) + +import XMonad +import Operations ( ModifyWindows(ModifyWindows) ) +import qualified StackSet as W + +newDecoration :: Rectangle -> Int -> Pixel -> Pixel -> X () -> X () -> X Window +newDecoration (Rectangle x y w h) th fg bg draw click = + do d <- asks display + rt <- asks theRoot + n <- (W.tag . W.workspace . W.current) `fmap` gets windowset + Just (l,ls) <- M.lookup n `fmap` gets layouts + win <- io $ createSimpleWindow d rt x y w h (fromIntegral th) fg bg + io $ mapWindow d win + let modml :: (SomeMessage -> X (Maybe Layout)) -> SomeMessage -> X (Maybe Layout) + modml oldml m | Just ModifyWindows == fromMessage m = io (destroyWindow d win) >> oldml m + | Just e <- fromMessage m = handle_event e >> oldml m + | otherwise = fmap modl `fmap` oldml m + modl :: Layout -> Layout + modl oldl = oldl { modifyLayout = modml (modifyLayout oldl) } + handle_event (ButtonEvent {ev_subwindow = thisw,ev_event_type = t}) + | t == buttonPress && thisw == win = click + handle_event (ButtonEvent {ev_window = thisw,ev_event_type = t}) + | t == buttonPress && thisw == win = click + handle_event (AnyEvent {ev_window = thisw}) | thisw == win = draw + handle_event _ = return () + modify $ \s -> s { layouts = M.insert n (modl l,ls) (layouts s) } + return win + hunk ./scripts/xmonad-clock.c 6 -to compile: gcc -Os -s -o xmonad-status xmonad-status.c +to compile: gcc -Os -s -o xmonad-clock xmonad-clock.c hunk ./Decoration.hs 4 - hunk ./Decoration.hs 6 -import Graphics.X11.Xlib ( Window, Rectangle(Rectangle), Pixel - , createSimpleWindow, mapWindow, destroyWindow - , buttonPress ) +import Graphics.X11.Xlib hunk ./Decoration.hs 13 -newDecoration :: Rectangle -> Int -> Pixel -> Pixel -> X () -> X () -> X Window +newDecoration :: Rectangle -> Int -> Pixel -> Pixel + -> (Display -> Window -> GC -> X ()) -> X () -> X Window hunk ./Decoration.hs 22 - let modml :: (SomeMessage -> X (Maybe Layout)) -> SomeMessage -> X (Maybe Layout) + let draw' = withGC win draw + modml :: (SomeMessage -> X (Maybe Layout)) -> SomeMessage -> X (Maybe Layout) hunk ./Decoration.hs 33 - handle_event (AnyEvent {ev_window = thisw}) | thisw == win = draw + handle_event (AnyEvent {ev_window = thisw}) | thisw == win = draw' hunk ./Decoration.hs 35 + draw' hunk ./Decoration.hs 39 +-- FIXME: withGC should use bracket (but can't, unless draw is an IO thing) +withGC :: Drawable -> (Display -> Drawable -> GC -> X ()) -> X () +withGC w f = withDisplay $ \d -> do gc <- io $ createGC d w + f d w gc + io $ freeGC d gc + hunk ./Tabbed.hs 20 +import XMonadContrib.NamedWindows + hunk ./Tabbed.hs 30 - forM tws $ \(t,w) -> newDecoration t 1 0xFF0000 0x00FFFF (trace "draw") (focus w) + maketab (t,w) = newDecoration t 1 0xFF0000 0x00FFFF (drawtab t w) (focus w) + drawtab r w d w' gc = + do nw <- getName w + centerText d w' gc r (show nw) + centerText d w' gc (Rectangle _ _ wt ht) name = + do font <- io (fontFromGC d gc >>= queryFont d) + -- let (_,namew,nameh,_) = textExtents font name -- textExtents causes a crash! + -- let nameh = ht `div` 2 + -- namew = textWidth font name -- textWidth also causes a crash! + let nameh = ht - 6 + namew = wt - 20 + io $ drawString d w' gc + (fromIntegral (wt `div` 2) - fromIntegral (namew `div` 2)) + (fromIntegral (ht `div` 2) + fromIntegral (nameh `div` 2)) name + forM tws maketab hunk ./Tabbed.hs 57 -tabsize = 30 +tabsize = 20 addfile ./Anneal.hs hunk ./Anneal.hs 1 +module XMonadContrib.Anneal ( Rated(Rated), the_value, the_rating, anneal ) where + +data Rated a b = Rated !a !b + deriving ( Show ) +instance Functor (Rated a) where + f `fmap` (Rated v a) = Rated v (f a) + +the_value :: Rated a b -> b +the_value (Rated _ b) = b +the_rating :: Rated a b -> a +the_rating (Rated a _) = a + +instance Eq a => Eq (Rated a b) where + (Rated a _) == (Rated a' _) = a == a' +instance Ord a => Ord (Rated a b) where + compare (Rated a _) (Rated a' _) = compare a a' + +anneal :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a +anneal = undefined hunk ./Mosaic.hs 2 + tallWindow, wideWindow, hunk ./Mosaic.hs 25 +-- , ((controlMask .|. modMask .|. shiftMask, xK_h), withNamedWindow (sendMessage . tallWindow)) +-- , ((controlMask .|. modMask .|. shiftMask, xK_l), withNamedWindow (sendMessage . wideWindow)) hunk ./Mosaic.hs 30 --- , ((modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . clearWindow)) +-- , ((modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . myclearWindow)) + +import Control.Monad.State ( State, runState, put, get ) +import System.Random ( StdGen, Random, mkStdGen, randomR ) hunk ./Mosaic.hs 37 -import XMonad +import XMonad hiding ( trace ) hunk ./Mosaic.hs 45 +import XMonadContrib.Anneal hunk ./Mosaic.hs 47 -import System.IO.Unsafe +import Debug.Trace hunk ./Mosaic.hs 51 + | TallWindow NamedWindow | WideWindow NamedWindow hunk ./Mosaic.hs 56 -expandWindow, shrinkWindow, squareWindow, myclearWindow :: NamedWindow -> HandleWindow +expandWindow, shrinkWindow, squareWindow, myclearWindow,tallWindow, wideWindow :: NamedWindow -> HandleWindow hunk ./Mosaic.hs 61 +tallWindow = TallWindow +wideWindow = WideWindow hunk ./Mosaic.hs 64 -largeNumber :: Int -largeNumber = 100 +largeNumber, mediumNumber, resolutionNumber :: Int +largeNumber = 200 +mediumNumber = 10 +resolutionNumber = 100 hunk ./Mosaic.hs 69 -mosaic :: Rational -> Rational -> M.Map NamedWindow WindowRater -> M.Map NamedWindow Area -> Layout -mosaic delta tileFrac raters areas = Layout { doLayout = mosaicL tileFrac raters areas - , modifyLayout = mlayout } +defaultArea :: Double +defaultArea = 1 + +flexibility :: Double +flexibility = 0.1 + +mosaic :: Double -> Double -> M.Map NamedWindow [WindowHint] -> Layout +mosaic delta tileFrac hints = Layout { doLayout = mosaicL tileFrac hints, modifyLayout = mlayout } hunk ./Mosaic.hs 78 - m1 Shrink = mosaic delta (tileFrac/(1+delta)) raters areas - m1 Expand = mosaic delta (tileFrac*(1+delta)) raters areas - m2 (ExpandWindow w) = mosaic delta tileFrac raters - -- (add_rater (\_ (Rectangle _ _ wid h) -> delta*(1-wid///h)) w raters) - (multiply_area (1+delta) w areas) - m2 (ShrinkWindow w) = mosaic delta tileFrac raters - -- (add_rater (\_ (Rectangle _ _ wid h) -> delta*(wid///h-1)) w raters) - (multiply_area (1/(1+ delta)) w areas) - m2 (SquareWindow w) = mosaic delta tileFrac (M.insert w force_square raters) areas - m2 (ClearWindow w) = mosaic delta tileFrac (M.delete w raters) (M.delete w areas) - force_square _ (Rectangle _ _ a b) = 100*(sqr(a///b) + sqr(b///a)) - sqr a = a * a + m1 Shrink = mosaic delta (tileFrac/(1+delta)) hints + m1 Expand = mosaic delta (tileFrac*(1+delta)) hints + m2 (ExpandWindow w) = mosaic delta tileFrac (multiply_area (1+delta) w hints) + m2 (ShrinkWindow w) = mosaic delta tileFrac (multiply_area (1/(1+ delta)) w hints) + m2 (SquareWindow w) = mosaic delta tileFrac (set_aspect_ratio 1 w hints) + m2 (TallWindow w) = mosaic delta tileFrac (multiply_aspect (1/(1+delta)) w hints) + m2 (WideWindow w) = mosaic delta tileFrac (multiply_aspect (1+delta) w hints) + m2 (ClearWindow w) = mosaic delta tileFrac (M.delete w hints) hunk ./Mosaic.hs 87 -mytrace :: String -> a -> a -mytrace s a = seq foo a - where foo = unsafePerformIO $ appendFile "/tmp/xmonad.trace" (s++"\n") +multiply_area :: Double -> NamedWindow + -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] +multiply_area a = alterlist f where f [] = [RelArea (defaultArea*a)] + f (RelArea a':xs) = RelArea (a'*a) : xs + f (x:xs) = x : f xs hunk ./Mosaic.hs 93 -myerror :: String -> a -myerror s = seq foo $ error s - where foo = unsafePerformIO $ appendFile "/tmp/xmonad.trace" (s++"\n") +set_aspect_ratio :: Double -> NamedWindow + -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] +set_aspect_ratio r = alterlist f where f [] = [AspectRatio r] + f (FlexibleAspectRatio _:x) = AspectRatio r:x + f (AspectRatio _:x) = AspectRatio r:x + f (x:xs) = x:f xs hunk ./Mosaic.hs 100 -multiply_area :: Area -> NamedWindow -> M.Map NamedWindow Area -> M.Map NamedWindow Area -multiply_area a w = M.alter (Just . f) w where f Nothing = a - f (Just a') = a'*a +multiply_aspect :: Double -> NamedWindow + -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] +multiply_aspect r = alterlist f where f [] = [FlexibleAspectRatio r] + f (AspectRatio r':x) = AspectRatio (r*r'):x + f (FlexibleAspectRatio r':x) = FlexibleAspectRatio (r*r'):x + f (x:xs) = x:f xs hunk ./Mosaic.hs 107 -add_rater :: WindowRater -> NamedWindow -> M.Map NamedWindow WindowRater -> M.Map NamedWindow WindowRater -add_rater r w = M.alter f w where f Nothing= Just r - f (Just r') = Just $ \foo bar -> r foo bar + r' foo bar +findlist :: Ord k => k -> M.Map k [a] -> [a] +findlist = M.findWithDefault [] hunk ./Mosaic.hs 110 -type WindowRater = NamedWindow -> Rectangle -> Rational +alterlist :: (Ord k, Ord a) => ([a] -> [a]) -> k -> M.Map k [a] -> M.Map k [a] +alterlist f k = M.alter f' k + where f' Nothing = f' (Just []) + f' (Just xs) = case f xs of + [] -> Nothing + xs' -> Just xs' hunk ./Mosaic.hs 117 -mosaicL :: Rational -> M.Map NamedWindow WindowRater -> M.Map NamedWindow Area +mosaicL :: Double -> M.Map NamedWindow [WindowHint] hunk ./Mosaic.hs 119 -mosaicL _ _ _ _ [] = return [] -mosaicL f raters areas origRect origws +mosaicL _ _ _ [] = return [] +mosaicL f hints origRect origws hunk ./Mosaic.hs 123 - myv = my_mosaic origRect Vertical sortedws - myh = my_mosaic origRect Horizontal sortedws - return $ map (\(nw,r)->(unName nw,r)) $ flattenMosaic $ the_value $ if myv < myh then myv else myh - where mean_area = area origRect / fromIntegral (length origws) - - my_mosaic :: Rectangle -> CutDirection -> [NamedWindow] - -> Rated Rational (Mosaic (NamedWindow, Rectangle)) - my_mosaic _ _ [] = Rated 0 $ M [] - my_mosaic r _ [w] = Rated (rating w r) $ OM (w,r) - my_mosaic r d ws = minL $ - map (fmap M . catRated . - map (\(ws',r') -> my_mosaic r' (otherDirection d) ws')) $ - map (\ws' -> zip ws' $ partitionR d r $ map sumareas ws') $ - take largeNumber $ init $ allsplits ws - where minL [] = myerror "minL on empty list" - minL [a] = a - minL (a:b:c) = minL (min a b:c) + myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws + myv2 = maxL $ runCountDown largeNumber $ + sequence $ replicate mediumNumber $ + mosaic_splits one_split origRect Vertical sortedws + myh = runCountDown largeNumber $ mosaic_splits even_split origRect Horizontal sortedws + myh2 = maxL $ runCountDown largeNumber $ + sequence $ replicate mediumNumber $ + mosaic_splits one_split origRect Horizontal sortedws + return $ map (\(nw,r)->(trace ("rate1:"++ unlines [show nw, + show $ rate f meanarea (findlist nw hints) r, + show r, + show $ area r/meanarea, + show $ findlist nw hints]) $ + unName nw,crop' (findlist nw hints) r)) $ + flattenMosaic $ the_value $ + trace ("ratings: "++ show (map the_rating [myv,myh,myv2,myh2])) $ + maxL [myv,myh,myv2,myh2] + where mosaic_splits _ _ _ [] = return $ Rated 0 $ M [] + mosaic_splits _ r _ [w] = return $ Rated (rate f meanarea (findlist w hints) r) $ OM (w,r) + mosaic_splits spl r d ws = maxL `fmap` mapCD (spl r d) (init $ allsplits ws) + even_split :: Rectangle -> CutDirection -> [[NamedWindow]] + -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle))) + even_split r d [ws] = even_split r d $ map (:[]) ws + even_split r d wss = + do let areas = map sumareas wss + let wsr_s :: [([NamedWindow], Rectangle)] + wsr_s = zip wss (partitionR d r areas) + submosaics <- mapM (\(ws',r') -> + mosaic_splits even_split r' (otherDirection d) ws') wsr_s + return $ fmap M $ catRated submosaics + one_split :: Rectangle -> CutDirection -> [[NamedWindow]] + -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle))) + one_split r d [ws] = one_split r d $ map (:[]) ws + one_split r d wss = + do rnd <- mapM (const (fractional resolutionNumber)) [1..length wss] + let wsr_s :: [([NamedWindow], Rectangle)] + wsr_s = zip wss (partitionR d r rnd) + submosaics <- mapM (\(ws',r') -> + mosaic_splits even_split r' (otherDirection d) ws') wsr_s + return $ fmap M $ catRated submosaics hunk ./Mosaic.hs 164 - partitionR :: CutDirection -> Rectangle -> [Area] -> [Rectangle] + partitionR :: CutDirection -> Rectangle -> [Double] -> [Rectangle] hunk ./Mosaic.hs 170 + theareas = hints2area `fmap` hints + sumareas ws = sum $ map (\w -> M.findWithDefault 1 w theareas) ws + meanarea = area origRect / fromIntegral (length origws) + +maxL :: Ord a => [a] -> a +maxL [] = error "maxL on empty list" +maxL [a] = a +maxL (a:b:c) = maxL (max a b:c) + +catRated :: Floating v => [Rated v a] -> Rated v [a] +catRated xs = Rated (product $ map the_rating xs) (map the_value xs) + +data CountDown = CD !StdGen !Int + +runCountDown :: Int -> State CountDown a -> a +runCountDown n x = fst $ runState x (CD (mkStdGen n) n) hunk ./Mosaic.hs 187 - rating :: WindowRater - rating w r = (M.findWithDefault default_preferences w raters) w r - default_preferences :: WindowRater - default_preferences _ r@(Rectangle _ _ w h) - | fr <- w /// h = sqr(fr/f)+sqr(f/fr)-2+ toRational (mean_area/area r) - sqr a = a * a - sumareas ws = sum $ map (\w -> M.findWithDefault 1 w areas) ws +tries_left :: State CountDown Int +tries_left = do CD _ n <- get + return (max 0 n) hunk ./Mosaic.hs 191 +mapCD :: (a -> State CountDown b) -> [a] -> State CountDown [b] +mapCD f xs = do n <- tries_left + let len = length xs + mapM (run_with_only ((n `div` len)+1) . f) $ take (n+1) xs hunk ./Mosaic.hs 196 +run_with_only :: Int -> State CountDown a -> State CountDown a +run_with_only limit j = + do CD g n <- get + let leftover = n - limit + if leftover < 0 then j + else do put $ CD g limit + x <- j + CD g' n' <- get + put $ CD g' (leftover + n') + return x hunk ./Mosaic.hs 207 -catRated :: Num v => [Rated v a] -> Rated v [a] -catRated xs = Rated (sum $ map the_rating xs) (map the_value xs) +getOne :: (Random a) => (a,a) -> State CountDown a +getOne bounds = do CD g n <- get + (x,g') <- return $ randomR bounds g + put $ CD g' n + return x + +fractional :: Int -> State CountDown Double +fractional n = ((/ fromIntegral n).fromIntegral) `fmap` getOne (1,n) hunk ./Mosaic.hs 216 -data Rated a b = Rated !a !b -instance Functor (Rated a) where - f `fmap` (Rated v a) = Rated v (f a) - -the_value :: Rated a b -> b -the_value (Rated _ b) = b -the_rating :: Rated a b -> a -the_rating (Rated a _) = a - -instance Eq a => Eq (Rated a b) where - (Rated a _) == (Rated a' _) = a == a' -instance Ord a => Ord (Rated a b) where - compare (Rated a _) (Rated a' _) = compare a a' - -type Area = Rational +data WindowHint = RelArea Double + | AspectRatio Double + | FlexibleAspectRatio Double + deriving ( Show, Read, Eq, Ord ) + +fixedAspect :: [WindowHint] -> Bool +fixedAspect [] = False +fixedAspect (AspectRatio _:_) = True +fixedAspect (_:x) = fixedAspect x + +rate :: Double -> Double -> [WindowHint] -> Rectangle -> Double +rate defaulta meanarea xs rr + | fixedAspect xs = (area (crop xs rr) / meanarea) ** weight + | otherwise = (area rr / meanarea)**(weight-flexibility) + * (area (crop (xs++[FlexibleAspectRatio defaulta]) rr) / meanarea)**flexibility + where weight = hints2area xs + +crop :: [WindowHint] -> Rectangle -> Rectangle +crop (AspectRatio f:_) = cropit f +crop (FlexibleAspectRatio f:_) = cropit f +crop (_:hs) = crop hs +crop [] = id hunk ./Mosaic.hs 239 -area :: Rectangle -> Area +crop' :: [WindowHint] -> Rectangle -> Rectangle +crop' (AspectRatio f:_) = cropit f +crop' (_:hs) = crop' hs +crop' [] = id + +cropit :: Double -> Rectangle -> Rectangle +cropit f (Rectangle a b w h) | w -/- h > f = Rectangle a b (floor $ h -* f) h + | otherwise = Rectangle a b w (floor $ w -/ f) + +hints2area :: [WindowHint] -> Double +hints2area [] = defaultArea +hints2area (RelArea r:x) = r +hints2area (_:x) = hints2area x + +area :: Rectangle -> Double hunk ./Mosaic.hs 256 -(///) :: (Integral a, Integral b) => a -> b -> Rational -a /// b = fromIntegral a / fromIntegral b +(-/-) :: (Integral a, Integral b) => a -> b -> Double +a -/- b = fromIntegral a / fromIntegral b + +(-/) :: (Integral a) => a -> Double -> Double +a -/ b = fromIntegral a / b hunk ./Mosaic.hs 262 +(-*) :: (Integral a) => a -> Double -> Double +a -* b = fromIntegral a * b hunk ./Mosaic.hs 265 -split :: CutDirection -> Rational -> Rectangle -> (Rectangle, Rectangle) +split :: CutDirection -> Double -> Rectangle -> (Rectangle, Rectangle) hunk ./Mosaic.hs 281 + deriving ( Show ) hunk ./Mosaic.hs 290 -allsplits (x:xs) = (map ([x]:) splitsrest) ++ - (map (maphead (x:)) splitsrest) +allsplits (x:xs) = (map ([x]:) splitsrest) ++ (map (maphead (x:)) splitsrest) + where splitsrest = allsplits' xs + +allsplits' :: [a] -> [[[a]]] +allsplits' [] = [[[]]] +allsplits' [a] = [[[a]]] +allsplits' (x:xs) = (map (maphead (x:)) splitsrest) ++ (map ([x]:) splitsrest) hunk ./Anneal.hs 3 +import System.Random ( StdGen, Random, mkStdGen, randomR ) +import Control.Monad.State ( State, runState, put, get, gets, modify ) + hunk ./Anneal.hs 22 -anneal = undefined +anneal st r sel = runAnneal st r (do_anneal sel) + +do_anneal :: (a -> [a]) -> State (Anneal a) (Rated Double a) +do_anneal sel = do sequence_ $ replicate 100 da + gets best + where da = do select_metropolis sel + modify $ \s -> s { temperature = temperature s *0.99 } + +data Anneal a = A { g :: StdGen + , best :: Rated Double a + , current :: Rated Double a + , rate :: a -> Rated Double a + , temperature :: Double } + +runAnneal :: a -> (a -> Double) -> State (Anneal a) b -> b +runAnneal start r x = fst $ runState x (A { g = mkStdGen 137 + , best = Rated (r start) start + , current = Rated (r start) start + , rate = \xx -> Rated (r xx) xx + , temperature = 1.0 }) + +select_metropolis :: (a -> [a]) -> State (Anneal a) () +select_metropolis x = do c <- gets current + a <- select $ x $ the_value c + metropolis a + +metropolis :: a -> State (Anneal a) () +metropolis x = do r <- gets rate + c <- gets current + t <- gets temperature + let rx = r x + boltz = exp $ (the_rating c - the_rating rx) / t + if rx < c then do modify $ \s -> s { current = rx, best = rx } + else do p <- getOne (0,1) + if p < boltz + then modify $ \s -> s { current = rx } + else return () + +select :: [a] -> State (Anneal x) a +select [] = error "empty list in select" +select [x] = return x +select xs = do n <- getOne (0,length xs - 1) + return (xs !! n) + +getOne :: (Random a) => (a,a) -> State (Anneal x) a +getOne bounds = do s <- get + (x,g') <- return $ randomR bounds (g s) + put $ s { g = g' } + return x hunk ./Mosaic.hs 65 -largeNumber = 200 +largeNumber = 50 hunk ./Mosaic.hs 124 - myv2 = maxL $ runCountDown largeNumber $ - sequence $ replicate mediumNumber $ - mosaic_splits one_split origRect Vertical sortedws + myv2 = mc_mosaic sortedws Vertical + myh2 = mc_mosaic sortedws Horizontal +-- myv2 = maxL $ runCountDown largeNumber $ +-- sequence $ replicate mediumNumber $ +-- mosaic_splits one_split origRect Vertical sortedws hunk ./Mosaic.hs 130 - myh2 = maxL $ runCountDown largeNumber $ - sequence $ replicate mediumNumber $ - mosaic_splits one_split origRect Horizontal sortedws - return $ map (\(nw,r)->(trace ("rate1:"++ unlines [show nw, - show $ rate f meanarea (findlist nw hints) r, - show r, - show $ area r/meanarea, - show $ findlist nw hints]) $ +-- myh2 = maxL $ runCountDown largeNumber $ +-- sequence $ replicate mediumNumber $ +-- mosaic_splits one_split origRect Horizontal sortedws + return $ map (\(nw,r)->(--trace ("rate1:"++ unlines [show nw, + -- show $ rate f meanarea (findlist nw hints) r, + -- show r, + -- show $ area r/meanarea, + -- show $ findlist nw hints]) $ hunk ./Mosaic.hs 139 - flattenMosaic $ the_value $ - trace ("ratings: "++ show (map the_rating [myv,myh,myv2,myh2])) $ - maxL [myv,myh,myv2,myh2] + flattenMosaic $ the_value $ maxL [myh2,myv2] hunk ./Mosaic.hs 153 + another_mosaic :: [NamedWindow] -> CutDirection + -> Rated Double (Mosaic (NamedWindow,Rectangle)) + another_mosaic ws d = rate_mosaic ratew $ + rect_mosaic origRect d $ + zipML (example_mosaic ws) (map findarea ws) + mc_mosaic :: [NamedWindow] -> CutDirection + -> Rated Double (Mosaic (NamedWindow,Rectangle)) + mc_mosaic ws d = fmap (rect_mosaic origRect d) $ + anneal (zipML (example_mosaic ws) (map findarea ws)) + (the_rating . rate_mosaic ratew . rect_mosaic origRect d ) + changeMosaic + + ratew :: (NamedWindow,Rectangle) -> Double + ratew (w,r) = rate f meanarea (findlist w hints) r + example_mosaic :: [NamedWindow] -> Mosaic NamedWindow + example_mosaic ws = M (map OM ws) + rect_mosaic :: Rectangle -> CutDirection -> Mosaic (a,Double) -> Mosaic (a,Rectangle) + rect_mosaic r _ (OM (w,_)) = OM (w,r) + rect_mosaic r d (M ws) = M $ zipWith (\w' r' -> rect_mosaic r' d' w') ws rs + where areas = map (sum . map snd . flattenMosaic) ws + rs = partitionR d r areas + d' = otherDirection d + rate_mosaic :: ((NamedWindow,Rectangle) -> Double) + -> Mosaic (NamedWindow,Rectangle) -> Rated Double (Mosaic (NamedWindow,Rectangle)) + rate_mosaic r m = catRatedM $ fmap (\x -> Rated (r x) x) m +{- hunk ./Mosaic.hs 189 - +-} hunk ./Mosaic.hs 197 - sumareas ws = sum $ map (\w -> M.findWithDefault 1 w theareas) ws + sumareas ws = sum $ map findarea ws + findarea :: NamedWindow -> Double + findarea w = M.findWithDefault 1 w theareas hunk ./Mosaic.hs 210 +catRatedM :: Floating v => Mosaic (Rated v a) -> Rated v (Mosaic a) +catRatedM (OM (Rated v x)) = Rated v (OM x) +catRatedM (M xs) = case catRated $ map catRatedM xs of Rated v xs' -> Rated v (M xs') + hunk ./Mosaic.hs 239 -getOne :: (Random a) => (a,a) -> State CountDown a -getOne bounds = do CD g n <- get - (x,g') <- return $ randomR bounds g - put $ CD g' n - return x - -fractional :: Int -> State CountDown Double -fractional n = ((/ fromIntegral n).fromIntegral) `fmap` getOne (1,n) - hunk ./Mosaic.hs 306 +instance Functor Mosaic where + fmap f (OM x) = OM (f x) + fmap f (M xs) = M (map (fmap f) xs) + +zipMLwith :: (a -> b -> c) -> Mosaic a -> [b] -> Mosaic c +zipMLwith f (OM x) (y:_) = OM (f x y) +zipMLwith _ (OM _) [] = error "bad zipMLwith" +zipMLwith f (M xxs) yys = makeM $ foo xxs yys + where foo (x:xs) ys = zipMLwith f x (take (lengthM x) ys) : + foo xs (drop (lengthM x) ys) + foo [] _ = [] + +zipML :: Mosaic a -> [b] -> Mosaic (a,b) +zipML = zipMLwith (\a b -> (a,b)) + +lengthM :: Mosaic a -> Int +lengthM (OM _) = 1 +lengthM (M x) = sum $ map lengthM x + +changeMosaic :: Mosaic a -> [Mosaic a] +changeMosaic (OM a) = [] +changeMosaic (M xs) = [makeM $ reverse xs] ++ + map makeM (concatenations xs) ++ + map makeM (splits xs) -- should also change the lower level + +splits :: [Mosaic a] -> [[Mosaic a]] +splits [] = [] +splits (OM x:y) = map (OM x:) $ splits y +splits (M (x:y):z) = (x:makeM y:z) : map (makeM (x:y) :) (splits z) +splits (M []:x) = splits x + +concatenations :: [Mosaic a] -> [[Mosaic a]] +concatenations (x:y:z) = (concatenateMosaic x y:z):(map (x:) $ concatenations (y:z)) +concatenations _ = [] + +concatenateMosaic :: Mosaic a -> Mosaic a -> Mosaic a +concatenateMosaic (OM a) (OM b) = M [OM a, OM b] +concatenateMosaic (OM a) (M b) = M (OM a:b) +concatenateMosaic (M a) (OM b) = M (a++[OM b]) +concatenateMosaic (M a) (M b) = M (a++b) + +makeM :: [Mosaic a] -> Mosaic a +makeM [m] = m +makeM [] = error "makeM []" +makeM ms = M ms + hunk ./Mosaic.hs 5 --- This module defines a "mosaic" layout, which tries to give all windows --- equal area, while also trying to give them a user-defined (and run-time --- adjustable) aspect ratio. You can use mod-l and mod-h to adjust the --- aspect ratio (which probably won't have a very interesting effect unless --- you've got a number of windows upen. - --- My intent is to extend this layout to optimize various constraints, such --- as windows that should have a different aspect ratio, a fixed size, or --- minimum dimensions in certain directions. +-- This module defines a "mosaic" layout, which tries to give each window a +-- user-configurable relative area, while also trying to give them aspect +-- ratios configurable at run-time by the user. See comments below for the +-- key bindings. hunk ./Mosaic.hs 322 -changeMosaic (M xs) = [makeM $ reverse xs] ++ - map makeM (concatenations xs) ++ - map makeM (splits xs) -- should also change the lower level +changeMosaic (M xs) = map makeM (concatenations xs) ++ + map makeM (splits xs) ++ + map M (tryAll changeMosaic xs) + +tryAll :: (a -> [a]) -> [a] -> [[a]] +tryAll _ [] = [] +tryAll f (x:xs) = map (:xs) (f x) ++ map (x:) (tryAll f xs) + +onceToEach :: (a -> a) -> [a] -> [[a]] +onceToEach _ [] = [] +onceToEach f (x:xs) = (f x : xs) : map (x:) (onceToEach f xs) hunk ./Anneal.hs 60 -select :: [a] -> State (Anneal x) a -select [] = error "empty list in select" +select :: [a] -> State (Anneal a) a +select [] = the_value `fmap` gets best hunk ./Anneal.hs 1 -module XMonadContrib.Anneal ( Rated(Rated), the_value, the_rating, anneal ) where +module XMonadContrib.Anneal ( Rated(Rated), the_value, the_rating + , anneal, annealMax ) where hunk ./Anneal.hs 25 +annealMax :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a +annealMax st r sel = runAnneal st (negate . r) (do_anneal sel) + hunk ./Mosaic.hs 156 - anneal (zipML (example_mosaic ws) (map findarea ws)) + annealMax (zipML (example_mosaic ws) (map findarea ws)) hunk ./Mosaic.hs 33 -import Operations ( Resize(Shrink, Expand) ) +import Operations ( full, Resize(Shrink, Expand) ) hunk ./Mosaic.hs 71 -mosaic delta tileFrac hints = Layout { doLayout = mosaicL tileFrac hints, modifyLayout = mlayout } +mosaic delta tileFrac hints = full { doLayout = mosaicL tileFrac hints, modifyLayout = return . mlayout } hunk ./Tabbed.hs 14 +import Control.Monad.State ( gets ) hunk ./Tabbed.hs 20 +import qualified StackSet as W hunk ./Tabbed.hs 32 - maketab (t,w) = newDecoration t 1 0xFF0000 0x00FFFF (drawtab t w) (focus w) - drawtab r w d w' gc = + maketab (t,w) = newDecoration t 1 0x000000 0x00FFFF (drawtab t w) (focus w) + drawtab r@(Rectangle _ _ wt ht) w d w' gc = hunk ./Tabbed.hs 35 + focusw <- gets (W.focus . W.stack . W.workspace . W.current . windowset) + let tabcolor = if focusw == w then 0xBBBBBB else 0x888888 + io $ setForeground d gc tabcolor + io $ fillRectangles d w' gc [Rectangle 0 0 wt ht] + io $ setForeground d gc 0x000000 hunk ./Circle.hs 8 - modifyLayout = const Nothing } + modifyLayout = return . const Nothing } hunk ./Spiral.hs 36 - modifyLayout = \m -> fmap resize $ fromMessage m } + modifyLayout = \m -> return $ fmap resize $ fromMessage m } hunk ./TwoPane.hs 27 - message x = case fromMessage x of + message x = return $ case fromMessage x of hunk ./Decoration.hs 4 +import Data.Bits ( (.|.) ) hunk ./Decoration.hs 22 + io $ selectInput d win $ exposureMask .|. buttonPressMask hunk ./Decoration.hs 35 - handle_event (AnyEvent {ev_window = thisw}) | thisw == win = draw' + handle_event (AnyEvent {ev_window = thisw, ev_event_type = t}) + | thisw == win && t == expose = draw' hunk ./Decoration.hs 38 - draw' hunk ./Tabbed.hs 32 - maketab (t,w) = newDecoration t 1 0x000000 0x00FFFF (drawtab t w) (focus w) + maketab (t,w) = newDecoration t 1 0x000000 0x777777 (drawtab t w) (focus w) hunk ./Tabbed.hs 47 - namew = wt - 20 + namew = wt - 10 hunk ./Tabbed.hs 29 -dolay sc@(Rectangle x _ wid _) ws = - do let ts = gentabs x wid (length ws) +dolay sc@(Rectangle x y wid _) ws = + do let ts = gentabs x y wid (length ws) hunk ./Tabbed.hs 57 -gentabs :: Position -> Dimension -> Int -> [Rectangle] -gentabs _ _ 0 = [] -gentabs x1 w num = Rectangle x1 0 (wid - 2) (tabsize - 2) - : gentabs (x1 + fromIntegral wid) (w - wid) (num - 1) +gentabs :: Position -> Position -> Dimension -> Int -> [Rectangle] +gentabs _ _ _ 0 = [] +gentabs x y w num = Rectangle x y (wid - 2) (tabsize - 2) + : gentabs (x + fromIntegral wid) y (w - wid) (num - 1) hunk ./Tabbed.hs 13 -import Control.Monad ( forM ) +import Control.Monad ( forM, liftM ) hunk ./Tabbed.hs 35 - focusw <- gets (W.focus . W.stack . W.workspace . W.current . windowset) - let tabcolor = if focusw == w then 0xBBBBBB else 0x888888 + tabcolor <- (maybe 0x888888 (\focusw -> if focusw == w then 0xBBBBBB else 0x888888) . W.peek) `liftM` gets windowset hunk ./Decoration.hs 14 -newDecoration :: Rectangle -> Int -> Pixel -> Pixel +newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel hunk ./Decoration.hs 16 -newDecoration (Rectangle x y w h) th fg bg draw click = +newDecoration decfor (Rectangle x y w h) th fg bg draw click = hunk ./Decoration.hs 36 - | thisw == win && t == expose = draw' + | thisw == win && t == expose = draw' + | thisw == decfor && t == propertyNotify = draw' hunk ./Tabbed.hs 32 - maketab (t,w) = newDecoration t 1 0x000000 0x777777 (drawtab t w) (focus w) + maketab (t,w) = newDecoration w t 1 0x000000 0x777777 (drawtab t w) (focus w) hunk ./DynamicLog.hs 17 -module XMonadContrib.DynamicLog where +module XMonadContrib.DynamicLog (dynamicLog, dynamicLogXinerama) where hunk ./DynamicLog.hs 41 - ppr s = concatMap fmt $ sortBy tags + ppr s = concatMap fmt $ sortBy (compare `on` S.tag) hunk ./DynamicLog.hs 43 - where tags a b = S.tag a `compare` S.tag b - this = S.tag (S.workspace (S.current s)) - pprTag = show . (+(1::Int)) . fromIntegral . S.tag + where this = S.tag (S.workspace (S.current s)) hunk ./DynamicLog.hs 51 +-- +-- Workspace logger with a format designed for Xinerama: +-- +-- [1 9 3] 2 7 +-- +-- where 1, 9, and 3 are the workspaces on screens 1, 2 and 3, respectively, +-- and 2 and 7 are non-visible, non-empty workspaces +-- +dynamicLogXinerama :: X () +dynamicLogXinerama = withWindowSet $ io . putStrLn . ppr + where + ppr ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen + where onscreen = map (pprTag . S.workspace) . sortBy (compare `on` S.screen) $ S.current ws : S.visible ws + offscreen = map pprTag . filter ((/= S.Empty) . S.stack) . sortBy (compare `on` S.tag) $ S.hidden ws + +-- util functions +pprTag :: Integral i => S.Workspace i a -> String +pprTag = show . (+(1::Int)) . fromIntegral . S.tag + +on :: (a -> a -> c) -> (b -> a) -> b -> b -> c +on f g a b = (g a) `f` (g b) + hunk ./DynamicLog.hs 63 - where onscreen = map (pprTag . S.workspace) . sortBy (compare `on` S.screen) $ S.current ws : S.visible ws - offscreen = map pprTag . filter ((/= S.Empty) . S.stack) . sortBy (compare `on` S.tag) $ S.hidden ws + where onscreen = map (pprTag . S.workspace) + . sortBy (compare `on` S.screen) $ S.current ws : S.visible ws + offscreen = map pprTag . filter ((/= S.Empty) . S.stack) + . sortBy (compare `on` S.tag) $ S.hidden ws addfile ./WorkspaceDir.hs hunk ./WorkspaceDir.hs 1 +module XMonadContrib.WorkspaceDir ( workspaceDir, changeDir ) where + +-- to use: + +-- import XMonadContrib.WorkspaceDir + +-- defaultLayouts = map (workspaceDir "~") [ tiled, ... ] + +-- In keybindings: +-- , ((modMask .|. shiftMask, xK_x ), changeDir ["~","/tmp"]) + +import System.Directory ( setCurrentDirectory, getCurrentDirectory ) +import Data.List ( nub ) + +import XMonad +import Operations ( sendMessage ) +import XMonadContrib.Dmenu ( dmenu, runProcessWithInput ) + +data Chdir = Chdir String deriving ( Typeable ) +instance Message Chdir + +workspaceDir :: String -> Layout -> Layout +workspaceDir wd l = l { doLayout = \r x -> scd wd >> doLayout l r x + , modifyLayout = ml } + where ml m | Just (Chdir wd') <- fromMessage m = return $ Just (workspaceDir wd' l) + | otherwise = fmap (workspaceDir wd) `fmap` modifyLayout l m + +scd :: String -> X () +scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` \_ -> return x) + safeIO $ setCurrentDirectory x' + +changeDir :: [String] -> X () +changeDir dirs = do thisd <- io getCurrentDirectory + dir <- dmenu (nub (thisd:dirs)) + sendMessage (Chdir dir) hunk ./WorkspaceDir.hs 30 - safeIO $ setCurrentDirectory x' + catchIO $ setCurrentDirectory x' hunk ./Circle.hs 5 +import StackSet (integrate) hunk ./Circle.hs 8 -circle = Layout { doLayout = circleLayout, +circle = Layout { doLayout = \r -> circleLayout r . integrate, hunk ./GreedyView.hs 28 -import StackSet as W +import StackSet as W hiding (filter) hunk ./HintedTile.hs 5 +import qualified StackSet as W hunk ./HintedTile.hs 22 - Layout { doLayout = \r w -> do { hints <- sequence (map getHints w) - ; return $ zip w (tiler frac r `uncurry` splitAt nmaster hints) } - , modifyLayout = \m -> fmap resize (fromMessage m) `mplus` - fmap incmastern (fromMessage m) } + Layout { doLayout = \r w' -> let w = W.integrate w' + in do { hints <- sequence (map getHints w) + ; return $ zip w (tiler frac r `uncurry` splitAt nmaster hints) } + , modifyLayout = \m -> return $ fmap resize (fromMessage m) `mplus` + fmap incmastern (fromMessage m) } hunk ./Mosaic.hs 34 +import qualified StackSet as W hunk ./Mosaic.hs 72 -mosaic delta tileFrac hints = full { doLayout = mosaicL tileFrac hints, modifyLayout = return . mlayout } +mosaic delta tileFrac hints = full { doLayout = \r -> mosaicL tileFrac hints r . W.integrate, modifyLayout = return . mlayout } hunk ./RotView.hs 16 -import StackSet +import StackSet hiding (filter) hunk ./Spiral.hs 7 +import qualified StackSet as W hunk ./Spiral.hs 36 -spiral scale = Layout { doLayout = fibLayout, +spiral scale = Layout { doLayout = \r -> fibLayout r . W.integrate, hunk ./Tabbed.hs 27 -dolay :: Rectangle -> [Window] -> X [(Window, Rectangle)] -dolay sc [w] = return [(w,sc)] -dolay sc@(Rectangle x y wid _) ws = - do let ts = gentabs x y wid (length ws) +dolay :: Rectangle -> W.Stack Window -> X [(Window, Rectangle)] +dolay sc (W.Node w [] []) = return [(w,sc)] +dolay sc@(Rectangle x y wid _) s@(W.Node w _ _) = + do let ws = W.integrate s + ts = gentabs x y wid (length ws) hunk ./Tabbed.hs 52 - return [ (w,shrink sc) | w <- ws ] + return [ (w,shrink sc) ] hunk ./TwoPane.hs 16 -twoPane delta split = Layout { doLayout = arrange, modifyLayout = message } +twoPane delta split = Layout { doLayout = \r -> arrange r . W.integrate, modifyLayout = message } hunk ./TwoPane.hs 19 + -- TODO this is buggy, it might peek another workspace addfile ./MetaModule.hs hunk ./MetaModule.hs 1 +-- Maintainer: Spencer Janssen +-- +-- This is an artificial dependency on all the XMonadContrib.* modules. It is +-- intended to help xmonad hackers ensure that contrib modules build after API +-- changes. +-- +-- Please add new modules to this list (in alphabetical order). + +module XMonadContrib.MetaModule () where + +import XMonadContrib.Anneal () +-- commented because of conflicts with 6.6's instances import XMonadContrib.BackCompat () +import XMonadContrib.Circle () +-- TODO commented because it requires hs-boot modifications import XMonadContrib.Commands () +import XMonadContrib.Decoration () +import XMonadContrib.Dmenu () +import XMonadContrib.DwmPromote () +import XMonadContrib.DynamicLog () +import XMonadContrib.Dzen () +import XMonadContrib.FindEmptyWorkspace () +import XMonadContrib.GreedyView () +import XMonadContrib.HintedTile () +import XMonadContrib.LayoutHints () +import XMonadContrib.Mosaic () +import XMonadContrib.NamedWindows () +import XMonadContrib.RotView () +import XMonadContrib.SimpleDate () +import XMonadContrib.Spiral () +import XMonadContrib.Submap () +import XMonadContrib.Tabbed () +import XMonadContrib.TwoPane () +import XMonadContrib.Warp () +import XMonadContrib.WorkspaceDir () hunk ./GreedyView.hs 1 +-- Maintainer: Spencer Janssen +-- hunk ./TwoPane.hs 1 +-- Maintainer: Spencer Janssen +-- hunk ./Mosaic.hs 2 - tallWindow, wideWindow, + tallWindow, wideWindow, flexibleWindow, hunk ./Mosaic.hs 26 +-- , ((controlMask .|. modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . flexibleWindow)) hunk ./Mosaic.hs 49 + | FlexibleWindow NamedWindow hunk ./Mosaic.hs 58 +flexibleWindow = FlexibleWindow hunk ./Mosaic.hs 82 + m2 (FlexibleWindow w) = mosaic delta tileFrac (make_flexible w hints) hunk ./Mosaic.hs 100 +make_flexible :: NamedWindow + -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] +make_flexible = alterlist (map f) where f (AspectRatio r) = FlexibleAspectRatio r + f (FlexibleAspectRatio r) = AspectRatio r + f x = x + hunk ./LayoutHints.hs 6 -import Operations ( applySizeHints ) +import Operations ( applySizeHints, D ) hunk ./LayoutHints.hs 9 +import {-#SOURCE#-} Config (borderWidth) hunk ./LayoutHints.hs 12 +-- | Expand a size by the given multiple of the border width. The +-- multiple is most commonly 1 or -1. +adjBorders :: Dimension -> D -> D +adjBorders mult (w,h) = (w+2*mult*borderWidth, h+2*mult*borderWidth) + hunk ./LayoutHints.hs 26 - let (c',d') = applySizeHints sh (c,d) + let (c',d') = adjBorders 1 . applySizeHints sh . adjBorders (-1) $ (c,d) hunk ./FindEmptyWorkspace.hs 22 --- Now you can jump to an empty workspace with mod-n. Mod-shift-n will +-- Now you can jump to an empty workspace with mod-m. Mod-shift-m will hunk ./Mosaic.hs 15 --- defaultLayouts = [ mosaic (1%4) (1%2) M.empty M.empty, full, +-- defaultLayouts = [ mosaic 0.25 0.5 M.empty M.empty, full, hunk ./Tabbed.hs 28 +dolay _ W.Empty = return [] addfile ./LayoutHooks.hs hunk ./Decoration.hs 3 -import qualified Data.Map as M hunk ./Decoration.hs 5 -import Control.Monad.State ( modify, gets ) hunk ./Decoration.hs 8 +import XMonadContrib.LayoutHooks + hunk ./Decoration.hs 12 -import qualified StackSet as W hunk ./Decoration.hs 15 -newDecoration decfor (Rectangle x y w h) th fg bg draw click = - do d <- asks display - rt <- asks theRoot - n <- (W.tag . W.workspace . W.current) `fmap` gets windowset - Just (l,ls) <- M.lookup n `fmap` gets layouts - win <- io $ createSimpleWindow d rt x y w h (fromIntegral th) fg bg - io $ selectInput d win $ exposureMask .|. buttonPressMask - io $ mapWindow d win - let draw' = withGC win draw - modml :: (SomeMessage -> X (Maybe Layout)) -> SomeMessage -> X (Maybe Layout) - modml oldml m | Just ModifyWindows == fromMessage m = io (destroyWindow d win) >> oldml m - | Just e <- fromMessage m = handle_event e >> oldml m - | otherwise = fmap modl `fmap` oldml m - modl :: Layout -> Layout - modl oldl = oldl { modifyLayout = modml (modifyLayout oldl) } - handle_event (ButtonEvent {ev_subwindow = thisw,ev_event_type = t}) - | t == buttonPress && thisw == win = click - handle_event (ButtonEvent {ev_window = thisw,ev_event_type = t}) - | t == buttonPress && thisw == win = click - handle_event (AnyEvent {ev_window = thisw, ev_event_type = t}) - | thisw == win && t == expose = draw' - | thisw == decfor && t == propertyNotify = draw' - handle_event _ = return () - modify $ \s -> s { layouts = M.insert n (modl l,ls) (layouts s) } - return win +newDecoration decfor (Rectangle x y w h) th fg bg draw click = do + d <- asks display + rt <- asks theRoot + win <- io $ createSimpleWindow d rt x y w h (fromIntegral th) fg bg + io $ selectInput d win $ exposureMask .|. buttonPressMask + io $ mapWindow d win + + trace $ "created decoration " ++ show win + + let hook :: SomeMessage -> X Bool + hook sm | Just e <- fromMessage sm = handle_event e >> (trace $ "handle even " ++ show win ++ show e) >> return True + | Just ModifyWindows == fromMessage sm = io (destroyWindow d win) >> (trace $ "destroyed decoration " ++ show win) >> return False + | otherwise = (trace $ "something weird " ++ show win) >> return True + + handle_event (ButtonEvent {ev_subwindow = thisw,ev_event_type = t}) + | t == buttonPress && thisw == win = click + handle_event (ButtonEvent {ev_window = thisw,ev_event_type = t}) + | t == buttonPress && thisw == win = click + handle_event (AnyEvent {ev_window = thisw, ev_event_type = t}) + | thisw == win && t == expose = withGC win draw + | thisw == decfor && t == propertyNotify = withGC win draw + handle_event _ = return () + + addLayoutMessageHook hook + + return win hunk ./LayoutHooks.hs 1 +module XMonadContrib.LayoutHooks ( addLayoutMessageHook ) where + +import qualified Data.Map as M ( adjust ) +import Control.Arrow ( first ) +import Control.Monad.State ( modify ) + +import XMonad +import qualified StackSet as W + +install :: (SomeMessage -> X Bool) -> Layout -> Layout +install hk lay = lay{ modifyLayout = mod' } + where + mod' msg = do reinst <- hk msg + nlay <- modifyLayout lay msg + + return $ cond_reinst reinst nlay + + -- no need to make anything change + cond_reinst True Nothing = Nothing + -- reinstall + cond_reinst True (Just nlay) = Just (install hk nlay) + -- restore inner layout + cond_reinst False Nothing = Just lay + -- let it rot + cond_reinst False (Just nlay) = Just nlay + +-- Return True each time you want the hook reinstalled +addLayoutMessageHook :: (SomeMessage -> X Bool) -> X () +addLayoutMessageHook hk = modify $ \ s -> + let nr = W.tag . W.workspace . W.current . windowset $ s + in s { layouts = M.adjust (first $ install hk) nr (layouts s) } replace ./Decoration.hs [A-Za-z_0-9] ModifyWindows UnDoLayout addfile ./Combo.hs hunk ./Combo.hs 1 +-- A layout that combines multiple layouts. + +-- To use this layout, 'import XMonadContrib.Combo' and add something like +-- 'combo [(full,1),(tabbed,1)] (twoPane 0.03 0.5)' to your defaultLayouts. + +module XMonadContrib.Combo where + +import XMonad + +combo :: [(Layout, Int)] -> Layout -> Layout +combo origls super = Layout { doLayout = arrange, modifyLayout = message } + where arrange _ [] = return [] + arrange r [w] = return [(w,r)] + arrange rinput origws = + do rs <- map snd `fmap` doLayout super rinput (take (length origls) origws) + let wss [] _ = [] + wss [_] ws = [ws] + wss (n:ns) ws = take len1 ws : wss ns (drop len1 ws) + where len1 = min n (length ws - length ns) + out <- sequence $ zipWith3 doLayout (map fst origls) rs + (wss (take (length rs) $ map snd origls) origws) + return $ concat out + message m = do msuper' <- modifyLayout super m + case msuper' of + Nothing -> return Nothing + Just super' -> return $ Just $ combo origls super' addfile ./Square.hs hunk ./Square.hs 1 +-- A layout that splits the screen into a square area and the rest of the +-- screen. + + +-- An example layout using square to make the very last area square: + +-- , combo [(tabbed,3),(tabbed,30),(tabbed,1),(tabbed,1)] +-- (combo [(twoPane 0.03 0.2,1) +-- ,(combo [(twoPane 0.03 0.8,1),(square,1)] +-- (mirror $ twoPane 0.03 0.85),1)] (twoPane 0.03 0.5) ) + +module XMonadContrib.Square ( square ) where + +import XMonad +import Graphics.X11.Xlib + +square :: Layout +square = Layout { doLayout = arrange, modifyLayout = message } + where + arrange rect ws@(_:_) = do + let (rest, sq) = splitSquare rect + return (map (\w->(w,rest)) (init ws) ++ [(last ws,sq)]) + arrange _ [] = return [] + + message _ = return Nothing + +splitSquare :: Rectangle -> (Rectangle, Rectangle) +splitSquare (Rectangle x y w h) + | w > h = (Rectangle x y (w - h) h, Rectangle (x+fromIntegral (w-h)) y h h) + | otherwise = (Rectangle x y w (h-w), Rectangle x (y+fromIntegral (h-w)) w w) hunk ./Square.hs 16 +import StackSet ( integrate ) hunk ./Square.hs 19 -square = Layout { doLayout = arrange, modifyLayout = message } +square = Layout { doLayout = \r s -> arrange r (integrate s), modifyLayout = message } hunk ./Combo.hs 9 +import StackSet ( integrate, differentiate ) hunk ./Combo.hs 12 -combo origls super = Layout { doLayout = arrange, modifyLayout = message } +combo origls super = Layout { doLayout = \r s -> arrange r (integrate s), modifyLayout = message } hunk ./Combo.hs 16 - do rs <- map snd `fmap` doLayout super rinput (take (length origls) origws) + do rs <- map snd `fmap` doLayout super rinput (differentiate $ take (length origls) origws) hunk ./Combo.hs 22 - (wss (take (length rs) $ map snd origls) origws) + (map differentiate $ + wss (take (length rs) $ map snd origls) origws) hunk ./MetaModule.hs 26 +import XMonadContrib.NoBorders () addfile ./NoBorders.hs hunk ./NoBorders.hs 1 +module XMonadContrib.NoBorders ( noBorders, withBorder ) where + +-- Make a given layout display without borders. This is useful for +-- full-screen or tabbed layouts, where you don't really want to waste a +-- couple of pixels of real estate just to inform yourself that the visible +-- window has focus. + +-- Usage: + +-- import XMonadContrib.NoBorders + +-- layouts = [ noBorders full, tall, ... ] + +import Control.Monad.State ( gets ) +import Graphics.X11.Xlib + +import XMonad +import Operations ( ModifyWindows(ModifyWindows) ) +import qualified StackSet as W +import {-# SOURCE #-} Config (borderWidth) + +noBorders :: Layout -> Layout +noBorders = withBorder 0 + +withBorder :: Dimension -> Layout -> Layout +withBorder bd l = l { doLayout = \r x -> setborders bd >> doLayout l r x + , modifyLayout = ml } + where ml m | Just ModifyWindows == fromMessage m + = do setborders borderWidth + fmap (withBorder bd) `fmap` (modifyLayout l) m + | otherwise = fmap (withBorder bd) `fmap` (modifyLayout l) m + +setborders :: Dimension -> X () +setborders bw = withDisplay $ \d -> + do ws <- gets (W.integrate . W.stack . W.workspace . W.current . windowset) + mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws replace ./NoBorders.hs [A-Za-z_0-9] ModifyWindows UnDoLayout hunk ./MetaModule.hs 15 +import XMonadContrib.Combo () hunk ./MetaModule.hs 31 +import XMonadContrib.Square () hunk ./Combo.hs 16 - do rs <- map snd `fmap` doLayout super rinput (differentiate $ take (length origls) origws) + do rs <- map snd `fmap` runLayout super rinput (differentiate $ take (length origls) origws) hunk ./Combo.hs 21 - out <- sequence $ zipWith3 doLayout (map fst origls) rs - (map differentiate $ - wss (take (length rs) $ map snd origls) origws) + out <- sequence $ zipWith3 runLayout (map fst origls) rs + (map differentiate $ + wss (take (length rs) $ map snd origls) origws) hunk ./DwmPromote.hs 36 -swap = modify Empty $ \c -> case c of - Node _ [] [] -> c - Node t [] (x:rs) -> Node x [] (t:rs) - Node t ls rs -> Node t [] (ys ++ x : rs) where (x:ys) = reverse ls +swap = modify' $ \c -> case c of + Stack _ [] [] -> c + Stack t [] (x:rs) -> Stack x [] (t:rs) + Stack t ls rs -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls hunk ./DynamicLog.hs 23 +import Data.Maybe ( isJust ) hunk ./DynamicLog.hs 49 - | S.stack w /= S.Empty = " " ++ pprTag w ++ " " + | isJust (S.stack w) = " " ++ pprTag w ++ " " hunk ./DynamicLog.hs 66 - offscreen = map pprTag . filter ((/= S.Empty) . S.stack) + offscreen = map pprTag . filter (isJust . S.stack) hunk ./FindEmptyWorkspace.hs 32 +import Data.Maybe ( isNothing ) hunk ./FindEmptyWorkspace.hs 44 -findEmptyWorkspace = find (isEmpty . stack) . allWorkspaces +findEmptyWorkspace = find (isNothing . stack) . allWorkspaces hunk ./FindEmptyWorkspace.hs 46 - isEmpty Empty = True - isEmpty _ = False hunk ./NoBorders.hs 35 - do ws <- gets (W.integrate . W.stack . W.workspace . W.current . windowset) + do ws <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset) hunk ./RotView.hs 13 -import Data.Maybe ( listToMaybe ) +import Data.Maybe ( listToMaybe, isJust ) hunk ./RotView.hs 25 - nextws = listToMaybe . filter (not.isEmpty) . (if b then id else reverse) $ pivoted + nextws = listToMaybe . filter (isJust . stack) . (if b then id else reverse) $ pivoted hunk ./RotView.hs 28 -isEmpty :: Workspace i a -> Bool -isEmpty ws = case stack ws of - Empty -> True - _ -> False - hunk ./Tabbed.hs 28 -dolay _ W.Empty = return [] -dolay sc (W.Node w [] []) = return [(w,sc)] -dolay sc@(Rectangle x y wid _) s@(W.Node w _ _) = +dolay sc (W.Stack w [] []) = return [(w,sc)] +dolay sc@(Rectangle x y wid _) s@(W.Stack w _ _) = hunk ./Decoration.hs 1 +{-# OPTIONS -fglasgow-exts #-} hunk ./GreedyView.hs 1 +{-# OPTIONS -fglasgow-exts #-} hunk ./Mosaic.hs 1 +{-# OPTIONS -fglasgow-exts #-} hunk ./WorkspaceDir.hs 1 +{-# OPTIONS -fglasgow-exts #-} addfile ./MagicFocus.hs hunk ./MagicFocus.hs 1 +module XMonadContrib.MagicFocus (magicFocus) where + +import XMonad +import StackSet + +magicFocus l = l { doLayout = \s -> (doLayout l) s . swap + , modifyLayout = \x -> fmap magicFocus `fmap` modifyLayout l x } + +swap :: Stack a -> Stack a +swap Empty = Empty +swap (Node f u d) = Node f [] (reverse u ++ d) hunk ./MetaModule.hs 25 +import XMonadContrib.MagicFocus () hunk ./MagicFocus.hs 10 -swap Empty = Empty -swap (Node f u d) = Node f [] (reverse u ++ d) +swap (Stack f u d) = Stack f [] (reverse u ++ d) hunk ./Decoration.hs 23 - trace $ "created decoration " ++ show win - - let hook :: SomeMessage -> X Bool - hook sm | Just e <- fromMessage sm = handle_event e >> (trace $ "handle even " ++ show win ++ show e) >> return True - | Just UnDoLayout == fromMessage sm = io (destroyWindow d win) >> (trace $ "destroyed decoration " ++ show win) >> return False - | otherwise = (trace $ "something weird " ++ show win) >> return True + let hook :: SomeMessage -> X Bool + hook sm | Just e <- fromMessage sm = handle_event e >> return True + | Just UnDoLayout == fromMessage sm = io (destroyWindow d win) >> return False + | otherwise = return True hunk ./Tabbed.hs 1 -module XMonadContrib.Tabbed ( tabbed ) where +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Tabbed +-- Copyright : (c) David Roundy +-- License : ??? GPL 2 ??? +-- +-- Maintainer : email@address.com +-- Stability : unstable +-- Portability : unportable +-- +-- A tabbed layout for the Xmonad Window Manager +-- +----------------------------------------------------------------------------- hunk ./Tabbed.hs 15 --- This module defines a tabbed layout. - --- You can use this module with the following in your config file: - --- import XMonadContrib.Tabbed - --- defaultLayouts :: [Layout] --- defaultLayouts = [ tabbed --- , ... ] +module XMonadContrib.Tabbed ( + -- * Usage: + -- $usage + tabbed + ) where hunk ./Tabbed.hs 32 +-- $usage +-- You can use this module with the following in your configuration file: +-- +-- > import XMonadContrib.Tabbed +-- +-- > defaultLayouts :: [Layout] +-- > defaultLayouts = [ tabbed +-- > , ... ] + + hunk ./Tabbed.hs 5 --- License : ??? GPL 2 ??? +-- License : BSD-style (see xmonad/LICENSE) addfile ./LICENSE hunk ./LICENSE 1 +Copyright (c) The Xmonad Community + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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. hunk ./README 17 +------------------------------------------------------------------------ + +Code submitted to the contrib repo is licensed under the same license as +xmonad itself, with copyright held by the authors. + hunk ./Commands.hs 5 +-- License : BSD3 hunk ./Commands.hs 11 ------------------------------------------------------------------------------ --- hunk ./Commands.hs 15 +----------------------------------------------------------------------------- + +module XMonadContrib.Commands ( + -- * Usage + -- $usage + runCommand, + defaultCommands + ) where + +import XMonad +import Operations +import {-# SOURCE #-} Config (workspaces, commands) +import XMonadContrib.Dmenu (dmenu) + +import qualified Data.Map as M +import System.Exit +import Data.Maybe + +-- $usage +-- hunk ./Commands.hs 37 --- import XMonadContrib.Commands +-- > import XMonadContrib.Commands hunk ./Commands.hs 41 --- , ((modMask .|. controlMask, xK_y), runCommand) +-- > , ((modMask .|. controlMask, xK_y), runCommand) hunk ./Commands.hs 45 --- commands = defaultCommands +-- > commands = defaultCommands hunk ./Commands.hs 49 --- import XMonad (X) --- workspaces :: Int --- commands :: [(String, X ())] +-- > import XMonad (X) +-- > workspaces :: Int +-- > commands :: [(String, X ())] hunk ./Commands.hs 58 -module XMonadContrib.Commands where - -import XMonad -import Operations -import {-# SOURCE #-} Config (workspaces, commands) -import XMonadContrib.Dmenu (dmenu) - -import qualified Data.Map as M -import System.Exit -import Data.Maybe hunk ./Tabbed.hs 27 -import Operations ( focus ) +import Operations ( focus, initColor ) hunk ./Tabbed.hs 47 -dolay sc@(Rectangle x y wid _) s@(W.Stack w _ _) = - do let ws = W.integrate s +dolay sc@(Rectangle x y wid _) s@(W.Stack w _ _) = withDisplay $ \d -> + do activecolor <- io $ initColor d "#BBBBBB" + inactivecolor <- io $ initColor d "#888888" + textcolor <- io $ initColor d "#000000" + bgcolor <- io $ initColor d "#000000" + let ws = W.integrate s hunk ./Tabbed.hs 55 - maketab (t,w) = newDecoration w t 1 0x000000 0x777777 (drawtab t w) (focus w) + maketab (t,w) = newDecoration w t 1 bgcolor activecolor (drawtab t w) (focus w) hunk ./Tabbed.hs 58 - tabcolor <- (maybe 0x888888 (\focusw -> if focusw == w then 0xBBBBBB else 0x888888) . W.peek) `liftM` gets windowset + tabcolor <- (maybe inactivecolor (\focusw -> if focusw == w then activecolor else inactivecolor) . W.peek) `liftM` gets windowset hunk ./Tabbed.hs 61 - io $ setForeground d gc 0x000000 + io $ setForeground d gc textcolor hunk ./BackCompat.hs 1 -module XMonadContrib.BackCompat (forM, forM_) where - -{- This file will contain all the things GHC 6.4 users need to compile xmonad. - - Currently, the steps to get compilation are: - - add the following line to StackSet.hs, Operations.hs, and Main.hs: - - import XMonadContrib.BackCompat - -} +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.BackCompat +-- Copyright : (c) daniel@wagner-home.com +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : daniel@wagner-home.com +-- Stability : unstable +-- Portability : unportable +-- +-- A module that provides back compatibility with GHC 6.4 +-- +----------------------------------------------------------------------------- +module XMonadContrib.BackCompat ( + -- * Usage + -- $usage + forM, forM_ + ) where hunk ./BackCompat.hs 23 +{- $usage + +This file will contain all the things GHC 6.4 users need to compile xmonad. +Currently, the steps to get compilation are: +add the following line to StackSet.hs, Operations.hs, and Main.hs: + +> import XMonadContrib.BackCompat + +-} + hunk ./Circle.hs 1 -module XMonadContrib.Circle (circle) where -- actually it's an ellipse +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Circle +-- Copyright : (c) Peter De Wachter +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Peter De Wachter +-- Stability : unstable +-- Portability : unportable +-- +-- Circle is an elliptical, overlapping layout, by Peter De Wachter +-- +----------------------------------------------------------------------------- + +module XMonadContrib.Circle ( + -- * Usage + -- $usage + circle + ) where -- actually it's an ellipse hunk ./Circle.hs 25 +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.Circle + hunk ./Combo.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Combo +-- Copyright : (c) David Roundy +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- hunk ./Combo.hs 12 +-- +----------------------------------------------------------------------------- hunk ./Combo.hs 15 --- To use this layout, 'import XMonadContrib.Combo' and add something like --- 'combo [(full,1),(tabbed,1)] (twoPane 0.03 0.5)' to your defaultLayouts. - -module XMonadContrib.Combo where +module XMonadContrib.Combo ( + -- * Usage + -- $usage + combo + ) where hunk ./Combo.hs 24 +-- $usage +-- +-- To use this layout write, in your Config.hs: +-- +-- > import XMonadContrib.Combo +-- +-- and add something like +-- +-- > combo [(full,1),(tabbed,1)] (twoPane 0.03 0.5) +-- +-- to your defaultLayouts. + hunk ./Decoration.hs 2 -module XMonadContrib.Decoration ( newDecoration ) where +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Decoration +-- Copyright : (c) David Roundy +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- A module to be used to easily define decorations. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.Decoration ( + -- * Usage + -- $usage + newDecoration + ) where hunk ./Decoration.hs 32 +-- $usage +-- You can use this module for writing other extensions. +-- See, for instance, "XMonadContrib.Tabbed" + hunk ./Dmenu.hs 1 -module XMonadContrib.Dmenu (dmenu, dmenuXinerama, runProcessWithInput) where +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Dmenu +-- Copyright : (c) Spencer Janssen +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Spencer Janssen +-- Stability : unstable +-- Portability : unportable +-- +-- A convenient binding to dmenu. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.Dmenu ( + -- * Usage + -- $usage + dmenu, dmenuXinerama, + runProcessWithInput + ) where hunk ./Dmenu.hs 28 +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.Dmenu + hunk ./Dmenu.hs 45 --- Starts dmenu on the current screen. Requires this patch to dmenu: --- http://www.jcreigh.com/dmenu/dmenu-2.8-xinerama.patch +-- | Starts dmenu on the current screen. Requires this patch to dmenu: +-- http:\/\/www.jcreigh.com\/dmenu\/dmenu-2.8-xinerama.patch hunk ./DwmPromote.hs 8 --- ------------------------------------------------------------------------------ +-- Stability : unstable +-- Portability : unportable hunk ./DwmPromote.hs 12 --- +-- hunk ./DwmPromote.hs 17 --- To use, modify your Config.hs to: --- --- import XMonadContrib.DwmPromote --- --- and add a keybinding or substitute promote with dwmpromote: --- --- , ((modMask, xK_Return), dwmpromote) --- +----------------------------------------------------------------------------- hunk ./DwmPromote.hs 19 -module XMonadContrib.DwmPromote (dwmpromote) where +module XMonadContrib.DwmPromote ( + -- * Usage + -- $usage + dwmpromote + ) where hunk ./DwmPromote.hs 29 +-- $usage +-- +-- To use, modify your Config.hs to: +-- +-- > import XMonadContrib.DwmPromote +-- +-- and add a keybinding or substitute promote with dwmpromote: +-- +-- > , ((modMask, xK_Return), dwmpromote) + hunk ./DynamicLog.hs 1 --- +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.DynamicLog +-- Copyright : (c) Don Stewart +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Don Stewart +-- Stability : unstable +-- Portability : unportable +-- hunk ./DynamicLog.hs 15 --- 1 2 [3] 4 8 +-- > 1 2 [3] 4 8 hunk ./DynamicLog.hs 19 --- To use, set: --- --- import XMonadContrib.DynamicLog --- logHook = dynamicLog --- --- Don Stewart +----------------------------------------------------------------------------- hunk ./DynamicLog.hs 21 -module XMonadContrib.DynamicLog (dynamicLog, dynamicLogXinerama) where +module XMonadContrib.DynamicLog ( + -- * Usage + -- $usage + dynamicLog, dynamicLogXinerama + ) where hunk ./DynamicLog.hs 35 +-- $usage hunk ./DynamicLog.hs 37 +-- To use, set: +-- +-- > import XMonadContrib.DynamicLog +-- > logHook = dynamicLog + + +-- | hunk ./DynamicLog.hs 48 - hunk ./DynamicLog.hs 51 --- 1 2 [3] 4 7 +-- > 1 2 [3] 4 7 hunk ./DynamicLog.hs 67 --- +-- | hunk ./DynamicLog.hs 70 --- [1 9 3] 2 7 +-- > [1 9 3] 2 7 hunk ./FindEmptyWorkspace.hs 8 +-- Stability : unstable +-- Portability : unportable hunk ./FindEmptyWorkspace.hs 11 ------------------------------------------------------------------------------ --- --- Find an empty workspace in xmonad. --- --- To use, modify your Config.hs to: --- --- import XMonadContrib.FindEmptyWorkspace --- --- and add a keybinding: --- --- , ((modMask, xK_m ), viewEmptyWorkspace) --- , ((modMask .|. shiftMask, xK_m ), tagToEmptyWorkspace) --- --- Now you can jump to an empty workspace with mod-m. Mod-shift-m will --- tag the current window to an empty workspace and view it. +-- Find an empty workspace in XMonad. hunk ./FindEmptyWorkspace.hs 13 +----------------------------------------------------------------------------- hunk ./FindEmptyWorkspace.hs 16 + -- * Usage + -- $usage hunk ./FindEmptyWorkspace.hs 30 +-- $usage +-- +-- To use, modify your Config.hs to: +-- +-- > import XMonadContrib.FindEmptyWorkspace +-- +-- and add a keybinding: +-- +-- > , ((modMask, xK_m ), viewEmptyWorkspace) +-- > , ((modMask .|. shiftMask, xK_m ), tagToEmptyWorkspace) +-- +-- Now you can jump to an empty workspace with mod-m. Mod-shift-m will +-- tag the current window to an empty workspace and view it. + + hunk ./GreedyView.hs 2 --- Maintainer: Spencer Janssen +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.FindEmptyWorkspace +-- Copyright : (c) Spencer Janssen +-- License : BSD3-style (see LICENSE) hunk ./GreedyView.hs 8 --- greedyView is an alternative to standard workspace switching. When a --- workspace is already visible on another screen, greedyView swaps the +-- Maintainer : Spencer Janssen +-- Stability : unstable +-- Portability : unportable +-- +-- GreedyView is an alternative to standard workspace switching. When a +-- workspace is already visible on another screen, GreedyView swaps the hunk ./GreedyView.hs 16 --- To use GreedyView as your default workspace switcher, +----------------------------------------------------------------------------- + +module XMonadContrib.GreedyView ( + -- * Usage + -- $usage + greedyView + ) where + +import StackSet as W hiding (filter) +import XMonad +import Operations +import Data.List (find) + +-- $usage +-- To use GreedyView as your default workspace switcher hunk ./GreedyView.hs 32 --- Add this import : +-- Add this import: hunk ./GreedyView.hs 34 --- import XMonadContrib.GreedyView +-- > import XMonadContrib.GreedyView hunk ./GreedyView.hs 38 --- this : +-- this: hunk ./GreedyView.hs 40 --- [((m .|. modMask, k), f i) --- | (i, k) <- zip [0 .. fromIntegral workspaces - 1] [xK_1 ..] --- , (f, m) <- [(view, 0), (shift, shiftMask)]] +-- > [((m .|. modMask, k), f i) +-- > | (i, k) <- zip [0 .. fromIntegral workspaces - 1] [xK_1 ..] +-- > , (f, m) <- [(view, 0), (shift, shiftMask)]] hunk ./GreedyView.hs 46 --- [((m .|. modMask, k), f i) --- | (i, k) <- zip [0 .. fromIntegral workspaces - 1] [xK_1 ..] --- , (f, m) <- [(greedyView, 0), (shift, shiftMask)]] +-- > [((m .|. modMask, k), f i) +-- > | (i, k) <- zip [0 .. fromIntegral workspaces - 1] [xK_1 ..] +-- > , (f, m) <- [(greedyView, 0), (shift, shiftMask)]] hunk ./GreedyView.hs 51 -module XMonadContrib.GreedyView (greedyView) where - -import StackSet as W hiding (filter) -import XMonad -import Operations -import Data.List (find) - hunk ./HintedTile.hs 1 -module XMonadContrib.HintedTile (tall, wide) where +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.HintedTile +-- Copyright : (c) Peter De Wachter +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Peter De Wachter +-- Stability : unstable +-- Portability : unportable +-- +-- A gapless tiled layout that attempts to obey window size hints, +-- rather than simply ignoring them. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.HintedTile ( + -- * Usage + -- $usage + tall, wide) where hunk ./HintedTile.hs 29 +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.HintedTile + hunk ./MetaModule.hs 1 --- Maintainer: Spencer Janssen +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.WorkspaceDir +-- Copyright : (c) 2007 Spencer Janssen +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Spencer Janssen +-- Stability : unstable +-- Portability : unportable hunk ./MetaModule.hs 16 +-- +----------------------------------------------------------------------------- + hunk ./Mosaic.hs 2 -module XMonadContrib.Mosaic ( mosaic, expandWindow, shrinkWindow, squareWindow, myclearWindow, - tallWindow, wideWindow, flexibleWindow, - getName, withNamedWindow ) where - --- This module defines a "mosaic" layout, which tries to give each window a +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Mosaic +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- This module defines a \"mosaic\" layout, which tries to give each window a hunk ./Mosaic.hs 14 --- ratios configurable at run-time by the user. See comments below for the --- key bindings. - --- You can use this module with the following in your config file: - --- import XMonadContrib.Mosaic - --- defaultLayouts :: [Layout] --- defaultLayouts = [ mosaic 0.25 0.5 M.empty M.empty, full, --- tall defaultDelta (1%2), wide defaultDelta (1%2) ] - --- In the key-bindings, do something like: - --- , ((controlMask .|. modMask .|. shiftMask, xK_h), withNamedWindow (sendMessage . tallWindow)) --- , ((controlMask .|. modMask .|. shiftMask, xK_l), withNamedWindow (sendMessage . wideWindow)) --- , ((modMask .|. shiftMask, xK_h ), withNamedWindow (sendMessage . shrinkWindow)) --- , ((modMask .|. shiftMask, xK_l ), withNamedWindow (sendMessage . expandWindow)) --- , ((modMask .|. shiftMask, xK_s ), withNamedWindow (sendMessage . squareWindow)) --- , ((modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . myclearWindow)) --- , ((controlMask .|. modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . flexibleWindow)) +-- ratios configurable at run-time by the user. +-- +----------------------------------------------------------------------------- +module XMonadContrib.Mosaic ( + -- * Usage + -- $usage + mosaic, expandWindow, shrinkWindow, squareWindow, myclearWindow, + tallWindow, wideWindow, flexibleWindow, + getName, withNamedWindow ) where hunk ./Mosaic.hs 42 +-- $usage +-- +-- Key bindings: +-- +-- You can use this module with the following in your config file: +-- +-- > import XMonadContrib.Mosaic +-- +-- > defaultLayouts :: [Layout] +-- > defaultLayouts = [ mosaic 0.25 0.5 M.empty M.empty, full, +-- > tall defaultDelta (1%2), wide defaultDelta (1%2) ] +-- +-- In the key-bindings, do something like: +-- +-- > , ((controlMask .|. modMask .|. shiftMask, xK_h), withNamedWindow (sendMessage . tallWindow)) +-- > , ((controlMask .|. modMask .|. shiftMask, xK_l), withNamedWindow (sendMessage . wideWindow)) +-- > , ((modMask .|. shiftMask, xK_h ), withNamedWindow (sendMessage . shrinkWindow)) +-- > , ((modMask .|. shiftMask, xK_l ), withNamedWindow (sendMessage . expandWindow)) +-- > , ((modMask .|. shiftMask, xK_s ), withNamedWindow (sendMessage . squareWindow)) +-- > , ((modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . myclearWindow)) +-- > , ((controlMask .|. modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . flexibleWindow)) +-- + hunk ./NamedWindows.hs 1 -module XMonadContrib.NamedWindows ( NamedWindow, getName, withNamedWindow, unName ) where - +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.NamedWindows +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- hunk ./NamedWindows.hs 12 --- them. See XMonadContrib.Mosaic for an example of its use. +-- them. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.NamedWindows ( + -- * Usage + -- $usage + NamedWindow, + getName, + withNamedWindow, + unName + ) where hunk ./NamedWindows.hs 35 +-- $usage +-- See "XMonadContrib.Mosaic" for an example of its use. + + hunk ./NoBorders.hs 1 -module XMonadContrib.NoBorders ( noBorders, withBorder ) where - +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.NoBorders +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- hunk ./NoBorders.hs 15 +-- +----------------------------------------------------------------------------- hunk ./NoBorders.hs 18 --- Usage: - --- import XMonadContrib.NoBorders - --- layouts = [ noBorders full, tall, ... ] +module XMonadContrib.NoBorders ( + -- * Usage + -- $usage + noBorders, + withBorder + ) where hunk ./NoBorders.hs 33 +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.NoBorders +-- +-- > layouts = [ noBorders full, tall, ... ] + hunk ./RotView.hs 1 -module XMonadContrib.RotView ( rotView ) where - +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.RotView +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- hunk ./RotView.hs 12 +-- +----------------------------------------------------------------------------- hunk ./RotView.hs 15 --- To use: --- import XMonadContrib.RotView - --- , ((modMask .|. shiftMask, xK_Right), rotView True) --- , ((modMask .|. shiftMask, xK_Left), rotView False) +module XMonadContrib.RotView ( + -- * Usage + -- $usage + rotView + ) where hunk ./RotView.hs 29 +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.RotView +-- +-- > , ((modMask .|. shiftMask, xK_Right), rotView True) +-- > , ((modMask .|. shiftMask, xK_Left), rotView False) + hunk ./SimpleDate.hs 3 --- Module : XMonadContrib.Example +-- Module : XMonadContrib.SimpleDate hunk ./SimpleDate.hs 11 ------------------------------------------------------------------------------ --- --- An example external contrib module for xmonad. --- +-- An example external contrib module for XMonad. hunk ./SimpleDate.hs 14 +----------------------------------------------------------------------------- + +module XMonadContrib.SimpleDate ( + -- * Usage + -- $usage + date + ) where + +import XMonad + +-- $usage hunk ./SimpleDate.hs 27 --- import XMonadContrib.SimpleDate +-- > import XMonadContrib.SimpleDate hunk ./SimpleDate.hs 31 --- , ((modMask, xK_d ), date) +-- > , ((modMask, xK_d ), date) hunk ./SimpleDate.hs 34 --- - -module XMonadContrib.SimpleDate where - -import XMonad hunk ./Spiral.hs 1 -module XMonadContrib.Spiral (spiral) where +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.SimpleDate +-- Copyright : (c) Joe Thornber +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Joe Thornber +-- Stability : stable +-- Portability : portable +-- +-- Spiral adds a spiral tiling layout +-- +----------------------------------------------------------------------------- + +module XMonadContrib.Spiral ( + -- * Usage + -- $usage + spiral + ) where hunk ./Spiral.hs 27 +-- $usage +-- You can use this module with the following in your Config.hs file: hunk ./Spiral.hs 30 --- Spiral layout --- --- eg, --- defaultLayouts :: [Layout] --- defaultLayouts = [ full, --- tall defaultWindowsInMaster defaultDelta (1%2), --- wide defaultWindowsInMaster defaultDelta (1%2), --- spiral (1 % 1) ] +-- > import XMonadContrib.Spiral hunk ./Spiral.hs 32 +-- > defaultLayouts :: [Layout] +-- > defaultLayouts = [ full, +-- > tall defaultWindowsInMaster defaultDelta (1%2), +-- > wide defaultWindowsInMaster defaultDelta (1%2), +-- > spiral (1 % 1) ] + hunk ./Square.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Square +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- hunk ./Square.hs 13 +-- This is probably only ever useful in combination with +-- "XMonadContrib.Combo". +-- It sticks one window in a square region, and makes the rest +-- of the windows live with what's left (in a full-screen sense). +-- +----------------------------------------------------------------------------- hunk ./Square.hs 20 - --- An example layout using square to make the very last area square: - --- , combo [(tabbed,3),(tabbed,30),(tabbed,1),(tabbed,1)] --- (combo [(twoPane 0.03 0.2,1) --- ,(combo [(twoPane 0.03 0.8,1),(square,1)] --- (mirror $ twoPane 0.03 0.85),1)] (twoPane 0.03 0.5) ) - -module XMonadContrib.Square ( square ) where +module XMonadContrib.Square ( + -- * Usage + -- $usage + square ) where hunk ./Square.hs 29 +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.Spiral +-- +-- An example layout using square together with "XMonadContrib.Combo" +-- to make the very last area square: +-- +-- > , combo [(tabbed,3),(tabbed,30),(tabbed,1),(tabbed,1)] +-- > (combo [(twoPane 0.03 0.2,1) +-- > ,(combo [(twoPane 0.03 0.8,1),(square,1)] +-- > (mirror $ twoPane 0.03 0.85),1)] (twoPane 0.03 0.5) ) + + hunk ./Submap.hs 1 -{- -Allows you to create a sub-mapping of keys. Example: - - , ((modMask, xK_a), submap . M.fromList $ - [ ((0, xK_n), spawn "mpc next") - , ((0, xK_p), spawn "mpc prev") - , ((0, xK_z), spawn "mpc random") - , ((0, xK_space), spawn "mpc toggle") - ]) - -So, for example, to run 'spawn "mpc next"', you would hit mod-a (to trigger the -submapping) and then 'n' to run that action. (0 means "no modifier"). You are, -of course, free to use any combination of modifiers in the submapping. However, -anyModifier will not work, because that is a special value passed to XGrabKey() -and not an actual modifier. --} +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Submap +-- Copyright : (c) Jason Creighton +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Jason Creighton +-- Stability : unstable +-- Portability : unportable +-- +-- A module that allows the user to create a sub-mapping of keys bindings. +-- +----------------------------------------------------------------------------- hunk ./Submap.hs 15 -module XMonadContrib.Submap where +module XMonadContrib.Submap ( + -- * Usage + -- $usage + submap + ) where hunk ./Submap.hs 29 +{- $usage +Allows you to create a sub-mapping of keys. Example: + +> , ((modMask, xK_a), submap . M.fromList $ +> [ ((0, xK_n), spawn "mpc next") +> , ((0, xK_p), spawn "mpc prev") +> , ((0, xK_z), spawn "mpc random") +> , ((0, xK_space), spawn "mpc toggle") +> ]) + +So, for example, to run 'spawn \"mpc next\"', you would hit mod-a (to trigger the +submapping) and then 'n' to run that action. (0 means \"no modifier\"). You are, +of course, free to use any combination of modifiers in the submapping. However, +anyModifier will not work, because that is a special value passed to XGrabKey() +and not an actual modifier. +-} + hunk ./TwoPane.hs 1 --- Maintainer: Spencer Janssen +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.TwoPane +-- Copyright : (c) JSpencer Janssen +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Spencer Janssen +-- Stability : unstable +-- Portability : unportable hunk ./TwoPane.hs 15 --- To use this layout, 'import XMonadContrib.TwoPane' and add --- 'twoPane defaultDelta (1%2)' to the list of layouts +----------------------------------------------------------------------------- hunk ./TwoPane.hs 17 -module XMonadContrib.TwoPane where +module XMonadContrib.TwoPane ( + -- * Usage + -- $usage + twoPane + ) where hunk ./TwoPane.hs 28 + +-- $usage +-- +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.TwoPane +-- +-- and add, to the list of layouts: +-- +-- > twoPane defaultDelta (1%2) + hunk ./Warp.hs 1 -module XMonadContrib.Warp where +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Warp +-- Copyright : (c) daniel@wagner-home.com +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : daniel@wagner-home.com +-- Stability : unstable +-- Portability : unportable +-- +-- This can be used to make a keybinding that warps the pointer to a given +-- window or screen. +-- +----------------------------------------------------------------------------- hunk ./Warp.hs 16 -{- Usage: - - This can be used to make a keybinding that warps the pointer to a given - - window or screen. For example, I've added the following keybindings to - - my Config.hs: - - - - , ((modMask, xK_z ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window - - - - -- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3 - - ++ - - [((modMask .|. controlMask, key), warpToScreen sc (1%2) (1%2)) - - | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]] - - - - Note that warping to a particular screen may change the focus. - -} +module XMonadContrib.Warp ( + -- * Usage + -- $usage + warpToScreen, + warpToWindow + ) where hunk ./Warp.hs 31 +{- $usage +This can be used to make a keybinding that warps the pointer to a given +window or screen. For example, I've added the following keybindings to +my Config.hs: + +> , ((modMask, xK_z ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window +> +>-- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3 +> +> [((modMask .|. controlMask, key), warpToScreen sc (1%2) (1%2)) +> | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]] + +Note that warping to a particular screen may change the focus. +-} + hunk ./WorkspaceDir.hs 2 -module XMonadContrib.WorkspaceDir ( workspaceDir, changeDir ) where +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.WorkspaceDir +-- Copyright : (c) 2007 David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- WorkspaceDir is an exstension to set the current directory in a workspace. +-- +-- Actually, it sets the current directory in a layout, since there's no way I +-- know of to attach a behavior to a workspace. This means that any terminals +-- (or other programs) pulled up in that workspace (with that layout) will +-- execute in that working directory. Sort of handy, I think. +-- +----------------------------------------------------------------------------- hunk ./WorkspaceDir.hs 21 --- to use: - --- import XMonadContrib.WorkspaceDir - --- defaultLayouts = map (workspaceDir "~") [ tiled, ... ] - --- In keybindings: --- , ((modMask .|. shiftMask, xK_x ), changeDir ["~","/tmp"]) +module XMonadContrib.WorkspaceDir ( + -- * Usage + -- $usage + workspaceDir, + changeDir + ) where hunk ./WorkspaceDir.hs 35 +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.WorkspaceDir +-- > +-- > defaultLayouts = map (workspaceDir "~") [ tiled, ... ] +-- +-- In keybindings: +-- +-- > , ((modMask .|. shiftMask, xK_x ), changeDir ["~","/tmp"]) + + hunk ./Mosaic.hs 326 -data Mosaic a where - M :: [Mosaic a] -> Mosaic a - OM :: a -> Mosaic a +data Mosaic a = M [Mosaic a] | OM a addfile ./Magnifier.hs hunk ./Magnifier.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Magnifier +-- Copyright : (c) Peter De Wachter 2007 +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : Peter De Wachter +-- Stability : unstable +-- Portability : unportable +-- +-- Screenshot : http://caladan.rave.org/magnifier.png +-- +-- This layout hack increases the size of the window that has focus. +-- The master window is left alone. (Maybe that should be an option.) +-- +-- +----------------------------------------------------------------------------- + + +module XMonadContrib.Magnifier (magnifier) where + +import Graphics.X11.Xlib +import XMonad +import StackSet + +magnifier :: Layout -> Layout +magnifier l = l { doLayout = \r s -> applyMagnifier r s `fmap` doLayout l r s + , modifyLayout = \x -> fmap magnifier `fmap` modifyLayout l x } + +applyMagnifier :: Rectangle -> Stack Window -> [(Window, Rectangle)] -> [(Window, Rectangle)] +applyMagnifier r s | null (up s) = id -- don't change the master window + | otherwise = map $ \(w,wr) -> if w == focus s then (w, shrink r $ magnify wr) else (w, wr) + +magnify :: Rectangle -> Rectangle +magnify (Rectangle x y w h) = Rectangle x' y' w' h' + where x' = x - fromIntegral (w' - w) `div` 2 + y' = y - fromIntegral (h' - h) `div` 2 + w' = round $ fromIntegral w * zoom + h' = round $ fromIntegral h * zoom + zoom = 1.5 :: Double + +shrink :: Rectangle -> Rectangle -> Rectangle +shrink (Rectangle sx sy sw sh) (Rectangle x y w h) = Rectangle x' y' w' h' + where x' = max sx x + y' = max sy y + w' = min w (fromIntegral sx + sw - fromIntegral x') + h' = min h (fromIntegral sy + sh - fromIntegral y') hunk ./MetaModule.hs 38 +import XMoandContrib.Magnifier () hunk ./MetaModule.hs 38 -import XMoandContrib.Magnifier () +import XMonadContrib.Magnifier () hunk ./GreedyView.hs 4 --- Module : XMonadContrib.FindEmptyWorkspace +-- Module : XMonadContrib.GreedyView hunk ./TwoPane.hs 4 --- Copyright : (c) JSpencer Janssen +-- Copyright : (c) Spencer Janssen hunk ./Combo.hs 23 +import Operations ( UnDoLayout(UnDoLayout) ) hunk ./Combo.hs 51 + message m | Just UnDoLayout <- fromMessage m = + do (super':ls') <- broadcastPrivate UnDoLayout (super:map fst origls) + return $ Just $ combo (zip ls' $ map snd origls) super' hunk ./Combo.hs 59 +broadcastPrivate :: Message a => a -> [Layout] -> X [Layout] +broadcastPrivate a ol = mapM f ol + where f l = do ml' <- modifyLayout l (SomeMessage a) `catchX` return (Just l) + return $ maybe l id ml' + hunk ./Tabbed.hs 47 -dolay sc@(Rectangle x y wid _) s@(W.Stack w _ _) = withDisplay $ \d -> - do activecolor <- io $ initColor d "#BBBBBB" - inactivecolor <- io $ initColor d "#888888" - textcolor <- io $ initColor d "#000000" - bgcolor <- io $ initColor d "#000000" +dolay sc@(Rectangle x y wid _) s@(W.Stack w _ _) = withDisplay $ \dpy -> + do activecolor <- io $ initColor dpy "#BBBBBB" + inactivecolor <- io $ initColor dpy "#888888" + textcolor <- io $ initColor dpy "#000000" + bgcolor <- io $ initColor dpy "#000000" hunk ./Tabbed.hs 55 - maketab (t,w) = newDecoration w t 1 bgcolor activecolor (drawtab t w) (focus w) - drawtab r@(Rectangle _ _ wt ht) w d w' gc = - do nw <- getName w - tabcolor <- (maybe inactivecolor (\focusw -> if focusw == w then activecolor else inactivecolor) . W.peek) `liftM` gets windowset + maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor (drawtab t ow) (focus ow) + drawtab r@(Rectangle _ _ wt ht) ow d w' gc = + do nw <- getName ow + tabcolor <- (maybe inactivecolor (\focusw -> if focusw == ow then activecolor else inactivecolor) . W.peek) `liftM` gets windowset hunk ./Tabbed.hs 64 - do font <- io (fontFromGC d gc >>= queryFont d) - -- let (_,namew,nameh,_) = textExtents font name -- textExtents causes a crash! - -- let nameh = ht `div` 2 - -- namew = textWidth font name -- textWidth also causes a crash! - let nameh = ht - 6 - namew = wt - 10 + do fontst <- io $ loadQueryFont d "-misc-fixed-*-*-*-*-*-*-*-*-*-*-*-*" + io $ setFont d gc (fontFromFontStruct fontst) + let (_,asc,_,_) = textExtents fontst name + width = textWidth fontst name hunk ./Tabbed.hs 69 - (fromIntegral (wt `div` 2) - fromIntegral (namew `div` 2)) - (fromIntegral (ht `div` 2) + fromIntegral (nameh `div` 2)) name + (fromIntegral (wt `div` 2) - fromIntegral (width `div` 2)) + (fromIntegral ht - fromIntegral (asc `div` 2)) name hunk ./Tabbed.hs 18 - tabbed + tabbed + , Shrinker, shrinkText hunk ./Tabbed.hs 39 --- > defaultLayouts = [ tabbed +-- > defaultLayouts = [ tabbed shrinkText hunk ./Tabbed.hs 43 -tabbed :: Layout -tabbed = Layout { doLayout = dolay, modifyLayout = const (return Nothing) } +tabbed :: Shrinker -> Layout +tabbed shrinkT = Layout { doLayout = dolay shrinkT, modifyLayout = const (return Nothing) } hunk ./Tabbed.hs 46 -dolay :: Rectangle -> W.Stack Window -> X [(Window, Rectangle)] -dolay sc (W.Stack w [] []) = return [(w,sc)] -dolay sc@(Rectangle x y wid _) s@(W.Stack w _ _) = withDisplay $ \dpy -> +dolay :: Shrinker -> Rectangle -> W.Stack Window -> X [(Window, Rectangle)] +dolay _ sc (W.Stack w [] []) = return [(w,sc)] +dolay shr sc@(Rectangle x y wid _) s@(W.Stack w _ _) = withDisplay $ \dpy -> hunk ./Tabbed.hs 68 - width = textWidth fontst name + name' = shrinkWhile shr (\n -> textWidth fontst n > + fromIntegral wt - fromIntegral (ht `div` 2)) name + width = textWidth fontst name' hunk ./Tabbed.hs 73 - (fromIntegral ht - fromIntegral (asc `div` 2)) name + (fromIntegral ht - fromIntegral (asc `div` 2)) name' hunk ./Tabbed.hs 77 +type Shrinker = String -> [String] + +shrinkWhile :: Shrinker -> (String -> Bool) -> String -> String +shrinkWhile sh p x = sw $ sh x + where sw [n] = n + sw [] = "" + sw (n:ns) | p n = sw ns + | otherwise = n + +shrinkText :: Shrinker +shrinkText "" = [""] +shrinkText cs = cs : shrinkText (init cs) + hunk ./RotView.hs 24 +import Data.Ord ( comparing ) hunk ./RotView.hs 42 - sortWs = sortBy (\x y -> compare (tag x) (tag y)) + sortWs = sortBy (comparing tag) addfile ./Accordion.hs hunk ./Accordion.hs 1 +module XMonadContrib.Accordion (accordion) where + +import XMonad +import Operations +import qualified StackSet as W +import Graphics.X11.Xlib +import Data.Ratio + +accordion :: Layout +accordion = Layout { doLayout = accordionLayout + , modifyLayout = const $ return Nothing } + +accordionLayout :: Rectangle -> W.Stack Window -> X [(Window, Rectangle)] +accordionLayout sc ws = return $ (zip ups tops) ++ + [(W.focus ws, mainPane)] ++ + (zip dns bottoms) + where ups = W.up ws + dns = W.down ws + (top, allButTop) = splitVerticallyBy (1%8) sc + (center, bottom) = splitVerticallyBy (6%7) allButTop + (allButBottom, _) = splitVerticallyBy (7%8) sc + mainPane | ups /= [] && dns /= [] = center + | ups /= [] = allButTop + | dns /= [] = allButBottom + | otherwise = sc + tops = if ups /= [] then splitVertically (length ups) top else [] + bottoms= if dns /= [] then splitVertically (length dns) bottom else [] hunk ./MetaModule.hs 22 +import XMonadContrib.Accordion () hunk ./scripts/run-xmonad.sh 16 -#exec xmonad +#xmonad hunk ./scripts/xinitrc 37 -exec /home/dons/bin/run-xmonad.sh +/home/dons/bin/run-xmonad.sh hunk ./MetaModule.hs 3 --- Module : XMonadContrib.WorkspaceDir +-- Module : XMonadContrib.MetaModule hunk ./Dzen.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Dzen +-- Copyright : (c) glasser@mit.edu +-- License : BSD +-- +-- Maintainer : glasser@mit.edu +-- Stability : unstable +-- Portability : unportable +-- +-- Handy wrapper for dzen. +-- +----------------------------------------------------------------------------- + hunk ./LayoutHints.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.LayoutHints +-- Copyright : (c) David Roundy +-- License : BSD +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : portable +-- +-- Make layouts respect size hints. +----------------------------------------------------------------------------- + hunk ./LayoutHints.hs 14 -module XMonadContrib.LayoutHints ( layoutHints ) where - --- to use: --- defaultLayouts = [ layoutHints tiled, layoutHints $ mirror tiled , full ] +module XMonadContrib.LayoutHints ( + -- * usage + -- $ usage + layoutHints) where hunk ./LayoutHints.hs 25 +-- $ usage +-- > import XMonadContrib.LayoutHints +-- > defaultLayouts = [ layoutHints tiled , layoutHints $ mirror tiled ] + hunk ./Accordion.hs 1 -module XMonadContrib.Accordion (accordion) where +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Accordion +-- Copyright : (c) glasser@mit.edu +-- License : BSD +-- +-- Maintainer : glasser@mit.edu +-- Stability : unstable +-- Portability : unportable +-- +-- Layout that puts non-focused windows in ribbons at the top and bottom +-- of the screen. +----------------------------------------------------------------------------- + +module XMonadContrib.Accordion ( + -- * Usage + -- $ usage + accordion) where hunk ./Accordion.hs 26 +-- $ usage +-- > import XMonadContrib.Accordion +-- > defaultLayouts = [ accordion ] + hunk ./MagicFocus.hs 6 +magicFocus :: Layout -> Layout hunk ./MagicFocus.hs 1 -module XMonadContrib.MagicFocus (magicFocus) where +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.MagicFocus +-- Copyright : (c) Peter De Wachter +-- License : BSD +-- +-- Maintainer : Peter De Wachter +-- Stability : unstable +-- Portability : unportable +-- +-- Automagically put the focused window in the master area. +----------------------------------------------------------------------------- + +module XMonadContrib.MagicFocus ( + -- * Usage + -- $ usage + magicFocus) where hunk ./MagicFocus.hs 22 +-- $ usage +-- > import XMonadContrib.MagicFocus +-- > defaultLayouts = [ magicFocus tiled , magicFocus $ mirror tiled ] + hunk ./Magnifier.hs 20 -module XMonadContrib.Magnifier (magnifier) where +module XMonadContrib.Magnifier ( + -- * Usage + -- $usage + magnifier) where hunk ./Magnifier.hs 29 +-- $usage +-- > import XMonadContrib.Magnifier +-- > defaultLayouts = [ magnifier tiled , magnifier $ mirror tiled ] + hunk ./Circle.hs 41 - where w = round ((fromIntegral sw / sqrt 2) :: Double) - h = round ((fromIntegral sh / sqrt 2) :: Double) + where s = sqrt 2 + w = round ((fromIntegral sw / s) :: Double) + h = round ((fromIntegral sh / s) :: Double) hunk ./scripts/run-xmonad.sh 11 -PATH=/home/dons/bin:$PATH +PATH=${HOME}/bin:$PATH hunk ./Anneal.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Anneal +-- Copyright : (c) David Roundy +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- +----------------------------------------------------------------------------- + hunk ./scripts/run-xmonad.sh 23 -/sbin/mkfifo -m 600 $PIPE +PATH=${PATH}:/sbin mkfifo -m 600 $PIPE hunk ./TwoPane.hs 24 -import Operations -import qualified StackSet as W -import Control.Monad.State (gets) - +import Operations ( Resize(..), splitHorizontallyBy ) +import StackSet ( focus, up, down) hunk ./TwoPane.hs 38 -twoPane delta split = Layout { doLayout = \r -> arrange r . W.integrate, modifyLayout = message } +twoPane delta split = Layout { doLayout = \r s -> return $ arrange r s, modifyLayout = message } hunk ./TwoPane.hs 40 - arrange rect ws@(w:x:_) = do - -- TODO this is buggy, it might peek another workspace - (Just f) <- gets (W.peek . windowset) -- safe because of pattern match above - let y = if f == w then x else f - (left, right) = splitHorizontallyBy split rect - mapM_ hide . filter (\a -> a /= w && a /= y) $ ws - return [(w, left), (y, right)] - -- there are one or zero windows - arrange rect ws = return . map (\w -> (w, rect)) $ ws + arrange rect st = case reverse (up st) of + (master:_) -> [(master,left),(focus st,right)] + [] -> case down st of + (next:_) -> [(focus st,left),(next,right)] + [] -> [(focus st, rect)] + where (left, right) = splitHorizontallyBy split rect hunk ./DynamicLog.hs 24 - dynamicLog, dynamicLogXinerama + dynamicLog, dynamicLogXinerama, pprWindowSet, pprWindowSetXinerama hunk ./DynamicLog.hs 55 -dynamicLog = withWindowSet $ io . putStrLn . ppr - where - ppr s = concatMap fmt $ sortBy (compare `on` S.tag) - (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) +dynamicLog = withWindowSet $ io . putStrLn . pprWindowSet hunk ./DynamicLog.hs 57 - fmt w | S.tag w == this = "[" ++ pprTag w ++ "]" - | S.tag w `elem` visibles = "<" ++ pprTag w ++ ">" - | isJust (S.stack w) = " " ++ pprTag w ++ " " - | otherwise = "" +pprWindowSet :: WindowSet -> String +pprWindowSet s = concatMap fmt $ sortBy (compare `on` S.tag) + (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 | S.tag w == this = "[" ++ pprTag w ++ "]" + | S.tag w `elem` visibles = "<" ++ pprTag w ++ ">" + | isJust (S.stack w) = " " ++ pprTag w ++ " " + | otherwise = "" hunk ./DynamicLog.hs 77 -dynamicLogXinerama = withWindowSet $ io . putStrLn . ppr - where - ppr ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen - where onscreen = map (pprTag . S.workspace) - . sortBy (compare `on` S.screen) $ S.current ws : S.visible ws - offscreen = map pprTag . filter (isJust . S.stack) - . sortBy (compare `on` S.tag) $ S.hidden ws +dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama + +pprWindowSetXinerama :: WindowSet -> String +pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen + where onscreen = map (pprTag . S.workspace) + . sortBy (compare `on` S.screen) $ S.current ws : S.visible ws + offscreen = map pprTag . filter (isJust . S.stack) + . sortBy (compare `on` S.tag) $ S.hidden ws hunk ./LayoutHooks.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.LayoutHooks +-- Copyright : (c) Stefan O'Rear +-- License : BSD +-- +-- Maintainer : Stefan O'Rear +-- Stability : unstable +-- Portability : portable +-- +-- General layout-level hooks. +----------------------------------------------------------------------------- + hunk ./MagicFocus.hs 26 -magicFocus :: Layout -> Layout +magicFocus :: Layout a -> Layout a hunk ./Accordion.hs 30 -accordion :: Layout +accordion :: Layout Window hunk ./Circle.hs 30 -circle :: Layout +circle :: Layout Window hunk ./Combo.hs 37 -combo :: [(Layout, Int)] -> Layout -> Layout +combo :: [(Layout a, Int)] -> Layout a -> Layout a hunk ./Combo.hs 59 -broadcastPrivate :: Message a => a -> [Layout] -> X [Layout] +broadcastPrivate :: Message a => a -> [Layout b] -> X [Layout b] hunk ./HintedTile.hs 40 -tall, wide :: Int -> Rational -> Rational -> Layout +tall, wide :: Int -> Rational -> Rational -> Layout Window hunk ./LayoutHints.hs 34 -layoutHints :: Layout -> Layout +layoutHints :: Layout Window -> Layout Window hunk ./LayoutHooks.hs 23 -install :: (SomeMessage -> X Bool) -> Layout -> Layout +install :: (SomeMessage -> X Bool) -> Layout a -> Layout a hunk ./Magnifier.hs 33 -magnifier :: Layout -> Layout +magnifier :: Layout Window -> Layout Window hunk ./Mosaic.hs 93 -mosaic :: Double -> Double -> M.Map NamedWindow [WindowHint] -> Layout +mosaic :: Double -> Double -> M.Map NamedWindow [WindowHint] -> Layout Window hunk ./NoBorders.hs 40 -noBorders :: Layout -> Layout +noBorders :: Layout a -> Layout a hunk ./NoBorders.hs 43 -withBorder :: Dimension -> Layout -> Layout +withBorder :: Dimension -> Layout a -> Layout a hunk ./Spiral.hs 54 -spiral :: Rational -> Layout +spiral :: Rational -> Layout a hunk ./Square.hs 43 -square :: Layout +square :: Layout Window hunk ./Tabbed.hs 43 -tabbed :: Shrinker -> Layout +tabbed :: Shrinker -> Layout Window hunk ./TwoPane.hs 37 -twoPane :: Rational -> Rational -> Layout +twoPane :: Rational -> Rational -> Layout a hunk ./WorkspaceDir.hs 50 -workspaceDir :: String -> Layout -> Layout +workspaceDir :: String -> Layout a -> Layout a hunk ./DynamicLog.hs 33 +import Data.Ord ( comparing ) hunk ./DynamicLog.hs 59 -pprWindowSet s = concatMap fmt $ sortBy (compare `on` S.tag) +pprWindowSet s = concatMap fmt $ sortBy (comparing S.tag) hunk ./DynamicLog.hs 83 - . sortBy (compare `on` S.screen) $ S.current ws : S.visible ws + . sortBy (comparing S.screen) $ S.current ws : S.visible ws hunk ./DynamicLog.hs 85 - . sortBy (compare `on` S.tag) $ S.hidden ws + . sortBy (comparing S.tag) $ S.hidden ws hunk ./DynamicLog.hs 91 -on :: (a -> a -> c) -> (b -> a) -> b -> b -> c -on f g a b = (g a) `f` (g b) - hunk ./README 7 -examples/ contains further external programs useful with xmonad. +scripts/ contains further external programs useful with xmonad. hunk ./Combo.hs 33 --- > combo [(full,1),(tabbed,1)] (twoPane 0.03 0.5) +-- > combo [(full,1),(tabbed shrinkText,1)] (twoPane 0.03 0.5) hunk ./Combo.hs 51 - message m | Just UnDoLayout <- fromMessage m = - do (super':ls') <- broadcastPrivate UnDoLayout (super:map fst origls) - return $ Just $ combo (zip ls' $ map snd origls) super' - message m = do msuper' <- modifyLayout super m - case msuper' of - Nothing -> return Nothing - Just super' -> return $ Just $ combo origls super' + message m = case fromMessage m of + Just UnDoLayout -> fmap (\(super':ls') -> Just $ combo (zip ls' $ map snd origls) super') + (broadcastPrivate UnDoLayout (super:map fst origls)) + _ -> fmap (maybe Nothing (Just . combo origls)) (modifyLayout super m) hunk ./MetaModule.hs 37 +import XMonadContrib.LayoutHooks () hunk ./Mosaic.hs 73 -expandWindow, shrinkWindow, squareWindow, myclearWindow,tallWindow, wideWindow :: NamedWindow -> HandleWindow +expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: NamedWindow -> HandleWindow hunk ./Mosaic.hs 298 -hints2area (RelArea r:x) = r +hints2area (RelArea r:_) = r hunk ./Mosaic.hs 349 -changeMosaic (OM a) = [] +changeMosaic (OM _) = [] hunk ./Accordion.hs 30 -accordion :: Layout Window +accordion :: Eq a => Layout a hunk ./Accordion.hs 34 -accordionLayout :: Rectangle -> W.Stack Window -> X [(Window, Rectangle)] +accordionLayout :: Eq a => Rectangle -> W.Stack a -> X [(a, Rectangle)] hunk ./Circle.hs 30 -circle :: Layout Window +circle :: Layout a hunk ./Circle.hs 34 -circleLayout :: Rectangle -> [Window] -> X [(Window, Rectangle)] +circleLayout :: Rectangle -> [a] -> X [(a, Rectangle)] hunk ./Magnifier.hs 33 -magnifier :: Layout Window -> Layout Window +magnifier :: Eq a => Layout a -> Layout a hunk ./Magnifier.hs 37 -applyMagnifier :: Rectangle -> Stack Window -> [(Window, Rectangle)] -> [(Window, Rectangle)] +applyMagnifier :: Eq a => Rectangle -> Stack a -> [(a, Rectangle)] -> [(a, Rectangle)] hunk ./Square.hs 43 -square :: Layout Window +square :: Layout a hunk ./Mosaic.hs 24 -import Control.Monad.State ( State, runState, put, get ) -import System.Random ( StdGen, Random, mkStdGen, randomR ) +import Control.Monad.State ( State, put, get ) +import System.Random ( StdGen ) hunk ./Mosaic.hs 40 -import Debug.Trace - hunk ./Mosaic.hs 80 -largeNumber, mediumNumber, resolutionNumber :: Int -largeNumber = 50 -mediumNumber = 10 -resolutionNumber = 100 +-- TODO: not used at the moment: +-- largeNumber, mediumNumber, resolutionNumber :: Int +-- largeNumber = 50 +-- mediumNumber = 10 +-- resolutionNumber = 100 hunk ./Mosaic.hs 147 - myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws + -- TODO: remove all this dead code + -- myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws hunk ./Mosaic.hs 154 - myh = runCountDown largeNumber $ mosaic_splits even_split origRect Horizontal sortedws + -- myh = runCountDown largeNumber $ mosaic_splits even_split origRect Horizontal sortedws hunk ./Mosaic.hs 178 + {- hunk ./Mosaic.hs 184 + -} hunk ./Mosaic.hs 243 -runCountDown :: Int -> State CountDown a -> a -runCountDown n x = fst $ runState x (CD (mkStdGen n) n) - hunk ./Mosaic.hs 357 -onceToEach :: (a -> a) -> [a] -> [[a]] -onceToEach _ [] = [] -onceToEach f (x:xs) = (f x : xs) : map (x:) (onceToEach f xs) - hunk ./Accordion.hs 26 --- $ usage +-- $usage hunk ./Circle.hs 6 --- +-- hunk ./LayoutHints.hs 16 - -- $ usage + -- $usage hunk ./LayoutHints.hs 25 --- $ usage +-- $usage hunk ./MagicFocus.hs 16 - -- $ usage + -- $usage hunk ./MagicFocus.hs 22 --- $ usage +-- $usage hunk ./Mosaic.hs 17 -module XMonadContrib.Mosaic ( +module XMonadContrib.Mosaic ( hunk ./Magnifier.hs 14 --- The master window is left alone. (Maybe that should be an option.) --- hunk ./Magnifier.hs 21 - magnifier) where + magnifier, magnifier') where hunk ./Magnifier.hs 31 -magnifier :: Eq a => Layout a -> Layout a -magnifier l = l { doLayout = \r s -> applyMagnifier r s `fmap` doLayout l r s +-- | Increase the size of the window that has focus, unless it is the master window. +magnifier :: Eq a => Layout a -> Layout a +magnifier l = l { doLayout = \r s -> unlessMaster applyMagnifier r s `fmap` doLayout l r s hunk ./Magnifier.hs 36 -applyMagnifier :: Eq a => Rectangle -> Stack a -> [(a, Rectangle)] -> [(a, Rectangle)] -applyMagnifier r s | null (up s) = id -- don't change the master window - | otherwise = map $ \(w,wr) -> if w == focus s then (w, shrink r $ magnify wr) else (w, wr) +-- | Increase the size of the window that has focus, even if it is the master window. +magnifier' :: Eq a => Layout a -> Layout a +magnifier' l = l { doLayout = \r s -> applyMagnifier r s `fmap` doLayout l r s + , modifyLayout = \x -> fmap magnifier' `fmap` modifyLayout l x } + + +type DoLayout = Eq a => Rectangle -> Stack a -> [(a, Rectangle)] -> [(a, Rectangle)] + +unlessMaster :: DoLayout -> DoLayout +unlessMaster f r s = if null (up s) then id else f r s + +applyMagnifier :: DoLayout +applyMagnifier r s = map $ \(w,wr) -> if w == focus s then (w, shrink r $ magnify wr) else (w, wr) hunk ./Combo.hs 30 +-- > import XMonadContrib.SimpleStacking hunk ./Combo.hs 34 --- > combo [(full,1),(tabbed shrinkText,1)] (twoPane 0.03 0.5) +-- > simpleStacking $ combo [(full,1),(tabbed shrinkText,1)] (twoPane 0.03 0.5) hunk ./MetaModule.hs 45 +import XMonadContrib.SimpleStacking () addfile ./SimpleStacking.hs hunk ./SimpleStacking.hs 1 +{-# OPTIONS -fglasgow-exts #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.SimpleStacking +-- Copyright : (c) David Roundy +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- A module to be used to obtain a simple "memory" of stacking order. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.SimpleStacking ( + -- * Usage + -- $usage + simpleStacking + ) where + +import Control.Monad.State ( modify ) +import qualified Data.Map as M +import Data.Maybe ( catMaybes ) + +import Data.List ( nub, lookup ) +import StackSet ( focus, tag, workspace, current, integrate ) +import Graphics.X11.Xlib ( Window ) + +import XMonad + +-- $usage +-- You can use this module for +-- See, for instance, "XMonadContrib.Tabbed" + +simpleStacking :: Layout Window -> Layout Window +simpleStacking = simpleStacking' [] + +simpleStacking' :: [Window] -> Layout Window -> Layout Window +simpleStacking' st l = l { doLayout = dl + , modifyLayout = \m -> fmap (simpleStacking' st) `fmap` modifyLayout l m } + where dl r s = do modify $ \ state -> + state { layouts = M.adjust + (\(_,ss)->(simpleStacking' + (focus s:filter (`elem` integrate s) st) l,ss)) + (tag.workspace.current.windowset $ state) + (layouts state) } + lo <- doLayout l r s + let m = map (\ (w,rr) -> (w,(w,rr))) lo + return $ catMaybes $ map ((flip lookup) m) $ nub (focus s : st ++ map fst lo) hunk ./Tabbed.hs 37 +-- > import XMonadContrib.SimpleStacking hunk ./Tabbed.hs 40 --- > defaultLayouts = [ tabbed shrinkText +-- > defaultLayouts = [ simpleStacking $ tabbed shrinkText hunk ./Tabbed.hs 43 - hunk ./Tabbed.hs 48 -dolay shr sc@(Rectangle x y wid _) s@(W.Stack w _ _) = withDisplay $ \dpy -> +dolay shr sc@(Rectangle x y wid _) s = withDisplay $ \dpy -> hunk ./Tabbed.hs 75 - return [ (w,shrink sc) ] + return $ map (\w -> (w,shrink sc)) ws hunk ./Mosaic.hs 24 -import Control.Monad.State ( State, put, get ) -import System.Random ( StdGen ) +import Control.Monad.State ( State, put, get, runState ) +import System.Random ( StdGen, mkStdGen ) hunk ./Mosaic.hs 80 --- TODO: not used at the moment: --- largeNumber, mediumNumber, resolutionNumber :: Int --- largeNumber = 50 --- mediumNumber = 10 --- resolutionNumber = 100 +largeNumber :: Int +largeNumber = 50 hunk ./Mosaic.hs 145 - -- myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws + myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws hunk ./Mosaic.hs 151 - -- myh = runCountDown largeNumber $ mosaic_splits even_split origRect Horizontal sortedws + myh = runCountDown largeNumber $ mosaic_splits even_split origRect Horizontal sortedws hunk ./Mosaic.hs 161 - flattenMosaic $ the_value $ maxL [myh2,myv2] + flattenMosaic $ the_value $ maxL [myh,myv,myh2,myv2] hunk ./Mosaic.hs 289 -cropit f (Rectangle a b w h) | w -/- h > f = Rectangle a b (floor $ h -* f) h - | otherwise = Rectangle a b w (floor $ w -/ f) +cropit f (Rectangle a b w h) | w -/- h > f = Rectangle a b (ceiling $ h -* f) h + | otherwise = Rectangle a b w (ceiling $ w -/ f) hunk ./Mosaic.hs 395 +runCountDown :: Int -> State CountDown a -> a +runCountDown n x = fst $ runState x (CD (mkStdGen n) n) + hunk ./Circle.hs 31 -circle = Layout { doLayout = \r -> circleLayout r . integrate, +circle = Layout { doLayout = \r -> return . circleLayout r . integrate, hunk ./Circle.hs 34 -circleLayout :: Rectangle -> [a] -> X [(a, Rectangle)] -circleLayout _ [] = return [] -circleLayout r (w:ws) = return $ (w, center r) : (zip ws sats) - where sats = map (satellite r) $ take (length ws) [0, pi * 2 / fromIntegral (length ws) ..] +circleLayout :: Rectangle -> [a] -> [(a, Rectangle)] +circleLayout _ [] = [] +circleLayout r (w:ws) = master : rest + where master = (w, center r) + rest = zip ws $ map (satellite r) [0, pi * 2 / fromIntegral (length ws) ..] hunk ./Circle.hs 42 - where s = sqrt 2 - w = round ((fromIntegral sw / s) :: Double) - h = round ((fromIntegral sh / s) :: Double) + where s = sqrt 2 :: Double + w = round (fromIntegral sw / s) + h = round (fromIntegral sh / s) hunk ./Circle.hs 23 -import StackSet (integrate) +import StackSet (integrate, Stack(..)) hunk ./Circle.hs 31 -circle = Layout { doLayout = \r -> return . circleLayout r . integrate, +circle = Layout { doLayout = \r s -> return . raise (length (up s)) . circleLayout r $ integrate s, hunk ./Circle.hs 40 +raise :: Int -> [a] -> [a] +raise n xs = xs !! n : take n xs ++ drop (n + 1) xs + hunk ./Magnifier.hs 48 -applyMagnifier r s = map $ \(w,wr) -> if w == focus s then (w, shrink r $ magnify wr) else (w, wr) +applyMagnifier r s = reverse . foldr accumulate [] + where accumulate (w,wr) ws | w == focus s = ws ++ [(w, shrink r $ magnify wr)] + | otherwise = (w,wr) : ws addfile ./LayoutScreens.hs hunk ./LayoutScreens.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.RotView +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- Provides bindings to cycle through non-empty workspaces. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.LayoutScreens ( + -- * Usage + -- $usage + layoutScreens + ) where + +import Control.Monad.State ( modify ) +import Control.Monad.Reader ( asks ) + +import XMonad +import qualified StackSet as W +import qualified Operations as O +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +-- $usage + +-- This module allows you to pretend that you have more than one screen by +-- dividing a single screen into multiple screens that xmonad will treat as +-- separate screens. This should definitely be useful for testing the +-- behavior of xmonad under Xinerama, and it's possible that it'd also be +-- handy for use as an actual user interface, if you've got a very large +-- sceen 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 Config.hs file: +-- +-- > import XMonadContrib.LayoutScreens +-- +-- > , ((modMask .|. shiftMask, xK_space), layoutScreens 2 (twoPane 0.5 0.5)) +-- > , ((controlMask .|. modMask .|. shiftMask, xK_space), do layoutScreens 1 xineScreenLayout +-- rescreen) + +layoutScreens :: Int -> Layout Int -> X () +layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens." +layoutScreens nscr l = + do rtrect <- asks theRoot >>= getWindowRectangle + wss <- doLayout l rtrect W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] } + modify $ \s -> s { xineScreens = map snd wss + , statusGaps = take nscr $ (statusGaps s) ++ repeat (0,0,0,0) } + + O.windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) -> + let (x:xs, ys) = splitAt nscr $ map W.workspace (v:vs) ++ hs + in ws { W.current = W.Screen x 0 + , W.visible = zipWith W.Screen xs [1 ..] + , W.hidden = ys } + +getWindowRectangle :: Window -> X Rectangle +getWindowRectangle w = withDisplay $ \d -> + do a <- io $ getWindowAttributes d w + return $ Rectangle (fromIntegral $ wa_x a) (fromIntegral $ wa_y a) + (fromIntegral $ wa_width a) (fromIntegral $ wa_height a) hunk ./MetaModule.hs 37 -import XMonadContrib.LayoutHooks () +import XMonadContrib.LayoutScreens () hunk ./LayoutScreens.hs 45 --- > , ((controlMask .|. modMask .|. shiftMask, xK_space), do layoutScreens 1 xineScreenLayout --- rescreen) +-- > , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen) hunk ./Magnifier.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} addfile ./SinkAll.hs hunk ./SinkAll.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XmonadContrib.SinkAll +-- License : BSD3-style (see LICENSE) +-- Stability : unstable +-- Portability : unportable +-- +-- Provides a simple binding that pushes all floating windows on the current +-- workspace back into tiling. +----------------------------------------------------------------------------- + +module XMonadContrib.SinkAll ( + -- * Usage + -- $usage + sinkAll) where + +import Operations +import XMonad +import StackSet hiding (sink) + +import Control.Monad.State +import Graphics.X11.Xlib + +-- $usage +-- > import XMonadContrib.SinkAll +-- > keys = [ ((modMask .|. shiftMask, xK_t), sinkAll) ] + +sinkAll :: X () +sinkAll = withAll sink + +-- Apply a function to all windows on current workspace. +withAll :: (Window -> X a) -> X () +withAll f = gets (integrate' . stack . workspace . current . windowset) >>= + mapM_ f addfile ./LayoutHelpers.hs hunk ./LayoutHelpers.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.LayoutHelpers +-- Copyright : (c) David Roundy +-- License : BSD +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : portable +-- +-- Make layouts respect size hints. +----------------------------------------------------------------------------- + +module XMonadContrib.LayoutHelpers ( + -- * usage + -- $usage + DoLayout, ModDo, ModMod, ModLay, + layoutModify, + l2lModDo, + idModMod, + ) where + +import Graphics.X11.Xlib ( Rectangle ) +import XMonad +import StackSet ( Stack, integrate ) + +-- $usage +-- Use LayoutHelpers to help write easy Layouts. + +--type DoLayout a = Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Layout a)) +type DoLayout a = Rectangle -> Stack a -> X [(a, Rectangle)] +type ModifyLayout a = SomeMessage -> X (Maybe (Layout a)) + +type ModDo a = Rectangle -> Stack a -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ModLay a)) +type ModMod a = SomeMessage -> X (Maybe (ModLay a)) + +type ModLay a = Layout a -> Layout a + +layoutModify :: ModDo a -> ModMod a -> ModLay a +layoutModify fdo fmod l = Layout { doLayout = dl, modifyLayout = modl } + where dl r s = do --(ws, ml') <- doLayout l r s + ws <- doLayout l r s + (ws', mmod') <- fdo r s ws + --let ml'' = case mmod' of + -- Just mod' -> Just $ mod' $ maybe l id ml' + -- Nothing -> layoutModify fdo mod `fmap` ml' + --return (ws', ml'') + case mmod' of + Just _ -> fail "Sorry, can't yet safely modify layouts in doLayout." + Nothing -> return ws' + modl m = do ml' <- modifyLayout l m + mmod' <- fmod m + return $ case mmod' of + Just mod' -> Just $ mod' $ maybe l id ml' + Nothing -> layoutModify fdo fmod `fmap` ml' + +l2lModDo :: (Rectangle -> [a] -> [(a,Rectangle)]) -> DoLayout a +--l2lModDo dl r s = return (dl r $ integrate s, Nothing) +l2lModDo dl r s = return (dl r $ integrate s) + +idModMod :: ModMod a +idModMod _ = return Nothing hunk ./Square.hs 25 -import XMonad -import Graphics.X11.Xlib -import StackSet ( integrate ) - hunk ./Square.hs 28 --- > import XMonadContrib.Spiral +-- > import XMonadContrib.Square hunk ./Square.hs 38 +import XMonad +import Graphics.X11.Xlib +import StackSet ( integrate ) +import XMonadContrib.LayoutHelpers ( l2lModDo ) hunk ./Square.hs 44 -square = Layout { doLayout = \r s -> arrange r (integrate s), modifyLayout = message } - where - arrange rect ws@(_:_) = do - let (rest, sq) = splitSquare rect - return (map (\w->(w,rest)) (init ws) ++ [(last ws,sq)]) - arrange _ [] = return [] - - message _ = return Nothing +square = Layout { doLayout = l2lModDo arrange, modifyLayout = const (return Nothing) } + where arrange :: Rectangle -> [a] -> [(a, Rectangle)] + arrange rect ws@(_:_) = map (\w->(w,rest)) (init ws) ++ [(last ws,sq)] + where (rest, sq) = splitSquare rect + arrange _ [] = [] hunk ./Magnifier.hs 12 --- Screenshot : http://caladan.rave.org/magnifier.png +-- Screenshot : hunk ./Square.hs 25 +import XMonad +import Graphics.X11.Xlib +import StackSet ( integrate ) +import XMonadContrib.LayoutHelpers ( l2lModDo ) + hunk ./Square.hs 43 -import XMonad -import Graphics.X11.Xlib -import StackSet ( integrate ) -import XMonadContrib.LayoutHelpers ( l2lModDo ) - hunk ./BackCompat.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.BackCompat --- Copyright : (c) daniel@wagner-home.com --- License : BSD-style (see xmonad/LICENSE) --- --- Maintainer : daniel@wagner-home.com --- Stability : unstable --- Portability : unportable --- --- A module that provides back compatibility with GHC 6.4 --- ------------------------------------------------------------------------------ -module XMonadContrib.BackCompat ( - -- * Usage - -- $usage - forM, forM_ - ) where - -import Data.Map (Map, fromList) -import GHC.Read - -{- $usage - -This file will contain all the things GHC 6.4 users need to compile xmonad. -Currently, the steps to get compilation are: -add the following line to StackSet.hs, Operations.hs, and Main.hs: - -> import XMonadContrib.BackCompat - --} - -forM_ :: (Monad m) => [a] -> (a -> m b) -> m () -forM_ = flip mapM_ - --- not used yet, but just in case -forM :: (Monad m) => [a] -> (a -> m b) -> m [b] -forM = flip mapM - -instance (Ord k, Read k, Read e) => Read (Map k e) where - readsPrec _ = \s1 -> do - ("{", s2) <- lex s1 - (xs, s3) <- readPairs s2 - ("}", s4) <- lex s3 - return (fromList xs, s4) - --- parses a pair of things with the syntax a:=b --- stolen from the GHC 6.6 sources -readPair :: (Read a, Read b) => ReadS (a,b) -readPair s = do (a, ct1) <- reads s - (":=", ct2) <- lex ct1 - (b, ct3) <- reads ct2 - return ((a,b), ct3) - -readPairs :: (Read a, Read b) => ReadS [(a,b)] -readPairs s1 = case readPair s1 of - [(p, s2)] -> case s2 of - (',':s3) -> do - (ps, s4) <- readPairs s3 - return (p:ps, s4) - _ -> [([p], s2)] - _ -> [([],s1)] rmfile ./BackCompat.hs hunk ./NoBorders.hs 38 --- > layouts = [ noBorders full, tall, ... ] +-- and modify the defaultLayouts to call noBorders on the layouts you want to lack +-- borders +-- +-- > defaultLayouts = [ noBorders full, ... ] hunk ./Decoration.hs 36 -newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel - -> (Display -> Window -> GC -> X ()) -> X () -> X Window -newDecoration decfor (Rectangle x y w h) th fg bg draw click = do +newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel -> String + -> (Display -> Window -> GC -> FontStruct -> X ()) -> X () -> X Window +newDecoration decfor (Rectangle x y w h) th fg bg fn draw click = do hunk ./Decoration.hs 55 - | thisw == win && t == expose = withGC win draw - | thisw == decfor && t == propertyNotify = withGC win draw + | thisw == win && t == expose = withGC win fn draw + | thisw == decfor && t == propertyNotify = withGC win fn draw hunk ./Decoration.hs 64 -withGC :: Drawable -> (Display -> Drawable -> GC -> X ()) -> X () -withGC w f = withDisplay $ \d -> do gc <- io $ createGC d w - f d w gc - io $ freeGC d gc +withGC :: Drawable -> String -> (Display -> Drawable -> GC -> FontStruct -> X ()) -> X () +withGC w fn f = withDisplay $ \d -> do gc <- io $ createGC d w + let fontname = if fn == "" + then "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + else fn + font <- io $ loadQueryFont d fontname + io $ setFont d gc (fontFromFontStruct font) + f d w gc font + io $ freeGC d gc + io $ freeFont d font hunk ./Tabbed.hs 20 + , TConf (..), defaultTConf hunk ./Tabbed.hs 41 --- > defaultLayouts = [ simpleStacking $ tabbed shrinkText +-- > defaultLayouts = [ simpleStacking $ tabbed shrinkText defaultTConf hunk ./Tabbed.hs 44 -tabbed :: Shrinker -> Layout Window -tabbed shrinkT = Layout { doLayout = dolay shrinkT, modifyLayout = const (return Nothing) } +data TConf = + TConf { activeColor :: String + , inactiveColor :: String + , bgColor :: String + , textColor :: String + , fontName :: String + , tabSize :: Int + } deriving (Show, Read) + +defaultTConf :: TConf +defaultTConf = + TConf { activeColor ="#BBBBBB" + , inactiveColor = "#888888" + , bgColor = "#000000" + , textColor = "#000000" + , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , tabSize = 20 + } hunk ./Tabbed.hs 63 -dolay :: Shrinker -> Rectangle -> W.Stack Window -> X [(Window, Rectangle)] -dolay _ sc (W.Stack w [] []) = return [(w,sc)] -dolay shr sc@(Rectangle x y wid _) s = withDisplay $ \dpy -> - do activecolor <- io $ initColor dpy "#BBBBBB" - inactivecolor <- io $ initColor dpy "#888888" - textcolor <- io $ initColor dpy "#000000" - bgcolor <- io $ initColor dpy "#000000" +tabbed :: Shrinker -> TConf -> Layout Window +tabbed shrinkT config = Layout { doLayout = dolay shrinkT config, modifyLayout = const (return Nothing) } + +dolay :: Shrinker -> TConf -> Rectangle -> W.Stack Window -> X [(Window, Rectangle)] +dolay _ _ sc (W.Stack w [] []) = return [(w,sc)] +dolay shr conf sc@(Rectangle x y wid _) s = withDisplay $ \dpy -> + do activecolor <- io $ initColor dpy $ activeColor conf + inactivecolor <- io $ initColor dpy $ inactiveColor conf + textcolor <- io $ initColor dpy $ textColor conf + bgcolor <- io $ initColor dpy $ bgColor conf hunk ./Tabbed.hs 74 - ts = gentabs x y wid (length ws) + ts = gentabs conf x y wid (length ws) hunk ./Tabbed.hs 76 - maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor (drawtab t ow) (focus ow) - drawtab r@(Rectangle _ _ wt ht) ow d w' gc = + maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor (fontName conf) (drawtab t ow) (focus ow) + drawtab r@(Rectangle _ _ wt ht) ow d w' gc fn = hunk ./Tabbed.hs 83 - centerText d w' gc r (show nw) - centerText d w' gc (Rectangle _ _ wt ht) name = - do fontst <- io $ loadQueryFont d "-misc-fixed-*-*-*-*-*-*-*-*-*-*-*-*" - io $ setFont d gc (fontFromFontStruct fontst) - let (_,asc,_,_) = textExtents fontst name + centerText d w' gc fn r (show nw) + centerText d w' gc fontst (Rectangle _ _ wt ht) name = + do let (_,asc,_,_) = textExtents fontst name hunk ./Tabbed.hs 91 - (fromIntegral ht - fromIntegral (asc `div` 2)) name' + ((fromIntegral ht + fromIntegral asc) `div` 2) name' hunk ./Tabbed.hs 93 - return $ map (\w -> (w,shrink sc)) ws + return $ map (\w -> (w,shrink conf sc)) ws hunk ./Tabbed.hs 108 -shrink :: Rectangle -> Rectangle -shrink (Rectangle x y w h) = Rectangle x (y+tabsize) w (h-tabsize) - -gentabs :: Position -> Position -> Dimension -> Int -> [Rectangle] -gentabs _ _ _ 0 = [] -gentabs x y w num = Rectangle x y (wid - 2) (tabsize - 2) - : gentabs (x + fromIntegral wid) y (w - wid) (num - 1) - where wid = w `div` (fromIntegral num) +shrink :: TConf -> Rectangle -> Rectangle +shrink c (Rectangle x y w h) = Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c)) hunk ./Tabbed.hs 111 -tabsize :: Integral a => a -tabsize = 20 +gentabs :: TConf -> Position -> Position -> Dimension -> Int -> [Rectangle] +gentabs _ _ _ _ 0 = [] +gentabs c x y w num = Rectangle x y (wid - 2) (fromIntegral (tabSize c) - 2) + : gentabs c (x + fromIntegral wid) y (w - wid) (num - 1) + where wid = w `div` (fromIntegral num) hunk ./Tabbed.hs 42 +-- > , ... ] +-- +-- You can also edit the default configuration options. +-- +-- > myconfig = defaultTConf { bgColor = "#FF0000" +-- > , textColor = "#00FF00"} +-- +-- and +-- +-- > defaultLayouts = [ simpleStacking $ tabbed shrinkText myconfig hunk ./MetaModule.hs 36 +import XMonadContrib.LayoutHelpers () hunk ./MetaModule.hs 40 -import XMonadContrib.Mosaic () hunk ./MetaModule.hs 41 +import XMonadContrib.Mosaic () hunk ./Accordion.hs 17 - -- $ usage + -- $usage hunk ./Tabbed.hs 23 -import Control.Monad ( forM, liftM ) -import Control.Monad.State ( gets ) +import Control.Monad ( forM ) hunk ./Tabbed.hs 88 - tabcolor <- (maybe inactivecolor (\focusw -> if focusw == ow then activecolor else inactivecolor) . W.peek) `liftM` gets windowset + let tabcolor = if W.focus s == ow then activecolor else inactivecolor hunk ./Tabbed.hs 102 - return $ map (\w -> (w,shrink conf sc)) ws + return [(W.focus s, shrink conf sc)] hunk ./SimpleStacking.hs 13 +-- +-- WARNING: This module is incompatible with Xinerama! hunk ./Spiral.hs 25 -import qualified StackSet as W + +import XMonadContrib.LayoutHelpers hunk ./Spiral.hs 56 -spiral scale = Layout { doLayout = \r -> fibLayout r . W.integrate, +spiral scale = Layout { doLayout = l2lModDo fibLayout, hunk ./Spiral.hs 59 - fibLayout sc ws = return $ zip ws rects + fibLayout sc ws = zip ws rects hunk ./LayoutHelpers.hs 19 - l2lModDo, + l2lModDo, idModify, hunk ./LayoutHelpers.hs 61 +idModify :: ModifyLayout a +idModify _ = return Nothing + hunk ./Square.hs 43 +import XMonad +import Graphics.X11.Xlib +import StackSet ( integrate ) +import XMonadContrib.LayoutHelpers ( l2lModDo ) + hunk ./Square.hs 49 -square = Layout { doLayout = l2lModDo arrange, modifyLayout = const (return Nothing) } +square = Layout { doLayout = l2lModDo arrange, modifyLayout = idModify } hunk ./Accordion.hs 25 +import XMonadContrib.LayoutHelpers ( idModify ) hunk ./Accordion.hs 32 -accordion = Layout { doLayout = accordionLayout - , modifyLayout = const $ return Nothing } +accordion = Layout { doLayout = accordionLayout, modifyLayout = idModify } hunk ./Accordion.hs 34 -accordionLayout :: Eq a => Rectangle -> W.Stack a -> X [(a, Rectangle)] -accordionLayout sc ws = return $ (zip ups tops) ++ - [(W.focus ws, mainPane)] ++ - (zip dns bottoms) +accordionLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Layout a)) +accordionLayout sc ws = return ((zip ups tops) ++ + [(W.focus ws, mainPane)] ++ + (zip dns bottoms) + ,Nothing) hunk ./Circle.hs 25 +import XMonadContrib.LayoutHelpers ( idModify ) + hunk ./Circle.hs 33 -circle = Layout { doLayout = \r s -> return . raise (length (up s)) . circleLayout r $ integrate s, - modifyLayout = return . const Nothing } +circle = Layout { doLayout = \r s -> return (raise (length (up s)) . circleLayout r $ integrate s, Nothing), + modifyLayout = idModify } hunk ./Combo.hs 21 +import Data.Maybe ( isJust ) hunk ./Combo.hs 24 -import Operations ( UnDoLayout(UnDoLayout) ) hunk ./Combo.hs 40 - where arrange _ [] = return [] - arrange r [w] = return [(w,r)] + where arrange _ [] = return ([], Nothing) + arrange r [w] = return ([(w,r)], Nothing) hunk ./Combo.hs 43 - do rs <- map snd `fmap` runLayout super rinput (differentiate $ take (length origls) origws) + do rs <- (map snd . fst) `fmap` + runLayout super rinput (differentiate $ take (length origls) origws) hunk ./Combo.hs 52 - return $ concat out - message m = case fromMessage m of - Just UnDoLayout -> fmap (\(super':ls') -> Just $ combo (zip ls' $ map snd origls) super') - (broadcastPrivate UnDoLayout (super:map fst origls)) - _ -> fmap (maybe Nothing (Just . combo origls)) (modifyLayout super m) + let origls' = zipWith foo (out++repeat ([],Nothing)) origls + foo (_, Nothing) x = x + foo (_, Just l') (_, n) = (l', n) + return (concat $ map fst out, Just $ combo origls' super) + message m = do mls <- broadcastPrivate m (super:map fst origls) + return $ (\(super':ls') -> combo (zip ls' $ map snd origls) super') `fmap` mls hunk ./Combo.hs 59 -broadcastPrivate :: Message a => a -> [Layout b] -> X [Layout b] -broadcastPrivate a ol = mapM f ol - where f l = do ml' <- modifyLayout l (SomeMessage a) `catchX` return (Just l) - return $ maybe l id ml' +broadcastPrivate :: SomeMessage -> [Layout b] -> X (Maybe [Layout b]) +broadcastPrivate a ol = do nml <- mapM f ol + if any isJust nml + then return $ Just $ zipWith ((flip maybe) id) ol nml + else return Nothing + where f l = modifyLayout l a `catchX` return Nothing hunk ./Decoration.hs 27 -import XMonadContrib.LayoutHooks +import XMonadContrib.LayoutHelpers ( ModLay, layoutModify, idModDo ) hunk ./Decoration.hs 36 -newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel -> String - -> (Display -> Window -> GC -> FontStruct -> X ()) -> X () -> X Window -newDecoration decfor (Rectangle x y w h) th fg bg fn draw click = do +newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel + -> (Display -> Window -> GC -> X ()) -> X () -> X Window +newDecoration decfor (Rectangle x y w h) th fg bg draw click = do hunk ./Decoration.hs 45 - let hook :: SomeMessage -> X Bool - hook sm | Just e <- fromMessage sm = handle_event e >> return True - | Just UnDoLayout == fromMessage sm = io (destroyWindow d win) >> return False - | otherwise = return True + let hook :: SomeMessage -> X (Maybe (ModLay a)) + hook sm | Just e <- fromMessage sm = handle_event e >> return Nothing + | Just UnDoLayout == fromMessage sm = io (destroyWindow d win) >> return (Just id) + | otherwise = return Nothing hunk ./Decoration.hs 59 - addLayoutMessageHook hook - - return win + return $ layoutModify idModDo hook l hunk ./HintedTile.hs 47 - ; return $ zip w (tiler frac r `uncurry` splitAt nmaster hints) } + ; return (zip w (tiler frac r `uncurry` splitAt nmaster hints) + , Nothing) } hunk ./LayoutHelpers.hs 20 - idModMod, + idModDo, idModMod, hunk ./LayoutHelpers.hs 30 ---type DoLayout a = Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Layout a)) -type DoLayout a = Rectangle -> Stack a -> X [(a, Rectangle)] +type DoLayout a = Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Layout a)) hunk ./LayoutHelpers.hs 40 - where dl r s = do --(ws, ml') <- doLayout l r s - ws <- doLayout l r s + where dl r s = do (ws, ml') <- doLayout l r s hunk ./LayoutHelpers.hs 42 - --let ml'' = case mmod' of - -- Just mod' -> Just $ mod' $ maybe l id ml' - -- Nothing -> layoutModify fdo mod `fmap` ml' - --return (ws', ml'') - case mmod' of - Just _ -> fail "Sorry, can't yet safely modify layouts in doLayout." - Nothing -> return ws' + let ml'' = case mmod' of + Just mod' -> Just $ mod' $ maybe l id ml' + Nothing -> layoutModify fdo fmod `fmap` ml' + return (ws', ml'') hunk ./LayoutHelpers.hs 53 ---l2lModDo dl r s = return (dl r $ integrate s, Nothing) -l2lModDo dl r s = return (dl r $ integrate s) +l2lModDo dl r s = return (dl r $ integrate s, Nothing) + +idModDo :: ModDo a +idModDo _ _ wrs = return (wrs, Nothing) hunk ./LayoutHints.hs 24 +import XMonadContrib.LayoutHelpers ( layoutModify, idModMod ) hunk ./LayoutHints.hs 36 -layoutHints l = l { doLayout = \r x -> doLayout l r x >>= applyHints - , modifyLayout = \x -> fmap layoutHints `fmap` modifyLayout l x } - -applyHints :: [(Window, Rectangle)] -> X [(Window, Rectangle)] -applyHints xs = mapM applyHint xs - where applyHint (w,Rectangle a b c d) = +layoutHints = layoutModify applyHints idModMod + where applyHints _ _ xs = do xs' <- mapM applyHint xs + return (xs', Nothing) + applyHint (w,Rectangle a b c d) = hunk ./LayoutScreens.hs 51 - wss <- doLayout l rtrect W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] } + (wss, _) <- doLayout l rtrect W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] } hunk ./Magnifier.hs 27 +import XMonadContrib.LayoutHelpers hunk ./Magnifier.hs 35 -magnifier l = l { doLayout = \r s -> unlessMaster applyMagnifier r s `fmap` doLayout l r s - , modifyLayout = \x -> fmap magnifier `fmap` modifyLayout l x } +magnifier = layoutModify (unlessMaster applyMagnifier) idModMod hunk ./Magnifier.hs 39 -magnifier' l = l { doLayout = \r s -> applyMagnifier r s `fmap` doLayout l r s - , modifyLayout = \x -> fmap magnifier' `fmap` modifyLayout l x } +magnifier' = layoutModify applyMagnifier idModMod hunk ./Magnifier.hs 41 +unlessMaster :: ModDo a -> ModDo a +unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing) + else mainmod r s wrs hunk ./Magnifier.hs 45 -type DoLayout = Eq a => Rectangle -> Stack a -> [(a, Rectangle)] -> [(a, Rectangle)] - -unlessMaster :: DoLayout -> DoLayout -unlessMaster f r s = if null (up s) then id else f r s - -applyMagnifier :: DoLayout -applyMagnifier r s = reverse . foldr accumulate [] - where accumulate (w,wr) ws | w == focus s = ws ++ [(w, shrink r $ magnify wr)] - | otherwise = (w,wr) : ws +applyMagnifier :: Eq a => ModDo a +applyMagnifier r s wrs = return (map mag wrs, Nothing) + where mag (w,wr) | w == focus s = (w, shrink r $ magnify wr) + | otherwise = (w,wr) hunk ./Mosaic.hs 90 -mosaic delta tileFrac hints = full { doLayout = \r -> mosaicL tileFrac hints r . W.integrate, modifyLayout = return . mlayout } +mosaic delta tileFrac hints = full { doLayout = \r -> mosaicL tileFrac hints r . W.integrate + , modifyLayout = return . mlayout } hunk ./Mosaic.hs 140 - -> Rectangle -> [Window] -> X [(Window, Rectangle)] -mosaicL _ _ _ [] = return [] + -> Rectangle -> [Window] -> X ([(Window, Rectangle)],Maybe (Layout Window)) +mosaicL _ _ _ [] = return ([], Nothing) hunk ./Mosaic.hs 156 - return $ map (\(nw,r)->(--trace ("rate1:"++ unlines [show nw, + return (map (\(nw,r)->(--trace ("rate1:"++ unlines [show nw, hunk ./Mosaic.hs 162 - flattenMosaic $ the_value $ maxL [myh,myv,myh2,myv2] + flattenMosaic $ the_value $ maxL [myh,myv,myh2,myv2], Nothing) hunk ./SimpleStacking.hs 24 -import Control.Monad.State ( modify ) +import Control.Monad.State ( get ) hunk ./SimpleStacking.hs 28 -import Data.List ( nub, lookup ) -import StackSet ( focus, tag, workspace, current, integrate ) +import Data.List ( nub, lookup, delete ) +import StackSet ( focus, tag, workspace, current, up, down ) hunk ./SimpleStacking.hs 33 +import XMonadContrib.LayoutHelpers hunk ./SimpleStacking.hs 43 -simpleStacking' st l = l { doLayout = dl - , modifyLayout = \m -> fmap (simpleStacking' st) `fmap` modifyLayout l m } - where dl r s = do modify $ \ state -> - state { layouts = M.adjust - (\(_,ss)->(simpleStacking' - (focus s:filter (`elem` integrate s) st) l,ss)) - (tag.workspace.current.windowset $ state) - (layouts state) } - lo <- doLayout l r s - let m = map (\ (w,rr) -> (w,(w,rr))) lo - return $ catMaybes $ map ((flip lookup) m) $ nub (focus s : st ++ map fst lo) +simpleStacking' st = layoutModify dl idModMod + where dl r s wrs = let m = map (\ (w,rr) -> (w,(w,rr))) wrs + wrs' = catMaybes $ map ((flip lookup) m) $ + nub (focus s : st ++ map fst wrs) + st' = focus s:filter (`elem` (up s++down s)) st + in return (wrs', Just (simpleStacking' st')) hunk ./Tabbed.hs 23 -import Control.Monad ( forM ) +import Control.Monad ( forM, liftM ) +import Control.Monad.State ( gets ) hunk ./Tabbed.hs 33 +import XMonadContrib.LayoutHelpers ( idModify ) hunk ./Tabbed.hs 55 -data TConf = - TConf { activeColor :: String - , inactiveColor :: String - , bgColor :: String - , textColor :: String - , fontName :: String - , tabSize :: Int - } deriving (Show, Read) - -defaultTConf :: TConf -defaultTConf = - TConf { activeColor ="#BBBBBB" - , inactiveColor = "#888888" - , bgColor = "#000000" - , textColor = "#000000" - , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , tabSize = 20 - } +tabbed :: Shrinker -> Layout Window +tabbed shrinkT = Layout { doLayout = dolay shrinkT, modifyLayout = const (return Nothing) } hunk ./Tabbed.hs 58 -tabbed :: Shrinker -> TConf -> Layout Window -tabbed shrinkT config = Layout { doLayout = dolay shrinkT config, modifyLayout = const (return Nothing) } - -dolay :: Shrinker -> TConf -> Rectangle -> W.Stack Window -> X [(Window, Rectangle)] -dolay _ _ sc (W.Stack w [] []) = return [(w,sc)] -dolay shr conf sc@(Rectangle x y wid _) s = withDisplay $ \dpy -> - do activecolor <- io $ initColor dpy $ activeColor conf - inactivecolor <- io $ initColor dpy $ inactiveColor conf - textcolor <- io $ initColor dpy $ textColor conf - bgcolor <- io $ initColor dpy $ bgColor conf +dolay :: Shrinker -> Rectangle -> W.Stack Window -> X [(Window, Rectangle)] +dolay _ sc (W.Stack w [] []) = return [(w,sc)] +dolay shr sc@(Rectangle x y wid _) s = withDisplay $ \dpy -> + do activecolor <- io $ initColor dpy "#BBBBBB" + inactivecolor <- io $ initColor dpy "#888888" + textcolor <- io $ initColor dpy "#000000" + bgcolor <- io $ initColor dpy "#000000" hunk ./Tabbed.hs 68 - maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor (fontName conf) (drawtab t ow) (focus ow) - drawtab r@(Rectangle _ _ wt ht) ow d w' gc fn = + maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor (drawtab t ow) (focus ow) + drawtab r@(Rectangle _ _ wt ht) ow d w' gc = hunk ./Tabbed.hs 71 - let tabcolor = if W.focus s == ow then activecolor else inactivecolor + tabcolor <- (maybe inactivecolor (\focusw -> if focusw == ow then activecolor else inactivecolor) . W.peek) `liftM` gets windowset hunk ./Tabbed.hs 85 - return [(W.focus s, shrink conf sc)] + return $ map (\w -> (w,shrink sc)) ws hunk ./TwoPane.hs 38 -twoPane delta split = Layout { doLayout = \r s -> return $ arrange r s, modifyLayout = message } +twoPane delta split = Layout { doLayout = \r s -> return (arrange r s,Nothing), modifyLayout = message } addfile ./CopyWindow.hs hunk ./CopyWindow.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.CopyWindow +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- Provides a binding to duplicate a window on multiple workspaces, +-- providing dwm-like tagging functionality. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.CopyWindow ( + -- * Usage + -- $usage + copy, kill1 + ) where + +import Prelude hiding ( filter ) +import Control.Monad.State ( gets ) +import qualified Data.List as L +import XMonad +import Operations ( windows, kill ) +import StackSet + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.CopyWindow +-- +-- > -- mod-[1..9] @@ Switch to workspace N +-- > -- mod-shift-[1..9] @@ Move client to workspace N +-- > -- mod-control-shift-[1..9] @@ Copy client to workspace N +-- > [((m .|. modMask, k), f i) +-- > | (i, k) <- zip [0..fromIntegral (workspaces-1)] [xK_1 ..] +-- > , (f, m) <- [(view, 0), (shift, shiftMask), (copy, shiftMask .|. controlMask)]] +-- +-- you may also wish to redefine the binding to kill a window so it only +-- removes it from the current workspace, if it's present elsewhere: +-- +-- > , ((modMask .|. shiftMask, xK_c ), kill1) -- @@ Close the focused window + +-- | copy. Copy a window to a new workspace. +copy :: WorkspaceId -> X () +copy n = windows (copy' n) + +copy' :: (Ord a, Eq s, Integral i) => i -> StackSet i a s -> StackSet i a s +copy' n s = if n `tagMember` s && n /= tag (workspace (current s)) + then maybe s go (peek s) + else s + where go w = view (tag (workspace (current s))) $ insertUp' w $ view n s + + +-- | +-- /O(n)/. (Complexity due to check if element is in current stack.) Insert +-- a new element into the stack, above the currently focused element. +-- +-- The new element is given focus, and is set as the master window. +-- The previously focused element is moved down. The previously +-- 'master' element is forgotten. (Thus, 'insert' will cause a retiling). +-- +-- If the element is already in the current stack, it is shifted to the +-- focus position, as if it had been removed and then added. +-- +-- Semantics in Huet's paper is that insert doesn't move the cursor. +-- However, we choose to insert above, and move the focus. + +insertUp' :: Eq a => a -> StackSet i a s -> StackSet i a s +insertUp' a s = modify (Just $ Stack a [] []) + (\(Stack t l r) -> Just $ Stack a (L.delete a l) (L.delete a (t:r))) s + +delete' :: Ord a => a -> StackSet i a s -> StackSet i a s +delete' w = sink w . modify Nothing (filter (/= w)) + +-- | Remove the focussed window from this workspace. If it's present in no +-- other workspace, then kill it instead. If we do kill it, we'll get a +-- delete notify back from X. +-- +-- There are two ways to delete a window. Either just kill it, or if it +-- supports the delete protocol, send a delete event (e.g. firefox) +-- +kill1 :: X () +kill1 = do ss <- gets windowset + whenJust (peek ss) $ \w -> if member w $ delete' w ss + then windows $ delete' w + else kill hunk ./MetaModule.hs 28 +import XMonadContrib.CopyWindow () hunk ./Combo.hs 21 +import Control.Arrow ( first ) hunk ./Combo.hs 35 --- > simpleStacking $ combo [(full,1),(tabbed shrinkText,1)] (twoPane 0.03 0.5) +-- > simpleStacking $ combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText,1)] hunk ./Combo.hs 38 +-- +-- The first argument to combo is a Layout that will divide the screen into +-- one or more subscreens. The second argument is a list of layouts which +-- will be used to lay out the contents of each of those subscreents. +-- Paired with each of these layouts is an integer giving the number of +-- windows this section should hold. This number is ignored for the last +-- layout, which will hold any excess windows. hunk ./Combo.hs 46 -combo :: [(Layout a, Int)] -> Layout a -> Layout a -combo origls super = Layout { doLayout = \r s -> arrange r (integrate s), modifyLayout = message } +combo :: Layout (Layout a, Int) -> [(Layout a, Int)] -> Layout a +combo super origls = Layout { doLayout = \r s -> arrange r (integrate s), modifyLayout = message } hunk ./Combo.hs 51 - do rs <- (map snd . fst) `fmap` - runLayout super rinput (differentiate $ take (length origls) origws) - let wss [] _ = [] - wss [_] ws = [ws] - wss (n:ns) ws = take len1 ws : wss ns (drop len1 ws) - where len1 = min n (length ws - length ns) - out <- sequence $ zipWith3 runLayout (map fst origls) rs - (map differentiate $ - wss (take (length rs) $ map snd origls) origws) + do lrs <- fst `fmap` + runLayout super rinput (differentiate $ take (length origws) origls) + let lwrs [] _ = [] + lwrs [((l,_),r)] ws = [((l,r),differentiate ws)] + lwrs (((l,n),r):xs) ws = ((l,r),differentiate $ take len1 ws) : lwrs xs (drop len1 ws) + where len1 = min n (length ws - length xs) + out <- mapM (uncurry $ uncurry runLayout) $ lwrs lrs origws hunk ./Combo.hs 61 - return (concat $ map fst out, Just $ combo origls' super) - message m = do mls <- broadcastPrivate m (super:map fst origls) - return $ (\(super':ls') -> combo (zip ls' $ map snd origls) super') `fmap` mls + return (concat $ map fst out, Just $ combo super origls') + message m = do mls <- broadcastPrivate m (map fst origls) + let mls' = (\x->zipWith first (map const x) origls) `fmap` mls + msuper <- broadcastPrivate m [super] + case msuper of + Just [super'] -> return $ Just $ combo super' $ maybe origls id mls' + _ -> return $ combo super `fmap` mls' hunk ./Square.hs 38 --- > , combo [(tabbed,3),(tabbed,30),(tabbed,1),(tabbed,1)] --- > (combo [(twoPane 0.03 0.2,1) --- > ,(combo [(twoPane 0.03 0.8,1),(square,1)] --- > (mirror $ twoPane 0.03 0.85),1)] (twoPane 0.03 0.5) ) +-- > , combo (combo (mirror $ twoPane 0.03 0.85),1)] (twoPane 0.03 0.5) ) +-- > [(twoPane 0.03 0.2,1),(combo [(twoPane 0.03 0.8,1),(square,1)] +-- > [(tabbed,3),(tabbed,30),(tabbed,1),(tabbed,1)] hunk ./Square.hs 27 -import StackSet ( integrate ) -import XMonadContrib.LayoutHelpers ( l2lModDo ) +import XMonadContrib.LayoutHelpers ( l2lModDo, idModify ) hunk ./Square.hs 40 - -import XMonad -import Graphics.X11.Xlib -import StackSet ( integrate ) -import XMonadContrib.LayoutHelpers ( l2lModDo ) hunk ./Decoration.hs 36 -newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel - -> (Display -> Window -> GC -> X ()) -> X () -> X Window -newDecoration decfor (Rectangle x y w h) th fg bg draw click = do +newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel -> String + -> (Display -> Window -> GC -> FontStruct -> X ()) + -> X () -> Layout a -> X (Layout a) +newDecoration decfor (Rectangle x y w h) th fg bg fn draw click l = do hunk ./Tabbed.hs 23 -import Control.Monad ( forM, liftM ) hunk ./Tabbed.hs 32 +import XMonadContrib.SimpleStacking ( simpleStacking ) hunk ./Tabbed.hs 39 --- > import XMonadContrib.SimpleStacking hunk ./Tabbed.hs 41 --- > defaultLayouts = [ simpleStacking $ tabbed shrinkText defaultTConf --- > , ... ] +-- > defaultLayouts = [ tabbed shrinkText defaultTConf +-- > , ... ] hunk ./Tabbed.hs 51 --- > defaultLayouts = [ simpleStacking $ tabbed shrinkText myconfig --- > , ... ] +-- > defaultLayouts = [ tabbed shrinkText myconfig +-- > , ... ] hunk ./Tabbed.hs 54 -tabbed :: Shrinker -> Layout Window -tabbed shrinkT = Layout { doLayout = dolay shrinkT, modifyLayout = const (return Nothing) } +data TConf = + TConf { activeColor :: String + , inactiveColor :: String + , bgColor :: String + , textColor :: String + , fontName :: String + , tabSize :: Int + } deriving (Show, Read) + +defaultTConf :: TConf +defaultTConf = + TConf { activeColor ="#BBBBBB" + , inactiveColor = "#888888" + , bgColor = "#000000" + , textColor = "#000000" + , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , tabSize = 20 + } hunk ./Tabbed.hs 73 -dolay :: Shrinker -> Rectangle -> W.Stack Window -> X [(Window, Rectangle)] -dolay _ sc (W.Stack w [] []) = return [(w,sc)] -dolay shr sc@(Rectangle x y wid _) s = withDisplay $ \dpy -> - do activecolor <- io $ initColor dpy "#BBBBBB" - inactivecolor <- io $ initColor dpy "#888888" - textcolor <- io $ initColor dpy "#000000" - bgcolor <- io $ initColor dpy "#000000" +tabbed :: Shrinker -> TConf -> Layout Window +tabbed s t = simpleStacking $ tabbed' s t + +tabbed' :: Shrinker -> TConf -> Layout Window +tabbed' shrinkT config = Layout { doLayout = dolay shrinkT config, modifyLayout = idModify } + +dolay :: Shrinker -> TConf + -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Layout Window)) +dolay _ _ sc (W.Stack w [] []) = return ([(w,sc)], Nothing) +dolay shr conf sc@(Rectangle x y wid _) s = withDisplay $ \dpy -> + do activecolor <- io $ initColor dpy $ activeColor conf + inactivecolor <- io $ initColor dpy $ inactiveColor conf + textcolor <- io $ initColor dpy $ textColor conf + bgcolor <- io $ initColor dpy $ bgColor conf hunk ./Tabbed.hs 90 - maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor (drawtab t ow) (focus ow) - drawtab r@(Rectangle _ _ wt ht) ow d w' gc = + make_tabs [] l = return l + make_tabs (tw':tws') l = do l' <- maketab tw' l + make_tabs tws' l' + maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor + (fontName conf) (drawtab t ow) (focus ow) + drawtab r@(Rectangle _ _ wt ht) ow d w' gc fn = hunk ./Tabbed.hs 97 - tabcolor <- (maybe inactivecolor (\focusw -> if focusw == ow then activecolor else inactivecolor) . W.peek) `liftM` gets windowset + tabcolor <- (maybe inactivecolor (\focusw -> if focusw == ow + then activecolor + else inactivecolor) . W.peek) + `fmap` gets windowset hunk ./Tabbed.hs 113 - forM tws maketab - return $ map (\w -> (w,shrink sc)) ws + l' <- make_tabs tws $ tabbed shr conf + return (map (\w -> (w,shrink conf sc)) ws, Just l') addfile ./FlexibleResize.hs hunk ./FlexibleResize.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.FlexibleResize +-- Copyright : (c) Lukas Mai +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Lets you resize floating windows from any corner. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.FlexibleResize ( + -- * Usage + -- $usage + XMonadContrib.FlexibleResize.mouseResizeWindow +) where + +import XMonad +import Operations +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras +import Foreign.C.Types + +-- $usage +-- Put something like this in your Config.hs file: +-- +-- > import qualified XMonadContrib.FlexibleResize as Flex +-- > mouseBindings = M.fromList +-- > [ ... +-- > , ((modMask, button3), (\w -> focus w >> Flex.mouseResizeWindow w)) ] + +mouseResizeWindow :: Window -> X () +mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + sh <- io $ getWMNormalHints d w + (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w + let + [pos_x, pos_y, width, height] = map (fromIntegral . ($ wa)) [wa_x, wa_y, wa_width, wa_height] + west = firstHalf ix width + north = firstHalf iy height + (cx, fx, gx) = mkSel west width pos_x + (cy, fy, gy) = mkSel north height pos_y + io $ warpPointer d none w 0 0 0 0 cx cy + mouseDrag $ \(_, _, _, ex, ey, _, _, _, _, _) -> do + wa' <- getWindowAttributes d w + let [px, py] = map (fromIntegral . ($ wa')) [wa_x, wa_y] + moveResizeWindow d w (fromIntegral $ fx px ex) (fromIntegral $ fy py ey) + `uncurry` applySizeHints sh (gx ex, gy ey) + float w + where + firstHalf :: CInt -> Position -> Bool + firstHalf a b = fromIntegral a * 2 <= b + cfst = curry fst + csnd = curry snd + mkSel :: Bool -> Position -> Position -> (Position, a -> a -> a, CInt -> Dimension) + mkSel b k p = + if b + then (0, csnd, fromIntegral . max 1 . ((k + p) -) . fromIntegral) + else (k, cfst, fromIntegral . max 1 . subtract p . fromIntegral) hunk ./GreedyView.hs 57 - | (Just s) <- find (wTag . workspace) (visible ws) = ws { current = setScreen s (screen $ current ws) - , visible = setScreen (current ws) (screen s) + | (Just s) <- find (wTag . workspace) (visible ws) = ws { current = (current ws) { workspace = workspace s } + , visible = s { workspace = workspace (current ws) } hunk ./GreedyView.hs 63 - setScreen s i = s { screen = i } hunk ./CopyWindow.hs 50 -copy' :: (Ord a, Eq s, Integral i) => i -> StackSet i a s -> StackSet i a s +copy' :: (Ord a, Eq s, Integral i) => i -> StackSet i a s sd -> StackSet i a s sd hunk ./CopyWindow.hs 71 -insertUp' :: Eq a => a -> StackSet i a s -> StackSet i a s +insertUp' :: Eq a => a -> StackSet i a s sd -> StackSet i a s sd hunk ./CopyWindow.hs 75 -delete' :: Ord a => a -> StackSet i a s -> StackSet i a s +delete' :: Ord a => a -> StackSet i a s sd -> StackSet i a s sd hunk ./DwmPromote.hs 42 -swap :: StackSet i a s -> StackSet i a s +swap :: StackSet i a s sd -> StackSet i a s sd hunk ./FindEmptyWorkspace.hs 49 -findEmptyWorkspace :: StackSet i a s -> Maybe (Workspace i a) +findEmptyWorkspace :: StackSet i a s sd -> Maybe (Workspace i a) hunk ./Warp.hs 25 +import Data.List hunk ./Warp.hs 31 +import StackSet as W hunk ./Warp.hs 64 -warpToScreen :: Int -> Rational -> Rational -> X () +warpToScreen :: ScreenId -> Rational -> Rational -> X () hunk ./Warp.hs 66 - xScreens <- gets xineScreens - root <- asks theRoot - whenJust (ix n xScreens) $ \r -> - warp root (rect_x r + fraction h (rect_width r)) - (rect_y r + fraction v (rect_height r)) + root <- asks theRoot + (StackSet {current = x, visible = xs}) <- gets windowset + whenJust (fmap (screenRect . W.screenDetail) . find ((n==) . W.screen) $ x : xs) + $ \r -> + warp root (rect_x r + fraction h (rect_width r)) + (rect_y r + fraction v (rect_height r)) hunk ./LayoutScreens.hs 21 -import Control.Monad.State ( modify ) hunk ./LayoutScreens.hs 51 - modify $ \s -> s { xineScreens = map snd wss - , statusGaps = take nscr $ (statusGaps s) ++ repeat (0,0,0,0) } - hunk ./LayoutScreens.hs 53 - in ws { W.current = W.Screen x 0 - , W.visible = zipWith W.Screen xs [1 ..] + gaps = map (statusGap . W.screenDetail) $ v:vs + (s:ss, g:gg) = (map snd wss, take nscr $ gaps ++ repeat (0,0,0,0)) + sd = zipWith SD ss gg + in ws { W.current = W.Screen x 0 (SD s g) + , W.visible = zipWith3 W.Screen xs [1 ..] sd hunk ./SimpleStacking.hs 14 --- WARNING: This module is incompatible with Xinerama! --- hunk ./SimpleStacking.hs 22 -import Control.Monad.State ( get ) -import qualified Data.Map as M hunk ./SimpleStacking.hs 24 -import Data.List ( nub, lookup, delete ) -import StackSet ( focus, tag, workspace, current, up, down ) +import Data.List ( nub, lookup ) +import StackSet ( focus, up, down ) hunk ./SimpleStacking.hs 40 - where dl r s wrs = let m = map (\ (w,rr) -> (w,(w,rr))) wrs + where dl _ s wrs = let m = map (\ (w,rr) -> (w,(w,rr))) wrs hunk ./LayoutScreens.hs 54 - (s:ss, g:gg) = (map snd wss, take nscr $ gaps ++ repeat (0,0,0,0)) - sd = zipWith SD ss gg + (s:ss, g:gg) = (map snd wss, take nscr $ gaps ++ repeat (head gaps)) hunk ./LayoutScreens.hs 56 - , W.visible = zipWith3 W.Screen xs [1 ..] sd + , W.visible = zipWith3 W.Screen xs [1 ..] $ zipWith SD ss gg hunk ./NamedWindows.hs 31 -import Graphics.X11.Xlib.Extras ( fetchName ) +import Graphics.X11.Xlib.Extras hunk ./NamedWindows.hs 48 -getName w = asks display >>= \d -> do n <- maybe "" id `fmap` io (fetchName d w) +getName w = asks display >>= \d -> do s <- io $ getClassHint d w + n <- maybe (resName s) id `fmap` io (fetchName d w) hunk ./Tabbed.hs 57 - , bgColor :: String - , textColor :: String - , fontName :: String + , activeBorderColor :: String + , inactiveTextColor :: String + , inactiveBorderColor :: String + , activeTextColor :: String + , fontName :: String hunk ./Tabbed.hs 64 - + hunk ./Tabbed.hs 69 - , bgColor = "#000000" - , textColor = "#000000" + , activeBorderColor = "#FFFFFF" + , inactiveBorderColor = "#BFBFBF" + , activeTextColor = "#FFFFFF" + , inactiveTextColor = "#BFBFBF" hunk ./Tabbed.hs 87 - do activecolor <- io $ initColor dpy $ activeColor conf - inactivecolor <- io $ initColor dpy $ inactiveColor conf - textcolor <- io $ initColor dpy $ textColor conf - bgcolor <- io $ initColor dpy $ bgColor conf + do ac <- io $ initColor dpy $ activeColor conf + ic <- io $ initColor dpy $ inactiveColor conf + abc <- io $ initColor dpy $ activeBorderColor conf + ibc <- io $ initColor dpy $ inactiveBorderColor conf + atc <- io $ initColor dpy $ activeTextColor conf + itc <- io $ initColor dpy $ inactiveTextColor conf hunk ./Tabbed.hs 96 + focusColor w incol actcol = (maybe incol (\focusw -> if focusw == w + then actcol else incol) . W.peek) + `fmap` gets windowset hunk ./Tabbed.hs 100 - make_tabs (tw':tws') l = do l' <- maketab tw' l + make_tabs (tw':tws') l = do bc <- focusColor (snd tw') ibc abc + l' <- maketab tw' bc l hunk ./Tabbed.hs 103 - maketab (t,ow) = newDecoration ow t 1 bgcolor activecolor - (fontName conf) (drawtab t ow) (focus ow) + maketab (t,ow) bg = newDecoration ow t 1 bg ac + (fontName conf) (drawtab t ow) (focus ow) hunk ./Tabbed.hs 107 - tabcolor <- (maybe inactivecolor (\focusw -> if focusw == ow - then activecolor - else inactivecolor) . W.peek) - `fmap` gets windowset - io $ setForeground d gc tabcolor + (fc,tc) <- focusColor ow (ic,itc) (ac,atc) + io $ setForeground d gc fc hunk ./Tabbed.hs 110 - io $ setForeground d gc textcolor + io $ setForeground d gc tc hunk ./Decoration.hs 45 + io $ restackWindows d $ decfor : [win] hunk ./Tabbed.hs 46 --- > myconfig = defaultTConf { bgColor = "#FF0000" --- > , textColor = "#00FF00"} +-- > myconfig = defaultTConf { inactiveBolderColor = "#FF0000" +-- > , activeTextColor = "#00FF00"} hunk ./Dmenu.hs 46 --- http:\/\/www.jcreigh.com\/dmenu\/dmenu-2.8-xinerama.patch +-- hunk ./MetaModule.hs 35 +import XMonadContrib.FlexibleResize () hunk ./LayoutScreens.hs 3 --- Module : XMonadContrib.RotView +-- Module : XMonadContrib.LayoutScreens hunk ./LayoutScreens.hs 11 --- Provides bindings to cycle through non-empty workspaces. --- hunk ./Spiral.hs 3 --- Module : XMonadContrib.SimpleDate +-- Module : XMonadContrib.Spiral hunk ./Magnifier.hs 46 -applyMagnifier r s wrs = return (map mag wrs, Nothing) - where mag (w,wr) | w == focus s = (w, shrink r $ magnify wr) - | otherwise = (w,wr) +applyMagnifier r s wrs = return (reverse $ foldr mag [] wrs, Nothing) + where mag (w,wr) ws | w == focus s = ws ++ [(w, shrink r $ magnify wr)] + | otherwise = (w,wr) : ws hunk ./MetaModule.hs 40 +import XMonadContrib.LayoutHooks () hunk ./MetaModule.hs 50 +import XMonadContrib.SinkAll () hunk ./Commands.hs 69 -screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= f) +screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust f) hunk ./Tabbed.hs 40 --- > defaultLayouts :: [Layout] +-- > defaultLayouts :: [Layout Window] addfile ./DeManage.hs hunk ./DeManage.hs 1 +{-# OPTIONS -fglasgow-exts #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.DeManage +-- Copyright : (c) Spencer Janssen +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Spencer Janssen +-- Stability : unstable +-- Portability : unportable +-- +-- This module provides a method to cease management of a window, without +-- unmapping it. This is especially useful for applications like kicker and +-- gnome-panel. +-- +-- To make a panel display correctly with xmonad: +-- +-- * Determine the pixel size of the panel, add that value to defaultGaps +-- * Launch the panel +-- * Give the panel window focus, then press mod-d +-- * Convince the panel to move/resize to the correct location. Changing the +-- panel's position setting several times seems to work. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.DeManage ( + -- * Usage + -- $usage + demanage + ) where + +import qualified StackSet as W +import XMonad +import Operations +import Control.Monad.State + +-- $usage +-- To use demanage, add this import: +-- +-- > import XMonadContrib.GreedyView +-- +-- And add a keybinding to it: +-- +-- > , ((modMask, xK_d ), demanage) +-- + +-- | Stop managing the current focused window. +demanage :: X () +demanage = do + ws <- gets windowset + modify (\s -> s { windowset = maybe ws (flip W.delete ws) (W.peek ws) }) + refresh hunk ./MetaModule.hs 30 +import XMonadContrib.DeManage () hunk ./DeManage.hs 40 --- > import XMonadContrib.GreedyView +-- > import XMonadContrib.DeManage hunk ./DeManage.hs 36 +import Graphics.X11 (Window) hunk ./DeManage.hs 45 --- > , ((modMask, xK_d ), demanage) +-- > , ((modMask, xK_d ), withFocused demanage) hunk ./DeManage.hs 49 -demanage :: X () -demanage = do - ws <- gets windowset - modify (\s -> s { windowset = maybe ws (flip W.delete ws) (W.peek ws) }) +demanage :: Window -> X () +demanage w = do + -- use modify to defeat automatic 'unmanage' calls. + modify (\s -> s { windowset = W.delete w (windowset s) }) hunk ./Spiral.hs 19 + , spiralWithDir + , Rotation (..) + , Direction (..) hunk ./Spiral.hs 49 -data Direction = East | South | West | North deriving (Enum) +data Rotation = CW | CCW +data Direction = East | South | West | North deriving (Eq, Enum) hunk ./Spiral.hs 60 -spiral scale = Layout { doLayout = l2lModDo fibLayout, - modifyLayout = \m -> return $ fmap resize $ fromMessage m } +spiral = spiralWithDir East CW + +spiralWithDir :: Direction -> Rotation -> Rational -> Layout a +spiralWithDir dir rot scale = Layout { doLayout = l2lModDo fibLayout, + modifyLayout = \m -> return $ fmap resize $ fromMessage m } hunk ./Spiral.hs 68 - rects = divideRects (zip ratios (cycle [East .. North])) sc - + rects = divideRects (zip ratios dirs) sc + dirs = dropWhile (/= dir) $ case rot of + CW -> cycle [East .. North] + CCW -> cycle [North, West, South, East] addfile ./ThreeColumns.hs hunk ./ThreeColumns.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.ThreeColumns +-- Copyright : (c) Kai Grossjohann +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : ? +-- Stability : unstable +-- Portability : unportable +-- +-- A layout similar to tall but with three columns. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.ThreeColumns ( + -- * Usage + -- $usage + threeCol + ) where + +import XMonad +import qualified StackSet as W +import Operations ( Resize(..), IncMasterN(..), splitVertically, tall ) + +import Data.Ratio + +--import Control.Monad.State +import Control.Monad.Reader + +import Graphics.X11.Xlib + +-- $usage +-- +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.ThreeColumns +-- +-- and add, to the list of layouts: +-- +-- > threeCol + +threeCol :: Int -> Rational -> Rational -> Layout a +threeCol nmaster delta frac = + Layout { doLayout = \r -> return . (\x->(x,Nothing)) . + ap zip (tile3 frac r nmaster . length) . W.integrate + , modifyLayout = \m -> return $ msum [fmap resize (fromMessage m) + ,fmap incmastern (fromMessage m)] } + + where resize Shrink = tall nmaster delta (max 0 $ frac-delta) + resize Expand = tall nmaster delta (min 1 $ frac+delta) + incmastern (IncMasterN d) = tall (max 0 (nmaster+d)) delta frac + +-- | tile3. Compute window positions using 3 panes +tile3 :: Rational -> Rectangle -> Int -> Int -> [Rectangle] +tile3 f r nmaster n = if n <= nmaster || nmaster == 0 + then splitVertically n r + else splitVertically nmaster r1 ++ splitVertically nmid r2 ++ splitVertically nright r3 + where (r1, r2, r3) = split3HorizontallyBy f r + nslave = (n - nmaster) + nmid = floor (nslave % 2) + nright = (n - nmaster - nmid) + +split3HorizontallyBy :: Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle) +split3HorizontallyBy f (Rectangle sx sy sw sh) = + ( Rectangle sx sy leftw sh + , Rectangle (sx + fromIntegral leftw) sy midw sh + , Rectangle (sx + fromIntegral leftw + fromIntegral midw) sy rightw sh ) + where leftw = floor $ fromIntegral sw * (2/3) * f + midw = floor ( (sw - leftw) % 2 ) + rightw = sw - leftw - midw hunk ./ThreeColumns.hs 23 -import Operations ( Resize(..), IncMasterN(..), splitVertically, tall ) +import Operations ( Resize(..), IncMasterN(..), splitVertically, tall, splitHorizontallyBy ) hunk ./ThreeColumns.hs 55 -tile3 f r nmaster n = if n <= nmaster || nmaster == 0 - then splitVertically n r - else splitVertically nmaster r1 ++ splitVertically nmid r2 ++ splitVertically nright r3 +tile3 f r nmaster n + | n <= nmaster || nmaster == 0 = splitVertically n r + | n <= nmaster+1 = splitVertically nmaster s1 ++ splitVertically (n-nmaster) s2 + | otherwise = splitVertically nmaster r1 ++ splitVertically nmid r2 ++ splitVertically nright r3 hunk ./ThreeColumns.hs 60 + (s1, s2) = splitHorizontallyBy f r hunk ./ThreeColumns.hs 62 - nmid = floor (nslave % 2) + nmid = ceiling (nslave % 2) hunk ./ThreeColumns.hs 70 - where leftw = floor $ fromIntegral sw * (2/3) * f - midw = floor ( (sw - leftw) % 2 ) + where leftw = ceiling $ fromIntegral sw * (2/3) * f + midw = ceiling ( (sw - leftw) % 2 ) hunk ./ThreeColumns.hs 23 -import Operations ( Resize(..), IncMasterN(..), splitVertically, tall, splitHorizontallyBy ) +import Operations ( Resize(..), IncMasterN(..), splitVertically, splitHorizontallyBy ) hunk ./ThreeColumns.hs 49 - where resize Shrink = tall nmaster delta (max 0 $ frac-delta) - resize Expand = tall nmaster delta (min 1 $ frac+delta) - incmastern (IncMasterN d) = tall (max 0 (nmaster+d)) delta frac + where resize Shrink = threeCol nmaster delta (max 0 $ frac-delta) + resize Expand = threeCol nmaster delta (min 1 $ frac+delta) + incmastern (IncMasterN d) = threeCol (max 0 (nmaster+d)) delta frac hunk ./Tabbed.hs 67 - TConf { activeColor ="#BBBBBB" - , inactiveColor = "#888888" + TConf { activeColor ="#999999" + , inactiveColor = "#666666" hunk ./Tabbed.hs 70 - , inactiveBorderColor = "#BFBFBF" + , inactiveBorderColor = "#BBBBBB" addfile ./FocusNth.hs hunk ./FocusNth.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.FocusNth +-- Copyright : (c) Karsten Schoelzel +-- License : BSD +-- +-- Maintainer : Karsten Schoelzel +-- Stability : unstable +-- Portability : unportable +-- +-- Focus the n'th window on the screen. +----------------------------------------------------------------------------- + +module XMonadContrib.FocusNth ( + -- * Usage + -- $usage + focusNth) where + +import StackSet +import Operations +import XMonad + +-- $usage +-- > import XMonadContrib.FocusNth + +-- > -- mod4-[1..9] @@ Switch to window N +-- > ++ [((mod4Mask, k), focusNth i) +-- > | (i, k) <- zip [0 .. 8] [xK_1 ..]] + +focusNth :: Int -> X () +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) + +listToStack :: Int -> [a] -> Stack a +listToStack n l = Stack t ls rs + where (t:rs) = drop n l + ls = reverse (take n l) + + hunk ./WorkspaceDir.hs 34 +import XMonadContrib.LayoutHelpers ( layoutModify ) hunk ./WorkspaceDir.hs 52 -workspaceDir wd l = l { doLayout = \r x -> scd wd >> doLayout l r x - , modifyLayout = ml } - where ml m | Just (Chdir wd') <- fromMessage m = return $ Just (workspaceDir wd' l) - | otherwise = fmap (workspaceDir wd) `fmap` modifyLayout l m +workspaceDir wd = layoutModify dowd modwd + where dowd _ _ rws = scd wd >> return (rws, Nothing) + modwd m = return $ do Chdir wd' <- fromMessage m + Just $ workspaceDir wd' hunk ./MetaModule.hs 55 +import XMonadContrib.SwitchTrans () addfile ./SwitchTrans.hs hunk ./SwitchTrans.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.SwitchTrans +-- Copyright : (c) Lukas Mai +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +----------------------------------------------------------------------------- + +{-# OPTIONS_GHC -fglasgow-exts #-} + +-- | Ordinary layout transformers are simple and easy to use but inflexible. +-- This module provides a more structured interface to them. +-- +-- The basic idea is to have a base layout and a set of layout transformers, +-- of which at most one is active at any time. Enabling another transformer +-- first disables any currently active transformer; i.e. it works like +-- a 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 undo the current layout transformer, pass the message on to the base +-- layout, then reapply the transformer. +-- +-- Here's how you might use this in Config.hs: +-- +-- > defaultLayouts = +-- > map ( +-- > mkSwitch (M.singleton "full" (const $ noBorders full)) . +-- > mkSwitch (M.singleton "mirror" mirror) +-- > ) [ tiled ] +-- +-- (The noBorders transformer is from @XMonadContrib.NoBorders@.) +-- +-- This example is probably overkill but it's very close to what I actually use. +-- Anyway, this layout behaves like the default @tiled@ layout, until you send it +-- @Enable@\/@Disable@\/@Toggle@ messages. From the definition of @keys@: +-- +-- > ... +-- > , ((modMask, xK_f ), sendMessage $ Toggle "full") +-- > , ((modMask, xK_r ), sendMessage $ Toggle "mirror") +-- +-- (You may want to use other keys. I don't use Xinerama so the default mod-r +-- binding is useless to me.) +-- +-- After this, pressing @mod-f@ switches the current window to fullscreen mode. +-- Pressing @mod-f@ again switches it back. Similarly, @mod-r@ rotates the layout +-- by 90 degrees (and back). The nice thing is that your changes are kept: +-- Rotating first then changing the size of the master area then rotating back +-- does not undo the master area changes. +-- +-- The reason I use two stacked @SwitchTrans@ transformers instead of +-- @mkSwitch (M.fromList [("full", const $ noBorders full), ("mirror", mirror)])@ +-- is that I use @mod-f@ to "zoom in" on interesting windows, no matter what other +-- layout transformers may be active. Having an extra fullscreen mode on top of +-- everything else means I can zoom in and out without implicitly undoing "normal" +-- layout transformers, like @mirror@. Remember, inside a @SwitchTrans@ there can +-- be at most one active layout transformer. +module XMonadContrib.SwitchTrans ( + Toggle(..), + Enable(..), + Disable(..), + mkSwitch +) where + +import XMonad +import Operations + +import qualified Data.Map as M +import Data.Map (Map) + +-- | Toggle the specified layout transformer. +data Toggle = Toggle String deriving (Eq, Typeable) +instance Message Toggle +-- | Enable the specified transformer. +data Enable = Enable String deriving (Eq, Typeable) +instance Message Enable +-- | Disable the specified transformer. +data Disable = Disable String deriving (Eq, Typeable) +instance Message Disable + +data State a = State { + base :: Layout a, + currTag :: Maybe String, + currLayout :: Layout a, + currFilt :: Layout a -> Layout a, + filters :: Map String (Layout a -> Layout a) +} + +-- | Take a transformer table and a base layout, and return a +-- SwitchTrans layout. +mkSwitch :: Map String (Layout a -> Layout a) -> Layout a -> Layout a +mkSwitch fs b = switched st + where + st = State{ + base = b, + currTag = Nothing, + currLayout = b, + currFilt = id, + filters = fs } + +provided :: Bool -> X (Maybe a) -> X (Maybe a) +provided c x + | c = x + | otherwise = return Nothing + +switched :: State a -> Layout a +switched + state@State{ + base = b, + currTag = ct, + currLayout = cl, + currFilt = cf, + filters = fs + } = Layout {doLayout = dl, modifyLayout = ml} + where + enable tag alt = do + modifyLayout cl (SomeMessage UnDoLayout) + return . Just . switched $ state{ + currTag = Just tag, + currFilt = alt, + currLayout = alt b } + disable = do + modifyLayout cl (SomeMessage UnDoLayout) + return . Just . switched $ state{ + currTag = Nothing, + currFilt = id, + currLayout = b } + dl r s = do + (x, _) <- doLayout cl r s + return (x, Nothing) -- sorry Dave, I can't let you do that + ml m + | Just (Disable tag) <- fromMessage m + , M.member tag fs + = provided (ct == Just tag) $ disable + | Just (Enable tag) <- fromMessage m + , Just alt <- M.lookup tag fs + = provided (ct /= Just tag) $ enable tag alt + | Just (Toggle tag) <- fromMessage m + , Just alt <- M.lookup tag fs + = + if (ct == Just tag) then + disable + else + enable tag alt + | Just UnDoLayout <- fromMessage m + = do + modifyLayout cl m + return Nothing + | otherwise = do + x <- modifyLayout b m + case x of + Nothing -> return Nothing + Just b' -> do + modifyLayout cl (SomeMessage UnDoLayout) + return . Just $ switched state{ + base = b', + currLayout = cf b' } hunk ./Commands.hs 20 + commandMap, hunk ./Commands.hs 22 + runCommand', + workspaceCommands, + screenCommands, hunk ./Commands.hs 27 - + hunk ./Commands.hs 30 -import {-# SOURCE #-} Config (workspaces, commands) hunk ./Commands.hs 31 +import {-# SOURCE #-} Config (workspaces) hunk ./Commands.hs 49 +-- > commands :: [(String, X ())] hunk ./Commands.hs 52 --- Finally, add the following lines to Config.hs-boot: --- --- > import XMonad (X) --- > workspaces :: Int --- > commands :: [(String, X ())] --- hunk ./Commands.hs 57 - -commandMap :: M.Map String (X ()) -commandMap = M.fromList commands +commandMap :: [(String, X ())] -> M.Map String (X ()) +commandMap c = M.fromList c hunk ./Commands.hs 92 -runCommand :: X () -runCommand = do - choice <- dmenu (M.keys commandMap) - fromMaybe (return ()) (M.lookup choice commandMap) +runCommand :: [(String, X ())] -> X () +runCommand cl = do + let m = commandMap cl + choice <- dmenu (M.keys m) + fromMaybe (return ()) (M.lookup choice m) + +runCommand' :: String -> X () +runCommand' c = do + let m = commandMap defaultCommands + fromMaybe (return ()) (M.lookup c m) hunk ./MetaModule.hs 26 --- TODO commented because it requires hs-boot modifications import XMonadContrib.Commands () +import XMonadContrib.Commands () addfile ./FlexibleManipulate.hs hunk ./FlexibleManipulate.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.FlexibleManipulate +-- Copyright : (c) Michael Sloan +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Lets you move and resize floating windows without warping the mouse. +-- +----------------------------------------------------------------------------- + +-- Based on the FlexibleResize code by Lukas Mai (Mauke) + +module XMonadContrib.FlexibleManipulate ( + -- * Usage + -- $usage + mouseWindow, discrete, linear, resize, position +) where + +import XMonad +import Operations +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras +import Foreign.C.Types + +-- $usage +-- Add this import to your Config.hs file: +-- +-- > import qualified XMonadContrib.FlexibleManipulate as Flex +-- +-- Set one of the mouse button bindings up like this: +-- > mouseBindings = M.fromList +-- > [ ((modMask, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w)) ], ... +-- +-- Flex.linear indicates that positions between the edges and the middle +-- indicate a combination scale/position. +-- Flex.discrete indicates that there are discrete pick regions. (window +-- is divided by thirds for each axis) +-- Flex.resize performs only resize of the window, based on which quadrant +-- the mouse is in +-- Flex.position is similar to the builtin mouseMoveWindow +-- +-- You can also write your own function for this parameter. It should take +-- a value between 0 and 1 indicating position, and return a value indicating +-- the corresponding position if plain Flex.linear was used. + +discrete x | x < 0.33 = 0 + | x > 0.66 = 1 + | otherwise = 0.5 + +linear = id + +resize x = if x < 0.5 then 0 else 1 +position = const 0.5 + +mouseWindow :: (Double -> Double) -> Window -> X () +mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + [wpos, wsize] <- io $ getWindowAttributes d w >>= return . winAttrs + sh <- io $ getWMNormalHints d w + pointer <- io $ queryPointer d w >>= return . pointerPos + + let uv = (pointer - wpos) / wsize + fc = mapP f uv + mul = mapP (\x -> 2 - 2 * abs(x - 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle + atl = ((1, 1) - fc) * mul + abr = fc * mul + mouseDrag $ \(_, _, _, _, _, ex, ey, _, _, _) -> do + let offset = (fromIntegral ex, fromIntegral ey) - pointer + npos = wpos + offset * atl + nbr = (wpos + wsize) + offset * abr + ntl = minP (nbr - (32, 32)) npos --minimum size + nwidth = applySizeHints sh $ mapP round (nbr - ntl) + moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth + + float w + + where + pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt + winAttrs :: WindowAttributes -> [Pnt] + winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height] + + +-- I'd rather I didn't have to do this, but I hate writing component 2d math +type Pnt = (Double, Double) + +pairUp :: [a] -> [(a,a)] +pairUp [] = [] +pairUp [_] = [] +pairUp (x:y:xs) = (x, y) : (pairUp xs) + +mapP :: (a -> b) -> (a, a) -> (b, b) +mapP f (x, y) = (f x, f y) +zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c) +zipP f (ax,ay) (bx,by) = (f ax bx, f ay by) + +minP :: Ord a => (a,a) -> (a,a) -> (a,a) +minP = zipP min + +instance Num Pnt where + (+) = zipP (+) + (-) = zipP (-) + (*) = zipP (*) + abs = mapP abs + signum = mapP signum + fromInteger = const undefined + +instance Fractional Pnt where + fromRational = const undefined + recip = mapP recip hunk ./MetaModule.hs 37 +import XMonadContrib.FlexibleManipulate () hunk ./FlexibleManipulate.hs 27 -import Foreign.C.Types hunk ./FlexibleManipulate.hs 49 +discrete, linear, resize, position :: Double -> Double + hunk ./DeManage.hs 21 --- * Convince the panel to move/resize to the correct location. Changing the +-- * Convince the panel to move\/resize to the correct location. Changing the addfile ./RotSlaves.hs hunk ./RotSlaves.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.RotSlaves +-- Copyright : (c) Hans Philipp Annen , Mischa Dieterle +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Hans Philipp Annen +-- Stability : unstable +-- Portability : unportable +-- +-- Rotate all windows except the master window +-- and keep the focus in place. +----------------------------------------------------------------------------- +module XMonadContrib.RotSlaves ( + -- $usage + rotSlaves', rotSlaves + ) where + +import qualified StackSet as SS + +-- $usage +-- +-- To use this module, import it with: +-- +-- > import XMonadContrib.RotSlaves +-- +-- and add a keybinding: +-- +-- , ((modMask .|. shiftMask, xK_Tab ), windows rotSlaves) +-- +-- +-- This operation will rotate all windows except the master window, while the focus +-- stays where it is. It is usefull together with the TwoPane-Layout (see XMonadContrib.TwoPane). +-- + +rotSlaves :: SS.StackSet i a s sd -> SS.StackSet i a s sd +rotSlaves = SS.modify' rotSlaves' + +rotSlaves' :: SS.Stack a -> SS.Stack a +rotSlaves' (SS.Stack t ls rs) | (null ls) = SS.Stack t [] ((rearRs)++(frontRs)) --Master has focus + | otherwise = SS.Stack t' (reverse ((master)++revls')) rs' --otherwise + where (frontRs, rearRs) = splitAt (max 0 ((length rs) - 1)) rs + (ils, master) = splitAt (max 0 ((length ls) - 1)) ls + toBeRotated = (reverse ils)++(t:rs) + (revls',t':rs') = splitAt (length ils) ((last toBeRotated):(init toBeRotated)) + + hunk ./MetaModule.hs 49 +import XMonadContrib.RotSlaves () hunk ./MetaModule.hs 59 +import XMonadContrib.ThreeColumns () hunk ./MetaModule.hs 38 +import XMonadContrib.FocusNth () hunk ./FlexibleManipulate.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} addfile ./ShellPrompt.hs hunk ./ShellPrompt.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.ShellPrompt +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A shell prompt for XMonad +-- +----------------------------------------------------------------------------- + +module XMonadContrib.ShellPrompt ( + -- * Usage + -- $usage + shellPrompt + ) where +{- +usage: +1. In xmonad.cabal change: +build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0 +to +build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0, readline >= 1.0 + +2. In Config.hs add: +> import XMonadContrib.ShellPrompt + +3. In your keybindings add something like: + +> , ((modMask .|. controlMask, xK_x), shellPrompt defaultPromptConfig) + +-} + +import XMonad +import XMonadContrib.XPrompt + +import Control.Monad +import Data.List +import System.Console.Readline +import System.Environment + +data Shell = Shell + +instance XPrompt Shell where + showXPrompt Shell = "Run: " + + +shellPrompt :: XPConfig -> X () +shellPrompt c = mkXPrompt Shell c getShellCompl spawn + +getShellCompl :: String -> IO [String] +getShellCompl s + | s /= "" && last s /= ' ' = do + fl <- filenameCompletionFunction (last . words $ s) + c <- commandCompletionFunction (last . words $ s) + return $ sort . nub $ fl ++ c + | otherwise = return [] + +commandCompletionFunction :: String -> IO [String] +commandCompletionFunction str + | '/' `elem` str = return [] + | otherwise = do + p <- getEnv "PATH" + cl p + where + cl = liftM (nub . rmPath . concat) . mapM fCF . map addToPath . split ':' + addToPath = flip (++) ("/" ++ str) + fCF = filenameCompletionFunction + rmPath [] = [] + rmPath s = map (last . split '/') s + +split :: Eq a => a -> [a] -> [[a]] +split _ [] = [] +split e l = + f : split e (rest ls) + where + (f,ls) = span (/=e) l + rest s | s == [] = [] + | otherwise = tail s + addfile ./SshPrompt.hs hunk ./SshPrompt.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.SshPrompt +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A ssh prompt for XMonad +-- +----------------------------------------------------------------------------- + +module XMonadContrib.SshPrompt ( + -- * Usage + -- $usage + sshPrompt + ) where +{- +usage: +1. In Config.hs add: + +> import XMonadContrib.SshPrompt + +3. In your keybindings add something like: + +> , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultPromptConfig) + +-} + +import XMonad +import XMonadContrib.XPrompt + +import Control.Monad +import System.Directory +import System.Environment + +data Ssh = Ssh + +instance XPrompt Ssh where + showXPrompt Ssh = "SSH to: " + +sshPrompt :: XPConfig -> X () +sshPrompt c = do + sc <- io $ sshComplList + mkXPrompt Ssh c (mkComplFunFromList sc) ssh + +ssh :: String -> X () +ssh s = spawn $ "exec xterm -e ssh " ++ s + +sshComplList :: IO [String] +sshComplList = do + h <- getEnv "HOME" + let kh = h ++ "/.ssh/known_hosts" + f <- doesFileExist kh + if f then do l <- readFile kh + return $ map (takeWhile (/= ',') . concat . take 1 . words) (lines l) + else return [] addfile ./XMonadPrompt.hs hunk ./XMonadPrompt.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.XMonadPrompt +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A prompt for running XMonad commands +-- +----------------------------------------------------------------------------- + +module XMonadContrib.XMonadPrompt ( + -- * Usage + -- $usage + xmonadPrompt + ) where +{- +usage: +in Config.hs add: +> import XMonadContrib.XMonadPrompt + +in you keybindings add: + +> , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultPromptConfig) + +-} + +import XMonad +import XMonadContrib.XPrompt +import XMonadContrib.Commands + +data XMonad = XMonad + +instance XPrompt XMonad where + showXPrompt XMonad = "XMonad: " + +xmonadPrompt :: XPConfig -> X () +xmonadPrompt c = mkXPrompt XMonad c (mkComplFunFromList (map fst defaultCommands)) runCommand' addfile ./Prompt.hs move ./Prompt.hs ./XPrompt.hs hunk ./XPrompt.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.XPrompt +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A module for writing graphical prompts for XMonad +-- +----------------------------------------------------------------------------- + +module XMonadContrib.XPrompt ( + -- * Usage + -- $usage + mkXPrompt + , defaultPromptConfig + , mkComplFunFromList + , XPType (..) + , XPPosition (..) + , XPConfig (..) + , XPrompt (..) + ) where + +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras +import XMonad hiding (io) +import Operations + +import Control.Monad.Reader +import Control.Monad.State +import Data.Bits +import Data.Char +import Data.Maybe +import Data.List + + +-- $usage: +-- +-- For example usage see XMonadContrib.ShellPrompt or +-- XMonadContrib.XMonadPrompt + + +type XP = StateT XPState IO + +data XPState = + XPS { dpy :: Display + , rootw :: Window + , win :: Window + , complWin :: Maybe Window + , complWinDim :: Maybe ComplWindowDim + , completionFunction :: String -> IO [String] + , compList :: Maybe [String] + , gcon :: GC + , fs :: FontStruct + , xptype :: XPType + , command :: String + , offset :: Int + , config :: XPConfig + } + +data XPConfig = + XPC { font :: String -- ^ Font + , bgColor :: String -- ^ Backgroud color + , fgColor :: String -- ^ Default font color + , hLight :: String -- ^ Default font color + , borderColor :: String -- ^ + , borderWidth :: Dimension + , position :: XPPosition + , height :: Dimension -- ^ Window height + } deriving (Show, Read) + +data XPType = forall p . XPrompt p => XPT p + +instance Show XPType where + show (XPT p) = showXPrompt p + +instance XPrompt XPType where + showXPrompt = show + +class XPrompt t where + showXPrompt :: t -> String + +data XPPosition = Top + | Bottom + deriving (Show,Read) + +defaultPromptConfig :: XPConfig +defaultPromptConfig = + XPC { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , bgColor = "#666666" + , fgColor = "#FFFFFF" + , hLight = "#999999" + , borderColor = "#FFFFFF" + , borderWidth = 1 + , position = Bottom + , height = 18 + } + +type ComplFunction = String -> IO [String] + +initState :: XPrompt p => Display -> Window -> Window -> ComplFunction + -> GC -> FontStruct -> p -> XPConfig -> XPState +initState d rw w compl gc f pt c = + XPS d rw w Nothing Nothing compl Nothing gc f (XPT pt) "" 0 c + +mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X () +mkXPrompt t conf compl action = do + c <- ask + let d = display c + rw = theRoot c + w <- liftIO $ createWin d rw conf + liftIO $ selectInput d w $ exposureMask .|. keyPressMask + gc <- liftIO $ createGC d w + liftIO $ setGraphicsExposures d gc False + fontS <- liftIO $ loadQueryFont d (font conf) + + let st = initState d rw w compl gc fontS (XPT t) conf + st' <- liftIO $ execStateT runXP st + + liftIO $ freeGC d gc + liftIO $ freeFont d fontS + action (command st') + +runXP :: XP () +runXP = do + st <- get + let d = dpy st + w = win st + status <- io $ grabKeyboard d w True grabModeAsync grabModeAsync currentTime + when (status == grabSuccess) $ do + updateWin + io $ ungrabKeyboard d currentTime + io $ destroyWindow d w + destroyComplWin + io $ sync d False + +eventLoop :: XP () +eventLoop = do + d <- gets dpy + (keysym,string,event) <- io $ + allocaXEvent $ \e -> do + nextEvent d e + ev <- getEvent e + (ks,s) <- lookupString $ asKeyEvent e + return (ks,s,ev) + handle (fromMaybe xK_VoidSymbol keysym,string) event + +type KeyStroke = (KeySym, String) + +-- Main event handler +handle :: KeyStroke -> Event -> XP () +handle ks (KeyEvent {ev_event_type = t, ev_state = m}) + | t == keyPress = do + keyPressHandle m ks +handle _ (AnyEvent {ev_event_type = t, ev_window = w}) + | t == expose = do + st <- get + when (win st == w) updateWin +handle _ _ = eventLoop + +-- KeyPresses + +data Direction = Prev | Next deriving (Eq,Show,Read) + +keyPressHandle :: KeyMask -> KeyStroke -> XP () +-- commands: ctrl + ... todo +keyPressHandle mask (ks,s) + | mask == controlMask = do + -- TODO + eventLoop + +keyPressHandle _ (ks,_) +-- exit + | ks == xK_Return = do + return () +-- backspace + | ks == xK_BackSpace = do + deleteString Prev + updateWin +-- delete + | ks == xK_Delete = do + deleteString Next + updateWin +-- left + | ks == xK_Left = do + moveCursor Prev + updateWin +-- right + | ks == xK_Right = do + moveCursor Next + updateWin +-- exscape: exit and discard everything + | ks == xK_Escape = do + flushString + return () +-- tab -> completion loop + | ks == xK_Tab = do + completionLoop + --eventLoop + +-- insert a character +keyPressHandle _ (_,s) + | s == "" = eventLoop + | otherwise = do + insertString s + updateWin + +-- KeyPress and State + +-- | Flush the command string and reset the offest +flushString :: XP () +flushString = + modify (\s -> s { command = "", offset = 0} ) + +-- | Insert a character at the cursor position +insertString :: String -> XP () +insertString str = + modify (\s -> s { command = c (command s) (offset s), offset = o (offset s)} ) + where o oo = oo + length str + c oc oo + | oo >= length oc = oc ++ str + | otherwise = f ++ str ++ ss + where (f,ss) = splitAt oo oc + +-- | Remove a character at the cursor position +deleteString :: Direction -> XP () +deleteString d = + modify (\s -> s { command = c (command s) (offset s), offset = o (offset s)} ) + where o oo = if d == Prev then max 0 (oo - 1) else oo + c oc oo + | oo >= length oc && d == Prev = take (oo - 1) oc + | oo < length oc && d == Prev = take (oo - 1) f ++ ss + | oo < length oc && d == Next = f ++ tail ss + | otherwise = oc + where (f,ss) = splitAt oo oc + +-- | move the cursor one position +moveCursor :: Direction -> XP () +moveCursor d = + 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) + + +-- X Stuff + +createWin :: Display -> Window -> XPConfig -> IO Window +createWin d rw c = do + let scr = defaultScreenOfDisplay d + wh = widthOfScreen scr + (x,y) = case position c of + Top -> (0,0) + Bottom -> (0,heightOfScreen scr - (height c)) + w <- mkUnmanagedWindow d scr rw + x (fi y) wh (height c) + mapWindow d w + return w + +updateWin :: XP () +updateWin = do + st <- get + drawWin + compl <- getCompletions (command st) + nwi <- getComplWinDim compl + let recreate = do destroyComplWin + w <- createComplWin nwi + drawComplWin w compl + -- check if we have to recreate the completion window + if (compl /= [] ) + then case complWin st of + Just w -> case complWinDim st of + Just wi -> if nwi == wi -- complWinDim did not change + then drawComplWin w compl -- so update + else recreate + Nothing -> recreate + Nothing -> recreate + else destroyComplWin + io $ sync (dpy st) False + eventLoop + +drawWin :: XP () +drawWin = do + st <- get + let c = config st + d = dpy st + scr = defaultScreenOfDisplay d + w = win st + wh = widthOfScreen scr + ht = height c + bw = borderWidth c + gc = gcon st + fontStruc = fs st + bgcolor <- io $ initColor d (bgColor c) + border <- io $ initColor d (borderColor c) + p <- io $ createPixmap d w wh ht + (defaultDepthOfScreen scr) + io $ fillDrawable d p gc border bgcolor (fi bw) wh ht + printPrompt p gc fontStruc + io $ copyArea d p w gc 0 0 wh ht 0 0 + io $ freePixmap d p + +printPrompt :: Drawable -> GC -> FontStruct -> XP () +printPrompt drw gc fontst = do + c <- gets config + st <- get + let d = dpy st + (prt,com,off) = (show (xptype st), command st, offset st) + str = prt ++ com + -- scompose the string in 3 part: till the cursor, the cursor and the rest + (f,p,ss) = if off >= length com + then (str, " ","") -- add a space: it will be our cursor ;-) + else let (a,b) = (splitAt off com) + in (prt ++ a, [head b], tail b) + ht = height c + (fsl,psl) = (textWidth fontst f, textWidth fontst p) + (_,asc,desc,_) = textExtents fontst str + y = fi $ (ht + fi (asc + desc)) `div` 2 + x = (asc + desc) `div` 2 + fgcolor <- io $ initColor d $ fgColor c + bgcolor <- io $ initColor d $ bgColor c + -- print the first part + io $ printString d drw gc fgcolor bgcolor x y f + -- reverse the colors and print the "cursor" ;-) + io $ printString d drw gc bgcolor fgcolor (x + fsl) y p + -- reverse the colors and print the rest of the string + io $ printString d drw gc fgcolor bgcolor (x + fsl + psl) y ss + + +-- Completions + +getCompletions :: String -> XP [String] +getCompletions s = do + cf <- gets completionFunction + c <- io $ cf s + setComplList c + return c + +setComplWin :: Window -> ComplWindowDim -> XP () +setComplWin w wi = + modify (\s -> s { complWin = Just w, complWinDim = Just wi }) + +setComplList :: [String] -> XP () +setComplList l = + modify (\s -> s { compList = Just l }) + +destroyComplWin :: XP () +destroyComplWin = do + d <- gets dpy + cw <- gets complWin + case cw of + Just w -> do io $ destroyWindow d w + modify (\s -> s { complWin = Nothing, complWinDim = Nothing, compList = Nothing }) + Nothing -> return () + +completionLoop :: XP () +completionLoop = do + cl <- gets compList + let nc oc | oc == [] = [] + | otherwise = head $ fromMaybe [oc] cl + case cl of + Just (l:_) -> do modify (\s -> s { command = l, offset = length l }) + updateWin + _ -> eventLoop + +type ComplWindowDim = (Position,Position,Dimension,Dimension,Rows,Columns) +type Rows = [Position] +type Columns = [Position] + +createComplWin :: ComplWindowDim -> XP Window +createComplWin wi@(x,y,wh,ht,_,_) = do + st <- get + let d = dpy st + scr = defaultScreenOfDisplay d + w <- io $ mkUnmanagedWindow d scr (rootw st) + x y wh ht + io $ mapWindow d w + setComplWin w wi + return w + +getComplWinDim :: [String] -> XP ComplWindowDim +getComplWinDim compl = do + st <- get + let c = config st + d = dpy st + scr = defaultScreenOfDisplay d + wh = widthOfScreen scr + ht = height c + fontst = fs st + + let compl_number = length compl + max_compl_len = (fi ht `div` 2) + (maximum . map (textWidth fontst) $ compl) + columns = wh `div` (fi max_compl_len) + rem_height = heightOfScreen scr - ht + needed_rows = max 1 (compl_number `div` fi columns) + actual_max_number_of_rows = rem_height `div` ht + actual_rows = min actual_max_number_of_rows (fi needed_rows) + actual_height = actual_rows * ht + (x,y) = case position c of + Top -> (0,ht) + Bottom -> (0, (0 + rem_height - actual_height)) + + let (_,asc,desc,_) = textExtents fontst $ head compl + yp = fi $ (ht + fi (asc + desc)) `div` 2 + xp = (asc + desc) `div` 2 + yy = map fi . take (fi actual_rows) $ [yp,(yp + ht)..] + xx = take (fi columns) [xp,(xp + max_compl_len)..] + + return (x, fi y, wh, actual_height, xx, yy) + +drawComplWin :: Window -> [String] -> XP () +drawComplWin w compl = do + st <- get + let c = config st + d = dpy st + scr = defaultScreenOfDisplay d + bw = borderWidth c + gc = gcon st + bgcolor <- io $ initColor d (bgColor c) + fgcolor <- io $ initColor d (fgColor c) + border <- io $ initColor d (borderColor c) + + (_,_,wh,ht,xx,yy) <- getComplWinDim compl + + p <- io $ createPixmap d w wh ht + (defaultDepthOfScreen scr) + io $ fillDrawable d p gc border bgcolor (fi bw) wh ht + let ac = splitInSubListsAt (length yy) (take ((length xx) * (length yy)) compl) + printComplList d p gc fgcolor bgcolor xx yy ac + io $ copyArea d p w gc 0 0 wh ht 0 0 + io $ freePixmap d p + +printComplList :: Display -> Drawable -> GC -> Pixel -> Pixel + -> [Position] -> [Position] -> [[String]] -> XP () +printComplList _ _ _ _ _ _ _ [] = return () +printComplList _ _ _ _ _ [] _ _ = return () +printComplList d drw gc fc bc (x:xs) y (s:ss) = do + printComplColumn d drw gc fc bc x y s + printComplList d drw gc fc bc xs y ss + +printComplColumn :: Display -> Drawable -> GC -> Pixel -> Pixel + -> Position -> [Position] -> [String] -> XP () +printComplColumn _ _ _ _ _ _ _ [] = return () +printComplColumn _ _ _ _ _ _ [] _ = return () +printComplColumn d drw gc fc bc x (y:yy) (s:ss) = do + printComplString d drw gc fc bc x y s + printComplColumn d drw gc fc bc x yy ss + +printComplString :: Display -> Drawable -> GC -> Pixel -> Pixel + -> Position -> Position -> String -> XP () +printComplString d drw gc fc bc x y s = do + st <- get + if s == command st + then do c <- io $ initColor d (hLight $ config st) + io $ printString d drw gc fc c x y s + else io $ printString d drw gc fc bc x y s + +-- More general X Stuff + +printString :: Display -> Drawable -> GC -> Pixel -> Pixel + -> Position -> Position -> String -> IO () +printString d drw gc fc bc x y s = do + setForeground d gc fc + setBackground d gc bc + drawImageString d drw gc x y s + +fillDrawable :: Display -> Drawable -> GC -> Pixel -> Pixel + -> Dimension -> Dimension -> Dimension -> IO () +fillDrawable d drw gc border bgcolor bw wh ht = do + -- we strat with the border + setForeground d gc border + fillRectangle d drw gc 0 0 wh ht + -- this foreground is the background of the text + setForeground d gc bgcolor + fillRectangle d drw gc (fi bw) (fi bw) (wh - (bw * 2)) (ht - (bw * 2)) + +-- | Creates a window with the attribute override_redirect set to True. +-- Windows Managers should not touch this kind of windows. +mkUnmanagedWindow :: Display -> Screen -> Window -> Position + -> Position -> Dimension -> Dimension -> IO Window +mkUnmanagedWindow d s rw x y w h = do + let visual = defaultVisualOfScreen s + attrmask = cWOverrideRedirect + allocaSetWindowAttributes $ + \attributes -> do + set_override_redirect attributes True + createWindow d rw x y w h 0 (defaultDepthOfScreen s) + inputOutput visual attrmask attributes + +-- Utilities + +-- completions +mkComplFunFromList :: [String] -> String -> IO [String] +mkComplFunFromList _ [] = return [] +mkComplFunFromList l s = + return $ filter (\x -> take (length s) x == s) l + + +-- Lift an IO action into the XP +io :: IO a -> XP a +io = liftIO + +-- shorthand +fi :: (Num b, Integral a) => a -> b +fi = fromIntegral + +splitInSubListsAt :: Int -> [a] -> [[a]] +splitInSubListsAt _ [] = [] +splitInSubListsAt i x = f : splitInSubListsAt i rest + where (f,rest) = splitAt i x + hunk ./XPrompt.hs 31 +import qualified StackSet as W hunk ./XPrompt.hs 53 + , screen :: Rectangle hunk ./XPrompt.hs 106 -initState :: XPrompt p => Display -> Window -> Window -> ComplFunction +initState :: XPrompt p => Display -> Window -> Window -> Rectangle -> ComplFunction hunk ./XPrompt.hs 108 -initState d rw w compl gc f pt c = - XPS d rw w Nothing Nothing compl Nothing gc f (XPT pt) "" 0 c +initState d rw w s compl gc f pt c = + XPS d rw w s Nothing Nothing compl Nothing gc f (XPT pt) "" 0 c hunk ./XPrompt.hs 116 - w <- liftIO $ createWin d rw conf + s <- gets $ screenRect . W.screenDetail . W.current . windowset + w <- liftIO $ createWin d rw conf s hunk ./XPrompt.hs 123 - let st = initState d rw w compl gc fontS (XPT t) conf + let st = initState d rw w s compl gc fontS (XPT t) conf hunk ./XPrompt.hs 252 -createWin :: Display -> Window -> XPConfig -> IO Window -createWin d rw c = do - let scr = defaultScreenOfDisplay d - wh = widthOfScreen scr - (x,y) = case position c of +createWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window +createWin d rw c s = do + let (x,y) = case position c of hunk ./XPrompt.hs 256 - Bottom -> (0,heightOfScreen scr - (height c)) - w <- mkUnmanagedWindow d scr rw - x (fi y) wh (height c) + Bottom -> (0, rect_height s - height c) + w <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rw + (rect_x s + x) (rect_y s + fi y) (rect_width s) (height c) hunk ./XPrompt.hs 388 - scr = defaultScreenOfDisplay d - wh = widthOfScreen scr + scr = screen st + wh = rect_width scr hunk ./XPrompt.hs 396 - rem_height = heightOfScreen scr - ht + rem_height = rect_height scr - ht hunk ./XPrompt.hs 411 - return (x, fi y, wh, actual_height, xx, yy) + return (rect_x scr + x, rect_y scr + fi y, wh, actual_height, xx, yy) hunk ./ShellPrompt.hs 28 +> import XMonadContrib.XPrompt hunk ./ShellPrompt.hs 33 -> , ((modMask .|. controlMask, xK_x), shellPrompt defaultPromptConfig) +> , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig) hunk ./ShellPrompt.hs 57 - fl <- filenameCompletionFunction (last . words $ s) - c <- commandCompletionFunction (last . words $ s) + fl <- filenameCompletionFunction s + c <- commandCompletionFunction s hunk ./SshPrompt.hs 24 +> import XMonadContrib.XPrompt hunk ./XMonadPrompt.hs 23 +> import XMonadContrib.XPrompt hunk ./XPrompt.hs 1 +{-# OPTIONS -fglasgow-exts #-} hunk ./XPrompt.hs 21 + , defaultXPConfig hunk ./XPrompt.hs 41 - +import System.Environment (getEnv) +import System.IO +import System.Posix.Files (fileExist) hunk ./XPrompt.hs 50 +-- TODO +-- scrolling the completions that don't fit in the window +-- commands to edit the command line hunk ./XPrompt.hs 64 - , compList :: Maybe [String] + , compList :: Maybe [String] -- Maybe ([String],[String],[String]) for scrolling hunk ./XPrompt.hs 69 - , offset :: Int + , offset :: Int + , history :: ![History] hunk ./XPrompt.hs 75 - XPC { font :: String -- ^ Font - , bgColor :: String -- ^ Backgroud color - , fgColor :: String -- ^ Default font color - , hLight :: String -- ^ Default font color - , borderColor :: String -- ^ - , borderWidth :: Dimension - , position :: XPPosition - , height :: Dimension -- ^ Window height + XPC { font :: String -- ^ Font + , bgColor :: String -- ^ Backgroud color + , fgColor :: String -- ^ Font color + , fgHLight :: String -- ^ Font color of a highlighted completion entry + , bgHLight :: String -- ^ Backgroud color of a highlighted completion entry + , borderColor :: String -- ^ Border color + , borderWidth :: Dimension -- ^ Border width + , position :: XPPosition -- ^ Position: 'Top' or 'Bottom' + , height :: Dimension -- ^ Window height + , historySize :: Int hunk ./XPrompt.hs 103 -defaultPromptConfig = +defaultPromptConfig = defaultXPConfig + +defaultXPConfig :: XPConfig +defaultXPConfig = hunk ./XPrompt.hs 110 - , hLight = "#999999" + , fgHLight = "#000000" + , bgHLight = "#999999" hunk ./XPrompt.hs 116 + , historySize = 256 hunk ./XPrompt.hs 122 - -> GC -> FontStruct -> p -> XPConfig -> XPState -initState d rw w s compl gc f pt c = - XPS d rw w s Nothing Nothing compl Nothing gc f (XPT pt) "" 0 c + -> GC -> FontStruct -> p -> [History] -> XPConfig -> XPState +initState d rw w s compl gc f pt h c = + XPS d rw w s Nothing Nothing compl Nothing gc f (XPT pt) "" 0 h c hunk ./XPrompt.hs 137 - - let st = initState d rw w s compl gc fontS (XPT t) conf + h <- liftIO $ readHistory + let st = initState d rw w s compl gc fontS (XPT t) h conf hunk ./XPrompt.hs 152 - updateWin + updateWindows + eventLoop handle hunk ./XPrompt.hs 159 -eventLoop :: XP () -eventLoop = do +eventLoop :: (KeyStroke -> Event -> XP ()) -> XP () +eventLoop action = do hunk ./XPrompt.hs 168 - handle (fromMaybe xK_VoidSymbol keysym,string) event + action (fromMaybe xK_VoidSymbol keysym,string) event hunk ./XPrompt.hs 174 +handle k@(ks,_) e@(KeyEvent {ev_event_type = t}) + | t == keyPress && ks == xK_Tab = completionHandle k e hunk ./XPrompt.hs 177 - | t == keyPress = do - keyPressHandle m ks + | t == keyPress = keyPressHandle m ks hunk ./XPrompt.hs 181 - when (win st == w) updateWin -handle _ _ = eventLoop + when (win st == w) $ updateWindows >> eventLoop handle +handle _ _ = eventLoop handle + +-- completion event handler +completionHandle :: KeyStroke -> Event -> XP () +completionHandle k@(ks,_) e@(KeyEvent {ev_event_type = t}) + | t == keyPress && ks == xK_Tab = do + st <- get + case compList st of + Just l -> let new_index = case elemIndex (getLastWord (command st)) l of + Just i -> if i >= (length l - 1) then 0 else i + 1 + Nothing -> 0 + new_command = skipLastWord (command st) ++ fill ++ l !! new_index + fill = if ' ' `elem` (command st) then " " else "" + in do modify $ \s -> s { command = new_command, offset = length new_command } + redrawWindows + Nothing -> do updateWindows + eventLoop completionHandle + +completionHandle ks (KeyEvent {ev_event_type = t, ev_state = m}) + | t == keyPress = keyPressHandle m ks +-- go back to main loop +completionHandle k e = handle k e + hunk ./XPrompt.hs 215 - eventLoop + eventLoop handle hunk ./XPrompt.hs 220 + historyPush + writeHistory hunk ./XPrompt.hs 226 - updateWin + setCompletionList + updateWindows + eventLoop handle hunk ./XPrompt.hs 232 - updateWin + setCompletionList + updateWindows + eventLoop handle hunk ./XPrompt.hs 238 - updateWin + redrawWindows + eventLoop handle hunk ./XPrompt.hs 243 - updateWin + redrawWindows + eventLoop handle +-- up + | ks == xK_Up = do + moveHistory Prev + setCompletionList + updateWindows + eventLoop handle +-- down + | ks == xK_Down = do + moveHistory Next + setCompletionList + updateWindows + eventLoop handle hunk ./XPrompt.hs 261 --- tab -> completion loop - | ks == xK_Tab = do - completionLoop - --eventLoop hunk ./XPrompt.hs 264 - | s == "" = eventLoop + | s == "" = eventLoop handle hunk ./XPrompt.hs 267 - updateWin + setCompletionList + updateWindows + eventLoop handle hunk ./XPrompt.hs 275 -flushString = +flushString = do hunk ./XPrompt.hs 306 +moveHistory :: Direction -> XP () +moveHistory d = do + h <- getHistory + c <- gets command + let str = if h /= [] then head h else c + let nc = case elemIndex c h of + Just i -> case d of + Prev -> h !! (if (i + 1) > (length h - 1) then 0 else i + 1) + Next -> h !! (max (i - 1) 0) + Nothing -> str + modify (\s -> s { command = nc, offset = length nc }) hunk ./XPrompt.hs 330 -updateWin :: XP () -updateWin = do +updateWindows :: XP () +updateWindows = do + d <- gets dpy + drawWin + setCompletionList + io $ sync d False + +redrawWindows :: XP () +redrawWindows = do hunk ./XPrompt.hs 341 - compl <- getCompletions (command st) - nwi <- getComplWinDim compl - let recreate = do destroyComplWin - w <- createComplWin nwi - drawComplWin w compl - -- check if we have to recreate the completion window - if (compl /= [] ) - then case complWin st of - Just w -> case complWinDim st of - Just wi -> if nwi == wi -- complWinDim did not change - then drawComplWin w compl -- so update - else recreate - Nothing -> recreate - Nothing -> recreate - else destroyComplWin - io $ sync (dpy st) False - eventLoop + case compList st of + Just l -> redrawComplWin l + Nothing -> return () hunk ./XPrompt.hs 402 +setComplList :: [String] -> XP () +setComplList [] = return () +setComplList l = + modify (\s -> s { compList = Just l }) + hunk ./XPrompt.hs 411 -setComplList :: [String] -> XP () -setComplList l = - modify (\s -> s { compList = Just l }) +setCompletionList :: XP () +setCompletionList = do + c <- gets command + compl <- getCompletions $ getLastWord c + redrawComplWin compl hunk ./XPrompt.hs 426 -completionLoop :: XP () -completionLoop = do - cl <- gets compList - let nc oc | oc == [] = [] - | otherwise = head $ fromMaybe [oc] cl - case cl of - Just (l:_) -> do modify (\s -> s { command = l, offset = length l }) - updateWin - _ -> eventLoop - -type ComplWindowDim = (Position,Position,Dimension,Dimension,Rows,Columns) +type ComplWindowDim = (Position,Position,Dimension,Dimension,Columns,Rows) hunk ./XPrompt.hs 445 - d = dpy st hunk ./XPrompt.hs 454 - needed_rows = max 1 (compl_number `div` fi columns) + (rows,r) = compl_number `divMod` fi columns + needed_rows = max 1 (rows + if r == 0 then 0 else 1) hunk ./XPrompt.hs 493 +redrawComplWin :: [String] -> XP () +redrawComplWin compl = do + st <- get + nwi <- getComplWinDim compl + let recreate = do destroyComplWin + w <- createComplWin nwi + drawComplWin w compl + if (compl /= [] ) + then case complWin st of + Just w -> case complWinDim st of + Just wi -> if nwi == wi -- complWinDim did not change + then drawComplWin w compl -- so update + else recreate + Nothing -> recreate + Nothing -> recreate + else destroyComplWin + hunk ./XPrompt.hs 530 - if s == command st - then do c <- io $ initColor d (hLight $ config st) - io $ printString d drw gc fc c x y s + if s == getLastWord (command st) + then do bhc <- io $ initColor d (bgHLight $ config st) + fhc <- io $ initColor d (fgHLight $ config st) + io $ printString d drw gc fhc bhc x y s hunk ./XPrompt.hs 536 +-- History + +data History = + H { prompt :: String + , command_history :: String + } deriving (Show, Read, Eq) + +historyPush :: XP () +historyPush = do + c <- gets command + when (c /= []) $ modify (\s -> s { history = H (showXPrompt (xptype s)) c : history s }) + +getHistory :: XP [String] +getHistory = do + hist <- gets history + pt <- gets xptype + return $ map command_history . filter (\h -> prompt h == showXPrompt pt) $ hist + +readHistory :: IO [History] +readHistory = do + home <- getEnv "HOME" + let path = home ++ "/.xmonad_history" + f <- fileExist path + -- from http://users.aber.ac.uk/afc/stricthaskell.html#semiclosed + let hGetContentsStrict h = do + b <- hIsEOF h + if b then return [] else + do c <- hGetChar h + r <- hGetContentsStrict h + return (c:r) + do_read = do ha <- openFile path ReadMode + hSetBuffering ha NoBuffering + s <- hGetContentsStrict ha + hClose ha + return s + if f then do str <- catch (do_read) (\_ -> do putStrLn "error in reading"; return []) + case (reads str) of + [(hist,_)] -> return hist + [] -> return [] + _ -> return [] + else return [] + +writeHistory :: XP () +writeHistory = do + h <- gets history + c <- gets config + home <- io $ getEnv "HOME" + let path = home ++ "/.xmonad_history" + htw = take (historySize c) . nub $ h + io $ catch (writeFile path (show htw)) (\_ -> do putStrLn "error in writing"; return ()) + hunk ./XPrompt.hs 641 +getLastWord :: String -> String +getLastWord [] = [] +getLastWord c = last . words $ c + +skipLastWord :: String -> String +skipLastWord [] = [] +skipLastWord c = unwords . init . words $ c hunk ./XPrompt.hs 226 - setCompletionList + refreshCompletionList hunk ./XPrompt.hs 232 - setCompletionList + refreshCompletionList hunk ./XPrompt.hs 248 - setCompletionList + refreshCompletionList hunk ./XPrompt.hs 254 - setCompletionList + refreshCompletionList hunk ./XPrompt.hs 267 - setCompletionList + refreshCompletionList hunk ./XPrompt.hs 334 - setCompletionList + refreshCompletionList hunk ./XPrompt.hs 411 -setCompletionList :: XP () -setCompletionList = do +refreshCompletionList :: XP () +refreshCompletionList = do hunk ./XPrompt.hs 64 - , compList :: Maybe [String] -- Maybe ([String],[String],[String]) for scrolling + , compList :: [String] -- Maybe ([String],[String],[String]) for scrolling hunk ./XPrompt.hs 124 - XPS d rw w s Nothing Nothing compl Nothing gc f (XPT pt) "" 0 h c + XPS d rw w s Nothing Nothing compl [] gc f (XPT pt) "" 0 h c hunk ./XPrompt.hs 190 - Just l -> let new_index = case elemIndex (getLastWord (command st)) l of + [] -> do updateWindows + l -> let new_index = case elemIndex (getLastWord (command st)) l of hunk ./XPrompt.hs 194 - new_command = skipLastWord (command st) ++ fill ++ l !! new_index - fill = if ' ' `elem` (command st) then " " else "" - in do modify $ \s -> s { command = new_command, offset = length new_command } - redrawWindows - Nothing -> do updateWindows + new_command = skipLastWord (command st) ++ fill ++ l !! new_index + fill = if ' ' `elem` (command st) then " " else "" + in do modify $ \s -> s { command = new_command, offset = length new_command } + redrawWindows hunk ./XPrompt.hs 342 - Just l -> redrawComplWin l - Nothing -> return () + [] -> return () + l -> redrawComplWin l hunk ./XPrompt.hs 403 -setComplList [] = return () hunk ./XPrompt.hs 404 - modify (\s -> s { compList = Just l }) + modify (\s -> s { compList = l }) hunk ./XPrompt.hs 422 - modify (\s -> s { complWin = Nothing, complWinDim = Nothing, compList = Nothing }) + modify (\s -> s { complWin = Nothing, complWinDim = Nothing, compList = [] }) hunk ./XPrompt.hs 64 - , compList :: [String] -- Maybe ([String],[String],[String]) for scrolling hunk ./XPrompt.hs 123 - XPS d rw w s Nothing Nothing compl [] gc f (XPT pt) "" 0 h c + XPS d rw w s Nothing Nothing compl gc f (XPT pt) "" 0 h c hunk ./XPrompt.hs 151 - updateWindows - eventLoop handle - io $ ungrabKeyboard d currentTime + --updateWindows + updateWindows + eventLoop handle + io $ ungrabKeyboard d currentTime hunk ./XPrompt.hs 175 - | t == keyPress && ks == xK_Tab = completionHandle k e + | t == keyPress && ks == xK_Tab = do + c <- getCompletions + completionHandle c k e hunk ./XPrompt.hs 187 -completionHandle :: KeyStroke -> Event -> XP () -completionHandle k@(ks,_) e@(KeyEvent {ev_event_type = t}) +completionHandle :: [String] -> KeyStroke -> Event -> XP () +completionHandle c k@(ks,_) e@(KeyEvent {ev_event_type = t}) hunk ./XPrompt.hs 191 - case compList st of + case c of hunk ./XPrompt.hs 193 + eventLoop handle hunk ./XPrompt.hs 200 - redrawWindows - eventLoop completionHandle - -completionHandle ks (KeyEvent {ev_event_type = t, ev_state = m}) + redrawWindows c + eventLoop (completionHandle c) +-- key release + | t == keyRelease && ks == xK_Tab = eventLoop (completionHandle c) +completionHandle _ ks (KeyEvent {ev_event_type = t, ev_state = m}) hunk ./XPrompt.hs 207 -completionHandle k e = handle k e +completionHandle _ k e = handle k e hunk ./XPrompt.hs 230 - refreshCompletionList hunk ./XPrompt.hs 235 - refreshCompletionList hunk ./XPrompt.hs 240 - redrawWindows + updateWindows hunk ./XPrompt.hs 245 - redrawWindows + updateWindows hunk ./XPrompt.hs 250 - refreshCompletionList hunk ./XPrompt.hs 255 - refreshCompletionList hunk ./XPrompt.hs 267 - refreshCompletionList hunk ./XPrompt.hs 319 -createWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window -createWin d rw c s = do - let (x,y) = case position c of - Top -> (0,0) - Bottom -> (0, rect_height s - height c) - w <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rw - (rect_x s + x) (rect_y s + fi y) (rect_width s) (height c) - mapWindow d w - return w - hunk ./XPrompt.hs 323 - refreshCompletionList + c <- getCompletions + case c of + [] -> return () + l -> redrawComplWin l hunk ./XPrompt.hs 329 -redrawWindows :: XP () -redrawWindows = do - st <- get +redrawWindows :: [String] -> XP () +redrawWindows c = do + d <- gets dpy hunk ./XPrompt.hs 333 - case compList st of + case c of hunk ./XPrompt.hs 336 + io $ sync d False + +createWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window +createWin d rw c s = do + let (x,y) = case position c of + Top -> (0,0) + Bottom -> (0, rect_height s - height c) + w <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rw + (rect_x s + x) (rect_y s + fi y) (rect_width s) (height c) + mapWindow d w + return w hunk ./XPrompt.hs 398 -getCompletions :: String -> XP [String] -getCompletions s = do - cf <- gets completionFunction - c <- io $ cf s - setComplList c - return c - -setComplList :: [String] -> XP () -setComplList l = - modify (\s -> s { compList = l }) +getCompletions :: XP [String] +getCompletions = do + s <- get + io $ (completionFunction s) (command s) hunk ./XPrompt.hs 407 -refreshCompletionList :: XP () -refreshCompletionList = do - c <- gets command - compl <- getCompletions $ getLastWord c - redrawComplWin compl - hunk ./XPrompt.hs 413 - modify (\s -> s { complWin = Nothing, complWinDim = Nothing, compList = [] }) + modify (\s -> s { complWin = Nothing, complWinDim = Nothing }) hunk ./RotSlaves.hs 16 - rotSlaves', rotSlaves + rotSlaves', rotSlavesUp, rotSlavesDown hunk ./RotSlaves.hs 19 -import qualified StackSet as SS +import StackSet +import Operations +import XMonad hunk ./RotSlaves.hs 31 --- , ((modMask .|. shiftMask, xK_Tab ), windows rotSlaves) +-- , ((modMask .|. shiftMask, xK_Tab ), rotSlavesUp) hunk ./RotSlaves.hs 38 -rotSlaves :: SS.StackSet i a s sd -> SS.StackSet i a s sd -rotSlaves = SS.modify' rotSlaves' - -rotSlaves' :: SS.Stack a -> SS.Stack a -rotSlaves' (SS.Stack t ls rs) | (null ls) = SS.Stack t [] ((rearRs)++(frontRs)) --Master has focus - | otherwise = SS.Stack t' (reverse ((master)++revls')) rs' --otherwise - where (frontRs, rearRs) = splitAt (max 0 ((length rs) - 1)) rs - (ils, master) = splitAt (max 0 ((length ls) - 1)) ls - toBeRotated = (reverse ils)++(t:rs) - (revls',t':rs') = splitAt (length ils) ((last toBeRotated):(init toBeRotated)) - +rotSlavesUp,rotSlavesDown :: X () +rotSlavesUp = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l])) +rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l))) hunk ./RotSlaves.hs 42 +rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a +rotSlaves' _ s@(Stack _ [] []) = s +rotSlaves' f (Stack t [] rs) = Stack t [] (f rs) -- Master has focus +rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs' -- otherwise + where (master:ws) = integrate s + (revls',t':rs') = splitAt (length ls) (master:(f ws)) hunk ./XPrompt.hs 69 - , history :: ![History] + , history :: [History] hunk ./XPrompt.hs 142 - action (command st') + when (command st' /= "") $ action (command st') hunk ./XPrompt.hs 151 - --updateWindows hunk ./XPrompt.hs 158 +type KeyStroke = (KeySym, String) + hunk ./XPrompt.hs 171 -type KeyStroke = (KeySym, String) - hunk ./XPrompt.hs 187 -completionHandle c k@(ks,_) e@(KeyEvent {ev_event_type = t}) +completionHandle c (ks,_) (KeyEvent {ev_event_type = t}) hunk ./XPrompt.hs 203 +-- other keys hunk ./XPrompt.hs 206 --- go back to main loop +-- some other event: go back to main loop hunk ./XPrompt.hs 209 - hunk ./XPrompt.hs 215 -keyPressHandle mask (ks,s) +keyPressHandle mask _ hunk ./XPrompt.hs 221 --- exit +-- Return: exit hunk ./XPrompt.hs 229 - updateWindows - eventLoop handle + go hunk ./XPrompt.hs 233 - updateWindows - eventLoop handle + go hunk ./XPrompt.hs 237 - updateWindows - eventLoop handle + go hunk ./XPrompt.hs 241 - updateWindows - eventLoop handle + go hunk ./XPrompt.hs 245 - updateWindows - eventLoop handle + go hunk ./XPrompt.hs 249 - updateWindows - eventLoop handle --- exscape: exit and discard everything + go +-- escape: exit and discard everything hunk ./XPrompt.hs 254 + where + go = do + updateWindows + eventLoop handle hunk ./XPrompt.hs 322 - [] -> return () + [] -> destroyComplWin >> return () hunk ./MetaModule.hs 52 +-- XMonadContrib.ShellPrompt depends on readline +--import XMonadContrib.ShellPrompt () hunk ./MetaModule.hs 59 +import XMonadContrib.SshPrompt () hunk ./MetaModule.hs 65 +import XMonadContrib.XMonadPrompt () +import XMonadContrib.XPrompt () hunk ./FlexibleManipulate.hs 35 +-- hunk ./FlexibleManipulate.hs 40 --- indicate a combination scale/position. +-- indicate a combination scale\/position. hunk ./ShellPrompt.hs 20 -{- -usage: -1. In xmonad.cabal change: -build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0 -to -build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0, readline >= 1.0 - -2. In Config.hs add: -> import XMonadContrib.XPrompt -> import XMonadContrib.ShellPrompt - -3. In your keybindings add something like: - -> , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig) - --} hunk ./ShellPrompt.hs 29 +-- $usage +-- +-- 1. In xmonad.cabal change: +-- +-- > build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0 +-- +-- to +-- +-- > build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0, readline >= 1.0 +-- +-- 2. In Config.hs add: +-- +-- > import XMonadContrib.XPrompt +-- > import XMonadContrib.ShellPrompt +-- +-- 3. In your keybindings add something like: +-- +-- > , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig) +-- + hunk ./SshPrompt.hs 20 -{- -usage: -1. In Config.hs add: - -> import XMonadContrib.XPrompt -> import XMonadContrib.SshPrompt - -3. In your keybindings add something like: - -> , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultPromptConfig) - --} hunk ./SshPrompt.hs 28 +-- $usage +-- 1. In Config.hs add: +-- +-- > import XMonadContrib.XPrompt +-- > import XMonadContrib.SshPrompt +-- +-- 3. In your keybindings add something like: +-- +-- > , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) +-- + hunk ./SwitchTrans.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} hunk ./SwitchTrans.hs 12 ------------------------------------------------------------------------------ - -{-# OPTIONS_GHC -fglasgow-exts #-} - --- | Ordinary layout transformers are simple and easy to use but inflexible. +-- +-- Ordinary layout transformers are simple and easy to use but inflexible. hunk ./SwitchTrans.hs 34 --- (The noBorders transformer is from @XMonadContrib.NoBorders@.) +-- (The noBorders transformer is from 'XMonadContrib.NoBorders'.) hunk ./SwitchTrans.hs 55 --- is that I use @mod-f@ to "zoom in" on interesting windows, no matter what other +-- is that I use @mod-f@ to \"zoom in\" on interesting windows, no matter what other hunk ./SwitchTrans.hs 57 --- everything else means I can zoom in and out without implicitly undoing "normal" +-- everything else means I can zoom in and out without implicitly undoing \"normal\" hunk ./SwitchTrans.hs 60 +----------------------------------------------------------------------------- + hunk ./XMonadPrompt.hs 20 -{- -usage: -in Config.hs add: -> import XMonadContrib.XPrompt -> import XMonadContrib.XMonadPrompt - -in you keybindings add: - -> , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultPromptConfig) - --} hunk ./XMonadPrompt.hs 23 -import XMonadContrib.Commands +import XMonadContrib.Commands (defaultCommands, runCommand') + +-- $usage +-- +-- in Config.hs add: +-- +-- > import XMonadContrib.XPrompt +-- > import XMonadContrib.XMonadPrompt +-- +-- in you keybindings add: +-- +-- > , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) +-- hunk ./XPrompt.hs 45 --- $usage: +-- $usage hunk ./XPrompt.hs 47 --- For example usage see XMonadContrib.ShellPrompt or --- XMonadContrib.XMonadPrompt - --- TODO --- scrolling the completions that don't fit in the window --- commands to edit the command line +-- For example usage see 'XMonadContrib.ShellPrompt', +-- 'XMonadContrib.XMonadPrompt' or 'XMonadContrib.SshPrompt' +-- +-- TODO: +-- +-- * scrolling the completions that don't fit in the window (?) +-- +-- * commands to edit the command line hunk ./XPrompt.hs 85 - , historySize :: Int + , historySize :: Int -- ^ The number of history entries to be saved hunk ./XPrompt.hs 588 - -- we strat with the border + -- we start with the border hunk ./XPrompt.hs 591 - -- this foreground is the background of the text + -- here foreground means the background of the text addfile ./Roledex.hs hunk ./Roledex.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Roledex +-- Copyright : (c) tim.thelion@gmail.com +-- License : BSD Because this is dirived from Accordian which is licenced that way. +-- The maintainer of Accordian is glasser@mit.edu +-- +-- Maintainer : tim.thelion@gmail.com +-- Stability : unstable +-- Portability : unportable +-- +-- Screenshot : www.timthelion.com/rolodex.png +-- This is a compleatly pointless layout which acts like Microsoft's Flip 3D +----------------------------------------------------------------------------- + +module XMonadContrib.Roledex ( + -- * Usage + -- $usage + roledex) where + +import XMonad +import Operations +import qualified StackSet as W +import Graphics.X11.Xlib +import Data.Ratio +import XMonadContrib.LayoutHelpers ( idModify ) + +-- $usage +-- > import XMonadContrib.Roledex +-- > defaultLayouts = [ roledex ] + +roledex :: Eq a => Layout a +roledex = Layout { doLayout = roledexLayout, modifyLayout = idModify } + +roledexLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Layout a)) +roledexLayout sc ws = return ([(W.focus ws, mainPane)] ++ + (zip ups tops) ++ + (reverse (zip dns bottoms)) + ,Nothing) + where ups = W.up ws + dns = W.down ws + c = length ups + length dns + rect = fst $ splitHorizontallyBy (2% 3) $ fst (splitVerticallyBy (2% 3) sc) + gw = div' (w - rw) (fromIntegral c) + where + (Rectangle _ _ w _) = sc + (Rectangle _ _ rw _) = rect + gh = div' (h - rh) (fromIntegral c) + where + (Rectangle _ _ _ h) = sc + (Rectangle _ _ _ rh) = rect + mainPane = mrect (gw * fromIntegral c) (gh * fromIntegral c) rect + mrect mx my (Rectangle x y w h) = Rectangle (x + (fromIntegral mx)) (y + (fromIntegral my)) w h + tops = map f $ cd c (length dns) + bottoms = map f $ [0..(length dns)] + f n = mrect (gw * (fromIntegral n)) (gh * (fromIntegral n)) rect + cd n m = if n > m + then (n - 1) : (cd (n-1) m) + else [] + +div' _ 0 = 0 +div' n o = div n o hunk ./DynamicLog.hs 22 - -- * Usage - -- $usage - dynamicLog, dynamicLogXinerama, pprWindowSet, pprWindowSetXinerama - ) where + -- * Usage + -- $usage + dynamicLog, dynamicLogXinerama, pprWindowSet, pprWindowSetXinerama + ) where hunk ./XPrompt.hs 20 - , defaultPromptConfig hunk ./XPrompt.hs 102 -defaultPromptConfig :: XPConfig -defaultPromptConfig = defaultXPConfig - hunk ./XPrompt.hs 42 -import System.Posix.Files (fileExist) +import System.Posix.Files hunk ./XPrompt.hs 134 - h <- liftIO $ readHistory - let st = initState d rw w s compl gc fontS (XPT t) h conf + (hist,h) <- liftIO $ readHistory + let st = initState d rw w s compl gc fontS (XPT t) hist conf hunk ./XPrompt.hs 140 - when (command st' /= "") $ action (command st') + liftIO $ hClose h + when (command st' /= "") $ do + let htw = take (historySize conf) (history st') + liftIO $ writeHistory h htw + action (command st') hunk ./XPrompt.hs 226 - writeHistory hunk ./XPrompt.hs 534 - when (c /= []) $ modify (\s -> s { history = H (showXPrompt (xptype s)) c : history s }) + when (c /= []) $ modify (\s -> s { history = nub $ H (showXPrompt (xptype s)) c : history s }) hunk ./XPrompt.hs 542 -readHistory :: IO [History] +readHistory :: IO ([History],Handle) hunk ./XPrompt.hs 547 - -- from http://users.aber.ac.uk/afc/stricthaskell.html#semiclosed - let hGetContentsStrict h = do - b <- hIsEOF h - if b then return [] else - do c <- hGetChar h - r <- hGetContentsStrict h - return (c:r) - do_read = do ha <- openFile path ReadMode - hSetBuffering ha NoBuffering - s <- hGetContentsStrict ha - hClose ha - return s - if f then do str <- catch (do_read) (\_ -> do putStrLn "error in reading"; return []) + if f then do h <- openFile path ReadMode + str <- hGetContents h hunk ./XPrompt.hs 550 - [(hist,_)] -> return hist - [] -> return [] - _ -> return [] - else return [] + [(hist,_)] -> return (hist,h) + [] -> return ([],h) + _ -> return ([],h) + else do touchFile path + h <- openFile path ReadMode + return ([],h) hunk ./XPrompt.hs 557 -writeHistory :: XP () -writeHistory = do - h <- gets history - c <- gets config - home <- io $ getEnv "HOME" +writeHistory :: Handle -> [History] -> IO () +writeHistory h hist = do + home <- getEnv "HOME" hunk ./XPrompt.hs 561 - htw = take (historySize c) . nub $ h - io $ catch (writeFile path (show htw)) (\_ -> do putStrLn "error in writing"; return ()) + catch (writeFile path (show hist)) (\_ -> do putStrLn "error in writing"; return ()) hunk ./MetaModule.hs 50 +import XMonadContrib.Roledex () hunk ./Magnifier.hs 24 -import Graphics.X11.Xlib +import Graphics.X11.Xlib (Window, Rectangle(..)) hunk ./Magnifier.hs 34 -magnifier :: Eq a => Layout a -> Layout a +magnifier :: Layout Window -> Layout Window hunk ./Magnifier.hs 38 -magnifier' :: Eq a => Layout a -> Layout a +magnifier' :: Layout Window -> Layout Window hunk ./Magnifier.hs 41 -unlessMaster :: ModDo a -> ModDo a +unlessMaster :: ModDo Window -> ModDo Window hunk ./Magnifier.hs 45 -applyMagnifier :: Eq a => ModDo a -applyMagnifier r s wrs = return (reverse $ foldr mag [] wrs, Nothing) - where mag (w,wr) ws | w == focus s = ws ++ [(w, shrink r $ magnify wr)] - | otherwise = (w,wr) : ws +applyMagnifier :: ModDo Window +applyMagnifier r _ wrs = do focused <- withWindowSet (return . peek) + let mag (w,wr) ws | focused == Just w = ws ++ [(w, shrink r $ magnify wr)] + | otherwise = (w,wr) : ws + return (reverse $ foldr mag [] wrs, Nothing) hunk ./XPrompt.hs 399 - io $ (completionFunction s) (command s) + io $ (completionFunction s) (getLastWord $ command s) hunk ./XPrompt.hs 558 -writeHistory h hist = do +writeHistory _ hist = do hunk ./LayoutScreens.hs 28 - hunk ./LayoutScreens.hs 35 - +-- hunk ./XPrompt.hs 553 - else do touchFile path - h <- openFile path ReadMode + else do h <- openFile path WriteMode addfile ./RunInXTerm.hs hunk ./RunInXTerm.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.RunInXTerm +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A simple module to launch commands in an X terminal +-- from XMonad +-- +----------------------------------------------------------------------------- + +module XMonadContrib.RunInXTerm ( + -- * Usage + -- $usage + runInXTerm + ) where + +import XMonad +import System.Environment + +-- $usage +-- For an example usage see SshPrompt + +runInXTerm :: String -> X () +runInXTerm com = do + c <- io $ catch (getEnv "XTERMCMD") (const $ return "xterm") + spawn ("exec " ++ c ++ " -e " ++ com) hunk ./SshPrompt.hs 23 +import XMonadContrib.RunInXTerm hunk ./SshPrompt.hs 51 -ssh s = spawn $ "exec xterm -e ssh " ++ s +ssh s = runInXTerm ("ssh " ++ s) hunk ./CopyWindow.hs 50 -copy' :: (Ord a, Eq s, Integral i) => i -> StackSet i a s sd -> StackSet i a s sd +copy' :: (Ord a, Eq s, Eq i) => i -> StackSet i a s sd -> StackSet i a s sd addfile ./ViewPrev.hs hunk ./ViewPrev.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.ViewPrev +-- Copyright : (c) Nelson Elhage +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Nelson Elhage +-- Stability : unstable +-- Portability : unportable +-- +-- A module that implements a command to switch to the previously +-- viewed workspace +-- +----------------------------------------------------------------------------- + +module XMonadContrib.ViewPrev ( + viewPrev + ) where + +import XMonad +import Operations +import qualified StackSet as W + +viewPrev' :: (Eq a, Eq s, Eq i) => W.StackSet i a s sd -> W.StackSet i a s sd +viewPrev' x = W.view (W.tag . head . W.hidden $ x) x + +viewPrev :: X () +viewPrev = windows viewPrev' hunk ./MetaModule.hs 66 +import XMonadContrib.ViewPrev () hunk ./XPrompt.hs 133 - fontS <- liftIO $ loadQueryFont d (font conf) + fontS <- liftIO (loadQueryFont d (font conf) `catch` + \_ -> loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*") hunk ./XPrompt.hs 383 - y = fi $ (ht + fi (asc + desc)) `div` 2 + y = fi $ ((ht - fi (asc + desc)) `div` 2) + fi asc hunk ./XPrompt.hs 105 - , bgColor = "#666666" + , bgColor = "#333333" hunk ./XPrompt.hs 108 - , bgHLight = "#999999" + , bgHLight = "#BBBBBB" hunk ./XPrompt.hs 135 + liftIO $ setFont d gc $ fontFromFontStruct fontS hunk ./Decoration.hs 69 - font <- io $ loadQueryFont d fontname + font <- io $ catch (loadQueryFont d fontname) + (const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*") hunk ./XPrompt.hs 169 - nextEvent d e + maskEvent d keyPressMask e hunk ./GreedyView.hs 1 -{-# OPTIONS -fglasgow-exts #-} ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.GreedyView --- Copyright : (c) Spencer Janssen --- License : BSD3-style (see LICENSE) --- --- Maintainer : Spencer Janssen --- Stability : unstable --- Portability : unportable --- --- GreedyView is an alternative to standard workspace switching. When a --- workspace is already visible on another screen, GreedyView swaps the --- contents of that other screen with the current screen. --- ------------------------------------------------------------------------------ - -module XMonadContrib.GreedyView ( - -- * Usage - -- $usage - greedyView - ) where - -import StackSet as W hiding (filter) -import XMonad -import Operations -import Data.List (find) - --- $usage --- To use GreedyView as your default workspace switcher --- --- Add this import: --- --- > import XMonadContrib.GreedyView --- --- And replace the function call used to switch workspaces, --- --- this: --- --- > [((m .|. modMask, k), f i) --- > | (i, k) <- zip [0 .. fromIntegral workspaces - 1] [xK_1 ..] --- > , (f, m) <- [(view, 0), (shift, shiftMask)]] --- --- becomes this : --- --- > [((m .|. modMask, k), f i) --- > | (i, k) <- zip [0 .. fromIntegral workspaces - 1] [xK_1 ..] --- > , (f, m) <- [(greedyView, 0), (shift, shiftMask)]] --- - -greedyView :: WorkspaceId -> X () -greedyView = windows . greedyView' - -greedyView' :: WorkspaceId -> WindowSet -> WindowSet -greedyView' w ws - | any wTag (hidden ws) = W.view w ws - | (Just s) <- find (wTag . workspace) (visible ws) = ws { current = (current ws) { workspace = workspace s } - , visible = s { workspace = workspace (current ws) } - : filter (not . wTag . workspace) (visible ws) - } - | otherwise = ws - where - wTag = (w == ) . tag rmfile ./GreedyView.hs hunk ./MetaModule.hs 39 -import XMonadContrib.GreedyView () hunk ./Spiral.hs 72 - resize Expand = spiral $ (21 % 20) * scale - resize Shrink = spiral $ (20 % 21) * scale + resize Expand = spiralWithDir dir rot $ (21 % 20) * scale + resize Shrink = spiralWithDir dir rot $ (20 % 21) * scale hunk ./FlexibleResize.hs 48 - mouseDrag $ \(_, _, _, ex, ey, _, _, _, _, _) -> do - wa' <- getWindowAttributes d w - let [px, py] = map (fromIntegral . ($ wa')) [wa_x, wa_y] - moveResizeWindow d w (fromIntegral $ fx px ex) (fromIntegral $ fy py ey) - `uncurry` applySizeHints sh (gx ex, gy ey) - float w + mouseDrag (\ex ey -> do + wa' <- io $ getWindowAttributes d w + let [px, py] = map (fromIntegral . ($ wa')) [wa_x, wa_y] + io $ moveResizeWindow d w (fromIntegral $ fx px (fromIntegral ex)) + (fromIntegral $ fy py (fromIntegral ey)) + `uncurry` applySizeHints sh (gx $ fromIntegral ex, gy $ fromIntegral ey)) + (float w) hunk ./FlexibleManipulate.hs 74 - mouseDrag $ \(_, _, _, _, _, ex, ey, _, _, _) -> do + mouseDrag (\ex ey -> io $ do hunk ./FlexibleManipulate.hs 81 + return ()) + (float w) hunk ./Commands.hs 62 - | i <- [0 .. workspaces - 1] + | i <- workspaces addfile ./DynamicWorkspaces.hs hunk ./DynamicWorkspaces.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.DynamicWorkspaces +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- Provides bindings to add and delete workspaces. Note that you may only +-- delete a workspace that is already empty. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.DynamicWorkspaces ( + -- * Usage + -- $usage + addWorkspace, removeWorkspace + ) where + +import XMonad ( X ) +import Operations ( windows ) +import StackSet ( tagMember, StackSet(..), Screen(..), Workspace(..) ) + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.DynamicWorkspaces +-- +-- > , ((modMask .|. shiftMask, xK_Up), addWorkspace) +-- > , ((modMask .|. shiftMask, xK_Down), removeWorkspace) + +addWorkspace :: X () +addWorkspace = windows addWorkspace' + +removeWorkspace :: X () +removeWorkspace = windows removeWorkspace' + +addWorkspace' :: (Enum i, Num i) => StackSet i a sid sd -> StackSet i a sid sd +addWorkspace' s@(StackSet { current = scr@(Screen { workspace = w }) + , hidden = ws }) + = s { current = scr { workspace = Workspace newtag Nothing } + , hidden = w:ws } + where (newtag:_) = filter (not . (`tagMember` s)) [0..] + +removeWorkspace' :: StackSet i a sid sd -> StackSet i a sid sd +removeWorkspace' s@(StackSet { current = scr@(Screen { workspace = Workspace { stack = Nothing } }) + , hidden = (w:ws) }) + = s { current = scr { workspace = w } + , hidden = ws } +removeWorkspace' s = s hunk ./MetaModule.hs 34 +import XMonadContrib.DynamicWorkspaces () hunk ./DynamicWorkspaces.hs 22 -import XMonad ( X ) +import Control.Monad.State ( get, gets, modify ) + +import XMonad ( X, XState(..), Layout, trace ) hunk ./DynamicWorkspaces.hs 26 -import StackSet ( tagMember, StackSet(..), Screen(..), Workspace(..) ) +import StackSet ( tagMember, StackSet(..), Screen(..), Workspace(..), + integrate, differentiate ) +import Data.Map ( delete, insert ) +import Graphics.X11.Xlib ( Window ) hunk ./DynamicWorkspaces.hs 36 --- > , ((modMask .|. shiftMask, xK_Up), addWorkspace) +-- > , ((modMask .|. shiftMask, xK_Up), addWorkspace defaultLayouts) hunk ./DynamicWorkspaces.hs 39 -addWorkspace :: X () -addWorkspace = windows addWorkspace' +addWorkspace :: [Layout Window] -> X () +addWorkspace (l:ls) = do s <- gets windowset + let newtag:_ = filter (not . (`tagMember` s)) [0..] + modify $ \st -> st { layouts = insert newtag (l,ls) $ layouts st } + windows (addWorkspace' newtag) +addWorkspace [] = trace "bad layouts in XMonadContrib.DynamicWorkspaces.addWorkspace\n" hunk ./DynamicWorkspaces.hs 47 -removeWorkspace = windows removeWorkspace' +removeWorkspace = do XState { windowset = s, layouts = fls } <- get + let w = tag $ workspace $ current s + modify $ \st -> st { layouts = delete w fls } + windows removeWorkspace' hunk ./DynamicWorkspaces.hs 52 -addWorkspace' :: (Enum i, Num i) => StackSet i a sid sd -> StackSet i a sid sd -addWorkspace' s@(StackSet { current = scr@(Screen { workspace = w }) - , hidden = ws }) +addWorkspace' :: i -> StackSet i a sid sd -> StackSet i a sid sd +addWorkspace' newtag s@(StackSet { current = scr@(Screen { workspace = w }) + , hidden = ws }) hunk ./DynamicWorkspaces.hs 57 - where (newtag:_) = filter (not . (`tagMember` s)) [0..] hunk ./DynamicWorkspaces.hs 59 -removeWorkspace' s@(StackSet { current = scr@(Screen { workspace = Workspace { stack = Nothing } }) +removeWorkspace' s@(StackSet { current = scr@(Screen { workspace = Workspace { stack = st } }) hunk ./DynamicWorkspaces.hs 61 - = s { current = scr { workspace = w } - , hidden = ws } + = s { current = scr { workspace = w { stack = meld st (stack w) } } + , hidden = ws } + where meld Nothing Nothing = Nothing + meld x Nothing = x + meld Nothing x = x + meld (Just x) (Just y) = differentiate (integrate x ++ integrate y) hunk ./DynamicWorkspaces.hs 22 -import Control.Monad.State ( get, gets, modify ) +import Control.Monad.State ( gets, modify ) hunk ./DynamicWorkspaces.hs 25 -import Operations ( windows ) +import Operations ( windows, view ) hunk ./DynamicWorkspaces.hs 47 -removeWorkspace = do XState { windowset = s, layouts = fls } <- get - let w = tag $ workspace $ current s - modify $ \st -> st { layouts = delete w fls } - windows removeWorkspace' +removeWorkspace = do s <- gets windowset + case s of + StackSet { current = Screen { workspace = torem } + , hidden = (w:_) } + -> do view $ tag w + modify $ \st -> st { layouts = delete (tag torem) $ layouts st } + windows (removeWorkspace' (tag torem)) + _ -> return () hunk ./DynamicWorkspaces.hs 62 -removeWorkspace' :: StackSet i a sid sd -> StackSet i a sid sd -removeWorkspace' s@(StackSet { current = scr@(Screen { workspace = Workspace { stack = st } }) - , hidden = (w:ws) }) - = s { current = scr { workspace = w { stack = meld st (stack w) } } - , hidden = ws } +removeWorkspace' :: (Eq i) => i -> StackSet i a sid sd -> StackSet i a sid sd +removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc }) + , hidden = (w:ws) }) + | tag w == torem = s { current = scr { workspace = wc { stack = meld (stack w) (stack wc) } } + , hidden = ws } hunk ./DynamicWorkspaces.hs 71 -removeWorkspace' s = s +removeWorkspace' _ s = s addfile ./DirectoryPrompt.hs hunk ./DirectoryPrompt.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.DirectoryPrompt +-- Copyright : (C) 2007 Andrea Rossato, David Roundy +-- License : BSD3 +-- +-- Maintainer : droundy@darcs.net +-- Stability : unstable +-- Portability : unportable +-- +-- A directory prompt for XMonad +-- +----------------------------------------------------------------------------- + +module XMonadContrib.DirectoryPrompt ( + -- * Usage + -- $usage + directoryPrompt + ) where + +import XMonad +import XMonadContrib.XPrompt +import XMonadContrib.Dmenu ( runProcessWithInput ) + +-- $usage +-- +-- 1. In xmonad.cabal change: +-- +-- > build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0 +-- +-- to +-- +-- > build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0, readline >= 1.0 +-- +-- 2. In Config.hs add: +-- +-- > import XMonadContrib.XPrompt +-- > import XMonadContrib.ShellPrompt +-- +-- 3. In your keybindings add something like: +-- +-- > , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig) +-- + +data Dir = Dir String + +instance XPrompt Dir where + showXPrompt (Dir x) = x + +directoryPrompt :: XPConfig -> String -> (String -> X ()) -> X () +directoryPrompt c prom job = mkXPrompt (Dir prom) c getDirCompl job + +getDirCompl :: String -> IO [String] +getDirCompl s = (filter notboring . lines) `fmap` + runProcessWithInput "/bin/bash" [] ("compgen -A directory " ++ s ++ "\n") + +notboring ('.':'.':_) = True +notboring ('.':_) = False +notboring _ = True hunk ./MetaModule.hs 31 +import XMonadContrib.DirectoryPrompt () hunk ./WorkspaceDir.hs 28 -import System.Directory ( setCurrentDirectory, getCurrentDirectory ) -import Data.List ( nub ) +import System.Directory ( setCurrentDirectory ) hunk ./WorkspaceDir.hs 32 -import XMonadContrib.Dmenu ( dmenu, runProcessWithInput ) +import XMonadContrib.Dmenu ( runProcessWithInput ) +import XMonadContrib.XPrompt ( XPConfig ) +import XMonadContrib.DirectoryPrompt ( directoryPrompt ) hunk ./WorkspaceDir.hs 36 +import XMonadContrib.XPrompt ( defaultXPConfig ) hunk ./WorkspaceDir.hs 47 --- > , ((modMask .|. shiftMask, xK_x ), changeDir ["~","/tmp"]) +-- > , ((modMask .|. shiftMask, xK_x ), changeDir defaultXPConfig) hunk ./WorkspaceDir.hs 63 -changeDir :: [String] -> X () -changeDir dirs = do thisd <- io getCurrentDirectory - dir <- dmenu (nub (thisd:dirs)) - sendMessage (Chdir dir) +changeDir :: XPConfig -> X () +changeDir c = directoryPrompt c "Set working directory: " (sendMessage . Chdir) hunk ./FlexibleResize.hs 51 - io $ moveResizeWindow d w (fromIntegral $ fx px (fromIntegral ex)) - (fromIntegral $ fy py (fromIntegral ey)) + io $ moveResizeWindow d w (fx px (fromIntegral ex)) + (fy py (fromIntegral ey)) hunk ./XPrompt.hs 169 - maskEvent d keyPressMask e + maskEvent d (exposureMask .|. keyPressMask) e hunk ./XPrompt.hs 171 - (ks,s) <- lookupString $ asKeyEvent e + (ks,s) <- if ev_event_type ev == keyPress + then lookupString $ asKeyEvent e + else return (Nothing, "") hunk ./XPrompt.hs 621 -getLastWord [] = [] -getLastWord c = last . words $ c +getLastWord c + | c == [] || filter (/=' ') c == [] = [] + | otherwise = last . words $ c hunk ./XPrompt.hs 26 + , mkUnmanagedWindow + , getLastWord + , skipLastWord + , splitInSubListsAt + , newIndex + , newCommand + hunk ./XPrompt.hs 206 - l -> let new_index = case elemIndex (getLastWord (command st)) l of - Just i -> if i >= (length l - 1) then 0 else i + 1 - Nothing -> 0 - new_command = skipLastWord (command st) ++ fill ++ l !! new_index - fill = if ' ' `elem` (command st) then " " else "" - in do modify $ \s -> s { command = new_command, offset = length new_command } - redrawWindows c - eventLoop (completionHandle c) + l -> do let new_command = newCommand (command st) l + modify $ \s -> s { command = new_command, offset = length new_command } + redrawWindows c + eventLoop (completionHandle c) hunk ./XPrompt.hs 218 +newIndex :: String -> [String] -> Int +newIndex com cl = + case elemIndex (getLastWord com) cl of + Just i -> if i >= length cl - 1 then 0 else i + 1 + Nothing -> 0 + +newCommand :: String -> [String] -> String +newCommand com cl = + skipLastWord com ++ (cl !! (newIndex com cl)) + hunk ./XPrompt.hs 619 - hunk ./XPrompt.hs 633 -getLastWord c - | c == [] || filter (/=' ') c == [] = [] - | otherwise = last . words $ c +getLastWord str = + reverse . fst . break isSpace . reverse $ str hunk ./XPrompt.hs 637 -skipLastWord [] = [] -skipLastWord c = unwords . init . words $ c +skipLastWord str = + reverse . snd . break isSpace . reverse $ str adddir ./tests addfile ./tests/test_XPrompt.hs hunk ./tests/test_XPrompt.hs 1 +{-# OPTIONS -fglasgow-exts #-} +------------------------------------- +-- +-- Tests for XPrompt and ShellPrompt +-- +------------------------------------- + +import Data.Char +import Test.QuickCheck + +import Data.List + +import XMonadContrib.XPrompt +import qualified XMonadContrib.ShellPrompt as S + +instance Arbitrary Char where + arbitrary = choose ('\32', '\255') + coarbitrary c = variant (ord c `rem` 4) + + +doubleCheck p = check (defaultConfig { configMaxTest = 1000}) p +deepCheck p = check (defaultConfig { configMaxTest = 10000}) p +deepestCheck p = check (defaultConfig { configMaxTest = 100000}) p + +-- brute force check for exceptions +prop_split (str :: [Char]) = + forAll (elements str) $ \e -> S.split e str == S.split e str + +-- check for exceptions +prop_rmPath (str :: [[Char]]) = + S.rmPath str == S.rmPath str + +-- check if the first element of the new list is indeed the first part +-- of the string. +prop_spliInSubListsAt (x :: Int) (str :: [Char]) = + x < length str ==> result == take x str + where result = case splitInSubListsAt x str of + [] -> [] + x -> head x + +-- skipLastWord is complementary to getLastWord, unless the only space +-- in the string is the final character, in which case skipLastWord +-- and getLastWord will produce the same result. +prop_skipGetLastWord (str :: [Char]) = + skipLastWord str ++ getLastWord str == str || skipLastWord str == getLastWord str + +-- newIndex and newCommand get only non empy lists +elemGen :: Gen ([String],String) +elemGen = do + a <- arbitrary :: Gen [[Char]] + let l = case filter (/= []) a of + [] -> ["a"] + x -> x + e <- elements l + return (l,e) + +-- newIndex calculates the index of the next completion in the +-- completion list, so the index must be within the range of the +-- copletions list +prop_newIndex_range = + forAll elemGen $ \(l,c) -> newIndex c l >= 0 && newIndex c l < length l + +-- this is actually the definition of newCommand... +-- just to check something. +prop_newCommandIndex = + forAll elemGen $ \(l,c) -> (skipLastWord c ++ (l !! (newIndex c l))) == newCommand c l + +main = do + putStrLn "Testing ShellPrompt.split" + deepCheck prop_split + putStrLn "Testing ShellPrompt.rmPath" + doubleCheck prop_rmPath + putStrLn "Testing spliInSubListsAt" + deepCheck prop_spliInSubListsAt + putStrLn "Testing newIndex + newCommand" + deepCheck prop_newCommandIndex + putStrLn "Testing skip + get lastWord" + deepCheck prop_skipGetLastWord + putStrLn "Testing range of XPrompt.newIndex" + deepCheck prop_newIndex_range + hunk ./ShellPrompt.hs 19 + , rmPath + , split hunk ./ShellPrompt.hs 78 - rmPath [] = [] - rmPath s = map (last . split '/') s + +rmPath :: [String] -> [String] +rmPath s = + map (reverse . fst . break (=='/') . reverse) s hunk ./XPrompt.hs 26 + -- * Utilities hunk ./XPrompt.hs 54 --- For example usage see 'XMonadContrib.ShellPrompt', --- 'XMonadContrib.XMonadPrompt' or 'XMonadContrib.SshPrompt' +-- For usage examples see 'ShellPrompt', +-- 'XMonadPrompt' or 'SshPrompt' hunk ./XPrompt.hs 103 +-- | The class prompt types must be an instance of. In order to +-- create a prompt you need to create a data type, without parameters, +-- and make it an instance of this class, by implementing a simple +-- method, 'showXPrompt', which will be used to print the string to be +-- displayed in the command line window. +-- +-- This is an example of a XPrompt instance definition: +-- +-- > instance XPrompt Shell where +-- > showXPrompt Shell = "Run: " hunk ./XPrompt.hs 141 +-- | Creates a prompt given: +-- +-- * a prompt type, instance of the 'XPrompt' class. +-- +-- * a prompt configuration ('defaultXPConfig' can be used as a +-- starting point) +-- +-- * a completion functions ('mkComplFunFromList' can be used to +-- create a completions function given a list of possible completions) +-- +-- * an action to be run: the action must take a string and return 'XMonad.X' () hunk ./XPrompt.hs 635 --- completions +-- | This function takes a list of possible completions and returns a +-- completions function to be used with 'mkXPrompt' hunk ./Circle.hs 21 +import Data.List hunk ./Circle.hs 24 -import StackSet (integrate, Stack(..)) +import StackSet (integrate, peek) hunk ./Circle.hs 33 -circle :: Layout a -circle = Layout { doLayout = \r s -> return (raise (length (up s)) . circleLayout r $ integrate s, Nothing), - modifyLayout = idModify } +circle :: Layout Window +circle = Layout { doLayout = \r s -> do { layout <- raiseFocus $ circleLayout r $ integrate s + ; return (layout, Nothing) } + , modifyLayout = idModify } hunk ./Circle.hs 44 -raise :: Int -> [a] -> [a] -raise n xs = xs !! n : take n xs ++ drop (n + 1) xs +raiseFocus :: [(Window, Rectangle)] -> X [(Window, Rectangle)] +raiseFocus xs = do focused <- withWindowSet (return . peek) + return $ case find ((== focused) . Just . fst) xs of + Just x -> x : delete x xs + Nothing -> xs hunk ./MagicFocus.hs 19 +import Graphics.X11.Xlib (Window) hunk ./MagicFocus.hs 27 -magicFocus :: Layout a -> Layout a -magicFocus l = l { doLayout = \s -> (doLayout l) s . swap +magicFocus :: Layout Window -> Layout Window +magicFocus l = l { doLayout = \r s -> withWindowSet (return . peek) >>= (doLayout l) r . swap s hunk ./MagicFocus.hs 31 -swap :: Stack a -> Stack a -swap (Stack f u d) = Stack f [] (reverse u ++ d) +swap :: (Eq a) => Stack a -> Maybe a -> Stack a +swap (Stack f u d) focused | Just f == focused = Stack f [] (reverse u ++ d) + | otherwise = Stack f u d hunk ./MetaModule.hs 24 --- commented because of conflicts with 6.6's instances import XMonadContrib.BackCompat () hunk ./DeManage.hs 19 +-- hunk ./DeManage.hs 21 +-- hunk ./DeManage.hs 23 +-- hunk ./DirectoryPrompt.hs 26 --- --- 1. In xmonad.cabal change: --- --- > build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0 --- --- to --- --- > build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0, readline >= 1.0 --- --- 2. In Config.hs add: --- --- > import XMonadContrib.XPrompt --- > import XMonadContrib.ShellPrompt --- --- 3. In your keybindings add something like: --- --- > , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig) --- +-- For an example usage see "XMonadContrib.WorkspaceDir" hunk ./LayoutHelpers.hs 11 --- Make layouts respect size hints. +-- A module for writing easy Layouts hunk ./LayoutHelpers.hs 15 - -- * usage + -- * Usage hunk ./Roledex.hs 5 --- License : BSD Because this is dirived from Accordian which is licenced that way. --- The maintainer of Accordian is glasser@mit.edu +-- License : BSD hunk ./Roledex.hs 11 --- Screenshot : www.timthelion.com/rolodex.png +-- Screenshot : +-- hunk ./Roledex.hs 29 +-- hunk ./RotSlaves.hs 31 --- , ((modMask .|. shiftMask, xK_Tab ), rotSlavesUp) +-- > , ((modMask .|. shiftMask, xK_Tab ), rotSlavesUp) hunk ./RotSlaves.hs 36 --- hunk ./RunInXTerm.hs 26 --- For an example usage see SshPrompt +-- For an example usage see "XMonadContrib.SshPrompt" hunk ./SwitchTrans.hs 34 --- (The noBorders transformer is from 'XMonadContrib.NoBorders'.) +-- (The noBorders transformer is from "XMonadContrib.NoBorders".) hunk ./XPrompt.hs 26 - -- * Utilities + , ComplFunction + -- * X Utilities + -- $xutils hunk ./XPrompt.hs 30 + , fillDrawable + , printString + -- * Other Utilities + -- $utils hunk ./XPrompt.hs 60 --- For usage examples see 'ShellPrompt', --- 'XMonadPrompt' or 'SshPrompt' +-- For usage examples see "XMonadContrib.ShellPrompt", +-- "XMonadContrib.XMonadPrompt" or "XMonadContrib.SshPrompt" hunk ./XPrompt.hs 154 --- * a completion functions ('mkComplFunFromList' can be used to +-- * a completion function ('mkComplFunFromList' can be used to hunk ./XPrompt.hs 246 +-- | Given a completion and a list of possible completions, returns the +-- index of the next completion in the list hunk ./XPrompt.hs 254 +-- | Given a completion and a list of possible completions, returns the +-- the next completion in the list hunk ./XPrompt.hs 611 --- More general X Stuff +-- $xutils hunk ./XPrompt.hs 613 +-- | Prints a string on a 'Drawable' hunk ./XPrompt.hs 621 +-- | Fills a 'Drawable' with a rectangle and a border hunk ./XPrompt.hs 645 --- Utilities +-- $utils hunk ./XPrompt.hs 658 --- shorthand +-- Shorthand for fromIntegral hunk ./XPrompt.hs 662 +-- | Given a maximum length, splits a list into sublists hunk ./XPrompt.hs 668 +-- | Gets the last word of a string or the whole string if formed by +-- only one word hunk ./XPrompt.hs 674 +-- | Skips the last word of the string, if the string is composed by +-- more then one word. Otherwise returns the string. hunk ./Mosaic.hs 48 --- > defaultLayouts :: [Layout] --- > defaultLayouts = [ mosaic 0.25 0.5 M.empty M.empty, full, +-- > defaultLayouts :: [Layout Window] +-- > defaultLayouts = [ mosaic 0.25 0.5 M.empty, full, hunk ./Mosaic.hs 49 --- > defaultLayouts = [ mosaic 0.25 0.5 M.empty, full, --- > tall defaultDelta (1%2), wide defaultDelta (1%2) ] +-- > defaultLayouts = [ mosaic 0.25 0.5 M.empty, full ] hunk ./Commands.hs 61 -workspaceCommands = [((m ++ show i), f (fromIntegral i)) +workspaceCommands = [((m ++ show i), f i) hunk ./Combo.hs 51 - do lrs <- fst `fmap` - runLayout super rinput (differentiate $ take (length origws) origls) - let lwrs [] _ = [] + do (lrs, msuper') <- runLayout super rinput (differentiate $ take (length origws) origls) + let super' = maybe super id msuper' + lwrs [] _ = [] hunk ./Combo.hs 61 - return (concat $ map fst out, Just $ combo super origls') + return (concat $ map fst out, Just $ combo super' origls') addfile ./DragPane.hs hunk ./DragPane.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.DragPane +-- Copyright : (c) Spencer Janssen +-- David Roundy , +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable + +-- Layouts that splits the screen either horizontally or vertically and +-- shows two windows. The first window is always the master window, and +-- the other is either the currently focused window or the second window in +-- layout order. + +----------------------------------------------------------------------------- + +module XMonadContrib.DragPane ( + -- * Usage + -- $usage + dragPane, dragUpDownPane + ) where + +import Control.Monad.Reader ( asks ) +import Graphics.X11.Xlib ( Rectangle( Rectangle ) ) +import XMonad +import XMonadContrib.Decoration ( newDecoration ) +import Operations ( Resize(..), splitHorizontallyBy, splitVerticallyBy, initColor, mouseDrag, sendMessage ) +import StackSet ( focus, up, down) + +-- $usage +-- +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.DragPane +-- +-- and add, to the list of layouts: +-- +-- > dragPane defaultDelta (1%2) + +halfHandleWidth :: Integral a => a +halfHandleWidth = 2 + +handleColor :: String +handleColor = "#000000" + +dragPane :: String -> Double -> Double -> Layout a +dragPane ident delta split = Layout { doLayout = dolay, modifyLayout = return . message } + where + dolay r s = do handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor + root <- asks theRoot + let (left', right') = splitHorizontallyBy split r + leftmost = fromIntegral $ case r of Rectangle x _ _ _ -> x + widt = fromIntegral $ case r of Rectangle _ _ w _ -> w + left = case left' of Rectangle x y w h -> Rectangle x y (w-halfHandleWidth) h + right = case right' of + Rectangle x y w h -> Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h + handr = case left' of + Rectangle x y w h -> + Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h + wrs = case reverse (up s) of + (master:_) -> [(master,left),(focus s,right)] + [] -> case down s of + (next:_) -> [(focus s,left),(next,right)] + [] -> [(focus s, r)] + handle = newDecoration root handr 0 handlec handlec + "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + (const $ const $ const $ const $ return ()) (doclick) + doclick = mouseDrag (\ex _ -> + sendMessage (SetFrac ident ((fromIntegral ex - leftmost)/widt))) + (return ()) + + l' <- handle (dragPane ident delta split) + return (wrs, Just l') + message x | Just Shrink <- fromMessage x = Just (dragPane ident delta (split - delta)) + | Just Expand <- fromMessage x = Just (dragPane ident delta (split + delta)) + | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = + Just (dragPane ident delta frac) + message _ = Nothing + +dragUpDownPane :: String -> Double -> Double -> Layout a +dragUpDownPane ident delta split = Layout { doLayout = dolay, modifyLayout = return . message } + where + dolay r s = do handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor + root <- asks theRoot + let (left', right') = splitVerticallyBy split r + leftmost = fromIntegral $ case r of Rectangle _ x _ _ -> x + widt = fromIntegral $ case r of Rectangle _ _ _ w -> w + left = case left' of Rectangle x y w h -> Rectangle x y w (h-halfHandleWidth) + right = case right' of + Rectangle x y w h -> Rectangle x (y+halfHandleWidth) w (h-halfHandleWidth) + handr = case left' of + Rectangle x y w h -> + Rectangle x (y + fromIntegral h - halfHandleWidth) w (2*halfHandleWidth) + wrs = case reverse (up s) of + (master:_) -> [(master,left),(focus s,right)] + [] -> case down s of + (next:_) -> [(focus s,left),(next,right)] + [] -> [(focus s, r)] + handle = newDecoration root handr 0 handlec handlec + "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + (const $ const $ const $ const $ return ()) (doclick) + doclick = mouseDrag (\_ ey -> + sendMessage (SetFrac ident ((fromIntegral ey - leftmost)/widt))) + (return ()) + + l' <- handle (dragUpDownPane ident delta split) + return (wrs, Just l') + message x | Just Shrink <- fromMessage x = Just (dragUpDownPane ident delta (split - delta)) + | Just Expand <- fromMessage x = Just (dragUpDownPane ident delta (split + delta)) + | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = + Just (dragUpDownPane ident delta frac) + message _ = Nothing + +data SetFrac = SetFrac String Double deriving ( Show, Read, Eq, Typeable ) +instance Message SetFrac hunk ./MetaModule.hs 32 +import XMonadContrib.DragPane () hunk ./CopyWindow.hs 38 --- > | (i, k) <- zip [0..fromIntegral (workspaces-1)] [xK_1 ..] +-- > | (i, k) <- zip workspaces [xK_1 ..] hunk ./DragPane.hs 74 - l' <- handle (dragPane ident delta split) - return (wrs, Just l') + ml' <- if length wrs > 1 then Just `fmap` handle (dragPane ident delta split) + else return Nothing + return (wrs, ml') hunk ./DragPane.hs 109 - l' <- handle (dragUpDownPane ident delta split) - return (wrs, Just l') + ml' <- if length wrs > 1 then Just `fmap` handle (dragUpDownPane ident delta split) + else return Nothing + return (wrs, ml') hunk ./XPrompt.hs 223 - when (win st == w) $ updateWindows >> eventLoop handle + when (win st == w) updateWindows + eventLoop handle hunk ./XPrompt.hs 72 - XPS { dpy :: Display - , rootw :: Window - , win :: Window - , screen :: Rectangle - , complWin :: Maybe Window - , complWinDim :: Maybe ComplWindowDim + XPS { dpy :: Display + , rootw :: Window + , win :: Window + , screen :: Rectangle + , complWin :: Maybe Window + , complWinDim :: Maybe ComplWindowDim hunk ./XPrompt.hs 79 - , gcon :: GC - , fs :: FontStruct - , xptype :: XPType - , command :: String - , offset :: Int - , history :: [History] - , config :: XPConfig + , gcon :: GC + , fs :: FontStruct + , xptype :: XPType + , command :: String + , offset :: Int + , history :: [History] + , config :: XPConfig hunk ./XPrompt.hs 128 - XPC { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , bgColor = "#333333" - , fgColor = "#FFFFFF" - , fgHLight = "#000000" - , bgHLight = "#BBBBBB" + XPC { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , bgColor = "#333333" + , fgColor = "#FFFFFF" + , fgHLight = "#000000" + , bgHLight = "#BBBBBB" hunk ./XPrompt.hs 135 - , position = Bottom - , height = 18 + , position = Bottom + , height = 18 hunk ./XPrompt.hs 180 - liftIO $ writeHistory h htw + liftIO $ writeHistory htw hunk ./XPrompt.hs 342 - | oo < length oc && d == Prev = take (oo - 1) f ++ ss - | oo < length oc && d == Next = f ++ tail ss + | oo < length oc && d == Prev = take (oo - 1) f ++ ss + | oo < length oc && d == Next = f ++ tail ss hunk ./XPrompt.hs 519 - border <- io $ initColor d (borderColor c) + border <- io $ initColor d (borderColor c) hunk ./XPrompt.hs 606 -writeHistory :: Handle -> [History] -> IO () -writeHistory _ hist = do +writeHistory :: [History] -> IO () +writeHistory hist = do hunk ./XPrompt.hs 268 - | mask == controlMask = do - -- TODO - eventLoop handle - + | mask == controlMask = eventLoop handle -- TODO hunk ./XPrompt.hs 271 - | ks == xK_Return = do - historyPush - return () + | ks == xK_Return = do historyPush + liftIO $ hPutStrLn stderr "Hello world" + return () hunk ./XPrompt.hs 275 - | ks == xK_BackSpace = do - deleteString Prev - go + | ks == xK_BackSpace = deleteString Prev >> go hunk ./XPrompt.hs 277 - | ks == xK_Delete = do - deleteString Next - go + | ks == xK_Delete = deleteString Next >> go hunk ./XPrompt.hs 279 - | ks == xK_Left = do - moveCursor Prev - go + | ks == xK_Left = moveCursor Prev >> go hunk ./XPrompt.hs 281 - | ks == xK_Right = do - moveCursor Next - go + | ks == xK_Right = moveCursor Next >> go hunk ./XPrompt.hs 283 - | ks == xK_Up = do - moveHistory Prev - go + | ks == xK_Up = moveHistory Prev >> go hunk ./XPrompt.hs 285 - | ks == xK_Down = do - moveHistory Next - go + | ks == xK_Down = moveHistory Next >> go hunk ./XPrompt.hs 287 - | ks == xK_Escape = do - flushString - return () - where - go = do - updateWindows - eventLoop handle - + | ks == xK_Escape = flushString >> return () + where go = updateWindows >> eventLoop handle hunk ./XPrompt.hs 292 - | otherwise = do - insertString s - updateWindows - eventLoop handle + | otherwise = do insertString s + updateWindows + eventLoop handle hunk ./XPrompt.hs 308 - c oc oo - | oo >= length oc = oc ++ str - | otherwise = f ++ str ++ ss - where (f,ss) = splitAt oo oc + c oc oo | oo >= length oc = oc ++ str + | otherwise = f ++ str ++ ss + where (f,ss) = splitAt oo oc hunk ./XPrompt.hs 272 - liftIO $ hPutStrLn stderr "Hello world" hunk ./XPrompt.hs 466 - columns = wh `div` (fi max_compl_len) + columns = max 1 $ wh `div` (fi max_compl_len) hunk ./DragPane.hs 40 --- > dragPane defaultDelta (1%2) +-- > dragPane "" (fromRational delta) (fromRational delta) hunk ./HintedTile.hs 32 --- > import XMonadContrib.HintedTile +-- > import qualified XMonadContrib.HintedTile +-- +-- > defaultLayouts = [ XMonadContrib.HintedTil.tall nmaster delta ratio, ... ] hunk ./HintedTile.hs 34 --- > defaultLayouts = [ XMonadContrib.HintedTil.tall nmaster delta ratio, ... ] +-- > defaultLayouts = [ XMonadContrib.HintedTile.tall nmaster delta ratio, ... ] hunk ./DragPane.hs 11 - +-- hunk ./scripts/xmonad-clock.c 33 -#define TIME_FORMAT2 "PDT %H.%M" +#define TIME_FORMAT2 "SYD %H.%M" hunk ./scripts/xmonad-clock.c 55 - setenv("TZ","America/Los_Angeles", 1); + setenv("TZ","Australia/Sydney", 1); hunk ./Accordion.hs 30 + +-- %import XMonadContrib.Accordion +-- %layout , accordion hunk ./Anneal.hs 19 + +-- %import XMonadContrib.Anneal hunk ./Circle.hs 32 + +-- %import XMonadContrib.Circle hunk ./Combo.hs 35 --- > simpleStacking $ combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText,1)] +-- > simpleStacking $ combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)] hunk ./Combo.hs 46 +-- %import XMonadContrib.Combo +-- %import XMonadContrib.SimpleStacking +-- %layout , simpleStacking $ combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)] + hunk ./Commands.hs 45 --- > , ((modMask .|. controlMask, xK_y), runCommand) +-- > , ((modMask .|. controlMask, xK_y), runCommand commands) hunk ./Commands.hs 57 +-- %def commands :: [(String, X ())] +-- %def commands = defaultCommands +-- %import XMonadContrib.Commands +-- %keybind , ((modMask .|. controlMask, xK_y), runCommand commands) + hunk ./CopyWindow.hs 45 + +-- %import XMonadContrib.CopyWindow +-- %keybind -- comment out default close window binding above if you uncomment this: +-- %keybind , ((modMask .|. shiftMask, xK_c ), kill1) -- @@ Close the focused window +-- %keybindlist ++ +-- %keybindlist -- mod-[1..9] @@ Switch to workspace N +-- %keybindlist -- mod-shift-[1..9] @@ Move client to workspace N +-- %keybindlist -- mod-control-shift-[1..9] @@ Copy client to workspace N +-- %keybindlist [((m .|. modMask, k), f i) +-- %keybindlist | (i, k) <- zip workspaces [xK_1 ..] +-- %keybindlist , (f, m) <- [(view, 0), (shift, shiftMask), (copy, shiftMask .|. controlMask)]] hunk ./DeManage.hs 50 + +-- %import XMonadContrib.DeManage +-- %keybind , ((modMask, xK_d ), withFocused demanage) hunk ./Dmenu.hs 32 + +-- %import XMonadContrib.Dmenu hunk ./DwmPromote.hs 38 + +-- %import XMonadContrib.DwmPromote +-- %keybind , ((modMask, xK_Return), dwmpromote) hunk ./DynamicLog.hs 42 + +-- %import XMonadContrib.DynamicLog +-- %def -- comment out default logHook definition above if you uncomment this: +-- %def logHook = dynamicLog hunk ./FindEmptyWorkspace.hs 43 + +-- %import XMonadContrib.FindEmptyWorkspace +-- %keybind , ((modMask, xK_m ), viewEmptyWorkspace) +-- %keybind , ((modMask .|. shiftMask, xK_m ), tagToEmptyWorkspace) hunk ./FlexibleManipulate.hs 50 + +-- %import qualified XMonadContrib.FlexibleManipulate as Flex +-- %mousebind , ((modMask, button1), (\\w -> focus w >> Flex.mouseWindow Flex.linear w)) hunk ./FlexibleResize.hs 34 + +-- %import qualified XMonadContrib.FlexibleResize as Flex +-- %mousebind , ((modMask, button3), (\\w -> focus w >> Flex.mouseResizeWindow w)) hunk ./FocusNth.hs 29 + +-- %import XMonadContrib.FocusNth +-- %keybdindextra ++ +-- %keybdindextra -- mod4-[1..9] @@ Switch to window N +-- %keybdindextra [((mod4Mask, k), focusNth i) +-- %keybdindextra | (i, k) <- zip [0 .. 8] [xK_1 ..]] hunk ./LayoutHints.hs 29 + +-- %import XMonadContrib.LayoutHints +-- %layout , layoutHints tiled +-- %layout , layoutHints $ mirror tiled hunk ./LayoutScreens.hs 42 + +-- %import XMonadContrib.LayoutScreens +-- %keybind , ((modMask .|. shiftMask, xK_space), layoutScreens 2 (twoPane 0.5 0.5)) +-- %keybind , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen) hunk ./MagicFocus.hs 26 + +-- %import XMonadContrib.MagicFocus +-- %layout , magicFocus tiled +-- %layout , magicFocus $ mirror tiled hunk ./Magnifier.hs 32 + +-- %import XMonadContrib.Magnifier +-- %layout , magnifier tiled +-- %layout , magnifier $ mirror tiled hunk ./Mosaic.hs 61 + +-- %import XMonadContrib.Mosaic +-- %keybind , ((controlMask .|. modMask .|. shiftMask, xK_h), withNamedWindow (sendMessage . tallWindow)) +-- %keybind , ((controlMask .|. modMask .|. shiftMask, xK_l), withNamedWindow (sendMessage . wideWindow)) +-- %keybind , ((modMask .|. shiftMask, xK_h ), withNamedWindow (sendMessage . shrinkWindow)) +-- %keybind , ((modMask .|. shiftMask, xK_l ), withNamedWindow (sendMessage . expandWindow)) +-- %keybind , ((modMask .|. shiftMask, xK_s ), withNamedWindow (sendMessage . squareWindow)) +-- %keybind , ((modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . myclearWindow)) +-- %keybind , ((controlMask .|. modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . flexibleWindow)) +-- %layout , mosaic 0.25 0.5 M.empty hunk ./NoBorders.hs 42 + +-- %import XMonadContrib.NoBorders +-- %layout -- prepend noBorders to default layouts above to remove their borders, like so: +-- %layout , noBorders full hunk ./Roledex.hs 32 + +-- %import XMonadContrib.Roledex +-- %layout , roledex hunk ./RotSlaves.hs 36 + +-- %import XMonadContrib.RotSlaves +-- %keybind , ((modMask .|. shiftMask, xK_Tab ), rotSlavesUp) hunk ./RotView.hs 37 + +-- %import XMonadContrib.RotView +-- %keybind , ((modMask .|. shiftMask, xK_Right), rotView True) +-- %keybind , ((modMask .|. shiftMask, xK_Left), rotView False) hunk ./ShellPrompt.hs 50 + +-- %cabalbuilddep readline>=1.0 +-- %import XMonadContrib.XPrompt +-- %import XMonadContrib.ShellPrompt +-- %keybind , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig) hunk ./SimpleDate.hs 34 + +-- %import XMonadContrib.SimpleDate +-- %keybind , ((modMask, xK_d ), date) hunk ./SinkAll.hs 27 + +-- %import XMonadContrib.SinkAll +-- %keybind , ((modMask .|. shiftMask, xK_t), sinkAll) hunk ./Spiral.hs 36 --- > defaultLayouts :: [Layout] --- > defaultLayouts = [ full, --- > tall defaultWindowsInMaster defaultDelta (1%2), --- > wide defaultWindowsInMaster defaultDelta (1%2), --- > spiral (1 % 1) ] +-- > defaultLayouts = [ full, spiral (1 % 1), ... ] + +-- %import XMonadContrib.Spiral +-- %layout , spiral (1 % 1) hunk ./Square.hs 40 + +-- %import XMonadContrib.Square hunk ./SshPrompt.hs 39 + +-- %import XMonadContrib.XPrompt +-- %import XMonadContrib.SshPrompt +-- %keybind , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) hunk ./Submap.hs 45 + +-- %import XMonadContrib.Submap +-- %keybind , ((modMask, xK_a), submap . M.fromList $ +-- %keybind [ ((0, xK_n), spawn "mpc next") +-- %keybind , ((0, xK_p), spawn "mpc prev") +-- %keybind , ((0, xK_z), spawn "mpc random") +-- %keybind , ((0, xK_space), spawn "mpc toggle") +-- %keybind ]) hunk ./Tabbed.hs 53 + +-- %import XMonadContrib.Tabbed +-- %layout , tabbed shrinkText defaultTConf hunk ./ThreeColumns.hs 40 --- > threeCol +-- > threeCol nmaster delta ratio + +-- %import XMonadContrib.ThreeColumns +-- %layout , threeCol nmaster delta ratio hunk ./TwoPane.hs 35 --- > twoPane defaultDelta (1%2) +-- > twoPane delta (1%2) + +-- %import XMonadContrib.TwoPane +-- %layout , twoPane delta (1%2) hunk ./Warp.hs 47 + +-- %import XMonadContrib.Warp +-- %keybind , ((modMask, xK_z ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window +-- %keybindlist ++ +-- %keybindlist -- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3 +-- %keybindlist [((modMask .|. controlMask, key), warpToScreen sc (1%2) (1%2)) +-- %keybindlist | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]] hunk ./WorkspaceDir.hs 48 + +-- %import XMonadContrib.WorkspaceDir +-- %keybind , ((modMask .|. shiftMask, xK_x ), changeDir defaultXPConfig) +-- %layout -- prepend 'map (workspaceDir "~")' to defaultLayouts definition above, +-- %layout -- just before the list, like the following (don't uncomment next line): +-- %layout -- defaultLayouts = map (workspaceDir "~") [ tiled, ... ] hunk ./XMonadPrompt.hs 36 + +-- %import XMonadContrib.XPrompt +-- %import XMonadContrib.XMonadPrompt +-- %keybind , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) addfile ./scripts/generate-configs.sh hunk ./scripts/generate-configs.sh 1 +#!/bin/bash + +# generate-configs.sh - Docstring parser for generating xmonad build configs +# with default settings for extensions +# Author: Alex Tarkovsky +# Released into the public domain + +# This script parses custom docstrings specifying build-time configuration data +# from xmonad extension source files, then inserts the data into copies of +# xmonad's Config.hs and xmonad.cabal files accordingly. +# +# Usage: generate-configs.sh PATH_TO_CONTRIBS +# +# Run this script from the directory containing xmonad's main Config.hs and +# xmonad.cabal files, otherwise you'll need to change the value of +# $REPO_DIR_BASE below. +# +# The docstring markup can be extended as needed. Currently the following tags +# are defined, shown with some examples: +# +# ~~~~~ +# +# %cabalbuilddep +# +# Cabal build dependency. Value is appended to the "build-depends" line in +# xmonad.cabal and automatically prefixed with ", ". NB: Don't embed +# comments in this tag! +# +# -- %cabalbuilddep readline>=1.0 +# +# %def +# +# General definition. Value is appended to the end of Config.sh. +# +# -- %def commands :: [(String, X ())] +# -- %def commands = defaultCommands +# +# %import +# +# Module needed by Config.sh to build the extension. Value is appended to +# the end of the default import list in Config.sh and automatically +# prefixed with "import ". +# +# -- %import XMonadContrib.Accordion +# -- %import qualified XMonadContrib.FlexibleManipulate as Flex +# +# %keybind +# +# Tuple defining a key binding. Must be prefixed with ", ". Value is +# inserted at the end of the "keys" list in Config.sh. +# +# -- %keybind , ((modMask, xK_d), date) +# +# %keybindlist +# +# Same as %keybind, but instead of a key binding tuple the definition is a +# list of key binding tuples (or a list comprehension producing them). This +# list is concatenated to the "keys" list must begin with the "++" operator +# rather than ", ". +# +# -- %keybindlist ++ +# -- %keybindlist -- mod-[1..9] @@ Switch to workspace N +# -- %keybindlist -- mod-shift-[1..9] @@ Move client to workspace N +# -- %keybindlist -- mod-control-shift-[1..9] @@ Copy client to workspace N +# -- %keybindlist [((m .|. modMask, k), f i) +# -- %keybindlist | (i, k) <- zip [0..fromIntegral (workspaces-1)] [xK_1 ..] +# -- %keybindlist , (f, m) <- [(view, 0), (shift, shiftMask), (copy, shiftMask .|. controlMask)]] +# +# %layout +# +# A layout. Must be prefixed with ", ". Value is inserted at the end of the +# "defaultLayouts" list in Config.sh. +# +# -- %layout , accordion +# +# %mousebind +# +# Tuple defining a mouse binding. Must be prefixed with ", ". Value is +# inserted at the end of the "mouseBindings" list in Config.sh. +# +# -- %mousebind , ((modMask, button3), (\\w -> focus w >> Flex.mouseResizeWindow w)) +# +# ~~~~~ +# +# NB: '/' and '\' characters must be escaped with a '\' character! +# +# Tags may also contain comments, as illustrated in the %keybindlist examples +# above. Comments are a good place for special user instructions: +# +# -- %def -- comment out default logHook definition above if you uncomment this: +# -- %def logHook = dynamicLog + +if [[ -z "$1" || $# > 1 || ! -d "$1" ]] ; then + echo "Usage: generate-configs.sh PATH_TO_CONTRIB" + exit 1 +fi + +REPO_DIR_BASE="." + +CABAL_FILE_BASE="${REPO_DIR_BASE}/xmonad.cabal" +CABAL_FILE_CONTRIB="${1}/xmonad.cabal" + +CONFIG_FILE_BASE="${REPO_DIR_BASE}/Config.hs" +CONFIG_FILE_CONTRIB="${1}/Config.hs" + +# Markup tag to search for in source files. +TAG_CABALBUILDDEP="%cabalbuilddep" +TAG_DEF="%def" +TAG_IMPORT="%import" +TAG_KEYBIND="%keybind" +TAG_KEYBINDLIST="%keybindlist" +TAG_LAYOUT="%layout" +TAG_MOUSEBIND="%mousebind" + +# Insert markers to search for in Config.sh and xmonad.cabal. Values are +# extended sed regular expressions. +INS_MARKER_CABALBUILDDEP='^build-depends:.*' +INS_MARKER_DEF='-- Extension-provided definitions$' +INS_MARKER_IMPORT='-- Extension-provided imports$' +INS_MARKER_KEYBIND='-- Extension-provided key bindings$' +INS_MARKER_KEYBINDLIST='-- Extension-provided key bindings lists$' +INS_MARKER_LAYOUT='-- Extension-provided layouts$' +INS_MARKER_MOUSEBIND='-- Extension-provided mouse bindings$' + +# Literal indentation strings. Values may contain escaped chars such as \t. +INS_INDENT_CABALBUILDDEP="" +INS_INDENT_DEF="" +INS_INDENT_IMPORT="" +INS_INDENT_KEYBIND=" " +INS_INDENT_KEYBINDLIST=" " +INS_INDENT_LAYOUT=" " +INS_INDENT_MOUSEBIND=" " + +# Prefix applied to inserted values after indent strings have been applied. +INS_PREFIX_CABALBUILDDEP=", " +INS_PREFIX_DEF="-- " +INS_PREFIX_IMPORT="--import " +INS_PREFIX_KEYBIND="-- " +INS_PREFIX_KEYBINDLIST="-- " +INS_PREFIX_LAYOUT="-- " +INS_PREFIX_MOUSEBIND="-- " + +cp -f "${CABAL_FILE_BASE}" "${CABAL_FILE_CONTRIB}" +cp -f "${CONFIG_FILE_BASE}" "${CONFIG_FILE_CONTRIB}" + +for extension_srcfile in $(ls --color=never -1 "${1}"/*.hs | head -n -1 | sort -r) ; do + for tag in $TAG_CABALBUILDDEP \ + $TAG_DEF \ + $TAG_IMPORT \ + $TAG_KEYBIND \ + $TAG_KEYBINDLIST \ + $TAG_LAYOUT \ + $TAG_MOUSEBIND ; do + + ifs="$IFS" + IFS=$'\n' + tags=( $(sed -n -r -e "s/^.*--\s*${tag}\s//p" "${extension_srcfile}") ) + IFS="${ifs}" + + case $tag in + $TAG_CABALBUILDDEP) ins_indent=$INS_INDENT_CABALBUILDDEP + ins_marker=$INS_MARKER_CABALBUILDDEP + ins_prefix=$INS_PREFIX_CABALBUILDDEP + ;; + $TAG_DEF) ins_indent=$INS_INDENT_DEF + ins_marker=$INS_MARKER_DEF + ins_prefix=$INS_PREFIX_DEF + ;; + $TAG_IMPORT) ins_indent=$INS_INDENT_IMPORT + ins_marker=$INS_MARKER_IMPORT + ins_prefix=$INS_PREFIX_IMPORT + ;; + $TAG_KEYBIND) ins_indent=$INS_INDENT_KEYBIND + ins_marker=$INS_MARKER_KEYBIND + ins_prefix=$INS_PREFIX_KEYBIND + ;; + $TAG_KEYBINDLIST) ins_indent=$INS_INDENT_KEYBINDLIST + ins_marker=$INS_MARKER_KEYBINDLIST + ins_prefix=$INS_PREFIX_KEYBINDLIST + ;; + $TAG_LAYOUT) ins_indent=$INS_INDENT_LAYOUT + ins_marker=$INS_MARKER_LAYOUT + ins_prefix=$INS_PREFIX_LAYOUT + ;; + $TAG_MOUSEBIND) ins_indent=$INS_INDENT_MOUSEBIND + ins_marker=$INS_MARKER_MOUSEBIND + ins_prefix=$INS_PREFIX_MOUSEBIND + ;; + esac + + # Insert in reverse so values will ultimately appear in correct order. + for i in $( seq $(( ${#tags[*]} - 1 )) -1 0 ) ; do + [ -z "${tags[i]}" ] && continue + if [[ $tag == $TAG_CABALBUILDDEP ]] ; then + sed -i -r -e "s/${ins_marker}/\\0${ins_prefix}${tags[i]}/" "${CABAL_FILE_CONTRIB}" + else + sed -i -r -e "/${ins_marker}/{G;s/$/${ins_indent}${ins_prefix}${tags[i]}/;}" "${CONFIG_FILE_CONTRIB}" + fi + done + + if [[ $tag != $TAG_CABALBUILDDEP && -n "${tags}" ]] ; then + ins_group_comment="${ins_indent}-- For extension $(basename $extension_srcfile .hs):" + sed -i -r -e "/${ins_marker}/{G;s/$/${ins_group_comment}/;}" "${CONFIG_FILE_CONTRIB}" + fi + done +done hunk ./HintedTile.hs 35 + +-- %import qualified XMonadContrib.HintedTile +-- +-- %layout , XMonadContrib.HintedTile.tall nmaster delta ratio hunk ./DynamicLog.hs 68 - fmt w | S.tag w == this = "[" ++ pprTag w ++ "]" - | S.tag w `elem` visibles = "<" ++ pprTag w ++ ">" - | isJust (S.stack w) = " " ++ pprTag w ++ " " + fmt w | S.tag w == this = "[" ++ S.tag w ++ "]" + | S.tag w `elem` visibles = "<" ++ S.tag w ++ ">" + | isJust (S.stack w) = " " ++ S.tag w ++ " " hunk ./DynamicLog.hs 86 - where onscreen = map (pprTag . S.workspace) + where onscreen = map (S.tag . S.workspace) hunk ./DynamicLog.hs 88 - offscreen = map pprTag . filter (isJust . S.stack) + offscreen = map S.tag . filter (isJust . S.stack) hunk ./DynamicLog.hs 91 --- util functions -pprTag :: Integral i => S.Workspace i a -> String -pprTag = show . (+(1::Int)) . fromIntegral . S.tag - hunk ./DynamicWorkspaces.hs 24 -import XMonad ( X, XState(..), Layout, trace ) +import XMonad ( X, XState(..), Layout, WorkspaceId, trace ) hunk ./DynamicWorkspaces.hs 39 +allPossibleTags :: [WorkspaceId] +allPossibleTags = map (:"") ['0'..] + hunk ./DynamicWorkspaces.hs 44 - let newtag:_ = filter (not . (`tagMember` s)) [0..] + let newtag:_ = filter (not . (`tagMember` s)) allPossibleTags addfile ./CycleWS.hs hunk ./CycleWS.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.CycleWS +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A module to cycle between Workspaces +-- +----------------------------------------------------------------------------- + +module XMonadContrib.CycleWS ( + -- * Usage + -- $usage + nextWS + , prevWS + ) where + +import XMonad +import Operations +import qualified StackSet as W +import {-# SOURCE #-} Config (workspaces) +import Data.List + +-- $usage +-- Import this module in Config.hs: +-- +-- > import XMonadContrib.CycleWS +-- +-- And add, in you key bindings: +-- +-- > , ((modMask , xK_comma ), prevWS ) +-- > , ((modMask , xK_period), nextWS ) + +nextWS, prevWS :: X () +nextWS = withWindowSet $ \s -> view (workspaces !! (setWS s N)) +prevWS = withWindowSet $ \s -> view (workspaces !! (setWS s P)) + +data Dir = P | N deriving Eq +setWS :: WindowSet -> Dir -> Int +setWS s d + | d == N && cur == (lw - 1) = 0 + | d == N = cur + 1 + | d == P && cur == 0 = lw - 1 + | otherwise = cur - 1 + where + cur = maybe 0 id $ elemIndex (W.tag (W.workspace ((W.current s)))) workspaces + lw = length workspaces hunk ./MetaModule.hs 28 +import XMonadContrib.CycleWS () hunk ./CopyWindow.hs 60 - -copy' :: (Ord a, Eq s, Eq i) => i -> StackSet i a s sd -> StackSet i a s sd -copy' n s = if n `tagMember` s && n /= tag (workspace (current s)) - then maybe s go (peek s) - else s - where go w = view (tag (workspace (current s))) $ insertUp' w $ view n s - - --- | --- /O(n)/. (Complexity due to check if element is in current stack.) Insert --- a new element into the stack, above the currently focused element. --- --- The new element is given focus, and is set as the master window. --- The previously focused element is moved down. The previously --- 'master' element is forgotten. (Thus, 'insert' will cause a retiling). --- --- If the element is already in the current stack, it is shifted to the --- focus position, as if it had been removed and then added. --- --- Semantics in Huet's paper is that insert doesn't move the cursor. --- However, we choose to insert above, and move the focus. - -insertUp' :: Eq a => a -> StackSet i a s sd -> StackSet i a s sd -insertUp' a s = modify (Just $ Stack a [] []) - (\(Stack t l r) -> Just $ Stack a (L.delete a l) (L.delete a (t:r))) s - -delete' :: Ord a => a -> StackSet i a s sd -> StackSet i a s sd -delete' w = sink w . modify Nothing (filter (/= w)) + where copy' n s = if n `tagMember` s && n /= tag (workspace (current s)) + then maybe s (go s) (peek s) + else s + go s w = view (tag (workspace (current s))) $ insertUp' w $ view n s + insertUp' a s = modify (Just $ Stack a [] []) + (\(Stack t l r) -> Just $ Stack a (L.delete a l) (L.delete a (t:r))) s hunk ./CopyWindow.hs 79 + where delete' w = sink w . modify Nothing (filter (/= w)) hunk ./ViewPrev.hs 24 -viewPrev' :: (Eq a, Eq s, Eq i) => W.StackSet i a s sd -> W.StackSet i a s sd -viewPrev' x = W.view (W.tag . head . W.hidden $ x) x - hunk ./ViewPrev.hs 26 + where viewPrev' x = W.view (W.tag . head . W.hidden $ x) x hunk ./DwmPromote.hs 43 -dwmpromote = windows swap - -swap :: StackSet i a s sd -> StackSet i a s sd -swap = modify' $ \c -> case c of - Stack _ [] [] -> c - Stack t [] (x:rs) -> Stack x [] (t:rs) - Stack t ls rs -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls +dwmpromote = windows $ modify' $ + \c -> case c of + Stack _ [] [] -> c + Stack t [] (x:rs) -> Stack x [] (t:rs) + Stack t ls rs -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls hunk ./LayoutHooks.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.LayoutHooks --- Copyright : (c) Stefan O'Rear --- License : BSD --- --- Maintainer : Stefan O'Rear --- Stability : unstable --- Portability : portable --- --- General layout-level hooks. ------------------------------------------------------------------------------ - -module XMonadContrib.LayoutHooks ( addLayoutMessageHook ) where - -import qualified Data.Map as M ( adjust ) -import Control.Arrow ( first ) -import Control.Monad.State ( modify ) - -import XMonad -import qualified StackSet as W - -install :: (SomeMessage -> X Bool) -> Layout a -> Layout a -install hk lay = lay{ modifyLayout = mod' } - where - mod' msg = do reinst <- hk msg - nlay <- modifyLayout lay msg - - return $ cond_reinst reinst nlay - - -- no need to make anything change - cond_reinst True Nothing = Nothing - -- reinstall - cond_reinst True (Just nlay) = Just (install hk nlay) - -- restore inner layout - cond_reinst False Nothing = Just lay - -- let it rot - cond_reinst False (Just nlay) = Just nlay - --- Return True each time you want the hook reinstalled -addLayoutMessageHook :: (SomeMessage -> X Bool) -> X () -addLayoutMessageHook hk = modify $ \ s -> - let nr = W.tag . W.workspace . W.current . windowset $ s - in s { layouts = M.adjust (first $ install hk) nr (layouts s) } rmfile ./LayoutHooks.hs hunk ./MetaModule.hs 45 -import XMonadContrib.LayoutHooks () hunk ./MetaModule.hs 54 +import XMonadContrib.SetWMName () addfile ./SetWMName.hs hunk ./SetWMName.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.SetWMName +-- Copyright : © 2007 Ivan Tarasov +-- License : BSD +-- +-- Maintainer : Ivan.Tarasov@gmail.com +-- Stability : experimental +-- Portability : unportable +-- +-- Sets the WM name to a given string, so that it could be detected using +-- _NET_SUPPORTING_WM_CHECK protocol. +-- +-- May be useful for making Java GUI programs work, just set WM name to "LG3D" +-- and use Java 1.6u1 (1.6.0_01-ea-b03 works for me) or later. +-- +-- Remember that you need to call the setWMName action yourself (at least until +-- we have startup hooks). E.g., you can bind it in your Config.hs: +-- +-- ((modMask .|. controlMask .|. shiftMask, xK_z), setWMName "LG3D") -- @@ Java hack +-- +-- and press the key combination before running the Java programs (you only +-- need to do it once per XMonad execution) +-- +-- For details on the problems with running Java GUI programs in non-reparenting +-- WMs, see and +-- related bugs. +-- +-- Setting WM name to "compiz" does not solve the problem, because of yet +-- another bug in AWT code (related to insets). For LG3D insets are explicitly +-- set to 0, while for other WMs the insets are "guessed" and the algorithm +-- fails miserably by guessing abolutely bogus values. +----------------------------------------------------------------------------- + +module XMonadContrib.SetWMName ( + setWMName) where + +import Control.Monad (join) +import Control.Monad.Reader (asks) +import Data.Bits ((.|.)) +import Data.Char (ord) +import Data.List (nub) +import Data.Maybe (fromJust, listToMaybe, maybeToList) +import Data.Word (Word8) + +import Foreign.Marshal.Alloc (alloca) + +import XMonad +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Atom +import Graphics.X11.Xlib.Extras + +-- | sets WM name +setWMName :: String -> X () +setWMName name = do + atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom + atom_NET_WM_NAME <- getAtom "_NET_WM_NAME" + atom_NET_SUPPORTED_ATOM <- getAtom "_NET_SUPPORTED" + atom_UTF8_STRING <- getAtom "UTF8_STRING" + + root <- asks theRoot + supportWindow <- getSupportWindow + dpy <- asks display + io $ do + -- _NET_SUPPORTING_WM_CHECK atom of root and support windows refers to the support window + mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW 0 [supportWindow]) [root, supportWindow] + -- set WM_NAME in supportWindow (now only accepts latin1 names to eliminate dependency on utf8 encoder) + changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToWord8List name) + -- declare which _NET protocols are supported (append to the list if it exists) + supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root + changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ atom_NET_SUPPORTING_WM_CHECK : atom_NET_WM_NAME : supportedList) + where + netSupportingWMCheckAtom :: X Atom + netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK" + + latin1StringToWord8List :: String -> [Word8] + latin1StringToWord8List str = map (fromIntegral . ord) str + + getSupportWindow :: X Window + getSupportWindow = withDisplay $ \dpy -> do + atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom + root <- asks theRoot + supportWindow <- fmap (join . fmap listToMaybe) $ io $ getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root + validateWindow supportWindow + + validateWindow :: Maybe Window -> X Window + validateWindow w = do + valid <- maybe (return False) isValidWindow w + if valid then + return $ fromJust w + else + createSupportWindow + + -- is there a better way to check the validity of the window? + isValidWindow :: Window -> X Bool + isValidWindow w = withDisplay $ \dpy -> io $ alloca $ \p -> do + status <- xGetWindowAttributes dpy w p + return (status /= 0) + + -- this code was translated from C (see OpenBox WM, screen.c) + createSupportWindow :: X Window + createSupportWindow = withDisplay $ \dpy -> do + root <- asks theRoot + let visual = defaultVisual dpy (defaultScreen dpy) -- should be CopyFromParent (=0), but the constructor is hidden in X11.XLib + window <- io $ allocaSetWindowAttributes $ \winAttrs -> do + set_override_redirect winAttrs True -- WM cannot decorate/move/close this window + set_event_mask winAttrs propertyChangeMask -- not sure if this is needed + let bogusX = -100 + bogusY = -100 + in + createWindow dpy root bogusX bogusY 1 1 0 0 inputOutput visual (cWEventMask .|. cWOverrideRedirect) winAttrs + io $ mapWindow dpy window -- not sure if this is needed + io $ lowerWindow dpy window -- not sure if this is needed + return window hunk ./WorkspaceDir.hs 36 -import XMonadContrib.XPrompt ( defaultXPConfig ) hunk ./DragPane.hs 43 -halfHandleWidth = 2 +halfHandleWidth = 1 hunk ./FlexibleResize.hs 63 - mkSel :: Bool -> Position -> Position -> (Position, a -> a -> a, CInt -> Dimension) + mkSel :: Bool -> Position -> Position -> (Position, a -> a -> a, CInt -> Position) hunk ./FlexibleResize.hs 66 - then (0, csnd, fromIntegral . max 1 . ((k + p) -) . fromIntegral) - else (k, cfst, fromIntegral . max 1 . subtract p . fromIntegral) + then (0, csnd, ((k + p) -) . fromIntegral) + else (k, cfst, subtract p . fromIntegral) addfile ./FloatKeys.hs hunk ./FloatKeys.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.FloatKeys +-- Copyright : (c) Karsten Schoelzel +-- License : BSD +-- +-- Maintainer : Karsten Schoelzel +-- Stability : unstable +-- Portability : unportable +-- +-- Move and resize floating windows. +----------------------------------------------------------------------------- + +module XMonadContrib.FloatKeys ( + -- * Usage + -- $usage + keysMoveWindow, + keysMoveWindowTo, + keysResizeWindow, + keysAbsResizeWindow) where + +import Operations +import XMonad +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +-- $usage +-- > import XMonadContrib.FloatKeys +-- +-- > , ((modMask, xK_d ), withFocused (keysResizeWindow (-10,-10) (1,1))) +-- > , ((modMask, xK_s ), withFocused (keysResizeWindow (10,10) (1,1))) +-- > , ((modMask .|. shiftMask, xK_d ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752))) +-- > , ((modMask .|. shiftMask, xK_s ), withFocused (keysAbsResizeWindow (10,10) (1024,752))) +-- > , ((modMask, xK_a ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2))) +-- +-- +-- keysMoveWindow (dx, dy) moves the window by dx pixels to the right and dy pixels down +-- +-- keysMoveWindowTo (x, y) (gx, gy) moves the window relative point (gx, gy) to the point (x,y) +-- where (gx,gy) gives a position relative to the window border, i.e. +-- gx = 0 is the left border and gx = 1 the right border +-- gy = 0 is the top border and gy = 1 the bottom border +-- +-- examples on a 1024x768 screen: keysMoveWindowTo (512,384) (1%2, 1%2) centers the window on screen +-- keysMoveWindowTo (1024,0) (1, 0) puts it into the top right corner +-- +-- keysResizeWindow (dx, dy) (gx, gy) changes the width by dx and the height by dy leaving the window +-- relative point (gx, gy) fixed +-- +-- examples: keysResizeWindow (10, 0) (0, 0) makes the window 10 pixels larger to the right +-- keysResizeWindow (10, 0) (0, 1%2) does the same, unless sizeHints are applied +-- keysResizeWindow (10, 10) (1%2, 1%2) adds 5 pixels on each side +-- keysResizeWindow (-10, -10) (0, 1) shrinks the window in direction of the bottom-left corner +-- +-- keysAbsResizeWindow (dx, dy) (ax, ay) changes the width by dx and the height by dy leaving the screen +-- absolut point (ax, ay) fixed +-- +-- examples on a 1024x768 screen: keysAbsResizeWindow (10, 10) (0, 0) enlarge the window and if it is not in the top-left corner it will also be moved away +-- +keysMoveWindow :: D -> Window -> X () +keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + dx)) + (fromIntegral (fromIntegral (wa_y wa) + dy)) + float w + +keysMoveWindowTo :: P -> G -> Window -> X () +keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + io $ moveWindow d w (x - round (gx * fromIntegral (wa_width wa))) + (y - round (gy * fromIntegral (wa_height wa))) + float w + +type G = (Rational, Rational) +type P = (Position, Position) + +keysResizeWindow :: D -> G -> Window -> X () +keysResizeWindow = keysMoveResize keysResizeWindow' + +keysAbsResizeWindow :: D -> D -> Window -> X () +keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow' + +keysAbsResizeWindow' :: SizeHints -> P -> D -> D -> D -> (P,D) +keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh)) + where + (nw, nh) = applySizeHints sh (w + dx, h + dy) + nx :: Rational = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w + ny :: Rational = fromIntegral (ay * h + nh * (fromIntegral y - ay)) / fromIntegral h + +keysResizeWindow' :: SizeHints -> P -> D -> D -> G -> (P,D) +keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh)) + where + (nw, nh) = applySizeHints sh (w + dx, h + dy) + nx = round $ fromIntegral x + gx * fromIntegral w - gx * fromIntegral nw + ny = round $ fromIntegral y + gy * fromIntegral h - gy * fromIntegral nh + +keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X () +keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + sh <- io $ getWMNormalHints d w + let wa_dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa) + wa_pos = (fromIntegral $ wa_x wa, fromIntegral $ wa_y wa) + (wn_pos, wn_dim) = f sh wa_pos wa_dim move resize + io $ resizeWindow d w `uncurry` wn_dim + io $ moveWindow d w `uncurry` wn_pos + float w + hunk ./MetaModule.hs 41 +import XMonadContrib.FloatKeys () hunk ./LayoutScreens.hs 16 - layoutScreens + layoutScreens, fixedLayout hunk ./LayoutScreens.hs 42 - --- %import XMonadContrib.LayoutScreens --- %keybind , ((modMask .|. shiftMask, xK_space), layoutScreens 2 (twoPane 0.5 0.5)) --- %keybind , ((controlMask .|. modMask .|. 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 +-- to resize your screen (e.g. to match the size of a remote VNC client): +-- +-- > import XMonadContrib.LayoutScreens +-- +-- > , ((modMask .|. shiftMask, xK_space), +-- > layoutScreens 1 (fixedLayout $ Rectangle 0 0 1024 768)) +-- > , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen) + +-- %import XMonadContrib.LayoutScreens +-- %keybind , ((modMask .|. shiftMask, xK_space), layoutScreens 2 (twoPane 0.5 0.5)) +-- %keybind , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen) hunk ./LayoutScreens.hs 76 +fixedLayout :: Rectangle -> Layout a +fixedLayout r = Layout { doLayout = \_ (W.Stack f _ _) -> return ([(f, r)],Nothing) + , modifyLayout = const (return Nothing) } -- no changes + hunk ./DragPane.hs 29 -import Operations ( Resize(..), splitHorizontallyBy, splitVerticallyBy, initColor, mouseDrag, sendMessage ) +import Operations ( Resize(..), splitHorizontallyBy, initColor, mouseDrag, sendMessage, mirrorRect ) hunk ./DragPane.hs 49 -dragPane ident delta split = Layout { doLayout = dolay, modifyLayout = return . message } - where - dolay r s = do handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor - root <- asks theRoot - let (left', right') = splitHorizontallyBy split r - leftmost = fromIntegral $ case r of Rectangle x _ _ _ -> x - widt = fromIntegral $ case r of Rectangle _ _ w _ -> w - left = case left' of Rectangle x y w h -> Rectangle x y (w-halfHandleWidth) h - right = case right' of - Rectangle x y w h -> Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h - handr = case left' of - Rectangle x y w h -> - Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h - wrs = case reverse (up s) of - (master:_) -> [(master,left),(focus s,right)] - [] -> case down s of - (next:_) -> [(focus s,left),(next,right)] - [] -> [(focus s, r)] - handle = newDecoration root handr 0 handlec handlec - "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - (const $ const $ const $ const $ return ()) (doclick) - doclick = mouseDrag (\ex _ -> - sendMessage (SetFrac ident ((fromIntegral ex - leftmost)/widt))) - (return ()) - - ml' <- if length wrs > 1 then Just `fmap` handle (dragPane ident delta split) - else return Nothing - return (wrs, ml') - message x | Just Shrink <- fromMessage x = Just (dragPane ident delta (split - delta)) - | Just Expand <- fromMessage x = Just (dragPane ident delta (split + delta)) - | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = - Just (dragPane ident delta frac) - message _ = Nothing +dragPane = dragPane' id hunk ./DragPane.hs 52 -dragUpDownPane ident delta split = Layout { doLayout = dolay, modifyLayout = return . message } +dragUpDownPane = dragPane' mirrorRect + +dragPane' :: (Rectangle -> Rectangle) -> String -> Double -> Double -> Layout a +dragPane' mirror ident delta split = Layout { doLayout = dolay, modifyLayout = return . message } hunk ./DragPane.hs 59 - let (left', right') = splitVerticallyBy split r - leftmost = fromIntegral $ case r of Rectangle _ x _ _ -> x - widt = fromIntegral $ case r of Rectangle _ _ _ w -> w - left = case left' of Rectangle x y w h -> Rectangle x y w (h-halfHandleWidth) + let r' = mirror r + (left', right') = splitHorizontallyBy split r' + leftmost = fromIntegral $ case r' of Rectangle x _ _ _ -> x + widt = fromIntegral $ case r' of Rectangle _ _ w _ -> w + left = case left' of Rectangle x y w h -> + mirror $ Rectangle x y (w-halfHandleWidth) h hunk ./DragPane.hs 66 - Rectangle x y w h -> Rectangle x (y+halfHandleWidth) w (h-halfHandleWidth) + Rectangle x y w h -> + mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h hunk ./DragPane.hs 70 - Rectangle x (y + fromIntegral h - halfHandleWidth) w (2*halfHandleWidth) + mirror $ Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h hunk ./DragPane.hs 79 - doclick = mouseDrag (\_ ey -> - sendMessage (SetFrac ident ((fromIntegral ey - leftmost)/widt))) + doclick = mouseDrag (\ex _ -> + sendMessage (SetFrac ident ((fromIntegral ex - leftmost)/widt))) hunk ./DragPane.hs 83 - ml' <- if length wrs > 1 then Just `fmap` handle (dragUpDownPane ident delta split) + ml' <- if length wrs > 1 then Just `fmap` handle (dragPane' mirror ident delta split) hunk ./DragPane.hs 86 - message x | Just Shrink <- fromMessage x = Just (dragUpDownPane ident delta (split - delta)) - | Just Expand <- fromMessage x = Just (dragUpDownPane ident delta (split + delta)) + message x | Just Shrink <- fromMessage x = Just (dragPane' mirror ident delta (split - delta)) + | Just Expand <- fromMessage x = Just (dragPane' mirror ident delta (split + delta)) hunk ./DragPane.hs 89 - Just (dragUpDownPane ident delta frac) + Just (dragPane' mirror ident delta frac) hunk ./DragPane.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} hunk ./FloatKeys.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} addfile ./LayoutChoice.hs hunk ./LayoutChoice.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.LayoutChoice +-- Copyright : (c) David Roundy +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : email@address.com +-- Stability : unstable +-- Portability : unportable +-- +-- A tabbed layout for the Xmonad Window Manager +-- +----------------------------------------------------------------------------- + +module XMonadContrib.LayoutChoice ( + -- * Usage: + -- $usage + layoutChoice + , ChangeLayout(..) + ) where + +import Data.List ( partition ) +import Data.Maybe ( fromMaybe ) +import XMonad +import Operations ( tall, UnDoLayout(..) ) + +-- $usage +-- You can use this module to replace the default layout handling of +-- xmonad. See the docstring docs for example usage. + +-- %import XMonadContrib.LayoutChoice +-- %layout , layoutChoice [("full", full), +-- %layout ("tall", tall 1 0.03 0.5)] + +-- %keybind , ((modMask, xK_space), sendMessage NextLayout) +-- %keybind , ((modMask .|. shiftMask, xK_space), sendMessage PrevLayout) +-- %keybind , ((modMask, xK_f), sendMessage (JumpToLayout "full")) + +data ChangeLayout = NextLayout | PrevLayout | JumpToLayout String + deriving ( Eq, Show, Typeable ) +instance Message ChangeLayout + +layoutChoice :: [(String, Layout a)] -> Layout a +layoutChoice [] = tall 1 0.03 0.5 +layoutChoice ((n,l):ls) = Layout { doLayout = dolay + , modifyLayout = md } + where dolay r s = do (x,ml') <- doLayout l r s + return (x, (\l' -> layoutChoice ((n,l'):ls)) `fmap` ml') + md m | Just NextLayout <- fromMessage m = switchl rls + | Just PrevLayout <- fromMessage m = switchl rls' + | Just (JumpToLayout x) <- fromMessage m = switchl (j x) + | otherwise = do ml' <- modifyLayout l m + return $ (\l' -> layoutChoice ((n,l'):ls)) `fmap` ml' + + rls (x:xs) = xs ++ [x] + rls [] = [] + rls' = reverse . rls . reverse + j s zs = case partition (\z -> s == fst z) zs of + (xs,ys) -> xs++ys + switchl f = do ml' <- modifyLayout l (SomeMessage UnDoLayout) + return $ Just (layoutChoice $ f $ (n,fromMaybe l ml'):ls) hunk ./MetaModule.hs 44 +import XMonadContrib.LayoutChoice () hunk ./SshPrompt.hs 28 +import Data.List +import Data.Maybe hunk ./SshPrompt.hs 58 - + hunk ./SshPrompt.hs 60 -sshComplList = do +sshComplList = (nub . sort) `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal + +sshComplListLocal :: IO [String] +sshComplListLocal = do hunk ./SshPrompt.hs 65 - let kh = h ++ "/.ssh/known_hosts" + sshComplListFile $ h ++ "/.ssh/known_hosts" + +sshComplListGlobal :: IO [String] +sshComplListGlobal = do + env <- getEnv "SSH_KNOWN_HOSTS" `catch` (\_ -> return "/nonexistent") + fs <- mapM fileExists [ env + , "/usr/local/etc/ssh/ssh_known_hosts" + , "/usr/local/etc/ssh_known_hosts" + , "/etc/ssh/ssh_known_hosts" + , "/etc/ssh_known_hosts" + ] + case catMaybes fs of + [] -> return [] + (f:_) -> sshComplListFile' f + +sshComplListFile :: String -> IO [String] +sshComplListFile kh = do hunk ./SshPrompt.hs 83 - if f then do l <- readFile kh - return $ map (takeWhile (/= ',') . concat . take 1 . words) (lines l) + if f then sshComplListFile' kh hunk ./SshPrompt.hs 86 +sshComplListFile' :: String -> IO [String] +sshComplListFile' kh = do + l <- readFile kh + return $ map (takeWhile (/= ',') . concat . take 1 . words) + $ filter nonComment + $ lines l + +fileExists :: String -> IO (Maybe String) +fileExists kh = do + f <- doesFileExist kh + if f then return $ Just kh + else return Nothing + +nonComment :: String -> Bool +nonComment [] = False +nonComment ('#':_) = False +nonComment ('|':_) = False -- hashed, undecodeable +nonComment _ = True + hunk ./Tabbed.hs 46 --- > myconfig = defaultTConf { inactiveBolderColor = "#FF0000" +-- > myconfig = defaultTConf { inactiveBorderColor = "#FF0000" hunk ./Combo.hs 41 --- will be used to lay out the contents of each of those subscreents. +-- will be used to lay out the contents of each of those subscreens. hunk ./DynamicLog.hs 17 --- format. suitable to pipe into dzen. +-- format. Suitable to pipe into dzen. hunk ./FlexibleManipulate.hs 45 --- Flex.position is similar to the builtin mouseMoveWindow +-- Flex.position is similar to the built-in mouseMoveWindow hunk ./FocusNth.hs 11 --- Focus the n'th window on the screen. +-- Focus the nth window on the screen. hunk ./LayoutScreens.hs 33 --- sceen and long for greater flexibility (e.g. being able to see your +-- screen and long for greater flexibility (e.g. being able to see your hunk ./Mosaic.hs 44 --- You can use this module with the following in your config file: +-- You can use this module with the following in your Config.hs: hunk ./Roledex.hs 13 --- This is a compleatly pointless layout which acts like Microsoft's Flip 3D +-- This is a completely pointless layout which acts like Microsoft's Flip 3D hunk ./RotSlaves.hs 35 --- stays where it is. It is usefull together with the TwoPane-Layout (see XMonadContrib.TwoPane). +-- stays where it is. It is useful together with the TwoPane-Layout (see XMonadContrib.TwoPane). hunk ./SetWMName.hs 32 --- fails miserably by guessing abolutely bogus values. +-- fails miserably by guessing absolutely bogus values. hunk ./WorkspaceDir.hs 12 --- WorkspaceDir is an exstension to set the current directory in a workspace. +-- WorkspaceDir is an extension to set the current directory in a workspace. hunk ./LayoutScreens.hs 76 -fixedLayout :: Rectangle -> Layout a -fixedLayout r = Layout { doLayout = \_ (W.Stack f _ _) -> return ([(f, r)],Nothing) +fixedLayout :: [Rectangle] -> Layout a +fixedLayout rs = Layout { doLayout = \_ s -> return (zip (W.integrate s) rs,Nothing) hunk ./SshPrompt.hs 39 --- > , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) +-- > , ((modMask .|. controlMask, xK_s), sshPrompt defaultXPConfig) hunk ./SshPrompt.hs 44 --- %keybind , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) +-- %keybind , ((modMask .|. controlMask, xK_s), sshPrompt defaultXPConfig) hunk ./Commands.hs 30 +import StackSet hiding (sink) hunk ./Commands.hs 67 -workspaceCommands = [((m ++ show i), f i) +workspaceCommands = [((m ++ show i), windows $ f i) hunk ./Commands.hs 73 -screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust f) +screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f)) hunk ./Commands.hs 89 - , ("focus-up", focusUp) - , ("focus-down", focusDown) - , ("swap-up", swapUp) - , ("swap-down", swapDown) - , ("swap-master", swapMaster) + , ("focus-up", windows $ focusUp) + , ("focus-down", windows $ focusDown) + , ("swap-up", windows $ swapUp) + , ("swap-down", windows $ swapDown) + , ("swap-master", windows $ swapMaster) hunk ./CycleWS.hs 39 -nextWS = withWindowSet $ \s -> view (workspaces !! (setWS s N)) -prevWS = withWindowSet $ \s -> view (workspaces !! (setWS s P)) +nextWS = withWindowSet $ \s -> windows $ W.view (workspaces !! (setWS s N)) +prevWS = withWindowSet $ \s -> windows $ W.view (workspaces !! (setWS s P)) hunk ./DynamicWorkspaces.hs 25 -import Operations ( windows, view ) -import StackSet ( tagMember, StackSet(..), Screen(..), Workspace(..), - integrate, differentiate ) +import Operations +import StackSet hiding (filter, modify, delete) hunk ./DynamicWorkspaces.hs 53 - -> do view $ tag w + -> do windows $ view (tag w) hunk ./FindEmptyWorkspace.hs 28 -import qualified Operations as O +import Operations hunk ./FindEmptyWorkspace.hs 67 -viewEmptyWorkspace = withEmptyWorkspace O.view +viewEmptyWorkspace = withEmptyWorkspace (windows . view) hunk ./FindEmptyWorkspace.hs 72 -tagToEmptyWorkspace = withEmptyWorkspace $ \w -> O.shift w >> O.view w +tagToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ view w . shift w hunk ./RotView.hs 28 -import qualified Operations as O +import Operations hunk ./RotView.hs 49 - whenJust nextws (O.view . tag) + whenJust nextws (windows . view . tag) hunk ./Commands.hs 30 -import StackSet hiding (sink) +import StackSet hunk ./Commands.hs 94 - , ("sink", withFocused sink) + , ("sink", withFocused $ windows . sink) hunk ./SinkAll.hs 19 -import StackSet hiding (sink) +import StackSet hunk ./SinkAll.hs 35 -withAll :: (Window -> X a) -> X () -withAll f = gets (integrate' . stack . workspace . current . windowset) >>= - mapM_ f +withAll :: (Window -> WindowSet -> WindowSet) -> X () +withAll f = windows $ \ws -> let all = integrate' . stack . workspace . current $ ws + in foldr f ws all hunk ./XPrompt.hs 92 - , fgHLight :: String -- ^ Font color of a highlighted completion entry - , bgHLight :: String -- ^ Backgroud color of a highlighted completion entry - , borderColor :: String -- ^ Border color - , borderWidth :: Dimension -- ^ Border width + , fgHLight :: String -- ^ Font color of a highlighted completion entry + , bgHLight :: String -- ^ Backgroud color of a highlighted completion entry + , borderColor :: String -- ^ Border color + , borderPixel :: Dimension -- ^ Border width hunk ./XPrompt.hs 134 - , borderWidth = 1 + , borderPixel = 1 hunk ./XPrompt.hs 381 - bw = borderWidth c + bw = borderPixel c hunk ./XPrompt.hs 491 - bw = borderWidth c + bw = borderPixel c hunk ./SinkAll.hs 21 -import Control.Monad.State hunk ./SinkAll.hs 35 -withAll f = windows $ \ws -> let all = integrate' . stack . workspace . current $ ws - in foldr f ws all +withAll f = windows $ \ws -> let all' = integrate' . stack . workspace . current $ ws + in foldr f ws all' hunk ./LayoutChoice.hs 1 +{-# LANGUAGE GeneralizedNewtypeDeriving #-} hunk ./LayoutChoice.hs 8 --- Maintainer : email@address.com +-- Maintainer : droundy@darcs.net hunk ./LayoutChoice.hs 12 --- A tabbed layout for the Xmonad Window Manager +-- A replacement for the default layout handling. hunk ./DirectoryPrompt.hs 40 +notboring :: String -> Bool hunk ./CopyWindow.hs 59 -copy n = windows (copy' n) - where copy' n s = if n `tagMember` s && n /= tag (workspace (current s)) - then maybe s (go s) (peek s) - else s +copy n = windows copy' + where copy' s = if n `tagMember` s && n /= tag (workspace (current s)) + then maybe s (go s) (peek s) + else s hunk ./CopyWindow.hs 76 - whenJust (peek ss) $ \w -> if member w $ delete' w ss - then windows $ delete' w + whenJust (peek ss) $ \w -> if member w $ delete'' w ss + then windows $ delete'' w hunk ./CopyWindow.hs 79 - where delete' w = sink w . modify Nothing (filter (/= w)) + where delete'' w = sink w . modify Nothing (filter (/= w)) hunk ./Warp.hs 24 -import Data.Maybe hunk ./Warp.hs 57 -ix :: Int -> [a] -> Maybe a -ix n = listToMaybe . take 1 . drop n - hunk ./Roledex.hs 65 +div' :: Integral a => a -> a -> a hunk ./Commands.hs 30 -import StackSet +import StackSet hiding (workspaces) hunk ./Circle.hs 18 - circle + Circle hunk ./Circle.hs 26 -import XMonadContrib.LayoutHelpers ( idModify ) - hunk ./Circle.hs 33 -circle :: Layout Window -circle = Layout { doLayout = \r s -> do { layout <- raiseFocus $ circleLayout r $ integrate s - ; return (layout, Nothing) } - , modifyLayout = idModify } +data Circle a = Circle deriving ( Read, Show ) + +instance Layout Circle Window where + doLayout Circle r s = do layout <- raiseFocus $ circleLayout r $ integrate s + return (layout, Nothing) + modifyLayout Circle _ = return Nothing hunk ./Circle.hs 18 - Circle + Circle (..) hunk ./TwoPane.hs 20 - twoPane + TwoPane (..) hunk ./TwoPane.hs 35 --- > twoPane delta (1%2) +-- > ,("twopane", SomeLayout $ TwoPane 0.03 0.5) hunk ./TwoPane.hs 38 --- %layout , twoPane delta (1%2) +-- %layout , ,("twopane", SomeLayout $ TwoPane 0.03 0.5) hunk ./TwoPane.hs 40 -twoPane :: Rational -> Rational -> Layout a -twoPane delta split = Layout { doLayout = \r s -> return (arrange r s,Nothing), modifyLayout = message } - where - arrange rect st = case reverse (up st) of - (master:_) -> [(master,left),(focus st,right)] - [] -> case down st of - (next:_) -> [(focus st,left),(next,right)] - [] -> [(focus st, rect)] - where (left, right) = splitHorizontallyBy split rect +data TwoPane a = + TwoPane Rational Rational + deriving ( Show, Read ) + +instance Layout TwoPane a where + doLayout (TwoPane _ split) r s = return (arrange r s,Nothing) + where + arrange rect st = case reverse (up st) of + (master:_) -> [(master,left),(focus st,right)] + [] -> case down st of + (next:_) -> [(focus st,left),(next,right)] + [] -> [(focus st, rect)] + where (left, right) = splitHorizontallyBy split rect + + modifyLayout (TwoPane delta split) x = + return $ case fromMessage x of + Just Shrink -> Just (TwoPane delta (split - delta)) + Just Expand -> Just (TwoPane delta (split + delta)) + _ -> Nothing hunk ./TwoPane.hs 60 - message x = return $ case fromMessage x of - Just Shrink -> Just (twoPane delta (split - delta)) - Just Expand -> Just (twoPane delta (split + delta)) - _ -> Nothing hunk ./LayoutHelpers.hs 1 +{-# OPTIONS -fallow-undecidable-instances #-} hunk ./LayoutHelpers.hs 18 - DoLayout, ModDo, ModMod, ModLay, - layoutModify, - l2lModDo, idModify, - idModDo, idModMod, + LayoutModifier(..) hunk ./LayoutHelpers.hs 21 +import Control.Monad ( mplus ) hunk ./LayoutHelpers.hs 24 -import StackSet ( Stack, integrate ) +import StackSet ( Stack ) hunk ./LayoutHelpers.hs 29 -type DoLayout a = Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Layout a)) -type ModifyLayout a = SomeMessage -> X (Maybe (Layout a)) +class (Show (m l a), Read (m l a), Layout l a) => LayoutModifier m l a where + extractLayout :: m l a -> l a + wrapLayout :: m l a -> l a -> m l a + modifyModify :: m l a -> SomeMessage -> X (Maybe (l a -> m l a)) + modifyModify _ _ = return Nothing + redoLayout :: m l a -> Rectangle -> Stack a -> [(a, Rectangle)] + -> X ([(a, Rectangle)], Maybe (l a -> m l a)) + redoLayout _ _ _ wrs = return (wrs, Nothing) hunk ./LayoutHelpers.hs 38 -type ModDo a = Rectangle -> Stack a -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ModLay a)) -type ModMod a = SomeMessage -> X (Maybe (ModLay a)) - -type ModLay a = Layout a -> Layout a - -layoutModify :: ModDo a -> ModMod a -> ModLay a -layoutModify fdo fmod l = Layout { doLayout = dl, modifyLayout = modl } - where dl r s = do (ws, ml') <- doLayout l r s - (ws', mmod') <- fdo r s ws - let ml'' = case mmod' of - Just mod' -> Just $ mod' $ maybe l id ml' - Nothing -> layoutModify fdo fmod `fmap` ml' - return (ws', ml'') - modl m = do ml' <- modifyLayout l m - mmod' <- fmod m - return $ case mmod' of - Just mod' -> Just $ mod' $ maybe l id ml' - Nothing -> layoutModify fdo fmod `fmap` ml' - -l2lModDo :: (Rectangle -> [a] -> [(a,Rectangle)]) -> DoLayout a -l2lModDo dl r s = return (dl r $ integrate s, Nothing) - -idModDo :: ModDo a -idModDo _ _ wrs = return (wrs, Nothing) - -idModify :: ModifyLayout a -idModify _ = return Nothing - -idModMod :: ModMod a -idModMod _ = return Nothing +instance LayoutModifier m l a => Layout (m l) a where + doLayout m r s = do (ws, ml') <- doLayout (extractLayout m) r s + (ws', mmod') <- redoLayout m r s ws + let ml'' = case mmod' of + Just mod' -> Just $ mod' $ maybe (extractLayout m) id ml' + Nothing -> wrapLayout m `fmap` ml' + return (ws', ml'') + modifyLayout m mess = do ml' <- modifyLayout (extractLayout m) mess + mmod' <- modifyModify m mess + return $ case mmod' of + Just mod' -> Just $ mod' $ maybe (extractLayout m) id ml' + Nothing -> wrapLayout m `fmap` ml' hunk ./Circle.hs 38 - modifyLayout Circle _ = return Nothing hunk ./LayoutHelpers.hs 36 - redoLayout _ _ _ wrs = return (wrs, Nothing) + redoLayout m _ _ wrs = do hook m; return (wrs, Nothing) + hook :: m l a -> X () + hook _ = return () hunk ./LayoutHelpers.hs 1 -{-# OPTIONS -fallow-undecidable-instances #-} hunk ./LayoutHelpers.hs 17 - LayoutModifier(..) + LayoutModifier(..), ModifiedLayout(..) hunk ./LayoutHelpers.hs 20 -import Control.Monad ( mplus ) hunk ./LayoutHelpers.hs 23 +import Operations ( UnDoLayout(UnDoLayout) ) hunk ./LayoutHelpers.hs 28 -class (Show (m l a), Read (m l a), Layout l a) => LayoutModifier m l a where - extractLayout :: m l a -> l a - wrapLayout :: m l a -> l a -> m l a - modifyModify :: m l a -> SomeMessage -> X (Maybe (l a -> m l a)) - modifyModify _ _ = return Nothing - redoLayout :: m l a -> Rectangle -> Stack a -> [(a, Rectangle)] - -> X ([(a, Rectangle)], Maybe (l a -> m l a)) +class (Show (m a), Read (m a)) => LayoutModifier m a where + modifyModify :: m a -> SomeMessage -> X (Maybe (m l)) + modifyModify m mess | Just UnDoLayout <- fromMessage mess = do unhook m; return Nothing + | otherwise = return Nothing + redoLayout :: m a -> Rectangle -> Stack a -> [(a, Rectangle)] + -> X ([(a, Rectangle)], Maybe (m l)) hunk ./LayoutHelpers.hs 35 - hook :: m l a -> X () + hook :: m a -> X () hunk ./LayoutHelpers.hs 37 + unhook :: m a -> X () + unhook _ = return () hunk ./LayoutHelpers.hs 40 -instance LayoutModifier m l a => Layout (m l) a where - doLayout m r s = do (ws, ml') <- doLayout (extractLayout m) r s - (ws', mmod') <- redoLayout m r s ws - let ml'' = case mmod' of - Just mod' -> Just $ mod' $ maybe (extractLayout m) id ml' - Nothing -> wrapLayout m `fmap` ml' - return (ws', ml'') - modifyLayout m mess = do ml' <- modifyLayout (extractLayout m) mess - mmod' <- modifyModify m mess - return $ case mmod' of - Just mod' -> Just $ mod' $ maybe (extractLayout m) id ml' - Nothing -> wrapLayout m `fmap` ml' +instance (LayoutModifier m a, Layout l a) => Layout (ModifiedLayout m l) a where + doLayout (ModifiedLayout m l) r s = + do (ws, ml') <- doLayout l r s + (ws', mm') <- redoLayout m r s ws + let ml'' = case mm' of + Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml' + Nothing -> ModifiedLayout m `fmap` ml' + return (ws', ml'') + modifyLayout (ModifiedLayout m l) mess = + do ml' <- modifyLayout l mess + mm' <- modifyModify m mess + return $ case mm' of + Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml' + Nothing -> (ModifiedLayout m) `fmap` ml' + +data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show ) hunk ./NoBorders.hs 21 - noBorders, - withBorder + noBorders, + withBorder hunk ./NoBorders.hs 29 -import Operations ( UnDoLayout(UnDoLayout) ) -import qualified StackSet as W +import XMonadContrib.LayoutHelpers hunk ./NoBorders.hs 31 +import qualified StackSet as W hunk ./NoBorders.hs 47 -noBorders :: Layout a -> Layout a -noBorders = withBorder 0 +data WithBorder a = WithBorder Dimension deriving ( Read, Show ) + +instance LayoutModifier WithBorder a where + hook (WithBorder b) = setborders b + unhook (WithBorder _) = setborders borderWidth + +noBorders :: Layout l a => l a -> ModifiedLayout WithBorder l a +noBorders = ModifiedLayout (WithBorder 0) hunk ./NoBorders.hs 56 -withBorder :: Dimension -> Layout a -> Layout a -withBorder bd l = l { doLayout = \r x -> setborders bd >> doLayout l r x - , modifyLayout = ml } - where ml m | Just UnDoLayout == fromMessage m - = do setborders borderWidth - fmap (withBorder bd) `fmap` (modifyLayout l) m - | otherwise = fmap (withBorder bd) `fmap` (modifyLayout l) m +withBorder :: Layout l a => Dimension -> l a -> ModifiedLayout WithBorder l a +withBorder b = ModifiedLayout (WithBorder b) hunk ./LayoutScreens.hs 57 -layoutScreens :: Int -> Layout Int -> X () +layoutScreens :: Layout l Int => Int -> l Int -> X () hunk ./LayoutScreens.hs 76 -fixedLayout :: [Rectangle] -> Layout a -fixedLayout rs = Layout { doLayout = \_ s -> return (zip (W.integrate s) rs,Nothing) - , modifyLayout = const (return Nothing) } -- no changes +data FixedLayout a = FixedLayout [Rectangle] deriving (Read,Show) + +instance Layout FixedLayout a where + doLayout (FixedLayout rs) _ s = return (zip (W.integrate s) rs, Nothing) + +fixedLayout :: [Rectangle] -> FixedLayout a +fixedLayout = FixedLayout move ./LayoutHelpers.hs ./LayoutModifier.hs replace ./LayoutModifier.hs [A-Za-z_0-9\-\.] XMonadContrib.LayoutHelpers XMonadContrib.LayoutModifier replace ./MetaModule.hs [A-Za-z_0-9\-\.] XMonadContrib.LayoutHelpers XMonadContrib.LayoutModifier replace ./NoBorders.hs [A-Za-z_0-9\-\.] XMonadContrib.LayoutHelpers XMonadContrib.LayoutModifier hunk ./WorkspaceDir.hs 35 -import XMonadContrib.LayoutHelpers ( layoutModify ) +import XMonadContrib.LayoutModifier hunk ./WorkspaceDir.hs 58 -workspaceDir :: String -> Layout a -> Layout a -workspaceDir wd = layoutModify dowd modwd - where dowd _ _ rws = scd wd >> return (rws, Nothing) - modwd m = return $ do Chdir wd' <- fromMessage m - Just $ workspaceDir wd' +data WorkspaceDir a = WorkspaceDir String deriving ( Read, Show ) + +instance LayoutModifier WorkspaceDir a where + hook (WorkspaceDir s) = scd s + modifyModify (WorkspaceDir _) m = return $ do Chdir wd <- fromMessage m + Just (WorkspaceDir wd) + +workspaceDir :: Layout l a => String -> l a + -> ModifiedLayout WorkspaceDir l a +workspaceDir s = ModifiedLayout (WorkspaceDir s) hunk ./FindEmptyWorkspace.hs 53 -findEmptyWorkspace :: StackSet i a s sd -> Maybe (Workspace i a) +findEmptyWorkspace :: StackSet i l a s sd -> Maybe (Workspace i l a) hunk ./Commands.hs 84 - , ("layout", switchLayout) + , ("layout", sendMessage NextLayout) hunk ./LayoutHints.hs 17 - layoutHints) where + LayoutHints) where hunk ./LayoutHints.hs 24 -import XMonadContrib.LayoutHelpers ( layoutModify, idModMod ) +import XMonadContrib.LayoutModifier hunk ./LayoutHints.hs 31 --- %layout , layoutHints tiled --- %layout , layoutHints $ mirror tiled +-- %layout , ModifiedLayout LayoutHints $ layoutHints tiled +-- %layout , ModifiedLayout LayoutHints $ mirror tiled hunk ./LayoutHints.hs 39 -layoutHints :: Layout Window -> Layout Window -layoutHints = layoutModify applyHints idModMod - where applyHints _ _ xs = do xs' <- mapM applyHint xs - return (xs', Nothing) - applyHint (w,Rectangle a b c d) = - withDisplay $ \disp -> - do sh <- io $ getWMNormalHints disp w - let (c',d') = adjBorders 1 . applySizeHints sh . adjBorders (-1) $ (c,d) - return (w, Rectangle a b c' d') +data LayoutHints a = LayoutHints deriving (Read, Show) + +instance LayoutModifier LayoutHints Window where + redoLayout _ _ _ xs = do + xs' <- mapM applyHint xs + return (xs', Nothing) + where + applyHint (w,Rectangle a b c d) = + withDisplay $ \disp -> do + sh <- io $ getWMNormalHints disp w + let (c',d') = adjBorders 1 . applySizeHints sh . adjBorders (-1) $ (c,d) + return (w, Rectangle a b c' d') hunk ./ThreeColumns.hs 18 - threeCol + ThreeCol hunk ./ThreeColumns.hs 40 --- > threeCol nmaster delta ratio +-- > ThreeCol nmaster delta ratio hunk ./ThreeColumns.hs 43 --- %layout , threeCol nmaster delta ratio +-- %layout , ThreeCol nmaster delta ratio hunk ./ThreeColumns.hs 45 -threeCol :: Int -> Rational -> Rational -> Layout a -threeCol nmaster delta frac = - Layout { doLayout = \r -> return . (\x->(x,Nothing)) . - ap zip (tile3 frac r nmaster . length) . W.integrate - , modifyLayout = \m -> return $ msum [fmap resize (fromMessage m) - ,fmap incmastern (fromMessage m)] } +data ThreeCol a = ThreeCol Int Rational Rational deriving (Show,Read) hunk ./ThreeColumns.hs 47 - where resize Shrink = threeCol nmaster delta (max 0 $ frac-delta) - resize Expand = threeCol nmaster delta (min 1 $ frac+delta) - incmastern (IncMasterN d) = threeCol (max 0 (nmaster+d)) delta frac +instance Layout ThreeCol a where + doLayout (ThreeCol nmaster _ frac) r = + return . (\x->(x,Nothing)) . + ap zip (tile3 frac r nmaster . length) . W.integrate + modifyLayout (ThreeCol nmaster delta frac) m = + return $ msum [fmap resize (fromMessage m) + ,fmap incmastern (fromMessage m)] + where resize Shrink = ThreeCol nmaster delta (max 0 $ frac-delta) + resize Expand = ThreeCol nmaster delta (min 1 $ frac+delta) + incmastern (IncMasterN d) = ThreeCol (max 0 (nmaster+d)) delta frac + description _ = "ThreeCol" hunk ./LayoutModifier.hs 23 -import Operations ( UnDoLayout(UnDoLayout) ) +import Operations ( LayoutMessages(Hide) ) hunk ./LayoutModifier.hs 30 - modifyModify m mess | Just UnDoLayout <- fromMessage mess = do unhook m; return Nothing + modifyModify m mess | Just Hide <- fromMessage mess = do unhook m; return Nothing addfile ./NewTabbed.hs hunk ./NewTabbed.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Tabbed +-- Copyright : (c) David Roundy +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : email@address.com +-- Stability : unstable +-- Portability : unportable +-- +-- A tabbed layout for the Xmonad Window Manager +-- +----------------------------------------------------------------------------- + +module XMonadContrib.NewTabbed ( + -- * Usage: + -- $usage + Tabbed (..) + , TConf (..), defaultTConf + ) where + +import Control.Monad.State ( gets ) +import Control.Monad.Reader +import Data.Maybe +import Data.Bits +import Data.List + +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +import XMonad +import Operations +import qualified StackSet as W + +import XMonadContrib.NamedWindows +import XMonadContrib.XPrompt (fillDrawable, printString) + +-- $usage +-- You can use this module with the following in your configuration file: +-- +-- > import XMonadContrib.NewTabbed +-- +-- > defaultLayouts :: [(String, SomeLayout Window)] +-- > defaultLayouts = [("tall", SomeLayout tiled) +-- > ,("wide", SomeLayout $ Mirror tiled) +-- > -- Extension-provided layouts +-- > ,("tabbed", SomeLayout $ Tabbed Nothing myTabConfig) +-- > , ... ] +-- +-- You can also edit the default configuration options. +-- +-- > myconfig = defaultTConf { inactiveBorderColor = "#FF0000" +-- > , activeTextColor = "#00FF00"} +-- +-- and +-- +-- > defaultLayouts = [ tabbed shrinkText myconfig +-- > , ... ] + +-- %import XMonadContrib.NewTabbed +-- %layout , tabbed shrinkText defaultTConf + +data TConf = + TConf { activeColor :: String + , inactiveColor :: String + , activeBorderColor :: String + , inactiveTextColor :: String + , inactiveBorderColor :: String + , activeTextColor :: String + , fontName :: String + , tabSize :: Int + } deriving (Show, Read) + +defaultTConf :: TConf +defaultTConf = + TConf { activeColor = "#999999" + , inactiveColor = "#666666" + , activeBorderColor = "#FFFFFF" + , inactiveBorderColor = "#BBBBBB" + , activeTextColor = "#FFFFFF" + , inactiveTextColor = "#BFBFBF" + , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , tabSize = 20 + } + +data TabState = + TabState { tabsWindows :: [(Window,Window)] + , scr :: Rectangle + , fontS :: FontStruct -- FontSet + } deriving (Read, Show) + +data Tabbed a = + Tabbed (Maybe TabState) TConf + deriving (Show, Read) + +instance Layout Tabbed Window where + doLayout (Tabbed mst conf) = doLay mst conf + modifyLayout l m = modLay l m + +instance Read FontStruct where + readsPrec _ _ = [] + +doLay :: Maybe TabState -> TConf -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed Window)) +doLay _ _ sc (W.Stack w [] []) = return ([(w,sc)], Nothing) +doLay mst conf sc@(Rectangle _ _ wid _) s@(W.Stack w _ _) = do + let ws = W.integrate s + width = wid `div` fromIntegral (length ws) + -- initialize state + st <- case mst of + Nothing -> initState conf sc ws + Just ts -> if map snd (tabsWindows ts) == ws + then return ts + else do destroyTabs (map fst $ tabsWindows ts) + tws <- createTabs conf sc ws + return (ts {tabsWindows = zip tws ws}) + showTabs $ map fst $ tabsWindows st + mapM_ (updateTab conf (fontS st) width) $ tabsWindows st + return ([(w,shrink conf sc)], Just (Tabbed (Just st) conf)) + +modLay :: Tabbed Window -> SomeMessage -> X (Maybe (Tabbed Window)) +modLay (Tabbed mst conf) m + | Just st <- mst, Just e <- fromMessage m :: Maybe Event = do + handleEvent conf st e >> return Nothing + | Just st <- mst, Just Hide == fromMessage m = do + hideTabs $ map fst $ tabsWindows st + return Nothing + | Just st <- mst, Just ReleaseResources == fromMessage m = do + d <- asks display + destroyTabs $ map fst $ tabsWindows st + io $ freeFont d (fontS st) + return $ Just $ Tabbed Nothing conf + | otherwise = return Nothing + +handleEvent :: TConf -> TabState -> Event -> X () +-- button press +handleEvent conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) + (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t }) + | t == buttonPress && thisw `elem` map fst tws || thisbw `elem` map fst tws = do + focus (fromJust $ lookup thisw tws) + updateTab conf fs width (thisw, fromJust $ lookup thisw tws) + where + width = rect_width screen`div` fromIntegral (length tws) + +handleEvent conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) + (AnyEvent {ev_window = thisw, ev_event_type = t }) +-- expose + | thisw `elem` (map fst tws) && t == expose = do + updateTab conf fs width (thisw, fromJust $ lookup thisw tws) +-- propertyNotify + | thisw `elem` (map snd tws) && t == propertyNotify = do + let tabwin = (fst $ fromJust $ find (\x -> snd x == thisw) tws, thisw) + updateTab conf fs width tabwin + where + width = rect_width screen`div` fromIntegral (length tws) +handleEvent _ _ _ = return () + +initState :: TConf -> Rectangle -> [Window] -> X TabState +initState conf sc ws = withDisplay $ \ d -> do + fs <- io $ loadQueryFont d (fontName conf) `catch` + \_-> loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + tws <- createTabs conf sc ws + return $ TabState (zip tws ws) sc fs + +createTabs :: TConf -> Rectangle -> [Window] -> X [Window] +createTabs _ _ [] = return [] +createTabs c (Rectangle x y wh ht) owl@(ow:ows) = do + let wid = wh `div` (fromIntegral $ length owl) + d <- asks display + rt <- asks theRoot + w <- io $ createSimpleWindow d rt x y wid (fromIntegral $ tabSize c) 0 0 0 + io $ selectInput d w $ exposureMask .|. buttonPressMask + io $ restackWindows d $ w : [ow] + ws <- createTabs c (Rectangle (x + fromIntegral wid) y (wh - wid) ht) ows + return (w:ws) + +updateTab :: TConf -> FontStruct -> Dimension -> (Window,Window) -> X () +updateTab c fs wh (tabw,ow) = do + xc <- ask + nw <- getName ow + let ht = fromIntegral $ tabSize c :: Dimension + d = display xc + focusColor win ic ac = (maybe ic (\focusw -> if focusw == win + then ac else ic) . W.peek) + `fmap` gets windowset + (bc',borderc',tc') <- focusColor ow + (inactiveColor c, inactiveBorderColor c, inactiveTextColor c) + (activeColor c, activeBorderColor c, activeTextColor c) + + -- initialize colors + bc <- io $ initColor d bc' + borderc <- io $ initColor d borderc' + tc <- io $ initColor d tc' + -- pixmax and graphic context + p <- io $ createPixmap d tabw wh ht (defaultDepthOfScreen $ defaultScreenOfDisplay d) + gc <- io $ createGC d p + -- draw + io $ setGraphicsExposures d gc False + io $ fillDrawable d p gc borderc bc 1 wh ht + io $ setFont d gc (fontFromFontStruct fs) + let name = shrinkWhile shrinkText (\n -> textWidth fs n > + fromIntegral wh - fromIntegral (ht `div` 2)) (show nw) + width = textWidth fs name + (_,asc,desc,_) = textExtents fs name + y = fromIntegral $ ((ht - fromIntegral (asc + desc)) `div` 2) + fromIntegral asc + x = fromIntegral (wh `div` 2) - fromIntegral (width `div` 2) + io $ printString d p gc tc bc x y name + io $ copyArea d p tabw gc 0 0 wh ht 0 0 + io $ freePixmap d p + io $ freeGC d gc + +destroyTabs :: [Window] -> X () +destroyTabs w = do + d <- asks display + io $ mapM_ (destroyWindow d) w + +hideTabs :: [Window] -> X () +hideTabs w = do + d <- asks display + io $ mapM_ (unmapWindow d) w + +showTabs :: [Window] -> X () +showTabs w = do + d <- asks display + io $ mapM_ (mapWindow d) w + +shrink :: TConf -> Rectangle -> Rectangle +shrink c (Rectangle x y w h) = + Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c)) + +type Shrinker = String -> [String] + +shrinkWhile :: Shrinker -> (String -> Bool) -> String -> String +shrinkWhile sh p x = sw $ sh x + where sw [n] = n + sw [] = "" + sw (n:ns) | p n = sw ns + | otherwise = n + +shrinkText :: Shrinker +shrinkText "" = [""] +shrinkText cs = cs : shrinkText (init cs) hunk ./LayoutModifier.hs 29 - modifyModify :: m a -> SomeMessage -> X (Maybe (m l)) + modifyModify :: m a -> SomeMessage -> X (Maybe (m a)) hunk ./LayoutModifier.hs 33 - -> X ([(a, Rectangle)], Maybe (m l)) + -> X ([(a, Rectangle)], Maybe (m a)) hunk ./Accordion.hs 18 - accordion) where + Accordion(Accordion)) where hunk ./Accordion.hs 25 -import XMonadContrib.LayoutHelpers ( idModify ) hunk ./Accordion.hs 33 -accordion :: Eq a => Layout a -accordion = Layout { doLayout = accordionLayout, modifyLayout = idModify } +data Accordion a = Accordion deriving ( Read, Show ) hunk ./Accordion.hs 35 -accordionLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Layout a)) +instance Layout Accordion Window where + doLayout _ = accordionLayout + +accordionLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Accordion a)) hunk ./Accordion.hs 45 - (top, allButTop) = splitVerticallyBy (1%8) sc - (center, bottom) = splitVerticallyBy (6%7) allButTop - (allButBottom, _) = splitVerticallyBy (7%8) sc + (top, allButTop) = splitVerticallyBy (1%8 :: Ratio Int) sc + (center, bottom) = splitVerticallyBy (6%7 :: Ratio Int) allButTop + (allButBottom, _) = splitVerticallyBy (7%8 :: Ratio Int) sc hunk ./Accordion.hs 52 - tops = if ups /= [] then splitVertically (length ups) top else [] - bottoms= if dns /= [] then splitVertically (length dns) bottom else [] + tops = if ups /= [] then splitVertically (length ups) top else [] + bottoms = if dns /= [] then splitVertically (length dns) bottom else [] hunk ./Roledex.hs 19 - roledex) where + Roledex(Roledex)) where hunk ./Roledex.hs 26 -import XMonadContrib.LayoutHelpers ( idModify ) hunk ./Roledex.hs 35 -roledex :: Eq a => Layout a -roledex = Layout { doLayout = roledexLayout, modifyLayout = idModify } +data Roledex a = Roledex deriving ( Show, Read ) hunk ./Roledex.hs 37 -roledexLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Layout a)) +instance Layout Roledex Window where + doLayout _ = roledexLayout + +roledexLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Roledex a)) hunk ./Roledex.hs 48 - rect = fst $ splitHorizontallyBy (2% 3) $ fst (splitVerticallyBy (2% 3) sc) + rect = fst $ splitHorizontallyBy (2%3 :: Ratio Int) $ fst (splitVerticallyBy (2%3 :: Ratio Int) sc) hunk ./NewTabbed.hs 104 -doLay _ _ sc (W.Stack w [] []) = return ([(w,sc)], Nothing) +doLay mst _ sc (W.Stack w [] []) = do + when (isJust mst) $ destroyTabs (map fst $ tabsWindows (fromJust mst)) + return ([(w,sc)], Nothing) hunk ./NewTabbed.hs 140 - | t == buttonPress && thisw `elem` map fst tws || thisbw `elem` map fst tws = do + | t == buttonPress, tl <- map fst tws, thisw `elem` tl || thisbw `elem` tl = do hunk ./NewTabbed.hs 186 - `fmap` gets windowset + `fmap` gets windowset hunk ./NewTabbed.hs 202 - let name = shrinkWhile shrinkText (\n -> textWidth fs n > + let name = shrinkWhile shrinkText (\n -> textWidth fs n > hunk ./NewTabbed.hs 204 - width = textWidth fs name + width = textWidth fs name hunk ./NewTabbed.hs 206 - y = fromIntegral $ ((ht - fromIntegral (asc + desc)) `div` 2) + fromIntegral asc - x = fromIntegral (wh `div` 2) - fromIntegral (width `div` 2) + y = fromIntegral $ ((ht - fromIntegral (asc + desc)) `div` 2) + fromIntegral asc + x = fromIntegral (wh `div` 2) - fromIntegral (width `div` 2) hunk ./NewTabbed.hs 209 - io $ copyArea d p tabw gc 0 0 wh ht 0 0 - io $ freePixmap d p - io $ freeGC d gc + io $ copyArea d p tabw gc 0 0 wh ht 0 0 + io $ freePixmap d p + io $ freeGC d gc hunk ./Combo.hs 1 +{-# OPTIONS -fallow-undecidable-instances #-} hunk ./Combo.hs 23 +import Data.List ( delete ) hunk ./Combo.hs 26 -import StackSet ( integrate, differentiate ) +import StackSet ( integrate, Stack(..) ) +import qualified StackSet as W ( differentiate ) hunk ./Combo.hs 34 --- > import XMonadContrib.SimpleStacking hunk ./Combo.hs 37 --- > simpleStacking $ combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)] +-- > combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)] hunk ./Combo.hs 41 --- The first argument to combo is a Layout that will divide the screen into +-- The first argument to combo is a layout that will divide the screen into hunk ./Combo.hs 49 --- %import XMonadContrib.SimpleStacking --- %layout , simpleStacking $ combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)] +-- %layout , combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)] hunk ./Combo.hs 51 -combo :: Layout (Layout a, Int) -> [(Layout a, Int)] -> Layout a -combo super origls = Layout { doLayout = \r s -> arrange r (integrate s), modifyLayout = message } - where arrange _ [] = return ([], Nothing) - arrange r [w] = return ([(w,r)], Nothing) - arrange rinput origws = - do (lrs, msuper') <- runLayout super rinput (differentiate $ take (length origws) origls) - let super' = maybe super id msuper' - lwrs [] _ = [] - lwrs [((l,_),r)] ws = [((l,r),differentiate ws)] - lwrs (((l,n),r):xs) ws = ((l,r),differentiate $ take len1 ws) : lwrs xs (drop len1 ws) - where len1 = min n (length ws - length xs) - out <- mapM (uncurry $ uncurry runLayout) $ lwrs lrs origws - let origls' = zipWith foo (out++repeat ([],Nothing)) origls - foo (_, Nothing) x = x - foo (_, Just l') (_, n) = (l', n) - return (concat $ map fst out, Just $ combo super' origls') - message m = do mls <- broadcastPrivate m (map fst origls) +combo :: (Eq a, Show a, Read a, ReadableSomeLayout a, Layout l (SomeLayout a, Int)) + => (l (SomeLayout a, Int)) -> [(SomeLayout a, Int)] -> Combo l a +combo = Combo [] + +data Combo l a = Combo [a] (l (SomeLayout a, Int)) [(SomeLayout a, Int)] + deriving ( Show, Read ) + +instance (Eq a, Show a, Read a, ReadableSomeLayout a, Layout l (SomeLayout a, Int)) + => Layout (Combo l) a where + doLayout (Combo f super origls) rinput s = arrange (integrate s) + where arrange [] = return ([], Just $ Combo [] super origls) + arrange [w] = return ([(w,rinput)], Just $ Combo [w] super origls) + arrange origws = + do (lrs, msuper') <- runLayout super rinput (W.differentiate $ take (length origws) origls) + let super' = maybe super id msuper' + f' = focus s:delete (focus s) f + lwrs [] _ = [] + lwrs [((l,_),r)] ws = [((l,r),differentiate f' ws)] + lwrs (((l,n),r):xs) ws = ((l,r),differentiate f' $ take len1 ws) : lwrs xs (drop len1 ws) + where len1 = min n (length ws - length xs) + out <- mapM (uncurry $ uncurry runLayout) $ lwrs lrs origws + let origls' = zipWith foo (out++repeat ([],Nothing)) origls + foo (_, Nothing) x = x + foo (_, Just l') (_, n) = (l', n) + return (concat $ map fst out, Just $ Combo f' super' origls') + differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q) + differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z + , up = reverse $ takeWhile (/=z) xs + , down = tail $ dropWhile (/=z) xs } + | otherwise = differentiate zs xs + differentiate [] xs = W.differentiate xs + modifyLayout (Combo f super origls) m = + do mls <- broadcastPrivate m (map fst origls) hunk ./Combo.hs 87 - Just [super'] -> return $ Just $ combo super' $ maybe origls id mls' - _ -> return $ combo super `fmap` mls' + Just [super'] -> return $ Just $ Combo f super' $ maybe origls id mls' + _ -> return $ Combo f super `fmap` mls' hunk ./Combo.hs 90 -broadcastPrivate :: SomeMessage -> [Layout b] -> X (Maybe [Layout b]) +broadcastPrivate :: Layout l b => SomeMessage -> [l b] -> X (Maybe [l b]) hunk ./Square.hs 23 - square ) where + Square(..) ) where hunk ./Square.hs 27 -import XMonadContrib.LayoutHelpers ( l2lModDo, idModify ) +import StackSet ( integrate ) hunk ./Square.hs 43 -square :: Layout a -square = Layout { doLayout = l2lModDo arrange, modifyLayout = idModify } - where arrange :: Rectangle -> [a] -> [(a, Rectangle)] - arrange rect ws@(_:_) = map (\w->(w,rest)) (init ws) ++ [(last ws,sq)] - where (rest, sq) = splitSquare rect - arrange _ [] = [] +data Square a = Square deriving ( Read, Show ) + +instance Layout Square a where + pureLayout Square r s = arrange (integrate s) + where arrange ws@(_:_) = map (\w->(w,rest)) (init ws) ++ [(last ws,sq)] + arrange [] = [] -- actually, this is an impossible case + (rest, sq) = splitSquare r replace ./Circle.hs [A-Za-z_0-9] modifyLayout handleMessage replace ./Combo.hs [A-Za-z_0-9] modifyLayout handleMessage replace ./LayoutModifier.hs [A-Za-z_0-9] modifyLayout handleMessage replace ./NewTabbed.hs [A-Za-z_0-9] modifyLayout handleMessage replace ./Square.hs [A-Za-z_0-9] modifyLayout handleMessage replace ./ThreeColumns.hs [A-Za-z_0-9] modifyLayout handleMessage replace ./TwoPane.hs [A-Za-z_0-9] modifyLayout handleMessage hunk ./Accordion.hs 36 - doLayout _ = accordionLayout - -accordionLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Accordion a)) -accordionLayout sc ws = return ((zip ups tops) ++ - [(W.focus ws, mainPane)] ++ - (zip dns bottoms) - ,Nothing) - where ups = W.up ws + pureLayout _ sc ws = zip ups tops ++ [(W.focus ws, mainPane)] ++ zip dns bottoms + where + ups = W.up ws addfile ./SetLayout.hs hunk ./SetLayout.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.SetLayout +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- Provides bindings to cycle through non-empty workspaces. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.SetLayout ( + -- * Usage + -- $usage + setLayout + ) where + +import Graphics.X11.Xlib ( Window ) +import XMonad +import StackSet hiding (filter) +import Operations + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.SetLayout +-- +-- > , ((modMask .|. shiftMask, xK_space ), setLayout $ SomeLayout $ LayoutSelection defaultLayouts) -- %! Reset this layout + +-- %import XMonadContrib.SetLayout +-- %keybind , ((modMask .|. shiftMask, xK_space ), setLayout $ SomeLayout $ LayoutSelection defaultLayouts) -- %! Reset this layout + +setLayout :: SomeLayout Window -> X () +setLayout l = do sendMessage ReleaseResources + windows $ \s -> s { current = r $ current s } + where r scr = scr { workspace = r' $ workspace scr } + r' ws = ws { layout = l } hunk ./LayoutChoice.hs 1 -{-# LANGUAGE GeneralizedNewtypeDeriving #-} ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.LayoutChoice --- Copyright : (c) David Roundy --- License : BSD-style (see xmonad/LICENSE) --- --- Maintainer : droundy@darcs.net --- Stability : unstable --- Portability : unportable --- --- A replacement for the default layout handling. --- ------------------------------------------------------------------------------ - -module XMonadContrib.LayoutChoice ( - -- * Usage: - -- $usage - layoutChoice - , ChangeLayout(..) - ) where - -import Data.List ( partition ) -import Data.Maybe ( fromMaybe ) -import XMonad -import Operations ( tall, UnDoLayout(..) ) - --- $usage --- You can use this module to replace the default layout handling of --- xmonad. See the docstring docs for example usage. - --- %import XMonadContrib.LayoutChoice --- %layout , layoutChoice [("full", full), --- %layout ("tall", tall 1 0.03 0.5)] - --- %keybind , ((modMask, xK_space), sendMessage NextLayout) --- %keybind , ((modMask .|. shiftMask, xK_space), sendMessage PrevLayout) --- %keybind , ((modMask, xK_f), sendMessage (JumpToLayout "full")) - -data ChangeLayout = NextLayout | PrevLayout | JumpToLayout String - deriving ( Eq, Show, Typeable ) -instance Message ChangeLayout - -layoutChoice :: [(String, Layout a)] -> Layout a -layoutChoice [] = tall 1 0.03 0.5 -layoutChoice ((n,l):ls) = Layout { doLayout = dolay - , modifyLayout = md } - where dolay r s = do (x,ml') <- doLayout l r s - return (x, (\l' -> layoutChoice ((n,l'):ls)) `fmap` ml') - md m | Just NextLayout <- fromMessage m = switchl rls - | Just PrevLayout <- fromMessage m = switchl rls' - | Just (JumpToLayout x) <- fromMessage m = switchl (j x) - | otherwise = do ml' <- modifyLayout l m - return $ (\l' -> layoutChoice ((n,l'):ls)) `fmap` ml' - - rls (x:xs) = xs ++ [x] - rls [] = [] - rls' = reverse . rls . reverse - j s zs = case partition (\z -> s == fst z) zs of - (xs,ys) -> xs++ys - switchl f = do ml' <- modifyLayout l (SomeMessage UnDoLayout) - return $ Just (layoutChoice $ f $ (n,fromMaybe l ml'):ls) rmfile ./LayoutChoice.hs hunk ./MetaModule.hs 44 -import XMonadContrib.LayoutChoice () hunk ./DynamicWorkspaces.hs 22 -import Control.Monad.State ( gets, modify ) +import Control.Monad.State ( gets ) hunk ./DynamicWorkspaces.hs 24 -import XMonad ( X, XState(..), Layout, WorkspaceId, trace ) +import XMonad ( X, XState(..), SomeLayout, WorkspaceId ) hunk ./DynamicWorkspaces.hs 27 -import Data.Map ( delete, insert ) hunk ./DynamicWorkspaces.hs 40 -addWorkspace :: [Layout Window] -> X () -addWorkspace (l:ls) = do s <- gets windowset - let newtag:_ = filter (not . (`tagMember` s)) allPossibleTags - modify $ \st -> st { layouts = insert newtag (l,ls) $ layouts st } - windows (addWorkspace' newtag) -addWorkspace [] = trace "bad layouts in XMonadContrib.DynamicWorkspaces.addWorkspace\n" +addWorkspace :: SomeLayout Window -> X () +addWorkspace l = do s <- gets windowset + let newtag:_ = filter (not . (`tagMember` s)) allPossibleTags + windows (addWorkspace' newtag l) hunk ./DynamicWorkspaces.hs 51 - modify $ \st -> st { layouts = delete (tag torem) $ layouts st } hunk ./DynamicWorkspaces.hs 54 -addWorkspace' :: i -> StackSet i a sid sd -> StackSet i a sid sd -addWorkspace' newtag s@(StackSet { current = scr@(Screen { workspace = w }) - , hidden = ws }) - = s { current = scr { workspace = Workspace newtag Nothing } +addWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd +addWorkspace' newtag l s@(StackSet { current = scr@(Screen { workspace = w }) + , hidden = ws }) + = s { current = scr { workspace = Workspace newtag l Nothing } hunk ./DynamicWorkspaces.hs 60 -removeWorkspace' :: (Eq i) => i -> StackSet i a sid sd -> StackSet i a sid sd +removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd hunk ./NewTabbed.hs 1 +{-# OPTIONS -fno-warn-orphans -fglasgow-exts #-} hunk ./NewTabbed.hs 99 - handleMessage l m = modLay l m + handleMessage l m = modLay l m hunk ./NewTabbed.hs 114 - Just ts -> if map snd (tabsWindows ts) == ws + Just ts -> if map snd (tabsWindows ts) == ws && scr ts == sc hunk ./NewTabbed.hs 118 - return (ts {tabsWindows = zip tws ws}) + return (ts {scr = sc, tabsWindows = zip tws ws}) hunk ./NewTabbed.hs 154 - let tabwin = (fst $ fromJust $ find (\x -> snd x == thisw) tws, thisw) + let tabwin = (fst $ fromJust $ find ((== thisw) . snd) tws, thisw) hunk ./MagicFocus.hs 14 -module XMonadContrib.MagicFocus ( - -- * Usage - -- $usage - magicFocus) where +module XMonadContrib.MagicFocus + (-- * Usage + -- $usage + MagicFocus(MagicFocus) + ) where hunk ./MagicFocus.hs 20 -import Graphics.X11.Xlib (Window) +import Graphics.X11.Xlib hunk ./MagicFocus.hs 26 --- > defaultLayouts = [ magicFocus tiled , magicFocus $ mirror tiled ] +-- > defaultLayouts = [ SomeLayout $ MagicFocus tiled , SomeLayout $ MagicFocus $ Mirror tiled ] hunk ./MagicFocus.hs 29 --- %layout , magicFocus tiled --- %layout , magicFocus $ mirror tiled +-- %layout , SomeLayout $ MagicFocus tiled +-- %layout , SomeLayout $ MagicFocus $ Mirror tiled hunk ./MagicFocus.hs 32 -magicFocus :: Layout Window -> Layout Window -magicFocus l = l { doLayout = \r s -> withWindowSet (return . peek) >>= (doLayout l) r . swap s - , modifyLayout = \x -> fmap magicFocus `fmap` modifyLayout l x } + +data MagicFocus l a = MagicFocus (l a) deriving ( Show , Read ) + +instance (Layout l Window) => Layout (MagicFocus l) Window where + doLayout = magicFocus + +magicFocus :: Layout l Window => MagicFocus l Window -> Rectangle + -> Stack Window -> X ([(Window, Rectangle)], Maybe (MagicFocus l Window)) +magicFocus (MagicFocus l) r s = + withWindowSet $ \wset -> do + (ws,nl) <- doLayout l r (swap s $ peek wset) + case nl of + Nothing -> return (ws, Nothing) + Just l' -> return (ws, Just $ MagicFocus l') hunk ./DragPane.hs 7 +-- Andrea Rossato hunk ./DragPane.hs 11 +-- Andrea Rossato hunk ./DragPane.hs 25 - dragPane, dragUpDownPane + DragPane (DragPane) + , DragType (..) hunk ./DragPane.hs 30 -import Graphics.X11.Xlib ( Rectangle( Rectangle ) ) +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras hunk ./DragPane.hs 33 -import XMonadContrib.Decoration ( newDecoration ) -import Operations ( Resize(..), splitHorizontallyBy, initColor, mouseDrag, sendMessage, mirrorRect ) -import StackSet ( focus, up, down) +import Data.Bits +import Data.Unique + +import Operations +import qualified StackSet as W hunk ./DragPane.hs 47 --- > dragPane "" (fromRational delta) (fromRational delta) +-- > DragPane Nothing Vertical 0.1 0.5 hunk ./DragPane.hs 55 -dragPane :: String -> Double -> Double -> Layout a -dragPane = dragPane' id +data DragPane a = + DragPane (Maybe (Window,Rectangle,Int)) DragType Double Double + deriving ( Show, Read ) hunk ./DragPane.hs 59 -dragUpDownPane :: String -> Double -> Double -> Layout a -dragUpDownPane = dragPane' mirrorRect +data DragType = Horizontal | Vertical deriving ( Show, Read ) hunk ./DragPane.hs 61 -dragPane' :: (Rectangle -> Rectangle) -> String -> Double -> Double -> Layout a -dragPane' mirror ident delta split = Layout { doLayout = dolay, modifyLayout = return . message } - where - dolay r s = do handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor - root <- asks theRoot - let r' = mirror r - (left', right') = splitHorizontallyBy split r' - leftmost = fromIntegral $ case r' of Rectangle x _ _ _ -> x - widt = fromIntegral $ case r' of Rectangle _ _ w _ -> w - left = case left' of Rectangle x y w h -> - mirror $ Rectangle x y (w-halfHandleWidth) h - right = case right' of - Rectangle x y w 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 - wrs = case reverse (up s) of - (master:_) -> [(master,left),(focus s,right)] - [] -> case down s of - (next:_) -> [(focus s,left),(next,right)] - [] -> [(focus s, r)] - handle = newDecoration root handr 0 handlec handlec - "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - (const $ const $ const $ const $ return ()) (doclick) - doclick = mouseDrag (\ex _ -> - sendMessage (SetFrac ident ((fromIntegral ex - leftmost)/widt))) - (return ()) - - ml' <- if length wrs > 1 then Just `fmap` handle (dragPane' mirror ident delta split) - else return Nothing - return (wrs, ml') - message x | Just Shrink <- fromMessage x = Just (dragPane' mirror ident delta (split - delta)) - | Just Expand <- fromMessage x = Just (dragPane' mirror ident delta (split + delta)) - | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = - Just (dragPane' mirror ident delta frac) - message _ = Nothing +instance Layout DragPane Window where + doLayout d@(DragPane _ ty _ _) = + case ty of + Vertical -> doLay id d + Horizontal -> doLay mirrorRect d + handleMessage = handleMess hunk ./DragPane.hs 68 -data SetFrac = SetFrac String Double deriving ( Show, Read, Eq, Typeable ) +data SetFrac = SetFrac Int Double deriving ( Show, Read, Eq, Typeable ) hunk ./DragPane.hs 71 +handleMess :: DragPane Window -> SomeMessage -> X (Maybe (DragPane Window)) +handleMess d@(DragPane mb@(Just (win,_,ident)) ty delta split) x + | Just e <- fromMessage x :: Maybe Event = do + handleEvent d e + return Nothing + | Just Hide <- fromMessage x = do + hideDragWin win + return $ Just (DragPane mb ty delta split) + | Just ReleaseResources <- fromMessage x = do + destroyDragWin win + return $ Just (DragPane Nothing ty delta split) + -- layout specific messages + | Just Shrink <- fromMessage x = return $ Just (DragPane mb ty delta (split - delta)) + | Just Expand <- fromMessage x = return $ Just (DragPane mb ty delta (split + delta)) + | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = do + return $ Just (DragPane mb ty delta frac) +handleMess _ _ = return Nothing + +handleEvent :: DragPane Window -> Event -> X () +handleEvent (DragPane (Just (win,r,ident)) ty _ _) + (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t }) + | t == buttonPress && thisw == win || thisbw == win = do + mouseDrag (\ex ey -> do + let frac = case ty of + Vertical -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r) + Horizontal -> (fromIntegral ey - (fromIntegral $ rect_y r))/(fromIntegral $ rect_height r) + sendMessage (SetFrac ident frac)) + (return ()) +handleEvent _ _ = return () + +doLay :: (Rectangle -> Rectangle) -> DragPane Window -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a)) +doLay mirror (DragPane mw ty delta split) r s = do + handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor + let r' = mirror r + (left', right') = splitHorizontallyBy split r' + left = case left' of Rectangle x y w h -> + mirror $ Rectangle x y (w-halfHandleWidth) h + right = case right' of + Rectangle x y w 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 + wrs = case reverse (W.up s) of + (master:_) -> [(master,left),(W.focus s,right)] + [] -> case W.down s of + (next:_) -> [(W.focus s,left),(next,right)] + [] -> [(W.focus s, r)] + if length wrs > 1 + then case mw of + Just (w,_,ident) -> do + w' <- updateDragWin w handlec handr + return (wrs, Just $ DragPane (Just (w',r',ident)) ty delta split) + Nothing -> do + w <- newDragWin handlec handr + i <- io $ newUnique + return (wrs, Just $ DragPane (Just (w,r',hashUnique i)) ty delta split) + else return (wrs, Nothing) + + +newDragWin :: Pixel -> Rectangle -> X Window +newDragWin p r = do + d <- asks display + dragWin d p r + +updateDragWin :: Window -> Pixel -> Rectangle -> X Window +updateDragWin w p r = do + d <- asks display + io $ destroyWindow d w + dragWin d p r + +hideDragWin :: Window -> X () +hideDragWin w = do + d <- asks display + io $ unmapWindow d w + +destroyDragWin :: Window -> X () +destroyDragWin w = do + d <- asks display + io $ destroyWindow d w + +dragWin :: Display -> Pixel -> Rectangle -> X Window +dragWin d p (Rectangle x y wt ht) = do + rt <- asks theRoot + w <- io $ createSimpleWindow d rt x y wt ht 0 p p + io $ selectInput d w $ exposureMask .|. buttonPressMask + io $ mapWindow d w + return w + hunk ./DragPane.hs 62 - doLayout d@(DragPane _ ty _ _) = - case ty of - Vertical -> doLay id d - Horizontal -> doLay mirrorRect d + doLayout d@(DragPane _ Vertical _ _) = doLay id d + doLayout d@(DragPane _ Horizontal _ _) = doLay mirrorRect d hunk ./DragPane.hs 25 - DragPane (DragPane) + dragPane hunk ./DragPane.hs 47 --- > DragPane Nothing Vertical 0.1 0.5 +-- > dragPane Vertical 0.1 0.5 hunk ./DragPane.hs 55 +dragPane :: DragType -> Double -> Double -> DragPane a +dragPane t x y = DragPane Nothing t x y + hunk ./DragPane.hs 74 - | Just e <- fromMessage x :: Maybe Event = do - handleEvent d e - return Nothing - | Just Hide <- fromMessage x = do - hideDragWin win - return $ Just (DragPane mb ty delta split) - | Just ReleaseResources <- fromMessage x = do - destroyDragWin win - return $ Just (DragPane Nothing ty delta split) + | Just e <- fromMessage x :: Maybe Event = do handleEvent d e + return Nothing + | Just Hide <- fromMessage x = do hideDragWin win + return $ Just (DragPane mb ty delta split) + | Just ReleaseResources <- fromMessage x = do destroyDragWin win + return $ Just (DragPane Nothing ty delta split) hunk ./NewTabbed.hs 19 - Tabbed (..) + tabbed hunk ./NewTabbed.hs 48 --- > ,("tabbed", SomeLayout $ Tabbed Nothing myTabConfig) +-- > ,("tabbed", SomeLayout $ tabbed myTabConfig) hunk ./NewTabbed.hs 64 +tabbed :: TConf -> Tabbed a +tabbed t = Tabbed INothin t + hunk ./NewTabbed.hs 94 - } deriving (Read, Show) + } hunk ./NewTabbed.hs 97 - Tabbed (Maybe TabState) TConf + Tabbed (InvisibleMaybe TabState) TConf hunk ./NewTabbed.hs 100 +data InvisibleMaybe a = INothin | IJus a +instance Show (InvisibleMaybe a) where show _ = "" +instance Read (InvisibleMaybe a) where readsPrec _ s = [(INothin, s)] +whenIJus :: Monad m => InvisibleMaybe a -> (a -> m ()) -> m () +whenIJus (IJus a) j = j a +whenIJus INothin _ = return () + hunk ./NewTabbed.hs 111 -instance Read FontStruct where - readsPrec _ _ = [] - -doLay :: Maybe TabState -> TConf -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed Window)) +doLay :: InvisibleMaybe TabState -> TConf -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed Window)) hunk ./NewTabbed.hs 113 - when (isJust mst) $ destroyTabs (map fst $ tabsWindows (fromJust mst)) + whenIJus mst $ \st -> destroyTabs (map fst $ tabsWindows st) hunk ./NewTabbed.hs 121 - Just ts -> if map snd (tabsWindows ts) == ws && scr ts == sc + Just ts -> if map snd (tabsWindows ts) == ws hunk ./NewTabbed.hs 128 - return ([(w,shrink conf sc)], Just (Tabbed (Just st) conf)) + return ([(w,shrink conf sc)], Just (Tabbed (IJus st) conf)) hunk ./NewTabbed.hs 131 -modLay (Tabbed mst conf) m - | Just st <- mst, Just e <- fromMessage m :: Maybe Event = do +modLay (Tabbed (IJus st) conf) m + | Just e <- fromMessage m :: Maybe Event = do hunk ./NewTabbed.hs 134 - | Just st <- mst, Just Hide == fromMessage m = do + | Just Hide == fromMessage m = do hunk ./NewTabbed.hs 137 - | Just st <- mst, Just ReleaseResources == fromMessage m = do + | Just ReleaseResources == fromMessage m = do hunk ./NewTabbed.hs 141 - return $ Just $ Tabbed Nothing conf - | otherwise = return Nothing + return $ Just $ Tabbed INothin conf +modLay _ _ = return Nothing hunk ./NewTabbed.hs 45 --- > defaultLayouts = [("tall", SomeLayout tiled) --- > ,("wide", SomeLayout $ Mirror tiled) +-- > defaultLayouts = [SomeLayout tiled +-- > ,SomeLayout $ Mirror tiled hunk ./NewTabbed.hs 48 --- > ,("tabbed", SomeLayout $ tabbed myTabConfig) +-- > ,SomeLayout $ tabbed defaultTConf) hunk ./NewTabbed.hs 53 --- > myconfig = defaultTConf { inactiveBorderColor = "#FF0000" --- > , activeTextColor = "#00FF00"} +-- > myTabConfig = defaultTConf { inactiveBorderColor = "#FF0000" +-- > , activeTextColor = "#00FF00"} hunk ./NewTabbed.hs 58 --- > defaultLayouts = [ tabbed shrinkText myconfig +-- > defaultLayouts = [ tabbed myTabConfig hunk ./NewTabbed.hs 62 --- %layout , tabbed shrinkText defaultTConf +-- %layout , tabbed defaultTConf hunk ./NewTabbed.hs 109 - handleMessage l m = modLay l m + handleMessage = handleMess + +instance Read FontStruct where + readsPrec _ _ = [] hunk ./NewTabbed.hs 123 - Nothing -> initState conf sc ws - Just ts -> if map snd (tabsWindows ts) == ws + INothin -> initState conf sc ws + IJus ts -> if map snd (tabsWindows ts) == ws && scr ts == sc hunk ./NewTabbed.hs 133 -modLay :: Tabbed Window -> SomeMessage -> X (Maybe (Tabbed Window)) -modLay (Tabbed (IJus st) conf) m - | Just e <- fromMessage m :: Maybe Event = do - handleEvent conf st e >> return Nothing - | Just Hide == fromMessage m = do - hideTabs $ map fst $ tabsWindows st - return Nothing - | Just ReleaseResources == fromMessage m = do - d <- asks display - destroyTabs $ map fst $ tabsWindows st - io $ freeFont d (fontS st) - return $ Just $ Tabbed INothin conf -modLay _ _ = return Nothing +handleMess :: Tabbed Window -> SomeMessage -> X (Maybe (Tabbed Window)) +handleMess (Tabbed (IJus st@(TabState {tabsWindows = tws})) conf) m + | Just e <- fromMessage m :: Maybe Event = handleEvent conf st e >> return Nothing + | Just Hide == fromMessage m = hideTabs (map fst tws) >> return Nothing + | Just ReleaseResources == fromMessage m = do d <- asks display + destroyTabs $ map fst tws + io $ freeFont d (fontS st) + return $ Just $ Tabbed INothin conf +handleMess _ _ = return Nothing hunk ./DragPane.hs 65 - doLayout d@(DragPane _ Vertical _ _) = doLay id d + doLayout d@(DragPane _ Vertical _ _) = doLay id d hunk ./DragPane.hs 136 - d <- asks display - io $ destroyWindow d w - dragWin d p r + d <- asks display + io $ destroyWindow d w + dragWin d p r hunk ./DragPane.hs 142 - d <- asks display - io $ unmapWindow d w + d <- asks display + io $ unmapWindow d w hunk ./DragPane.hs 147 - d <- asks display - io $ destroyWindow d w + d <- asks display + io $ destroyWindow d w hunk ./Decoration.hs 1 -{-# OPTIONS -fglasgow-exts #-} ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.Decoration --- Copyright : (c) David Roundy --- License : BSD-style (see LICENSE) --- --- Maintainer : David Roundy --- Stability : unstable --- Portability : unportable --- --- A module to be used to easily define decorations. --- ------------------------------------------------------------------------------ - -module XMonadContrib.Decoration ( - -- * Usage - -- $usage - newDecoration - ) where - -import Data.Bits ( (.|.) ) -import Control.Monad.Reader ( asks ) -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras ( Event(AnyEvent,ButtonEvent), ev_subwindow, ev_event_type, ev_window ) - -import XMonadContrib.LayoutHelpers ( ModLay, layoutModify, idModDo ) - -import XMonad -import Operations ( UnDoLayout(UnDoLayout) ) - --- $usage --- You can use this module for writing other extensions. --- See, for instance, "XMonadContrib.Tabbed" - -newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel -> String - -> (Display -> Window -> GC -> FontStruct -> X ()) - -> X () -> Layout a -> X (Layout a) -newDecoration decfor (Rectangle x y w h) th fg bg fn draw click l = do - d <- asks display - rt <- asks theRoot - win <- io $ createSimpleWindow d rt x y w h (fromIntegral th) fg bg - io $ selectInput d win $ exposureMask .|. buttonPressMask - io $ mapWindow d win - io $ restackWindows d $ decfor : [win] - - let hook :: SomeMessage -> X (Maybe (ModLay a)) - hook sm | Just e <- fromMessage sm = handle_event e >> return Nothing - | Just UnDoLayout == fromMessage sm = io (destroyWindow d win) >> return (Just id) - | otherwise = return Nothing - - handle_event (ButtonEvent {ev_subwindow = thisw,ev_event_type = t}) - | t == buttonPress && thisw == win = click - handle_event (ButtonEvent {ev_window = thisw,ev_event_type = t}) - | t == buttonPress && thisw == win = click - handle_event (AnyEvent {ev_window = thisw, ev_event_type = t}) - | thisw == win && t == expose = withGC win fn draw - | thisw == decfor && t == propertyNotify = withGC win fn draw - handle_event _ = return () - - return $ layoutModify idModDo hook l - --- FIXME: withGC should use bracket (but can't, unless draw is an IO thing) -withGC :: Drawable -> String -> (Display -> Drawable -> GC -> FontStruct -> X ()) -> X () -withGC w fn f = withDisplay $ \d -> do gc <- io $ createGC d w - let fontname = if fn == "" - then "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - else fn - font <- io $ catch (loadQueryFont d fontname) - (const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*") - io $ setFont d gc (fontFromFontStruct font) - f d w gc font - io $ freeGC d gc - io $ freeFont d font rmfile ./Decoration.hs hunk ./MetaModule.hs 29 -import XMonadContrib.Decoration () hunk ./MetaModule.hs 65 -import XMonadContrib.Tabbed () hunk ./Tabbed.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.Tabbed --- Copyright : (c) David Roundy --- License : BSD-style (see xmonad/LICENSE) --- --- Maintainer : email@address.com --- Stability : unstable --- Portability : unportable --- --- A tabbed layout for the Xmonad Window Manager --- ------------------------------------------------------------------------------ - -module XMonadContrib.Tabbed ( - -- * Usage: - -- $usage - tabbed - , Shrinker, shrinkText - , TConf (..), defaultTConf - ) where - -import Control.Monad.State ( gets ) - -import Graphics.X11.Xlib -import XMonad -import XMonadContrib.Decoration -import Operations ( focus, initColor ) -import qualified StackSet as W - -import XMonadContrib.NamedWindows -import XMonadContrib.SimpleStacking ( simpleStacking ) -import XMonadContrib.LayoutHelpers ( idModify ) - --- $usage --- You can use this module with the following in your configuration file: --- --- > import XMonadContrib.Tabbed --- --- > defaultLayouts :: [Layout Window] --- > defaultLayouts = [ tabbed shrinkText defaultTConf --- > , ... ] --- --- You can also edit the default configuration options. --- --- > myconfig = defaultTConf { inactiveBorderColor = "#FF0000" --- > , activeTextColor = "#00FF00"} --- --- and --- --- > defaultLayouts = [ tabbed shrinkText myconfig --- > , ... ] - --- %import XMonadContrib.Tabbed --- %layout , tabbed shrinkText defaultTConf - -data TConf = - TConf { activeColor :: String - , inactiveColor :: String - , activeBorderColor :: String - , inactiveTextColor :: String - , inactiveBorderColor :: String - , activeTextColor :: String - , fontName :: String - , tabSize :: Int - } deriving (Show, Read) - -defaultTConf :: TConf -defaultTConf = - TConf { activeColor ="#999999" - , inactiveColor = "#666666" - , activeBorderColor = "#FFFFFF" - , inactiveBorderColor = "#BBBBBB" - , activeTextColor = "#FFFFFF" - , inactiveTextColor = "#BFBFBF" - , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , tabSize = 20 - } - -tabbed :: Shrinker -> TConf -> Layout Window -tabbed s t = simpleStacking $ tabbed' s t - -tabbed' :: Shrinker -> TConf -> Layout Window -tabbed' shrinkT config = Layout { doLayout = dolay shrinkT config, modifyLayout = idModify } - -dolay :: Shrinker -> TConf - -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Layout Window)) -dolay _ _ sc (W.Stack w [] []) = return ([(w,sc)], Nothing) -dolay shr conf sc@(Rectangle x y wid _) s = withDisplay $ \dpy -> - do ac <- io $ initColor dpy $ activeColor conf - ic <- io $ initColor dpy $ inactiveColor conf - abc <- io $ initColor dpy $ activeBorderColor conf - ibc <- io $ initColor dpy $ inactiveBorderColor conf - atc <- io $ initColor dpy $ activeTextColor conf - itc <- io $ initColor dpy $ inactiveTextColor conf - let ws = W.integrate s - ts = gentabs conf x y wid (length ws) - tws = zip ts ws - focusColor w incol actcol = (maybe incol (\focusw -> if focusw == w - then actcol else incol) . W.peek) - `fmap` gets windowset - make_tabs [] l = return l - make_tabs (tw':tws') l = do bc <- focusColor (snd tw') ibc abc - l' <- maketab tw' bc l - make_tabs tws' l' - maketab (t,ow) bg = newDecoration ow t 1 bg ac - (fontName conf) (drawtab t ow) (focus ow) - drawtab r@(Rectangle _ _ wt ht) ow d w' gc fn = - do nw <- getName ow - (fc,tc) <- focusColor ow (ic,itc) (ac,atc) - io $ setForeground d gc fc - io $ fillRectangles d w' gc [Rectangle 0 0 wt ht] - io $ setForeground d gc tc - centerText d w' gc fn r (show nw) - centerText d w' gc fontst (Rectangle _ _ wt ht) name = - do let (_,asc,_,_) = textExtents fontst name - name' = shrinkWhile shr (\n -> textWidth fontst n > - fromIntegral wt - fromIntegral (ht `div` 2)) name - width = textWidth fontst name' - io $ drawString d w' gc - (fromIntegral (wt `div` 2) - fromIntegral (width `div` 2)) - ((fromIntegral ht + fromIntegral asc) `div` 2) name' - l' <- make_tabs tws $ tabbed shr conf - return (map (\w -> (w,shrink conf sc)) ws, Just l') - -type Shrinker = String -> [String] - -shrinkWhile :: Shrinker -> (String -> Bool) -> String -> String -shrinkWhile sh p x = sw $ sh x - where sw [n] = n - sw [] = "" - sw (n:ns) | p n = sw ns - | otherwise = n - -shrinkText :: Shrinker -shrinkText "" = [""] -shrinkText cs = cs : shrinkText (init cs) - -shrink :: TConf -> Rectangle -> Rectangle -shrink c (Rectangle x y w h) = Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c)) - -gentabs :: TConf -> Position -> Position -> Dimension -> Int -> [Rectangle] -gentabs _ _ _ _ 0 = [] -gentabs c x y w num = Rectangle x y (wid - 2) (fromIntegral (tabSize c) - 2) - : gentabs c (x + fromIntegral wid) y (w - wid) (num - 1) - where wid = w `div` (fromIntegral num) rmfile ./Tabbed.hs move ./NewTabbed.hs ./Tabbed.hs hunk ./MetaModule.hs 65 +import XMonadContrib.Tabbed () hunk ./Tabbed.hs 16 -module XMonadContrib.NewTabbed ( +module XMonadContrib.Tabbed ( hunk ./Tabbed.hs 42 --- > import XMonadContrib.NewTabbed +-- > import XMonadContrib.Tabbed hunk ./Tabbed.hs 61 --- %import XMonadContrib.NewTabbed +-- %import XMonadContrib.Tabbed hunk ./Tabbed.hs 5 --- Copyright : (c) David Roundy +-- Copyright : (c) 2007 David Roundy, Andrea Rossato hunk ./Tabbed.hs 8 --- Maintainer : email@address.com +-- Maintainer : droundy@darcs.net, andrea.rossato@unibz.it hunk ./Tabbed.hs 94 - } + } deriving ( Show , Read ) hunk ./Tabbed.hs 140 - return $ Just $ Tabbed INothin conf + return Nothing hunk ./LayoutHints.hs 17 + layoutHints, hunk ./LayoutHints.hs 35 +layoutHints :: (Layout l a) => l a -> ModifiedLayout LayoutHints l a +layoutHints = ModifiedLayout LayoutHints + hunk ./LayoutHints.hs 32 --- %layout , ModifiedLayout LayoutHints $ layoutHints tiled --- %layout , ModifiedLayout LayoutHints $ mirror tiled +-- %layout , layoutHints $ tiled +-- %layout , layoutHints $ mirror tiled hunk ./DynamicLog.hs 31 +import Operations () -- for ReadableSomeLayout instance hunk ./DynamicLog.hs 61 -dynamicLog = withWindowSet $ io . putStrLn . pprWindowSet +dynamicLog = withWindowSet $ \ws -> do + let desc = description . S.layout . S.workspace . S.current $ ws + io . putStrLn $ "(" ++ desc ++ ") " ++ pprWindowSet ws hunk ./Tabbed.hs 110 + description _ = "Tabbed" hunk ./LayoutModifier.hs 39 + modifierDescription :: m a -> String + modifierDescription = show hunk ./LayoutModifier.hs 56 + description (ModifiedLayout m l) = modifierDescription m ++ description l hunk ./LayoutHints.hs 46 + modifierDescription _ = "Hinted" hunk ./LayoutModifier.hs 56 - description (ModifiedLayout m l) = modifierDescription m ++ description l + description (ModifiedLayout m l) = modifierDescription m ++ " " ++ description l hunk ./DynamicLog.hs 31 +import {-# SOURCE #-} Config (workspaces) hunk ./DynamicLog.hs 37 +import Data.Monoid hunk ./DynamicLog.hs 68 -pprWindowSet s = concatMap fmt $ sortBy (comparing S.tag) +pprWindowSet s = concatMap fmt $ sortBy cmp hunk ./DynamicLog.hs 70 - where this = S.tag (S.workspace (S.current 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 workspaces . 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)) hunk ./LayoutModifier.hs 23 -import Operations ( LayoutMessages(Hide) ) +import Operations ( LayoutMessages(Hide, ReleaseResources) ) hunk ./LayoutModifier.hs 30 - modifyModify m mess | Just Hide <- fromMessage mess = do unhook m; return Nothing + modifyModify m mess | Just Hide <- fromMessage mess = doUnhook + | Just ReleaseResources <- fromMessage mess = doUnhook hunk ./LayoutModifier.hs 33 + where doUnhook = do unhook m; return Nothing hunk ./LayoutHints.hs 1 +{-# LANGUAGE FlexibleInstances #-} + hunk ./LayoutModifier.hs 1 +{-# LANGUAGE MultiParamTypeClasses #-} + hunk ./NoBorders.hs 1 +{-# LANGUAGE FlexibleInstances #-} + hunk ./NoBorders.hs 49 -data WithBorder a = WithBorder Dimension deriving ( Read, Show ) +-- todo, use an InvisibleList. +data WithBorder a = WithBorder Dimension [a] deriving ( Read, Show ) + +instance LayoutModifier WithBorder Window where + modifierDescription (WithBorder 0 _) = "NoBorders" + modifierDescription (WithBorder n _) = "Borders " ++ show n + + unhook (WithBorder _ s) = setBorders borderWidth s hunk ./NoBorders.hs 58 -instance LayoutModifier WithBorder a where - hook (WithBorder b) = setborders b - unhook (WithBorder _) = setborders borderWidth + redoLayout (WithBorder n s) _ stack wrs = do + setBorders borderWidth s + setBorders n ws + return (wrs, Just $ WithBorder n ws) + where + ws = map fst wrs hunk ./NoBorders.hs 65 -noBorders :: Layout l a => l a -> ModifiedLayout WithBorder l a -noBorders = ModifiedLayout (WithBorder 0) +noBorders :: Layout l Window => l Window -> ModifiedLayout WithBorder l Window +noBorders = ModifiedLayout $ WithBorder 0 [] hunk ./NoBorders.hs 69 -withBorder b = ModifiedLayout (WithBorder b) +withBorder b = ModifiedLayout $ WithBorder b [] hunk ./NoBorders.hs 71 -setborders :: Dimension -> X () -setborders bw = withDisplay $ \d -> - do ws <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset) - mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws +setBorders :: Dimension -> [Window] -> X () +setBorders bw ws = withDisplay $ \d -> mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws hunk ./SetLayout.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.SetLayout --- Copyright : (c) David Roundy --- License : BSD3-style (see LICENSE) --- --- Maintainer : David Roundy --- Stability : unstable --- Portability : unportable --- --- Provides bindings to cycle through non-empty workspaces. --- ------------------------------------------------------------------------------ - -module XMonadContrib.SetLayout ( - -- * Usage - -- $usage - setLayout - ) where - -import Graphics.X11.Xlib ( Window ) -import XMonad -import StackSet hiding (filter) -import Operations - --- $usage --- You can use this module with the following in your Config.hs file: --- --- > import XMonadContrib.SetLayout --- --- > , ((modMask .|. shiftMask, xK_space ), setLayout $ SomeLayout $ LayoutSelection defaultLayouts) -- %! Reset this layout - --- %import XMonadContrib.SetLayout --- %keybind , ((modMask .|. shiftMask, xK_space ), setLayout $ SomeLayout $ LayoutSelection defaultLayouts) -- %! Reset this layout - -setLayout :: SomeLayout Window -> X () -setLayout l = do sendMessage ReleaseResources - windows $ \s -> s { current = r $ current s } - where r scr = scr { workspace = r' $ workspace scr } - r' ws = ws { layout = l } rmfile ./SetLayout.hs hunk ./Accordion.hs 1 +{-# LANGUAGE FlexibleInstances #-} + hunk ./Circle.hs 1 +{-# LANGUAGE FlexibleInstances #-} hunk ./Combo.hs 1 -{-# OPTIONS -fallow-undecidable-instances #-} +{-# OPTIONS_GHC -fallow-undecidable-instances #-} +{-# LANGUAGE FlexibleInstances #-} + hunk ./DragPane.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE FlexibleInstances #-} + hunk ./FlexibleManipulate.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE FlexibleInstances #-} hunk ./FloatKeys.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} hunk ./FloatKeys.hs 89 - nx :: Rational = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w - ny :: Rational = fromIntegral (ay * h + nh * (fromIntegral y - ay)) / fromIntegral h + nx :: Rational + nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w + ny :: Rational + ny = fromIntegral (ay * h + nh * (fromIntegral y - ay)) / fromIntegral h hunk ./LayoutScreens.hs 1 +{-# LANGUAGE FlexibleInstances #-} + hunk ./MagicFocus.hs 1 +{-# LANGUAGE FlexibleInstances #-} + hunk ./Roledex.hs 1 +{-# LANGUAGE FlexibleInstances #-} + hunk ./Tabbed.hs 1 -{-# OPTIONS -fno-warn-orphans -fglasgow-exts #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances #-} hunk ./ThreeColumns.hs 1 +{-# LANGUAGE FlexibleInstances #-} + hunk ./TwoPane.hs 1 +{-# LANGUAGE FlexibleInstances #-} + hunk ./WorkspaceDir.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE FlexibleInstances #-} + hunk ./XPrompt.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE ExistentialQuantification #-} + hunk ./DeManage.hs 1 -{-# OPTIONS -fglasgow-exts #-} hunk ./Tabbed.hs 95 - } deriving ( Show , Read ) + } hunk ./Tabbed.hs 142 - return Nothing + return $ Just $ Tabbed INothin conf hunk ./MetaModule.hs 72 +import XMonadContrib.WindowNavigation () addfile ./WindowNavigation.hs hunk ./WindowNavigation.hs 1 +{-# OPTIONS -fglasgow-exts #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.WorkspaceDir +-- Copyright : (c) 2007 David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- WindowNavigation is an extension to allow easy navigation of a workspace. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.WindowNavigation ( + -- * Usage + -- $usage + windowNavigation, + Navigate(..), Direction(..) + ) where + +import Graphics.X11.Xlib ( Rectangle(..), Window, setWindowBorder ) +import Control.Monad.Reader ( asks ) +import Data.List ( nub, sortBy, (\\) ) +import XMonad +import qualified StackSet as W +import Operations ( focus, initColor ) +import XMonadContrib.LayoutModifier + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.WindowNavigation +-- > +-- > defaultLayout = SomeLayout $ windowNavigation $ LayoutSelection ... +-- +-- In keybindings: +-- +-- > , ((modMask, xK_Right), sendMessage $ Go R) +-- > , ((modMask, xK_Left), sendMessage $ Go L) +-- > , ((modMask, xK_Up), sendMessage $ Go U) +-- > , ((modMask, xK_Down), sendMessage $ Go D) + +-- %import XMonadContrib.WindowNavigation +-- %keybind , ((modMask, xK_Right), sendMessage $ Go R) +-- %keybind , ((modMask, xK_Left), sendMessage $ Go L) +-- %keybind , ((modMask, xK_Up), sendMessage $ Go U) +-- %keybind , ((modMask, xK_Down), sendMessage $ Go D) +-- %layout -- include 'windowNavigation' in defaultLayout definition above. +-- %layout -- just before the list, like the following (don't uncomment next line): +-- %layout -- defaultLayout = SomeLayout $ windowNavigation $ ... + + +data Navigate = Go Direction deriving ( Read, Show, Typeable ) +data Direction = U | D | R | L deriving ( Read, Show, Eq ) +instance Message Navigate + +data InvisibleMaybe a = INothin | IJus a +instance Show (InvisibleMaybe a) where show _ = "" +instance Read (InvisibleMaybe a) where readsPrec _ s = [(INothin, s)] + +data NavigationState a = NS Point [(a,Rectangle)] + +data WindowNavigation a = WindowNavigation (InvisibleMaybe (NavigationState a)) deriving ( Read, Show ) + +windowNavigation = ModifiedLayout (WindowNavigation INothin) + +instance LayoutModifier WindowNavigation Window where + redoLayout (WindowNavigation state) rscr s wrs = + do dpy <- asks display + --navigableColor <- io $ (Just `fmap` initColor dpy "#0000FF") `catch` \_ -> return Nothing + --otherColor <- io $ (Just `fmap` initColor dpy "#000000") `catch` \_ -> return Nothing + let sc mc win = case mc of + Just c -> io $ setWindowBorder dpy win c + Nothing -> return () + w = W.focus s + r = case filter ((==w).fst) wrs of ((_,x):_) -> x + [] -> rscr + pt = case state of IJus (NS ptold _) | ptold `inrect` r -> ptold + _ -> center r + wrs' = filter ((/=w) . fst) wrs + wnavigable = nub $ map fst $ concatMap (\d -> filter (inr d pt . snd) wrs') [U,D,R,L] + wothers = map fst wrs' \\ wnavigable + --mapM_ (sc navigableColor) wnavigable + --mapM_ (sc otherColor) wothers + return (wrs, Just $ WindowNavigation $ IJus $ NS pt wrs') + modifyModify (WindowNavigation (IJus (NS pt wrs))) m + | Just (Go d) <- fromMessage m = case sortby d $ filter (inr d pt . snd) wrs of + [] -> return Nothing + ((w,r):_) -> do focus w + return $ Just $ WindowNavigation $ IJus $ NS (centerd d pt r) [] + modifyModify _ _ = return Nothing + +center (Rectangle x y w h) = P (fromIntegral x + fromIntegral w/2) (fromIntegral y + fromIntegral h/2) +centerd d (P xx yy) (Rectangle x y w h) | d == U || d == D = P xx (fromIntegral y + fromIntegral h/2) + | otherwise = P (fromIntegral x + fromIntegral w/2) yy +inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && + y < fromIntegral yr + fromIntegral h +inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && + y > fromIntegral yr +inr R (P a x) (Rectangle b l _ w) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && + a < fromIntegral b +inr L (P a x) (Rectangle b l c w) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && + a > fromIntegral b + fromIntegral c +inrect (P x y) (Rectangle a b w h) = x > fromIntegral a && x < fromIntegral a + fromIntegral w && + y > fromIntegral b && y < fromIntegral b + fromIntegral h + +sortby U = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y' y) +sortby D = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y y') +sortby R = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x x') +sortby L = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x' x) + +data Point = P Double Double hunk ./Tabbed.hs 39 +import XMonadContrib.Invisible hunk ./Tabbed.hs 67 -tabbed t = Tabbed INothin t +tabbed t = Tabbed (I Nothing) t hunk ./Tabbed.hs 99 - Tabbed (InvisibleMaybe TabState) TConf + Tabbed (Invisible Maybe TabState) TConf hunk ./Tabbed.hs 102 -data InvisibleMaybe a = INothin | IJus a -instance Show (InvisibleMaybe a) where show _ = "" -instance Read (InvisibleMaybe a) where readsPrec _ s = [(INothin, s)] -whenIJus :: Monad m => InvisibleMaybe a -> (a -> m ()) -> m () -whenIJus (IJus a) j = j a -whenIJus INothin _ = return () - hunk ./Tabbed.hs 110 -doLay :: InvisibleMaybe TabState -> TConf -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed Window)) +doLay :: Invisible Maybe TabState -> TConf -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed Window)) hunk ./Tabbed.hs 112 - whenIJus mst $ \st -> destroyTabs (map fst $ tabsWindows st) + whenIJust mst $ \st -> destroyTabs (map fst $ tabsWindows st) hunk ./Tabbed.hs 119 - INothin -> initState conf sc ws - IJus ts -> if map snd (tabsWindows ts) == ws && scr ts == sc - then return ts - else do destroyTabs (map fst $ tabsWindows ts) - tws <- createTabs conf sc ws - return (ts {scr = sc, tabsWindows = zip tws ws}) + (I Nothing) -> initState conf sc ws + (I (Just ts)) -> if map snd (tabsWindows ts) == ws && scr ts == sc + then return ts + else do destroyTabs (map fst $ tabsWindows ts) + tws <- createTabs conf sc ws + return (ts {scr = sc, tabsWindows = zip tws ws}) hunk ./Tabbed.hs 127 - return ([(w,shrink conf sc)], Just (Tabbed (IJus st) conf)) + return ([(w,shrink conf sc)], Just (Tabbed (I (Just st)) conf)) hunk ./Tabbed.hs 130 -handleMess (Tabbed (IJus st@(TabState {tabsWindows = tws})) conf) m +handleMess (Tabbed (I (Just st@(TabState {tabsWindows = tws}))) conf) m hunk ./Tabbed.hs 136 - return $ Just $ Tabbed INothin conf + return $ Just $ Tabbed (I Nothing) conf hunk ./DragPane.hs 39 +import XMonadContrib.Invisible hunk ./DragPane.hs 58 -dragPane t x y = DragPane Nothing t x y +dragPane t x y = DragPane (I Nothing) t x y hunk ./DragPane.hs 61 - DragPane (Maybe (Window,Rectangle,Int)) DragType Double Double + DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double hunk ./DragPane.hs 75 -handleMess d@(DragPane mb@(Just (win,_,ident)) ty delta split) x +handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x hunk ./DragPane.hs 81 - return $ Just (DragPane Nothing ty delta split) + return $ Just (DragPane (I Nothing) ty delta split) hunk ./DragPane.hs 90 -handleEvent (DragPane (Just (win,r,ident)) ty _ _) +handleEvent (DragPane (I (Just (win,r,ident))) ty _ _) hunk ./DragPane.hs 121 - Just (w,_,ident) -> do + I (Just (w,_,ident)) -> do hunk ./DragPane.hs 123 - return (wrs, Just $ DragPane (Just (w',r',ident)) ty delta split) - Nothing -> do + return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split) + I Nothing -> do hunk ./DragPane.hs 127 - return (wrs, Just $ DragPane (Just (w,r',hashUnique i)) ty delta split) + return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split) hunk ./WindowNavigation.hs 30 +import XMonadContrib.Invisible hunk ./WindowNavigation.hs 60 -data InvisibleMaybe a = INothin | IJus a -instance Show (InvisibleMaybe a) where show _ = "" -instance Read (InvisibleMaybe a) where readsPrec _ s = [(INothin, s)] - hunk ./WindowNavigation.hs 62 -data WindowNavigation a = WindowNavigation (InvisibleMaybe (NavigationState a)) deriving ( Read, Show ) +data WindowNavigation a = WindowNavigation (Invisible Maybe (NavigationState a)) deriving ( Read, Show ) hunk ./WindowNavigation.hs 64 -windowNavigation = ModifiedLayout (WindowNavigation INothin) +windowNavigation = ModifiedLayout (WindowNavigation (I Nothing)) hunk ./WindowNavigation.hs 77 - pt = case state of IJus (NS ptold _) | ptold `inrect` r -> ptold + pt = case state of I (Just (NS ptold _)) | ptold `inrect` r -> ptold hunk ./WindowNavigation.hs 84 - return (wrs, Just $ WindowNavigation $ IJus $ NS pt wrs') - modifyModify (WindowNavigation (IJus (NS pt wrs))) m + return (wrs, Just $ WindowNavigation $ I $ Just $ NS pt wrs') + modifyModify (WindowNavigation (I (Just (NS pt wrs)))) m hunk ./WindowNavigation.hs 89 - return $ Just $ WindowNavigation $ IJus $ NS (centerd d pt r) [] + return $ Just $ WindowNavigation $ I $ Just $ NS (centerd d pt r) [] hunk ./WindowNavigation.hs 95 -inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && - y < fromIntegral yr + fromIntegral h -inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && - y > fromIntegral yr -inr R (P a x) (Rectangle b l _ w) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && - a < fromIntegral b -inr L (P a x) (Rectangle b l c w) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && - a > fromIntegral b + fromIntegral c -inrect (P x y) (Rectangle a b w h) = x > fromIntegral a && x < fromIntegral a + fromIntegral w && - y > fromIntegral b && y < fromIntegral b + fromIntegral h +inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && + y < fromIntegral yr + fromIntegral h +inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && + y > fromIntegral yr +inr R (P a x) (Rectangle b l _ w) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && + a < fromIntegral b +inr L (P a x) (Rectangle b l c w) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && + a > fromIntegral b + fromIntegral c +inrect (P x y) (Rectangle a b w h) = x > fromIntegral a && x < fromIntegral a + fromIntegral w && + y > fromIntegral b && y < fromIntegral b + fromIntegral h addfile ./Invisible.hs hunk ./Invisible.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Invisible +-- Copyright : (c) 2007 Andrea Rossato, David Roundy +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it, droundy@darcs.net +-- Stability : unstable +-- Portability : unportable +-- +-- A data type to store the layout state +-- +----------------------------------------------------------------------------- + +module XMonadContrib.Invisible ( + -- * Usage: + -- $usage + Invisible (..) + , whenIJust + ) where + +-- $usage +-- A data type to store the layout state + +data Invisible m a = I (m a) + +instance (Functor m, Monad m) => Read (Invisible m a) where + readsPrec _ s = [(fail "Read Invisible", s)] + +instance Monad m => Show (Invisible m a) where + show _ = "" + +instance (Functor m, Monad m) => Monad (Invisible m) where + return a = I (return a) + m >>= f = m >>= f + +instance (Functor m, Monad m) => Functor (Invisible m) where + fmap f (I x) = I (fmap f x) + +whenIJust :: (Monad m) => Invisible Maybe a -> (a -> m ()) -> m () +whenIJust (I (Just x)) f = f x +whenIJust (I Nothing) _ = return () hunk ./Tabbed.hs 111 -doLay mst _ sc (W.Stack w [] []) = do +doLay mst c sc (W.Stack w [] []) = do hunk ./Tabbed.hs 113 - return ([(w,sc)], Nothing) + return ([(w,sc)], Just $ Tabbed (I Nothing) c) hunk ./Tabbed.hs 119 - (I Nothing) -> initState conf sc ws + (I Nothing ) -> initState conf sc ws hunk ./Invisible.hs 36 + fail s = I (fail s) hunk ./NoBorders.hs 24 + smartBorders, hunk ./NoBorders.hs 75 +data SmartBorder a = SmartBorder [a] deriving (Read, Show) + +instance LayoutModifier SmartBorder Window where + modifierDescription _ = "SmartBorder" + + unhook (SmartBorder s) = setBorders borderWidth s + + redoLayout (SmartBorder s) _ stack wrs = do + ss <- gets (W.screens . windowset) + setBorders borderWidth s + + if singleton ws && singleton ss + then do setBorders 0 ws; return (wrs, Just $ SmartBorder ws) + else return (wrs, Just $ SmartBorder []) + where + ws = map fst wrs + singleton = null . drop 1 + +smartBorders = ModifiedLayout (SmartBorder []) + hunk ./WindowNavigation.hs 24 -import Control.Monad.Reader ( asks ) +import Control.Monad.Reader ( ask, asks ) hunk ./WindowNavigation.hs 28 -import Operations ( focus, initColor ) +import Operations ( focus, initColor, LayoutMessages(..) ) hunk ./WindowNavigation.hs 67 - redoLayout (WindowNavigation state) rscr s wrs = - do dpy <- asks display - --navigableColor <- io $ (Just `fmap` initColor dpy "#0000FF") `catch` \_ -> return Nothing - --otherColor <- io $ (Just `fmap` initColor dpy "#000000") `catch` \_ -> return Nothing - let sc mc win = case mc of - Just c -> io $ setWindowBorder dpy win c - Nothing -> return () - w = W.focus s + redoLayout (WindowNavigation (I state)) rscr s wrs = + do XConf { display = dpy, normalBorder = nbc } <- ask + navigableColor <- io $ (Just `fmap` initColor dpy "#0000FF") `catch` \_ -> return Nothing + --uc <- io $ (Just `fmap` initColor dpy "#0000FF") `catch` \_ -> return Nothing + --dc <- io $ (Just `fmap` initColor dpy "#00FFFF") `catch` \_ -> return Nothing + --lc <- io $ (Just `fmap` initColor dpy "#FF0000") `catch` \_ -> return Nothing + --rc <- io $ (Just `fmap` initColor dpy "#FF00FF") `catch` \_ -> return Nothing + --let dirc U = uc + -- dirc D = dc + -- dirc L = lc + -- dirc R = rc + let w = W.focus s hunk ./WindowNavigation.hs 81 - pt = case state of I (Just (NS ptold _)) | ptold `inrect` r -> ptold + pt = case state of Just (NS ptold _) | ptold `inrect` r -> ptold hunk ./WindowNavigation.hs 84 - wnavigable = nub $ map fst $ concatMap (\d -> filter (inr d pt . snd) wrs') [U,D,R,L] - wothers = map fst wrs' \\ wnavigable - --mapM_ (sc navigableColor) wnavigable - --mapM_ (sc otherColor) wothers - return (wrs, Just $ WindowNavigation $ I $ Just $ NS pt wrs') - modifyModify (WindowNavigation (I (Just (NS pt wrs)))) m - | Just (Go d) <- fromMessage m = case sortby d $ filter (inr d pt . snd) wrs of - [] -> return Nothing - ((w,r):_) -> do focus w - return $ Just $ WindowNavigation $ I $ Just $ NS (centerd d pt r) [] + wnavigable = nub $ concatMap + (\d -> truncHead $ sortby d $ filter (inr d pt . snd) wrs') [U,D,R,L] + --wnavigablec = nub $ concatMap + -- (\d -> map (\(w,_) -> (w,dirc d)) $ + -- truncHead $ sortby d $ filter (inr d pt . snd) wrs') [U,D,R,L] + wothers = case state of Just (NS _ wo) -> map fst wo + _ -> [] + mapM_ (sc (Just nbc)) (wothers \\ map fst wnavigable) + mapM_ (sc navigableColor) $ map fst wnavigable + --mapM_ (\(w,c) -> sc c w) wnavigablec + return (wrs, Just $ WindowNavigation $ I $ Just $ NS pt wnavigable) + + modifyModify (WindowNavigation (I (Just (NS pt wrs)))) m + | Just (Go d) <- fromMessage m = + case sortby d $ filter (inr d pt . snd) wrs of + [] -> return Nothing + ((w,r):_) -> do focus w + return $ Just $ WindowNavigation $ I $ Just $ + NS (centerd d pt r) wrs + | Just Hide <- fromMessage m = + do XConf { display = dpy, normalBorder = nbc } <- ask + mapM_ (sc (Just nbc) . fst) wrs + return $ Just $ WindowNavigation $ I $ Just $ NS pt [] + | Just ReleaseResources <- fromMessage m = + modifyModify (WindowNavigation (I $ Just (NS pt wrs))) (SomeMessage Hide) hunk ./WindowNavigation.hs 111 +truncHead (x:_) = [x] +truncHead [] = [] + +sc mc win = do dpy <- asks display + case mc of Just c -> io $ setWindowBorder dpy win c + Nothing -> return () + hunk ./WindowNavigation.hs 121 -inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && - y < fromIntegral yr + fromIntegral h -inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && - y > fromIntegral yr -inr R (P a x) (Rectangle b l _ w) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && - a < fromIntegral b -inr L (P a x) (Rectangle b l c w) = x >= fromIntegral l && x <= fromIntegral l + fromIntegral w && - a > fromIntegral b + fromIntegral c -inrect (P x y) (Rectangle a b w h) = x > fromIntegral a && x < fromIntegral a + fromIntegral w && - y > fromIntegral b && y < fromIntegral b + fromIntegral h +inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + y < fromIntegral yr + fromIntegral h +inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + y > fromIntegral yr +inr R (P a x) (Rectangle b l _ w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + a < fromIntegral b +inr L (P a x) (Rectangle b l c w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + a > fromIntegral b + fromIntegral c +inrect (P x y) (Rectangle a b w h) = x > fromIntegral a && x < fromIntegral a + fromIntegral w && + y > fromIntegral b && y < fromIntegral b + fromIntegral h addfile ./XUtils.hs hunk ./XUtils.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.XUtils +-- Copyright : (c) 2007 Andrea Rossato +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A module for painting on the screem +-- +----------------------------------------------------------------------------- + +module XMonadContrib.XUtils ( + -- * Usage: + -- $usage + stringToPixel + , initFont + , createNewWindow + , showWindow + , hideWindow + , deleteWindow + , paintWindow + , paintAndWrite + ) where + + +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +import Control.Monad.Reader +import Data.Maybe +import XMonad +import Operations + +-- $usage +-- See Tabbed or DragPane for usage examples + +-- | Get the Pixel value for a named color: if an invalid name is +-- given the black pixel will be returned. +stringToPixel :: String -> X Pixel +stringToPixel s = do + d <- asks display + return =<< io $ catch (getIt d) (fallBack d) + where getIt d = initColor d s + fallBack d = const $ return $ blackPixel d (defaultScreen d) + +-- | Given a fontname returns the fonstructure. If the font name is +-- not valid the default font will be loaded and returned. +initFont :: String -> X FontStruct +initFont s = do + d <- asks display + return =<< io $ catch (getIt d) (fallBack d) + where getIt d = loadQueryFont d s + fallBack d = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + +-- | 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 -> X Window +createNewWindow (Rectangle x y w h) m = do + d <- asks display + rw <- asks theRoot + win <- io $ createSimpleWindow d rw x y w h 0 0 0 + case m of + Just em -> io $ selectInput d win em + Nothing -> io $ selectInput d win exposureMask + return win + +-- | Map a window +showWindow :: Window -> X () +showWindow w = do + d <- asks display + io $ mapWindow d w + +-- | unmap a window +hideWindow :: Window -> X () +hideWindow w = do + d <- asks display + io $ unmapWindow d w + +-- | destroy a window +deleteWindow :: Window -> X () +deleteWindow w = do + d <- asks display + io $ destroyWindow d w + +-- | Fill a window with a rectangle and a border +paintWindow :: Window -- ^ The window where to draw + -> Dimension -- ^ Window width + -> Dimension -- ^ Window height + -> Dimension -- ^ Border width + -> String -- ^ Window background color + -> String -- ^ Border color + -> X () +paintWindow w wh ht bw c bc = + 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 + -> FontStruct -- ^ The FontStruct + -> Dimension -- ^ Window width + -> Dimension -- ^ Window height + -> Dimension -- ^ Border width + -> String -- ^ Window background color + -> String -- ^ Border color + -> Position -- ^ String x position + -> Position -- ^ String y position + -> String -- ^ String color + -> String -- ^ String background color + -> String -- ^ String to be printed + -> X () +paintAndWrite w fs wh ht bw bc borc x y ffc fbc str = + paintWindow' w (Rectangle x y wh ht) bw bc borc (Just (fs,ffc,fbc,str)) + +-- This stuf is not exported + +paintWindow' :: Window -> Rectangle -> Dimension -> String -> String -> Maybe (FontStruct,String,String,String) -> X () +paintWindow' win (Rectangle x y wh ht) bw color b_color str = do + d <- asks display + p <- io $ createPixmap d win wh ht (defaultDepthOfScreen $ defaultScreenOfDisplay d) + gc <- io $ createGC d p + let fi = fromIntegral + -- draw + io $ setGraphicsExposures d gc False + [c',bc'] <- mapM stringToPixel [color,b_color] + -- we start with the border + io $ setForeground d gc bc' + io $ fillRectangle d p gc 0 0 wh ht + -- and now again + io $ setForeground d gc c' + io $ fillRectangle d p gc (fi bw) (fi bw) ((wh - (bw * 2))) (ht - (bw * 2)) + when (isJust str) $ do + let (fs,fc,bc,s) = fromJust str + io $ setFont d gc $ fontFromFontStruct fs + printString d p gc fc bc x y s + -- copy the pixmap over the wind + io $ copyArea d p win gc 0 0 wh ht 0 0 + -- free the pixmap and GC + io $ freePixmap d p + io $ freeGC d gc + +-- | Prints a string on a 'Drawable' +printString :: Display -> Drawable -> GC -> String -> String + -> Position -> Position -> String -> X () +printString d drw gc fc bc x y s = do + [fc',bc'] <- mapM stringToPixel [fc,bc] + io $ setForeground d gc fc' + io $ setBackground d gc bc' + io $ drawImageString d drw gc x y s hunk ./Tabbed.hs 38 -import XMonadContrib.XPrompt (fillDrawable, printString) hunk ./Tabbed.hs 39 +import XMonadContrib.XUtils hunk ./Tabbed.hs 112 - whenIJust mst $ \st -> destroyTabs (map fst $ tabsWindows st) + whenIJust mst $ \st -> mapM_ deleteWindow (map fst $ tabsWindows st) hunk ./Tabbed.hs 122 - else do destroyTabs (map fst $ tabsWindows ts) + else do mapM_ deleteWindow (map fst $ tabsWindows ts) hunk ./Tabbed.hs 125 - showTabs $ map fst $ tabsWindows st + mapM_ showWindow $ map fst $ tabsWindows st hunk ./Tabbed.hs 131 - | Just e <- fromMessage m :: Maybe Event = handleEvent conf st e >> return Nothing - | Just Hide == fromMessage m = hideTabs (map fst tws) >> return Nothing + | Just e <- fromMessage m :: Maybe Event = handleEvent conf st e >> return Nothing + | Just Hide == fromMessage m = mapM_ hideWindow (map fst tws) >> return Nothing hunk ./Tabbed.hs 134 - destroyTabs $ map fst tws + mapM_ deleteWindow $ map fst tws hunk ./Tabbed.hs 163 -initState conf sc ws = withDisplay $ \ d -> do - fs <- io $ loadQueryFont d (fontName conf) `catch` - \_-> loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" +initState conf sc ws = do + fs <- initFont (fontName conf) hunk ./Tabbed.hs 171 - let wid = wh `div` (fromIntegral $ length owl) + let wid = wh `div` (fromIntegral $ length owl) + height = fromIntegral $ tabSize c + mask = Just (exposureMask .|. buttonPressMask) hunk ./Tabbed.hs 175 - rt <- asks theRoot - w <- io $ createSimpleWindow d rt x y wid (fromIntegral $ tabSize c) 0 0 0 - io $ selectInput d w $ exposureMask .|. buttonPressMask + w <- createNewWindow (Rectangle x y wid height) mask hunk ./Tabbed.hs 182 - xc <- ask hunk ./Tabbed.hs 184 - d = display xc hunk ./Tabbed.hs 190 - - -- initialize colors - bc <- io $ initColor d bc' - borderc <- io $ initColor d borderc' - tc <- io $ initColor d tc' - -- pixmax and graphic context - p <- io $ createPixmap d tabw wh ht (defaultDepthOfScreen $ defaultScreenOfDisplay d) - gc <- io $ createGC d p - -- draw - io $ setGraphicsExposures d gc False - io $ fillDrawable d p gc borderc bc 1 wh ht - io $ setFont d gc (fontFromFontStruct fs) hunk ./Tabbed.hs 196 - io $ printString d p gc tc bc x y name - io $ copyArea d p tabw gc 0 0 wh ht 0 0 - io $ freePixmap d p - io $ freeGC d gc - -destroyTabs :: [Window] -> X () -destroyTabs w = do - d <- asks display - io $ mapM_ (destroyWindow d) w - -hideTabs :: [Window] -> X () -hideTabs w = do - d <- asks display - io $ mapM_ (unmapWindow d) w - -showTabs :: [Window] -> X () -showTabs w = do - d <- asks display - io $ mapM_ (mapWindow d) w + paintAndWrite tabw fs wh ht 1 bc' borderc' x y tc' bc' name hunk ./DragPane.hs 30 -import Control.Monad.Reader ( asks ) hunk ./DragPane.hs 39 +import XMonadContrib.XUtils hunk ./DragPane.hs 78 - | Just Hide <- fromMessage x = do hideDragWin win + | Just Hide <- fromMessage x = do hideWindow win hunk ./DragPane.hs 80 - | Just ReleaseResources <- fromMessage x = do destroyDragWin win + | Just ReleaseResources <- fromMessage x = do deleteWindow win hunk ./DragPane.hs 103 - handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor hunk ./DragPane.hs 121 - w' <- updateDragWin w handlec handr + w' <- deleteWindow w >> newDragWin handr hunk ./DragPane.hs 124 - w <- newDragWin handlec handr + w <- newDragWin handr hunk ./DragPane.hs 130 -newDragWin :: Pixel -> Rectangle -> X Window -newDragWin p r = do - d <- asks display - dragWin d p r - -updateDragWin :: Window -> Pixel -> Rectangle -> X Window -updateDragWin w p r = do - d <- asks display - io $ destroyWindow d w - dragWin d p r - -hideDragWin :: Window -> X () -hideDragWin w = do - d <- asks display - io $ unmapWindow d w - -destroyDragWin :: Window -> X () -destroyDragWin w = do - d <- asks display - io $ destroyWindow d w - -dragWin :: Display -> Pixel -> Rectangle -> X Window -dragWin d p (Rectangle x y wt ht) = do - rt <- asks theRoot - w <- io $ createSimpleWindow d rt x y wt ht 0 p p - io $ selectInput d w $ exposureMask .|. buttonPressMask - io $ mapWindow d w - return w +newDragWin :: Rectangle -> X Window +newDragWin r@(Rectangle _ _ wh ht) = do + let mask = Just $ exposureMask .|. buttonPressMask + w <- createNewWindow r mask + paintWindow w wh ht 0 handleColor handleColor + showWindow w + return w hunk ./XUtils.hs 11 --- A module for painting on the screem +-- A module for painting on the screen hunk ./XUtils.hs 25 + , Align (..) + , stringPosition hunk ./XUtils.hs 47 - return =<< io $ catch (getIt d) (fallBack d) + io $ catch (getIt d) (fallBack d) hunk ./XUtils.hs 56 - return =<< io $ catch (getIt d) (fallBack d) + io $ catch (getIt d) (fallBack d) hunk ./XUtils.hs 102 +-- | String position +data Align = AlignCenter | AlignRight | AlignLeft + +-- | Return the string x and y 'Position' in a 'Rectangle', given a +-- 'FontStruct' and the 'Align'ment +stringPosition :: FontStruct -> Rectangle -> Align -> String -> (Position,Position) +stringPosition fs (Rectangle _ _ w h) al s = (x',y') + where width = textWidth fs s + (_,a,d,_) = textExtents fs s + y' = fi $ ((h - fi (a + d)) `div` 2) + fi a + x' = case al of + AlignCenter -> fi (w `div` 2) - fi (width `div` 2) + AlignLeft -> 1 + AlignRight -> fi (w - (fi width + 1)) + hunk ./XUtils.hs 125 - -> Position -- ^ String x position - -> Position -- ^ String y position hunk ./XUtils.hs 127 + -> Align -- ^ String 'Align'ment hunk ./XUtils.hs 130 -paintAndWrite w fs wh ht bw bc borc x y ffc fbc str = - paintWindow' w (Rectangle x y wh ht) bw bc borc (Just (fs,ffc,fbc,str)) +paintAndWrite w fs wh ht bw bc borc ffc fbc al str = + paintWindow' w r bw bc borc ms + where ms = Just (fs,ffc,fbc,str) + r = Rectangle x y wh ht + (x,y) = stringPosition fs (Rectangle 0 0 wh ht) al str hunk ./XUtils.hs 143 - let fi = fromIntegral hunk ./XUtils.hs 156 - -- copy the pixmap over the wind + -- copy the pixmap over the window hunk ./XUtils.hs 171 +-- | Short-hand for 'fromIntegral' +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral + hunk ./Tabbed.hs 192 - width = textWidth fs name - (_,asc,desc,_) = textExtents fs name - y = fromIntegral $ ((ht - fromIntegral (asc + desc)) `div` 2) + fromIntegral asc - x = fromIntegral (wh `div` 2) - fromIntegral (width `div` 2) - paintAndWrite tabw fs wh ht 1 bc' borderc' x y tc' bc' name + paintAndWrite tabw fs wh ht 1 bc' borderc' tc' bc' AlignCenter name hunk ./Tabbed.hs 1 -{-# OPTIONS_GHC -fno-warn-orphans #-} hunk ./Tabbed.hs 20 + , shrinkText hunk ./Tabbed.hs 66 -tabbed :: TConf -> Tabbed a -tabbed t = Tabbed (I Nothing) t +tabbed :: Shrinker -> TConf -> Tabbed a +tabbed s t = Tabbed (I Nothing) (I (Just s)) t hunk ./Tabbed.hs 99 - Tabbed (Invisible Maybe TabState) TConf + Tabbed (Invisible Maybe TabState) (Invisible Maybe Shrinker) TConf hunk ./Tabbed.hs 103 - doLayout (Tabbed mst conf) = doLay mst conf - handleMessage = handleMess - description _ = "Tabbed" + doLayout (Tabbed ist ishr conf) = doLay ist ishr conf + handleMessage = handleMess + description _ = "Tabbed" hunk ./Tabbed.hs 107 -instance Read FontStruct where - readsPrec _ _ = [] - -doLay :: Invisible Maybe TabState -> TConf -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed Window)) -doLay mst c sc (W.Stack w [] []) = do - whenIJust mst $ \st -> mapM_ deleteWindow (map fst $ tabsWindows st) - return ([(w,sc)], Just $ Tabbed (I Nothing) c) -doLay mst conf sc@(Rectangle _ _ wid _) s@(W.Stack w _ _) = do +doLay :: Invisible Maybe TabState -> Invisible Maybe Shrinker -> TConf + -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed Window)) +doLay ist ishr c sc (W.Stack w [] []) = do + whenIJust ist $ \st -> mapM_ deleteWindow (map fst $ tabsWindows st) + return ([(w,sc)], Just $ Tabbed (I Nothing) ishr c) +doLay ist ishr conf sc@(Rectangle _ _ wid _) s@(W.Stack w _ _) = do hunk ./Tabbed.hs 116 - st <- case mst of + st <- case ist of hunk ./Tabbed.hs 124 - mapM_ (updateTab conf (fontS st) width) $ tabsWindows st - return ([(w,shrink conf sc)], Just (Tabbed (I (Just st)) conf)) + mapM_ (updateTab ishr conf (fontS st) width) $ tabsWindows st + return ([(w,shrink conf sc)], Just (Tabbed (I (Just st)) ishr conf)) hunk ./Tabbed.hs 128 -handleMess (Tabbed (I (Just st@(TabState {tabsWindows = tws}))) conf) m - | Just e <- fromMessage m :: Maybe Event = handleEvent conf st e >> return Nothing +handleMess (Tabbed (I (Just st@(TabState {tabsWindows = tws}))) ishr conf) m + | Just e <- fromMessage m :: Maybe Event = handleEvent ishr conf st e >> return Nothing hunk ./Tabbed.hs 134 - return $ Just $ Tabbed (I Nothing) conf + return $ Just $ Tabbed (I Nothing) (I Nothing) conf hunk ./Tabbed.hs 137 -handleEvent :: TConf -> TabState -> Event -> X () +handleEvent :: Invisible Maybe Shrinker -> TConf -> TabState -> Event -> X () hunk ./Tabbed.hs 139 -handleEvent conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) hunk ./Tabbed.hs 143 - updateTab conf fs width (thisw, fromJust $ lookup thisw tws) + updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws) hunk ./Tabbed.hs 147 -handleEvent conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) hunk ./Tabbed.hs 151 - updateTab conf fs width (thisw, fromJust $ lookup thisw tws) + updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws) hunk ./Tabbed.hs 155 - updateTab conf fs width tabwin + updateTab ishr conf fs width tabwin hunk ./Tabbed.hs 158 -handleEvent _ _ _ = return () +handleEvent _ _ _ _ = return () hunk ./Tabbed.hs 178 -updateTab :: TConf -> FontStruct -> Dimension -> (Window,Window) -> X () -updateTab c fs wh (tabw,ow) = do +updateTab :: Invisible Maybe Shrinker -> TConf -> FontStruct -> Dimension -> (Window,Window) -> X () +updateTab ishr c fs wh (tabw,ow) = do hunk ./Tabbed.hs 188 - let name = shrinkWhile shrinkText (\n -> textWidth fs n > - fromIntegral wh - fromIntegral (ht `div` 2)) (show nw) + let s = fromIMaybe shrinkText ishr + name = shrinkWhile s (\n -> textWidth fs n > + fromIntegral wh - fromIntegral (ht `div` 2)) (show nw) hunk ./Tabbed.hs 210 +fromIMaybe :: a -> Invisible Maybe a -> a +fromIMaybe _ (I (Just x)) = x +fromIMaybe a (I Nothing) = a + hunk ./Invisible.hs 20 + , fromIMaybe hunk ./Invisible.hs 46 +fromIMaybe :: a -> Invisible Maybe a -> a +fromIMaybe _ (I (Just x)) = x +fromIMaybe a (I Nothing) = a + hunk ./Tabbed.hs 140 - (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t }) + (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t }) hunk ./Tabbed.hs 148 - (AnyEvent {ev_window = thisw, ev_event_type = t }) + (AnyEvent {ev_window = thisw, ev_event_type = t }) hunk ./Tabbed.hs 210 -fromIMaybe :: a -> Invisible Maybe a -> a -fromIMaybe _ (I (Just x)) = x -fromIMaybe a (I Nothing) = a - hunk ./Commands.hs 32 -import {-# SOURCE #-} Config (workspaces) +import {-# SOURCE #-} Config (workspaces,possibleLayouts) hunk ./Commands.hs 80 - ++ [ ("shrink", sendMessage Shrink) - , ("expand", sendMessage Expand) - , ("restart-wm", restart Nothing True) - , ("restart-wm-no-resume", restart Nothing False) - , ("layout", sendMessage NextLayout) - , ("xterm", spawn "xterm") - , ("run", spawn "exe=`dmenu_path | dmenu -b` && exec $exe") - , ("kill", kill) - , ("refresh", refresh) - , ("focus-up", windows $ focusUp) - , ("focus-down", windows $ focusDown) - , ("swap-up", windows $ swapUp) - , ("swap-down", windows $ swapDown) - , ("swap-master", windows $ swapMaster) - , ("sink", withFocused $ windows . sink) - , ("quit-wm", io $ exitWith ExitSuccess) + ++ [ ("shrink" , sendMessage Shrink ) + , ("expand" , sendMessage Expand ) + , ("next-layout" , sendMessage NextLayout ) + , ("previous-layout" , sendMessage PrevLayout ) + , ("default-layout" , setLayout (head possibleLayouts) ) + , ("restart-wm" , sr >> restart Nothing True ) + , ("restart-wm-no-resume", sr >> restart Nothing False ) + , ("xterm" , spawn "xterm" ) + , ("run" , spawn "exe=`dmenu_path | dmenu -b` && exec $exe" ) + , ("kill" , kill ) + , ("refresh" , refresh ) + , ("focus-up" , windows $ focusUp ) + , ("focus-down" , windows $ focusDown ) + , ("swap-up" , windows $ swapUp ) + , ("swap-down" , windows $ swapDown ) + , ("swap-master" , windows $ swapMaster ) + , ("sink" , withFocused $ windows . sink ) + , ("quit-wm" , io $ exitWith ExitSuccess ) hunk ./Commands.hs 99 + where sr = broadcastMessage ReleaseResources addfile ./ResizableTile.hs hunk ./ResizableTile.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.ResizableTile +-- Copyright : (c) MATSUYAMA Tomohiro +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : MATSUYAMA Tomohiro +-- Stability : unstable +-- Portability : unportable +-- +-- More useful tiled layout that allows you to change a width/height of window. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.ResizableTile (Tall(..), MirrorResize(..)) where + +import XMonad +import Operations (Resize(..), IncMasterN(..)) +import qualified StackSet as W +import Graphics.X11.Xlib +import Control.Monad.State +import Control.Monad + +-- $usage +-- +-- To use, modify your Config.hs to: +-- +-- > import XMonadContrib.ResizableTile as T +-- +-- and add a keybinding: +-- +-- > , ((modMask, xK_a ), sendMessage MirrorShrink) +-- > , ((modMask, xK_z ), sendMessage MirrorExpand) +-- +-- and redefine "tiled" as: +-- +-- > tiled = T.Tall nmaster delta ratio (repeat 1) + +data MirrorResize = MirrorShrink | MirrorExpand deriving Typeable +instance Message MirrorResize + +data Tall a = Tall Int Rational Rational [Rational] deriving (Show, Read) +instance Layout Tall a where + doLayout (Tall nmaster _ frac mfrac) r = + return . (\x->(x,Nothing)) . + ap zip (tile frac mfrac r nmaster . length) . W.integrate + handleMessage (Tall 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 = Tall nmaster delta (max 0 $ frac-delta) mfrac + resize Expand = Tall nmaster delta (min 1 $ frac+delta) mfrac + mresize MirrorShrink s = mresize' s delta + mresize MirrorExpand s = mresize' s (0-delta) + mresize' s d = let n = length $ W.up s + total = n + (length $ W.down s) + 1 + in Tall nmaster delta frac + (modifymfrac mfrac d (if n == (nmaster-1) || n == (total-1) + then n-1 + else n)) + modifymfrac [] _ _ = [] + modifymfrac (f:fx) d n | n == 0 = f+d : fx + | otherwise = f : modifymfrac fx d (n-1) + incmastern (IncMasterN d) = Tall (max 0 (nmaster+d)) delta frac mfrac + description _ = "ResizableTall" + +tile :: Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle] +tile f mf r nmaster n = if n <= nmaster || nmaster == 0 + then splitVertically mf n r + else splitVertically mf nmaster r1 ++ splitVertically (drop nmaster mf) (n-nmaster) r2 -- two columns + where (r1,r2) = splitHorizontallyBy f r + +splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle] +splitVertically [] _ r = [r] +splitVertically _ n r | n < 2 = [r] +splitVertically (f:fx) n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh : + splitVertically fx (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh)) + where smallh = floor $ fromIntegral (sh `div` fromIntegral n) * f --hmm, this is a fold or map. + +splitHorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle) +splitHorizontallyBy f (Rectangle sx sy sw sh) = + ( Rectangle sx sy leftw sh + , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh) + where leftw = floor $ fromIntegral sw * f hunk ./Tabbed.hs 50 --- > ,SomeLayout $ tabbed defaultTConf) +-- > ,SomeLayout $ tabbed shrinkText defaultTConf) hunk ./Tabbed.hs 60 --- > defaultLayouts = [ tabbed myTabConfig --- > , ... ] +-- > defaultLayouts = [ ... +-- > , tabbed shrinkText myTabConfig ] hunk ./Tabbed.hs 64 --- %layout , tabbed defaultTConf +-- %layout , tabbed shrinkText defaultTConf hunk ./Invisible.hs 1 +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + hunk ./Invisible.hs 28 -data Invisible m a = I (m a) +newtype Invisible m a = I (m a) deriving (Monad, Functor) hunk ./Invisible.hs 36 -instance (Functor m, Monad m) => Monad (Invisible m) where - return a = I (return a) - m >>= f = m >>= f - fail s = I (fail s) - -instance (Functor m, Monad m) => Functor (Invisible m) where - fmap f (I x) = I (fmap f x) - hunk ./ResizableTile.hs 37 --- > tiled = T.Tall nmaster delta ratio (repeat 1) +-- > tiled = T.Tall nmaster delta ratio [] hunk ./ResizableTile.hs 46 - ap zip (tile frac mfrac r nmaster . length) . W.integrate + ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate hunk ./ResizableTile.hs 60 - in Tall nmaster delta frac - (modifymfrac mfrac d (if n == (nmaster-1) || n == (total-1) - then n-1 - else n)) + pos = if n == (nmaster-1) || n == (total-1) then n-1 else n + mfrac' = modifymfrac (mfrac ++ repeat 1) d pos + in Tall nmaster delta frac $ take total mfrac' hunk ./MetaModule.hs 49 +import XMonadContrib.MosaicAlt () addfile ./MosaicAlt.hs hunk ./MosaicAlt.hs 1 +{-# OPTIONS -fglasgow-exts #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.MosaicAlt +-- Copyright : (c) 2007 James Webb +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : xmonad#jwebb,sygneca,com +-- Stability : unstable +-- Portability : unportable +-- +-- A layout which gives each window a specified amount of screen space +-- relative to the others. Compared to the 'Mosaic' layout, this one +-- divides the space in a more balanced way. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.MosaicAlt ( + -- * Usage: + -- $usage + MosaicAlt(..) + , shrinkWindowAlt + , expandWindowAlt + , resetAlt + ) where + +import XMonad +import Operations +import Graphics.X11.Xlib +import qualified StackSet as W +import qualified Data.Map as M +import Data.List ( sortBy ) +import Data.Ratio +import Graphics.X11.Types ( Window ) + +-- $usage +-- You can use this module with the following in your configuration file: +-- +-- > import XMonadContrib.MosaicAlt +-- +-- > defaultLayouts = ... +-- > , SomeLayout $ MosaicAlt M.empty +-- > ... +-- +-- > keys = ... +-- > , ((modMask .|. shiftMask, xK_a), withFocused (sendMessage . expandWindowAlt)) +-- > , ((modMask .|. shiftMask, xK_z), withFocused (sendMessage . shrinkWindowAlt)) +-- > , ((modMask .|. controlMask, xK_space), sendMessage resetAlt) +-- > ... + +-- %import XMonadContrib.MosaicAlt +-- %layout , SomeLayout $ MosaicAlt M.empty + +data HandleWindowAlt = + ShrinkWindowAlt Window + | ExpandWindowAlt Window + | ResetAlt + deriving ( Typeable, Eq ) +instance Message HandleWindowAlt +shrinkWindowAlt, expandWindowAlt :: Window -> HandleWindowAlt +shrinkWindowAlt = ShrinkWindowAlt +expandWindowAlt = ExpandWindowAlt +resetAlt :: HandleWindowAlt +resetAlt = ResetAlt + +type Areas = M.Map Window Rational +data MosaicAlt a = MosaicAlt Areas deriving ( Show, Read ) + +instance Layout MosaicAlt Window where + description _ = "MosaicAlt" + doLayout (MosaicAlt areas) rect stack = + return (arrange rect stack areas', Just $ MosaicAlt areas') + where + areas' = ins (W.up stack) $ ins (W.down stack) $ ins [W.focus stack] areas + ins wins as = foldl M.union as $ map (`M.singleton` 1) wins + + handleMessage (MosaicAlt areas) msg = return $ case fromMessage msg of + Just (ShrinkWindowAlt w) -> Just $ MosaicAlt $ alter areas w (4 % 5) + Just (ExpandWindowAlt w) -> Just $ MosaicAlt $ alter areas w (6 % 5) + Just ResetAlt -> Just $ MosaicAlt M.empty + _ -> Nothing + +-- Layout algorithm entry point. +arrange :: Rectangle -> W.Stack Window -> Areas -> [(Window, Rectangle)] +arrange rect stack areas = tree rect (sortBy areaCompare winList) totalArea areas + where + winList = reverse (W.up stack) ++ W.focus stack : W.down stack + totalArea = areaSum areas winList + areaCompare a b = or1 b `compare` or1 a + or1 w = maybe 1 id $ M.lookup w areas + +-- Selects a horizontal or vertical split to get the best aspect ratio. +-- FIXME: Give the user more dynamic control. +splitBest :: Rational -> Rectangle -> (Rectangle, Rectangle) +splitBest ratio rect = + if (w % h) < cutoff then splitVerticallyBy ratio rect + else splitHorizontallyBy ratio rect + where + -- Prefer wide windows to tall ones, mainly because it makes xterms more usable. + cutoff = if w > 1000 then 1.25 + else if w < 500 then 2.25 + else 2.25 - (w - 500) % 500 + w = rect_width rect + h = rect_height rect + +-- Recursively group windows into a binary tree. Aim to balance the tree +-- according to the total requested area in each branch. +tree :: Rectangle -> [Window] -> Rational -> Areas -> [(Window, Rectangle)] +tree rect winList totalArea areas = case winList of + [] -> [] + [x] -> [(x, rect)] + _ -> tree aRect aWins aArea areas ++ tree bRect bWins bArea areas + where + (aRect, bRect) = splitBest (aArea / (aArea + bArea)) rect + ((aWins, aArea), (bWins, bArea)) = areaSplit areas winList totalArea + +-- Sum the requested areas of a bunch of windows. +areaSum :: Areas -> [Window] -> Rational +areaSum areas = sum . map (maybe 1 id . flip M.lookup areas) + +-- Split a list of windows in half by area. +areaSplit :: Areas -> [Window] -> Rational -> (([Window], Rational), ([Window], Rational)) +areaSplit areas wins totalArea = ((reverse aWins, aArea), (bWins, bArea)) + where + ((aWins, aArea), (bWins, bArea)) = gather [] wins 0 + gather a b t = if t >= (totalArea / 2) then ((a, t), (b, totalArea - t)) + else gather (head b : a) (tail b) (t + or1 (head b)) + or1 w = maybe 1 id $ M.lookup w areas + +-- Change requested area for a window. +alter :: Areas -> Window -> Rational -> Areas +alter areas win delta = case M.lookup win areas of + Just v -> M.insert win (v * delta) areas + Nothing -> M.insert win delta areas + +-- vim: sw=4:et hunk ./XUtils.hs 20 + , releaseFont hunk ./XUtils.hs 61 +releaseFont :: FontStruct -> X () +releaseFont fs = do + d <- asks display + io $ freeFont d fs + hunk ./XUtils.hs 114 -stringPosition fs (Rectangle _ _ w h) al s = (x',y') +stringPosition fs (Rectangle _ _ w h) al s = (x,y) hunk ./XUtils.hs 117 - y' = fi $ ((h - fi (a + d)) `div` 2) + fi a - x' = case al of + y = fi $ ((h - fi (a + d)) `div` 2) + fi a + x = case al of hunk ./Tabbed.hs 131 - | Just ReleaseResources == fromMessage m = do d <- asks display - mapM_ deleteWindow $ map fst tws - io $ freeFont d (fontS st) + | Just ReleaseResources == fromMessage m = do mapM_ deleteWindow $ map fst tws + releaseFont (fontS st) hunk ./MetaModule.hs 59 -import XMonadContrib.SimpleStacking () hunk ./SimpleStacking.hs 1 -{-# OPTIONS -fglasgow-exts #-} ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.SimpleStacking --- Copyright : (c) David Roundy --- License : BSD-style (see LICENSE) --- --- Maintainer : David Roundy --- Stability : unstable --- Portability : unportable --- --- A module to be used to obtain a simple "memory" of stacking order. --- ------------------------------------------------------------------------------ - -module XMonadContrib.SimpleStacking ( - -- * Usage - -- $usage - simpleStacking - ) where - -import Data.Maybe ( catMaybes ) - -import Data.List ( nub, lookup ) -import StackSet ( focus, up, down ) -import Graphics.X11.Xlib ( Window ) - -import XMonad -import XMonadContrib.LayoutHelpers - --- $usage --- You can use this module for --- See, for instance, "XMonadContrib.Tabbed" - -simpleStacking :: Layout Window -> Layout Window -simpleStacking = simpleStacking' [] - -simpleStacking' :: [Window] -> Layout Window -> Layout Window -simpleStacking' st = layoutModify dl idModMod - where dl _ s wrs = let m = map (\ (w,rr) -> (w,(w,rr))) wrs - wrs' = catMaybes $ map ((flip lookup) m) $ - nub (focus s : st ++ map fst wrs) - st' = focus s:filter (`elem` (up s++down s)) st - in return (wrs', Just (simpleStacking' st')) rmfile ./SimpleStacking.hs replace ./Accordion.hs [A-Za-z_0-9] Layout LayoutClass replace ./Circle.hs [A-Za-z_0-9] Layout LayoutClass replace ./Combo.hs [A-Za-z_0-9] Layout LayoutClass replace ./Combo.hs [A-Za-z_0-9] ReadableSomeLayout ReadableLayout replace ./Combo.hs [A-Za-z_0-9] SomeLayout Layout replace ./DragPane.hs [A-Za-z_0-9] Layout LayoutClass replace ./DynamicWorkspaces.hs [A-Za-z_0-9] SomeLayout Layout replace ./LayoutHints.hs [A-Za-z_0-9] Layout LayoutClass replace ./LayoutModifier.hs [A-Za-z_0-9] Layout LayoutClass replace ./LayoutModifier.hs [A-Za-z_0-9] modifyModify handleMess replace ./LayoutScreens.hs [A-Za-z_0-9] Layout LayoutClass replace ./MagicFocus.hs [A-Za-z_0-9] Layout LayoutClass replace ./NoBorders.hs [A-Za-z_0-9] Layout LayoutClass replace ./Roledex.hs [A-Za-z_0-9] Layout LayoutClass replace ./Spiral.hs [A-Za-z_0-9] Layout LayoutClass replace ./Square.hs [A-Za-z_0-9] Layout LayoutClass replace ./Tabbed.hs [A-Za-z_0-9] Layout LayoutClass replace ./ThreeColumns.hs [A-Za-z_0-9] Layout LayoutClass replace ./TwoPane.hs [A-Za-z_0-9] Layout LayoutClass replace ./WindowNavigation.hs [A-Za-z_0-9] modifyModify handleMess hunk ./WorkspaceDir.hs 64 - Just (WorkspaceDir wd) + Just (WorkspaceDir wd) replace ./WorkspaceDir.hs [A-Za-z_0-9] Layout LayoutClass replace ./WorkspaceDir.hs [A-Za-z_0-9] modifyModify handleMess hunk ./Spiral.hs 28 - -import XMonadContrib.LayoutHelpers +import StackSet ( integrate ) hunk ./Spiral.hs 35 --- > defaultLayouts = [ full, spiral (1 % 1), ... ] +-- > defaultLayouts = [ ..., Layout $ spiral (1 % 1), ... ] hunk ./Spiral.hs 38 --- %layout , spiral (1 % 1) +-- %layout , Layout $ spiral (1 % 1) hunk ./Spiral.hs 47 -data Rotation = CW | CCW -data Direction = East | South | West | North deriving (Eq, Enum) +data Rotation = CW | CCW deriving (Read, Show) +data Direction = East | South | West | North deriving (Eq, Enum, Read, Show) hunk ./Spiral.hs 57 -spiral :: Rational -> LayoutClass a +spiral :: Rational -> SpiralWithDir a hunk ./Spiral.hs 60 -spiralWithDir :: Direction -> Rotation -> Rational -> LayoutClass a -spiralWithDir dir rot scale = LayoutClass { doLayout = l2lModDo fibLayout, - modifyLayout = \m -> return $ fmap resize $ fromMessage m } - where - fibLayout sc ws = zip ws rects - where ratios = blend scale . reverse . take (length ws - 1) . mkRatios $ tail fibs - rects = divideRects (zip ratios dirs) sc - dirs = dropWhile (/= dir) $ case rot of - CW -> cycle [East .. North] - CCW -> cycle [North, West, South, East] - resize Expand = spiralWithDir dir rot $ (21 % 20) * scale - resize Shrink = spiralWithDir dir rot $ (20 % 21) * scale +spiralWithDir :: Direction -> Rotation -> Rational -> SpiralWithDir a +spiralWithDir = SpiralWithDir + +data SpiralWithDir a = SpiralWithDir Direction Rotation Rational + deriving ( Read, Show ) + +instance LayoutClass SpiralWithDir a where + pureLayout (SpiralWithDir dir rot scale) sc stack = zip ws rects + where ws = integrate stack + ratios = blend scale . reverse . take (length ws - 1) . mkRatios $ tail fibs + rects = divideRects (zip ratios dirs) sc + dirs = dropWhile (/= dir) $ case rot of + CW -> cycle [East .. North] + CCW -> cycle [North, West, South, East] + handleMessage (SpiralWithDir dir rot scale) = return . fmap resize . fromMessage + where resize Expand = spiralWithDir dir rot $ (21 % 20) * scale + resize Shrink = spiralWithDir dir rot $ (20 % 21) * scale addfile ./XPropManage.hs hunk ./XPropManage.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.XPropManage +-- Copyright : (c) Karsten Schoelzel +-- License : BSD +-- +-- Maintainer : Karsten Schoelzel +-- Stability : unstable +-- Portability : unportable +-- +-- A ManageHook matching on XProperties. +----------------------------------------------------------------------------- + +module XMonadContrib.XPropManage ( + -- * Usage + -- $usage + xPropManageHook, XPropMatch, pmX, pmP + ) where + +import Data.Char (chr) +import Data.List (concat) + +import Control.Monad.State +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +import XMonad + +-- $usage +-- +-- Add something like the following lines to Config.hs to use this module +-- > import XMonadContrib.XPropManage +-- +-- > manageHook = xPropManageHook xPropMatches +-- > +-- > xPropMatches :: [XPropMatch] +-- > xPropMatches = [ ([ (wM_CLASS, any ("gimp"==)))], (\w -> float w >> return (W.shift "2"))) +-- > , ([ (wM_COMMAND, any ("screen" ==)), (wM_CLASS, any ("xterm" ==))], pmX (addTag "screen")) +-- > , ([ (wM_NAME, any ("Iceweasel" `isInfixOf`))], pmP (W.shift "3")) +-- > ] +-- +-- Properties known to work: wM_CLASS, wM_NAME, wM_COMMAND +-- +-- A XPropMatch consists of a list of conditions and function telling what to do. +-- +-- The list entries are pairs of an XProperty to match on (like wM_CLASS, wM_NAME)^1, +-- and an function which matches onto the value of the property (represented as a List +-- of Strings). +-- +-- If a match succeeds the function is called immediately, can perform any action and then return +-- a function to apply in 'windows' (see Operations.hs). So if the action does only work on the +-- WindowSet use just 'pmP function'. +-- +-- *1 You can get the available properties of an application with the xprop utility. STRING properties +-- should work fine. Others might not work. +-- + +type XPropMatch = ([(Atom, [String] -> Bool)], (Window -> X (WindowSet -> WindowSet))) + +pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet) +pmX f w = f w >> return id + +pmP :: (WindowSet -> WindowSet) -> Window -> X (WindowSet -> WindowSet) +pmP f _ = return f + +xPropManageHook :: [XPropMatch] -> Window -> X (WindowSet -> WindowSet) +xPropManageHook tms w = withDisplay $ \d -> do + fs <- mapM (matchProp d w `uncurry`) tms + return (foldr (.) id fs) + +matchProp :: Display -> Window -> [(Atom, [String] -> Bool)] -> (Window -> X (WindowSet -> WindowSet)) -> X (WindowSet -> WindowSet) +matchProp d w tm tf = do + m <- and `liftM` sequence (map (\(k,f) -> f `liftM` getProp d w k) tm) + case m of + True -> tf w + False -> return id + +getProp :: Display -> Window -> Atom -> X ([String]) +getProp d w p = do + prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\_ -> return [[]]) + let filt q | q == wM_COMMAND = concat . map splitAtNull + | otherwise = id + return (filt p prop) + +splitAtNull :: String -> [String] +splitAtNull s = case dropWhile (== (chr 0)) s of + "" -> [] + s' -> w : splitAtNull s'' + where (w, s'') = break (== (chr 0)) s' + addfile ./TagWindows.hs hunk ./TagWindows.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.TagWindows +-- Copyright : (c) Karsten Schoelzel +-- License : BSD +-- +-- Maintainer : Karsten Schoelzel +-- Stability : unstable +-- Portability : unportable +-- +-- Functions for tagging windows and selecting them by tags. +----------------------------------------------------------------------------- + +module XMonadContrib.TagWindows ( + -- * Usage + -- $usage + addTag, delTag, unTag, + setTags, getTags, + withTaggedP, withTaggedGlobalP, withFocusedP, + withTagged , withTaggedGlobal , + focusUpTagged, focusUpTaggedGlobal, + focusDownTagged, focusDownTaggedGlobal, + shiftHere, shiftToScreen, + tagPrompt, + tagDelPrompt + ) where + +import Data.List (nub,concat,sortBy) + +import Control.Monad.State +import StackSet hiding (filter) +import Operations (windows, withFocused) + +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +import XMonadContrib.XPrompt +import XMonad + +-- $usage +-- +-- To use window tags add in your Config.hs: +-- +-- > import XMonadContrib.TagWindows +-- > import XMonadContrib.XPrompt -- to use tagPrompt +-- +-- and add keybindings like as follows: +-- , ((modMask, xK_f ), withFocused (addTag "abc")) +-- , ((modMask .|. controlMask, xK_f ), withFocused (delTag "abc")) +-- , ((modMask .|. shiftMask, xK_f ), withTaggedGlobal "abc" sink) +-- , ((modMask, xK_d ), withTaggedP "abc" (shiftWin "2")) +-- , ((modMask .|. shiftMask, xK_d ), withTaggedGlobalP "abc" shiftHere) +-- , ((modMask .|. controlMask, xK_d ), focusUpTaggedGlobal "abc") +-- , ((modMask, xK_g ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s))) +-- , ((modMask .|. controlMask, xK_g ), tagDelPrompt defaultXPConfig) +-- , ((modMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float)) +-- , ((modWinMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedP s (shiftWin "2"))) +-- , ((modWinMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere)) +-- , ((modWinMask .|. controlMask, xK_g), tagPrompt defaultXPConfig (\s -> focusUpTaggedGlobal s)) +-- +-- NOTE: Tags are saved as space seperated string and split with 'unwords' thus +-- if you add a tag "a b" the window will have the tags "a" and "b" but not "a b". +-- +-- %import XMonadContrib.TagWindows +-- %import XMonadContrib.XPrompt -- to use tagPrompt + +-- set multiple tags for a window at once (overriding any previous tags) +setTags :: [String] -> Window -> X () +setTags = setTag . unwords + +-- set a tag for a window (overriding any previous tags) +-- writes it to the "_XMONAD_TAGS" window property +setTag :: String -> Window -> X () +setTag s w = withDisplay $ \d -> + io $ internAtom d "_XMONAD_TAGS" False >>= setTextProperty d w s + +-- read all tags of a window +-- reads from the "_XMONAD_TAGS" window property +getTags :: Window -> X [String] +getTags w = withDisplay $ \d -> + io $ catch (internAtom d "_XMONAD_TAGS" False >>= + getTextProperty d w >>= + wcTextPropertyToTextList d) + (\_ -> return [[]]) + >>= return . words . unwords + +-- check a window for the given tag +hasTag :: String -> Window -> X Bool +hasTag s w = (s `elem`) `liftM` getTags w + +-- add a tag to the existing ones +addTag :: String -> Window -> X () +addTag s w = do + tags <- getTags w + if (s `notElem` tags) then setTags (s:tags) w else return () + +-- remove a tag from a window, if it exists +delTag :: String -> Window -> X () +delTag s w = do + tags <- getTags w + setTags (filter (/= s) tags) w + +-- remove all tags +unTag :: Window -> X () +unTag = setTag "" + +-- Move the focus in a group of windows, which share the same given tag. +-- The Global variants move through all workspaces, whereas the other +-- ones operate only on the current workspace +focusUpTagged, focusDownTagged, focusUpTaggedGlobal, focusDownTaggedGlobal :: String -> X () +focusUpTagged = focusTagged' (reverse . wsToList) +focusDownTagged = focusTagged' wsToList +focusUpTaggedGlobal = focusTagged' (reverse . wsToListGlobal) +focusDownTaggedGlobal = focusTagged' wsToListGlobal + +-- +wsToList :: (Ord i) => StackSet i l a s sd -> [a] +wsToList ws = crs ++ cls + where + (crs, cls) = (cms down, cms (reverse . up)) + cms f = maybe [] f (stack . workspace . current $ ws) + +wsToListGlobal :: (Ord i) => StackSet i l a s sd -> [a] +wsToListGlobal ws = concat ([crs] ++ rws ++ lws ++ [cls]) + where + curtag = tag . workspace . current $ ws + (crs, cls) = (cms down, cms (reverse . up)) + cms f = maybe [] f (stack . workspace . current $ ws) + (lws, rws) = (mws (<), mws (>)) + mws cmp = map (integrate' . stack) . sortByTag . filter (\w -> tag w `cmp` curtag) . workspaces $ ws + sortByTag = sortBy (\x y -> compare (tag x) (tag y)) + +focusTagged' :: (WindowSet -> [Window]) -> String -> X () +focusTagged' wl t = gets windowset >>= findM (hasTag t) . wl >>= + maybe (return ()) (windows . focusWindow) + +findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a) +findM _ [] = return Nothing +findM p (x:xs) = do b <- p x + if b then return (Just x) else findM p xs + +-- apply a pure function to windows with a tag +withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X () +withTaggedP t f = withTagged' t (winMap f) +withTaggedGlobalP t f = withTaggedGlobal' t (winMap f) + +winMap :: (Window -> WindowSet -> WindowSet) -> [Window] -> X () +winMap f tw = when (tw /= []) (windows $ foldl1 (.) (map f tw)) + +withTagged, withTaggedGlobal :: String -> (Window -> X ()) -> X () +withTagged t f = withTagged' t (mapM_ f) +withTaggedGlobal t f = withTaggedGlobal' t (mapM_ f) + +withTagged' :: String -> ([Window] -> X ()) -> X () +withTagged' t m = gets windowset >>= + filterM (hasTag t) . integrate' . stack . workspace . current >>= m + +withTaggedGlobal' :: String -> ([Window] -> X ()) -> X () +withTaggedGlobal' t m = gets windowset >>= + filterM (hasTag t) . concat . map (integrate' . stack) . workspaces >>= m + +withFocusedP :: (Window -> WindowSet -> WindowSet) -> X () +withFocusedP f = withFocused $ windows . f + +shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd +shiftHere w s = shiftWin (tag . workspace . current $ s) w s + +shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd +shiftToScreen sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of + [] -> s + (t:_) -> shiftWin (tag . workspace $ t) w s + +data TagPrompt = TagPrompt + +instance XPrompt TagPrompt where + showXPrompt TagPrompt = "Select Tag: " + + +tagPrompt :: XPConfig -> (String -> X ()) -> X () +tagPrompt c f = do + sc <- tagComplList + mkXPrompt TagPrompt c (mkComplFunFromList' sc) f + +tagComplList :: X [String] +tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>= + mapM getTags >>= + return . nub . concat + + +tagDelPrompt :: XPConfig -> X () +tagDelPrompt c = do + sc <- tagDelComplList + if (sc /= []) + then mkXPrompt TagPrompt c (mkComplFunFromList' sc) (\s -> withFocused (delTag s)) + else return () + +tagDelComplList :: X [String] +tagDelComplList = gets windowset >>= maybe (return []) getTags . peek + + +mkComplFunFromList' :: [String] -> String -> IO [String] +mkComplFunFromList' l [] = return l +mkComplFunFromList' l s = + return $ filter (\x -> take (length s) x == s) l hunk ./NoBorders.hs 35 +import Data.List ((\\)) hunk ./NoBorders.hs 61 - setBorders borderWidth s + setBorders borderWidth (ws \\ s) hunk ./NoBorders.hs 85 - setBorders borderWidth s hunk ./NoBorders.hs 87 - then do setBorders 0 ws; return (wrs, Just $ SmartBorder ws) - else return (wrs, Just $ SmartBorder []) + then do + setBorders borderWidth (s \\ ws) + setBorders 0 ws + return (wrs, Just $ SmartBorder ws) + else do + setBorders borderWidth s + return (wrs, Just $ SmartBorder []) hunk ./MosaicAlt.hs 69 -instance Layout MosaicAlt Window where +instance LayoutClass MosaicAlt Window where hunk ./ResizableTile.hs 43 -instance Layout Tall a where +instance LayoutClass Tall a where addfile ./SwapWorkspaces.hs hunk ./SwapWorkspaces.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.SwapWorkspaces +-- Copyright : (c) Devin Mullins +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Devin Mullins +-- Stability : unstable +-- Portability : unportable +-- +-- Lets you swap workspace tags, so you can keep related ones next to +-- each other, without having to move individual windows. +-- +-- TODO: add quickcheck props for: +-- * double swap invariant (guarantees no 'loss' of workspaces) +-- * non-swapped ws's invariant +-- +----------------------------------------------------------------------------- + +module XMonadContrib.SwapWorkspaces ( + -- * Usage + -- $usage + swapWithCurrent, + swapWorkspaces + ) where + +import StackSet + +-- $usage +-- Add this import to your Config.hs: +-- > import XMonadContrib.SwapWorkspaces +-- +-- Throw this in your keys definition: +-- > ++ +-- > [((modMask .|. controlMask, k), windows $ swapWithCurrent i) +-- > | (i, k) <- zip workspaces [xK_1 ..]] + +swapWithCurrent :: Eq i => i -> StackSet i l a s sd -> StackSet i l a s sd +swapWithCurrent t s = swapWorkspaces t (tag $ workspace $ current s) s + +-- Stole this from StackSet.renameTag -- extracted the traversal code they have in common as mapWorkspaces +swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd +swapWorkspaces t1 t2 = mapWorkspaces swap + where swap w = if tag w == t1 then w { tag = t2 } + else if tag w == t2 then w { tag = t1 } + else w + +mapWorkspaces :: (Workspace i l a -> Workspace i l a) -> StackSet i l a s sd -> StackSet i l a s sd +mapWorkspaces f s = s { current = updScr $ current s + , visible = map updScr $ visible s + , hidden = map f $ hidden s } + where updScr scr = scr { workspace = f $ workspace scr } hunk ./MetaModule.hs 65 +import XMonadContrib.SwapWorkspaces () hunk ./WindowNavigation.hs 20 - Navigate(..), Direction(..) + Navigate(..), Direction(..), + WNConfig (..), defaultWNConfig hunk ./WindowNavigation.hs 24 -import Graphics.X11.Xlib ( Rectangle(..), Window, setWindowBorder ) -import Control.Monad.Reader ( ask, asks ) +import Graphics.X11.Xlib ( Rectangle(..), Window, Pixel, setWindowBorder ) +import Control.Monad ( when ) +import Control.Monad.Reader ( ask ) hunk ./WindowNavigation.hs 30 -import Operations ( focus, initColor, LayoutMessages(..) ) +import Operations ( focus, LayoutMessages(..) ) hunk ./WindowNavigation.hs 33 +import XMonadContrib.XUtils hunk ./WindowNavigation.hs 40 --- > defaultLayout = SomeLayout $ windowNavigation $ LayoutSelection ... +-- > defaultLayout = SomeLayout $ windowNavigation defaultWNConfig $ LayoutSelection ... hunk ./WindowNavigation.hs 56 --- %layout -- defaultLayout = SomeLayout $ windowNavigation $ ... +-- %layout -- defaultLayout = SomeLayout $ windowNavigation defaultWNConfig $ ... hunk ./WindowNavigation.hs 63 +data WNConfig = + WNC { showNavigable :: Bool + , upColor :: String + , downColor :: String + , leftColor :: String + , rightColor :: String + } deriving (Show, Read) + +defaultWNConfig :: WNConfig +defaultWNConfig = WNC True "#0000FF" "#00FFFF" "#FF0000" "#FF00FF" + hunk ./WindowNavigation.hs 76 -data WindowNavigation a = WindowNavigation (Invisible Maybe (NavigationState a)) deriving ( Read, Show ) +data WindowNavigation a = WindowNavigation WNConfig (Invisible Maybe (NavigationState a)) deriving ( Read, Show ) hunk ./WindowNavigation.hs 78 -windowNavigation = ModifiedLayout (WindowNavigation (I Nothing)) +windowNavigation :: LayoutClass l a => WNConfig -> l a -> ModifiedLayout WindowNavigation l a +windowNavigation conf = ModifiedLayout (WindowNavigation conf (I Nothing)) hunk ./WindowNavigation.hs 82 - redoLayout (WindowNavigation (I state)) rscr s wrs = - do XConf { display = dpy, normalBorder = nbc } <- ask - navigableColor <- io $ (Just `fmap` initColor dpy "#0000FF") `catch` \_ -> return Nothing - --uc <- io $ (Just `fmap` initColor dpy "#0000FF") `catch` \_ -> return Nothing - --dc <- io $ (Just `fmap` initColor dpy "#00FFFF") `catch` \_ -> return Nothing - --lc <- io $ (Just `fmap` initColor dpy "#FF0000") `catch` \_ -> return Nothing - --rc <- io $ (Just `fmap` initColor dpy "#FF00FF") `catch` \_ -> return Nothing - --let dirc U = uc - -- dirc D = dc - -- dirc L = lc - -- dirc R = rc - let w = W.focus s - r = case filter ((==w).fst) wrs of ((_,x):_) -> x - [] -> rscr - pt = case state of Just (NS ptold _) | ptold `inrect` r -> ptold - _ -> center r + redoLayout (WindowNavigation conf (I state)) rscr s wrs = + do XConf { normalBorder = nbc } <- ask + [uc,dc,lc,rc] <- mapM stringToPixel [upColor conf, downColor conf, leftColor conf, rightColor conf] + let dirc U = uc + dirc D = dc + dirc L = lc + dirc R = rc + let w = W.focus s + r = case filter ((==w).fst) wrs of ((_,x):_) -> x + [] -> rscr + pt = case state of Just (NS ptold _) | ptold `inrect` r -> ptold + _ -> center r hunk ./WindowNavigation.hs 97 - --wnavigablec = nub $ concatMap - -- (\d -> map (\(w,_) -> (w,dirc d)) $ - -- truncHead $ sortby d $ filter (inr d pt . snd) wrs') [U,D,R,L] + wnavigablec = nub $ concatMap + (\d -> map (\(win,_) -> (win,dirc d)) $ + truncHead $ sortby d $ filter (inr d pt . snd) wrs') [U,D,R,L] hunk ./WindowNavigation.hs 101 - _ -> [] - mapM_ (sc (Just nbc)) (wothers \\ map fst wnavigable) - mapM_ (sc navigableColor) $ map fst wnavigable - --mapM_ (\(w,c) -> sc c w) wnavigablec - return (wrs, Just $ WindowNavigation $ I $ Just $ NS pt wnavigable) + _ -> [] + mapM_ (sc nbc) (wothers \\ map fst wnavigable) + when (showNavigable conf) $ mapM_ (\(win,c) -> sc c win) wnavigablec + return (wrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable) hunk ./WindowNavigation.hs 106 - handleMess (WindowNavigation (I (Just (NS pt wrs)))) m + handleMess (WindowNavigation conf (I (Just (NS pt wrs)))) m hunk ./WindowNavigation.hs 109 - [] -> return Nothing + [] -> return Nothing hunk ./WindowNavigation.hs 111 - return $ Just $ WindowNavigation $ I $ Just $ + return $ Just $ WindowNavigation conf $ I $ Just $ hunk ./WindowNavigation.hs 114 - do XConf { display = dpy, normalBorder = nbc } <- ask - mapM_ (sc (Just nbc) . fst) wrs - return $ Just $ WindowNavigation $ I $ Just $ NS pt [] + do XConf { normalBorder = nbc } <- ask + mapM_ (sc nbc . fst) wrs + return $ Just $ WindowNavigation conf $ I $ Just $ NS pt [] hunk ./WindowNavigation.hs 118 - handleMess (WindowNavigation (I $ Just (NS pt wrs))) (SomeMessage Hide) + handleMess (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide) hunk ./WindowNavigation.hs 121 +truncHead :: [a] -> [a] hunk ./WindowNavigation.hs 125 -sc mc win = do dpy <- asks display - case mc of Just c -> io $ setWindowBorder dpy win c - Nothing -> return () +sc :: Pixel -> Window -> X () +sc c win = withDisplay $ \dpy -> io $ setWindowBorder dpy win c hunk ./WindowNavigation.hs 128 +center :: Rectangle -> Point hunk ./WindowNavigation.hs 130 + +centerd :: Direction -> Point -> Rectangle -> Point hunk ./WindowNavigation.hs 134 + +inr :: Direction -> Point -> Rectangle -> Bool hunk ./WindowNavigation.hs 137 - y < fromIntegral yr + fromIntegral h + y < fromIntegral yr + fromIntegral h hunk ./WindowNavigation.hs 139 - y > fromIntegral yr -inr R (P a x) (Rectangle b l _ w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && - a < fromIntegral b -inr L (P a x) (Rectangle b l c w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && - a > fromIntegral b + fromIntegral c -inrect (P x y) (Rectangle a b w h) = x > fromIntegral a && x < fromIntegral a + fromIntegral w && - y > fromIntegral b && y < fromIntegral b + fromIntegral h + y > fromIntegral yr +inr R (P a x) (Rectangle b l _ w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + a < fromIntegral b +inr L (P a x) (Rectangle b l c w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + a > fromIntegral b + fromIntegral c + +inrect :: Point -> Rectangle -> Bool +inrect (P x y) (Rectangle a b w h) = x > fromIntegral a && x < fromIntegral a + fromIntegral w && + y > fromIntegral b && y < fromIntegral b + fromIntegral h hunk ./WindowNavigation.hs 149 +sortby :: Direction -> [(a,Rectangle)] -> [(a,Rectangle)] hunk ./ThreeColumns.hs 20 - ThreeCol + ThreeCol(..) hunk ./WindowNavigation.hs 30 -import Operations ( focus, LayoutMessages(..) ) +import Operations ( windows, focus, LayoutMessages(..) ) hunk ./WindowNavigation.hs 54 +-- %keybind , ((modMask .|. controlMask, xK_Right), sendMessage $ Swap R) +-- %keybind , ((modMask .|. controlMask, xK_Left), sendMessage $ Swap L) +-- %keybind , ((modMask .|. controlMask, xK_Up), sendMessage $ Swap U) +-- %keybind , ((modMask .|. controlMask, xK_Down), sendMessage $ Swap D) hunk ./WindowNavigation.hs 63 -data Navigate = Go Direction deriving ( Read, Show, Typeable ) +data Navigate = Go Direction | Swap Direction deriving ( Read, Show, Typeable ) hunk ./WindowNavigation.hs 117 + | Just (Swap d) <- fromMessage m = + case sortby d $ filter (inr d pt . snd) wrs of + [] -> return Nothing + ((w,_):_) -> do let swap st = unint (W.focus st) $ map (swapw (W.focus st)) $ W.integrate st + swapw y x | x == w = y + | x == y = w + | otherwise = x + unint f xs = case span (/= f) xs of + (u,_:dn) -> W.Stack { W.focus = f + , W.up = reverse u + , W.down = dn } + _ -> W.Stack { W.focus = f + , W.down = xs + , W.up = [] } + windows $ W.modify' swap + return Nothing hunk ./MetaModule.hs 72 +import XMonadContrib.XPropManage () hunk ./Spiral.hs 1 +{-# LANGUAGE MultiParamTypeClasses #-} + hunk ./Square.hs 1 +{-# LANGUAGE MultiParamTypeClasses #-} hunk ./MetaModule.hs 42 -import XMonadContrib.HintedTile () +-- import XMonadContrib.HintedTile () hunk ./MetaModule.hs 47 -import XMonadContrib.Magnifier () -import XMonadContrib.Mosaic () +-- import XMonadContrib.Magnifier () +-- import XMonadContrib.Mosaic () hunk ./MetaModule.hs 64 -import XMonadContrib.SwitchTrans () +-- import XMonadContrib.SwitchTrans () hunk ./MosaicAlt.hs 24 + , tallWindowAlt + , wideWindowAlt hunk ./MosaicAlt.hs 50 +-- > , ((modMask .|. shiftMask, xK_s), withFocused (sendMessage . tallWindowAlt)) +-- > , ((modMask .|. shiftMask, xK_d), withFocused (sendMessage . wideWindowAlt)) hunk ./MosaicAlt.hs 61 + | TallWindowAlt Window + | WideWindowAlt Window hunk ./MosaicAlt.hs 67 +tallWindowAlt, wideWindowAlt :: Window -> HandleWindowAlt hunk ./MosaicAlt.hs 70 +tallWindowAlt = TallWindowAlt +wideWindowAlt = WideWindowAlt hunk ./MosaicAlt.hs 75 -type Areas = M.Map Window Rational -data MosaicAlt a = MosaicAlt Areas deriving ( Show, Read ) +data Param = Param { area, aspect :: Rational } deriving ( Show, Read ) +type Params = M.Map Window Param +data MosaicAlt a = MosaicAlt Params deriving ( Show, Read ) hunk ./MosaicAlt.hs 81 - doLayout (MosaicAlt areas) rect stack = - return (arrange rect stack areas', Just $ MosaicAlt areas') + doLayout (MosaicAlt params) rect stack = + return (arrange rect stack params', Just $ MosaicAlt params') hunk ./MosaicAlt.hs 84 - areas' = ins (W.up stack) $ ins (W.down stack) $ ins [W.focus stack] areas - ins wins as = foldl M.union as $ map (`M.singleton` 1) wins + params' = ins (W.up stack) $ ins (W.down stack) $ ins [W.focus stack] params + ins wins as = foldl M.union as $ map (`M.singleton` (Param 1 1.5)) wins hunk ./MosaicAlt.hs 87 - handleMessage (MosaicAlt areas) msg = return $ case fromMessage msg of - Just (ShrinkWindowAlt w) -> Just $ MosaicAlt $ alter areas w (4 % 5) - Just (ExpandWindowAlt w) -> Just $ MosaicAlt $ alter areas w (6 % 5) + handleMessage (MosaicAlt params) msg = return $ case fromMessage msg of + Just (ShrinkWindowAlt w) -> Just $ MosaicAlt $ alter params w (4 % 5) 1 + Just (ExpandWindowAlt w) -> Just $ MosaicAlt $ alter params w (6 % 5) 1 + Just (TallWindowAlt w) -> Just $ MosaicAlt $ alter params w 1 (3 % 4) + Just (WideWindowAlt w) -> Just $ MosaicAlt $ alter params w 1 (5 % 4) hunk ./MosaicAlt.hs 95 +-- Change requested params for a window. +alter :: Params -> Window -> Rational -> Rational -> Params +alter params win arDelta asDelta = case M.lookup win params of + Just (Param ar as) -> M.insert win (Param (ar * arDelta) (as * asDelta)) params + Nothing -> M.insert win (Param arDelta (1.5 * asDelta)) params + hunk ./MosaicAlt.hs 102 -arrange :: Rectangle -> W.Stack Window -> Areas -> [(Window, Rectangle)] -arrange rect stack areas = tree rect (sortBy areaCompare winList) totalArea areas +arrange :: Rectangle -> W.Stack Window -> Params -> [(Window, Rectangle)] +arrange rect stack params = r hunk ./MosaicAlt.hs 105 - winList = reverse (W.up stack) ++ W.focus stack : W.down stack - totalArea = areaSum areas winList + (_, r) = findSplits 3 rect tree params + tree = makeTree (sortBy areaCompare wins) params + wins = reverse (W.up stack) ++ W.focus stack : W.down stack hunk ./MosaicAlt.hs 109 - or1 w = maybe 1 id $ M.lookup w areas - --- Selects a horizontal or vertical split to get the best aspect ratio. --- FIXME: Give the user more dynamic control. -splitBest :: Rational -> Rectangle -> (Rectangle, Rectangle) -splitBest ratio rect = - if (w % h) < cutoff then splitVerticallyBy ratio rect - else splitHorizontallyBy ratio rect - where - -- Prefer wide windows to tall ones, mainly because it makes xterms more usable. - cutoff = if w > 1000 then 1.25 - else if w < 500 then 2.25 - else 2.25 - (w - 500) % 500 - w = rect_width rect - h = rect_height rect + or1 w = maybe 1 area $ M.lookup w params hunk ./MosaicAlt.hs 113 -tree :: Rectangle -> [Window] -> Rational -> Areas -> [(Window, Rectangle)] -tree rect winList totalArea areas = case winList of - [] -> [] - [x] -> [(x, rect)] - _ -> tree aRect aWins aArea areas ++ tree bRect bWins bArea areas - where - (aRect, bRect) = splitBest (aArea / (aArea + bArea)) rect - ((aWins, aArea), (bWins, bArea)) = areaSplit areas winList totalArea - --- Sum the requested areas of a bunch of windows. -areaSum :: Areas -> [Window] -> Rational -areaSum areas = sum . map (maybe 1 id . flip M.lookup areas) +data Tree = Node (Rational, Tree) (Rational, Tree) | Leaf Window | None +makeTree :: [Window] -> Params -> Tree +makeTree wins params = case wins of + [] -> None + [x] -> Leaf x + _ -> Node (aArea, makeTree aWins params) (bArea, makeTree bWins params) + where ((aWins, aArea), (bWins, bArea)) = areaSplit params wins hunk ./MosaicAlt.hs 122 -areaSplit :: Areas -> [Window] -> Rational -> (([Window], Rational), ([Window], Rational)) -areaSplit areas wins totalArea = ((reverse aWins, aArea), (bWins, bArea)) +areaSplit :: Params -> [Window] -> (([Window], Rational), ([Window], Rational)) +areaSplit params wins = gather [] 0 [] 0 wins + where + gather a aa b ba (r : rs) = + if aa <= ba + then gather (r : a) (aa + or1 r) b ba rs + else gather a aa (r : b) (ba + or1 r) rs + gather a aa b ba [] = ((reverse a, aa), (b, ba)) + or1 w = maybe 1 area $ M.lookup w params + +-- Figure out which ways to split the space, by exhaustive search. +-- Complexity is quadratic in the number of windows. +findSplits :: Int -> Rectangle -> Tree -> Params -> (Double, [(Window, Rectangle)]) +findSplits _ _ None _ = (0, []) +findSplits _ rect (Leaf w) params = (aspectBadness rect w params, [(w, rect)]) +findSplits depth rect (Node (aArea, aTree) (bArea, bTree)) params = + if hBadness < vBadness then (hBadness, hList) else (vBadness, vList) hunk ./MosaicAlt.hs 140 - ((aWins, aArea), (bWins, bArea)) = gather [] wins 0 - gather a b t = if t >= (totalArea / 2) then ((a, t), (b, totalArea - t)) - else gather (head b : a) (tail b) (t + or1 (head b)) - or1 w = maybe 1 id $ M.lookup w areas + (hBadness, hList) = trySplit splitHorizontallyBy + (vBadness, vList) = trySplit splitVerticallyBy + trySplit splitBy = + (aBadness + bBadness, aList ++ bList) + where + (aBadness, aList) = findSplits (depth - 1) aRect aTree params + (bBadness, bList) = findSplits (depth - 1) bRect bTree params + (aRect, bRect) = splitBy ratio rect + ratio = aArea / (aArea + bArea) hunk ./MosaicAlt.hs 150 --- Change requested area for a window. -alter :: Areas -> Window -> Rational -> Areas -alter areas win delta = case M.lookup win areas of - Just v -> M.insert win (v * delta) areas - Nothing -> M.insert win delta areas +-- Decide how much we like this rectangle. +aspectBadness :: Rectangle -> Window -> Params -> Double +aspectBadness rect win params = + (if a < 1 then tall else wide) * sqrt(w * h) + where + tall = if w < 700 then ((1 / a) * (700 / w)) else 1 / a + wide = if w < 700 then a else (a * w / 700) + a = (w / h) / fromRational (maybe 1.5 aspect $ M.lookup win params) + w = fromIntegral $ rect_width rect + h = fromIntegral $ rect_height rect hunk ./ResizableTile.hs 15 -module XMonadContrib.ResizableTile (Tall(..), MirrorResize(..)) where +module XMonadContrib.ResizableTile (ResizableTall(..), MirrorResize(..)) where hunk ./ResizableTile.hs 28 --- > import XMonadContrib.ResizableTile as T +-- > import XMonadContrib.ResizableTile hunk ./ResizableTile.hs 37 --- > tiled = T.Tall nmaster delta ratio [] +-- > tiled = ResizableTall nmaster delta ratio [] hunk ./ResizableTile.hs 42 -data Tall a = Tall Int Rational Rational [Rational] deriving (Show, Read) -instance LayoutClass Tall a where - doLayout (Tall nmaster _ frac mfrac) r = +data ResizableTall a = ResizableTall Int Rational Rational [Rational] deriving (Show, Read) +instance LayoutClass ResizableTall a where + doLayout (ResizableTall nmaster _ frac mfrac) r = hunk ./ResizableTile.hs 47 - handleMessage (Tall nmaster delta frac mfrac) m = + handleMessage (ResizableTall nmaster delta frac mfrac) m = hunk ./ResizableTile.hs 54 - where resize Shrink = Tall nmaster delta (max 0 $ frac-delta) mfrac - resize Expand = Tall nmaster delta (min 1 $ frac+delta) mfrac + where resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac + resize Expand = ResizableTall nmaster delta (min 1 $ frac+delta) mfrac hunk ./ResizableTile.hs 62 - in Tall nmaster delta frac $ take total mfrac' + in ResizableTall nmaster delta frac $ take total mfrac' hunk ./ResizableTile.hs 66 - incmastern (IncMasterN d) = Tall (max 0 (nmaster+d)) delta frac mfrac + incmastern (IncMasterN d) = ResizableTall (max 0 (nmaster+d)) delta frac mfrac hunk ./XPrompt.hs 268 -keyPressHandle mask _ - | mask == controlMask = eventLoop handle -- TODO -keyPressHandle _ (ks,_) +keyPressHandle mask (ks,_) + | mask == controlMask = + case () of +-- ^U + _ | ks == xK_u -> killBefore >> go +-- ^K + | ks == xK_k -> killAfter >> go +-- Unhandled control sequence + | otherwise -> eventLoop handle hunk ./XPrompt.hs 304 +-- | Kill the portion of the command before the cursor +killBefore :: XP () +killBefore = + modify $ \s -> s { command = drop (offset s) (command s) + , offset = 0 } + +-- | Kill the portion of the command including and after the cursor +killAfter :: XP () +killAfter = + modify $ \s -> s { command = take (offset s) (command s) } + addfile ./Maximize.hs hunk ./Maximize.hs 1 +{-# LANGUAGE FlexibleInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Maximize +-- Copyright : (c) 2007 James Webb +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : xmonad#jwebb,sygneca,com +-- Stability : unstable +-- Portability : unportable +-- +-- Temporarily yanks the focused window out of the layout to mostly fill +-- the screen. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.Maximize ( + -- * Usage + -- $usage + maximize, + maximizeRestore + ) where + +import Graphics.X11.Xlib +import XMonad +import XMonadContrib.LayoutModifier +import Data.List ( partition ) + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.Maximize +-- +-- > defaultLayouts = ... +-- > , Layout $ maximize $ myLayout ... +-- > ... +-- +-- > keys = ... +-- > , ((modMask, xK_backslash), withFocused (sendMessage . maximizeRestore)) +-- > ... + +-- %import XMonadContrib.Maximize +-- %layout , Layout $ maximize $ myLayout + +data Maximize a = Maximize (Maybe Window) deriving ( Read, Show ) +maximize :: LayoutClass l Window => l Window -> ModifiedLayout Maximize l Window +maximize = ModifiedLayout $ Maximize Nothing + +data MaximizeRestore = MaximizeRestore Window deriving ( Typeable, Eq ) +instance Message MaximizeRestore +maximizeRestore :: Window -> MaximizeRestore +maximizeRestore = MaximizeRestore + +instance LayoutModifier Maximize Window where + modifierDescription (Maximize _) = "Maximize" + redoLayout (Maximize mw) rect _ wrs = case mw of + Just win -> + return (maxed ++ rest, Nothing) + where + maxed = map (\(w, _) -> (w, maxRect)) toMax + (toMax, rest) = partition (\(w, _) -> w == win) wrs + maxRect = Rectangle (rect_x rect + 50) (rect_y rect + 50) + (rect_width rect - 100) (rect_height rect - 100) + Nothing -> return (wrs, Nothing) + handleMess (Maximize mw) m = case fromMessage m of + Just (MaximizeRestore w) -> case mw of + Just _ -> return $ Just $ Maximize Nothing + Nothing -> return $ Just $ Maximize $ Just w + _ -> return Nothing + +-- vim: sw=4:et hunk ./MetaModule.hs 48 +import XMonadContrib.Maximize () hunk ./SwapWorkspaces.hs 37 +-- +-- %import XMonadContrib.SwapWorkspaces +-- %keybindlist ++ +-- %keybindlist [((modMask .|. controlMask, k), windows $ swapWithCurrent i) +-- %keybindlist | (i, k) <- zip workspaces [xK_1 ..]] addfile ./tests/test_SwapWorkspaces.hs hunk ./tests/test_SwapWorkspaces.hs 1 +{-# OPTIONS -fglasgow-exts #-} + +import Data.List(find,union) +import Data.Maybe(fromJust) +import Test.QuickCheck + +import StackSet +import Properties(T, NonNegative) +import XMonadContrib.SwapWorkspaces + +-- Ensures that no "loss of information" can happen from a swap. +prop_double_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) = + t1 `tagMember` ss && t2 `tagMember` ss ==> + ss == swap (swap ss) + where swap = swapWorkspaces t1 t2 + +-- Degrade nicely when given invalid data. +prop_invalid_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) = + not (t1 `tagMember` ss || t2 `tagMember` ss) ==> + ss == swapWorkspaces t1 t2 ss + +-- This doesn't pass yet. Probably should. +-- prop_half_invalid_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) = +-- t1 `tagMember` ss && not (t2 `tagMember` ss) ==> +-- ss == swapWorkspaces t1 t2 ss + +zipWorkspacesWith :: (Workspace i l a -> Workspace i l a -> n) -> StackSet i l a s sd -> + StackSet i l a s sd -> [n] +zipWorkspacesWith f s t = f (workspace $ current s) (workspace $ current t) : + zipWith f (map workspace $ visible s) (map workspace $ visible t) ++ + zipWith f (hidden s) (hidden t) + +-- Swap only modifies the workspaces tagged t1 and t2 -- leaves all others alone. +prop_swap_only_two (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) = + t1 `tagMember` ss && t2 `tagMember` ss ==> + and $ zipWorkspacesWith mostlyEqual ss (swapWorkspaces t1 t2 ss) + where mostlyEqual w1 w2 = map tag [w1, w2] `elem` [[t1, t2], [t2, t1]] || w1 == w2 + +-- swapWithCurrent stays on current +prop_swap_with_current (ss :: T) (t :: NonNegative Int) = + t `tagMember` ss ==> + layout before == layout after && stack before == stack after + where before = workspace $ current ss + after = workspace $ current $ swapWithCurrent t ss + +main = do + putStrLn "Testing double swap" + quickCheck prop_double_swap + putStrLn "Testing invalid swap" + quickCheck prop_invalid_swap + -- putStrLn "Testing half-invalid swap" + -- quickCheck prop_half_invalid_swap + putStrLn "Testing swap only two" + quickCheck prop_swap_only_two + putStrLn "Testing swap with current" + quickCheck prop_swap_with_current hunk ./Tabbed.hs 141 - focus (fromJust $ lookup thisw tws) - updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws) + case lookup thisw tws of + Just x -> do focus x + updateTab ishr conf fs width (thisw, x) + Nothing -> return () hunk ./XPrompt.hs 38 + , breakAtSpace hunk ./XPrompt.hs 41 - hunk ./XPrompt.hs 46 -import Operations +import Operations (initColor) hunk ./XPrompt.hs 48 +import XMonadContrib.XUtils hunk ./XPrompt.hs 50 +import Control.Arrow ((***),(&&&)) hunk ./XPrompt.hs 62 --- hunk ./XPrompt.hs 82 - , fs :: FontStruct + , fontS :: FontStruct hunk ./XPrompt.hs 91 - XPC { font :: String -- ^ Font - , bgColor :: String -- ^ Backgroud color - , fgColor :: String -- ^ Font color - , fgHLight :: String -- ^ Font color of a highlighted completion entry - , bgHLight :: String -- ^ Backgroud color of a highlighted completion entry - , borderColor :: String -- ^ Border color - , borderPixel :: Dimension -- ^ Border width - , position :: XPPosition -- ^ Position: 'Top' or 'Bottom' - , height :: Dimension -- ^ Window height - , historySize :: Int -- ^ The number of history entries to be saved + XPC { font :: String -- ^ Font + , bgColor :: String -- ^ Backgroud color + , fgColor :: String -- ^ Font color + , fgHLight :: String -- ^ Font color of a highlighted completion entry + , bgHLight :: String -- ^ Backgroud color of a highlighted completion entry + , borderColor :: String -- ^ Border color + , promptBorderWidth :: Dimension -- ^ Border width + , position :: XPPosition -- ^ Position: 'Top' or 'Bottom' + , height :: Dimension -- ^ Window height + , historySize :: Int -- ^ The number of history entries to be saved hunk ./XPrompt.hs 130 - XPC { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , bgColor = "#333333" - , fgColor = "#FFFFFF" - , fgHLight = "#000000" - , bgHLight = "#BBBBBB" - , borderColor = "#FFFFFF" - , borderPixel = 1 - , position = Bottom - , height = 18 - , historySize = 256 + XPC { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , bgColor = "#333333" + , fgColor = "#FFFFFF" + , fgHLight = "#000000" + , bgHLight = "#BBBBBB" + , borderColor = "#FFFFFF" + , promptBorderWidth = 1 + , position = Bottom + , height = 18 + , historySize = 256 hunk ./XPrompt.hs 146 -initState d rw w s compl gc f pt h c = - XPS d rw w s Nothing Nothing compl gc f (XPT pt) "" 0 h c +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 hunk ./XPrompt.hs 170 - fontS <- liftIO (loadQueryFont d (font conf) `catch` - \_ -> loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*") - liftIO $ setFont d gc $ fontFromFontStruct fontS hunk ./XPrompt.hs 171 - let st = initState d rw w s compl gc fontS (XPT t) hist conf + fs <- initFont (font conf) + liftIO $ setFont d gc $ fontFromFontStruct fs + let st = initState d rw w s compl gc fs (XPT t) hist conf hunk ./XPrompt.hs 176 + releaseFont fs hunk ./XPrompt.hs 178 - liftIO $ freeFont d fontS hunk ./XPrompt.hs 187 - let d = dpy st - w = win st + let (d,w) = (dpy &&& win) st hunk ./XPrompt.hs 271 - _ | ks == xK_u -> killBefore >> go + _ | ks == xK_u -> killBefore >> go hunk ./XPrompt.hs 273 - | ks == xK_k -> killAfter >> go + | ks == xK_k -> killAfter >> go +-- ^A + | ks == xK_a -> startOfLine >> go +-- ^E + | ks == xK_e -> endOfLine >> go hunk ./XPrompt.hs 281 - | ks == xK_Return = do historyPush - return () + | ks == xK_Return = historyPush >> return () hunk ./XPrompt.hs 285 - | ks == xK_Delete = deleteString Next >> go + | ks == xK_Delete = deleteString Next >> go hunk ./XPrompt.hs 287 - | ks == xK_Left = moveCursor Prev >> go + | ks == xK_Left = moveCursor Prev >> go hunk ./XPrompt.hs 289 - | ks == xK_Right = moveCursor Next >> go + | ks == xK_Right = moveCursor Next >> go hunk ./XPrompt.hs 291 - | ks == xK_Up = moveHistory Prev >> go + | ks == xK_Up = moveHistory Prev >> go hunk ./XPrompt.hs 293 - | ks == xK_Down = moveHistory Next >> go + | ks == xK_Down = moveHistory Next >> go hunk ./XPrompt.hs 295 - | ks == xK_Escape = flushString >> return () + | ks == xK_Escape = flushString >> return () hunk ./XPrompt.hs 317 +-- | Put the cursor at the end of line +endOfLine :: XP () +endOfLine = + modify $ \s -> s { offset = length (command s) } + +-- | Put the cursor at the start of line +startOfLine :: XP () +startOfLine = + modify $ \s -> s { offset = 0 } + hunk ./XPrompt.hs 334 -insertString str = +insertString str = hunk ./XPrompt.hs 405 - let c = config st - d = dpy st + let (c,(d,(w,gc))) = (config &&& dpy &&& win &&& gcon) st hunk ./XPrompt.hs 407 - w = win st hunk ./XPrompt.hs 409 - bw = borderPixel c - gc = gcon st - fontStruc = fs st + bw = promptBorderWidth c hunk ./XPrompt.hs 411 - border <- io $ initColor d (borderColor c) + border <- io $ initColor d (borderColor c) hunk ./XPrompt.hs 415 - printPrompt p gc fontStruc + printPrompt p hunk ./XPrompt.hs 419 -printPrompt :: Drawable -> GC -> FontStruct -> XP () -printPrompt drw gc fontst = do - c <- gets config +printPrompt :: Drawable -> XP () +printPrompt drw = do hunk ./XPrompt.hs 422 - let d = dpy st - (prt,com,off) = (show (xptype st), command st, offset st) + let (gc,(c,(d,fs))) = (gcon &&& config &&& dpy &&& fontS) st + (prt,(com,off)) = (show . xptype &&& command &&& offset) st hunk ./XPrompt.hs 431 - (fsl,psl) = (textWidth fontst f, textWidth fontst p) - (_,asc,desc,_) = textExtents fontst str + (fsl,psl) = (textWidth fs *** textWidth fs) (f,p) + (_,asc,desc,_) = textExtents fs str hunk ./XPrompt.hs 444 - hunk ./XPrompt.hs 457 - d <- gets dpy + d <- gets dpy hunk ./XPrompt.hs 482 - let c = config st - scr = screen st + let (c,(scr,fs)) = (config &&& screen &&& fontS) st hunk ./XPrompt.hs 485 - fontst = fs st hunk ./XPrompt.hs 486 - let compl_number = length compl - max_compl_len = (fi ht `div` 2) + (maximum . map (textWidth fontst) $ compl) + let max_compl_len = (fi ht `div` 2) + (maximum . map (textWidth fs) $ compl) hunk ./XPrompt.hs 489 - (rows,r) = compl_number `divMod` fi columns + (rows,r) = (length compl) `divMod` fi columns hunk ./XPrompt.hs 498 - let (_,asc,desc,_) = textExtents fontst $ head compl + let (_,asc,desc,_) = textExtents fs $ head compl hunk ./XPrompt.hs 512 - bw = borderPixel c + bw = promptBorderWidth c hunk ./XPrompt.hs 568 - io $ printString d drw gc fhc bhc x y s + io $ printString d drw gc fhc bhc x y s hunk ./XPrompt.hs 613 - -> Position -> Position -> String -> IO () + -> Position -> Position -> String -> IO () hunk ./XPrompt.hs 670 - reverse . fst . break isSpace . reverse $ str + reverse . fst . breakAtSpace . reverse $ str hunk ./XPrompt.hs 676 - reverse . snd . break isSpace . reverse $ str + reverse . snd . breakAtSpace . reverse $ str + +breakAtSpace :: String -> (String, String) +breakAtSpace s + | " \\" `isPrefixOf` s2 = (s1 ++ " " ++ s1', s2') + | otherwise = (s1, s2) + where (s1, s2 ) = break isSpace s + (s1',s2') = breakAtSpace $ tail s2 hunk ./ShellPrompt.hs 25 +import XMonadContrib.Dmenu hunk ./ShellPrompt.hs 29 -import System.Console.Readline +import System.Directory +import System.IO hunk ./ShellPrompt.hs 35 --- 1. In xmonad.cabal change: --- --- > build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0 --- --- to --- --- > build-depends: base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0, readline >= 1.0 --- --- 2. In Config.hs add: +-- 1. In Config.hs add: hunk ./ShellPrompt.hs 40 --- 3. In your keybindings add something like: +-- 2. In your keybindings add something like: hunk ./ShellPrompt.hs 45 --- %cabalbuilddep readline>=1.0 hunk ./ShellPrompt.hs 61 - fl <- filenameCompletionFunction s + f <- fmap lines $ runProcessWithInput "/bin/bash" [] ("compgen -A file " ++ s ++ "\n") hunk ./ShellPrompt.hs 63 - return $ sort . nub $ fl ++ c + hPutStrLn stdout s + return $ map escape . sort . nub $ f ++ c hunk ./ShellPrompt.hs 70 - | otherwise = do + | otherwise = do hunk ./ShellPrompt.hs 74 - cl = liftM (nub . rmPath . concat) . mapM fCF . map addToPath . split ':' - addToPath = flip (++) ("/" ++ str) - fCF = filenameCompletionFunction + cl = liftM (nub . rmPath . concat) . mapM cmpl . split ':' + cmpl s = filter (isPrefixOf str) `fmap` getFileNames s + +getFileNames :: FilePath -> IO [FilePath] +getFileNames fp = + getDirectoryContents fp `catch` \_ -> return [] hunk ./ShellPrompt.hs 94 +escape :: String -> String +escape [] = "" +escape (' ':xs) = "\\ " ++ escape xs +escape (x:xs) + | isSpecialChar x = '\\' : x : escape xs + | otherwise = x : escape xs + +isSpecialChar :: Char -> Bool +isSpecialChar = flip elem "\\@\"'#?$*()[]{};" addfile ./Dishes.hs hunk ./Dishes.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Dishes +-- Copyright : (c) Jeremy Apthorp +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jeremy Apthorp +-- Stability : unstable +-- Portability : portable +-- +-- Dishes is a layout that stacks extra windows underneath the master +-- windows. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.Dishes ( + -- * Usage + -- $usage + Dishes (..) + ) where + +import Data.List +import XMonad +import Operations +import StackSet (integrate) +import Control.Monad (ap) +import Graphics.X11.Xlib + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.Dishes + +-- %import XMonadContrib.Dishes + +data Dishes a = Dishes Int Rational deriving (Show, Read) +instance LayoutClass Dishes a where + doLayout (Dishes nmaster h) r = + return . (\x->(x,Nothing)) . + ap zip (dishes h r nmaster . length) . integrate + handleMessage (Dishes nmaster h) m = return $ fmap incmastern (fromMessage m) + where incmastern (IncMasterN d) = Dishes (max 0 (nmaster+d)) h + +dishes :: Rational -> Rectangle -> Int -> Int -> [Rectangle] +dishes h s nmaster n = if n <= nmaster + then splitHorizontally n s + else ws + where + (m,rest) = splitVerticallyBy (1 - (fromIntegral $ n - nmaster) * h) s + ws = splitHorizontally nmaster m ++ splitVertically (n - nmaster) rest addfile ./Grid.hs hunk ./Grid.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Grid +-- Copyright : (c) Lukas Mai +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- +----------------------------------------------------------------------------- + +module XMonadContrib.Grid ( + Grid(..) +) where + +import XMonad +import StackSet +import Graphics.X11.Xlib.Types + +data Grid a = Grid deriving (Read, Show) + +instance LayoutClass Grid a where + pureLayout Grid r s = arrange r (integrate s) + +arrange :: Rectangle -> [a] -> [(a, Rectangle)] +arrange (Rectangle rx ry rw rh) st = zip st rectangles + where + nwins = length st + ncols = ceiling . (sqrt :: Double -> Double) . fromIntegral $ nwins + mincs = nwins `div` ncols + extrs = nwins - ncols * mincs + chop :: Int -> Dimension -> [(Position, Dimension)] + chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m' + where + k :: Dimension + k = m `div` fromIntegral n + m' = fromIntegral m + k' :: Position + k' = fromIntegral k + xcoords = chop ncols rw + ycoords = chop mincs rh + ycoords' = chop (succ mincs) rh + (xbase, xext) = splitAt (ncols - extrs) xcoords + rectangles = combine ycoords xbase ++ combine ycoords' xext + where + combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys] hunk ./Grid.hs 11 +-- A simple layout that attempts to put all windows in a square grid. hunk ./Grid.hs 16 + -- * Usage + -- $usage hunk ./Grid.hs 25 +-- $usage +-- Put the following in your Config.hs file: +-- +-- > import XMonadContrib.Grid +-- > ... +-- > defaultLayouts = [ ... +-- > , Layout Grid +-- > ] + +-- %import XMonadContrib.Grid +-- %layout , Layout Grid + hunk ./MetaModule.hs 42 +import XMonadContrib.Grid () hunk ./SwapWorkspaces.hs 48 -swapWorkspaces t1 t2 = mapWorkspaces swap +swapWorkspaces t1 t2 = mapWorkspace swap hunk ./SwapWorkspaces.hs 53 -mapWorkspaces :: (Workspace i l a -> Workspace i l a) -> StackSet i l a s sd -> StackSet i l a s sd -mapWorkspaces f s = s { current = updScr $ current s - , visible = map updScr $ visible s - , hidden = map f $ hidden s } - where updScr scr = scr { workspace = f $ workspace scr } - hunk ./SwapWorkspaces.hs 46 --- Stole this from StackSet.renameTag -- extracted the traversal code they have in common as mapWorkspaces addfile ./EwmhDesktops.hs hunk ./EwmhDesktops.hs 1 +module XMonadContrib.EwmhDesktops (ewmhDesktopsLogHook) where + +import Data.Maybe (listToMaybe,fromJust) +import Data.List (elemIndex, sortBy) +import Data.Ord ( comparing) + +import Control.Monad.Reader +import XMonad +import qualified StackSet as W +import System.IO +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +ewmhDesktopsLogHook :: X () +ewmhDesktopsLogHook = withDisplay $ \dpy -> withWindowSet $ \s -> do + -- Number of Workspaces + -- Bad hack because xmonad forgets the original order of things, it seems + let ws = sortBy (comparing W.tag) $ W.workspaces s + + let n = fromIntegral (length ws) + a <- getAtom "_NET_NUMBER_OF_DESKTOPS" + c <- getAtom "CARDINAL" + r <- asks theRoot + io $ changeProperty32 dpy r a c propModeReplace [n] + + -- Names thereof + a <- getAtom "_NET_DESKTOP_NAMES" + c <- getAtom "UTF8_STRING" + let names = map (fromIntegral.fromEnum) $ + concatMap (("Workspace "++) . (++['\0']). W.tag) ws + io $ changeProperty8 dpy r a c propModeReplace names + + -- Current desktop + a <- getAtom "_NET_CURRENT_DESKTOP" + c <- getAtom "CARDINAL" + let Just n = W.lookupWorkspace 0 s + let Just i = elemIndex n $ map W.tag ws + io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i] + + return () + + hunk ./EwmhDesktops.hs 1 -module XMonadContrib.EwmhDesktops (ewmhDesktopsLogHook) where +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.EwmhDesktops +-- Copyright : (c) Joachim Breitner +-- License : BSD +-- +-- Maintainer : Joachim Breitner +-- Stability : unstable +-- Portability : unportable +-- +-- Makes xmonad use the EWMH hints to tell panel applications about its +-- workspaces and the windows therein. +----------------------------------------------------------------------------- +module XMonadContrib.EwmhDesktops ( + -- * Usage + -- $usage + ewmhDesktopsLogHook + ) where hunk ./EwmhDesktops.hs 20 -import Data.Maybe (listToMaybe,fromJust) -import Data.List (elemIndex, sortBy) -import Data.Ord ( comparing) +import Data.List (elemIndex, sortBy) +import Data.Ord (comparing) +import Data.Maybe (fromMaybe) hunk ./EwmhDesktops.hs 27 -import System.IO hunk ./EwmhDesktops.hs 30 +-- $usage +-- Add the imports to your configuration file and add the logHook: +-- +-- > import XMonadContrib.EwmhDesktops +-- +-- > logHook :: X() +-- > logHook = do ewmhDesktopsLogHook +-- > return () + +-- %import XMonadContrib.EwmhDesktops +-- %def -- comment out default logHook definition above if you uncomment this: +-- %def logHook = ewmhDesktopsLogHook + + +-- | +-- Notifies pagers and window lists, such as those in the gnome-panel +-- of the current state of workspaces and windows. hunk ./EwmhDesktops.hs 48 -ewmhDesktopsLogHook = withDisplay $ \dpy -> withWindowSet $ \s -> do - -- Number of Workspaces +ewmhDesktopsLogHook = withWindowSet $ \s -> do hunk ./EwmhDesktops.hs 50 + -- see http://code.google.com/p/xmonad/issues/detail?id=53 hunk ./EwmhDesktops.hs 52 + let wins = W.allWindows s hunk ./EwmhDesktops.hs 54 - let n = fromIntegral (length ws) - a <- getAtom "_NET_NUMBER_OF_DESKTOPS" - c <- getAtom "CARDINAL" - r <- asks theRoot - io $ changeProperty32 dpy r a c propModeReplace [n] + -- Number of Workspaces + setNumberOfDesktops (length ws) hunk ./EwmhDesktops.hs 58 - a <- getAtom "_NET_DESKTOP_NAMES" - c <- getAtom "UTF8_STRING" - let names = map (fromIntegral.fromEnum) $ - concatMap (("Workspace "++) . (++['\0']). W.tag) ws - io $ changeProperty8 dpy r a c propModeReplace names + setDesktopNames (map W.tag ws) hunk ./EwmhDesktops.hs 61 + fromMaybe (return ()) $ do + n <- W.lookupWorkspace 0 s + i <- elemIndex n $ map W.tag ws + return $ setCurrentDesktop i + + setClientList wins + + -- Per window Desktop + forM (zip ws [(0::Int)..]) $ \(w, wn) -> + forM (W.integrate' (W.stack w)) $ \win -> do + setWindowDesktop win wn + + return () + + +setNumberOfDesktops :: (Integral a) => a -> X () +setNumberOfDesktops n = withDisplay $ \dpy -> do + a <- getAtom "_NET_NUMBER_OF_DESKTOPS" + c <- getAtom "CARDINAL" + r <- asks theRoot + io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n] + +setCurrentDesktop :: (Integral a) => a -> X () +setCurrentDesktop i = withDisplay $ \dpy -> do hunk ./EwmhDesktops.hs 87 - let Just n = W.lookupWorkspace 0 s - let Just i = elemIndex n $ map W.tag ws + r <- asks theRoot hunk ./EwmhDesktops.hs 89 - - return () hunk ./EwmhDesktops.hs 90 +setDesktopNames :: [String] -> X () +setDesktopNames names = withDisplay $ \dpy -> do + -- Names thereof + r <- asks theRoot + a <- getAtom "_NET_DESKTOP_NAMES" + c <- getAtom "UTF8_STRING" + let names' = map (fromIntegral.fromEnum) $ + concatMap (("Workspace "++) . (++['\0'])) names + io $ changeProperty8 dpy r a c propModeReplace names' hunk ./EwmhDesktops.hs 100 +setClientList :: [Window] -> X () +setClientList wins = withDisplay $ \dpy -> do + -- (What order do we really need? Something about age and stacking) + r <- asks theRoot + c <- getAtom "WINDOW" + a <- getAtom "_NET_CLIENT_LIST" + io $ changeProperty32 dpy r a c propModeReplace wins + a' <- getAtom "_NET_CLIENT_LIST_STACKING" + io $ changeProperty32 dpy r a' c propModeReplace wins + +setWindowDesktop :: (Integral a) => Window -> a -> X () +setWindowDesktop win i = withDisplay $ \dpy -> do + a <- getAtom "_NET_WM_DESKTOP" + c <- getAtom "CARDINAL" + io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i] hunk ./MetaModule.hs 37 +import XMonadContrib.EwmhDesktop () hunk ./MetaModule.hs 80 + hunk ./Grid.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} hunk ./NoBorders.hs 98 +smartBorders :: LayoutClass l a => l a -> ModifiedLayout SmartBorder l a hunk ./NoBorders.hs 60 - redoLayout (WithBorder n s) _ stack wrs = do + redoLayout (WithBorder n s) _ _ wrs = do hunk ./NoBorders.hs 83 - redoLayout (SmartBorder s) _ stack wrs = do + redoLayout (SmartBorder s) _ _ wrs = do hunk ./MetaModule.hs 37 -import XMonadContrib.EwmhDesktop () +import XMonadContrib.EwmhDesktops () hunk ./MetaModule.hs 44 +import XMonadContrib.Invisible () hunk ./MetaModule.hs 56 +import XMonadContrib.ResizableTile () hunk ./MetaModule.hs 72 +import XMonadContrib.TagWindows () hunk ./MetaModule.hs 83 - hunk ./ResizableTile.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} hunk ./Dishes.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} hunk ./MetaModule.hs 31 +import XMonadContrib.Dishes () addfile ./ManageDocks.hs hunk ./ManageDocks.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.ManageDocks +-- Copyright : (c) Joachim Breitner +-- License : BSD +-- +-- Maintainer : Joachim Breitner +-- Stability : unstable +-- Portability : unportable +-- +-- Makes xmonad detect windows with type DOCK and does not put them in +-- layouts. +----------------------------------------------------------------------------- +module XMonadContrib.ManageDocks ( + -- * Usage + -- $usage + manageDocksHook + ) where + +import Control.Monad.Reader +import XMonad +import Operations +import qualified StackSet as W +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +-- $usage +-- Add the imports to your configuration file and add the mangeHook: +-- +-- > import XMonadContrib.ManageDocks +-- +-- > manageHook w _ _ _ = manageDocksHook w + +-- %import XMonadContrib.ManageDocks +-- %def -- comment out default manageHook definition above if you uncomment this: +-- %def manageHook _ _ _ = manageDocksHook w + + +-- | +-- Deteckts if the given window is of type DOCK and if so, reveals it, but does +-- not manage it +manageDocksHook :: Window -> X (WindowSet -> WindowSet) +manageDocksHook w = do + isDock <- checkDock w + if isDock then do + reveal w + return (W.delete w) + else do + return id + +checkDock :: Window -> X (Bool) +checkDock w = do + a <- getAtom "_NET_WM_WINDOW_TYPE" + d <- getAtom "_NET_WM_WINDOW_TYPE_DOCK" + mbr <- withDisplay $ \dpy -> do + io $ getWindowProperty32 dpy a w + case mbr of + Just [r] -> return (r == d) + _ -> return False hunk ./MetaModule.hs 51 +import XMonadContrib.ManageDocks () hunk ./CopyWindow.hs 58 -copy :: WorkspaceId -> X () -copy n = windows copy' +copy n = copy' hunk ./Commands.hs 105 - fromMaybe (return ()) (M.lookup choice m) + case choice of + Just selection -> fromMaybe (return ()) (M.lookup selection m) + Nothing -> return () hunk ./DirectoryPrompt.hs 21 +import Data.Maybe(fromMaybe) + hunk ./DirectoryPrompt.hs 39 -getDirCompl s = (filter notboring . lines) `fmap` +getDirCompl s = (filter notboring . lines . fromMaybe "") `fmap` hunk ./Dmenu.hs 24 +import System.Exit hunk ./Dmenu.hs 36 -runProcessWithInput :: FilePath -> [String] -> String -> IO String +-- | Returns Just output if the command succeeded, and Nothing if it didn't. +-- This corresponds to dmenu's notion of exit code 1 for a cancelled invocation. +runProcessWithInput :: FilePath -> [String] -> String -> IO (Maybe String) hunk ./Dmenu.hs 47 - waitForProcess ph - return output - + exitCode <- waitForProcess ph + case exitCode of + ExitSuccess -> return (Just output) + ExitFailure _ -> return Nothing + hunk ./Dmenu.hs 54 -dmenuXinerama :: [String] -> X String +dmenuXinerama :: [String] -> X (Maybe String) hunk ./Dmenu.hs 59 -dmenu :: [String] -> X String +dmenu :: [String] -> X (Maybe String) hunk ./Dmenu.hs 62 - hunk ./ShellPrompt.hs 61 - f <- fmap lines $ runProcessWithInput "/bin/bash" [] ("compgen -A file " ++ s ++ "\n") + f <- fmap (lines . fromMaybe "") $ runProcessWithInput "/bin/bash" [] ("compgen -A file " ++ s ++ "\n") hunk ./WorkspaceDir.hs 71 -scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` \_ -> return x) - catchIO $ setCurrentDirectory x' +scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` \_ -> return Nothing) + case x' of + Just newDir -> catchIO $ setCurrentDirectory newDir + Nothing -> return () hunk ./DynamicLog.hs 24 - dynamicLog, dynamicLogXinerama, pprWindowSet, pprWindowSetXinerama + dynamicLog, dynamicLogWithTitle, dynamicLogWithTitleColored, dynamicLogXinerama, pprWindowSet, pprWindowSetXinerama hunk ./DynamicLog.hs 38 +import XMonadContrib.NamedWindows hunk ./DynamicLog.hs 46 +-- +-- To get the title of the currently focused window after the workspace list: +-- +-- > import XMonadContrib.DynamicLog +-- > logHook = dynamicLogWithTitle +-- +-- To have the window title highlighted in any color recognized by dzen: +-- +-- > import XMonadContrib.DynamicLog +-- > logHook = dynamicLogWithTitleColored "white" +-- hunk ./DynamicLog.hs 59 --- %def -- comment out default logHook definition above if you uncomment this: +-- %def -- comment out default logHook definition above if you uncomment any of these: hunk ./DynamicLog.hs 61 +-- %def logHook = dynamicLogWithTitle +-- %def logHook = dynamicLogWithTitleColored "white" hunk ./DynamicLog.hs 81 +-- Appends title of currently focused window to log output +-- Arguments are: pre-title text and post-title text +dynamicLogWithTitle_ :: String -> String -> X () +dynamicLogWithTitle_ pre post= do ld <- withWindowSet $ return . description . S.layout . S.workspace . S.current -- layout description + ws <- withWindowSet $ return . pprWindowSet -- workspace list + wt <- withWindowSet $ maybe (return "") (fmap show . getName) . S.peek -- window title + io . putStrLn $ "(" ++ ld ++ ") " ++ ws ++ " " ++ pre ++ wt ++ post + +dynamicLogWithTitle :: X () +dynamicLogWithTitle = dynamicLogWithTitle_ "<" ">" + +-- As dynamicLogWithTitle but with colored window title instead of angle brackets (works with dzen only) +dynamicLogWithTitleColored :: String -> X () +dynamicLogWithTitleColored color = dynamicLogWithTitle_ ("^fg(" ++ color ++ ")") "^fg()" + hunk ./SwitchTrans.hs 26 +-- Another potential problem is that functions can't be (de-)serialized so this +-- layout will not preserve state across xmonad restarts. +-- hunk ./SwitchTrans.hs 33 --- > mkSwitch (M.singleton "full" (const $ noBorders full)) . --- > mkSwitch (M.singleton "mirror" mirror) --- > ) [ tiled ] +-- > mkSwitch (M.singleton "full" (const $ Layout $ noBorders full)) . +-- > mkSwitch (M.singleton "mirror" (Layout . Mirror)) +-- > ) [ Layout tiled ] hunk ./SwitchTrans.hs 56 --- The reason I use two stacked @SwitchTrans@ transformers instead of --- @mkSwitch (M.fromList [("full", const $ noBorders full), ("mirror", mirror)])@ --- is that I use @mod-f@ to \"zoom in\" on interesting windows, no matter what other --- layout transformers may be active. Having an extra fullscreen mode on top of --- everything else means I can zoom in and out without implicitly undoing \"normal\" --- layout transformers, like @mirror@. Remember, inside a @SwitchTrans@ there can --- be at most one active layout transformer. +-- The reason I use two stacked @SwitchTrans@ transformers instead of @mkSwitch +-- (M.fromList [("full", const $ Layout $ noBorders Full), ("mirror", Layout . +-- Mirror)])@ is that I use @mod-f@ to \"zoom in\" on interesting windows, no +-- matter what other layout transformers may be active. Having an extra +-- fullscreen mode on top of everything else means I can zoom in and out +-- without implicitly undoing \"normal\" layout transformers, like @Mirror@. +-- Remember, inside a @SwitchTrans@ there can be at most one active layout +-- transformer. hunk ./SwitchTrans.hs 89 -data State a = State { +data SwitchTrans a = SwitchTrans { hunk ./SwitchTrans.hs 97 +instance Show (SwitchTrans a) where + show st = "SwitchTrans #<" ++ show (base st) ++ " " ++ show (currTag st) ++ " " ++ show (currLayout st) ++ "...>" + +instance Read (SwitchTrans a) where + readsPrec _ _ = [] + +unLayout :: Layout a -> (forall l. (LayoutClass l a) => l a -> r) -> r +unLayout (Layout l) k = k l + +instance LayoutClass SwitchTrans a where + description _ = "SwitchTrans" + + doLayout st r s = currLayout st `unLayout` \l -> do + (x, _) <- doLayout l r s + return (x, Nothing) -- sorry Dave, I still can't let you do that + + pureLayout st r s = currLayout st `unLayout` \l -> pureLayout l r s + + handleMessage st m + | Just (Disable tag) <- fromMessage m + , M.member tag (filters st) + = provided (currTag st == Just tag) $ disable + | Just (Enable tag) <- fromMessage m + , Just alt <- M.lookup tag (filters st) + = provided (currTag st /= Just tag) $ enable tag alt + | Just (Toggle tag) <- fromMessage m + , Just alt <- M.lookup tag (filters st) + = + if (currTag st == Just tag) then + disable + else + enable tag alt + | otherwise = base st `unLayout` \b -> do + x <- handleMessage b m + case x of + Nothing -> return Nothing + Just b' -> currLayout st `unLayout` \cl -> do + handleMessage cl (SomeMessage ReleaseResources) + let b'' = Layout b' + return . Just $ st{ base = b'', currLayout = currFilt st b'' } + where + enable tag alt = currLayout st `unLayout` \cl -> do + handleMessage cl (SomeMessage ReleaseResources) + return . Just $ st{ + currTag = Just tag, + currFilt = alt, + currLayout = alt (base st) } + disable = currLayout st `unLayout` \cl -> do + handleMessage cl (SomeMessage ReleaseResources) + return . Just $ st{ + currTag = Nothing, + currFilt = id, + currLayout = base st } + hunk ./SwitchTrans.hs 154 -mkSwitch fs b = switched st +mkSwitch fs b = Layout st hunk ./SwitchTrans.hs 156 - st = State{ + st = SwitchTrans{ hunk ./SwitchTrans.hs 168 -switched :: State a -> Layout a -switched - state@State{ - base = b, - currTag = ct, - currLayout = cl, - currFilt = cf, - filters = fs - } = Layout {doLayout = dl, modifyLayout = ml} - where - enable tag alt = do - modifyLayout cl (SomeMessage UnDoLayout) - return . Just . switched $ state{ - currTag = Just tag, - currFilt = alt, - currLayout = alt b } - disable = do - modifyLayout cl (SomeMessage UnDoLayout) - return . Just . switched $ state{ - currTag = Nothing, - currFilt = id, - currLayout = b } - dl r s = do - (x, _) <- doLayout cl r s - return (x, Nothing) -- sorry Dave, I can't let you do that - ml m - | Just (Disable tag) <- fromMessage m - , M.member tag fs - = provided (ct == Just tag) $ disable - | Just (Enable tag) <- fromMessage m - , Just alt <- M.lookup tag fs - = provided (ct /= Just tag) $ enable tag alt - | Just (Toggle tag) <- fromMessage m - , Just alt <- M.lookup tag fs - = - if (ct == Just tag) then - disable - else - enable tag alt - | Just UnDoLayout <- fromMessage m - = do - modifyLayout cl m - return Nothing - | otherwise = do - x <- modifyLayout b m - case x of - Nothing -> return Nothing - Just b' -> do - modifyLayout cl (SomeMessage UnDoLayout) - return . Just $ switched state{ - base = b', - currLayout = cf b' } hunk ./Dishes.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE FlexibleInstances #-} hunk ./Grid.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE FlexibleInstances #-} hunk ./MosaicAlt.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} hunk ./ResizableTile.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-} hunk ./WindowNavigation.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-} hunk ./SwitchTrans.hs 22 --- receive any messages; any message not handled by @SwitchTrans@ itself --- will undo the current layout transformer, pass the message on to the base --- layout, then reapply the transformer. +-- receive any messages; any message not handled by @SwitchTrans@ itself will +-- undo the current layout transformer, pass the message on to the base layout, +-- then reapply the transformer. (This happens to break +-- "XMonadContrib.NoBorders" and any transformer that updates its state on +-- @doLayout@ calls :-( ) hunk ./SwitchTrans.hs 35 --- > mkSwitch (M.singleton "full" (const $ Layout $ noBorders full)) . +-- > mkSwitch (M.singleton "full" (const $ Layout full)) . hunk ./SwitchTrans.hs 39 --- (The noBorders transformer is from "XMonadContrib.NoBorders".) --- hunk ./SwitchTrans.hs 57 --- (M.fromList [("full", const $ Layout $ noBorders Full), ("mirror", Layout . +-- (M.fromList [(\"full\", const $ Layout Full), (\"mirror\", Layout . hunk ./SwitchTrans.hs 79 +-- import System.IO + + hunk ./SwitchTrans.hs 101 - show st = "SwitchTrans #<" ++ show (base st) ++ " " ++ show (currTag st) ++ " " ++ show (currLayout st) ++ "...>" + show st = "SwitchTrans #" hunk ./SwitchTrans.hs 132 + | Just ReleaseResources <- fromMessage m + = currLayout st `unLayout` \cl -> do + handleMessage cl m + return Nothing hunk ./SwitchTrans.hs 146 + -- io $ hPutStrLn stderr $ "[ST]+ " ++ show cl ++ " -> " ++ show (alt (base st)) hunk ./SwitchTrans.hs 153 + -- io $ hPutStrLn stderr $ "[ST]- " ++ show cl ++ " -> " ++ show (base st) addfile ./MouseGestures.hs hunk ./MouseGestures.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.MouseGestures +-- Copyright : (c) Lukas Mai +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Support for simple mouse gestures +-- +----------------------------------------------------------------------------- + +module XMonadContrib.MouseGestures ( + -- * Usage + -- $usage + Direction(..), + mouseGesture +) where + +import XMonad +import Operations +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +import Control.Monad.Reader +import Data.IORef +import qualified Data.Map as M +import Data.Map (Map) + +import System.IO + +-- $usage +-- In your Config.hs: +-- +-- > import XMonadContrib.MouseGestures +-- > ... +-- > mouseBindings = M.fromList $ +-- > [ ... +-- > , ((modMask .|. shiftMask, button3), mouseGesture gestures) +-- > ] +-- > where +-- > gestures = M.fromList +-- > [ ([], focus) +-- > , ([U], \w -> focus w >> windows W.swapUp) +-- > , ([D], \w -> focus w >> windows W.swapDown) +-- > , ([R, D], \_ -> sendMessage NextLayout) +-- > ] +-- +-- This is just an example, of course. You can use any mouse button and +-- gesture definitions you want. + +data Direction = L | U | R | D + deriving (Eq, Ord, Show, Read, Enum, Bounded) + +type Pos = (Position, Position) + +delta :: Pos -> Pos -> Position +delta (ax, ay) (bx, by) = max (d ax bx) (d ay by) + where + d a b = abs (a - b) + +dir :: Pos -> Pos -> Direction +dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax) + where + trans :: Double -> Direction + trans x + | rg (-3/4) (-1/4) x = D + | rg (-1/4) (1/4) x = R + | rg (1/4) (3/4) x = U + | otherwise = L + rg a z x = a <= x && x < z + +debugging :: Int +debugging = 0 + +collect :: IORef (Pos, [(Direction, Pos, Pos)]) -> Position -> Position -> X () +collect st nx ny = do + let np = (nx, ny) + stx@(op, ds) <- io $ readIORef st + when (debugging > 0) $ io $ putStrLn $ show "Mouse Gesture" ++ unwords (map show (extract stx)) ++ (if debugging > 1 then "; " ++ show op ++ "-" ++ show np else "") + case ds of + [] + | insignificant np op -> return () + | otherwise -> io $ writeIORef st (op, [(dir op np, np, op)]) + (d, zp, ap_) : ds' + | insignificant np zp -> return () + | otherwise -> do + let + d' = dir zp np + ds'' + | d == d' = (d, np, ap_) : ds' + | otherwise = (d', np, zp) : ds + io $ writeIORef st (op, ds'') + where + insignificant a b = delta a b < 10 + +extract :: (Pos, [(Direction, Pos, Pos)]) -> [Direction] +extract (_, xs) = reverse . map (\(x, _, _) -> x) $ xs + +mouseGesture :: Map [Direction] (Window -> X ()) -> Window -> X () +mouseGesture tbl win = withDisplay $ \dpy -> do + root <- asks theRoot + let win' = if win == none then root else win + acc <- io $ do + qp@(_, _, _, ix, iy, _, _, _) <- queryPointer dpy win' + when (debugging > 1) $ putStrLn $ show "queryPointer" ++ show qp + when (debugging > 1 && win' == none) $ putStrLn $ show "mouseGesture" ++ "zomg none" + newIORef ((fromIntegral ix, fromIntegral iy), []) + mouseDrag (collect acc) $ do + when (debugging > 0) $ io $ putStrLn $ show "" + gest <- io $ liftM extract $ readIORef acc + case M.lookup gest tbl of + Nothing -> return () + Just f -> f win' hunk ./MetaModule.hs 71 --- import XMonadContrib.SwitchTrans () hunk ./MetaModule.hs 72 +import XMonadContrib.SwitchTrans () hunk ./MetaModule.hs 56 +import XMonadContrib.MouseGestures () hunk ./ShellPrompt.hs 29 +import Data.Maybe hunk ./Tabbed.hs 153 + where + width = rect_width screen`div` fromIntegral (length tws) +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) + (PropertyEvent {ev_window = thisw }) hunk ./Tabbed.hs 158 - | thisw `elem` (map snd tws) && t == propertyNotify = do + | thisw `elem` (map snd tws) = do hunk ./MetaModule.hs 64 --- XMonadContrib.ShellPrompt depends on readline ---import XMonadContrib.ShellPrompt () +import XMonadContrib.ShellPrompt () hunk ./EwmhDesktops.hs 30 +import XMonadContrib.SetWMName + hunk ./EwmhDesktops.hs 56 + setSupported + hunk ./EwmhDesktops.hs 120 +setSupported :: X () +setSupported = withDisplay $ \dpy -> do + r <- asks theRoot + a <- getAtom "_NET_SUPPORTED" + c <- getAtom "ATOM" + supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"] + io $ changeProperty32 dpy r a c propModeReplace supp + + setWMName "xmonad" + + + hunk ./MetaModule.hs 58 +import XMonadContrib.NextWorkspace () addfile ./NextWorkspace.hs hunk ./NextWorkspace.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.NextWorkspace +-- Copyright : (c) Joachim Breitner +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Joachim Breitner +-- Stability : unstable +-- Portability : unportable +-- +-- Provides bindings to cycle forward or backward through the list +-- of workspaces, and to move windows there. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.NextWorkspace ( + -- * Usage + -- $usage + nextWorkspace, + prevWorkspace, + shiftToNext, + shiftToPrev, + ) where + +import Control.Monad.State ( gets ) +import Data.List ( sortBy, findIndex ) +import Data.Maybe ( fromMaybe ) +import Data.Ord ( comparing ) + +import XMonad +import StackSet hiding (filter, findIndex) +import Operations +import {-# SOURCE #-} qualified Config (workspaces) + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.NextWorkspace +-- +-- > , ((modMask, xK_Right), nextWorkspace) +-- > , ((modMask, xK_Left), prevWorkspace) +-- > , ((modMask .|. shiftMask, xK_Right), shiftToNext) +-- > , ((modMask .|. shiftMask, xK_Left), shiftToPrev) + +-- %import XMonadContrib.RotView +-- %keybind , ((modMask .|. shiftMask, xK_Right), rotView True) +-- %keybind , ((modMask .|. shiftMask, xK_Left), rotView False) + + +-- --------------------- +-- | +-- Switch to next workspace +nextWorkspace :: X() +nextWorkspace = switchWorkspace (1) + +-- --------------------- +-- | +-- Switch to previous workspace +prevWorkspace :: X() +prevWorkspace = switchWorkspace (-1) + +-- | +-- Move focused window to next workspace +shiftToNext :: X() +shiftToNext = shiftBy (1) + +-- | +-- Move focused window to previous workspace +shiftToPrev :: X () +shiftToPrev = shiftBy (-1) + +switchWorkspace :: Int -> X () +switchWorkspace d = wsBy d >>= windows . greedyView + +shiftBy :: Int -> X () +shiftBy d = wsBy d >>= windows . shift + +wsBy :: Int -> X (WorkspaceId) +wsBy d = do + ws <- gets windowset + let orderedWs = sortBy (comparing wsIndex) (workspaces ws) + let now = fromMaybe 0 $ findWsIndex (workspace (current ws)) orderedWs + let next = orderedWs !! ((now + d) `mod` length orderedWs) + return $ tag next + + +wsIndex :: WindowSpace -> Maybe Int +wsIndex ws = findIndex (==(tag ws)) Config.workspaces + +findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int +findWsIndex ws wss = findIndex ((== tag ws) . tag) wss hunk ./NextWorkspace.hs 44 +-- +-- If you want to follow the moved window, you can use both actions: +-- +-- > , ((modMask .|. shiftMask, xK_Right), shiftToNext >> nextWorkspace) +-- > , ((modMask .|. shiftMask, xK_Left), shiftToPrev >> prevWorkspace) +-- hunk ./ManageDocks.hs 12 --- layouts. +-- layouts. It also detects window with STRUT set and modifies the +-- gap accordingly. +-- +-- Cheveats: +-- +-- * Only acts on STRUT apps on creation, not if you move or close them +-- +-- * To reset the gap, press Mod-b twice and restart xmonad (Mod-q) hunk ./ManageDocks.hs 33 +import Data.Word hunk ./ManageDocks.hs 48 --- Deteckts if the given window is of type DOCK and if so, reveals it, but does --- not manage it +-- Detects if the given window is of type DOCK and if so, reveals it, but does +-- not manage it. If the window has the STRUT property set, adjust the gap accordingly. hunk ./ManageDocks.hs 52 + hasStrut <- getStrut w + maybe (return ()) setGap hasStrut + hunk ./ManageDocks.hs 62 +-- | +-- Checks if a window is a DOCK window hunk ./ManageDocks.hs 68 - mbr <- withDisplay $ \dpy -> do - io $ getWindowProperty32 dpy a w + mbr <- getProp a w hunk ./ManageDocks.hs 73 +-- | +-- Gets the STRUT config, if present, in xmonad gap order +getStrut :: Window -> X (Maybe (Int, Int, Int, Int)) +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 + +-- | +-- Helper to read a property +getProp :: Atom -> Window -> X (Maybe [Word32]) +getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w + +-- | +-- Modifies the gap, setting new max +setGap :: (Int, Int, Int, Int) -> X () +setGap gap = modifyGap (\_ -> max4 gap) + +-- | +-- 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) + hunk ./CycleWS.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.CycleWS --- Copyright : (C) 2007 Andrea Rossato --- License : BSD3 --- --- Maintainer : andrea.rossato@unibz.it --- Stability : unstable --- Portability : unportable --- --- A module to cycle between Workspaces --- ------------------------------------------------------------------------------ - -module XMonadContrib.CycleWS ( - -- * Usage - -- $usage - nextWS - , prevWS - ) where - -import XMonad -import Operations -import qualified StackSet as W -import {-# SOURCE #-} Config (workspaces) -import Data.List - --- $usage --- Import this module in Config.hs: --- --- > import XMonadContrib.CycleWS --- --- And add, in you key bindings: --- --- > , ((modMask , xK_comma ), prevWS ) --- > , ((modMask , xK_period), nextWS ) - -nextWS, prevWS :: X () -nextWS = withWindowSet $ \s -> windows $ W.view (workspaces !! (setWS s N)) -prevWS = withWindowSet $ \s -> windows $ W.view (workspaces !! (setWS s P)) - -data Dir = P | N deriving Eq -setWS :: WindowSet -> Dir -> Int -setWS s d - | d == N && cur == (lw - 1) = 0 - | d == N = cur + 1 - | d == P && cur == 0 = lw - 1 - | otherwise = cur - 1 - where - cur = maybe 0 id $ elemIndex (W.tag (W.workspace ((W.current s)))) workspaces - lw = length workspaces rmfile ./CycleWS.hs move ./NextWorkspace.hs ./CycleWS.hs hunk ./CycleWS.hs 3 --- Module : XMonadContrib.NextWorkspace +-- Module : XMonadContrib.CycleWS hunk ./CycleWS.hs 16 -module XMonadContrib.NextWorkspace ( +module XMonadContrib.CycleWS ( hunk ./CycleWS.hs 19 - nextWorkspace, - prevWorkspace, + nextWS, + prevWS, hunk ./CycleWS.hs 40 --- > , ((modMask, xK_Right), nextWorkspace) --- > , ((modMask, xK_Left), prevWorkspace) +-- > , ((modMask, xK_Right), nextWS) +-- > , ((modMask, xK_Left), prevWWS) hunk ./CycleWS.hs 47 --- > , ((modMask .|. shiftMask, xK_Right), shiftToNext >> nextWorkspace) --- > , ((modMask .|. shiftMask, xK_Left), shiftToPrev >> prevWorkspace) +-- > , ((modMask .|. shiftMask, xK_Right), shiftToNext >> nextWS) +-- > , ((modMask .|. shiftMask, xK_Left), shiftToPrev >> prevWS) hunk ./CycleWS.hs 51 --- %import XMonadContrib.RotView --- %keybind , ((modMask .|. shiftMask, xK_Right), rotView True) --- %keybind , ((modMask .|. shiftMask, xK_Left), rotView False) +-- %import XMonadContrib.NextWorkspace +-- %keybind , ((modMask, xK_Right), nextWS) +-- %keybind , ((modMask, xK_Left), prevWWS) +-- %keybind , ((modMask .|. shiftMask, xK_Right), shiftToNext) +-- %keybind , ((modMask .|. shiftMask, xK_Left), shiftToPrev) hunk ./CycleWS.hs 61 -nextWorkspace :: X() -nextWorkspace = switchWorkspace (1) +nextWS :: X() +nextWS = switchWorkspace (1) hunk ./CycleWS.hs 67 -prevWorkspace :: X() -prevWorkspace = switchWorkspace (-1) +prevWS :: X() +prevWS = switchWorkspace (-1) hunk ./MetaModule.hs 58 -import XMonadContrib.NextWorkspace () hunk ./ShellPrompt.hs 19 - , rmPath hunk ./ShellPrompt.hs 64 - return $ map escape . sort . nub $ f ++ c + return . map escape . sort . nub $ f ++ c hunk ./ShellPrompt.hs 68 -commandCompletionFunction str +commandCompletionFunction str hunk ./ShellPrompt.hs 71 - p <- getEnv "PATH" - cl p - where - cl = liftM (nub . rmPath . concat) . mapM cmpl . split ':' - cmpl s = filter (isPrefixOf str) `fmap` getFileNames s + 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) + else return [] + return . filter (isPrefixOf str) . concat $ es hunk ./ShellPrompt.hs 81 -getFileNames :: FilePath -> IO [FilePath] -getFileNames fp = - getDirectoryContents fp `catch` \_ -> return [] - -rmPath :: [String] -> [String] -rmPath s = - map (reverse . fst . break (=='/') . reverse) s +isExecutable :: FilePath ->IO Bool +isExecutable f = do + fe <- doesFileExist f + if fe + then fmap executable $ getPermissions f + else return False hunk ./ShellPrompt.hs 94 - rest s | s == [] = [] + rest s | s == [] = [] hunk ./ShellPrompt.hs 102 - | otherwise = x : escape xs + | otherwise = x : escape xs hunk ./Dmenu.hs 6 --- +-- hunk ./Dmenu.hs 17 - -- $usage - dmenu, dmenuXinerama, + -- $usage + dmenu, dmenuXinerama, dmenuMap, hunk ./Dmenu.hs 24 +import qualified Data.Map as M hunk ./Dmenu.hs 63 +dmenuMap :: M.Map String a -> X (Maybe a) +dmenuMap selectionMap = + dmenu (M.keys selectionMap) >>= return . maybe Nothing (flip M.lookup selectionMap) + addfile ./WindowBringer.hs hunk ./WindowBringer.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.WindowBringer +-- Copyright : Devin Mullins +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Devin Mullins +-- Stability : unstable +-- Portability : unportable +-- +-- dmenu operations to bring windows to you, and bring you to windows. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.WindowBringer ( + -- * Usage + -- $usage + gotoMenu + ) where + +import Control.Monad.State (gets) +import Data.Char (toLower) +import qualified Data.Map as M +import Graphics.X11.Xlib (Window()) + +import Operations (windows) +import qualified StackSet as W +import XMonad (X) +import qualified XMonad as X +import XMonadContrib.Dmenu (dmenuMap) +import XMonadContrib.NamedWindows (getName) + +-- $usage +-- WindowBringer brings you to windows. (A future edition will bring windows to +-- you.) +-- +-- Place in your Config.hs: +-- > import XMonadContrib.WindowBringer +-- and in the keys definition: +-- > , ((modMask .|. shiftMask, xK_g ), gotoMenu) +-- +-- %import XMonadContrib.WindowBringer +-- %keybind ((modMask .|. shiftMask, xK_g ), gotoMenu) + +-- | Pops open a dmenu with window titles. Choose one, and you will be +-- taken to the corresponding workspace. +gotoMenu :: X () +gotoMenu = do + workspaceMap >>= dmenuMap >>= flip X.whenJust (windows . W.greedyView) + +-- | A map from decorated window name to target workspace ID, for use by gotoMenu. +workspaceMap :: X (M.Map String X.WorkspaceId) +workspaceMap = do + ws <- gets X.windowset + M.fromList `fmap` concat `fmap` mapM keyValuePairs (W.workspaces ws) + where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws) + keyValuePair ws w = flip (,) (W.tag ws) `fmap` decorateName ws w + +-- | Returns the window name as will be listed in dmenu. +-- Lowercased, for your convenience (since dmenu is case-sensitive). +-- Tagged with the workspace ID, to guarantee uniqueness, and to let the user know where he's going. +decorateName :: X.WindowSpace -> Window -> X String +decorateName ws w = do + name <- fmap (map toLower . show) $ getName w + return $ name ++ " [" ++ W.tag ws ++ "]" hunk ./Commands.hs 105 - case choice of - Just selection -> fromMaybe (return ()) (M.lookup selection m) - Nothing -> return () + fromMaybe (return ()) (M.lookup choice m) hunk ./DirectoryPrompt.hs 21 -import Data.Maybe(fromMaybe) - hunk ./DirectoryPrompt.hs 37 -getDirCompl s = (filter notboring . lines . fromMaybe "") `fmap` +getDirCompl s = (filter notboring . lines) `fmap` hunk ./Dmenu.hs 25 -import System.Exit hunk ./Dmenu.hs 38 -runProcessWithInput :: FilePath -> [String] -> String -> IO (Maybe String) +runProcessWithInput :: FilePath -> [String] -> String -> IO String hunk ./Dmenu.hs 47 - exitCode <- waitForProcess ph - case exitCode of - ExitSuccess -> return (Just output) - ExitFailure _ -> return Nothing + waitForProcess ph + return output hunk ./Dmenu.hs 52 -dmenuXinerama :: [String] -> X (Maybe String) +dmenuXinerama :: [String] -> X String hunk ./Dmenu.hs 57 -dmenu :: [String] -> X (Maybe String) +dmenu :: [String] -> X String hunk ./Dmenu.hs 61 -dmenuMap selectionMap = - dmenu (M.keys selectionMap) >>= return . maybe Nothing (flip M.lookup selectionMap) +dmenuMap selectionMap = do + selection <- dmenu (M.keys selectionMap) + return $ M.lookup selection selectionMap hunk ./ShellPrompt.hs 28 -import Data.Maybe hunk ./ShellPrompt.hs 60 - f <- fmap (lines . fromMaybe "") $ runProcessWithInput "/bin/bash" [] ("compgen -A file " ++ s ++ "\n") + f <- fmap lines $ runProcessWithInput "/bin/bash" [] ("compgen -A file " ++ s ++ "\n") hunk ./WorkspaceDir.hs 71 -scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` \_ -> return Nothing) - case x' of - Just newDir -> catchIO $ setCurrentDirectory newDir - Nothing -> return () +scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` \_ -> return x) + catchIO $ setCurrentDirectory x' hunk ./MetaModule.hs 82 +import XMonadContrib.WindowBringer () hunk ./NoBorders.hs 45 --- > defaultLayouts = [ noBorders full, ... ] +-- > defaultLayouts = [ Layout (noBorders Full), ... ] hunk ./NoBorders.hs 49 --- %layout , noBorders full +-- %layout , noBorders Full hunk ./FlexibleManipulate.hs 82 - nwidth = applySizeHints sh $ mapP round (nbr - ntl) + nwidth = applySizeHints sh $ mapP (round :: Double -> Integer) (nbr - ntl) hunk ./SwitchTrans.hs 24 --- then reapply the transformer. (This happens to break --- "XMonadContrib.NoBorders" and any transformer that updates its state on --- @doLayout@ calls :-( ) +-- then reapply the transformer. hunk ./SwitchTrans.hs 33 --- > mkSwitch (M.singleton "full" (const $ Layout full)) . --- > mkSwitch (M.singleton "mirror" (Layout . Mirror)) +-- > mkSwitch (M.fromList [ +-- > ("full", const $ Layout $ noBorders Full) +-- > ]) . +-- > mkSwitch (M.fromList [ +-- > ("mirror", Layout . Mirror) +-- > ]) hunk ./SwitchTrans.hs 41 +-- (The @noBorders@ transformer is from "XMonadContrib.NoBorders".) +-- hunk ./SwitchTrans.hs 61 --- (M.fromList [(\"full\", const $ Layout Full), (\"mirror\", Layout . --- Mirror)])@ is that I use @mod-f@ to \"zoom in\" on interesting windows, no --- matter what other layout transformers may be active. Having an extra --- fullscreen mode on top of everything else means I can zoom in and out +-- (M.fromList [(\"full\", const $ Layout $ noBorders Full), (\"mirror\", +-- Layout . Mirror)])@ is that I use @mod-f@ to \"zoom in\" on interesting +-- windows, no matter what other layout transformers may be active. Having an +-- extra fullscreen mode on top of everything else means I can zoom in and out hunk ./SwitchTrans.hs 117 - (x, _) <- doLayout l r s - return (x, Nothing) -- sorry Dave, I still can't let you do that + (x, y) <- doLayout l r s + case y of + Nothing -> return (x, Nothing) + -- ok, Dave; but just this one time + Just l' -> return (x, Just $ st{ currLayout = Layout l' }) hunk ./ManageDocks.hs 41 +-- +-- and comment out the default `manageHook _ _ _ _ = return id` line. hunk ./ManageDocks.hs 46 --- %def manageHook _ _ _ = manageDocksHook w +-- %def manageHook w _ _ _ = manageDocksHook w hunk ./Tabbed.hs 145 - where - width = rect_width screen`div` fromIntegral (length tws) - -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) - (AnyEvent {ev_window = thisw, ev_event_type = t }) --- expose - | thisw `elem` (map fst tws) && t == expose = do - updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws) - where - width = rect_width screen`div` fromIntegral (length tws) -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) - (PropertyEvent {ev_window = thisw }) + where width = rect_width screen `div` fromIntegral (length tws) hunk ./Tabbed.hs 147 - | thisw `elem` (map snd tws) = do +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) + (PropertyEvent {ev_window = thisw }) + | thisw `elem` (map snd tws) = do hunk ./Tabbed.hs 152 - where - width = rect_width screen`div` fromIntegral (length tws) + where width = rect_width screen `div` fromIntegral (length tws) +-- expose +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) + (ExposeEvent {ev_window = thisw }) + | thisw `elem` (map fst tws) = do + updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws) + where width = rect_width screen `div` fromIntegral (length tws) hunk ./XPrompt.hs 215 - | t == keyPress && ks == xK_Tab = do + | t == keyPress && ks == xK_Tab = do hunk ./XPrompt.hs 220 -handle _ (AnyEvent {ev_event_type = t, ev_window = w}) - | t == expose = do +handle _ (ExposeEvent {ev_window = w}) = do hunk ./ShellPrompt.hs 6 --- +-- hunk ./ShellPrompt.hs 19 + , getShellCompl hunk ./ShellPrompt.hs 59 -getShellCompl s +getShellCompl s hunk ./ShellPrompt.hs 73 - fp d f = d ++ "/" ++ f + fp d f = d ++ "/" ++ f hunk ./ShellPrompt.hs 92 - where + where hunk ./DragPane.hs 61 - DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double + DragPane (Invisible Maybe (Window,Rectangle,Rectangle,Int)) DragType Double Double hunk ./DragPane.hs 75 -handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x +handleMess d@(DragPane mb@(I (Just (win,_,_,ident))) ty delta split) x hunk ./DragPane.hs 90 -handleEvent (DragPane (I (Just (win,r,ident))) ty _ _) +handleEvent (DragPane (I (Just (win,_,r,ident))) ty _ _) hunk ./DragPane.hs 99 -handleEvent _ _ = return () +handleEvent (DragPane (I (Just (win,oret,_,_))) _ _ _) + (ExposeEvent {ev_window = thisw }) + | thisw == win = do + updateDragWin win oret + return () +handleEvent _ _ = return () hunk ./DragPane.hs 125 - I (Just (w,_,ident)) -> do + I (Just (w,_,_,ident)) -> do hunk ./DragPane.hs 127 - return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split) + return (wrs, Just $ DragPane (I $ Just (w',r,r',ident)) ty delta split) hunk ./DragPane.hs 131 - return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split) + return (wrs, Just $ DragPane (I $ Just (w,r,r',hashUnique i)) ty delta split) hunk ./DragPane.hs 139 - paintWindow w wh ht 0 handleColor handleColor hunk ./DragPane.hs 140 + paintWindow w wh ht 0 handleColor handleColor hunk ./DragPane.hs 143 +updateDragWin :: Window -> Rectangle -> X () +updateDragWin w (Rectangle _ _ wh ht) = do + paintWindow w wh ht 0 handleColor handleColor + hunk ./WindowBringer.hs 16 - -- * Usage - -- $usage - gotoMenu - ) where + -- * Usage + -- $usage + gotoMenu, bringMenu + ) where hunk ./WindowBringer.hs 41 +-- > , ((modMask .|. shiftMask, xK_b ), bringMenu) hunk ./WindowBringer.hs 45 +-- %keybind ((modMask .|. shiftMask, xK_b ), bringMenu) hunk ./WindowBringer.hs 50 -gotoMenu = do - workspaceMap >>= dmenuMap >>= flip X.whenJust (windows . W.greedyView) +gotoMenu = workspaceMap >>= actionMenu (windows . W.greedyView) + where workspaceMap = windowMapWith (W.tag . fst) hunk ./WindowBringer.hs 53 --- | A map from decorated window name to target workspace ID, for use by gotoMenu. -workspaceMap :: X (M.Map String X.WorkspaceId) -workspaceMap = do +-- | Pops open a dmenu with window titles. Choose one, and it will be +-- dragged, kicking and screaming, into your current workspace. +bringMenu :: X () +bringMenu = windowMap >>= actionMenu (windows . bringWindow) + where windowMap = windowMapWith snd + bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws + +-- | Calls dmenuMap to grab the appropriate element from the Map, and hands it +-- off to action if found. +actionMenu :: (a -> X ()) -> M.Map String a -> X () +actionMenu action windowMap = dmenuMap windowMap >>= flip X.whenJust action + +-- | Generates a Map from window name to . For use with +-- dmenuMap. TODO: extract the pure, creamy center. +windowMapWith :: ((X.WindowSpace, Window) -> a) -> X (M.Map String a) +windowMapWith value = do hunk ./WindowBringer.hs 72 - keyValuePair ws w = flip (,) (W.tag ws) `fmap` decorateName ws w + keyValuePair ws w = flip (,) (value (ws, w)) `fmap` decorateName ws w hunk ./WindowBringer.hs 34 --- WindowBringer brings you to windows. (A future edition will bring windows to --- you.) +-- WindowBringer brings windows to you and you to windows. +-- That is to say, it pops up a dmenu with window names, in case you forgot +-- where you left your XChat. hunk ./SwitchTrans.hs 113 +acceptChange :: (LayoutClass l a) => SwitchTrans a -> ((l a -> SwitchTrans a) -> b -> c) -> X b -> X c +acceptChange st f action = + -- seriously, Dave, you need to stop this + fmap (f (\l -> st{ currLayout = Layout l})) action + hunk ./SwitchTrans.hs 121 - doLayout st r s = currLayout st `unLayout` \l -> do - (x, y) <- doLayout l r s - case y of - Nothing -> return (x, Nothing) - -- ok, Dave; but just this one time - Just l' -> return (x, Just $ st{ currLayout = Layout l' }) + doLayout st r s = currLayout st `unLayout` \l -> + acceptChange st (fmap . fmap) (doLayout l r s) hunk ./SwitchTrans.hs 129 - = provided (currTag st == Just tag) $ disable + = provided (currTag st == Just tag) $ disable hunk ./SwitchTrans.hs 132 - = provided (currTag st /= Just tag) $ enable tag alt + = provided (currTag st /= Just tag) $ enable tag alt hunk ./SwitchTrans.hs 135 - = + = hunk ./SwitchTrans.hs 141 - = currLayout st `unLayout` \cl -> do - handleMessage cl m - return Nothing + = currLayout st `unLayout` \cl -> + acceptChange st fmap (handleMessage cl m) + | Just Hide <- fromMessage m + = currLayout st `unLayout` \cl -> + acceptChange st fmap (handleMessage cl m) hunk ./Accordion.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} hunk ./Circle.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} + hunk ./Combo.hs 1 -{-# OPTIONS_GHC -fallow-undecidable-instances #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} hunk ./Dishes.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fglasgow-exts #-} hunk ./DragPane.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} hunk ./FlexibleManipulate.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} + hunk ./Grid.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fglasgow-exts #-} hunk ./LayoutHints.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} hunk ./LayoutModifier.hs 1 -{-# LANGUAGE MultiParamTypeClasses #-} +{-# -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} hunk ./LayoutScreens.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} hunk ./MagicFocus.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} hunk ./Magnifier.hs 2 + hunk ./Maximize.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} hunk ./Mosaic.hs 2 + hunk ./MosaicAlt.hs 1 -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# OPTIONS -fglasgow-exts #-} hunk ./NoBorders.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} hunk ./ResizableTile.hs 1 -{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-} +{-# OPTIONS_GHC -fglasgow-exts #-} hunk ./Roledex.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-} hunk ./Spiral.hs 1 -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} hunk ./Square.hs 1 -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + hunk ./SwitchTrans.hs 2 + hunk ./Tabbed.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} + hunk ./ThreeColumns.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} hunk ./TwoPane.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} hunk ./WindowNavigation.hs 1 -{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-} +{-# OPTIONS -fglasgow-exts #-} hunk ./WorkspaceDir.hs 1 -{-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} hunk ./Dishes.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + hunk ./Grid.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + hunk ./MosaicAlt.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-} + hunk ./ResizableTile.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} + hunk ./WindowNavigation.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-} + hunk ./DragPane.hs 139 - w <- createNewWindow r mask + w <- createNewWindow r mask handleColor hunk ./DragPane.hs 141 - paintWindow w wh ht 0 handleColor handleColor hunk ./DragPane.hs 144 -updateDragWin w (Rectangle _ _ wh ht) = do - paintWindow w wh ht 0 handleColor handleColor +updateDragWin w (Rectangle _ _ wh ht) = return () hunk ./Tabbed.hs 175 - w <- createNewWindow (Rectangle x y wid height) mask + w <- createNewWindow (Rectangle x y wid height) mask (inactiveColor c) hunk ./XUtils.hs 69 -createNewWindow :: Rectangle -> Maybe EventMask -> X Window -createNewWindow (Rectangle x y w h) m = do +createNewWindow :: Rectangle -> Maybe EventMask -> String -> X Window +createNewWindow (Rectangle x y w h) m col = do hunk ./XUtils.hs 73 - win <- io $ createSimpleWindow d rw x y w h 0 0 0 + c <- stringToPixel col + win <- io $ createSimpleWindow d rw x y w h 0 c c hunk ./DragPane.hs 62 - DragPane (Invisible Maybe (Window,Rectangle,Rectangle,Int)) DragType Double Double + DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double hunk ./DragPane.hs 76 -handleMess d@(DragPane mb@(I (Just (win,_,_,ident))) ty delta split) x +handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x hunk ./DragPane.hs 91 -handleEvent (DragPane (I (Just (win,_,r,ident))) ty _ _) +handleEvent (DragPane (I (Just (win,r,ident))) ty _ _) hunk ./DragPane.hs 100 -handleEvent (DragPane (I (Just (win,oret,_,_))) _ _ _) - (ExposeEvent {ev_window = thisw }) - | thisw == win = do - updateDragWin win oret - return () -handleEvent _ _ = return () +handleEvent _ _ = return () hunk ./DragPane.hs 121 - I (Just (w,_,_,ident)) -> do + I (Just (w,_,ident)) -> do hunk ./DragPane.hs 123 - return (wrs, Just $ DragPane (I $ Just (w',r,r',ident)) ty delta split) + return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split) hunk ./DragPane.hs 127 - return (wrs, Just $ DragPane (I $ Just (w,r,r',hashUnique i)) ty delta split) + return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split) hunk ./DragPane.hs 132 -newDragWin r@(Rectangle _ _ wh ht) = do +newDragWin r = do hunk ./DragPane.hs 138 -updateDragWin :: Window -> Rectangle -> X () -updateDragWin w (Rectangle _ _ wh ht) = return () - hunk ./TwoPane.hs 37 --- > ,("twopane", SomeLayout $ TwoPane 0.03 0.5) +-- > ,(Layout $ TwoPane 0.03 0.5) hunk ./TwoPane.hs 40 --- %layout , ,("twopane", SomeLayout $ TwoPane 0.03 0.5) +-- %layout , ,(Layout $ TwoPane 0.03 0.5) hunk ./LayoutScreens.hs 42 --- > , ((modMask .|. shiftMask, xK_space), layoutScreens 2 (twoPane 0.5 0.5)) +-- > , ((modMask .|. shiftMask, xK_space), layoutScreens 2 (TwoPane 0.5 0.5)) hunk ./MetaModule.hs 84 +import XMonadContrib.WindowPrompt () hunk ./WindowBringer.hs 18 - gotoMenu, bringMenu + gotoMenu, bringMenu, windowMapWith addfile ./WindowsPrompt.hs move ./WindowsPrompt.hs ./WindowPrompt.hs hunk ./WindowPrompt.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.WindowPrompt +-- Copyright : Devin Mullins +-- Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Devin Mullins +-- Andrea Rossato +-- Stability : unstable +-- Portability : unportable +-- +-- xprompt operations to bring windows to you, and bring you to windows. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.WindowPrompt + ( + -- * Usage + -- $usage + windowPromptGoto, + windowPromptBring + ) where + +import qualified Data.Map as M +import Data.List + +import qualified StackSet as W +import XMonad +import Operations (windows) +import XMonadContrib.XPrompt +import XMonadContrib.WindowBringer + +-- $usage +-- WindowPrompt brings windows to you and you to windows. +-- That is to say, it pops up a dmenu with window names, in case you forgot +-- where you left your XChat. +-- +-- Place in your Config.hs: +-- +-- > import XMonadContrib.XPrompt +-- > import XMonadContrib.WindowPrompt +-- +-- and in the keys definition: +-- +-- > , ((modMask .|. shiftMask, xK_g ), windowPromptGoto defaultXPConfig) +-- > , ((modMask .|. shiftMask, xK_g ), windowPromptBring defaultXPConfig) +-- +-- %import XMonadContrib.XPrompt +-- %import XMonadContrib.WindowPrompt +-- %keybind ((modMask .|. shiftMask, xK_g ), windowPromptGoto defaultXPConfig) +-- %keybind ((modMask .|. shiftMask, xK_g ), windowPromptBring defaultXPConfig) + +data WindowPrompt = Goto | Bring +instance XPrompt WindowPrompt where + showXPrompt Goto = "Go to window: " + showXPrompt Bring = "Bring me here: " + +windowPromptGoto, windowPromptBring :: XPConfig -> X () +windowPromptGoto c = doPrompt Goto c +windowPromptBring c = doPrompt Bring c + +-- | Pops open a prompt with window titles. Choose one, and you will be +-- taken to the corresponding workspace. +doPrompt :: WindowPrompt -> XPConfig -> X () +doPrompt t c = do + a <- case t of + Goto -> return . gotoAction =<< windowMapWith (W.tag . fst) + Bring -> return . bringAction =<< windowMapWith snd + wm <- windowMapWith id + mkXPrompt t c (compList wm) a + + where + + winAction a m = flip whenJust (windows . a) . flip M.lookup m . unescape + gotoAction = winAction W.greedyView + bringAction = winAction bringWindow + bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws + + compList m s = return . filter (isPrefixOf s) . map (escape . fst) . M.toList $ m + + escape [] = [] + escape (' ':xs) = "\\ " ++ escape xs + escape (x :xs) = x : escape xs + + unescape [] = [] + unescape ('\\':' ':xs) = ' ' : unescape xs + unescape (x:xs) = x : unescape xs addfile ./XSelection.hs hunk ./XSelection.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.XSelection +-- Copyright : (C) 2007 Andrea Rossato, Matthew Sackman +-- License : BSD3 +-- +-- Maintainer : Andrea Rossato , Matthew Sackman +-- Stability : unstable +-- Portability : unportable +-- +-- A module for accessing and manipulating the X Window mouse selection (used in copy and pasting). +-- getSelection and putSelection are adaptations of Hxsel.hs and Hxput.hs from XMonad-utils, available: +-- $ darcs get http://gorgias.mine.nu/repos/xmonad-utils +----------------------------------------------------------------------------- +{- $usage + Add 'import XMonadContrib.XSelection' to the top of Config.hs + Then make use of getSelection or promptSelection as needed; if + one wanted to run Firefox with the selection as an argument (say, + the selection is an URL you just highlighted), then one could add + to the Config.hs a line like thus: + , ((modMask .|. shiftMask, xK_b ), promptSelection "firefox") + + TODO: + * Fix Unicode handling. Currently it's still better than calling + 'chr' to translate to ASCII, though. + As near as I can tell, the mangling happens when the String is + outputted somewhere, such as via promptSelection's passing through + the shell, or GHCi printing to the terminal. utf-string has IO functions + which can fix this, though I do not know have to use them here. It's + a complex issue; see + + and . + * Possibly add some more elaborate functionality: Emacs' registers are nice. +-} + +module XMonadContrib.XSelection (getSelection, promptSelection, putSelection) where + +-- getSelection, putSelection's imports: +import Graphics.X11.Xlib (allocaXEvent, createSimpleWindow, defaultScreen, destroyWindow, internAtom, nextEvent, openDisplay, rootWindow, selectionNotify, Display(), Atom(), XEventPtr(), selectionRequest, sendEvent, noEventMask, sync) +import Graphics.X11.Xlib.Extras (currentTime, ev_event_type, getEvent, getWindowProperty8, xConvertSelection, xSetSelectionOwner, xGetSelectionOwner, changeProperty8, propModeReplace, setSelectionNotify, ev_requestor, ev_selection, ev_target, ev_property, ev_time, ev_event_display) +import Data.Maybe (fromMaybe) +import Control.Concurrent (forkIO) +import Data.Char (chr, ord) + +-- promptSelection's imports: +import XMonad (io, spawn, X ()) + +-- decode's imports +import Foreign (Word8(), (.&.), shiftL, (.|.)) + +-- | Returns a String corresponding to the current mouse selection in X; if there is none, an empty string is returned.. Note that this is +-- only reliable for ASCII text and currently mangles/escapes more complex UTF-8 characters. +getSelection :: IO String +getSelection = do + dpy <- openDisplay "" + let dflt = defaultScreen dpy + rootw <- rootWindow dpy dflt + win <- createSimpleWindow dpy rootw 0 0 200 100 0 0 0 + p <- internAtom dpy "PRIMARY" True + ty <- internAtom dpy "UTF8_STRING" False +-- import Control.Exception as E (catch) +{- ty <- E.catch + (E.catch + (internAtom dpy "sTring" False) + (\_ -> internAtom dpy "COMPOUND_TEXT" False)) + (\_ -> internAtom dpy "UTF8_STRING" False) -} + clp <- internAtom dpy "BLITZ_SEL_STRING" False + xConvertSelection dpy p ty clp win currentTime + allocaXEvent $ \e -> do + nextEvent dpy e + ev <- getEvent e + if ev_event_type ev == selectionNotify + then do res <- getWindowProperty8 dpy clp win + return $ decode . fromMaybe [] $ res + else destroyWindow dpy win >> return "" + +-- | Set the current X Selection to a given String. +putSelection :: String -> IO () +putSelection text = do + dpy <- openDisplay "" + let dflt = defaultScreen dpy + rootw <- rootWindow dpy dflt + win <- createSimpleWindow dpy rootw 0 0 200 100 0 0 0 + p <- internAtom dpy "PRIMARY" True + ty <- internAtom dpy "UTF8_STRING" False + xSetSelectionOwner dpy p win currentTime + winOwn <- xGetSelectionOwner dpy p + if winOwn == win + then do forkIO ((allocaXEvent $ processEvent dpy ty text) >> destroyWindow dpy win) >> return () + else do putStrLn "Unable to obtain ownership of the selection" >> destroyWindow dpy win + return () + where + processEvent :: Display -> Atom -> [Char] -> XEventPtr -> IO () + processEvent dpy ty txt e = do + nextEvent dpy e + ev <- getEvent e + if ev_event_type ev == selectionRequest + then do print ev + -- selection == eg PRIMARY + -- target == type eg UTF8 + -- property == property name or None + allocaXEvent $ \replyPtr -> do + changeProperty8 (ev_event_display ev) + (ev_requestor ev) + (ev_property ev) + ty + propModeReplace + (map (fromIntegral . ord) txt) + setSelectionNotify replyPtr (ev_requestor ev) (ev_selection ev) (ev_target ev) (ev_property ev) (ev_time ev) + sendEvent dpy (ev_requestor ev) False noEventMask replyPtr + sync dpy False + else do putStrLn "Unexpected Message Received" + print ev + processEvent dpy ty text e + +-- | A wrapper around getSelection. Makes it convenient to run a program with the current selection as an argument. This is convenient +-- for handling URLs, in particular. For example, in your Config.hs you could bind a key to 'promptSelection "firefox"'; this would allow you to +-- highlight a URL string and then immediately open it up in Firefox. +promptSelection :: String -> X () +promptSelection app = spawn . ((app ++ " ") ++) =<< io getSelection + +{- UTF-8 decoding for internal use in getSelection. This code is copied from Eric Mertens's utf-string library + (version 0.1), which is BSD-3 licensed, as is this module. + It'd be better to just import Codec.Binary.UTF8.String (decode), but then users of this would need to install it; Xmonad has enough + dependencies already. -} +decode :: [Word8] -> String +decode [ ] = "" +decode (c:cs) + | c < 0x80 = chr (fromEnum c) : decode cs + | c < 0xc0 = replacement_character : decode cs + | c < 0xe0 = multi_byte 1 0x1f 0x80 + | c < 0xf0 = multi_byte 2 0xf 0x800 + | c < 0xf8 = multi_byte 3 0x7 0x10000 + | c < 0xfc = multi_byte 4 0x3 0x200000 + | c < 0xfe = multi_byte 5 0x1 0x4000000 + | otherwise = replacement_character : decode cs + where + replacement_character :: Char + replacement_character = '\xfffd' + + multi_byte :: Int -> Word8 -> Int -> [Char] + multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask)) + where + aux 0 rs acc + | overlong <= acc && acc <= 0x10ffff && + (acc < 0xd800 || 0xdfff < acc) && + (acc < 0xfffe || 0xffff < acc) = chr acc : decode rs + | otherwise = replacement_character : decode rs + + aux n (r:rs) acc + | r .&. 0xc0 == 0x80 = aux (n-1) rs + $ shiftL acc 6 .|. fromEnum (r .&. 0x3f) + + aux _ rs _ = replacement_character : decode rs hunk ./MetaModule.hs 81 +import XMonadContrib.XSelection () hunk ./XSelection.hs 44 +import Control.Exception as E (catch) hunk ./XSelection.hs 61 - ty <- internAtom dpy "UTF8_STRING" False --- import Control.Exception as E (catch) -{- ty <- E.catch + ty <- E.catch hunk ./XSelection.hs 63 - (internAtom dpy "sTring" False) + (internAtom dpy "UTF8_STRING" False) hunk ./XSelection.hs 65 - (\_ -> internAtom dpy "UTF8_STRING" False) -} + (\_ -> internAtom dpy "sTring" False) hunk ./NoBorders.hs 61 - setBorders borderWidth (ws \\ s) + setBorders borderWidth (s \\ ws) hunk ./SwitchTrans.hs 84 --- import System.IO +--import System.IO hunk ./SwitchTrans.hs 122 - doLayout st r s = currLayout st `unLayout` \l -> - acceptChange st (fmap . fmap) (doLayout l r s) + doLayout st r s = currLayout st `unLayout` \l -> do + --io $ hPutStrLn stderr $ "[ST]{ " ++ show st + x{- @(_, w) -} <- acceptChange st (fmap . fmap) (doLayout l r s) + --io $ hPutStrLn stderr $ "[ST]} " ++ show w + return x hunk ./SwitchTrans.hs 145 - = currLayout st `unLayout` \cl -> + = currLayout st `unLayout` \cl -> do + --io $ hPutStrLn stderr $ "[ST]~ " ++ show st hunk ./SwitchTrans.hs 149 - = currLayout st `unLayout` \cl -> - acceptChange st fmap (handleMessage cl m) + = currLayout st `unLayout` \cl -> do + --io $ hPutStrLn stderr $ "[ST]< " ++ show st + x <- acceptChange st fmap (handleMessage cl m) + --io $ hPutStrLn stderr $ "[ST]> " ++ show x + return x hunk ./SwitchTrans.hs 164 - -- io $ hPutStrLn stderr $ "[ST]+ " ++ show cl ++ " -> " ++ show (alt (base st)) + --io $ hPutStrLn stderr $ "[ST]+ " ++ show cl ++ " -> " ++ show (alt (base st)) hunk ./SwitchTrans.hs 171 - -- io $ hPutStrLn stderr $ "[ST]- " ++ show cl ++ " -> " ++ show (base st) + --io $ hPutStrLn stderr $ "[ST]- " ++ show cl ++ " -> " ++ show (base st) hunk ./ShellPrompt.hs 63 - hPutStrLn stdout s hunk ./MetaModule.hs 86 +import XMonadContrib.WmiiActions () addfile ./WmiiActions.hs hunk ./WmiiActions.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.WmiiActions +-- Copyright : (c) Juraj Hercek +-- License : BSD3 +-- +-- Maintainer : Juraj Hercek +-- Stability : unstable +-- Portability : unportable +-- +-- Provides `actions' as known from Wmii window manager ( +-- ). It also provides slightly better interface for +-- running dmenu on xinerama screens. If you want to use xinerama functions, +-- you have to apply following patch (see Dmenu.hs extension): +-- . Don't forget to +-- recompile dmenu afterwards ;-). +----------------------------------------------------------------------------- + +module XMonadContrib.WmiiActions ( + -- * Usage + -- $usage + wmiiActions + , wmiiActionsXinerama + , executables + , executablesXinerama + ) where + +import XMonad +import XMonadContrib.Dmenu (dmenu, dmenuXinerama, runProcessWithInput) + +import Control.Monad (filterM, liftM, liftM2) +import System.Directory (getDirectoryContents, doesFileExist, getPermissions, executable) + +-- $usage +-- +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.WmiiActions +-- +-- and add following to the list of keyboard bindings: +-- +-- > ,((modMask, xK_a), wmiiActions "/home/joe/.wmii-3.5/") +-- +-- or, if you are using xinerama, you can use +-- +-- > ,((modMask, xK_a), wmiiActionsXinerama "/home/joe/.wmii-3.5/") +-- +-- however, make sure you have also xinerama build of dmenu (for more +-- information see "XMonadContrib.Dmenu" extension). + +-- | The 'wmiiActions' function takes the file path as a first argument and +-- executes dmenu with all executables found in the provided path. +wmiiActions :: FilePath -> X () +wmiiActions path = + wmiiActionsDmenu path dmenu + +-- | The 'wmiiActionsXinerama' does the same as 'wmiiActions', but it shows +-- dmenu only on workspace which currently owns focus. +wmiiActionsXinerama :: FilePath -> X () +wmiiActionsXinerama path = + wmiiActionsDmenu path dmenuXinerama + +wmiiActionsDmenu :: FilePath -> ([String] -> X String) -> X () +wmiiActionsDmenu path dmenuBrand = + let path' = path ++ "/" in + getExecutableFileList path' >>= dmenuBrand >>= spawn . (path' ++) + +getExecutableFileList :: FilePath -> X [String] +getExecutableFileList path = + io $ getDirectoryContents path >>= + filterM (\x -> let x' = path ++ x in + liftM2 (&&) + (doesFileExist x') + (liftM executable (getPermissions x'))) + +{- +getExecutableFileList :: FilePath -> X [String] +getExecutableFileList path = + io $ getDirectoryContents path >>= + filterM (doesFileExist . (path ++)) >>= + filterM (liftM executable . getPermissions . (path ++)) +-} + +-- | The 'executables' function runs dmenu_path script providing list of +-- executable files accessible from $PATH variable. +executables :: X () +executables = executablesDmenu dmenu + +-- | The 'executablesXinerama' function does the same as 'executables' function +-- but on workspace which currently owns focus. +executablesXinerama :: X () +executablesXinerama = executablesDmenu dmenuXinerama + +executablesDmenu :: ([String] -> X String) -> X () +executablesDmenu dmenuBrand = + getExecutablesList >>= dmenuBrand >>= spawn + +getExecutablesList :: X [String] +getExecutablesList = + io $ liftM lines $ runProcessWithInput "dmenu_path" [] "" + hunk ./RotView.hs 22 -import Data.List ( sortBy ) -import Data.Maybe ( listToMaybe, isJust ) +import Data.List ( sortBy, find ) +import Data.Maybe ( isJust ) hunk ./RotView.hs 32 --- +-- hunk ./RotView.hs 43 -rotView b = do +rotView forward = do hunk ./RotView.hs 45 - let m = tag . workspace . current $ ws - sortWs = sortBy (comparing tag) - pivoted = uncurry (flip (++)) . span ((< m) . tag) . sortWs . hidden $ ws - nextws = listToMaybe . filter (isJust . stack) . (if b then id else reverse) $ pivoted + let currentTag = tag . workspace . current $ ws + sortWs = sortBy (comparing tag) + isNotEmpty = isJust . stack + sorted = sortWs (hidden ws) + pivoted = let (a,b) = span ((< currentTag) . tag) sorted in b ++ a + pivoted' | forward = pivoted + | otherwise = reverse pivoted + nextws = find isNotEmpty pivoted' hunk ./TagWindows.hs 18 - setTags, getTags, + setTags, getTags, hasTag, hunk ./EwmhDesktops.hs 15 - -- * Usage - -- $usage - ewmhDesktopsLogHook - ) where + -- * Usage + -- $usage + ewmhDesktopsLogHook + ) where hunk ./EwmhDesktops.hs 20 -import Data.List (elemIndex, sortBy) -import Data.Ord (comparing) -import Data.Maybe (fromMaybe) +import Data.List (elemIndex, sortBy) +import Data.Ord (comparing) +import Data.Maybe (fromMaybe) hunk ./EwmhDesktops.hs 51 - -- 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 - let wins = W.allWindows s + -- 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 + let wins = W.allWindows s hunk ./EwmhDesktops.hs 56 - setSupported + setSupported hunk ./EwmhDesktops.hs 58 - -- Number of Workspaces - setNumberOfDesktops (length ws) + -- Number of Workspaces + setNumberOfDesktops (length ws) hunk ./EwmhDesktops.hs 61 - -- Names thereof - 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 + -- Names thereof + setDesktopNames (map W.tag ws) hunk ./EwmhDesktops.hs 64 - setClientList wins + -- Current desktop + fromMaybe (return ()) $ do + n <- W.lookupWorkspace 0 s + i <- elemIndex n $ map W.tag ws + return $ setCurrentDesktop i hunk ./EwmhDesktops.hs 70 - -- Per window Desktop - forM (zip ws [(0::Int)..]) $ \(w, wn) -> - forM (W.integrate' (W.stack w)) $ \win -> do - setWindowDesktop win wn - - return () + setClientList wins + + -- Per window Desktop + forM (zip ws [(0::Int)..]) $ \(w, wn) -> + forM (W.integrate' (W.stack w)) $ \win -> do + setWindowDesktop win wn + + return () hunk ./EwmhDesktops.hs 81 -setNumberOfDesktops n = withDisplay $ \dpy -> do - a <- getAtom "_NET_NUMBER_OF_DESKTOPS" - c <- getAtom "CARDINAL" - r <- asks theRoot - io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n] +setNumberOfDesktops n = withDisplay $ \dpy -> do + a <- getAtom "_NET_NUMBER_OF_DESKTOPS" + c <- getAtom "CARDINAL" + r <- asks theRoot + io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n] hunk ./EwmhDesktops.hs 89 - a <- getAtom "_NET_CURRENT_DESKTOP" - c <- getAtom "CARDINAL" - r <- asks theRoot - io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i] + a <- getAtom "_NET_CURRENT_DESKTOP" + c <- getAtom "CARDINAL" + r <- asks theRoot + io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i] hunk ./EwmhDesktops.hs 96 - -- Names thereof - r <- asks theRoot - a <- getAtom "_NET_DESKTOP_NAMES" - c <- getAtom "UTF8_STRING" - let names' = map (fromIntegral.fromEnum) $ - concatMap (("Workspace "++) . (++['\0'])) names - io $ changeProperty8 dpy r a c propModeReplace names' + -- Names thereof + r <- asks theRoot + a <- getAtom "_NET_DESKTOP_NAMES" + c <- getAtom "UTF8_STRING" + let names' = map (fromIntegral.fromEnum) $ + concatMap (("Workspace "++) . (++['\0'])) names + io $ changeProperty8 dpy r a c propModeReplace names' hunk ./EwmhDesktops.hs 106 - -- (What order do we really need? Something about age and stacking) - r <- asks theRoot - c <- getAtom "WINDOW" - a <- getAtom "_NET_CLIENT_LIST" - io $ changeProperty32 dpy r a c propModeReplace wins - a' <- getAtom "_NET_CLIENT_LIST_STACKING" - io $ changeProperty32 dpy r a' c propModeReplace wins + -- (What order do we really need? Something about age and stacking) + r <- asks theRoot + c <- getAtom "WINDOW" + a <- getAtom "_NET_CLIENT_LIST" + io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins) + a' <- getAtom "_NET_CLIENT_LIST_STACKING" + io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins) hunk ./EwmhDesktops.hs 115 -setWindowDesktop win i = withDisplay $ \dpy -> do - a <- getAtom "_NET_WM_DESKTOP" - c <- getAtom "CARDINAL" - io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i] +setWindowDesktop win i = withDisplay $ \dpy -> do + a <- getAtom "_NET_WM_DESKTOP" + c <- getAtom "CARDINAL" + io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i] hunk ./EwmhDesktops.hs 121 -setSupported = withDisplay $ \dpy -> do - r <- asks theRoot - a <- getAtom "_NET_SUPPORTED" - c <- getAtom "ATOM" - supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"] - io $ changeProperty32 dpy r a c propModeReplace supp - - setWMName "xmonad" +setSupported = withDisplay $ \dpy -> do + r <- asks theRoot + a <- getAtom "_NET_SUPPORTED" + c <- getAtom "ATOM" + supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"] + io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp) + + setWMName "xmonad" hunk ./ManageDocks.hs 22 - -- * Usage - -- $usage - manageDocksHook - ) where + -- * Usage + -- $usage + manageDocksHook + ) where hunk ./ManageDocks.hs 54 - hasStrut <- getStrut w - maybe (return ()) setGap hasStrut + hasStrut <- getStrut w + maybe (return ()) setGap hasStrut hunk ./ManageDocks.hs 57 - isDock <- checkDock w - if isDock then do - reveal w - return (W.delete w) - else do - return id + isDock <- checkDock w + if isDock then do + reveal w + return (W.delete w) + else do + return id hunk ./ManageDocks.hs 68 - a <- getAtom "_NET_WM_WINDOW_TYPE" - d <- getAtom "_NET_WM_WINDOW_TYPE_DOCK" - mbr <- getProp a w - case mbr of - Just [r] -> return (r == d) - _ -> return False + a <- getAtom "_NET_WM_WINDOW_TYPE" + d <- getAtom "_NET_WM_WINDOW_TYPE_DOCK" + mbr <- getProp a w + case mbr of + Just [r] -> return (fromIntegral r == d) + _ -> return False hunk ./ManageDocks.hs 75 --- | +-- | hunk ./ManageDocks.hs 78 -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 +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 hunk ./ManageDocks.hs 101 -max4 :: (Int, Int, Int, Int) -> (Int, Int, Int, Int) -> (Int, Int, Int, Int) +max4 :: (Int, Int, Int, Int) -> (Int, Int, Int, Int) -> (Int, Int, Int, Int) hunk ./SetWMName.hs 66 - mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW 0 [supportWindow]) [root, supportWindow] + mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW 0 [fromIntegral supportWindow]) [root, supportWindow] hunk ./SetWMName.hs 71 - changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ atom_NET_SUPPORTING_WM_CHECK : atom_NET_WM_NAME : supportedList) + changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList) hunk ./SetWMName.hs 84 - validateWindow supportWindow + validateWindow (fmap fromIntegral supportWindow) hunk ./SetWMName.hs 99 - + hunk ./ResizableTile.hs 14 --- More useful tiled layout that allows you to change a width/height of window. +-- More useful tiled layout that allows you to change a width\/height of window. hunk ./SetWMName.hs 20 --- ((modMask .|. controlMask .|. shiftMask, xK_z), setWMName "LG3D") -- @@ Java hack +-- > ((modMask .|. controlMask .|. shiftMask, xK_z), setWMName "LG3D") -- @@ Java hack hunk ./SetWMName.hs 26 --- WMs, see and +-- WMs, see "http:\/\/bugs.sun.com\/bugdatabase\/view_bug.do?bug_id=6429775" and hunk ./SetWMName.hs 31 --- set to 0, while for other WMs the insets are "guessed" and the algorithm +-- set to 0, while for other WMs the insets are \"guessed\" and the algorithm hunk ./SwapWorkspaces.hs 15 +-- hunk ./SwapWorkspaces.hs 17 +-- hunk ./SwapWorkspaces.hs 33 +-- hunk ./SwapWorkspaces.hs 37 +-- hunk ./SwapWorkspaces.hs 41 --- + hunk ./WindowBringer.hs 39 +-- hunk ./WindowBringer.hs 41 +-- hunk ./WindowBringer.hs 43 +-- hunk ./WindowBringer.hs 46 --- + hunk ./XPrompt.hs 269 --- ^U +-- ctrl U hunk ./XPrompt.hs 271 --- ^K +-- ctrl K hunk ./XPrompt.hs 273 --- ^A +-- ctrl A hunk ./XPrompt.hs 275 --- ^E +-- ctrl E hunk ./XPropManage.hs 32 +-- hunk ./XPropManage.hs 55 --- *1 You can get the available properties of an application with the xprop utility. STRING properties +-- \*1 You can get the available properties of an application with the xprop utility. STRING properties hunk ./XSelection.hs 7 --- Maintainer : Andrea Rossato , Matthew Sackman +-- Maintainer : Andrea Rossato , +-- Matthew Sackman hunk ./XSelection.hs 14 --- $ darcs get http://gorgias.mine.nu/repos/xmonad-utils +-- +-- $ darcs get "http:\/\/gorgias.mine.nu\/repos\/xmonad-utils" hunk ./XSelection.hs 17 + +module XMonadContrib.XSelection ( + -- * Usage + -- $usage + getSelection, promptSelection, putSelection) where + +-- getSelection, putSelection's imports: +import Graphics.X11.Xlib (allocaXEvent, createSimpleWindow, defaultScreen, destroyWindow, internAtom, nextEvent, openDisplay, rootWindow, selectionNotify, Display(), Atom(), XEventPtr(), selectionRequest, sendEvent, noEventMask, sync) +import Graphics.X11.Xlib.Extras (currentTime, ev_event_type, getEvent, getWindowProperty8, xConvertSelection, xSetSelectionOwner, xGetSelectionOwner, changeProperty8, propModeReplace, setSelectionNotify, ev_requestor, ev_selection, ev_target, ev_property, ev_time, ev_event_display) +import Data.Maybe (fromMaybe) +import Control.Concurrent (forkIO) +import Data.Char (chr, ord) +import Control.Exception as E (catch) + +-- promptSelection's imports: +import XMonad (io, spawn, X ()) + +-- decode's imports +import Foreign (Word8(), (.&.), shiftL, (.|.)) + hunk ./XSelection.hs 43 - , ((modMask .|. shiftMask, xK_b ), promptSelection "firefox") + +> , ((modMask .|. shiftMask, xK_b ), promptSelection "firefox") hunk ./XSelection.hs 47 + hunk ./XSelection.hs 57 + hunk ./XSelection.hs 61 -module XMonadContrib.XSelection (getSelection, promptSelection, putSelection) where - --- getSelection, putSelection's imports: -import Graphics.X11.Xlib (allocaXEvent, createSimpleWindow, defaultScreen, destroyWindow, internAtom, nextEvent, openDisplay, rootWindow, selectionNotify, Display(), Atom(), XEventPtr(), selectionRequest, sendEvent, noEventMask, sync) -import Graphics.X11.Xlib.Extras (currentTime, ev_event_type, getEvent, getWindowProperty8, xConvertSelection, xSetSelectionOwner, xGetSelectionOwner, changeProperty8, propModeReplace, setSelectionNotify, ev_requestor, ev_selection, ev_target, ev_property, ev_time, ev_event_display) -import Data.Maybe (fromMaybe) -import Control.Concurrent (forkIO) -import Data.Char (chr, ord) -import Control.Exception as E (catch) - --- promptSelection's imports: -import XMonad (io, spawn, X ()) - --- decode's imports -import Foreign (Word8(), (.&.), shiftL, (.|.)) - hunk ./XSelection.hs 62 --- only reliable for ASCII text and currently mangles/escapes more complex UTF-8 characters. +-- only reliable for ASCII text and currently mangles\/escapes more complex UTF-8 characters. hunk ./XSelection.hs 125 --- for handling URLs, in particular. For example, in your Config.hs you could bind a key to 'promptSelection "firefox"'; this would allow you to +-- for handling URLs, in particular. For example, in your Config.hs you could bind a key to @promptSelection \"firefox\"@; this would allow you to replace ./DynamicLog.hs [A-Za-z_0-9] SomeLayout Layout replace ./MagicFocus.hs [A-Za-z_0-9] SomeLayout Layout hunk ./MosaicAlt.hs 46 --- > , SomeLayout $ MosaicAlt M.empty +-- > , Layout $ MosaicAlt M.empty hunk ./MosaicAlt.hs 58 --- %layout , SomeLayout $ MosaicAlt M.empty +-- %layout , Layout $ MosaicAlt M.empty replace ./Tabbed.hs [A-Za-z_0-9] SomeLayout Layout replace ./WindowNavigation.hs [A-Za-z_0-9] SomeLayout Layout hunk ./Dishes.hs 35 +-- +-- and add the following line to your 'defaultLayouts' +-- +-- > , Layout $ Dishes 2 (1%6) hunk ./Dishes.hs 41 +-- %layout , Layout $ Dishes 2 (1%6) hunk ./Dishes.hs 48 - handleMessage (Dishes nmaster h) m = return $ fmap incmastern (fromMessage m) + pureMessage (Dishes nmaster h) m = fmap incmastern (fromMessage m) hunk ./MetaModule.hs 63 +import XMonadContrib.RunInXTerm () hunk ./MetaModule.hs 83 +import XMonadContrib.XUtils () hunk ./SwapWorkspaces.hs 15 --- hunk ./SwapWorkspaces.hs 16 --- hunk ./SwapWorkspaces.hs 44 +-- +-- After installing this update, if you're on workspace 1, hitting mod-ctrl-5 +-- will swap workspaces 1 and 5. hunk ./SwapWorkspaces.hs 48 +-- | Swaps the currently focused workspace with the given workspace tag, via +-- @swapWorkspaces@. hunk ./SwapWorkspaces.hs 53 +-- | Takes two workspace tags and an existing StackSet and returns a new +-- one with the two corresponding workspaces' tags swapped. hunk ./WindowBringer.hs 12 +-- That is to say, it pops up a dmenu with window names, in case you forgot +-- where you left your XChat. hunk ./WindowBringer.hs 36 --- WindowBringer brings windows to you and you to windows. --- That is to say, it pops up a dmenu with window names, in case you forgot --- where you left your XChat. hunk ./WindowBringer.hs 51 --- taken to the corresponding workspace. +-- taken to the corresponding workspace. hunk ./WindowBringer.hs 57 --- dragged, kicking and screaming, into your current workspace. +-- dragged, kicking and screaming, into your current workspace. hunk ./WindowBringer.hs 64 --- off to action if found. +-- off to action if found. hunk ./WindowBringer.hs 69 --- dmenuMap. TODO: extract the pure, creamy center. +-- dmenuMap. hunk ./WindowBringer.hs 71 -windowMapWith value = do +windowMapWith value = do -- TODO: extract the pure, creamy center. hunk ./WindowBringer.hs 78 --- Lowercased, for your convenience (since dmenu is case-sensitive). --- Tagged with the workspace ID, to guarantee uniqueness, and to let the user know where he's going. +-- Lowercased, for your convenience (since dmenu is case-sensitive). +-- Tagged with the workspace ID, to guarantee uniqueness, and to let the user +-- know where he's going. hunk ./SwapWorkspaces.hs 13 --- --- TODO: add quickcheck props for: --- * double swap invariant (guarantees no 'loss' of workspaces) --- * non-swapped ws's invariant hunk ./DynamicLog.hs 24 - dynamicLog, dynamicLogWithTitle, dynamicLogWithTitleColored, dynamicLogXinerama, pprWindowSet, pprWindowSetXinerama + dynamicLog, + dynamicLogWithTitle, + dynamicLogWithTitleColored, + dynamicLogXinerama, + + pprWindowSet, + pprWindowSetXinerama hunk ./DynamicLog.hs 45 +import Data.Char hunk ./DynamicLog.hs 78 --- An example logger, print a status bar output to dzen, in the form: +-- | +-- An example log hook, print a status bar output to dzen, in the form: +-- +-- > 1 2 [3] 4 7 : full hunk ./DynamicLog.hs 83 --- > 1 2 [3] 4 7 +-- That is, the currently populated workspaces, and the current +-- workspace layout hunk ./DynamicLog.hs 86 - hunk ./DynamicLog.hs 88 - let desc = description . S.layout . S.workspace . S.current $ ws - io . putStrLn $ "(" ++ desc ++ ") " ++ pprWindowSet ws + let ld = description . S.layout . S.workspace . S.current $ ws + wn = pprWindowSet ws + io . putStrLn $ concat [wn ," : " ,map toLower ld] hunk ./DynamicLog.hs 92 --- Appends title of currently focused window to log output +-- | Appends title of currently focused window to log output, and the +-- current layout mode, to the normal dynamic log format. hunk ./DynamicLog.hs 95 +-- +-- The result is rendered in the form: +-- +-- > 1 2 [3] 4 7 : full : urxvt +-- hunk ./DynamicLog.hs 101 -dynamicLogWithTitle_ pre post= do ld <- withWindowSet $ return . description . S.layout . S.workspace . S.current -- layout description - ws <- withWindowSet $ return . pprWindowSet -- workspace list - wt <- withWindowSet $ maybe (return "") (fmap show . getName) . S.peek -- window title - io . putStrLn $ "(" ++ ld ++ ") " ++ ws ++ " " ++ pre ++ wt ++ post +dynamicLogWithTitle_ pre post= do + -- layout description + ld <- withWindowSet $ return . description . S.layout . S.workspace . S.current + -- workspace list + ws <- withWindowSet $ return . pprWindowSet + -- window title + wt <- withWindowSet $ maybe (return "") (fmap show . getName) . S.peek + + io . putStrLn $ concat [ws ," : " ,map toLower ld + , case wt of + [] -> [] + s -> " : " ++ pre ++ s ++ post + ] hunk ./DynamicLog.hs 116 -dynamicLogWithTitle = dynamicLogWithTitle_ "<" ">" +dynamicLogWithTitle = dynamicLogWithTitle_ "" "" hunk ./DynamicLog.hs 118 --- As dynamicLogWithTitle but with colored window title instead of angle brackets (works with dzen only) +-- | +-- As for dynamicLogWithTitle but with colored window title (for dzen use) +-- hunk ./DynamicLog.hs 127 - where f Nothing Nothing = EQ - f (Just _) Nothing = LT - f Nothing (Just _) = GT + where f Nothing Nothing = EQ + f (Just _) Nothing = LT + f Nothing (Just _) = GT hunk ./Accordion.hs 30 --- > defaultLayouts = [ accordion ] +-- > defaultLayouts = [ Layout Accordion ] hunk ./Accordion.hs 33 --- %layout , accordion +-- %layout , Layout Accordion hunk ./Circle.hs 32 +-- > defaultLayouts = [ Layout Circle ] hunk ./CopyWindow.hs 58 +copy :: WorkspaceId -> WindowSet -> WindowSet hunk ./CycleWS.hs 41 --- > , ((modMask, xK_Left), prevWWS) +-- > , ((modMask, xK_Left), prevWS) hunk ./CycleWS.hs 53 --- %keybind , ((modMask, xK_Left), prevWWS) +-- %keybind , ((modMask, xK_Left), prevWS) hunk ./ResizableTile.hs 18 -module XMonadContrib.ResizableTile (ResizableTall(..), MirrorResize(..)) where +module XMonadContrib.ResizableTile ( + -- * Usage + -- $usage + ResizableTall(..), MirrorResize(..) + ) where hunk ./Roledex.hs 32 --- > defaultLayouts = [ roledex ] +-- > defaultLayouts = [ Layout Roledex ] hunk ./Roledex.hs 35 --- %layout , roledex +-- %layout , Layout Roledex replace ./Tabbed.hs [A-Za-z_0-9] Layout SomeLayout hunk ./Tabbed.hs 47 --- > defaultLayouts :: [(String, SomeLayout Window)] --- > defaultLayouts = [SomeLayout tiled --- > ,SomeLayout $ Mirror tiled +-- > defaultLayouts :: [Layout Window] +-- > defaultLayouts = [ Layout tiled +-- > , Layout $ Mirror tiled +-- > , Layout Full +-- > hunk ./Tabbed.hs 53 --- > ,SomeLayout $ tabbed shrinkText defaultTConf) +-- > , Layout $ tabbed shrinkText defaultTConf +-- > ] +-- > hunk ./Tabbed.hs 66 --- > , tabbed shrinkText myTabConfig ] +-- > , Layout $ tabbed shrinkText myTabConfig ] hunk ./TagWindows.hs 48 --- , ((modMask, xK_f ), withFocused (addTag "abc")) --- , ((modMask .|. controlMask, xK_f ), withFocused (delTag "abc")) --- , ((modMask .|. shiftMask, xK_f ), withTaggedGlobal "abc" sink) --- , ((modMask, xK_d ), withTaggedP "abc" (shiftWin "2")) --- , ((modMask .|. shiftMask, xK_d ), withTaggedGlobalP "abc" shiftHere) --- , ((modMask .|. controlMask, xK_d ), focusUpTaggedGlobal "abc") --- , ((modMask, xK_g ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s))) --- , ((modMask .|. controlMask, xK_g ), tagDelPrompt defaultXPConfig) --- , ((modMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float)) --- , ((modWinMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedP s (shiftWin "2"))) --- , ((modWinMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere)) --- , ((modWinMask .|. controlMask, xK_g), tagPrompt defaultXPConfig (\s -> focusUpTaggedGlobal s)) +-- +-- > , ((modMask, xK_f ), withFocused (addTag "abc")) +-- > , ((modMask .|. controlMask, xK_f ), withFocused (delTag "abc")) +-- > , ((modMask .|. shiftMask, xK_f ), withTaggedGlobal "abc" sink) +-- > , ((modMask, xK_d ), withTaggedP "abc" (shiftWin "2")) +-- > , ((modMask .|. shiftMask, xK_d ), withTaggedGlobalP "abc" shiftHere) +-- > , ((modMask .|. controlMask, xK_d ), focusUpTaggedGlobal "abc") +-- > , ((modMask, xK_g ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s))) +-- > , ((modMask .|. controlMask, xK_g ), tagDelPrompt defaultXPConfig) +-- > , ((modMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float)) +-- > , ((modWinMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedP s (shiftWin "2"))) +-- > , ((modWinMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere)) +-- > , ((modWinMask .|. controlMask, xK_g), tagPrompt defaultXPConfig (\s -> focusUpTaggedGlobal s)) hunk ./TagWindows.hs 64 --- + hunk ./DragPane.hs 50 --- > dragPane Vertical 0.1 0.5 +-- > Layout $ dragPane Horizontal 0.1 0.5 hunk ./CycleWS.hs 38 --- > import XMonadContrib.NextWorkspace +-- > import XMonadContrib.CycleWS hunk ./CycleWS.hs 51 --- %import XMonadContrib.NextWorkspace +-- %import XMonadContrib.CycleWS hunk ./WindowBringer.hs 47 --- %keybind ((modMask .|. shiftMask, xK_g ), gotoMenu) --- %keybind ((modMask .|. shiftMask, xK_b ), bringMenu) +-- %keybind , ((modMask .|. shiftMask, xK_g ), gotoMenu) +-- %keybind , ((modMask .|. shiftMask, xK_b ), bringMenu) hunk ./WindowPrompt.hs 51 --- %keybind ((modMask .|. shiftMask, xK_g ), windowPromptGoto defaultXPConfig) --- %keybind ((modMask .|. shiftMask, xK_g ), windowPromptBring defaultXPConfig) +-- %keybind , ((modMask .|. shiftMask, xK_g ), windowPromptGoto defaultXPConfig) +-- %keybind , ((modMask .|. shiftMask, xK_g ), windowPromptBring defaultXPConfig) hunk ./WindowPrompt.hs 36 --- That is to say, it pops up a dmenu with window names, in case you forgot +-- That is to say, it pops up a prompt with window names, in case you forgot hunk ./WindowPrompt.hs 47 --- > , ((modMask .|. shiftMask, xK_g ), windowPromptBring defaultXPConfig) --- +-- > , ((modMask .|. shiftMask, xK_b ), windowPromptBring defaultXPConfig) + hunk ./WindowPrompt.hs 52 --- %keybind , ((modMask .|. shiftMask, xK_g ), windowPromptBring defaultXPConfig) +-- %keybind , ((modMask .|. shiftMask, xK_b ), windowPromptBring defaultXPConfig) + hunk ./scripts/generate-configs.sh 118 -INS_MARKER_DEF='-- Extension-provided definitions$' -INS_MARKER_IMPORT='-- Extension-provided imports$' -INS_MARKER_KEYBIND='-- Extension-provided key bindings$' -INS_MARKER_KEYBINDLIST='-- Extension-provided key bindings lists$' -INS_MARKER_LAYOUT='-- Extension-provided layouts$' -INS_MARKER_MOUSEBIND='-- Extension-provided mouse bindings$' +INS_MARKER_IMPORT='-- % Extension-provided imports$' +INS_MARKER_LAYOUT='-- % Extension-provided layouts$' +INS_MARKER_KEYBIND='-- % Extension-provided key bindings$' +INS_MARKER_KEYBINDLIST='-- % Extension-provided key bindings lists$' +INS_MARKER_MOUSEBIND='-- % Extension-provided mouse bindings$' +INS_MARKER_DEF='-- % Extension-provided definitions$' hunk ./Anneal.hs 11 +-- Requires the 'random' package hunk ./Combo.hs 1 -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} hunk ./Combo.hs 57 - deriving ( Show, Read ) + deriving (Show, Read) hunk ./Commands.hs 32 -import {-# SOURCE #-} Config (workspaces,possibleLayouts) +import {-# SOURCE #-} Config (workspaces,serialisedLayouts) hunk ./Commands.hs 84 - , ("default-layout" , setLayout (head possibleLayouts) ) + , ("default-layout" , setLayout (head serialisedLayouts) ) hunk ./Dmenu.hs 12 +-- +-- Requires the process-1.0 package hunk ./WorkspaceDir.hs 20 +-- +-- Requires the 'directory' package move ./scripts/generate-configs.sh ./scripts/generate-configs hunk ./scripts/generate-configs 3 -# generate-configs.sh - Docstring parser for generating xmonad build configs -# with default settings for extensions +# generate-configs - Docstring parser for generating xmonad build configs with +# default settings for extensions hunk ./scripts/generate-configs 12 -# Usage: generate-configs.sh PATH_TO_CONTRIBS +# Usage: generate-configs [ OPTIONS ] --main MAIN_DIR --contrib CONTRIB_DIR hunk ./scripts/generate-configs 14 -# Run this script from the directory containing xmonad's main Config.hs and -# xmonad.cabal files, otherwise you'll need to change the value of -# $REPO_DIR_BASE below. +# OPTIONS: +# --active, -a Insert data in active mode (default: passive) +# --contrib, -c CONTRIB_DIR Path to contrib repository base directory +# --help, -h Show help +# --main, -m MAIN_DIR Path to main repository base directory +# --output, -o OUTPUT_DIR Output directory (default: CONTRIB_DIR) +# +# Data parsed from the extension source files is inserted into Config.hs in +# either active or passive mode. The default is passive mode, in which the +# inserted data is commented out. The --active option inserts the data +# uncommented. Data inserted into xmonad.cabal is always inserted in active +# mode regardless of specified options. hunk ./scripts/generate-configs 102 -if [[ -z "$1" || $# > 1 || ! -d "$1" ]] ; then - echo "Usage: generate-configs.sh PATH_TO_CONTRIB" - exit 1 -fi - -REPO_DIR_BASE="." - -CABAL_FILE_BASE="${REPO_DIR_BASE}/xmonad.cabal" -CABAL_FILE_CONTRIB="${1}/xmonad.cabal" - -CONFIG_FILE_BASE="${REPO_DIR_BASE}/Config.hs" -CONFIG_FILE_CONTRIB="${1}/Config.hs" - hunk ./scripts/generate-configs 130 -# Prefix applied to inserted values after indent strings have been applied. -INS_PREFIX_CABALBUILDDEP=", " +# Prefix applied to inserted passive data after indent strings have been applied. hunk ./scripts/generate-configs 138 -cp -f "${CABAL_FILE_BASE}" "${CABAL_FILE_CONTRIB}" -cp -f "${CONFIG_FILE_BASE}" "${CONFIG_FILE_CONTRIB}" +# Prefix applied to inserted active data after indent strings have been applied. +ACTIVE_INS_PREFIX_CABALBUILDDEP=", " +ACTIVE_INS_PREFIX_DEF="" +ACTIVE_INS_PREFIX_IMPORT="import " +ACTIVE_INS_PREFIX_KEYBIND="" +ACTIVE_INS_PREFIX_KEYBINDLIST="" +ACTIVE_INS_PREFIX_LAYOUT="" +ACTIVE_INS_PREFIX_MOUSEBIND="" hunk ./scripts/generate-configs 147 -for extension_srcfile in $(ls --color=never -1 "${1}"/*.hs | head -n -1 | sort -r) ; do - for tag in $TAG_CABALBUILDDEP \ - $TAG_DEF \ - $TAG_IMPORT \ - $TAG_KEYBIND \ - $TAG_KEYBINDLIST \ - $TAG_LAYOUT \ - $TAG_MOUSEBIND ; do +# Don't touch these +opt_active=0 +opt_contrib="" +opt_main="" +opt_output="" hunk ./scripts/generate-configs 153 - ifs="$IFS" - IFS=$'\n' - tags=( $(sed -n -r -e "s/^.*--\s*${tag}\s//p" "${extension_srcfile}") ) - IFS="${ifs}" +generate_configs() { + for extension_srcfile in $(ls --color=never -1 "${opt_contrib}"/*.hs | head -n -1 | sort -r) ; do + for tag in $TAG_CABALBUILDDEP \ + $TAG_DEF \ + $TAG_IMPORT \ + $TAG_KEYBIND \ + $TAG_KEYBINDLIST \ + $TAG_LAYOUT \ + $TAG_MOUSEBIND ; do hunk ./scripts/generate-configs 163 - case $tag in - $TAG_CABALBUILDDEP) ins_indent=$INS_INDENT_CABALBUILDDEP - ins_marker=$INS_MARKER_CABALBUILDDEP - ins_prefix=$INS_PREFIX_CABALBUILDDEP - ;; - $TAG_DEF) ins_indent=$INS_INDENT_DEF - ins_marker=$INS_MARKER_DEF - ins_prefix=$INS_PREFIX_DEF - ;; - $TAG_IMPORT) ins_indent=$INS_INDENT_IMPORT - ins_marker=$INS_MARKER_IMPORT - ins_prefix=$INS_PREFIX_IMPORT - ;; - $TAG_KEYBIND) ins_indent=$INS_INDENT_KEYBIND - ins_marker=$INS_MARKER_KEYBIND - ins_prefix=$INS_PREFIX_KEYBIND - ;; - $TAG_KEYBINDLIST) ins_indent=$INS_INDENT_KEYBINDLIST - ins_marker=$INS_MARKER_KEYBINDLIST - ins_prefix=$INS_PREFIX_KEYBINDLIST - ;; - $TAG_LAYOUT) ins_indent=$INS_INDENT_LAYOUT - ins_marker=$INS_MARKER_LAYOUT - ins_prefix=$INS_PREFIX_LAYOUT - ;; - $TAG_MOUSEBIND) ins_indent=$INS_INDENT_MOUSEBIND - ins_marker=$INS_MARKER_MOUSEBIND - ins_prefix=$INS_PREFIX_MOUSEBIND - ;; - esac + ifs="$IFS" + IFS=$'\n' + tags=( $(sed -n -r -e "s/^.*--\s*${tag}\s//p" "${extension_srcfile}") ) + IFS="${ifs}" + + case $tag in + $TAG_CABALBUILDDEP) ins_indent=$INS_INDENT_CABALBUILDDEP + ins_marker=$INS_MARKER_CABALBUILDDEP + ins_prefix=$ACTIVE_INS_PREFIX_CABALBUILDDEP + ;; + $TAG_DEF) ins_indent=$INS_INDENT_DEF + ins_marker=$INS_MARKER_DEF + ins_prefix=$INS_PREFIX_DEF + ;; + $TAG_IMPORT) ins_indent=$INS_INDENT_IMPORT + ins_marker=$INS_MARKER_IMPORT + ins_prefix=$INS_PREFIX_IMPORT + ;; + $TAG_KEYBIND) ins_indent=$INS_INDENT_KEYBIND + ins_marker=$INS_MARKER_KEYBIND + ins_prefix=$INS_PREFIX_KEYBIND + ;; + $TAG_KEYBINDLIST) ins_indent=$INS_INDENT_KEYBINDLIST + ins_marker=$INS_MARKER_KEYBINDLIST + ins_prefix=$INS_PREFIX_KEYBINDLIST + ;; + $TAG_LAYOUT) ins_indent=$INS_INDENT_LAYOUT + ins_marker=$INS_MARKER_LAYOUT + ins_prefix=$INS_PREFIX_LAYOUT + ;; + $TAG_MOUSEBIND) ins_indent=$INS_INDENT_MOUSEBIND + ins_marker=$INS_MARKER_MOUSEBIND + ins_prefix=$INS_PREFIX_MOUSEBIND + ;; + esac hunk ./scripts/generate-configs 199 - # Insert in reverse so values will ultimately appear in correct order. - for i in $( seq $(( ${#tags[*]} - 1 )) -1 0 ) ; do - [ -z "${tags[i]}" ] && continue - if [[ $tag == $TAG_CABALBUILDDEP ]] ; then - sed -i -r -e "s/${ins_marker}/\\0${ins_prefix}${tags[i]}/" "${CABAL_FILE_CONTRIB}" - else - sed -i -r -e "/${ins_marker}/{G;s/$/${ins_indent}${ins_prefix}${tags[i]}/;}" "${CONFIG_FILE_CONTRIB}" + # Insert in reverse so values will ultimately appear in correct order. + for i in $( seq $(( ${#tags[*]} - 1 )) -1 0 ) ; do + [ -z "${tags[i]}" ] && continue + if [[ $tag == $TAG_CABALBUILDDEP ]] ; then + sed -i -r -e "s/${ins_marker}/\\0${ins_prefix}${tags[i]}/" "${CABAL_FILE}" + else + sed -i -r -e "/${ins_marker}/{G;s/$/${ins_indent}${ins_prefix}${tags[i]}/;}" "${CONFIG_FILE}" + fi + done + + if [[ $tag != $TAG_CABALBUILDDEP && -n "${tags}" ]] ; then + ins_group_comment="${ins_indent}-- For extension $(basename $extension_srcfile .hs):" + sed -i -r -e "/${ins_marker}/{G;s/$/${ins_group_comment}/;}" "${CONFIG_FILE}" hunk ./scripts/generate-configs 214 + done +} + +parse_opts() { + [[ -z "$1" ]] && show_usage 1 + + while [[ $# > 0 ]] ; do + case "$1" in + --active|-a) opt_active=1 + shift ;; + + --contrib|-c) shift + if [[ -z "$1" || ! -d "$1" ]] ; then + echo "Error: Option --contrib requires a directory as argument. See: generate-configs -h" + exit 1 + fi + opt_contrib="$1" + shift ;; + + --help|-h) show_usage ;; + + --main|-m) shift + if [[ -z "$1" || ! -d "$1" ]] ; then + echo "Error: Option --main requires a directory as argument. See: generate-configs -h" + exit 1 + fi + opt_main="$1" + shift ;; hunk ./scripts/generate-configs 243 - if [[ $tag != $TAG_CABALBUILDDEP && -n "${tags}" ]] ; then - ins_group_comment="${ins_indent}-- For extension $(basename $extension_srcfile .hs):" - sed -i -r -e "/${ins_marker}/{G;s/$/${ins_group_comment}/;}" "${CONFIG_FILE_CONTRIB}" - fi + --output|-o) shift + if [[ -z "$1" || ! -d "$1" ]] ; then + echo "Error: Option --output requires a directory as argument. See: generate-configs -h" + exit 1 + fi + opt_output="$1" + shift ;; + + -*) echo "Error: Unknown option ${1}. See: generate-configs -h" + exit 1 ;; + + *) show_usage 1 ;; + esac hunk ./scripts/generate-configs 257 -done + + if [[ -z "$opt_main" ]] ; then + echo "Error: Missing required option --main. See: generate-configs -h" + exit 1 + fi + + if [[ -z "$opt_contrib" ]] ; then + echo "Error: Missing required option --contrib. See: generate-configs -h" + exit 1 + fi +} + +show_usage() { +cat << EOF +Usage: generate-configs [ OPTIONS ] --main MAIN_DIR --contrib CONTRIB_DIR + +OPTIONS: + --active, -a Insert data in active mode (default: passive) + --contrib, -c CONTRIB_DIR Path to contrib repository base directory + --help, -h Show help + --main, -m MAIN_DIR Path to main repository base directory + --output, -o OUTPUT_DIR Output directory (default: CONTRIB_DIR) +EOF + exit ${1:-0} +} + +parse_opts $* + +[[ -z "$opt_output" ]] && opt_output="$opt_contrib" + +CABAL_FILE="${opt_output}/xmonad.cabal" +CONFIG_FILE="${opt_output}/Config.hs" + +cp -f "${opt_main}/xmonad.cabal" "${CABAL_FILE}" +cp -f "${opt_main}/Config.hs" "${CONFIG_FILE}" + +if [[ $opt_active == 1 ]] ; then + INS_PREFIX_DEF=$ACTIVE_INS_PREFIX_DEF + INS_PREFIX_IMPORT=$ACTIVE_INS_PREFIX_IMPORT + INS_PREFIX_KEYBIND=$ACTIVE_INS_PREFIX_KEYBIND + INS_PREFIX_KEYBINDLIST=$ACTIVE_INS_PREFIX_KEYBINDLIST + INS_PREFIX_LAYOUT=$ACTIVE_INS_PREFIX_LAYOUT + INS_PREFIX_MOUSEBIND=$ACTIVE_INS_PREFIX_MOUSEBIND +fi + +generate_configs hunk ./MetaModule.hs 26 -import XMonadContrib.Combo () +import XMonadContrib.Combo () -- broken under ghc head hunk ./TwoPane.hs 37 --- > ,(Layout $ TwoPane 0.03 0.5) +-- > , (Layout $ TwoPane 0.03 0.5) hunk ./TwoPane.hs 40 --- %layout , ,(Layout $ TwoPane 0.03 0.5) +-- %layout , (Layout $ TwoPane 0.03 0.5) hunk ./Combo.hs 38 --- > combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)] +-- > combo (TwoPane 0.03 0.5) [(Full,1),(tabbed shrinkText defaultTConf,1)] hunk ./LayoutHints.hs 31 --- > defaultLayouts = [ layoutHints tiled , layoutHints $ mirror tiled ] +-- > defaultLayouts = [ layoutHints tiled , layoutHints $ Mirror tiled ] hunk ./LayoutHints.hs 35 --- %layout , layoutHints $ mirror tiled +-- %layout , layoutHints $ Mirror tiled hunk ./Maximize.hs 37 --- > , Layout $ maximize $ myLayout ... +-- > , Layout $ maximize $ tiled ... hunk ./Maximize.hs 45 --- %layout , Layout $ maximize $ myLayout +-- %layout , Layout $ maximize $ tiled hunk ./CopyWindow.hs 79 - where delete'' w = sink w . modify Nothing (filter (/= w)) + where delete'' w = modify Nothing (filter (/= w)) replace ./Accordion.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Anneal.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Circle.hs [A-Za-z_0-9] defaultLayouts layouts hunk ./Combo.hs 40 --- to your defaultLayouts. +-- to your layouts. replace ./Commands.hs [A-Za-z_0-9] defaultLayouts layouts replace ./CopyWindow.hs [A-Za-z_0-9] defaultLayouts layouts replace ./CycleWS.hs [A-Za-z_0-9] defaultLayouts layouts replace ./DeManage.hs [A-Za-z_0-9] defaultLayouts layouts replace ./DirectoryPrompt.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Dishes.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Dmenu.hs [A-Za-z_0-9] defaultLayouts layouts replace ./DwmPromote.hs [A-Za-z_0-9] defaultLayouts layouts replace ./DynamicLog.hs [A-Za-z_0-9] defaultLayouts layouts replace ./DynamicWorkspaces.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Dzen.hs [A-Za-z_0-9] defaultLayouts layouts replace ./EwmhDesktops.hs [A-Za-z_0-9] defaultLayouts layouts replace ./FindEmptyWorkspace.hs [A-Za-z_0-9] defaultLayouts layouts replace ./FlexibleManipulate.hs [A-Za-z_0-9] defaultLayouts layouts replace ./FlexibleResize.hs [A-Za-z_0-9] defaultLayouts layouts replace ./FloatKeys.hs [A-Za-z_0-9] defaultLayouts layouts replace ./FocusNth.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Grid.hs [A-Za-z_0-9] defaultLayouts layouts replace ./HintedTile.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Invisible.hs [A-Za-z_0-9] defaultLayouts layouts hunk ./LayoutHints.hs 31 --- > defaultLayouts = [ layoutHints tiled , layoutHints $ Mirror tiled ] +-- > layouts = [ layoutHints tiled , layoutHints $ Mirror tiled ] replace ./LayoutModifier.hs [A-Za-z_0-9] defaultLayouts layouts replace ./LayoutScreens.hs [A-Za-z_0-9] defaultLayouts layouts replace ./MagicFocus.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Magnifier.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Maximize.hs [A-Za-z_0-9] defaultLayouts layouts replace ./MetaModule.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Mosaic.hs [A-Za-z_0-9] defaultLayouts layouts replace ./MosaicAlt.hs [A-Za-z_0-9] defaultLayouts layouts replace ./MouseGestures.hs [A-Za-z_0-9] defaultLayouts layouts replace ./NamedWindows.hs [A-Za-z_0-9] defaultLayouts layouts hunk ./NoBorders.hs 42 --- and modify the defaultLayouts to call noBorders on the layouts you want to lack +-- and modify the layouts to call noBorders on the layouts you want to lack hunk ./NoBorders.hs 45 --- > defaultLayouts = [ Layout (noBorders Full), ... ] +-- > layouts = [ Layout (noBorders Full), ... ] replace ./ResizableTile.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Roledex.hs [A-Za-z_0-9] defaultLayouts layouts replace ./RotSlaves.hs [A-Za-z_0-9] defaultLayouts layouts replace ./RotView.hs [A-Za-z_0-9] defaultLayouts layouts replace ./RunInXTerm.hs [A-Za-z_0-9] defaultLayouts layouts replace ./SetWMName.hs [A-Za-z_0-9] defaultLayouts layouts replace ./ShellPrompt.hs [A-Za-z_0-9] defaultLayouts layouts replace ./SimpleDate.hs [A-Za-z_0-9] defaultLayouts layouts replace ./SinkAll.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Spiral.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Square.hs [A-Za-z_0-9] defaultLayouts layouts replace ./SshPrompt.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Submap.hs [A-Za-z_0-9] defaultLayouts layouts replace ./SwapWorkspaces.hs [A-Za-z_0-9] defaultLayouts layouts replace ./SwitchTrans.hs [A-Za-z_0-9] defaultLayouts layouts hunk ./Tabbed.hs 47 --- > defaultLayouts :: [Layout Window] --- > defaultLayouts = [ Layout tiled --- > , Layout $ Mirror tiled --- > , Layout Full +-- > layouts :: [Layout Window] +-- > layouts = [ Layout tiled +-- > , Layout $ Mirror tiled +-- > , Layout Full hunk ./Tabbed.hs 52 --- > -- Extension-provided layouts --- > , Layout $ tabbed shrinkText defaultTConf --- > ] +-- > -- Extension-provided layouts +-- > , Layout $ tabbed shrinkText defaultTConf +-- > ] hunk ./Tabbed.hs 65 --- > defaultLayouts = [ ... --- > , Layout $ tabbed shrinkText myTabConfig ] +-- > layouts = [ ... +-- > , Layout $ tabbed shrinkText myTabConfig ] replace ./TagWindows.hs [A-Za-z_0-9] defaultLayouts layouts replace ./ViewPrev.hs [A-Za-z_0-9] defaultLayouts layouts replace ./Warp.hs [A-Za-z_0-9] defaultLayouts layouts replace ./WindowBringer.hs [A-Za-z_0-9] defaultLayouts layouts replace ./WindowNavigation.hs [A-Za-z_0-9] defaultLayouts layouts replace ./WindowPrompt.hs [A-Za-z_0-9] defaultLayouts layouts replace ./WmiiActions.hs [A-Za-z_0-9] defaultLayouts layouts replace ./WorkspaceDir.hs [A-Za-z_0-9] defaultLayouts layouts replace ./XMonadPrompt.hs [A-Za-z_0-9] defaultLayouts layouts replace ./XPrompt.hs [A-Za-z_0-9] defaultLayouts layouts replace ./XPropManage.hs [A-Za-z_0-9] defaultLayouts layouts replace ./XSelection.hs [A-Za-z_0-9] defaultLayouts layouts replace ./XUtils.hs [A-Za-z_0-9] defaultLayouts layouts hunk ./WindowNavigation.hs 42 --- > defaultLayout = Layout $ windowNavigation defaultWNConfig $ LayoutSelection ... +-- > defaultLayout = Layout $ windowNavigation defaultWNConfig $ Select ... replace ./WindowNavigation.hs [A-Za-z_0-9] defaultLayout layoutHook hunk ./ShellPrompt.hs 29 +import Data.Set (toList, fromList) hunk ./ShellPrompt.hs 64 - return . map escape . sort . nub $ f ++ c + return . map escape . sort . (toList . fromList) $ f ++ c hunk ./ShellPrompt.hs 55 - hunk ./ShellPrompt.hs 56 -shellPrompt c = mkXPrompt Shell c getShellCompl spawn +shellPrompt c = do + cmds <- io $ getCommands + mkXPrompt Shell c (getShellCompl cmds) spawn + +getShellCompl :: [String] -> String -> IO [String] +getShellCompl cmds s | s == "" || last s == ' ' = return [] + | otherwise = do + f <- fmap lines $ runProcessWithInput "/bin/bash" [] ("compgen -A file " ++ s ++ "\n") + return . map escape . uniqSort $ f ++ commandCompletionFunction cmds s + +uniqSort :: Ord a => [a] -> [a] +uniqSort = toList . fromList hunk ./ShellPrompt.hs 69 -getShellCompl :: String -> IO [String] -getShellCompl s - | s /= "" && last s /= ' ' = do - f <- fmap lines $ runProcessWithInput "/bin/bash" [] ("compgen -A file " ++ s ++ "\n") - c <- commandCompletionFunction s - return . map escape . sort . (toList . fromList) $ f ++ c - | otherwise = return [] +commandCompletionFunction :: [String] -> String -> [String] +commandCompletionFunction cmds str | '/' `elem` str = [] + | otherwise = filter (isPrefixOf str) cmds hunk ./ShellPrompt.hs 73 -commandCompletionFunction :: String -> IO [String] -commandCompletionFunction str - | '/' `elem` str = return [] - | otherwise = 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) - else return [] - return . filter (isPrefixOf str) . concat $ es +getCommands :: IO [String] +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) + else return [] + return . uniqSort . concat $ es hunk ./Spiral.hs 79 + description _ = "Spiral" hunk ./Combo.hs 27 +import Operations ( LayoutMessages(ReleaseResources) ) hunk ./Combo.hs 29 +import XMonadContrib.Invisible hunk ./Combo.hs 56 -combo = Combo [] +combo = Combo (I []) hunk ./Combo.hs 58 -data Combo l a = Combo [a] (l (Layout a, Int)) [(Layout a, Int)] +data Combo l a = Combo (Invisible [] a) (l (Layout a, Int)) [(Layout a, Int)] hunk ./Combo.hs 61 -instance (Eq a, Show a, Read a, ReadableLayout a, LayoutClass l (Layout a, Int)) +instance (Eq a, ReadableLayout a, LayoutClass l (Layout a, Int)) hunk ./Combo.hs 63 - doLayout (Combo f super origls) rinput s = arrange (integrate s) - where arrange [] = return ([], Just $ Combo [] super origls) - arrange [w] = return ([(w,rinput)], Just $ Combo [w] super origls) + doLayout (Combo (I f) super origls) rinput s = arrange (integrate s) + where arrange [] = return ([], Just $ Combo (I []) super origls) + arrange [w] = return ([(w,rinput)], Just $ Combo (I [w]) super origls) hunk ./Combo.hs 78 - return (concat $ map fst out, Just $ Combo f' super' origls') + return (concat $ map fst out, Just $ Combo (I f') super' origls') hunk ./Combo.hs 85 - handleMessage (Combo f super origls) m = + handleMessage (Combo (I f) super origls) m = hunk ./Combo.hs 88 + f' = case fromMessage m of + Just ReleaseResources -> [] + _ -> f hunk ./Combo.hs 93 - Just [super'] -> return $ Just $ Combo f super' $ maybe origls id mls' - _ -> return $ Combo f super `fmap` mls' + Just [super'] -> return $ Just $ Combo (I f') super' $ maybe origls id mls' + _ -> return $ Combo (I f') super `fmap` mls' hunk ./WindowNavigation.hs 23 - WNConfig (..), defaultWNConfig + navigateColor, noNavigateBorders hunk ./WindowNavigation.hs 42 --- > layoutHook = Layout $ windowNavigation defaultWNConfig $ Select ... +-- > layoutHook = Layout $ windowNavigation defaultWNConfig $ LayoutSelection ... hunk ./WindowNavigation.hs 47 --- > , ((modMask, xK_Left), sendMessage $ Go L) --- > , ((modMask, xK_Up), sendMessage $ Go U) --- > , ((modMask, xK_Down), sendMessage $ Go D) +-- > , ((modMask, xK_Left ), sendMessage $ Go L) +-- > , ((modMask, xK_Up ), sendMessage $ Go U) +-- > , ((modMask, xK_Down ), sendMessage $ Go D) hunk ./WindowNavigation.hs 52 --- %keybind , ((modMask, xK_Right), sendMessage $ Go R) --- %keybind , ((modMask, xK_Left), sendMessage $ Go L) --- %keybind , ((modMask, xK_Up), sendMessage $ Go U) --- %keybind , ((modMask, xK_Down), sendMessage $ Go D) +-- %keybind , ((modMask, xK_Right), sendMessage $ Go R) +-- %keybind , ((modMask, xK_Left ), sendMessage $ Go L) +-- %keybind , ((modMask, xK_Up ), sendMessage $ Go U) +-- %keybind , ((modMask, xK_Down ), sendMessage $ Go D) hunk ./WindowNavigation.hs 57 --- %keybind , ((modMask .|. controlMask, xK_Left), sendMessage $ Swap L) --- %keybind , ((modMask .|. controlMask, xK_Up), sendMessage $ Swap U) --- %keybind , ((modMask .|. controlMask, xK_Down), sendMessage $ Swap D) +-- %keybind , ((modMask .|. controlMask, xK_Left ), sendMessage $ Swap L) +-- %keybind , ((modMask .|. controlMask, xK_Up ), sendMessage $ Swap U) +-- %keybind , ((modMask .|. controlMask, xK_Down ), sendMessage $ Swap D) hunk ./WindowNavigation.hs 77 +noNavigateBorders :: WNConfig +noNavigateBorders = + defaultWNConfig {showNavigable = False} + +navigateColor :: String -> WNConfig +navigateColor c = + WNC True c c c c + hunk ./WindowNavigation.hs 23 - navigateColor, noNavigateBorders + navigateColor, navigateBrightness, + noNavigateBorders, defaultWNConfig hunk ./WindowNavigation.hs 28 -import Control.Monad ( when ) hunk ./WindowNavigation.hs 70 - WNC { showNavigable :: Bool + WNC { brightness :: Maybe Double -- Indicates a fraction of the focus color. hunk ./WindowNavigation.hs 79 - defaultWNConfig {showNavigable = False} + defaultWNConfig {brightness = Just 0} hunk ./WindowNavigation.hs 83 - WNC True c c c c + WNC Nothing c c c c + +navigateBrightness :: Double -> WNConfig +navigateBrightness f | f > 1 = navigateBrightness 1 + | f < 0 = navigateBrightness 0 +navigateBrightness f = defaultWNConfig { brightness = Just f } hunk ./WindowNavigation.hs 91 -defaultWNConfig = WNC True "#0000FF" "#00FFFF" "#FF0000" "#FF00FF" +defaultWNConfig = WNC (Just 0.5) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF" hunk ./WindowNavigation.hs 102 - do XConf { normalBorder = nbc } <- ask - [uc,dc,lc,rc] <- mapM stringToPixel [upColor conf, downColor conf, leftColor conf, rightColor conf] + do XConf { normalBorder = nbc, focusedBorder = fbc } <- ask + [uc,dc,lc,rc] <- + case brightness conf of + Just frac -> return $ map round [myc,myc,myc,myc] + -- Note: The following is a fragile crude hack... it really only + -- works properly when the only non-zero color is blue. We should + -- split the color into components and average *those*. + where myc = (1-frac)*(fromIntegral nbc) + frac*(fromIntegral fbc) + Nothing -> mapM stringToPixel [upColor conf, downColor conf, + leftColor conf, rightColor conf] hunk ./WindowNavigation.hs 130 - when (showNavigable conf) $ mapM_ (\(win,c) -> sc c win) wnavigablec + mapM_ (\(win,c) -> sc c win) wnavigablec hunk ./WindowNavigation.hs 42 --- > layoutHook = Layout $ windowNavigation defaultWNConfig $ LayoutSelection ... +-- > layoutHook = Layout $ windowNavigation defaultWNConfig $ Select ... +-- +-- or perhaps +-- +-- > layoutHook = Layout $ windowNavigation (navigateBorder "green") $ Select ... hunk ./WindowNavigation.hs 67 +-- %layout -- or +-- %layout -- layoutHook = Layout $ windowNavigation (navigateBorder "green") $ ... hunk ./WindowNavigation.hs 111 - Just frac -> return $ map round [myc,myc,myc,myc] - -- Note: The following is a fragile crude hack... it really only - -- works properly when the only non-zero color is blue. We should - -- split the color into components and average *those*. - where myc = (1-frac)*(fromIntegral nbc) + frac*(fromIntegral fbc) + Just frac -> do myc <- averagePixels fbc nbc frac + return [myc,myc,myc,myc] hunk ./XUtils.hs 19 + , averagePixels hunk ./XUtils.hs 53 +-- | Compute the weighted average the colors of two given Pixel values. +averagePixels :: Pixel -> Pixel -> Double -> X Pixel +averagePixels p1 p2 f = + do d <- asks display + let cm = defaultColormap d (defaultScreen d) + [Color _ r1 g1 b1 _,Color _ r2 g2 b2 _] <- io $ queryColors d cm [Color p1 0 0 0 0,Color p2 0 0 0 0] + 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 + hunk ./WindowNavigation.hs 21 - windowNavigation, + windowNavigation, configurableNavigation, hunk ./WindowNavigation.hs 42 --- > layoutHook = Layout $ windowNavigation defaultWNConfig $ Select ... +-- > layoutHook = Layout $ windowNavigation $ Select ... hunk ./WindowNavigation.hs 46 --- > layoutHook = Layout $ windowNavigation (navigateBorder "green") $ Select ... +-- > layoutHook = Layout $ configurableNavigation (navigateBorder "green") $ Select ... hunk ./WindowNavigation.hs 66 --- %layout -- layoutHook = Layout $ windowNavigation defaultWNConfig $ ... +-- %layout -- layoutHook = Layout $ windowNavigation $ ... hunk ./WindowNavigation.hs 68 --- %layout -- layoutHook = Layout $ windowNavigation (navigateBorder "green") $ ... +-- %layout -- layoutHook = Layout $ configurableNavigation (navigateBorder "green") $ ... hunk ./WindowNavigation.hs 103 -windowNavigation :: LayoutClass l a => WNConfig -> l a -> ModifiedLayout WindowNavigation l a -windowNavigation conf = ModifiedLayout (WindowNavigation conf (I Nothing)) +windowNavigation :: LayoutClass l a => l a -> ModifiedLayout WindowNavigation l a +windowNavigation = ModifiedLayout (WindowNavigation defaultWNConfig (I Nothing)) + +configurableNavigation :: LayoutClass l a => WNConfig -> l a -> ModifiedLayout WindowNavigation l a +configurableNavigation conf = ModifiedLayout (WindowNavigation conf (I Nothing)) hunk ./DynamicWorkspaces.hs 19 - addWorkspace, removeWorkspace + addWorkspace, removeWorkspace, + selectWorkspace hunk ./DynamicWorkspaces.hs 29 +import XMonadContrib.WorkspacePrompt +import XMonadContrib.XPrompt ( XPConfig ) hunk ./DynamicWorkspaces.hs 37 --- > , ((modMask .|. shiftMask, xK_Up), addWorkspace layouts) --- > , ((modMask .|. shiftMask, xK_Down), removeWorkspace) +-- > , ((modMask .|. shiftMask, xK_n), selectWorkspace defaultXPConfig layoutHook) +-- > , ((modMask .|. shiftMask, xK_BackSpace), removeWorkspace) hunk ./DynamicWorkspaces.hs 43 +selectWorkspace :: XPConfig -> Layout Window -> X () +selectWorkspace conf l = workspacePrompt conf $ \w -> + do s <- gets windowset + if tagMember w s + then windows $ greedyView w + else windows $ addWorkspace' w l + addfile ./WorkspacePrompt.hs hunk ./WorkspacePrompt.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.WorkspacePrompt +-- Copyright : (C) 2007 Andrea Rossato, David Roundy +-- License : BSD3 +-- +-- Maintainer : droundy@darcs.net +-- Stability : unstable +-- Portability : unportable +-- +-- A directory prompt for XMonad +-- +----------------------------------------------------------------------------- + +module XMonadContrib.WorkspacePrompt ( + -- * Usage + -- $usage + workspacePrompt + ) where + +import Control.Monad.State ( gets ) +import Data.List ( sort ) +import XMonad +import XMonadContrib.XPrompt +import StackSet ( workspaces, tag ) + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.WorkspacePrompt +-- +-- > , ((modMask .|. shiftMask, xK_m ), workspacePrompt myXPConfig (windows . W.shift)) + +data Wor = Wor String + +instance XPrompt Wor where + showXPrompt (Wor x) = x + +workspacePrompt :: XPConfig -> (String -> X ()) -> X () +workspacePrompt c job = do ws <- gets (workspaces . windowset) + let ts = sort $ map tag ws + mkXPrompt (Wor "") c (mkCompl ts) job + +mkCompl :: [String] -> String -> IO [String] +mkCompl l s = return $ filter (\x -> take (length s) x == s) l hunk ./DynamicWorkspaces.hs 20 - selectWorkspace + selectWorkspace, + toNthWorkspace, withNthWorkspace hunk ./DynamicWorkspaces.hs 25 +import Data.List ( sort ) hunk ./DynamicWorkspaces.hs 27 -import XMonad ( X, XState(..), Layout, WorkspaceId ) +import XMonad ( X, XState(..), Layout, WorkspaceId, WindowSet ) hunk ./DynamicWorkspaces.hs 41 +-- +-- > -- mod-[1..9] %! Switch to workspace N +-- > -- mod-shift-[1..9] %! Move client to workspace N +-- > ++ +-- > zip (zip (repeat modMask) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..]) +-- > ++ +-- > zip (zip (repeat (modMask .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..]) hunk ./DynamicWorkspaces.hs 52 +toNthWorkspace :: (String -> X ()) -> Int -> X () +toNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset) + case drop wnum ws of + (w:_) -> job w + [] -> return () + +withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X () +withNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset) + case drop wnum ws of + (w:_) -> windows $ job w + [] -> return () + hunk ./DynamicWorkspaces.hs 66 - do s <- gets windowset - if tagMember w s - then windows $ greedyView w - else windows $ addWorkspace' w l + windows $ \s -> if tagMember w s + then greedyView w s + else addWorkspace' w l s addfile ./TilePrime.hs hunk ./TilePrime.hs 1 +-- -------------------------------------------------------------------------- +-- -- | +-- -- Module : TilePrime.hs +-- -- Copyright : (c) Eric Mertens 2007 +-- -- License : BSD3-style (see LICENSE) +-- -- +-- -- Maintainer : emertens@gmail.com +-- -- Stability : unstable +-- -- Portability : not portable +-- -- +-- -- TilePrime. Tile windows filling gaps created by resize hints +-- -- +-- ----------------------------------------------------------------------------- +-- + +module XMonadContrib.TilePrime (TilePrime(TilePrime)) where + +import Control.Monad (mplus) +import Data.List (genericLength) +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras (getWMNormalHints) +import Operations +import XMonad hiding (trace) +import qualified StackSet as W +import {-#SOURCE#-} Config (borderWidth) + +data TilePrime a = TilePrime + { nmaster :: Int + , delta, frac :: Rational + , flipped :: Bool + } deriving (Show, Read) + +instance LayoutClass TilePrime Window where + description _ = "TilePrime" + + pureMessage c m = fmap resize (fromMessage m) `mplus` + fmap incmastern (fromMessage m) + where + resize Shrink = c { frac = max 0 $ frac c - delta c } + resize Expand = c { frac = min 1 $ frac c + delta c } + incmastern (IncMasterN d) = c { nmaster = max 0 $ nmaster c + d } + + doLayout c rect s = do + let flp = flipped c + let xs = W.integrate s + hints <- withDisplay $ \ disp -> io (mapM (getWMNormalHints disp) xs) + let xs' = zip xs hints + (leftRect, rightRect) + | flp = splitVerticallyBy (frac c) rect + | otherwise = splitHorizontallyBy (frac c) rect + masters = fillWindows flp leftRect (take (nmaster c) xs') + slaves = fillWindows flp rightRect (drop (nmaster c) xs') + return (masters ++ slaves, Nothing) + + where + + fillWindows _ _ [] = [] + fillWindows flp r ((x,hint):xs) = (x,r') : fillWindows flp rest xs + where + n = 1 + genericLength xs :: Rational + + (alloca, _) | flp = splitHorizontallyBy (recip n) r + | otherwise = splitVerticallyBy (recip n) r + + (w,h) = applySizeHints hint `underBorders` (rect_width alloca, rect_height alloca) + + r' = r { rect_width = w, rect_height = h } + + rest | flp = r { rect_x = rect_x r + toEnum (fromEnum w) + , rect_width = rect_width r - w } + | otherwise = r { rect_y = rect_y r + toEnum (fromEnum h) + , rect_height = rect_height r - h } + +-- | Transform a function on dimensions into one without regard for borders +underBorders :: (D -> D) -> D -> D +underBorders f = adjBorders 1 . f . adjBorders (-1) + +-- | Modify dimensions by a multiple of the current borders +adjBorders :: Dimension -> D -> D +adjBorders mult (w,h) = (w+2*mult*borderWidth, h+2*mult*borderWidth) hunk ./MetaModule.hs 77 +import XMonadContrib.TilePrime () hunk ./MetaModule.hs 91 +import XMonadContrib.WorkspacePrompt () hunk ./TilePrime.hs 1 +{-# LANGUAGE MultiParamTypeClasses #-} hunk ./TilePrime.hs 17 -module XMonadContrib.TilePrime (TilePrime(TilePrime)) where +module XMonadContrib.TilePrime ( + -- * Usage + -- $usage + TilePrime(TilePrime) + ) where hunk ./TilePrime.hs 32 +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonadContrib.TilePrime +-- +-- and add the following line to your 'layouts' +-- +-- > , Layout $ TilePrime nmaster delta ratio False +-- +-- Use True as the last argument to get a wide layout. + +-- %import XMonadContrib.TilePrime +-- %layout , Layout $ TilePrime nmaster delta ratio False + hunk ./RotSlaves.hs 15 - -- $usage - rotSlaves', rotSlavesUp, rotSlavesDown + -- $usag + rotSlaves', rotSlavesUp, rotSlavesDown, + rotAll', rotAllUp, rotAllDown hunk ./RotSlaves.hs 32 --- > , ((modMask .|. shiftMask, xK_Tab ), rotSlavesUp) +-- > , ((modMask .|. shiftMask, xK_Tab ), rotSlavesUp) hunk ./RotSlaves.hs 41 +-- | Rotate the windows in the current stack excluding the first one hunk ./RotSlaves.hs 53 +-- | Rotate the windows in the current stack +rotAllUp,rotAllDown :: X () +rotAllUp = windows $ modify' (rotAll' (\l -> (tail l)++[head l])) +rotAllDown = windows $ modify' (rotAll' (\l -> [last l]++(init l))) + +rotAll' :: ([a] -> [a]) -> Stack a -> Stack a +rotAll' f s = Stack r (reverse revls) rs + where (revls,r:rs) = splitAt (length (up s)) (f (integrate s)) + hunk ./TilePrime.hs 68 + | null (drop 1 xs) = (rect, Rectangle 0 0 0 0) hunk ./Roledex.hs 1 -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} hunk ./TilePrime.hs 1 -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} hunk ./DirectoryPrompt.hs 23 -import XMonadContrib.Dmenu ( runProcessWithInput ) +import XMonadContrib.Run ( runProcessWithInput ) hunk ./Dmenu.hs 20 - dmenu, dmenuXinerama, dmenuMap, - runProcessWithInput + dmenu, dmenuXinerama, dmenuMap hunk ./Dmenu.hs 26 -import System.Process -import System.IO hunk ./Dmenu.hs 27 +import XMonadContrib.Run hunk ./Dmenu.hs 36 --- | Returns Just output if the command succeeded, and Nothing if it didn't. --- 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 - (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing - hPutStr pin input - hClose pin - output <- hGetContents pout - when (output==output) $ return () - hClose pout - hClose perr - waitForProcess ph - return output - hunk ./Dzen.hs 17 -import System.Posix.Process (forkProcess, getProcessStatus, createSession) -import System.IO -import System.Process -import System.Exit -import Control.Concurrent (threadDelay) hunk ./Dzen.hs 18 - hunk ./Dzen.hs 20 - --- 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 - -- output <- hGetContents pout - -- when (output==output) $ return () - hClose pout - hClose perr - waitForProcess ph - return () - exitWith ExitSuccess - return () - getProcessStatus True False pid - return () - +import XMonadContrib.Run hunk ./MetaModule.hs 63 -import XMonadContrib.RunInXTerm () addfile ./Run.hs hunk ./Run.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Run +-- Copyright : (C) 2007 Spencer Janssen, Andrea Rossato, glasser@mit.edu +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Christian Thiemann +-- Stability : unstable +-- Portability : unportable +-- +-- This modules provides several commands to run an external process. +-- It is composed of functions formerly defined in XMonadContrib.Dmenu (by +-- Spenver Jannsen), XMonadContrib.Dzen (by glasser@mit.edu) and +-- XMonadContrib.RunInXTerm (by Andrea Rossato). +-- +----------------------------------------------------------------------------- + +module XMonadContrib.Run ( + -- * Usage + -- $usage + runInXTerm, + runProcessWithInput, + runProcessWithInputAndWait + ) where + +import XMonad +import Control.Concurrent (threadDelay) +import Control.Monad.State +import System.Environment +import System.Exit +import System.IO +import System.Posix.Process (forkProcess, getProcessStatus, createSession) +import System.Process + + +-- $usage +-- For an example usage of runInXTerm see XMonadContrib.SshPrompt +-- +-- For an example usage of runProcessWithInput see +-- XMonadContrib.{DirectoryPrompt,Dmenu,ShellPrompt,WmiiActions,WorkspaceDir} +-- +-- For an example usage of runProcessWithInputAndWait see XMonadContrib.Dzen + +-- | Returns Just output if the command succeeded, and Nothing if it didn't. +-- 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 + (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing + hPutStr pin input + hClose pin + output <- hGetContents pout + when (output==output) $ return () + hClose pout + hClose perr + waitForProcess ph + return output + +-- 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 + -- output <- hGetContents pout + -- when (output==output) $ return () + hClose pout + hClose perr + waitForProcess ph + return () + exitWith ExitSuccess + return () + getProcessStatus True False pid + return () + +runInXTerm :: String -> X () +runInXTerm com = do + c <- io $ catch (getEnv "XTERMCMD") (const $ return "xterm") + spawn ("exec " ++ c ++ " -e " ++ com) + hunk ./ShellPrompt.hs 25 -import XMonadContrib.Dmenu +import XMonadContrib.Run hunk ./WmiiActions.hs 29 -import XMonadContrib.Dmenu (dmenu, dmenuXinerama, runProcessWithInput) +import XMonadContrib.Dmenu (dmenu, dmenuXinerama) +import XMonadContrib.Run (runProcessWithInput) hunk ./WorkspaceDir.hs 36 -import XMonadContrib.Dmenu ( runProcessWithInput ) +import XMonadContrib.Run ( runProcessWithInput ) hunk ./MetaModule.hs 63 +import XMonadContrib.Run () hunk ./RunInXTerm.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.RunInXTerm --- Copyright : (C) 2007 Andrea Rossato --- License : BSD3 --- --- Maintainer : andrea.rossato@unibz.it --- Stability : unstable --- Portability : unportable --- --- A simple module to launch commands in an X terminal --- from XMonad --- ------------------------------------------------------------------------------ - -module XMonadContrib.RunInXTerm ( - -- * Usage - -- $usage - runInXTerm - ) where - -import XMonad -import System.Environment - --- $usage --- For an example usage see "XMonadContrib.SshPrompt" - -runInXTerm :: String -> X () -runInXTerm com = do - c <- io $ catch (getEnv "XTERMCMD") (const $ return "xterm") - spawn ("exec " ++ c ++ " -e " ++ com) rmfile ./RunInXTerm.hs hunk ./SshPrompt.hs 23 -import XMonadContrib.RunInXTerm +import XMonadContrib.Run hunk ./TilePrime.hs 24 -import Data.List (genericLength) +import Data.List (mapAccumL) hunk ./TilePrime.hs 62 - doLayout c rect s = do - let flp = flipped c + doLayout TilePrime { frac = f, nmaster = m, flipped = flp } rect s = do hunk ./TilePrime.hs 67 - | null (drop 1 xs) = (rect, Rectangle 0 0 0 0) - | flp = splitVerticallyBy (frac c) rect - | otherwise = splitHorizontallyBy (frac c) rect - masters = fillWindows flp leftRect (take (nmaster c) xs') - slaves = fillWindows flp rightRect (drop (nmaster c) xs') + | null (drop m xs) = (rect, Rectangle 0 0 0 0) + | flp = splitVerticallyBy f rect + | otherwise = splitHorizontallyBy f rect + (leftXs, rightXs) = splitAt m xs' + masters = fillWindows leftRect leftXs + slaves = fillWindows rightRect rightXs hunk ./TilePrime.hs 76 + fillWindows r xs = snd $ mapAccumL aux (r,n) xs + where n = fromIntegral (length xs) :: Rational hunk ./TilePrime.hs 79 - fillWindows _ _ [] = [] - fillWindows flp r ((x,hint):xs) = (x,r') : fillWindows flp rest xs + aux (r,n) (x,hint) = ((rest,n-1),(x,r')) hunk ./TilePrime.hs 81 - n = 1 + genericLength xs :: Rational + (allocated, _) | flp = splitHorizontallyBy (recip n) r + | otherwise = splitVerticallyBy (recip n) r hunk ./TilePrime.hs 84 - (alloca, _) | flp = splitHorizontallyBy (recip n) r - | otherwise = splitVerticallyBy (recip n) r - - (w,h) = applySizeHints hint `underBorders` (rect_width alloca, rect_height alloca) + (w,h) = applySizeHints hint `underBorders` rect_D allocated hunk ./TilePrime.hs 93 +rect_D :: Rectangle -> D +rect_D Rectangle { rect_width = w, rect_height = h } = (w,h) + hunk ./DynamicLog.hs 45 -import Data.Char hunk ./DynamicLog.hs 89 - io . putStrLn $ concat [wn ," : " ,map toLower ld] + io . putStrLn $ concat [wn ," : " ,ld] hunk ./DynamicLog.hs 25 - dynamicLogWithTitle, - dynamicLogWithTitleColored, + dynamicLogWithPP, hunk ./DynamicLog.hs 29 - pprWindowSetXinerama + pprWindowSetXinerama, + + PP(..), defaultPP, sjanssenPP, + wrap, xmobarColor hunk ./DynamicLog.hs 54 --- --- To get the title of the currently focused window after the workspace list: --- --- > import XMonadContrib.DynamicLog --- > logHook = dynamicLogWithTitle --- --- To have the window title highlighted in any color recognized by dzen: --- --- > import XMonadContrib.DynamicLog --- > logHook = dynamicLogWithTitleColored "white" --- hunk ./DynamicLog.hs 63 --- Perform an arbitrary action on each state change. --- Examples include: --- * do nothing --- * log the state to stdout +-- An example log hook, print a status bar output to stdout, in the form: hunk ./DynamicLog.hs 65 --- | --- An example log hook, print a status bar output to dzen, in the form: +-- > 1 2 [3] 4 7 : full : title hunk ./DynamicLog.hs 67 --- > 1 2 [3] 4 7 : full +-- That is, the currently populated workspaces, the current +-- workspace layout, and the title of the focused window. hunk ./DynamicLog.hs 70 --- That is, the currently populated workspaces, and the current --- workspace layout --- hunk ./DynamicLog.hs 71 -dynamicLog = withWindowSet $ \ws -> do - let ld = description . S.layout . S.workspace . S.current $ ws - wn = pprWindowSet ws - io . putStrLn $ concat [wn ," : " ,ld] +dynamicLog = dynamicLogWithPP defaultPP hunk ./DynamicLog.hs 73 --- | Appends title of currently focused window to log output, and the --- current layout mode, to the normal dynamic log format. --- Arguments are: pre-title text and post-title text --- --- The result is rendered in the form: --- --- > 1 2 [3] 4 7 : full : urxvt --- -dynamicLogWithTitle_ :: String -> String -> X () -dynamicLogWithTitle_ pre post= do +-- | +-- A log +dynamicLogWithPP :: PP -> X () +dynamicLogWithPP pp = do hunk ./DynamicLog.hs 80 - ws <- withWindowSet $ return . pprWindowSet + ws <- withWindowSet $ return . pprWindowSet pp hunk ./DynamicLog.hs 84 - io . putStrLn $ concat [ws ," : " ,map toLower ld - , case wt of - [] -> [] - s -> " : " ++ pre ++ s ++ post - ] - -dynamicLogWithTitle :: X () -dynamicLogWithTitle = dynamicLogWithTitle_ "" "" - --- | --- As for dynamicLogWithTitle but with colored window title (for dzen use) --- -dynamicLogWithTitleColored :: String -> X () -dynamicLogWithTitleColored color = dynamicLogWithTitle_ ("^fg(" ++ color ++ ")") "^fg()" + io . putStrLn . sepBy (ppSep pp) $ + [ ws + , ppLayout pp ld + , ppTitle pp wt + ] hunk ./DynamicLog.hs 90 -pprWindowSet :: WindowSet -> String -pprWindowSet s = concatMap fmt $ sortBy cmp +pprWindowSet :: PP -> WindowSet -> String +pprWindowSet pp s = unwords' $ map fmt $ sortBy cmp hunk ./DynamicLog.hs 105 - fmt w | S.tag w == this = "[" ++ S.tag w ++ "]" - | S.tag w `elem` visibles = "<" ++ S.tag w ++ ">" - | isJust (S.stack w) = " " ++ S.tag w ++ " " - | otherwise = "" + 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 hunk ./DynamicLog.hs 129 +wrap :: String -> String -> String -> String +wrap l r m = l ++ m ++ r + +-- | Intersperse spaces, filtering empty words. +unwords' :: [String] -> String +unwords' = sepBy " " + +sepBy :: String -> [String] -> String +sepBy sep = concat . intersperse sep . filter null + +-- TODO dzenColor +xmobarColor :: String -> String -> String -> String +xmobarColor fg bg = wrap t "" + where t = concat [""] + +-- | The 'PP' type allows the user to customize various behaviors of +-- dynamicLogPP +data PP = PP { ppCurrent, ppVisible + , ppHidden, ppHiddenNoWindows :: WorkspaceId -> String + , ppSep :: String + , ppTitle :: String -> String + , ppLayout :: String -> String } + +-- | The default pretty printing options, as seen in dynamicLog +defaultPP :: PP +defaultPP = PP { ppCurrent = wrap "[" "]" + , ppVisible = wrap "<" ">" + , ppHidden = id + , ppHiddenNoWindows = const "" + , ppSep = " : " + , ppTitle = const "" + , ppLayout = wrap "(" ")"} + +-- | The options that sjanssen likes to use, as an example. Note the use of +-- 'xmobarColor' and the record update on defaultPP +sjanssenPP :: PP +sjanssenPP = defaultPP { ppCurrent = xmobarColor "white" "#ff000000" + , ppTitle = xmobarColor "#00ee00" "" + } + hunk ./DynamicLog.hs 137 -sepBy sep = concat . intersperse sep . filter null +sepBy sep = concat . intersperse sep . filter (not . null) hunk ./DynamicLog.hs 160 - , ppLayout = wrap "(" ")"} + , ppLayout = id } hunk ./DynamicLog.hs 84 - io . putStrLn . sepBy (ppSep pp) $ + io . putStrLn . sepBy (ppSep pp) . ppOrder pp $ hunk ./DynamicLog.hs 150 - , ppLayout :: String -> String } + , ppLayout :: String -> String + , ppOrder :: [String] -> [String] } hunk ./DynamicLog.hs 161 - , ppLayout = id } + , ppLayout = id + , ppOrder = id } hunk ./DynamicLog.hs 169 + , ppOrder = reverse hunk ./DynamicLog.hs 58 --- %def logHook = dynamicLogWithTitle --- %def logHook = dynamicLogWithTitleColored "white" hunk ./DynamicLog.hs 72 --- A log +-- A log function that uses the 'PP' hooks to customize output. hunk ./DynamicLog.hs 128 -wrap l r m = l ++ m ++ r +wrap l r "" = "" +wrap l r m = l ++ m ++ r hunk ./DynamicLog.hs 89 -pprWindowSet pp s = unwords' $ map fmt $ sortBy cmp +pprWindowSet pp s = sepBy (ppWsSep pp) $ map fmt $ sortBy cmp hunk ./DynamicLog.hs 131 --- | Intersperse spaces, filtering empty words. -unwords' :: [String] -> String -unwords' = sepBy " " - hunk ./DynamicLog.hs 143 - , ppSep :: String + , ppSep, ppWsSep :: String hunk ./DynamicLog.hs 155 + , ppWsSep = " " hunk ./DynamicLog.hs 32 - wrap, xmobarColor + wrap, xmobarColor, shorten hunk ./DynamicLog.hs 131 +shorten :: Int -> String -> String +shorten n xs | length xs < n = xs + | otherwise = (take (n - length end) xs) ++ end + where + end = "..." + hunk ./DynamicLog.hs 162 - , ppTitle = const "" + , ppTitle = shorten 50 hunk ./DynamicLog.hs 170 - , ppTitle = xmobarColor "#00ee00" "" + , ppTitle = xmobarColor "#00ee00" "" . shorten 50 hunk ./DynamicLog.hs 162 - , ppTitle = shorten 50 + , ppTitle = shorten 80 hunk ./DynamicLog.hs 170 - , ppTitle = xmobarColor "#00ee00" "" . shorten 50 + , ppTitle = xmobarColor "#00ee00" "" . shorten 80 hunk ./TilePrime.hs 53 - description _ = "TilePrime" + description c | flipped c = "TilePrime Horizontal" + | otherwise = "TilePrime Vertical" addfile ./UrgencyHook.hs hunk ./UrgencyHook.hs 1 +module XMonadContrib.UrgencyHook where + +import {-# SOURCE #-} Config (urgencyHook) +import XMonad +import XMonadContrib.LayoutModifier + +import Control.Monad (when) +import Data.Bits (testBit, clearBit) +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +-- Oooh, spooky. +data WithUrgencyHook a = WithUrgencyHook deriving (Read, Show) + +instance LayoutModifier WithUrgencyHook Window where + handleMess _ mess = + let event = fromMessage mess :: Maybe Event in do + case event of + Just (PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w }) -> + when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do + wmh@WMHints { wmh_flags = flags } <- io $ getWMHints dpy w + when (testBit flags urgencyHintBit) $ do + urgencyHook w + -- Is clearing the bit really necessary? Xlib manual advises it. + _ <- io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit } + return () + _ -> return () + return Nothing + +withUrgencyHook :: LayoutClass l Window => l Window -> ModifiedLayout WithUrgencyHook l Window +withUrgencyHook = ModifiedLayout WithUrgencyHook hunk ./UrgencyHook.hs 25 - _ <- io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit } + io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit } hunk ./UrgencyHook.hs 1 -module XMonadContrib.UrgencyHook where +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.UrgencyHook +-- Copyright : Devin Mullins +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Devin Mullins +-- Stability : unstable +-- Portability : unportable +-- +-- UrgencyHook lets you configure an action to occur when a window demands +-- your attention. (In traditional WMs, this takes the form of "flashing" +-- on your "taskbar." Blech.) +-- +----------------------------------------------------------------------------- + +module XMonadContrib.UrgencyHook ( + -- * Usage + -- $usage + withUrgencyHook + ) where hunk ./UrgencyHook.hs 32 --- Oooh, spooky. +-- $usage +-- To wire this up, add: +-- +-- > import XMonadContrib.UrgencyHook +-- +-- to your import list in Config. Change your defaultLayout such that +-- withUrgencyHook is applied along the chain. Mine, for example: +-- +-- > defaultLayout = Layout $ withUrgencyHook $ windowNavigation wnConfig $ +-- > LayoutSelection defaultLayouts +-- +-- It shouldn't hurt to have the "withUrgencyHook $" at the outermost layer, +-- as above, as UrgencyHook is a LayoutModifier, and hence passes on any +-- messages sent to it. Next, add your actual urgencyHook to Config. This +-- needs to take a Window and return an X () action. Here's an example: +-- +-- > urgencyHook :: Window -> X () +-- > urgencyHook w = do +-- > name <- getName w +-- > ws <- gets windowset +-- > whenJust (W.findIndex w ws) (flash name ws) +-- > where flash name ws index = +-- > when (index /= W.tag (W.workspace (W.current ws))) $ +-- > dzen (show name ++ " requests your attention on workspace " ++ show index) +-- +-- This example stands on the shoulders of the NamedWindows and Dzen modules, +-- but you can build whatever urgencyHook you like. Finally, in order to make +-- this compile, open up your Config.hs-boot file and add the following to it: +-- +-- > urgencyHook :: Window -> X () +-- +-- Compile! + hunk ./UrgencyHook.hs 48 +-- > import Dzen (dzen) +-- > import NamedWindows (getName) +-- ... hunk ./UrgencyHook.hs 40 --- > defaultLayout = Layout $ withUrgencyHook $ windowNavigation wnConfig $ --- > LayoutSelection defaultLayouts +-- > layoutHook = Layout $ withUrgencyHook $ windowNavigation wnConfig $ +-- > Select defaultLayouts hunk ./Dzen.hs 11 --- Handy wrapper for dzen. +-- Handy wrapper for dzen. Requires dzen >= 0.2.4. hunk ./Dzen.hs 15 -module XMonadContrib.Dzen (dzen, dzenScreen) where +module XMonadContrib.Dzen (dzen, dzenScreen, seconds) where hunk ./Dzen.hs 17 -import Control.Monad.State -import qualified StackSet as W hunk ./Dzen.hs 18 -import XMonadContrib.Run - -curScreen :: X ScreenId -curScreen = (W.screen . W.current) `liftM` gets windowset +import XMonadContrib.Run (runProcessWithInputAndWait, seconds) hunk ./Dzen.hs 23 --- Requires dzen >= 0.2.4. +-- | @dzen str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds. +-- Example usage: +-- > dzen "Hi, mom!" (5 `seconds`) +dzen :: String -> Int -> X () +dzen str timeout = dzenWithArgs str [] timeout hunk ./Dzen.hs 29 -dzen :: String -> X () -dzen str = curScreen >>= \sc -> dzenScreen sc str +-- | @dzenScreen sc str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds, and on screen @sc@. +-- Requires dzen to be compiled with Xinerama support. +dzenScreen :: ScreenId -> String -> Int -> X() +dzenScreen sc str timeout = dzenWithArgs str ["-xs", screen] timeout + where screen = toXineramaArg sc hunk ./Dzen.hs 35 -dzenScreen :: ScreenId -> String -> X() -dzenScreen sc str = io $ (runProcessWithInputAndWait "dzen2" ["-xs", screen] str 5000000) - where screen = toXineramaArg sc +dzenWithArgs :: String -> [String] -> Int -> X () +dzenWithArgs str args timeout = io $ runProcessWithInputAndWait "dzen2" args (unchomp str) timeout + -- dzen seems to require the input to terminate with exactly one newline. + where unchomp s@['\n'] = s + unchomp [] = ['\n'] + unchomp (c:cs) = c : unchomp cs hunk ./Run.hs 23 - runProcessWithInputAndWait + runProcessWithInputAndWait, + seconds hunk ./Run.hs 86 +-- | Multiplies by ONE MILLION, for use with runProcessWithInputAndWait. +-- Use like: +-- > (5.5 `seconds`) +seconds :: Rational -> Int +seconds = fromEnum . (* 1000000) hunk ./Dzen.hs 15 -module XMonadContrib.Dzen (dzen, dzenScreen, seconds) where +module XMonadContrib.Dzen (dzen, dzenScreen, dzenUrgencyHook, seconds) where hunk ./Dzen.hs 17 +import Control.Monad (when) +import Control.Monad.State (gets) +import qualified Data.Set as S +import Graphics.X11.Types (Window) + +import qualified StackSet as W hunk ./Dzen.hs 24 + +import XMonadContrib.NamedWindows (getName) hunk ./Dzen.hs 43 +-- | Flashes when a window requests your attention and you can't see it. For use with +-- XMonadContrib.UrgencyHook. Usage: +-- > urgencyHook = dzenUrgencyHook (5 `seconds`) +-- Bug: Doesn't flash if you're on the same workspace, Full or Tabbed layout, different window. +dzenUrgencyHook :: Int -> Window -> X () +dzenUrgencyHook duration w = do + visibles <- gets mapped + name <- getName w + ws <- gets windowset + whenJust (W.findIndex w ws) (flash name ws visibles) + where flash name ws visibles index = + when (index /= W.tag (W.workspace (W.current ws)) && not (S.member w visibles)) $ + dzen (show name ++ " requests your attention on workspace " ++ index) duration + hunk ./UrgencyHook.hs 48 --- > import Dzen (dzen) --- > import NamedWindows (getName) +-- > import XMonadContrib.Dzen hunk ./UrgencyHook.hs 51 --- > urgencyHook w = do --- > name <- getName w --- > ws <- gets windowset --- > whenJust (W.findIndex w ws) (flash name ws) --- > where flash name ws index = --- > when (index /= W.tag (W.workspace (W.current ws))) $ --- > dzen (show name ++ " requests your attention on workspace " ++ show index) +-- > urgencyHook = dzenUrgencyHook (5 `seconds`) hunk ./UrgencyHook.hs 53 --- This example stands on the shoulders of the NamedWindows and Dzen modules, --- but you can build whatever urgencyHook you like. Finally, in order to make --- this compile, open up your Config.hs-boot file and add the following to it: +-- If you're comfortable with programming in the X monad, then you can build +-- whatever urgencyHook you like. Finally, in order to make this compile, +-- open up your Config.hs-boot file and add the following to it: hunk ./WindowNavigation.hs 6 --- Module : XMonadContrib.WorkspaceDir +-- Module : XMonadContrib.WindowNavigation hunk ./DynamicWorkspaces.hs 20 - selectWorkspace, + selectWorkspace, renameWorkspace, hunk ./DynamicWorkspaces.hs 41 +-- > , ((modMask .|. shiftMask .|. controlMask, xK_r), renameWorkspace defaultXPConfig) hunk ./DynamicWorkspaces.hs 53 +renameWorkspace :: XPConfig -> X () +renameWorkspace conf = workspacePrompt conf $ \w -> + windows $ \s -> let sett wk = wk { tag = w } + setscr scr = scr { workspace = sett $ workspace scr } + sets q = q { current = setscr $ current q } + in sets $ removeWorkspace' w s + hunk ./DynamicLog.hs 32 - wrap, xmobarColor, shorten + wrap, dzenColor, xmobarColor, shorten hunk ./DynamicLog.hs 140 --- TODO dzenColor +dzenColor :: String -> String -> String -> String +dzenColor fg bg = wrap (fg1++bg1) (fg2++bg2) + where (fg1,fg2) | null fg = ("","") + | otherwise = ("^fg(" ++ fg ++ ")","^fg()") + (bg1,bg2) | null bg = ("","") + | otherwise = ("^bg(" ++ bg ++ ")","^bg()") + hunk ./DynamicLog.hs 128 -wrap l r "" = "" +wrap _ _ "" = "" hunk ./LayoutModifier.hs 61 - description (ModifiedLayout m l) = modifierDescription m ++ " " ++ description l + description (ModifiedLayout m l) = modDesc ++ sep ++ description l + where modDesc = modifierDescription m + sep = if modDesc == "" then "" else " " hunk ./LayoutModifier.hs 61 - description (ModifiedLayout m l) = modDesc ++ sep ++ description l - where modDesc = modifierDescription m - sep = if modDesc == "" then "" else " " + description (ModifiedLayout m l) = modifierDescription m <> description l + where "" <> x = x + x <> y = x ++ " " ++ y hunk ./LayoutModifier.hs 45 - modifierDescription = show + modifierDescription = const "" hunk ./MetaModule.hs 78 +import XMonadContrib.ToggleLayouts () addfile ./ToggleLayouts.hs hunk ./ToggleLayouts.hs 1 +{-# -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.ToggleLayouts +-- Copyright : (c) David Roundy +-- License : BSD +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : portable +-- +-- A module for writing easy Layouts +----------------------------------------------------------------------------- + +module XMonadContrib.ToggleLayouts ( + -- * Usage + -- $usage + toggleLayouts, ToggleLayout(..) + ) where + +import XMonad +import Operations ( LayoutMessages(Hide, ReleaseResources) ) + +-- $usage +-- Use toggleLayouts to toggle between two layouts. +-- import XMonadContrib.ToggleLayouts, and add to your layoutHook something like +-- > layoutHook = Layout $ toggleLayouts (noBorders Full) $ Select layouts +-- and a key binding like +-- > , ((modMask .|. controlMask, xK_space), sendMessage ToggleLayout) + +data ToggleLayouts lt lf a = ToggleLayouts Bool (lt a) (lf a) deriving (Read,Show) +data ToggleLayout = ToggleLayout deriving (Read,Show,Typeable) +instance Message ToggleLayout + +toggleLayouts :: (LayoutClass lt a, LayoutClass lf a) => lt a -> lf a -> ToggleLayouts lt lf a +toggleLayouts = ToggleLayouts False + +instance (LayoutClass lt a, LayoutClass lf a) => LayoutClass (ToggleLayouts lt lf) a where + doLayout (ToggleLayouts True lt lf) r s = do (ws,mlt') <- doLayout lt r s + return (ws,fmap (\lt' -> ToggleLayouts True lt' lf) mlt') + doLayout (ToggleLayouts False lt lf) r s = do (ws,mlf') <- doLayout lf r s + return (ws,fmap (\lf' -> ToggleLayouts False lt lf') mlf') + description (ToggleLayouts True lt _) = description lt + description (ToggleLayouts False _ lf) = description lf + handleMessage (ToggleLayouts bool lt lf) m + | Just ReleaseResources <- fromMessage m = + do mlf' <- handleMessage lf m + mlt' <- handleMessage lt m + return $ case (mlt',mlf') of + (Nothing ,Nothing ) -> Nothing + (Just lt',Nothing ) -> Just $ ToggleLayouts bool lt' lf + (Nothing ,Just lf') -> Just $ ToggleLayouts bool lt lf' + (Just lt',Just lf') -> Just $ ToggleLayouts bool lt' lf' + handleMessage (ToggleLayouts True lt lf) m + | Just ToggleLayout <- fromMessage m = do mlt' <- handleMessage lt (SomeMessage Hide) + let lt' = maybe lt id mlt' + return $ Just $ ToggleLayouts False lt' lf + | otherwise = do mlt' <- handleMessage lt m + return $ fmap (\lt' -> ToggleLayouts True lt' lf) mlt' + handleMessage (ToggleLayouts False lt lf) m + | Just ToggleLayout <- fromMessage m = do mlf' <- handleMessage lf (SomeMessage Hide) + let lf' = maybe lf id mlf' + return $ Just $ ToggleLayouts True lt lf' + | otherwise = do mlf' <- handleMessage lf m + return $ fmap (\lf' -> ToggleLayouts False lt lf') mlf' hunk ./UrgencyHook.hs 40 --- > layoutHook = Layout $ withUrgencyHook $ windowNavigation wnConfig $ --- > Select defaultLayouts +-- > layoutHook = Layout $ withUrgencyHook $ windowNavigation $ +-- > Select layouts hunk ./LayoutModifier.hs 37 + handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage)) + handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess + return (Left `fmap` mm') hunk ./LayoutModifier.hs 59 - do ml' <- handleMessage l mess - mm' <- handleMess m mess + do mm' <- handleMessOrMaybeModifyIt m mess + ml' <- case mm' of + Just (Right mess') -> handleMessage l mess' + _ -> handleMessage l mess hunk ./LayoutModifier.hs 64 - Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml' - Nothing -> (ModifiedLayout m) `fmap` ml' + Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml' + _ -> (ModifiedLayout m) `fmap` ml' hunk ./Combo.hs 20 - combo + combo, combineTwo hunk ./Combo.hs 24 -import Data.List ( delete ) +import Data.List ( delete, intersect, (\\) ) hunk ./Combo.hs 27 -import Operations ( LayoutMessages(ReleaseResources) ) +import Operations ( LayoutMessages(ReleaseResources,Hide) ) hunk ./Combo.hs 30 +import XMonadContrib.WindowNavigation ( MoveWindowToWindow(..) ) hunk ./Combo.hs 41 --- > combo (TwoPane 0.03 0.5) [(Full,1),(tabbed shrinkText defaultTConf,1)] +-- > combo (TwoPane 0.03 0.5) [(Layout Full,1),(Layout $ tabbed shrinkText defaultTConf,1)] +-- +-- or alternatively +-- +-- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) hunk ./Combo.hs 56 +-- combineTwo is a new simpler (and yet in some ways more powerful) layout +-- combinator. It only allows the combination of two layouts, but has the +-- advantage of allowing you to dynamically adjust the layout, in terms of +-- the number of windows in each sublayout. To do this, use +-- WindowNavigation, and add the following key bindings (or something similar): + +-- , ((modMask .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) +-- , ((modMask .|. controlMask .|. shiftMask, xK_Left), sendMessage $ Move L) +-- , ((modMask .|. controlMask .|. shiftMask, xK_Up), sendMessage $ Move U) +-- , ((modMask .|. controlMask .|. shiftMask, xK_Down), sendMessage $ Move D) + +-- These bindings will move a window into the sublayout that is +-- up/down/left/right of its current position. Note that there is some +-- weirdness in combineTwo, in that the mod-tab focus order is not very +-- closely related to the layout order. This is because we're forced to +-- keep track of the window positions sparately, and this is ugly. If you +-- don't like this, lobby for hierarchical stacks in core xmonad or go +-- reimelement the core of xmonad yourself. + hunk ./Combo.hs 78 +data CombineTwo l l1 l2 a = C2 [a] [a] (l ()) (l1 a) (l2 a) + deriving (Read, Show) + +combineTwo :: (Read a, Eq a, LayoutClass super (), LayoutClass l1 a, LayoutClass l2 a) => + super () -> l1 a -> l2 a -> CombineTwo super l1 l2 a +combineTwo = C2 [] [] + +instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) + => LayoutClass (CombineTwo l l1 l2) a where + doLayout (C2 f w2 super l1 l2) rinput s = arrange (integrate s) + where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage Hide) + l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage Hide) + return ([], Just $ C2 [] [] super l1' l2') + arrange [w] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage Hide) + l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage Hide) + return ([(w,rinput)], Just $ C2 [w] [w] super l1' l2') + arrange origws = + do let w2' = case origws `intersect` w2 of [] -> [head origws] + [x] -> [x] + x -> case origws \\ x of + [] -> init x + _ -> x + superstack = if focus s `elem` w2' + then Stack { focus=(), up=[], down=[()] } + else Stack { focus=(), up=[], down=[()] } + s1 = differentiate f' (origws \\ w2') + s2 = differentiate f' w2' + f' = focus s:delete (focus s) f + ([((),r1),((),r2)], msuper') <- doLayout super rinput superstack + (wrs1, ml1') <- runLayout l1 r1 s1 + (wrs2, ml2') <- runLayout l2 r2 s2 + return (wrs1++wrs2, Just $ C2 f' w2' + (maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2')) + handleMessage (C2 f ws2 super l1 l2) m + | Just (MoveWindowToWindow w1 w2) <- fromMessage m, + w1 `notElem` ws2, + w2 `elem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m + l2' <- maybe l2 id `fmap` handleMessage l2 m + return $ Just $ C2 f (w1:ws2) super l1' l2' + | Just (MoveWindowToWindow w1 w2) <- fromMessage m, + w1 `elem` ws2, + w2 `notElem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m + l2' <- maybe l2 id `fmap` handleMessage l2 m + let ws2' = case delete w1 ws2 of [] -> [w2] + x -> x + return $ Just $ C2 f ws2' super l1' l2' + | otherwise = do ml1' <- broadcastPrivate m [l1] + ml2' <- broadcastPrivate m [l2] + msuper' <- broadcastPrivate m [super] + if isJust msuper' || isJust ml1' || isJust ml2' + then return $ Just $ C2 f ws2 + (maybe super head msuper') + (maybe l1 head ml1') + (maybe l2 head ml2') + else return Nothing + description (C2 _ _ super l1 l2) = "combining "++ description l1 ++" and "++ + description l2 ++" with "++ description super + hunk ./Combo.hs 161 - differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q) - differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z - , up = reverse $ takeWhile (/=z) xs - , down = tail $ dropWhile (/=z) xs } - | otherwise = differentiate zs xs - differentiate [] xs = W.differentiate xs hunk ./Combo.hs 172 +differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q) +differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z + , up = reverse $ takeWhile (/=z) xs + , down = tail $ dropWhile (/=z) xs } + | otherwise = differentiate zs xs +differentiate [] xs = W.differentiate xs + hunk ./WindowNavigation.hs 23 + MoveWindowToWindow(..), hunk ./WindowNavigation.hs 30 +import Control.Monad.State ( gets ) hunk ./WindowNavigation.hs 72 +data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( Read, Show, Typeable ) +instance Typeable a => Message (MoveWindowToWindow a) hunk ./WindowNavigation.hs 75 -data Navigate = Go Direction | Swap Direction deriving ( Read, Show, Typeable ) +data Navigate = Go Direction | Swap Direction | Move Direction deriving ( Read, Show, Typeable ) hunk ./WindowNavigation.hs 143 - handleMess (WindowNavigation conf (I (Just (NS pt wrs)))) m + handleMessOrMaybeModifyIt (WindowNavigation conf (I (Just (NS pt wrs)))) m hunk ./WindowNavigation.hs 148 - return $ Just $ WindowNavigation conf $ I $ Just $ + return $ Just $ Left $ WindowNavigation conf $ I $ Just $ hunk ./WindowNavigation.hs 166 + | Just (Move d) <- fromMessage m = + case sortby d $ filter (inr d pt . snd) wrs of + [] -> return Nothing + ((w,_):_) -> do mst <- gets (W.stack . W.workspace . W.current . windowset) + return $ do st <- mst + Just $ Right $ SomeMessage $ MoveWindowToWindow (W.focus st) w hunk ./WindowNavigation.hs 175 - return $ Just $ WindowNavigation conf $ I $ Just $ NS pt [] + return $ Just $ Left $ WindowNavigation conf $ I $ Just $ NS pt [] hunk ./WindowNavigation.hs 177 - handleMess (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide) - handleMess _ _ = return Nothing + handleMessOrMaybeModifyIt (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide) + handleMessOrMaybeModifyIt _ _ = return Nothing hunk ./tests/test_XPrompt.hs 29 --- check for exceptions -prop_rmPath (str :: [[Char]]) = - S.rmPath str == S.rmPath str - hunk ./tests/test_XPrompt.hs 67 - putStrLn "Testing ShellPrompt.rmPath" - doubleCheck prop_rmPath hunk ./LayoutModifier.hs 1 -{-# -fglasgow-exts #-} -- For deriving Data/Typeable +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable hunk ./ToggleLayouts.hs 1 -{-# -fglasgow-exts #-} -- For deriving Data/Typeable +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable hunk ./UrgencyHook.hs 1 +{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances #-} + hunk ./XPrompt.hs 8 --- +-- hunk ./XPrompt.hs 74 - XPS { dpy :: Display - , rootw :: Window + XPS { dpy :: Display + , rootw :: Window hunk ./XPrompt.hs 82 - , fontS :: FontStruct + , fontS :: FontStruct hunk ./XPrompt.hs 84 - , command :: String + , command :: String hunk ./XPrompt.hs 90 -data XPConfig = +data XPConfig = hunk ./XPrompt.hs 94 - , fgHLight :: String -- ^ Font color of a highlighted completion entry - , bgHLight :: String -- ^ Backgroud color of a highlighted completion entry - , borderColor :: String -- ^ Border color + , fgHLight :: String -- ^ Font color of a highlighted completion entry + , bgHLight :: String -- ^ Backgroud color of a highlighted completion entry + , borderColor :: String -- ^ Border color hunk ./XPrompt.hs 103 -data XPType = forall p . XPrompt p => XPT p +data XPType = forall p . XPrompt p => XPT p hunk ./XPrompt.hs 124 -data XPPosition = Top +data XPPosition = Top hunk ./XPrompt.hs 151 --- * a prompt type, instance of the 'XPrompt' class. +-- * a prompt type, instance of the 'XPrompt' class. hunk ./XPrompt.hs 179 - when (command st' /= "") $ do + when (command st' /= "") $ do hunk ./XPrompt.hs 202 - (keysym,string,event) <- io $ - allocaXEvent $ \e -> do + (keysym,string,event) <- io $ + allocaXEvent $ \e -> do hunk ./XPrompt.hs 218 -handle ks (KeyEvent {ev_event_type = t, ev_state = m}) +handle ks (KeyEvent {ev_event_type = t, ev_state = m}) hunk ./XPrompt.hs 329 - modify (\s -> s { command = "", offset = 0} ) - + modify (\s -> s { command = "", offset = 0} ) + hunk ./XPrompt.hs 396 - w <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rw + w <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rw hunk ./XPrompt.hs 427 - else let (a,b) = (splitAt off com) + else let (a,b) = (splitAt off com) hunk ./XPrompt.hs 489 - needed_rows = max 1 (rows + if r == 0 then 0 else 1) + needed_rows = max 1 (rows + if r == 0 then 0 else 1) hunk ./XPrompt.hs 567 - io $ printString d drw gc fhc bhc x y s + io $ printString d drw gc fhc bhc x y s hunk ./XPrompt.hs 572 -data History = - H { prompt :: String +data History = + H { prompt :: String hunk ./XPrompt.hs 575 - } deriving (Show, Read, Eq) + } deriving (Show, Read, Eq) hunk ./XPrompt.hs 618 --- | Fills a 'Drawable' with a rectangle and a border +-- | Fills a 'Drawable' with a rectangle and a border hunk ./XPrompt.hs 631 -mkUnmanagedWindow :: Display -> Screen -> Window -> Position +mkUnmanagedWindow :: Display -> Screen -> Window -> Position hunk ./XPrompt.hs 636 - allocaSetWindowAttributes $ + allocaSetWindowAttributes $ hunk ./XPrompt.hs 639 - createWindow d rw x y w h 0 (defaultDepthOfScreen s) + createWindow d rw x y w h 0 (defaultDepthOfScreen s) hunk ./XPrompt.hs 678 -breakAtSpace s +breakAtSpace s hunk ./XPrompt.hs 268 + -- control sequences hunk ./XPrompt.hs 270 --- ctrl U hunk ./XPrompt.hs 271 --- ctrl K hunk ./XPrompt.hs 272 --- ctrl A hunk ./XPrompt.hs 273 --- ctrl E hunk ./XPrompt.hs 274 --- Unhandled control sequence - | otherwise -> eventLoop handle --- Return: exit + | ks == xK_g || ks == xK_c -> quit + | otherwise -> eventLoop handle -- unhandled control sequence hunk ./XPrompt.hs 277 --- backspace hunk ./XPrompt.hs 278 --- delete hunk ./XPrompt.hs 279 --- left hunk ./XPrompt.hs 280 --- right hunk ./XPrompt.hs 281 --- up hunk ./XPrompt.hs 282 --- down hunk ./XPrompt.hs 283 --- escape: exit and discard everything - | ks == xK_Escape = flushString >> return () - where go = updateWindows >> eventLoop handle + | ks == xK_Escape = quit + where + go = updateWindows >> eventLoop handle + quit = flushString >> return () -- quit and discard everything hunk ./XSelection.hs 68 - win <- createSimpleWindow dpy rootw 0 0 200 100 0 0 0 + win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0 hunk ./XSelection.hs 91 - win <- createSimpleWindow dpy rootw 0 0 200 100 0 0 0 + win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0 hunk ./XSelection.hs 152 + aux :: forall t. (Num t) => t -> [Word8] -> Int -> [Char] hunk ./XSelection.hs 61 --- | Returns a String corresponding to the current mouse selection in X; if there is none, an empty string is returned.. Note that this is --- only reliable for ASCII text and currently mangles\/escapes more complex UTF-8 characters. +-- | 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. hunk ./XSelection.hs 124 --- | A wrapper around getSelection. Makes it convenient to run a program with the current selection as an argument. This is convenient --- for handling URLs, in particular. For example, in your Config.hs you could bind a key to @promptSelection \"firefox\"@; this would allow you to --- highlight a URL string and then immediately open it up in Firefox. +{- | A wrapper around getSelection. Makes it convenient to run a program with the current selection as an argument. +This is convenient for handling URLs, in particular. For example, in your Config.hs you could bind a key to + @promptSelection \"firefox\"@; +this would allow you to highlight a URL string and then immediately open it up in Firefox. -} hunk ./XSelection.hs 159 - hunk ./XSelection.hs 162 - hunk ./Run.hs 21 - runInXTerm, hunk ./Run.hs 80 -runInXTerm :: String -> X () -runInXTerm com = do - c <- io $ catch (getEnv "XTERMCMD") (const $ return "xterm") - spawn ("exec " ++ c ++ " -e " ++ com) - --- | Multiplies by ONE MILLION, for use with runProcessWithInputAndWait. --- Use like: --- > (5.5 `seconds`) +{- | Multiplies by ONE MILLION, for use with runProcessWithInputAndWait. + Use like: + > (5.5 `seconds`) +-} hunk ./ShellPrompt.hs 21 + , prompt + , safePrompt + , runInXTerm hunk ./ShellPrompt.hs 63 +{- | See safe and unsafeSpawn. prompt is an alias for safePrompt; safePrompt and unsafePrompt work on the same principles, + but will use XPrompt to interactively query the user for input; the appearance is set by passing an XPConfig as the + second argument. The first argument is the program to be run with the interactive input. + You would use these like this: + > , ((modMask, xK_b ), safePrompt "firefox" greenXPConfig) + > , ((modMask .|. shiftMask, xK_c ), prompt ("xterm" ++ " -e") greenXPConfig) + Note that you want to use safePrompt for Firefox input, as Firefox wants URLs, and unsafePrompt for the XTerm example + because this allows you to easily start a terminal executing an arbitrary command, like 'top'. -} +prompt, unsafePrompt, safePrompt :: FilePath -> XPConfig -> X () +prompt = unsafePrompt +safePrompt c config = mkXPrompt Shell config (getShellCompl [c]) run + where run = safeSpawn c +unsafePrompt c config = mkXPrompt Shell config (getShellCompl [c]) run + where run a = unsafeSpawn $ c ++ " " ++ a + +-- This may be better done as a specialization of 'prompt' +runInXTerm :: String -> X () +runInXTerm com = do + c <- io $ catch (getEnv "XTERMCMD") (const $ return "xterm") + spawn ("exec " ++ c ++ " -e " ++ com) + hunk ./Run.hs 6 --- +-- hunk ./Run.hs 26 -import XMonad +import Control.Monad.State (Monad((>>), return), when) +import System.Posix.Process (createSession, forkProcess, executeFile, + getProcessStatus) hunk ./Run.hs 30 -import Control.Monad.State -import System.Environment -import System.Exit -import System.IO -import System.Posix.Process (forkProcess, getProcessStatus, createSession) -import System.Process - +import Control.Exception (try) +import System.Exit (ExitCode(ExitSuccess), exitWith) +import System.IO (IO, FilePath, hPutStr, hGetContents, hFlush, hClose) +import System.Process (runInteractiveProcess, waitForProcess) +import XMonad (X, io, spawn) hunk ./Run.hs 69 - -- output <- hGetContents pout - -- when (output==output) $ return () hunk ./Run.hs 23 + safeSpawn, + unsafeSpawn, hunk ./Run.hs 87 +{- | safeSpawn bypasses XMonad's 'spawn' command, because spawn passes strings to /bin/sh to be interpreted as shell + commands. This is often what one wants, but in many cases the passed string will contain shell metacharacters + which one does not want interpreted as such (URLs particularly often have shell metacharacters like '&' in them). + In this case, it is more useful to specify a file or program to be run and a string to give it as an argument so + as to bypass the shell and be certain the program will receive the string as you typed it. + 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 :: FilePath -> String -> X () +safeSpawn prog arg = io (try (forkProcess $ executeFile prog True [arg] Nothing) >> return ()) +unsafeSpawn :: String -> X () +unsafeSpawn = spawn + hunk ./XSelection.hs 21 - getSelection, promptSelection, putSelection) where + getSelection, + promptSelection, + safePromptSelection, + putSelection) where hunk ./XSelection.hs 130 -this would allow you to highlight a URL string and then immediately open it up in Firefox. -} -promptSelection :: String -> X () -promptSelection app = spawn . ((app ++ " ") ++) =<< io getSelection +this would allow you to highlight a URL string and then immediately open it up in Firefox. + +promptSelection passes strings through the shell; if you do not wish your selected text to be interpreted/mangled +by the shell, use safePromptSelection which will bypass the shell using safeSpawn from Run.hs; see Run.hs for more +details on the advantages/disadvantages of this. -} +promptSelection, safePromptSelection, unsafePromptSelection :: String -> X () +promptSelection = unsafePromptSelection +safePromptSelection app = join $ io $ liftM (safeSpawn app) (getSelection) +unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection hunk ./XSelection.hs 26 --- getSelection, putSelection's imports: -import Graphics.X11.Xlib (allocaXEvent, createSimpleWindow, defaultScreen, destroyWindow, internAtom, nextEvent, openDisplay, rootWindow, selectionNotify, Display(), Atom(), XEventPtr(), selectionRequest, sendEvent, noEventMask, sync) -import Graphics.X11.Xlib.Extras (currentTime, ev_event_type, getEvent, getWindowProperty8, xConvertSelection, xSetSelectionOwner, xGetSelectionOwner, changeProperty8, propModeReplace, setSelectionNotify, ev_requestor, ev_selection, ev_target, ev_property, ev_time, ev_event_display) -import Data.Maybe (fromMaybe) +import Graphics.X11.Xlib.Extras (Graphics.X11.Xlib.Extras.Event(ev_event_display, + ev_time, ev_property, ev_target, ev_selection, + ev_requestor, ev_event_type), + xConvertSelection, xGetSelectionOwner, xSetSelectionOwner, getEvent, + currentTime, setSelectionNotify, getWindowProperty8, changeProperty8, + propModeReplace) +import Graphics.X11.Xlib (destroyWindow, createSimpleWindow, Display, XEventPtr, + sendEvent, nextEvent, sync, allocaXEvent, openDisplay, rootWindow, + defaultScreen, internAtom, Atom, selectionNotify, selectionRequest, noEventMask) hunk ./XSelection.hs 36 -import Data.Char (chr, ord) hunk ./XSelection.hs 37 - --- promptSelection's imports: -import XMonad (io, spawn, X ()) - --- decode's imports -import Foreign (Word8(), (.&.), shiftL, (.|.)) +import Control.Monad(Monad (return, (>>)), Functor(..), liftM, join) +import Data.Char (chr, ord) +import Data.Maybe (fromMaybe) +import Foreign(Word8, Data.Bits.Bits (shiftL, (.&.), (.|.))) +import XMonadContrib.Run (safeSpawn, unsafeSpawn) +import XMonad (X, io) hunk ./XSelection.hs 166 - aux :: forall t. (Num t) => t -> [Word8] -> Int -> [Char] + aux :: Int -> [Word8] -> Int -> [Char] hunk ./SshPrompt.hs 6 --- +-- hunk ./SshPrompt.hs 21 -import XMonad -import XMonadContrib.XPrompt -import XMonadContrib.Run - -import Control.Monad -import System.Directory -import System.Environment -import Data.List -import Data.Maybe - +import System.Environment (getEnv) +import XMonadContrib.ShellPrompt (runInXTerm) +import Control.Monad(Monad (return), Functor(..), liftM2, mapM) +import Data.List ((++), concat, filter, map, words, lines, takeWhile, take, nub, + sort) +import Data.Maybe (Maybe(..), catMaybes) +import System.Directory (doesFileExist) +import XMonad (X, io) +import XMonadContrib.XPrompt (XPrompt(..), XPConfig, mkXPrompt, + mkComplFunFromList) hunk ./SshPrompt.hs 60 -sshComplList = (nub . sort) `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal +sshComplList = (nub . sort) `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal hunk ./SshPrompt.hs 66 - + hunk ./ShellPrompt.hs 26 -import XMonad -import XMonadContrib.XPrompt -import XMonadContrib.Run - -import Control.Monad -import Data.List +import System.Environment (getEnv) +import Control.Monad (Monad((>>=), return), Functor(..), filterM, forM) +import Data.List ((++), concat, filter, map, lines, elem, span, tail, last, + isPrefixOf) hunk ./ShellPrompt.hs 31 -import System.Directory -import System.IO -import System.Environment +import System.Directory (Permissions(executable), getPermissions, + getDirectoryContents, doesDirectoryExist, doesFileExist) +import System.IO (IO, FilePath) +import XMonadContrib.Run (runProcessWithInput, safeSpawn, unsafeSpawn) +import XMonad (X, io, spawn) +import XMonadContrib.XPrompt (XPrompt(..), XPConfig, mkXPrompt) hunk ./SshPrompt.hs 24 -import Data.List ((++), concat, filter, map, words, lines, takeWhile, take, nub, +import Data.List ((++), concat, filter, map, words, lines, takeWhile, take, hunk ./SshPrompt.hs 27 +import Data.Set (toList, fromList) hunk ./SshPrompt.hs 61 -sshComplList = (nub . sort) `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal +sshComplList = (sort . toList . fromList) `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal hunk ./DragPane.hs 67 -instance LayoutClass DragPane Window where +instance LayoutClass DragPane a where hunk ./DragPane.hs 75 -handleMess :: DragPane Window -> SomeMessage -> X (Maybe (DragPane Window)) +handleMess :: DragPane a -> SomeMessage -> X (Maybe (DragPane a)) hunk ./DragPane.hs 90 -handleEvent :: DragPane Window -> Event -> X () +handleEvent :: DragPane a -> Event -> X () hunk ./DragPane.hs 102 -doLay :: (Rectangle -> Rectangle) -> DragPane Window -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a)) +doLay :: (Rectangle -> Rectangle) -> DragPane a -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a)) hunk ./DragPane.hs 28 - , DragType (..) + , DragPane, DragType (..) hunk ./Combo.hs 20 - combo, combineTwo + combo, combineTwo, + CombineTwo addfile ./LayoutCombinators.hs hunk ./LayoutCombinators.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.LayoutCombinators +-- Copyright : (c) David Roundy +-- License : BSD +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : portable +-- +-- A module for combining Layouts +----------------------------------------------------------------------------- + +module XMonadContrib.LayoutCombinators ( + -- * Usage + -- $usage + (<|>), (), (<||>), () + ) where + +import XMonad +import Operations ( Tall(..), Mirror(..) ) +import XMonadContrib.Combo +import XMonadContrib.DragPane + +-- $usage +-- Use LayoutCombinators to easily combine Layouts. + +(<||>), () :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => + l1 a -> l2 a -> CombineTwo DragPane l1 l2 a +(<|>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) + => l1 a -> l2 a -> CombineTwo Tall l1 l2 a +() :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) + => l1 a -> l2 a -> CombineTwo (Mirror Tall) l1 l2 a + +(<||>) = combineTwo (dragPane Vertical 0.1 0.5) +() = combineTwo (dragPane Horizontal 0.1 0.5) +(<|>) = combineTwo (Tall 1 0.1 0.5) +() = combineTwo (Mirror $ Tall 1 0.1 0.5) hunk ./MetaModule.hs 47 +import XMonadContrib.LayoutCombinators () hunk ./ManageDocks.hs 15 --- Cheveats: --- --- * Only acts on STRUT apps on creation, not if you move or close them --- --- * To reset the gap, press Mod-b twice and restart xmonad (Mod-q) +-- It also allows you to reset the gap to reflect the state of current STRUT +-- windows (for example, after you resized or closed a panel), and to toggle the Gap +-- in a STRUT-aware fashion. hunk ./ManageDocks.hs 23 + ,resetGap + ,toggleGap hunk ./ManageDocks.hs 33 -import Data.Word +import Data.Word (Word32) +import Data.Maybe (catMaybes) hunk ./ManageDocks.hs 44 +-- +-- Then you can bind resetGap or toggleGap as you wish: +-- +-- > , ((modMask, xK_b), toggleGap) hunk ./ManageDocks.hs 52 +-- %keybind , ((modMask, xK_b), toggleGap) hunk ./ManageDocks.hs 67 - else do - return id + else do + return id hunk ./ManageDocks.hs 105 + +-- | +-- Goes through the list of windows and find the gap so that all STRUT +-- settings are satisfied. +calcGap :: X (Int, Int, Int, Int) +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 + return $ foldl max4 (0,0,0,0) struts + +-- | +-- Adjusts the gap to the STRUTs of all current Windows +resetGap :: X () +resetGap = do + newGap <- calcGap + modifyGap (\_ _ -> newGap) + +-- | +-- Removes the gap or, if already removed, sets the gap according to the windows’ STRUT +toggleGap :: X () +toggleGap = do + newGap <- calcGap + modifyGap (\_ old -> if old == (0,0,0,0) then newGap else (0,0,0,0)) + addfile ./ManPrompt.hs hunk ./ManPrompt.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.ManPrompt +-- Copyright : (c) 2007 Valery V. Vorotyntsev +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : valery.vv@gmail.com +-- Stability : unstable +-- Portability : unportable +-- +-- A manual page prompt for XMonad window manager. +-- +-- TODO +-- +-- * narrow completions by section number, if the one is specified +-- (like @\/etc\/bash_completion@ does) +-- +-- * quickcheck properties +----------------------------------------------------------------------------- + +module XMonadContrib.ManPrompt ( + -- * Usage + -- $usage + manPrompt + , getCommandOutput + , uniqSort + ) where + +import XMonad +import XMonadContrib.XPrompt +import XMonadContrib.Run +import XMonadContrib.ShellPrompt ( split ) + +import System.Directory +import System.Process +import System.IO + +import qualified Control.Exception as E +import Control.Monad +import Data.List +import Data.Maybe +import Data.Set (toList, fromList) + +-- $usage +-- 1. In Config.hs add: +-- +-- > import XMonadContrib.ManPrompt +-- +-- 2. In your keybindings add something like: +-- +-- > , ((modMask, xK_F1), manPrompt defaultXPConfig) + +-- %import XMonadContrib.XPrompt +-- %import XMonadContrib.ManPrompt +-- %keybind , ((modMask, xK_F1), manPrompt defaultXPConfig) + +data Man = Man + +instance XPrompt Man where + showXPrompt Man = "Manual page: " + +-- | Query for manual page to be displayed. +manPrompt :: XPConfig -> X () +manPrompt c = mkXPrompt Man c manCompl man + where + man :: String -> X () + man s = runInXTerm ("man " ++ s) + +manCompl :: String -> IO [String] +manCompl s = getManpages >>= flip mkComplFunFromList s + +-- | Sort a list and remove duplicates. +-- +-- /XXX Code duplication!/ +-- The function with the same name exists in "ShellPrompt" module. +uniqSort :: Ord a => [a] -> [a] +uniqSort = toList . fromList + +-- | Obtain the list of manual pages. +-- +-- /XXX Code duplication!/ +-- Adopted from 'ShellPrompt.getCommands'. +getManpages :: IO [String] +getManpages = do + p <- getCommandOutput "manpath -g 2>/dev/null" `E.catch` const (return []) + let sections = ["man" ++ show n | n <- [1..9 :: Int]] -- XXX "cat1".."cat9"? + ds = [d ++ "/" ++ s | d <- split ':' p, s <- sections] + stripSec = reverse . drop 1 . dropWhile (/= '.') . reverse + ms <- forM ds $ \d -> do + exists <- doesDirectoryExist d + if exists + then map (stripSec . stripSuffixes [".gz", ".bz2"]) `fmap` + getDirectoryContents d + else return [] + return . uniqSort . concat $ ms + +-- | Run a command using shell and return its output. +getCommandOutput :: String -> IO String +getCommandOutput s = do + (pin, pout, perr, ph) <- runInteractiveCommand s + hClose pin + output <- hGetContents pout + E.evaluate (null output) + hClose perr + waitForProcess ph + return output + +stripSuffixes :: Eq a => [[a]] -> [a] -> [a] +stripSuffixes sufs fn = + head . catMaybes $ map (flip rstrip fn) sufs ++ [Just fn] + +rstrip :: Eq a => [a] -> [a] -> Maybe [a] +rstrip suf lst + | suf `isSuffixOf` lst = Just $ take (length lst - length suf) lst + | otherwise = Nothing hunk ./DragPane.hs 96 - Vertical -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r) - Horizontal -> (fromIntegral ey - (fromIntegral $ rect_y r))/(fromIntegral $ rect_height r) + Vertical -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r) + Horizontal -> (fromIntegral ey - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r) hunk ./XPrompt.hs 489 - yp = fi $ (ht + fi (asc + desc)) `div` 2 + yp = fi $ (ht + fi (asc - desc)) `div` 2 hunk ./CycleWS.hs 23 + toggleWS, hunk ./CycleWS.hs 38 --- +-- hunk ./CycleWS.hs 45 +-- > , ((modMask, xK_t), toggleWS) hunk ./CycleWS.hs 58 +-- %keybind , ((modMask, xK_t), toggleWS) hunk ./CycleWS.hs 61 --- --------------------- --- | --- Switch to next workspace -nextWS :: X() -nextWS = switchWorkspace (1) +-- | Switch to next workspace +nextWS :: X () +nextWS = switchWorkspace 1 hunk ./CycleWS.hs 65 --- --------------------- --- | --- Switch to previous workspace -prevWS :: X() +-- | Switch to previous workspace +prevWS :: X () hunk ./CycleWS.hs 69 --- | --- Move focused window to next workspace -shiftToNext :: X() -shiftToNext = shiftBy (1) +-- | Move focused window to next workspace +shiftToNext :: X () +shiftToNext = shiftBy 1 hunk ./CycleWS.hs 73 --- | --- Move focused window to previous workspace +-- | Move focused window to previous workspace hunk ./CycleWS.hs 77 +-- | Toggle to the workspace displayed previously +toggleWS :: X () +toggleWS = windows $ view =<< tag . head . hidden + hunk ./CycleWS.hs 95 - hunk ./CycleWS.hs 96 -wsIndex ws = findIndex (==(tag ws)) Config.workspaces +wsIndex ws = findIndex (== tag ws) Config.workspaces hunk ./Dzen.hs 46 --- Bug: Doesn't flash if you're on the same workspace, Full or Tabbed layout, different window. hunk ./Dzen.hs 51 - whenJust (W.findIndex w ws) (flash name ws visibles) - where flash name ws visibles index = - when (index /= W.tag (W.workspace (W.current ws)) && not (S.member w visibles)) $ + whenJust (W.findIndex w ws) (flash name visibles) + where flash name visibles index = + when (not $ S.member w visibles) $ addfile ./ConstrainedResize.hs hunk ./ConstrainedResize.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.ConstrainedResize +-- Copyright : (c) Dougal Stanton +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Lets you constrain the aspect ratio of a floating +-- window by holding shift while you resize. +-- +-- Useful for making a nice circular XClock window. +-- +----------------------------------------------------------------------------- + +module XMonadContrib.ConstrainedResize ( + -- * Usage + -- $usage + XMonadContrib.ConstrainedResize.mouseResizeWindow +) where + +import XMonad +import Operations +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +-- $usage +-- Put something like this in your Config.hs file: +-- +-- > import qualified XMonadContrib.ConstrainedResize as Sqr +-- > mouseBindings = M.fromList +-- > [ ... +-- > , ((modMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w False)) +-- > , ((modMask .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True )) ] + +-- %import qualified XMonadContrib.ConstrainedResize as Sqr +-- %mousebind , ((modMask, button3), (\\w -> focus w >> Sqr.mouseResizeWindow w False)) + +-- | Resize (floating) window with optional aspect ratio constraints. +mouseResizeWindow :: Window -> Bool -> X () +mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + sh <- io $ getWMNormalHints d w + io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa)) + mouseDrag (\ex ey -> do + let x = ex - fromIntegral (wa_x wa) + y = ey - fromIntegral (wa_y wa) + sz = if c then (max x y, max x y) else (x,y) + io $ resizeWindow d w `uncurry` + applySizeHints sh sz) + (float w) hunk ./MetaModule.hs 27 +import XMonadContrib.ConstrainedResize hunk ./ConstrainedResize.hs 37 +-- +-- The line without the shiftMask replaces the standard mouse resize function call, so it's +-- not completely necessary but seems neater this way. hunk ./ConstrainedResize.hs 43 +-- %mousebind , ((modMask .|. shiftMask, button3), (\\w -> focus w >> Sqr.mouseResizeWindow w True)) hunk ./Run.hs 25 + runInXTerm, hunk ./Run.hs 30 +import System.Environment (getEnv) hunk ./Run.hs 108 +runInXTerm :: String -> X () +runInXTerm com = do + c <- io $ catch (getEnv "XTERMCMD") (const $ return "xterm") + spawn ("exec " ++ c ++ " -e " ++ com) + hunk ./ShellPrompt.hs 23 - , runInXTerm hunk ./ShellPrompt.hs 78 --- This may be better done as a specialization of 'prompt' -runInXTerm :: String -> X () -runInXTerm com = do - c <- io $ catch (getEnv "XTERMCMD") (const $ return "xterm") - spawn ("exec " ++ c ++ " -e " ++ com) - hunk ./SshPrompt.hs 22 -import XMonadContrib.ShellPrompt (runInXTerm) hunk ./SshPrompt.hs 29 +import XMonadContrib.Run (runInXTerm) hunk ./Run.hs 25 + runInTerm, hunk ./Run.hs 109 +-- | Run a given program in a given X terminal emulator. This uses safeSpawn. +runInTerm :: String -> String -> X () +runInTerm term command = safeSpawn term ("-e " ++ command) + +-- | Runs a given program in XTerm, the X terminal emulator included by default in X.org installations. +-- The use of XTerm can be overridden in one's shell by setting $XTERMCMD to another shell's name. hunk ./Run.hs 31 -import System.Environment (getEnv) hunk ./Run.hs 113 --- The use of XTerm can be overridden in one's shell by setting $XTERMCMD to another shell's name. +-- Specializes runInTerm to use XTerm instead of an arbitrary other terminal emulator. hunk ./Run.hs 115 -runInXTerm com = do - c <- io $ catch (getEnv "XTERMCMD") (const $ return "xterm") - spawn ("exec " ++ c ++ " -e " ++ com) +runInXTerm = runInTerm "xterm" hunk ./Run.hs 26 + safeRunInTerm, hunk ./Run.hs 110 -runInTerm :: String -> String -> X () -runInTerm term command = safeSpawn term ("-e " ++ command) +safeRunInTerm :: String -> String -> X () +safeRunInTerm term command = safeSpawn term ("-e " ++ command) + +unsafeRunInTerm, runInTerm :: String -> String -> X () +unsafeRunInTerm term command = unsafeSpawn $ term ++ " -e " ++ command +runInTerm = unsafeRunInTerm hunk ./Commands.hs 32 -import {-# SOURCE #-} Config (workspaces,serialisedLayouts) +import {-# SOURCE #-} Config (workspaces,serialisedLayouts, terminal) hunk ./Commands.hs 87 - , ("xterm" , spawn "xterm" ) + , ("xterm" , spawn terminal ) hunk ./Run.hs 27 - runInXTerm, hunk ./Run.hs 39 +import {-# SOURCE #-} Config (terminal) hunk ./Run.hs 109 --- | Run a given program in a given X terminal emulator. This uses safeSpawn. -safeRunInTerm :: String -> String -> X () -safeRunInTerm term command = safeSpawn term ("-e " ++ command) +-- | Run a given program in the preferred terminal emulator. This uses safeSpawn. +safeRunInTerm :: String -> X () +safeRunInTerm command = safeSpawn terminal ("-e " ++ command) hunk ./Run.hs 113 -unsafeRunInTerm, runInTerm :: String -> String -> X () -unsafeRunInTerm term command = unsafeSpawn $ term ++ " -e " ++ command +unsafeRunInTerm, runInTerm :: String -> X () +unsafeRunInTerm command = unsafeSpawn $ terminal ++ " -e " ++ command hunk ./Run.hs 117 --- | Runs a given program in XTerm, the X terminal emulator included by default in X.org installations. --- Specializes runInTerm to use XTerm instead of an arbitrary other terminal emulator. -runInXTerm :: String -> X () -runInXTerm = runInTerm "xterm" - hunk ./SshPrompt.hs 29 -import XMonadContrib.Run (runInXTerm) +import XMonadContrib.Run (runInTerm) hunk ./SshPrompt.hs 58 -ssh s = runInXTerm ("ssh " ++ s) +ssh s = runInTerm ("ssh " ++ s) hunk ./ShellPrompt.hs 25 -import System.Environment (getEnv) -import Control.Monad (Monad((>>=), return), Functor(..), filterM, forM) -import Data.List ((++), concat, filter, map, lines, elem, span, tail, last, - isPrefixOf) +import System.Environment +import Control.Monad +import Data.List hunk ./ShellPrompt.hs 29 -import System.Directory (Permissions(executable), getPermissions, - getDirectoryContents, doesDirectoryExist, doesFileExist) -import System.IO (IO, FilePath) -import XMonadContrib.Run (runProcessWithInput, safeSpawn, unsafeSpawn) -import XMonad (X, io, spawn) -import XMonadContrib.XPrompt (XPrompt(..), XPConfig, mkXPrompt) +import System.Directory +import System.IO +import XMonadContrib.Run +import XMonad +import XMonadContrib.XPrompt hunk ./Invisible.hs 26 --- A data type to store the layout state +-- A wrapper data type to store layout state that shouldn't be persisted across +-- restarts. A common wrapped type to use is @Maybe a@. +-- Invisible derives trivial definitions for Read and Show, so the wrapped data +-- type need not do so hunk ./Invisible.hs 29 --- type need not do so +-- type need not do so. hunk ./TilePrime.hs 67 - (leftRect, rightRect) - | null (drop m xs) = (rect, Rectangle 0 0 0 0) - | flp = splitVerticallyBy f rect - | otherwise = splitHorizontallyBy f rect hunk ./TilePrime.hs 68 + (leftRect, rightRect) + | null rightXs = (rect, Rectangle 0 0 0 0) + | null leftXs = (Rectangle 0 0 0 0, rect) + | flp = splitVerticallyBy f rect + | otherwise = splitHorizontallyBy f rect hunk ./ManPrompt.hs 18 +-- * handle explicit paths (e.g., @~\/src\/xmonad\/man\/xmonad.1@) +-- hunk ./ManPrompt.hs 28 - , uniqSort hunk ./ManPrompt.hs 33 -import XMonadContrib.ShellPrompt ( split ) +import XMonadContrib.ShellPrompt (split) hunk ./ManPrompt.hs 43 -import Data.Set (toList, fromList) hunk ./ManPrompt.hs 64 -manPrompt c = mkXPrompt Man c manCompl man - where - man :: String -> X () - man s = runInXTerm ("man " ++ s) +manPrompt c = mkXPrompt Man c manCompl $ runInTerm . (++) "man " hunk ./ManPrompt.hs 69 --- | Sort a list and remove duplicates. --- --- /XXX Code duplication!/ --- The function with the same name exists in "ShellPrompt" module. -uniqSort :: Ord a => [a] -> [a] -uniqSort = toList . fromList - hunk ./ShellPrompt.hs 28 -import Data.Set (toList, fromList) hunk ./ShellPrompt.hs 81 -uniqSort :: Ord a => [a] -> [a] -uniqSort = toList . fromList - hunk ./SshPrompt.hs 6 --- +-- hunk ./SshPrompt.hs 38 --- 3. In your keybindings add something like: +-- 2. In your keybindings add something like: hunk ./SshPrompt.hs 50 - showXPrompt Ssh = "SSH to: " + showXPrompt Ssh = "SSH to: " hunk ./SshPrompt.hs 61 -sshComplList = (sort . toList . fromList) `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal +sshComplList = (nub . sort) `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal hunk ./SshPrompt.hs 67 - + hunk ./SshPrompt.hs 6 --- +-- hunk ./SshPrompt.hs 21 -import System.Environment (getEnv) -import Control.Monad(Monad (return), Functor(..), liftM2, mapM) -import Data.List ((++), concat, filter, map, words, lines, takeWhile, take, - sort) -import Data.Maybe (Maybe(..), catMaybes) -import Data.Set (toList, fromList) -import System.Directory (doesFileExist) -import XMonad (X, io) -import XMonadContrib.Run (runInTerm) -import XMonadContrib.XPrompt (XPrompt(..), XPConfig, mkXPrompt, - mkComplFunFromList) +import XMonad +import XMonadContrib.Run +import XMonadContrib.XPrompt + +import System.Directory +import System.Environment + +import Control.Monad +import Data.List +import Data.Maybe + hunk ./SshPrompt.hs 61 -sshComplList = (nub . sort) `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal +sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal hunk ./SshPrompt.hs 67 - + hunk ./XPrompt.hs 41 + , uniqSort hunk ./XPrompt.hs 58 +import Data.Set (fromList, toList) hunk ./XPrompt.hs 677 +-- | Sort a list and remove duplicates. +uniqSort :: Ord a => [a] -> [a] +uniqSort = toList . fromList + hunk ./Run.hs 42 --- For an example usage of runInXTerm see XMonadContrib.SshPrompt +-- For an example usage of runInTerm see XMonadContrib.SshPrompt hunk ./XPrompt.hs 50 +import XMonadContrib.XSelection (getSelection) hunk ./XPrompt.hs 277 + | ks == xK_y -> pasteString >> go hunk ./XPrompt.hs 335 +-- | Insert the current X selection string at the cursor position. +pasteString :: XP () +pasteString = join $ io $ liftM insertString $ getSelection + hunk ./XPrompt.hs 287 + | ks == xK_Home = startOfLine >> go + | ks == xK_End = endOfLine >> go replace ./Dzen.hs [A-Za-z_0-9] findIndex findTag hunk ./CycleWS.hs 32 -import StackSet hiding (filter, findIndex) +import StackSet hiding (filter) hunk ./XPrompt.hs 449 - io $ (completionFunction s) (getLastWord $ command s) + io $ ((completionFunction s) (getLastWord $ command s) + `catch` \_ -> return []) hunk ./ShellPrompt.hs 60 -{- | See safe and unsafeSpawn. prompt is an alias for safePrompt; safePrompt and unsafePrompt work on the same principles, - but will use XPrompt to interactively query the user for input; the appearance is set by passing an XPConfig as the - second argument. The first argument is the program to be run with the interactive input. - You would use these like this: - > , ((modMask, xK_b ), safePrompt "firefox" greenXPConfig) - > , ((modMask .|. shiftMask, xK_c ), prompt ("xterm" ++ " -e") greenXPConfig) - Note that you want to use safePrompt for Firefox input, as Firefox wants URLs, and unsafePrompt for the XTerm example - because this allows you to easily start a terminal executing an arbitrary command, like 'top'. -} +-- | See safe and unsafeSpawn. prompt is an alias for safePrompt; +-- safePrompt and unsafePrompt work on the same principles, but will use +-- XPrompt to interactively query the user for input; the appearance is +-- set by passing an XPConfig as the second argument. The first argument +-- is the program to be run with the interactive input. +-- You would use these like this: +-- +-- > , ((modMask, xK_b ), safePrompt "firefox" greenXPConfig) +-- > , ((modMask .|. shiftMask, xK_c ), prompt ("xterm" ++ " -e") greenXPConfig) +-- +-- Note that you want to use safePrompt for Firefox input, as Firefox +-- wants URLs, and unsafePrompt for the XTerm example because this allows +-- you to easily start a terminal executing an arbitrary command, like +-- 'top'. hunk ./ShellPrompt.hs 84 - f <- fmap lines $ runProcessWithInput "/bin/bash" [] ("compgen -A file " ++ s ++ "\n") + f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file " ++ s ++ "\n") hunk ./ShellPrompt.hs 53 - showXPrompt Shell = "Run: " + showXPrompt Shell = "Run: " hunk ./XPrompt.hs 123 --- > showXPrompt Shell = "Run: " +-- > showXPrompt Shell = "Run: " hunk ./XPrompt.hs 670 -getLastWord str = - reverse . fst . breakAtSpace . reverse $ str +getLastWord = reverse . fst . breakAtSpace . reverse hunk ./XPrompt.hs 675 -skipLastWord str = - reverse . snd . breakAtSpace . reverse $ str +skipLastWord = reverse . snd . breakAtSpace . reverse hunk ./XPrompt.hs 449 - io $ ((completionFunction s) (getLastWord $ command s) - `catch` \_ -> return []) + io $ (completionFunction s) (getLastWord $ command s) + `catch` \_ -> return [] hunk ./DynamicLog.hs 25 + dynamicLogDzen, hunk ./DynamicLog.hs 72 +-- | An example log hook that emulates dwm's status bar, using colour codes printed to dzen +-- Requires dzen. Workspaces, xinerama, layouts and the window title are handled. +-- +dynamicLogDzen :: X () +dynamicLogDzen = dynamicLogWithPP dzenPP + where + dzenPP = defaultPP { ppCurrent = dzenColor "white" "#2b4f98" . pad + , ppVisible = dzenColor "black" "#999999" . pad + , ppHidden = dzenColor "black" "#cccccc" . pad + , ppHiddenNoWindows = const "" + , ppWsSep = "" + , ppSep = "" + , ppLayout = dzenColor "black" "#cccccc" . + (\ x -> case x of + "TilePrime Horizontal" -> " TTT " + "TilePrime Vertical" -> " []= " + "Hinted Full" -> " [ ] " + _ -> pad x + ) + , ppTitle = ("^bg(#324c80) " ++) . escape + } + escape = concatMap (\x -> if x == '^' then "^^" else [x]) + pad = wrap " " " " + hunk ./NoBorders.hs 46 +-- hunk ./NoBorders.hs 99 +-- +-- | You can cleverly set no borders on a range of layouts, using a +-- layoutHook like so: +-- +-- > layoutHook = Layout $ smartBorders $ Select layouts +-- hunk ./CycleWS.hs 4 --- Copyright : (c) Joachim Breitner +-- Copyright : (c) Joachim Breitner , +-- Nelson Elhage (`toggleWS' function) hunk ./ViewPrev.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.ViewPrev --- Copyright : (c) Nelson Elhage --- License : BSD3-style (see LICENSE) --- --- Maintainer : Nelson Elhage --- Stability : unstable --- Portability : unportable --- --- A module that implements a command to switch to the previously --- viewed workspace --- ------------------------------------------------------------------------------ - -module XMonadContrib.ViewPrev ( - viewPrev - ) where - -import XMonad -import Operations -import qualified StackSet as W - -viewPrev :: X () -viewPrev = windows viewPrev' - where viewPrev' x = W.view (W.tag . head . W.hidden $ x) x rmfile ./ViewPrev.hs hunk ./MetaModule.hs 27 -import XMonadContrib.ConstrainedResize +import XMonadContrib.ConstrainedResize () hunk ./DynamicLog.hs 202 - , ppOrder = reverse hunk ./DynamicLog.hs 32 - PP(..), defaultPP, sjanssenPP, - wrap, dzenColor, xmobarColor, shorten + PP(..), defaultPP, dzenPP, sjanssenPP, + wrap, pad, shorten, + xmobarColor, dzenColor, dzenEscape hunk ./DynamicLog.hs 73 --- | An example log hook that emulates dwm's status bar, using colour codes printed to dzen --- Requires dzen. Workspaces, xinerama, layouts and the window title are handled. --- -dynamicLogDzen :: X () -dynamicLogDzen = dynamicLogWithPP dzenPP - where - dzenPP = defaultPP { ppCurrent = dzenColor "white" "#2b4f98" . pad - , ppVisible = dzenColor "black" "#999999" . pad - , ppHidden = dzenColor "black" "#cccccc" . pad - , ppHiddenNoWindows = const "" - , ppWsSep = "" - , ppSep = "" - , ppLayout = dzenColor "black" "#cccccc" . - (\ x -> case x of - "TilePrime Horizontal" -> " TTT " - "TilePrime Vertical" -> " []= " - "Hinted Full" -> " [ ] " - _ -> pad x - ) - , ppTitle = ("^bg(#324c80) " ++) . escape - } - escape = concatMap (\x -> if x == '^' then "^^" else [x]) - pad = wrap " " " " - hunk ./DynamicLog.hs 90 +-- | An example log hook that emulates dwm's status bar, using colour codes printed to dzen +-- Requires dzen. Workspaces, xinerama, layouts and the window title are handled. +-- +dynamicLogDzen :: X () +dynamicLogDzen = dynamicLogWithPP dzenPP + + hunk ./DynamicLog.hs 140 +pad :: String -> String +pad = wrap " " " " + hunk ./DynamicLog.hs 159 +-- | Escape any dzen metacharaters. +dzenEscape :: String -> String +dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x]) + hunk ./DynamicLog.hs 188 +-- | Settings to emulate dwm's statusbar, dzen only +dzenPP :: PP +dzenPP = defaultPP { ppCurrent = dzenColor "white" "#2b4f98" . pad + , ppVisible = dzenColor "black" "#999999" . pad + , ppHidden = dzenColor "black" "#cccccc" . pad + , ppHiddenNoWindows = const "" + , ppWsSep = "" + , ppSep = "" + , ppLayout = dzenColor "black" "#cccccc" . + (\ x -> case x of + "TilePrime Horizontal" -> " TTT " + "TilePrime Vertical" -> " []= " + "Hinted Full" -> " [ ] " + _ -> pad x + ) + , ppTitle = ("^bg(#324c80) " ++) . dzenEscape + } + hunk ./XMonadPrompt.hs 18 - xmonadPrompt + xmonadPrompt, + xmonadPromptC hunk ./XMonadPrompt.hs 50 +-- xmonad prompt with custom command list +xmonadPromptC :: [(String, X ())] -> XPConfig -> X () +xmonadPromptC commands c = mkXPrompt XMonad c (mkComplFunFromList (map fst commands)) runCommand' + hunk ./XMonadPrompt.hs 45 - showXPrompt XMonad = "XMonad: " + showXPrompt XMonad = "XMonad: " hunk ./MetaModule.hs 54 +import XMonadContrib.ManPrompt () hunk ./MetaModule.hs 83 -import XMonadContrib.ViewPrev () hunk ./WindowNavigation.hs 48 --- > layoutHook = Layout $ configurableNavigation (navigateBorder "green") $ Select ... +-- > layoutHook = Layout $ configurableNavigation (navigateColor "green") $ Select ... hunk ./WindowNavigation.hs 70 --- %layout -- layoutHook = Layout $ configurableNavigation (navigateBorder "green") $ ... +-- %layout -- layoutHook = Layout $ configurableNavigation (navigateColor "green") $ ... hunk ./ToggleLayouts.hs 28 --- import XMonadContrib.ToggleLayouts, and add to your layoutHook something like +-- +-- import XMonadContrib.ToggleLayouts +-- +-- and add to your layoutHook something like +-- hunk ./ToggleLayouts.hs 34 +-- hunk ./ToggleLayouts.hs 37 +-- +-- or a key binding like +-- > , ((modMask .|. controlMask, xK_space), sendMessage (Toggle "Full")) hunk ./ToggleLayouts.hs 42 -data ToggleLayout = ToggleLayout deriving (Read,Show,Typeable) +data ToggleLayout = ToggleLayout | Toggle String deriving (Read,Show,Typeable) hunk ./ToggleLayouts.hs 68 + | Just (Toggle d) <- fromMessage m, + d == description lt || d == description lf = + do mlt' <- handleMessage lt (SomeMessage Hide) + let lt' = maybe lt id mlt' + return $ Just $ ToggleLayouts False lt' lf hunk ./ToggleLayouts.hs 79 + | Just (Toggle d), + d == description lt || d == description lf <- fromMessage m = + do mlf' <- handleMessage lf (SomeMessage Hide) + let lf' = maybe lf id mlf' + return $ Just $ ToggleLayouts True lt lf' hunk ./ToggleLayouts.hs 79 - | Just (Toggle d), - d == description lt || d == description lf <- fromMessage m = + | Just (Toggle d) <- fromMessage m, + d == description lt || d == description lf = hunk ./UrgencyHook.hs 22 - withUrgencyHook + withUrgencyHook, + readUrgents, + withUrgents hunk ./UrgencyHook.hs 27 -import {-# SOURCE #-} Config (urgencyHook) +import {-# SOURCE #-} Config (urgencyHook, logHook) hunk ./UrgencyHook.hs 32 +import Control.Monad.State (gets) hunk ./UrgencyHook.hs 34 +import Data.IORef +import Data.Set (Set) +import qualified Data.Set as S hunk ./UrgencyHook.hs 39 +import Foreign (unsafePerformIO) hunk ./UrgencyHook.hs 69 +-- +-- You can also modify your logHook to print out information about urgent windows. +-- The functions readUrgents and withUrgents are there to help you with that. +-- No example for you. + +-- | Stores the global set of all urgent windows, across workspaces. Not exported -- use +-- @readUrgents@ or @withUrgents@ instead. +{-# NOINLINE urgents #-} +urgents :: IORef (Set Window) +urgents = unsafePerformIO (newIORef S.empty) + +readUrgents :: X (Set Window) +readUrgents = io $ readIORef urgents + +withUrgents :: (Set Window -> X a) -> X a +withUrgents f = readUrgents >>= f hunk ./UrgencyHook.hs 89 - handleMess _ mess = - let event = fromMessage mess :: Maybe Event in do - case event of - Just (PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w }) -> - when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do - wmh@WMHints { wmh_flags = flags } <- io $ getWMHints dpy w - when (testBit flags urgencyHintBit) $ do - urgencyHook w - -- Is clearing the bit really necessary? Xlib manual advises it. - io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit } - return () - _ -> return () - return Nothing + handleMess _ mess + | Just (PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w }) <- fromMessage mess = do + when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do + wmh@WMHints { wmh_flags = flags } <- io $ getWMHints dpy w + when (testBit flags urgencyHintBit) $ do + urgencyHook w + -- Clear the urgency bit in the WMHints flags field. According to the + -- Xlib manual, the *client* is supposed to clear this flag when the urgency + -- has been resolved, but, Xchat2, for example, sets the WMHints several + -- times (e.g. causing the dzen to blink) unless it's cleared. XMonad is + -- not a typical WM, so we're just breaking one more rule, here. + io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit } + adjustUrgents (S.insert w) + logHook -- call logHook after IORef has been modified + -- Doing the setWMHints triggers another propertyNotify with the bit + -- cleared, so we ignore that message. This has the potentially wrong + -- effect of ignoring *all* urgency-clearing messages, some of which might + -- be legitimate. Let's wait for bug reports on that, though. + return Nothing + | otherwise = + return Nothing + + -- Clear the urgency bit and remove from the urgent list when the window becomes visible. + redoLayout _ _ _ windowRects = do + visibles <- gets mapped + adjustUrgents (S.\\ visibles) + return (windowRects, Nothing) + +adjustUrgents :: (Set Window -> Set Window) -> X () +adjustUrgents f = io $ modifyIORef urgents f hunk ./Dzen.hs 15 -module XMonadContrib.Dzen (dzen, dzenScreen, dzenUrgencyHook, seconds) where +module XMonadContrib.Dzen (dzen, dzenWithArgs, dzenScreen, + dzenUrgencyHook, dzenUrgencyHookWithArgs, + seconds) where hunk ./Dzen.hs 49 -dzenUrgencyHook duration w = do +dzenUrgencyHook = dzenUrgencyHookWithArgs [] + +dzenUrgencyHookWithArgs :: [String] -> Int -> Window -> X () +dzenUrgencyHookWithArgs args duration w = do hunk ./Dzen.hs 59 - dzen (show name ++ " requests your attention on workspace " ++ index) duration + dzenWithArgs (show name ++ " requests your attention on workspace " ++ index) + args duration hunk ./Dzen.hs 30 -toXineramaArg :: ScreenId -> String -toXineramaArg n = show ( ((fromIntegral n)+1)::Int ) - hunk ./Dzen.hs 36 +-- | @dzen str args timeout@ pipes @str@ to dzen2 for @timeout@ seconds, passing @args@ to dzen. +-- Example usage: +-- > dzen "Hi, dons!" ["-ta", "r"] (5 `seconds`) +dzenWithArgs :: String -> [String] -> Int -> X () +dzenWithArgs str args timeout = io $ runProcessWithInputAndWait "dzen2" args (unchomp str) timeout + -- dzen seems to require the input to terminate with exactly one newline. + where unchomp s@['\n'] = s + unchomp [] = ['\n'] + unchomp (c:cs) = c : unchomp cs + hunk ./Dzen.hs 51 + toXineramaArg n = show ( ((fromIntegral n)+1)::Int ) hunk ./Dzen.hs 59 +-- | Flashes when a window requests your attention and you can't see it. For use with +-- XMonadContrib.UrgencyHook. Usage: +-- > urgencyHook = dzenUrgencyHook ["-bg", "darkgreen"] (5 `seconds`) hunk ./Dzen.hs 73 -dzenWithArgs :: String -> [String] -> Int -> X () -dzenWithArgs str args timeout = io $ runProcessWithInputAndWait "dzen2" args (unchomp str) timeout - -- dzen seems to require the input to terminate with exactly one newline. - where unchomp s@['\n'] = s - unchomp [] = ['\n'] - unchomp (c:cs) = c : unchomp cs - hunk ./Dzen.hs 38 --- > dzen "Hi, dons!" ["-ta", "r"] (5 `seconds`) +-- > dzenWithArgs "Hi, dons!" ["-ta", "r"] (5 `seconds`) hunk ./Dzen.hs 61 --- > urgencyHook = dzenUrgencyHook ["-bg", "darkgreen"] (5 `seconds`) +-- > urgencyHook = dzenUrgencyHookWithArgs ["-bg", "darkgreen"] (5 `seconds`) hunk ./UrgencyHook.hs 35 -import Data.Set (Set) +import Data.List ((\\)) +import Data.Maybe (listToMaybe) hunk ./UrgencyHook.hs 78 -urgents :: IORef (Set Window) -urgents = unsafePerformIO (newIORef S.empty) +urgents :: IORef [Window] +urgents = unsafePerformIO (newIORef []) hunk ./UrgencyHook.hs 81 -readUrgents :: X (Set Window) +readUrgents :: X [Window] hunk ./UrgencyHook.hs 84 -withUrgents :: (Set Window -> X a) -> X a +withUrgents :: ([Window] -> X a) -> X a hunk ./UrgencyHook.hs 102 - adjustUrgents (S.insert w) + adjustUrgents (\ws -> if elem w ws then ws else w : ws) hunk ./UrgencyHook.hs 115 - adjustUrgents (S.\\ visibles) + adjustUrgents (\\ (S.toList visibles)) hunk ./UrgencyHook.hs 118 -adjustUrgents :: (Set Window -> Set Window) -> X () +adjustUrgents :: ([Window] -> [Window]) -> X () hunk ./UrgencyHook.hs 23 + focusUrgent, hunk ./UrgencyHook.hs 29 +import Operations (windows) +import qualified StackSet as W hunk ./UrgencyHook.hs 78 +-- | Focuses the most recently urgent window. Good for what ails ya -- I mean, your keybindings. +-- Example keybinding: +-- > , ((modMask , xK_BackSpace), focusUrgent) +focusUrgent :: X () +focusUrgent = withUrgents $ flip whenJust (windows . W.focusWindow) . listToMaybe + hunk ./UrgencyHook.hs 38 -import Data.List ((\\)) +import Data.List ((\\), delete) hunk ./UrgencyHook.hs 100 - | Just (PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w }) <- fromMessage mess = do + | Just PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } <- fromMessage mess = do hunk ./UrgencyHook.hs 118 + | Just DestroyWindowEvent {ev_window = w} <- fromMessage mess = do + adjustUrgents (delete w) + return Nothing hunk ./ManPrompt.hs 1 +{-# OPTIONS_GHC -Wall #-} hunk ./ManPrompt.hs 10 --- Portability : unportable +-- Portability : non-portable (uses \"manpath\" and \"bash\") hunk ./ManPrompt.hs 19 --- * handle explicit paths (e.g., @~\/src\/xmonad\/man\/xmonad.1@) --- --- * quickcheck properties +-- * test with QuickCheck hunk ./ManPrompt.hs 50 --- > , ((modMask, xK_F1), manPrompt defaultXPConfig) +-- > , ((modMask, xK_F1), manPrompt defaultXPConfig) -- mod-f1 %! Query for manual page to be displayed hunk ./ManPrompt.hs 66 -manCompl s = getManpages >>= flip mkComplFunFromList s - --- | Obtain the list of manual pages. --- --- /XXX Code duplication!/ --- Adopted from 'ShellPrompt.getCommands'. -getManpages :: IO [String] -getManpages = do - p <- getCommandOutput "manpath -g 2>/dev/null" `E.catch` const (return []) - let sections = ["man" ++ show n | n <- [1..9 :: Int]] -- XXX "cat1".."cat9"? - ds = [d ++ "/" ++ s | d <- split ':' p, s <- sections] - stripSec = reverse . drop 1 . dropWhile (/= '.') . reverse - ms <- forM ds $ \d -> do - exists <- doesDirectoryExist d - if exists - then map (stripSec . stripSuffixes [".gz", ".bz2"]) `fmap` - getDirectoryContents d - else return [] - return . uniqSort . concat $ ms +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 [] + let sects = ["man" ++ show n | n <- [1..9 :: Int]] + dirs = [d ++ "/" ++ s | d <- split ':' mp, s <- sects] + stripExt = reverse . drop 1 . dropWhile (/= '.') . reverse + 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 hunk ./ManPrompt.hs 83 +-- +-- XXX merge with 'Run.runProcessWithInput'? +-- +-- * update documentation of the latter (there is no 'Maybe' in result) +-- +-- * ask \"gurus\" whether @evaluate (length ...)@ approach is +-- better\/more idiomatic hunk ./ManPrompt.hs 95 - E.evaluate (null output) + E.evaluate (length output) hunk ./LayoutCombinators.hs 20 - (<|>), (), (<||>), () + (<|>), (), (<||>), (), (|||) hunk ./LayoutCombinators.hs 23 +import Data.Maybe ( isJust ) + hunk ./LayoutCombinators.hs 26 -import Operations ( Tall(..), Mirror(..) ) +import Operations ( Tall(..), Mirror(..), + ChangeLayout(NextLayout,JumpToLayout), LayoutMessages(..) ) hunk ./LayoutCombinators.hs 46 +(|||) :: (LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> NewSelect l1 l2 a +(|||) = NewSelect True + +data NewSelect l1 l2 a = NewSelect Bool (l1 a) (l2 a) deriving ( Read, Show ) + +data NoWrap = NextLayoutNoWrap | Wrap deriving ( Read, Show, Typeable ) +instance Message NoWrap + +instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a where + doLayout (NewSelect True l1 l2) r s = do (wrs, ml1') <- doLayout l1 r s + return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1') + doLayout (NewSelect False l1 l2) r s = do (wrs, ml2') <- doLayout l2 r s + return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2') + description (NewSelect True l1 _) = description l1 + description (NewSelect False _ l2) = description l2 + descriptions (NewSelect _ l1 l2) = descriptions l1 ++ descriptions l2 + handleMessage (NewSelect False l1 l2) m + | Just Wrap <- fromMessage m = + do ml2' <- handleMessage l2 (SomeMessage Hide) + ml1' <- handleMessage l1 m + return $ Just $ NewSelect True (maybe l1 id ml1') (maybe l2 id ml2') + handleMessage (NewSelect True l1 l2) m + | Just NextLayoutNoWrap <- fromMessage m = + do ml1' <- handleMessage l1 m + case ml1' of + Just l1' -> return $ Just (NewSelect True l1' l2) + Nothing -> do ml1'' <- handleMessage l1 (SomeMessage Hide) + ml2' <- handleMessage l2 (SomeMessage Wrap) + return $ Just $ NewSelect False (maybe l1 id ml1'') (maybe l2 id ml2') + handleMessage l@(NewSelect True _ _) m + | Just NextLayout <- fromMessage m = handleMessage l (SomeMessage NextLayoutNoWrap) + handleMessage l@(NewSelect False l1 l2) m + | Just NextLayout <- fromMessage m = + do ml' <- handleMessage l (SomeMessage NextLayoutNoWrap) + case ml' of + Just l' -> return $ Just l' + Nothing -> do ml2' <- handleMessage l2 (SomeMessage Hide) + ml1' <- handleMessage l1 (SomeMessage Wrap) + return $ Just $ NewSelect True (maybe l1 id ml1') (maybe l2 id ml2') + handleMessage (NewSelect True l1 l2) m + | Just (JumpToLayout d) <- fromMessage m = + if d `elem` descriptions l2 + then do ml1' <- handleMessage l1 (SomeMessage Hide) + ml2' <- handleMessage l2 m + return $ Just $ NewSelect False (maybe l1 id ml1') (maybe l2 id ml2') + else if d `elem` descriptions l1 + then do ml1' <- handleMessage l1 m + return $ (\l1' -> NewSelect True l1' l2) `fmap` ml1' + else return Nothing + handleMessage (NewSelect False l1 l2) m + | Just (JumpToLayout d) <- fromMessage m = + if d `elem` descriptions l1 + then do ml2' <- handleMessage l2 (SomeMessage Hide) + ml1' <- handleMessage l1 m + return $ Just $ NewSelect False (maybe l1 id ml1') (maybe l2 id ml2') + else if d `elem` descriptions l2 + then do ml2' <- handleMessage l2 m + return $ (\l2' -> NewSelect True l1 l2') `fmap` ml2' + else return Nothing + handleMessage (NewSelect b l1 l2) m + | Just ReleaseResources <- fromMessage m = + do ml1' <- handleMessage l1 m + ml2' <- handleMessage l2 m + return $ if isJust ml1' || isJust ml2' + then Just $ NewSelect b (maybe l1 id ml1') (maybe l2 id ml2') + else Nothing + handleMessage (NewSelect True l1 l2) m = + do ml1' <- handleMessage l1 m + return $ (\l1' -> NewSelect True l1' l2) `fmap` ml1' + handleMessage (NewSelect False l1 l2) m = + do ml2' <- handleMessage l2 m + return $ (\l2' -> NewSelect False l1 l2') `fmap` ml2' + hunk ./LayoutCombinators.hs 61 - descriptions (NewSelect _ l1 l2) = descriptions l1 ++ descriptions l2 hunk ./LayoutCombinators.hs 84 - handleMessage (NewSelect True l1 l2) m - | Just (JumpToLayout d) <- fromMessage m = - if d `elem` descriptions l2 - then do ml1' <- handleMessage l1 (SomeMessage Hide) - ml2' <- handleMessage l2 m - return $ Just $ NewSelect False (maybe l1 id ml1') (maybe l2 id ml2') - else if d `elem` descriptions l1 - then do ml1' <- handleMessage l1 m - return $ (\l1' -> NewSelect True l1' l2) `fmap` ml1' - else return Nothing - handleMessage (NewSelect False l1 l2) m - | Just (JumpToLayout d) <- fromMessage m = - if d `elem` descriptions l1 - then do ml2' <- handleMessage l2 (SomeMessage Hide) - ml1' <- handleMessage l1 m - return $ Just $ NewSelect False (maybe l1 id ml1') (maybe l2 id ml2') - else if d `elem` descriptions l2 - then do ml2' <- handleMessage l2 m - return $ (\l2' -> NewSelect True l1 l2') `fmap` ml2' - else return Nothing hunk ./Run.hs 30 -import Control.Monad.State (Monad((>>), return), when) +import Control.Monad.State +import Control.Monad.Reader hunk ./Run.hs 33 - getProcessStatus) + getProcessStatus) hunk ./Run.hs 39 -import XMonad (X, io, spawn) -import {-# SOURCE #-} Config (terminal) +import XMonad hunk ./Run.hs 111 -safeRunInTerm command = safeSpawn terminal ("-e " ++ command) +safeRunInTerm command = asks terminal >>= \t -> safeSpawn t ("-e " ++ command) hunk ./Run.hs 114 -unsafeRunInTerm command = unsafeSpawn $ terminal ++ " -e " ++ command +unsafeRunInTerm command = asks terminal >>= \t -> unsafeSpawn $ t ++ " -e " ++ command hunk ./LayoutModifier.hs 26 -import Operations ( LayoutMessages(Hide, ReleaseResources) ) hunk ./NoBorders.hs 28 -import Control.Monad.State ( gets ) +import Control.Monad.State (gets) +import Control.Monad.Reader (asks) hunk ./NoBorders.hs 34 -import {-# SOURCE #-} Config (borderWidth) hunk ./NoBorders.hs 46 --- +-- hunk ./NoBorders.hs 59 - unhook (WithBorder _ s) = setBorders borderWidth s + unhook (WithBorder _ s) = asks borderWidth >>= setBorders s hunk ./NoBorders.hs 62 - setBorders borderWidth (s \\ ws) - setBorders n ws + asks borderWidth >>= setBorders (s \\ ws) + setBorders ws n hunk ./NoBorders.hs 74 -setBorders :: Dimension -> [Window] -> X () -setBorders bw ws = withDisplay $ \d -> mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws +setBorders :: [Window] -> Dimension -> X () +setBorders ws bw = withDisplay $ \d -> mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws hunk ./NoBorders.hs 82 - unhook (SmartBorder s) = setBorders borderWidth s + unhook (SmartBorder s) = asks borderWidth >>= setBorders s hunk ./NoBorders.hs 89 - setBorders borderWidth (s \\ ws) - setBorders 0 ws + asks borderWidth >>= setBorders (s \\ ws) + setBorders ws 0 hunk ./NoBorders.hs 93 - setBorders borderWidth s + asks borderWidth >>= setBorders s hunk ./DynamicLog.hs 41 -import {-# SOURCE #-} Config (workspaces) -import Operations () -- for ReadableSomeLayout instance +import Control.Monad.Reader hunk ./DynamicLog.hs 76 + spaces <- asks (workspaces . config) hunk ./DynamicLog.hs 80 - ws <- withWindowSet $ return . pprWindowSet pp + ws <- withWindowSet $ return . pprWindowSet spaces pp hunk ./DynamicLog.hs 97 -pprWindowSet :: PP -> WindowSet -> String -pprWindowSet pp s = sepBy (ppWsSep pp) $ map fmt $ sortBy cmp +pprWindowSet :: [String] -> PP -> WindowSet -> String +pprWindowSet spaces pp s = sepBy (ppWsSep pp) $ map fmt $ sortBy cmp hunk ./DynamicLog.hs 105 - wsIndex = flip elemIndex workspaces . S.tag + wsIndex = flip elemIndex spaces . S.tag hunk ./NoBorders.hs 59 - unhook (WithBorder _ s) = asks borderWidth >>= setBorders s + unhook (WithBorder _ s) = asks (borderWidth . config) >>= setBorders s hunk ./NoBorders.hs 62 - asks borderWidth >>= setBorders (s \\ ws) + asks (borderWidth . config) >>= setBorders (s \\ ws) hunk ./NoBorders.hs 82 - unhook (SmartBorder s) = asks borderWidth >>= setBorders s + unhook (SmartBorder s) = asks (borderWidth . config) >>= setBorders s hunk ./NoBorders.hs 89 - asks borderWidth >>= setBorders (s \\ ws) + asks (borderWidth . config) >>= setBorders (s \\ ws) hunk ./NoBorders.hs 93 - asks borderWidth >>= setBorders s + asks (borderWidth . config) >>= setBorders s hunk ./Run.hs 111 -safeRunInTerm command = asks terminal >>= \t -> safeSpawn t ("-e " ++ command) +safeRunInTerm command = asks (terminal . config) >>= \t -> safeSpawn t ("-e " ++ command) hunk ./Run.hs 114 -unsafeRunInTerm command = asks terminal >>= \t -> unsafeSpawn $ t ++ " -e " ++ command +unsafeRunInTerm command = asks (terminal . config) >>= \t -> unsafeSpawn $ t ++ " -e " ++ command hunk ./XPrompt.hs 46 -import XMonad hiding (io) +import XMonad hiding (config, io) hunk ./Commands.hs 32 -import {-# SOURCE #-} Config (workspaces,serialisedLayouts, terminal) +import Layouts hunk ./Commands.hs 34 +import Control.Monad.Reader hunk ./Commands.hs 67 -workspaceCommands :: [(String, X ())] -workspaceCommands = [((m ++ show i), windows $ f i) - | i <- workspaces - , (f, m) <- [(view, "view"), (shift, "shift")] - ] +workspaceCommands :: X [(String, X ())] +workspaceCommands = asks (workspaces . config) >>= \spaces -> return + [((m ++ show i), windows $ f i) + | i <- spaces + , (f, m) <- [(view, "view"), (shift, "shift")] ] hunk ./Commands.hs 79 -defaultCommands :: [(String, X ())] -defaultCommands = workspaceCommands ++ screenCommands - ++ [ ("shrink" , sendMessage Shrink ) - , ("expand" , sendMessage Expand ) - , ("next-layout" , sendMessage NextLayout ) - , ("previous-layout" , sendMessage PrevLayout ) - , ("default-layout" , setLayout (head serialisedLayouts) ) - , ("restart-wm" , sr >> restart Nothing True ) - , ("restart-wm-no-resume", sr >> restart Nothing False ) - , ("xterm" , spawn terminal ) - , ("run" , spawn "exe=`dmenu_path | dmenu -b` && exec $exe" ) - , ("kill" , kill ) - , ("refresh" , refresh ) - , ("focus-up" , windows $ focusUp ) - , ("focus-down" , windows $ focusDown ) - , ("swap-up" , windows $ swapUp ) - , ("swap-down" , windows $ swapDown ) - , ("swap-master" , windows $ swapMaster ) - , ("sink" , withFocused $ windows . sink ) - , ("quit-wm" , io $ exitWith ExitSuccess ) - ] - where sr = broadcastMessage ReleaseResources +defaultCommands :: X [(String, X ())] +defaultCommands = do + wscmds <- workspaceCommands + return $ wscmds ++ screenCommands ++ otherCommands + where + sr = broadcastMessage ReleaseResources + otherCommands = + [ ("shrink" , sendMessage Shrink ) + , ("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 ) + , ("xterm" , spawn =<< asks (terminal . config) ) + , ("run" , spawn "exe=`dmenu_path | dmenu -b` && exec $exe" ) + , ("kill" , kill ) + , ("refresh" , refresh ) + , ("focus-up" , windows $ focusUp ) + , ("focus-down" , windows $ focusDown ) + , ("swap-up" , windows $ swapUp ) + , ("swap-down" , windows $ swapDown ) + , ("swap-master" , windows $ swapMaster ) + , ("sink" , withFocused $ windows . sink ) + , ("quit-wm" , io $ exitWith ExitSuccess ) + ] hunk ./Commands.hs 113 - let m = commandMap defaultCommands + m <- fmap commandMap defaultCommands hunk ./CycleWS.hs 22 - shiftToNext, - shiftToPrev, + shiftToNext, + shiftToPrev, hunk ./CycleWS.hs 27 +import Control.Monad.Reader ( asks ) hunk ./CycleWS.hs 33 -import XMonad +import XMonad hiding (workspaces) +import qualified XMonad (workspaces) hunk ./CycleWS.hs 37 -import {-# SOURCE #-} qualified Config (workspaces) hunk ./CycleWS.hs 92 - let orderedWs = sortBy (comparing wsIndex) (workspaces ws) + spaces <- asks (XMonad.workspaces . config) + let orderedWs = sortBy (comparing (wsIndex spaces)) (workspaces ws) hunk ./CycleWS.hs 98 -wsIndex :: WindowSpace -> Maybe Int -wsIndex ws = findIndex (== tag ws) Config.workspaces +wsIndex :: [WorkspaceId] -> WindowSpace -> Maybe Int +wsIndex spaces ws = findIndex (== tag ws) spaces hunk ./Submap.hs 60 - keyspec <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do + (m, s) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do hunk ./Submap.hs 66 - else return (cleanMask m, keysym) + else return (m, keysym) hunk ./Submap.hs 70 - whenJust (M.lookup keyspec keys) id + m' <- cleanMask m + whenJust (M.lookup (m', s) keys) id hunk ./WindowNavigation.hs 34 -import Operations ( windows, focus, LayoutMessages(..) ) +import Operations ( windows, focus ) hunk ./XMonadPrompt.hs 19 - xmonadPromptC + xmonadPromptC hunk ./XMonadPrompt.hs 48 -xmonadPrompt c = mkXPrompt XMonad c (mkComplFunFromList (map fst defaultCommands)) runCommand' +xmonadPrompt c = do + cmds <- defaultCommands + mkXPrompt XMonad c (mkComplFunFromList (map fst cmds)) runCommand' hunk ./TwoPane.hs 26 -import Operations ( Resize(..), splitHorizontallyBy ) +import Layouts ( Resize(..), splitHorizontallyBy ) hunk ./ThreeColumns.hs 25 -import Operations ( Resize(..), IncMasterN(..), splitVertically, splitHorizontallyBy ) +import Layouts ( Resize(..), IncMasterN(..), splitVertically, splitHorizontallyBy ) hunk ./TagWindows.hs 38 -import XMonad +import XMonad hiding (workspaces) hunk ./Spiral.hs 30 +import Layouts hunk ./Roledex.hs 24 -import Operations +import Layouts hunk ./ResizableTile.hs 25 -import Operations (Resize(..), IncMasterN(..)) +import Layouts (Resize(..), IncMasterN(..)) hunk ./MosaicAlt.hs 32 -import Operations +import Layouts hunk ./DragPane.hs 37 -import Operations +import Layouts +import Operations hunk ./Dishes.hs 20 - -- $usage + -- $usage hunk ./Dishes.hs 45 - doLayout (Dishes nmaster h) r = - return . (\x->(x,Nothing)) . - ap zip (dishes h r nmaster . length) . integrate - pureMessage (Dishes nmaster h) m = fmap incmastern (fromMessage m) - where incmastern (IncMasterN d) = Dishes (max 0 (nmaster+d)) h + doLayout (Dishes nmaster h) r = + return . (\x->(x,Nothing)) . + ap zip (dishes h r nmaster . length) . integrate + pureMessage (Dishes nmaster h) m = fmap incmastern (fromMessage m) + where incmastern (IncMasterN d) = Dishes (max 0 (nmaster+d)) h hunk ./Dishes.hs 53 - then splitHorizontally n s - else ws - where - (m,rest) = splitVerticallyBy (1 - (fromIntegral $ n - nmaster) * h) s - ws = splitHorizontally nmaster m ++ splitVertically (n - nmaster) rest + then splitHorizontally n s + else ws + where + (m,rest) = splitVerticallyBy (1 - (fromIntegral $ n - nmaster) * h) s + ws = splitHorizontally nmaster m ++ splitVertically (n - nmaster) rest hunk ./Dishes.hs 26 -import Operations +import Layouts hunk ./Accordion.hs 23 -import Operations +import Layouts hunk ./WorkspacePrompt.hs 23 -import XMonad +import XMonad hiding ( workspaces ) hunk ./ToggleLayouts.hs 24 -import Operations ( LayoutMessages(Hide, ReleaseResources) ) hunk ./Combo.hs 20 - combo, combineTwo, + combineTwo, hunk ./Combo.hs 28 -import Operations ( LayoutMessages(ReleaseResources,Hide) ) hunk ./Combo.hs 41 --- > combo (TwoPane 0.03 0.5) [(Layout Full,1),(Layout $ tabbed shrinkText defaultTConf,1)] --- --- or alternatively --- hunk ./Combo.hs 44 --- --- The first argument to combo is a layout that will divide the screen into --- one or more subscreens. The second argument is a list of layouts which --- will be used to lay out the contents of each of those subscreens. --- Paired with each of these layouts is an integer giving the number of --- windows this section should hold. This number is ignored for the last --- layout, which will hold any excess windows. hunk ./Combo.hs 45 --- combineTwo is a new simpler (and yet in some ways more powerful) layout --- combinator. It only allows the combination of two layouts, but has the --- advantage of allowing you to dynamically adjust the layout, in terms of --- the number of windows in each sublayout. To do this, use --- WindowNavigation, and add the following key bindings (or something similar): +-- combineTwo is a new simple layout combinator. It allows the combination +-- of two layouts using a third to split the screen between the two, but +-- has the advantage of allowing you to dynamically adjust the layout, in +-- terms of the number of windows in each sublayout. To do this, use +-- WindowNavigation, and add the following key bindings (or something +-- similar): hunk ./Combo.hs 66 --- %layout , combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)] +-- %layout , combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) hunk ./Combo.hs 126 -combo :: (Eq a, Show a, Read a, ReadableLayout a, LayoutClass l (Layout a, Int)) - => (l (Layout a, Int)) -> [(Layout a, Int)] -> Combo l a -combo = Combo (I []) - -data Combo l a = Combo (Invisible [] a) (l (Layout a, Int)) [(Layout a, Int)] - deriving (Show, Read) - -instance (Eq a, ReadableLayout a, LayoutClass l (Layout a, Int)) - => LayoutClass (Combo l) a where - doLayout (Combo (I f) super origls) rinput s = arrange (integrate s) - where arrange [] = return ([], Just $ Combo (I []) super origls) - arrange [w] = return ([(w,rinput)], Just $ Combo (I [w]) super origls) - arrange origws = - do (lrs, msuper') <- runLayout super rinput (W.differentiate $ take (length origws) origls) - let super' = maybe super id msuper' - f' = focus s:delete (focus s) f - lwrs [] _ = [] - lwrs [((l,_),r)] ws = [((l,r),differentiate f' ws)] - lwrs (((l,n),r):xs) ws = ((l,r),differentiate f' $ take len1 ws) : lwrs xs (drop len1 ws) - where len1 = min n (length ws - length xs) - out <- mapM (uncurry $ uncurry runLayout) $ lwrs lrs origws - let origls' = zipWith foo (out++repeat ([],Nothing)) origls - foo (_, Nothing) x = x - foo (_, Just l') (_, n) = (l', n) - return (concat $ map fst out, Just $ Combo (I f') super' origls') - handleMessage (Combo (I f) super origls) m = - do mls <- broadcastPrivate m (map fst origls) - let mls' = (\x->zipWith first (map const x) origls) `fmap` mls - f' = case fromMessage m of - Just ReleaseResources -> [] - _ -> f - msuper <- broadcastPrivate m [super] - case msuper of - Just [super'] -> return $ Just $ Combo (I f') super' $ maybe origls id mls' - _ -> return $ Combo (I f') super `fmap` mls' hunk ./Run.hs 30 -import Control.Monad.State hunk ./LayoutCombinators.hs 20 - (<|>), (), (<||>), (), (|||) + (<|>), (), (<||>), (), (|||), JumpToLayout(JumpToLayout) hunk ./LayoutCombinators.hs 26 -import Operations ( Tall(..), Mirror(..), - ChangeLayout(NextLayout,JumpToLayout), LayoutMessages(..) ) +import Layouts ( Tall(..), Mirror(..), ChangeLayout(NextLayout) ) hunk ./LayoutCombinators.hs 53 +data JumpToLayout = JumpToLayout String deriving ( Read, Show, Typeable ) +instance Message JumpToLayout + hunk ./LayoutCombinators.hs 86 + handleMessage (NewSelect True l1 l2) m + | Just (JumpToLayout d) <- fromMessage m, + d == description l2 = do ml1' <- handleMessage l1 (SomeMessage Hide) + return $ Just $ NewSelect False (maybe l1 id ml1') l2 + handleMessage (NewSelect True l1 l2) m + | Just (JumpToLayout d) <- fromMessage m + = do ml1' <- handleMessage l1 m + case ml1' of + Just l1' -> return $ Just $ NewSelect True l1' l2 + Nothing -> + do ml2' <- handleMessage l2 m + case ml2' of + Nothing -> return Nothing + Just l2' -> do ml1'' <- handleMessage l1 (SomeMessage Hide) + return $ Just $ NewSelect False (maybe l1 id ml1'') l2' + handleMessage (NewSelect False l1 l2) m + | Just (JumpToLayout d) <- fromMessage m, + d == description l1 = do ml2' <- handleMessage l2 (SomeMessage Hide) + return $ Just $ NewSelect True l1 (maybe l2 id ml2') + handleMessage (NewSelect False l1 l2) m + | Just (JumpToLayout d) <- fromMessage m + = do ml2' <- handleMessage l2 m + case ml2' of + Just l2' -> return $ Just $ NewSelect False l1 l2' + Nothing -> + do ml1' <- handleMessage l1 m + case ml1' of + Nothing -> return Nothing + Just l1' -> do ml2'' <- handleMessage l2 (SomeMessage Hide) + return $ Just $ NewSelect True l1' (maybe l2 id ml2'') hunk ./ManageDocks.hs 25 + ,avoidStruts hunk ./ManageDocks.hs 137 +-- | Adjust layout automagically. +avoidStruts :: LayoutClass l a => l a -> AvoidStruts l a +avoidStruts = AvoidStruts + +data AvoidStruts l a = AvoidStruts (l a) deriving ( Read, Show ) + +instance LayoutClass l a => LayoutClass (AvoidStruts l) a where + doLayout (AvoidStruts lo) (Rectangle x y w h) s = + do (t,l,b,r) <- calcGap + let rect = Rectangle (x+10+fromIntegral l) (y+fromIntegral t) + (w-fromIntegral l-fromIntegral r) (h-fromIntegral t-fromIntegral b) + (wrs,mlo') <- doLayout lo rect s + return (wrs, AvoidStruts `fmap` mlo') + handleMessage (AvoidStruts l) m = + do ml' <- handleMessage l m + return (AvoidStruts `fmap` ml') + description (AvoidStruts l) = description l + hunk ./Accordion.hs 23 -import Layouts +import XMonad.Layouts replace ./Accordion.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./Circle.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./Combo.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet hunk ./Commands.hs 32 -import Layouts +import XMonad.Layouts replace ./Commands.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./Commands.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./ConstrainedResize.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./CopyWindow.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./CopyWindow.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./CycleWS.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./CycleWS.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./DeManage.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./DeManage.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet hunk ./Dishes.hs 26 -import Layouts +import XMonad.Layouts replace ./Dishes.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./Dmenu.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet hunk ./DragPane.hs 37 -import Layouts +import XMonad.Layouts replace ./DragPane.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./DragPane.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./DwmPromote.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./DwmPromote.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./DynamicLog.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./DynamicWorkspaces.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./DynamicWorkspaces.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet hunk ./DynamicWorkspaces.hs 86 - XMonad.StackSet { current = Screen { workspace = torem } + StackSet { current = Screen { workspace = torem } hunk ./DynamicWorkspaces.hs 92 -addWorkspace' :: i -> l -> XMonad.StackSet i l a sid sd -> XMonad.StackSet i l a sid sd -addWorkspace' newtag l s@(XMonad.StackSet { current = scr@(Screen { workspace = w }) +addWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd +addWorkspace' newtag l s@(StackSet { current = scr@(Screen { workspace = w }) hunk ./DynamicWorkspaces.hs 98 -removeWorkspace' :: (Eq i) => i -> XMonad.StackSet i l a sid sd -> XMonad.StackSet i l a sid sd -removeWorkspace' torem s@(XMonad.StackSet { current = scr@(Screen { workspace = wc }) +removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd +removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc }) replace ./Dzen.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./EwmhDesktops.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./FindEmptyWorkspace.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./FindEmptyWorkspace.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet hunk ./FindEmptyWorkspace.hs 53 -findEmptyWorkspace :: XMonad.StackSet i l a s sd -> Maybe (Workspace i l a) +findEmptyWorkspace :: StackSet i l a s sd -> Maybe (Workspace i l a) replace ./FlexibleManipulate.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./FlexibleResize.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./FloatKeys.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./FocusNth.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./FocusNth.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./Grid.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./HintedTile.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./HintedTile.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./LayoutHints.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./LayoutModifier.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./LayoutScreens.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./LayoutScreens.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./MagicFocus.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./Magnifier.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./ManageDocks.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./ManageDocks.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./Mosaic.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./Mosaic.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet hunk ./MosaicAlt.hs 32 -import Layouts +import XMonad.Layouts replace ./MosaicAlt.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./MouseGestures.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./NamedWindows.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./NoBorders.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet hunk ./ResizableTile.hs 25 -import Layouts (Resize(..), IncMasterN(..)) +import XMonad.Layouts (Resize(..), IncMasterN(..)) replace ./ResizableTile.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet hunk ./Roledex.hs 24 -import Layouts +import XMonad.Layouts replace ./Roledex.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./RotSlaves.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./RotSlaves.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./RotView.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./RotView.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./SinkAll.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./SinkAll.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet hunk ./Spiral.hs 30 -import Layouts +import XMonad.Layouts replace ./Spiral.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./Spiral.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./Square.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./Submap.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./SwapWorkspaces.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet hunk ./SwapWorkspaces.hs 46 -swapWithCurrent :: Eq i => i -> XMonad.StackSet i l a s sd -> XMonad.StackSet i l a s sd +swapWithCurrent :: Eq i => i -> StackSet i l a s sd -> StackSet i l a s sd hunk ./SwapWorkspaces.hs 51 -swapWorkspaces :: Eq i => i -> i -> XMonad.StackSet i l a s sd -> XMonad.StackSet i l a s sd +swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd replace ./SwitchTrans.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./Tabbed.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./Tabbed.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./TagWindows.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./TagWindows.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet hunk ./TagWindows.hs 118 -wsToList :: (Ord i) => XMonad.StackSet i l a s sd -> [a] +wsToList :: (Ord i) => StackSet i l a s sd -> [a] hunk ./TagWindows.hs 124 -wsToListGlobal :: (Ord i) => XMonad.StackSet i l a s sd -> [a] +wsToListGlobal :: (Ord i) => StackSet i l a s sd -> [a] hunk ./TagWindows.hs 166 -shiftHere :: (Ord a, Eq s, Eq i) => a -> XMonad.StackSet i l a s sd -> XMonad.StackSet i l a s sd +shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd hunk ./TagWindows.hs 169 -shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> XMonad.StackSet i l a s sd -> XMonad.StackSet i l a s sd +shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd hunk ./ThreeColumns.hs 25 -import Layouts ( Resize(..), IncMasterN(..), splitVertically, splitHorizontallyBy ) +import XMonad.Layouts ( Resize(..), IncMasterN(..), splitVertically, splitHorizontallyBy ) replace ./ThreeColumns.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./TilePrime.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./TilePrime.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet hunk ./TwoPane.hs 26 -import Layouts ( Resize(..), splitHorizontallyBy ) +import XMonad.Layouts ( Resize(..), splitHorizontallyBy ) replace ./TwoPane.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./Warp.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./Warp.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet hunk ./Warp.hs 70 - (XMonad.StackSet {current = x, visible = xs}) <- gets windowset + (StackSet {current = x, visible = xs}) <- gets windowset replace ./WindowBringer.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./WindowBringer.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./WindowNavigation.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./WindowNavigation.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./WindowPrompt.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./WindowPrompt.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./WorkspaceDir.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./WorkspacePrompt.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./XPrompt.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./XPrompt.hs [A-Za-z_0-9\-\.] StackSet XMonad.StackSet replace ./XPropManage.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations replace ./XUtils.hs [A-Za-z_0-9\-\.] Operations XMonad.Operations adddir ./Layout move ./Accordion.hs ./Layout/Accordion.hs move ./Circle.hs ./Layout/Circle.hs move ./Combo.hs ./Layout/Combo.hs move ./Dishes.hs ./Layout/Dishes.hs move ./DragPane.hs ./Layout/DragPane.hs move ./Grid.hs ./Layout/Grid.hs move ./LayoutCombinators.hs ./Layout/LayoutCombinators.hs move ./LayoutHints.hs ./Layout/LayoutHints.hs move ./LayoutModifier.hs ./Layout/LayoutModifier.hs move ./LayoutScreens.hs ./Layout/LayoutScreens.hs move ./MagicFocus.hs ./Layout/MagicFocus.hs move ./Magnifier.hs ./Layout/Magnifier.hs move ./Maximize.hs ./Layout/Maximize.hs move ./Mosaic.hs ./Layout/Mosaic.hs move ./MosaicAlt.hs ./Layout/MosaicAlt.hs move ./NoBorders.hs ./Layout/NoBorders.hs move ./ResizableTile.hs ./Layout/ResizableTile.hs move ./Roledex.hs ./Layout/Roledex.hs move ./Spiral.hs ./Layout/Spiral.hs move ./Square.hs ./Layout/Square.hs move ./SwitchTrans.hs ./Layout/SwitchTrans.hs move ./Tabbed.hs ./Layout/Tabbed.hs move ./ThreeColumns.hs ./Layout/ThreeColumns.hs move ./TilePrime.hs ./Layout/TilePrime.hs move ./ToggleLayouts.hs ./Layout/ToggleLayouts.hs move ./TwoPane.hs ./Layout/TwoPane.hs move ./WindowNavigation.hs ./Layout/WindowNavigation.hs adddir ./XMonad move ./Layout ./XMonad/Layout adddir ./XMonad/Util move ./Anneal.hs ./XMonad/Util/Anneal.hs move ./Invisible.hs ./XMonad/Util/Invisible.hs move ./NamedWindows.hs ./XMonad/Util/NamedWindows.hs move ./Run.hs ./XMonad/Util/Run.hs move ./XPrompt.hs ./XMonad/Prompt.hs move ./XSelection.hs ./XMonad/Util/XSelection.hs move ./XUtils.hs ./XMonad/Util/XUtils.hs adddir ./XMonad/Prompt move ./DirectoryPrompt.hs ./XMonad/Prompt/Directory.hs move ./Dmenu.hs ./XMonad/Util/Dmenu.hs move ./HintedTile.hs ./XMonad/Layout/HintedTile.hs move ./ManPrompt.hs ./XMonad/Prompt/Man.hs move ./ShellPrompt.hs ./XMonad/Prompt/Shell.hs move ./SshPrompt.hs ./XMonad/Prompt/Ssh.hs move ./WorkspacePrompt.hs ./XMonad/Prompt/Workspace.hs move ./XMonadPrompt.hs ./XMonad/Prompt/XMonad.hs adddir ./XMonad/Hooks move ./DynamicLog.hs ./XMonad/Hooks/DynamicLog.hs move ./EwmhDesktops.hs ./XMonad/Hooks/EwmhDesktops move ./ManageDocks.hs ./XMonad/Hooks/ManageDocks.hs move ./UrgencyHook.hs ./XMonad/Hooks/UrgencyHook.hs move ./XPropManage.hs ./XMonad/Hooks/XPropManage.hs adddir ./XMonad/Actions move ./Commands.hs ./XMonad/Actions/Commands.hs move ./ConstrainedResize.hs ./XMonad/Actions/ConstrainedResize.hs move ./CopyWindow.hs ./XMonad/Actions/CopyWindow.hs move ./CycleWS.hs ./XMonad/Actions/CycleWS.hs move ./DeManage.hs ./XMonad/Actions/DeManage.hs move ./DwmPromote.hs ./XMonad/Actions/DwmPromote.hs move ./DynamicWorkspaces.hs ./XMonad/Actions/DynamicWorkspaces.hs move ./Dzen.hs ./XMonad/Util/Dzen.hs move ./FindEmptyWorkspace.hs ./XMonad/Actions/FindEmptyWorkspace.hs move ./FlexibleManipulate.hs ./XMonad/Actions/FlexibleManipulate.hs move ./FlexibleResize.hs ./XMonad/Actions/FlexibleResize.hs move ./FloatKeys.hs ./XMonad/Actions/FloatKeys.hs move ./FocusNth.hs ./XMonad/Actions/FocusNth.hs move ./MouseGestures.hs ./XMonad/Actions/MouseGestures.hs move ./RotSlaves.hs ./XMonad/Actions/RotSlaves.hs move ./RotView.hs ./XMonad/Actions/RotView.hs move ./SetWMName.hs ./XMonad/Hooks/SetWMName.hs move ./SimpleDate.hs ./XMonad/Actions/SimpleDate.hs move ./SinkAll.hs ./XMonad/Actions/SinkAll.hs move ./Submap.hs ./XMonad/Actions/Submap.hs move ./SwapWorkspaces.hs ./XMonad/Actions/SwapWorkspaces.hs move ./TagWindows.hs ./XMonad/Actions/TagWindows.hs move ./Warp.hs ./XMonad/Actions/Warp.hs move ./WindowBringer.hs ./XMonad/Actions/WindowBringer.hs move ./WindowPrompt.hs ./XMonad/Prompt/Window.hs move ./WmiiActions.hs ./XMonad/Actions/WmiiActions.hs move ./WorkspaceDir.hs ./XMonad/Layout/WorkspaceDir.hs replace ./MetaModule.hs [A-Za-z_0-9] XMonadContrib XMonad replace ./XMonad/Util/Anneal.hs [A-Za-z_0-9] XMonadContrib XMonad replace ./XMonad/Util/Invisible.hs [A-Za-z_0-9] XMonadContrib XMonad replace ./tests/test_SwapWorkspaces.hs [A-Za-z_0-9] XMonadContrib XMonad replace ./tests/test_XPrompt.hs [A-Za-z_0-9] XMonadContrib XMonad hunk ./MetaModule.hs 26 -import XMonad.Combo () -- broken under ghc head +-- import XMonad.Combo () -- broken under ghc head hunk ./MetaModule.hs 48 -import XMonad.LayoutCombinators () +-- import XMonad.LayoutCombinators () hunk ./MetaModule.hs 50 -import XMonad.LayoutHints () +-- import XMonad.LayoutHints () hunk ./MetaModule.hs 53 -import XMonad.ManageDocks () +-- import XMonad.ManageDocks () hunk ./MetaModule.hs 76 -import XMonad.SwitchTrans () +-- import XMonad.SwitchTrans () hunk ./MetaModule.hs 80 -import XMonad.TilePrime () +-- import XMonad.TilePrime () hunk ./XMonad/Actions/Commands.hs 3 --- Module : XMonadContrib.Commands +-- Module : XMonad.Actions.Commands hunk ./XMonad/Actions/Commands.hs 13 --- the Dmenu XMonadContrib module. +-- the Dmenu XMonad.Actions module. hunk ./XMonad/Actions/Commands.hs 17 -module XMonadContrib.Commands ( +module XMonad.Actions.Commands ( hunk ./XMonad/Actions/Commands.hs 31 -import XMonadContrib.Dmenu (dmenu) +import XMonad.Util.Dmenu (dmenu) hunk ./XMonad/Actions/Commands.hs 43 --- > import XMonadContrib.Commands +-- > import XMonad.Actions.Commands hunk ./XMonad/Actions/Commands.hs 61 --- %import XMonadContrib.Commands +-- %import XMonad.Actions.Commands hunk ./XMonad/Actions/ConstrainedResize.hs 3 --- Module : XMonadContrib.ConstrainedResize +-- Module : XMonad.Actions.ConstrainedResize hunk ./XMonad/Actions/ConstrainedResize.hs 18 -module XMonadContrib.ConstrainedResize ( +module XMonad.Actions.ConstrainedResize ( hunk ./XMonad/Actions/ConstrainedResize.hs 21 - XMonadContrib.ConstrainedResize.mouseResizeWindow + XMonad.Actions.ConstrainedResize.mouseResizeWindow hunk ./XMonad/Actions/ConstrainedResize.hs 32 --- > import qualified XMonadContrib.ConstrainedResize as Sqr +-- > import qualified XMonad.Actions.ConstrainedResize as Sqr hunk ./XMonad/Actions/ConstrainedResize.hs 41 --- %import qualified XMonadContrib.ConstrainedResize as Sqr +-- %import qualified XMonad.Actions.ConstrainedResize as Sqr hunk ./XMonad/Actions/CopyWindow.hs 3 --- Module : XMonadContrib.CopyWindow +-- Module : XMonad.Actions.CopyWindow hunk ./XMonad/Actions/CopyWindow.hs 16 -module XMonadContrib.CopyWindow ( +module XMonad.Actions.CopyWindow ( hunk ./XMonad/Actions/CopyWindow.hs 32 --- > import XMonadContrib.CopyWindow +-- > import XMonad.Actions.CopyWindow hunk ./XMonad/Actions/CopyWindow.hs 46 --- %import XMonadContrib.CopyWindow +-- %import XMonad.Actions.CopyWindow hunk ./XMonad/Actions/CycleWS.hs 3 --- Module : XMonadContrib.CycleWS +-- Module : XMonad.Actions.CycleWS hunk ./XMonad/Actions/CycleWS.hs 17 -module XMonadContrib.CycleWS ( +module XMonad.Actions.CycleWS ( hunk ./XMonad/Actions/CycleWS.hs 41 --- > import XMonadContrib.CycleWS +-- > import XMonad.Actions.CycleWS hunk ./XMonad/Actions/CycleWS.hs 55 --- %import XMonadContrib.CycleWS +-- %import XMonad.Actions.CycleWS hunk ./XMonad/Actions/DeManage.hs 3 --- Module : XMonadContrib.DeManage +-- Module : XMonad.Actions.DeManage hunk ./XMonad/Actions/DeManage.hs 28 -module XMonadContrib.DeManage ( +module XMonad.Actions.DeManage ( hunk ./XMonad/Actions/DeManage.hs 43 --- > import XMonadContrib.DeManage +-- > import XMonad.Actions.DeManage hunk ./XMonad/Actions/DeManage.hs 50 --- %import XMonadContrib.DeManage +-- %import XMonad.Actions.DeManage hunk ./XMonad/Actions/DwmPromote.hs 3 --- Module : XMonadContrib.DwmPromote +-- Module : XMonad.Actions.DwmPromote hunk ./XMonad/Actions/DwmPromote.hs 19 -module XMonadContrib.DwmPromote ( +module XMonad.Actions.DwmPromote ( hunk ./XMonad/Actions/DwmPromote.hs 33 --- > import XMonadContrib.DwmPromote +-- > import XMonad.Actions.DwmPromote hunk ./XMonad/Actions/DwmPromote.hs 39 --- %import XMonadContrib.DwmPromote +-- %import XMonad.Actions.DwmPromote hunk ./XMonad/Actions/DynamicWorkspaces.hs 3 --- Module : XMonadContrib.DynamicWorkspaces +-- Module : XMonad.Actions.DynamicWorkspaces hunk ./XMonad/Actions/DynamicWorkspaces.hs 16 -module XMonadContrib.DynamicWorkspaces ( +module XMonad.Actions.DynamicWorkspaces ( hunk ./XMonad/Actions/DynamicWorkspaces.hs 31 -import XMonadContrib.WorkspacePrompt -import XMonadContrib.XPrompt ( XPConfig ) +import XMonad.Prompt.Workspace +import XMonad.Prompt ( XPConfig ) hunk ./XMonad/Actions/DynamicWorkspaces.hs 37 --- > import XMonadContrib.DynamicWorkspaces +-- > import XMonad.Actions.DynamicWorkspaces hunk ./XMonad/Actions/FindEmptyWorkspace.hs 3 --- Module : XMonadContrib.FindEmptyWorkspace +-- Module : XMonad.Actions.FindEmptyWorkspace hunk ./XMonad/Actions/FindEmptyWorkspace.hs 15 -module XMonadContrib.FindEmptyWorkspace ( +module XMonad.Actions.FindEmptyWorkspace ( hunk ./XMonad/Actions/FindEmptyWorkspace.hs 34 --- > import XMonadContrib.FindEmptyWorkspace +-- > import XMonad.Actions.FindEmptyWorkspace hunk ./XMonad/Actions/FindEmptyWorkspace.hs 44 --- %import XMonadContrib.FindEmptyWorkspace +-- %import XMonad.Actions.FindEmptyWorkspace hunk ./XMonad/Actions/FlexibleManipulate.hs 5 --- Module : XMonadContrib.FlexibleManipulate +-- Module : XMonad.Actions.FlexibleManipulate hunk ./XMonad/Actions/FlexibleManipulate.hs 19 -module XMonadContrib.FlexibleManipulate ( +module XMonad.Actions.FlexibleManipulate ( hunk ./XMonad/Actions/FlexibleManipulate.hs 33 --- > import qualified XMonadContrib.FlexibleManipulate as Flex +-- > import qualified XMonad.Actions.FlexibleManipulate as Flex hunk ./XMonad/Actions/FlexibleManipulate.hs 52 --- %import qualified XMonadContrib.FlexibleManipulate as Flex +-- %import qualified XMonad.Actions.FlexibleManipulate as Flex hunk ./XMonad/Actions/FlexibleResize.hs 3 --- Module : XMonadContrib.FlexibleResize +-- Module : XMonad.Actions.FlexibleResize hunk ./XMonad/Actions/FlexibleResize.hs 15 -module XMonadContrib.FlexibleResize ( +module XMonad.Actions.FlexibleResize ( hunk ./XMonad/Actions/FlexibleResize.hs 18 - XMonadContrib.FlexibleResize.mouseResizeWindow + XMonad.Actions.FlexibleResize.mouseResizeWindow hunk ./XMonad/Actions/FlexibleResize.hs 30 --- > import qualified XMonadContrib.FlexibleResize as Flex +-- > import qualified XMonad.Actions.FlexibleResize as Flex hunk ./XMonad/Actions/FlexibleResize.hs 35 --- %import qualified XMonadContrib.FlexibleResize as Flex +-- %import qualified XMonad.Actions.FlexibleResize as Flex hunk ./XMonad/Actions/FloatKeys.hs 3 --- Module : XMonadContrib.FloatKeys +-- Module : XMonad.Actions.FloatKeys hunk ./XMonad/Actions/FloatKeys.hs 14 -module XMonadContrib.FloatKeys ( +module XMonad.Actions.FloatKeys ( hunk ./XMonad/Actions/FloatKeys.hs 28 --- > import XMonadContrib.FloatKeys +-- > import XMonad.Actions.FloatKeys hunk ./XMonad/Actions/FocusNth.hs 3 --- Module : XMonadContrib.FocusNth +-- Module : XMonad.Actions.FocusNth hunk ./XMonad/Actions/FocusNth.hs 14 -module XMonadContrib.FocusNth ( +module XMonad.Actions.FocusNth ( hunk ./XMonad/Actions/FocusNth.hs 24 --- > import XMonadContrib.FocusNth +-- > import XMonad.Actions.FocusNth hunk ./XMonad/Actions/FocusNth.hs 30 --- %import XMonadContrib.FocusNth +-- %import XMonad.Actions.FocusNth hunk ./XMonad/Actions/MouseGestures.hs 3 --- Module : XMonadContrib.MouseGestures +-- Module : XMonad.Actions.MouseGestures hunk ./XMonad/Actions/MouseGestures.hs 15 -module XMonadContrib.MouseGestures ( +module XMonad.Actions.MouseGestures ( hunk ./XMonad/Actions/MouseGestures.hs 37 --- > import XMonadContrib.MouseGestures +-- > import XMonad.Actions.MouseGestures hunk ./XMonad/Actions/RotSlaves.hs 3 --- Module : XMonadContrib.RotSlaves +-- Module : XMonad.Actions.RotSlaves hunk ./XMonad/Actions/RotSlaves.hs 14 -module XMonadContrib.RotSlaves ( +module XMonad.Actions.RotSlaves ( hunk ./XMonad/Actions/RotSlaves.hs 28 --- > import XMonadContrib.RotSlaves +-- > import XMonad.Actions.RotSlaves hunk ./XMonad/Actions/RotSlaves.hs 36 --- stays where it is. It is useful together with the TwoPane-Layout (see XMonadContrib.TwoPane). +-- stays where it is. It is useful together with the TwoPane-Layout (see XMonad.Actions.TwoPane). hunk ./XMonad/Actions/RotSlaves.hs 38 --- %import XMonadContrib.RotSlaves +-- %import XMonad.Actions.RotSlaves hunk ./XMonad/Actions/RotView.hs 3 --- Module : XMonadContrib.RotView +-- Module : XMonad.Actions.RotView hunk ./XMonad/Actions/RotView.hs 15 -module XMonadContrib.RotView ( +module XMonad.Actions.RotView ( hunk ./XMonad/Actions/RotView.hs 33 --- > import XMonadContrib.RotView +-- > import XMonad.Actions.RotView hunk ./XMonad/Actions/RotView.hs 38 --- %import XMonadContrib.RotView +-- %import XMonad.Actions.RotView hunk ./XMonad/Actions/SimpleDate.hs 3 --- Module : XMonadContrib.SimpleDate +-- Module : XMonad.Actions.SimpleDate hunk ./XMonad/Actions/SimpleDate.hs 16 -module XMonadContrib.SimpleDate ( +module XMonad.Actions.SimpleDate ( hunk ./XMonad/Actions/SimpleDate.hs 27 --- > import XMonadContrib.SimpleDate +-- > import XMonad.Actions.SimpleDate hunk ./XMonad/Actions/SimpleDate.hs 35 --- %import XMonadContrib.SimpleDate +-- %import XMonad.Actions.SimpleDate hunk ./XMonad/Actions/SinkAll.hs 12 -module XMonadContrib.SinkAll ( +module XMonad.Actions.SinkAll ( hunk ./XMonad/Actions/SinkAll.hs 24 --- > import XMonadContrib.SinkAll +-- > import XMonad.Actions.SinkAll hunk ./XMonad/Actions/SinkAll.hs 27 --- %import XMonadContrib.SinkAll +-- %import XMonad.Actions.SinkAll hunk ./XMonad/Actions/Submap.hs 3 --- Module : XMonadContrib.Submap +-- Module : XMonad.Actions.Submap hunk ./XMonad/Actions/Submap.hs 15 -module XMonadContrib.Submap ( +module XMonad.Actions.Submap ( hunk ./XMonad/Actions/Submap.hs 46 --- %import XMonadContrib.Submap +-- %import XMonad.Actions.Submap hunk ./XMonad/Actions/SwapWorkspaces.hs 3 --- Module : XMonadContrib.SwapWorkspaces +-- Module : XMonad.Actions.SwapWorkspaces hunk ./XMonad/Actions/SwapWorkspaces.hs 16 -module XMonadContrib.SwapWorkspaces ( +module XMonad.Actions.SwapWorkspaces ( hunk ./XMonad/Actions/SwapWorkspaces.hs 28 --- > import XMonadContrib.SwapWorkspaces +-- > import XMonad.Actions.SwapWorkspaces hunk ./XMonad/Actions/SwapWorkspaces.hs 36 --- %import XMonadContrib.SwapWorkspaces +-- %import XMonad.Actions.SwapWorkspaces hunk ./XMonad/Actions/TagWindows.hs 3 --- Module : XMonadContrib.TagWindows +-- Module : XMonad.Actions.TagWindows hunk ./XMonad/Actions/TagWindows.hs 14 -module XMonadContrib.TagWindows ( +module XMonad.Actions.TagWindows ( hunk ./XMonad/Actions/TagWindows.hs 37 -import XMonadContrib.XPrompt +import XMonad.Prompt hunk ./XMonad/Actions/TagWindows.hs 44 --- > import XMonadContrib.TagWindows --- > import XMonadContrib.XPrompt -- to use tagPrompt +-- > import XMonad.Actions.TagWindows +-- > import XMonad.Prompt -- to use tagPrompt hunk ./XMonad/Actions/TagWindows.hs 65 --- %import XMonadContrib.TagWindows --- %import XMonadContrib.XPrompt -- to use tagPrompt +-- %import XMonad.Actions.TagWindows +-- %import XMonad.Prompt -- to use tagPrompt hunk ./XMonad/Actions/Warp.hs 3 --- Module : XMonadContrib.Warp +-- Module : XMonad.Actions.Warp hunk ./XMonad/Actions/Warp.hs 16 -module XMonadContrib.Warp ( +module XMonad.Actions.Warp ( hunk ./XMonad/Actions/Warp.hs 47 --- %import XMonadContrib.Warp +-- %import XMonad.Actions.Warp hunk ./XMonad/Actions/WindowBringer.hs 3 --- Module : XMonadContrib.WindowBringer +-- Module : XMonad.Actions.WindowBringer hunk ./XMonad/Actions/WindowBringer.hs 17 -module XMonadContrib.WindowBringer ( +module XMonad.Actions.WindowBringer ( hunk ./XMonad/Actions/WindowBringer.hs 32 -import XMonadContrib.Dmenu (dmenuMap) -import XMonadContrib.NamedWindows (getName) +import XMonad.Util.Dmenu (dmenuMap) +import XMonad.Util.NamedWindows (getName) hunk ./XMonad/Actions/WindowBringer.hs 39 --- > import XMonadContrib.WindowBringer +-- > import XMonad.Actions.WindowBringer hunk ./XMonad/Actions/WindowBringer.hs 46 --- %import XMonadContrib.WindowBringer +-- %import XMonad.Actions.WindowBringer hunk ./XMonad/Actions/WmiiActions.hs 3 --- Module : XMonadContrib.WmiiActions +-- Module : XMonad.Actions.WmiiActions hunk ./XMonad/Actions/WmiiActions.hs 19 -module XMonadContrib.WmiiActions ( +module XMonad.Actions.WmiiActions ( hunk ./XMonad/Actions/WmiiActions.hs 29 -import XMonadContrib.Dmenu (dmenu, dmenuXinerama) -import XMonadContrib.Run (runProcessWithInput) +import XMonad.Util.Dmenu (dmenu, dmenuXinerama) +import XMonad.Util.Run (runProcessWithInput) hunk ./XMonad/Actions/WmiiActions.hs 39 --- > import XMonadContrib.WmiiActions +-- > import XMonad.Actions.WmiiActions hunk ./XMonad/Actions/WmiiActions.hs 50 --- information see "XMonadContrib.Dmenu" extension). +-- information see "XMonad.Util.Dmenu" extension). hunk ./XMonad/Hooks/DynamicLog.hs 3 --- Module : XMonadContrib.DynamicLog +-- Module : XMonad.Hooks.DynamicLog hunk ./XMonad/Hooks/DynamicLog.hs 21 -module XMonadContrib.DynamicLog ( +module XMonad.Hooks.DynamicLog ( hunk ./XMonad/Hooks/DynamicLog.hs 47 -import XMonadContrib.NamedWindows +import XMonad.Util.NamedWindows hunk ./XMonad/Hooks/DynamicLog.hs 53 --- > import XMonadContrib.DynamicLog +-- > import XMonad.Hooks.DynamicLog hunk ./XMonad/Hooks/DynamicLog.hs 56 --- %import XMonadContrib.DynamicLog +-- %import XMonad.Hooks.DynamicLog hunk ./XMonad/Hooks/ManageDocks.hs 3 --- Module : XMonadContrib.ManageDocks +-- Module : XMonad.Hooks.ManageDocks hunk ./XMonad/Hooks/ManageDocks.hs 19 -module XMonadContrib.ManageDocks ( +module XMonad.Hooks.ManageDocks ( hunk ./XMonad/Hooks/ManageDocks.hs 40 --- > import XMonadContrib.ManageDocks +-- > import XMonad.Hooks.ManageDocks hunk ./XMonad/Hooks/ManageDocks.hs 50 --- %import XMonadContrib.ManageDocks +-- %import XMonad.Hooks.ManageDocks hunk ./XMonad/Hooks/SetWMName.hs 3 --- Module : XMonadContrib.SetWMName +-- Module : XMonad.Hooks.SetWMName hunk ./XMonad/Hooks/SetWMName.hs 35 -module XMonadContrib.SetWMName ( +module XMonad.Hooks.SetWMName ( hunk ./XMonad/Hooks/UrgencyHook.hs 5 --- Module : XMonadContrib.UrgencyHook +-- Module : XMonad.Hooks.UrgencyHook hunk ./XMonad/Hooks/UrgencyHook.hs 19 -module XMonadContrib.UrgencyHook ( +module XMonad.Hooks.UrgencyHook ( hunk ./XMonad/Hooks/UrgencyHook.hs 32 -import XMonadContrib.LayoutModifier +import XMonad.Layout.LayoutModifier hunk ./XMonad/Hooks/UrgencyHook.hs 48 --- > import XMonadContrib.UrgencyHook +-- > import XMonad.Hooks.UrgencyHook hunk ./XMonad/Hooks/UrgencyHook.hs 61 --- > import XMonadContrib.Dzen +-- > import XMonad.Util.Dzen hunk ./XMonad/Hooks/XPropManage.hs 3 --- Module : XMonadContrib.XPropManage +-- Module : XMonad.Hooks.XPropManage hunk ./XMonad/Hooks/XPropManage.hs 14 -module XMonadContrib.XPropManage ( +module XMonad.Hooks.XPropManage ( hunk ./XMonad/Hooks/XPropManage.hs 33 --- > import XMonadContrib.XPropManage +-- > import XMonad.Hooks.XPropManage hunk ./XMonad/Layout/Accordion.hs 5 --- Module : XMonadContrib.Accordion +-- Module : XMonad.Layout.Accordion hunk ./XMonad/Layout/Accordion.hs 17 -module XMonadContrib.Accordion ( +module XMonad.Layout.Accordion ( hunk ./XMonad/Layout/Accordion.hs 29 --- > import XMonadContrib.Accordion +-- > import XMonad.Layout.Accordion hunk ./XMonad/Layout/Accordion.hs 32 --- %import XMonadContrib.Accordion +-- %import XMonad.Layout.Accordion hunk ./XMonad/Layout/Circle.hs 5 --- Module : XMonadContrib.Circle +-- Module : XMonad.Layout.Circle hunk ./XMonad/Layout/Circle.hs 17 -module XMonadContrib.Circle ( +module XMonad.Layout.Circle ( hunk ./XMonad/Layout/Circle.hs 31 --- > import XMonadContrib.Circle +-- > import XMonad.Layout.Circle hunk ./XMonad/Layout/Circle.hs 34 --- %import XMonadContrib.Circle +-- %import XMonad.Layout.Circle hunk ./XMonad/Layout/Combo.hs 5 --- Module : XMonadContrib.Combo +-- Module : XMonad.Layout.Combo hunk ./XMonad/Layout/Combo.hs 17 -module XMonadContrib.Combo ( +module XMonad.Layout.Combo ( hunk ./XMonad/Layout/Combo.hs 29 -import XMonadContrib.Invisible -import XMonadContrib.WindowNavigation ( MoveWindowToWindow(..) ) +import XMonad.Util.Invisible +import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) ) hunk ./XMonad/Layout/Combo.hs 37 --- > import XMonadContrib.Combo +-- > import XMonad.Layout.Combo hunk ./XMonad/Layout/Combo.hs 65 --- %import XMonadContrib.Combo +-- %import XMonad.Layout.Combo hunk ./XMonad/Layout/Dishes.hs 5 --- Module : XMonadContrib.Dishes +-- Module : XMonad.Layout.Dishes hunk ./XMonad/Layout/Dishes.hs 18 -module XMonadContrib.Dishes ( +module XMonad.Layout.Dishes ( hunk ./XMonad/Layout/Dishes.hs 34 --- > import XMonadContrib.Dishes +-- > import XMonad.Layout.Dishes hunk ./XMonad/Layout/Dishes.hs 40 --- %import XMonadContrib.Dishes +-- %import XMonad.Layout.Dishes hunk ./XMonad/Layout/DragPane.hs 6 --- Module : XMonadContrib.DragPane +-- Module : XMonad.Layout.DragPane hunk ./XMonad/Layout/DragPane.hs 24 -module XMonadContrib.DragPane ( +module XMonad.Layout.DragPane ( hunk ./XMonad/Layout/DragPane.hs 40 -import XMonadContrib.Invisible -import XMonadContrib.XUtils +import XMonad.Util.Invisible +import XMonad.Util.XUtils hunk ./XMonad/Layout/DragPane.hs 47 --- > import XMonadContrib.DragPane +-- > import XMonad.Layout.DragPane hunk ./XMonad/Layout/Grid.hs 5 --- Module : XMonadContrib.Grid +-- Module : XMonad.Layout.Grid hunk ./XMonad/Layout/Grid.hs 17 -module XMonadContrib.Grid ( +module XMonad.Layout.Grid ( hunk ./XMonad/Layout/Grid.hs 30 --- > import XMonadContrib.Grid +-- > import XMonad.Layout.Grid hunk ./XMonad/Layout/Grid.hs 36 --- %import XMonadContrib.Grid +-- %import XMonad.Layout.Grid hunk ./XMonad/Layout/HintedTile.hs 3 --- Module : XMonadContrib.HintedTile +-- Module : XMonad.Layout.HintedTile hunk ./XMonad/Layout/HintedTile.hs 16 -module XMonadContrib.HintedTile ( +module XMonad.Layout.HintedTile ( hunk ./XMonad/Layout/HintedTile.hs 32 --- > import qualified XMonadContrib.HintedTile +-- > import qualified XMonad.Layout.HintedTile hunk ./XMonad/Layout/HintedTile.hs 34 --- > layouts = [ XMonadContrib.HintedTile.tall nmaster delta ratio, ... ] +-- > layouts = [ XMonad.Layout.HintedTile.tall nmaster delta ratio, ... ] hunk ./XMonad/Layout/HintedTile.hs 36 --- %import qualified XMonadContrib.HintedTile +-- %import qualified XMonad.Layout.HintedTile hunk ./XMonad/Layout/HintedTile.hs 38 --- %layout , XMonadContrib.HintedTile.tall nmaster delta ratio +-- %layout , XMonad.Layout.HintedTile.tall nmaster delta ratio hunk ./XMonad/Layout/LayoutCombinators.hs 6 --- Module : XMonadContrib.LayoutCombinators +-- Module : XMonad.Layout.LayoutCombinators hunk ./XMonad/Layout/LayoutCombinators.hs 17 -module XMonadContrib.LayoutCombinators ( +module XMonad.Layout.LayoutCombinators ( hunk ./XMonad/Layout/LayoutCombinators.hs 27 -import XMonadContrib.Combo -import XMonadContrib.DragPane +import XMonad.Layout.Combo +import XMonad.Layout.DragPane hunk ./XMonad/Layout/LayoutHints.hs 5 --- Module : XMonadContrib.LayoutHints +-- Module : XMonad.Layout.LayoutHints hunk ./XMonad/Layout/LayoutHints.hs 16 -module XMonadContrib.LayoutHints ( +module XMonad.Layout.LayoutHints ( hunk ./XMonad/Layout/LayoutHints.hs 27 -import XMonadContrib.LayoutModifier +import XMonad.Layout.LayoutModifier hunk ./XMonad/Layout/LayoutHints.hs 30 --- > import XMonadContrib.LayoutHints +-- > import XMonad.Layout.LayoutHints hunk ./XMonad/Layout/LayoutHints.hs 33 --- %import XMonadContrib.LayoutHints +-- %import XMonad.Layout.LayoutHints hunk ./XMonad/Layout/LayoutModifier.hs 6 --- Module : XMonadContrib.LayoutModifier +-- Module : XMonad.Layout.LayoutModifier hunk ./XMonad/Layout/LayoutModifier.hs 17 -module XMonadContrib.LayoutModifier ( +module XMonad.Layout.LayoutModifier ( hunk ./XMonad/Layout/LayoutScreens.hs 5 --- Module : XMonadContrib.LayoutScreens +-- Module : XMonad.Layout.LayoutScreens hunk ./XMonad/Layout/LayoutScreens.hs 15 -module XMonadContrib.LayoutScreens ( +module XMonad.Layout.LayoutScreens ( hunk ./XMonad/Layout/LayoutScreens.hs 40 --- > import XMonadContrib.LayoutScreens +-- > import XMonad.Layout.LayoutScreens hunk ./XMonad/Layout/LayoutScreens.hs 49 --- > import XMonadContrib.LayoutScreens +-- > import XMonad.Layout.LayoutScreens hunk ./XMonad/Layout/LayoutScreens.hs 55 --- %import XMonadContrib.LayoutScreens +-- %import XMonad.Layout.LayoutScreens hunk ./XMonad/Layout/MagicFocus.hs 5 --- Module : XMonadContrib.MagicFocus +-- Module : XMonad.Layout.MagicFocus hunk ./XMonad/Layout/MagicFocus.hs 16 -module XMonadContrib.MagicFocus +module XMonad.Layout.MagicFocus hunk ./XMonad/Layout/MagicFocus.hs 27 --- > import XMonadContrib.MagicFocus +-- > import XMonad.Layout.MagicFocus hunk ./XMonad/Layout/MagicFocus.hs 30 --- %import XMonadContrib.MagicFocus +-- %import XMonad.Layout.MagicFocus hunk ./XMonad/Layout/Magnifier.hs 5 --- Module : XMonadContrib.Magnifier +-- Module : XMonad.Layout.Magnifier hunk ./XMonad/Layout/Magnifier.hs 20 -module XMonadContrib.Magnifier ( +module XMonad.Layout.Magnifier ( hunk ./XMonad/Layout/Magnifier.hs 28 -import XMonadContrib.LayoutHelpers +import XMonad.Layout.LayoutHelpers hunk ./XMonad/Layout/Magnifier.hs 31 --- > import XMonadContrib.Magnifier +-- > import XMonad.Layout.Magnifier hunk ./XMonad/Layout/Magnifier.hs 34 --- %import XMonadContrib.Magnifier +-- %import XMonad.Layout.Magnifier hunk ./XMonad/Layout/Maximize.hs 6 --- Module : XMonadContrib.Maximize +-- Module : XMonad.Layout.Maximize hunk ./XMonad/Layout/Maximize.hs 19 -module XMonadContrib.Maximize ( +module XMonad.Layout.Maximize ( hunk ./XMonad/Layout/Maximize.hs 28 -import XMonadContrib.LayoutModifier +import XMonad.Layout.LayoutModifier hunk ./XMonad/Layout/Maximize.hs 34 --- > import XMonadContrib.Maximize +-- > import XMonad.Layout.Maximize hunk ./XMonad/Layout/Maximize.hs 44 --- %import XMonadContrib.Maximize +-- %import XMonad.Layout.Maximize hunk ./XMonad/Layout/Mosaic.hs 5 --- Module : XMonadContrib.Mosaic +-- Module : XMonad.Layout.Mosaic hunk ./XMonad/Layout/Mosaic.hs 18 -module XMonadContrib.Mosaic ( +module XMonad.Layout.Mosaic ( hunk ./XMonad/Layout/Mosaic.hs 38 -import XMonadContrib.NamedWindows -import XMonadContrib.Anneal +import XMonad.Util.NamedWindows +import XMonad.Util.Anneal hunk ./XMonad/Layout/Mosaic.hs 47 --- > import XMonadContrib.Mosaic +-- > import XMonad.Layout.Mosaic hunk ./XMonad/Layout/Mosaic.hs 63 --- %import XMonadContrib.Mosaic +-- %import XMonad.Layout.Mosaic hunk ./XMonad/Layout/MosaicAlt.hs 6 --- Module : XMonadContrib.MosaicAlt +-- Module : XMonad.Layout.MosaicAlt hunk ./XMonad/Layout/MosaicAlt.hs 20 -module XMonadContrib.MosaicAlt ( +module XMonad.Layout.MosaicAlt ( hunk ./XMonad/Layout/MosaicAlt.hs 43 --- > import XMonadContrib.MosaicAlt +-- > import XMonad.Layout.MosaicAlt hunk ./XMonad/Layout/MosaicAlt.hs 57 --- %import XMonadContrib.MosaicAlt +-- %import XMonad.Layout.MosaicAlt hunk ./XMonad/Layout/NoBorders.hs 5 --- Module : XMonadContrib.NoBorders +-- Module : XMonad.Layout.NoBorders hunk ./XMonad/Layout/NoBorders.hs 20 -module XMonadContrib.NoBorders ( +module XMonad.Layout.NoBorders ( hunk ./XMonad/Layout/NoBorders.hs 33 -import XMonadContrib.LayoutModifier +import XMonad.Layout.LayoutModifier hunk ./XMonad/Layout/NoBorders.hs 40 --- > import XMonadContrib.NoBorders +-- > import XMonad.Layout.NoBorders hunk ./XMonad/Layout/NoBorders.hs 48 --- %import XMonadContrib.NoBorders +-- %import XMonad.Layout.NoBorders hunk ./XMonad/Layout/ResizableTile.hs 6 --- Module : XMonadContrib.ResizableTile +-- Module : XMonad.Layout.ResizableTile hunk ./XMonad/Layout/ResizableTile.hs 18 -module XMonadContrib.ResizableTile ( +module XMonad.Layout.ResizableTile ( hunk ./XMonad/Layout/ResizableTile.hs 35 --- > import XMonadContrib.ResizableTile +-- > import XMonad.Layout.ResizableTile hunk ./XMonad/Layout/Roledex.hs 5 --- Module : XMonadContrib.Roledex +-- Module : XMonad.Layout.Roledex hunk ./XMonad/Layout/Roledex.hs 18 -module XMonadContrib.Roledex ( +module XMonad.Layout.Roledex ( hunk ./XMonad/Layout/Roledex.hs 31 --- > import XMonadContrib.Roledex +-- > import XMonad.Layout.Roledex hunk ./XMonad/Layout/Roledex.hs 34 --- %import XMonadContrib.Roledex +-- %import XMonad.Layout.Roledex hunk ./XMonad/Layout/Spiral.hs 5 --- Module : XMonadContrib.Spiral +-- Module : XMonad.Layout.Spiral hunk ./XMonad/Layout/Spiral.hs 17 -module XMonadContrib.Spiral ( +module XMonad.Layout.Spiral ( hunk ./XMonad/Layout/Spiral.hs 36 --- > import XMonadContrib.Spiral +-- > import XMonad.Layout.Spiral hunk ./XMonad/Layout/Spiral.hs 40 --- %import XMonadContrib.Spiral +-- %import XMonad.Layout.Spiral hunk ./XMonad/Layout/Square.hs 5 --- Module : XMonadContrib.Square +-- Module : XMonad.Layout.Square hunk ./XMonad/Layout/Square.hs 16 --- "XMonadContrib.Combo". +-- "XMonad.Layout.Combo". hunk ./XMonad/Layout/Square.hs 22 -module XMonadContrib.Square ( +module XMonad.Layout.Square ( hunk ./XMonad/Layout/Square.hs 34 --- > import XMonadContrib.Square +-- > import XMonad.Layout.Square hunk ./XMonad/Layout/Square.hs 36 --- An example layout using square together with "XMonadContrib.Combo" +-- An example layout using square together with "XMonad.Layout.Combo" hunk ./XMonad/Layout/Square.hs 43 --- %import XMonadContrib.Square +-- %import XMonad.Layout.Square hunk ./XMonad/Layout/SwitchTrans.hs 5 --- Module : XMonadContrib.SwitchTrans +-- Module : XMonad.Layout.SwitchTrans hunk ./XMonad/Layout/SwitchTrans.hs 42 --- (The @noBorders@ transformer is from "XMonadContrib.NoBorders".) +-- (The @noBorders@ transformer is from "XMonad.Layout.NoBorders".) hunk ./XMonad/Layout/SwitchTrans.hs 71 -module XMonadContrib.SwitchTrans ( +module XMonad.Layout.SwitchTrans ( hunk ./XMonad/Layout/Tabbed.hs 5 --- Module : XMonadContrib.Tabbed +-- Module : XMonad.Layout.Tabbed hunk ./XMonad/Layout/Tabbed.hs 17 -module XMonadContrib.Tabbed ( +module XMonad.Layout.Tabbed ( hunk ./XMonad/Layout/Tabbed.hs 38 -import XMonadContrib.NamedWindows -import XMonadContrib.Invisible -import XMonadContrib.XUtils +import XMonad.Util.NamedWindows +import XMonad.Util.Invisible +import XMonad.Util.XUtils hunk ./XMonad/Layout/Tabbed.hs 45 --- > import XMonadContrib.Tabbed +-- > import XMonad.Layout.Tabbed hunk ./XMonad/Layout/Tabbed.hs 68 --- %import XMonadContrib.Tabbed +-- %import XMonad.Layout.Tabbed hunk ./XMonad/Layout/ThreeColumns.hs 5 --- Module : XMonadContrib.ThreeColumns +-- Module : XMonad.Layout.ThreeColumns hunk ./XMonad/Layout/ThreeColumns.hs 17 -module XMonadContrib.ThreeColumns ( +module XMonad.Layout.ThreeColumns ( hunk ./XMonad/Layout/ThreeColumns.hs 38 --- > import XMonadContrib.ThreeColumns +-- > import XMonad.Layout.ThreeColumns hunk ./XMonad/Layout/ThreeColumns.hs 44 --- %import XMonadContrib.ThreeColumns +-- %import XMonad.Layout.ThreeColumns hunk ./XMonad/Layout/TilePrime.hs 17 -module XMonadContrib.TilePrime ( +module XMonad.Layout.TilePrime ( hunk ./XMonad/Layout/TilePrime.hs 35 --- > import XMonadContrib.TilePrime +-- > import XMonad.Layout.TilePrime hunk ./XMonad/Layout/TilePrime.hs 43 --- %import XMonadContrib.TilePrime +-- %import XMonad.Layout.TilePrime hunk ./XMonad/Layout/ToggleLayouts.hs 6 --- Module : XMonadContrib.ToggleLayouts +-- Module : XMonad.Layout.ToggleLayouts hunk ./XMonad/Layout/ToggleLayouts.hs 17 -module XMonadContrib.ToggleLayouts ( +module XMonad.Layout.ToggleLayouts ( hunk ./XMonad/Layout/ToggleLayouts.hs 28 --- import XMonadContrib.ToggleLayouts +-- import XMonad.Layout.ToggleLayouts hunk ./XMonad/Layout/TwoPane.hs 5 --- Module : XMonadContrib.TwoPane +-- Module : XMonad.Layout.TwoPane hunk ./XMonad/Layout/TwoPane.hs 19 -module XMonadContrib.TwoPane ( +module XMonad.Layout.TwoPane ( hunk ./XMonad/Layout/TwoPane.hs 33 --- > import XMonadContrib.TwoPane +-- > import XMonad.Layout.TwoPane hunk ./XMonad/Layout/TwoPane.hs 39 --- %import XMonadContrib.TwoPane +-- %import XMonad.Layout.TwoPane hunk ./XMonad/Layout/WindowNavigation.hs 6 --- Module : XMonadContrib.WindowNavigation +-- Module : XMonad.Layout.WindowNavigation hunk ./XMonad/Layout/WindowNavigation.hs 18 -module XMonadContrib.WindowNavigation ( +module XMonad.Layout.WindowNavigation ( hunk ./XMonad/Layout/WindowNavigation.hs 35 -import XMonadContrib.LayoutModifier -import XMonadContrib.Invisible -import XMonadContrib.XUtils +import XMonad.Layout.LayoutModifier +import XMonad.Util.Invisible +import XMonad.Util.XUtils hunk ./XMonad/Layout/WindowNavigation.hs 42 --- > import XMonadContrib.WindowNavigation +-- > import XMonad.Layout.WindowNavigation hunk ./XMonad/Layout/WindowNavigation.hs 57 --- %import XMonadContrib.WindowNavigation +-- %import XMonad.Layout.WindowNavigation hunk ./XMonad/Layout/WorkspaceDir.hs 6 --- Module : XMonadContrib.WorkspaceDir +-- Module : XMonad.Layout.WorkspaceDir hunk ./XMonad/Layout/WorkspaceDir.hs 25 -module XMonadContrib.WorkspaceDir ( +module XMonad.Layout.WorkspaceDir ( hunk ./XMonad/Layout/WorkspaceDir.hs 36 -import XMonadContrib.Run ( runProcessWithInput ) -import XMonadContrib.XPrompt ( XPConfig ) -import XMonadContrib.DirectoryPrompt ( directoryPrompt ) -import XMonadContrib.LayoutModifier +import XMonad.Util.Run ( runProcessWithInput ) +import XMonad.Prompt ( XPConfig ) +import XMonad.Prompt.Directory ( directoryPrompt ) +import XMonad.Layout.LayoutModifier hunk ./XMonad/Layout/WorkspaceDir.hs 44 --- > import XMonadContrib.WorkspaceDir +-- > import XMonad.Layout.WorkspaceDir hunk ./XMonad/Layout/WorkspaceDir.hs 52 --- %import XMonadContrib.WorkspaceDir +-- %import XMonad.Layout.WorkspaceDir hunk ./XMonad/Prompt/Directory.hs 3 --- Module : XMonadContrib.DirectoryPrompt +-- Module : XMonad.Prompt.Directory hunk ./XMonad/Prompt/Directory.hs 15 -module XMonadContrib.DirectoryPrompt ( +module XMonad.Prompt.Directory ( hunk ./XMonad/Prompt/Directory.hs 22 -import XMonadContrib.XPrompt -import XMonadContrib.Run ( runProcessWithInput ) +import XMonad.Prompt +import XMonad.Util.Run ( runProcessWithInput ) hunk ./XMonad/Prompt/Directory.hs 26 --- For an example usage see "XMonadContrib.WorkspaceDir" +-- For an example usage see "XMonad.Layout.WorkspaceDir" hunk ./XMonad/Prompt/Man.hs 4 --- Module : XMonadContrib.ManPrompt +-- Module : XMonad.Prompt.Man hunk ./XMonad/Prompt/Man.hs 22 -module XMonadContrib.ManPrompt ( +module XMonad.Prompt.Man ( hunk ./XMonad/Prompt/Man.hs 30 -import XMonadContrib.XPrompt -import XMonadContrib.Run -import XMonadContrib.ShellPrompt (split) +import XMonad.Prompt +import XMonad.Util.Run +import XMonad.Prompt.Shell (split) hunk ./XMonad/Prompt/Man.hs 46 --- > import XMonadContrib.ManPrompt +-- > import XMonad.Prompt.ManPrompt hunk ./XMonad/Prompt/Man.hs 52 --- %import XMonadContrib.XPrompt --- %import XMonadContrib.ManPrompt +-- %import XMonad.Prompt.XPrompt +-- %import XMonad.Prompt.ManPrompt hunk ./XMonad/Prompt/Shell.hs 3 --- Module : XMonadContrib.ShellPrompt +-- Module : XMonad.Prompt.Shell hunk ./XMonad/Prompt/Shell.hs 15 -module XMonadContrib.ShellPrompt ( +module XMonad.Prompt.Shell( hunk ./XMonad/Prompt/Shell.hs 30 -import XMonadContrib.Run +import XMonad.Util.Run hunk ./XMonad/Prompt/Shell.hs 32 -import XMonadContrib.XPrompt +import XMonad.Prompt hunk ./XMonad/Prompt/Shell.hs 38 --- > import XMonadContrib.XPrompt --- > import XMonadContrib.ShellPrompt +-- > import XMonad.Prompt +-- > import XMonad.Prompt.Shell hunk ./XMonad/Prompt/Shell.hs 46 --- %import XMonadContrib.XPrompt --- %import XMonadContrib.ShellPrompt +-- %import XMonad.Prompt +-- %import XMonad.Prompt.ShellPrompt hunk ./XMonad/Prompt/Ssh.hs 3 --- Module : XMonadContrib.SshPrompt +-- Module : XMonad.Prompt.Ssh hunk ./XMonad/Prompt/Ssh.hs 15 -module XMonadContrib.SshPrompt ( +module XMonad.Prompt.Ssh( hunk ./XMonad/Prompt/Ssh.hs 22 -import XMonadContrib.Run -import XMonadContrib.XPrompt +import XMonad.Util.Run +import XMonad.Prompt hunk ./XMonad/Prompt/Ssh.hs 35 --- > import XMonadContrib.XPrompt --- > import XMonadContrib.SshPrompt +-- > import XMonad.Prompt +-- > import XMonad.Prompt.SshPrompt hunk ./XMonad/Prompt/Ssh.hs 43 --- %import XMonadContrib.XPrompt --- %import XMonadContrib.SshPrompt +-- %import XMonad.Prompt +-- %import XMonad.Prompt.SshPrompt hunk ./XMonad/Prompt/Window.hs 3 --- Module : XMonadContrib.WindowPrompt +-- Module : XMonad.Prompt.Window hunk ./XMonad/Prompt/Window.hs 17 -module XMonadContrib.WindowPrompt +module XMonad.Prompt.Window hunk ./XMonad/Prompt/Window.hs 31 -import XMonadContrib.XPrompt -import XMonadContrib.WindowBringer +import XMonad.Prompt +import XMonad.Actions.WindowBringer hunk ./XMonad/Prompt/Window.hs 41 --- > import XMonadContrib.XPrompt --- > import XMonadContrib.WindowPrompt +-- > import XMonad.Prompt +-- > import XMonad.Prompt.WindowPrompt hunk ./XMonad/Prompt/Window.hs 49 --- %import XMonadContrib.XPrompt --- %import XMonadContrib.WindowPrompt +-- %import XMonad.Prompt +-- %import XMonad.Prompt.WindowPrompt hunk ./XMonad/Prompt/Workspace.hs 3 --- Module : XMonadContrib.WorkspacePrompt +-- Module : XMonad.Prompt.Workspace hunk ./XMonad/Prompt/Workspace.hs 15 -module XMonadContrib.WorkspacePrompt ( +module XMonad.Prompt.Workspace ( hunk ./XMonad/Prompt/Workspace.hs 24 -import XMonadContrib.XPrompt +import XMonad.Prompt hunk ./XMonad/Prompt/Workspace.hs 30 --- > import XMonadContrib.WorkspacePrompt +-- > import XMonad.Prompt.WorkspacePrompt hunk ./XMonad/Prompt/XMonad.hs 3 --- Module : XMonadContrib.XMonadPrompt +-- Module : XMonad.Prompt.XMonad hunk ./XMonad/Prompt/XMonad.hs 15 -module XMonadContrib.XMonadPrompt ( +module XMonad.Prompt.XMonad ( hunk ./XMonad/Prompt/XMonad.hs 23 -import XMonadContrib.XPrompt -import XMonadContrib.Commands (defaultCommands, runCommand') +import XMonad.Prompt +import XMonad.Actions.Commands (defaultCommands, runCommand') hunk ./XMonad/Prompt/XMonad.hs 30 --- > import XMonadContrib.XPrompt --- > import XMonadContrib.XMonadPrompt +-- > import XMonad.Prompt +-- > import XMonad.Prompt.XMonad hunk ./XMonad/Prompt/XMonad.hs 38 --- %import XMonadContrib.XPrompt --- %import XMonadContrib.XMonadPrompt +-- %import XMonad.Prompt +-- %import XMonad.Prompt.XMonad hunk ./XMonad/Prompt.hs 17 -module XMonadContrib.XPrompt ( +module XMonad.Prompt ( hunk ./XMonad/Prompt.hs 49 -import XMonadContrib.XUtils -import XMonadContrib.XSelection (getSelection) +import XMonad.Util.XUtils +import XMonad.Util.XSelection (getSelection) hunk ./XMonad/Util/Anneal.hs 3 --- Module : XMonad.Anneal +-- Module : XMonad.Util.Anneal hunk ./XMonad/Util/Anneal.hs 15 -module XMonad.Anneal ( Rated(Rated), the_value, the_rating +module XMonad.Util.Anneal ( Rated(Rated), the_value, the_rating hunk ./XMonad/Util/Anneal.hs 21 --- %import XMonad.Anneal +-- %import XMonad.Util.Anneal hunk ./XMonad/Util/Dmenu.hs 3 --- Module : XMonadContrib.Dmenu +-- Module : XMonad.Util.Dmenu hunk ./XMonad/Util/Dmenu.hs 17 -module XMonadContrib.Dmenu ( +module XMonad.Util.Dmenu ( hunk ./XMonad/Util/Dmenu.hs 27 -import XMonadContrib.Run +import XMonad.Util.Run hunk ./XMonad/Util/Dmenu.hs 32 --- > import XMonadContrib.Dmenu +-- > import XMonad.Util.Dmenu hunk ./XMonad/Util/Dmenu.hs 34 --- %import XMonadContrib.Dmenu +-- %import XMonad.Util.Dmenu hunk ./XMonad/Util/Dzen.hs 3 --- Module : XMonadContrib.Dzen +-- Module : XMonad.Util.Dzen hunk ./XMonad/Util/Dzen.hs 15 -module XMonadContrib.Dzen (dzen, dzenWithArgs, dzenScreen, +module XMonad.Util.Dzen (dzen, dzenWithArgs, dzenScreen, hunk ./XMonad/Util/Dzen.hs 27 -import XMonadContrib.NamedWindows (getName) -import XMonadContrib.Run (runProcessWithInputAndWait, seconds) +import XMonad.Util.NamedWindows (getName) +import XMonad.Util.Run (runProcessWithInputAndWait, seconds) hunk ./XMonad/Util/Invisible.hs 5 --- Module : XMonad.Invisible +-- Module : XMonad.Util.Invisible hunk ./XMonad/Util/Invisible.hs 17 -module XMonad.Invisible ( +module XMonad.Util.Invisible ( hunk ./XMonad/Util/NamedWindows.hs 3 --- Module : XMonadContrib.NamedWindows +-- Module : XMonad.Util.NamedWindows hunk ./XMonad/Util/NamedWindows.hs 16 -module XMonadContrib.NamedWindows ( +module XMonad.Util.NamedWindows ( hunk ./XMonad/Util/Run.hs 3 --- Module : XMonadContrib.Run +-- Module : XMonad.Util.Run hunk ./XMonad/Util/Run.hs 12 --- It is composed of functions formerly defined in XMonadContrib.Dmenu (by --- Spenver Jannsen), XMonadContrib.Dzen (by glasser@mit.edu) and --- XMonadContrib.RunInXTerm (by Andrea Rossato). +-- It is composed of functions formerly defined in XMonad.Util.Dmenu (by +-- Spenver Jannsen), XMonad.Util.Dzen (by glasser@mit.edu) and +-- XMonad.Util.RunInXTerm (by Andrea Rossato). hunk ./XMonad/Util/Run.hs 18 -module XMonadContrib.Run ( +module XMonad.Util.Run ( hunk ./XMonad/Util/Run.hs 41 --- For an example usage of runInTerm see XMonadContrib.SshPrompt +-- For an example usage of runInTerm see XMonad.Prompt.Ssh hunk ./XMonad/Util/Run.hs 44 --- XMonadContrib.{DirectoryPrompt,Dmenu,ShellPrompt,WmiiActions,WorkspaceDir} +-- XMonad.Prompt.{DirectoryPrompt,Dmenu,ShellPrompt,WmiiActions,WorkspaceDir} hunk ./XMonad/Util/Run.hs 46 --- For an example usage of runProcessWithInputAndWait see XMonadContrib.Dzen +-- For an example usage of runProcessWithInputAndWait see XMonad.Util.Dzen hunk ./XMonad/Util/XSelection.hs 18 -module XMonadContrib.XSelection ( +module XMonad.Util.XSelection ( hunk ./XMonad/Util/XSelection.hs 41 -import XMonadContrib.Run (safeSpawn, unsafeSpawn) +import XMonad.Util.Run (safeSpawn, unsafeSpawn) hunk ./XMonad/Util/XUtils.hs 3 --- Module : XMonadContrib.XUtils +-- Module : XMonad.Util.XUtils hunk ./XMonad/Util/XUtils.hs 15 -module XMonadContrib.XUtils ( +module XMonad.Util.XUtils ( hunk ./XMonad/Actions/DynamicWorkspaces.hs 24 +import Control.Monad.Reader ( asks ) hunk ./XMonad/Actions/DynamicWorkspaces.hs 28 -import XMonad ( X, XState(..), Layout, WorkspaceId, WindowSet ) +import XMonad ( X, XState(..), Layout, WorkspaceId, WindowSet, config, layoutHook ) hunk ./XMonad/Actions/DynamicWorkspaces.hs 40 --- > , ((modMask .|. shiftMask, xK_n), selectWorkspace defaultXPConfig layoutHook) +-- > , ((modMask .|. shiftMask, xK_n), selectWorkspace defaultXPConfig) hunk ./XMonad/Actions/DynamicWorkspaces.hs 73 -selectWorkspace :: XPConfig -> Layout Window -> X () -selectWorkspace conf l = workspacePrompt conf $ \w -> - windows $ \s -> if tagMember w s - then greedyView w s - else addWorkspace' w l s +selectWorkspace :: XPConfig -> X () +selectWorkspace conf = workspacePrompt conf $ \w -> + do l <- asks (layoutHook . config) + windows $ \s -> if tagMember w s + then greedyView w s + else addWorkspace' w l s replace ./XMonad/Layout/LayoutCombinators.hs [A-Za-z_0-9\-\.] Layouts XMonad.Layouts addfile ./Setup.lhs hunk ./Setup.lhs 1 +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain addfile ./XMonadContrib.cabal hunk ./XMonadContrib.cabal 1 +name: XMonadContrib +version: 0.4 +homepage: http://xmonad.org +synopsis: third party extensions for xmonad +description: + third party extensions for xmonad +category: System +license: BSD3 +license-file: LICENSE +author: Spencer Janssen +maintainer: sjanssen@cse.unl.edu +build-depends: base>=2.0, mtl, unix, X11==1.3.0, xmonad==0.4 +extra-source-files: README scripts/generate-configs scripts/run-xmonad.sh + scripts/xinitrc scripts/xmonad-acpi.c + scripts/xmonad-clock.c tests/test_SwapWorkspaces.hs + tests/tests_XPrompt.hs +exposed-modules: XMonad.Actions.Commands + XMonad.Actions.ConstrainedResize + XMonad.Actions.CopyWindow + XMonad.Actions.CycleWS + XMonad.Actions.DeManage + XMonad.Actions.DwmPromote + XMonad.Actions.DynamicWorkspaces + XMonad.Actions.FindEmptyWorkspace + XMonad.Actions.FlexibleManipulate + XMonad.Actions.FlexibleResize + XMonad.Actions.FloatKeys + XMonad.Actions.FocusNth + XMonad.Actions.MouseGestures + XMonad.Actions.RotSlaves + XMonad.Actions.RotView + XMonad.Actions.SimpleDate + XMonad.Actions.SinkAll + XMonad.Actions.Submap + XMonad.Actions.SwapWorkspaces + XMonad.Actions.TagWindows + XMonad.Actions.Warp + XMonad.Actions.WindowBringer + XMonad.Actions.WmiiActions + XMonad.Hooks.DynamicLog + -- XMonad.Hooks.ManageDocks + XMonad.Hooks.SetWMName + -- XMonad.Hooks.UrgencyHook + XMonad.Hooks.XPropManage + XMonad.Layout.Accordion + XMonad.Layout.Circle + XMonad.Layout.Combo + XMonad.Layout.Dishes + XMonad.Layout.DragPane + XMonad.Layout.Grid + -- XMonad.Layout.HintedTile + -- XMonad.Layout.LayoutCombinators + -- XMonad.Layout.LayoutHints + XMonad.Layout.LayoutModifier + XMonad.Layout.LayoutScreens + XMonad.Layout.MagicFocus + -- XMonad.Layout.Magnifier + XMonad.Layout.Maximize + XMonad.Layout.MosaicAlt + -- XMonad.Layout.Mosaic + XMonad.Layout.NoBorders + XMonad.Layout.ResizableTile + XMonad.Layout.Roledex + XMonad.Layout.Spiral + XMonad.Layout.Square + -- XMonad.Layout.SwitchTrans + XMonad.Layout.Tabbed + XMonad.Layout.ThreeColumns + -- XMonad.Layout.TilePrime + XMonad.Layout.ToggleLayouts + XMonad.Layout.TwoPane + XMonad.Layout.WindowNavigation + XMonad.Layout.WorkspaceDir + XMonad.Prompt.Directory + XMonad.Prompt + XMonad.Prompt.Man + XMonad.Prompt.Shell + XMonad.Prompt.Ssh + XMonad.Prompt.Window + XMonad.Prompt.Workspace + XMonad.Prompt.XMonad + XMonad.Util.Anneal + XMonad.Util.Dmenu + XMonad.Util.Dzen + XMonad.Util.Invisible + XMonad.Util.NamedWindows + XMonad.Util.Run + XMonad.Util.XSelection + XMonad.Util.XUtils adddir ./configs hunk ./XMonadContrib.cabal 17 + configs/droundy.hs hunk ./XMonadContrib.cabal 92 + +executable: xmonad-droundy +main-is: configs/droundy.hs +ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s +ghc-prof-options: -prof -auto-all +extensions: GeneralizedNewtypeDeriving +-- Also requires deriving Typeable, PatternGuards + addfile ./configs/droundy.hs hunk ./configs/droundy.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : DefaultConfig.hs +-- Copyright : (c) Spencer Janssen 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : dons@galois.com +-- Stability : stable +-- Portability : portable +-- +-- This module specifies configurable defaults for xmonad. If you change +-- values here, be sure to recompile and restart (mod-q) xmonad, +-- for the changes to take effect. +-- +------------------------------------------------------------------------ + +module Main (main) where + +-- +-- Useful imports +-- +import Control.Monad.Reader ( asks ) +import XMonad hiding (workspaces, manageHook, numlockMask) +import qualified XMonad (workspaces, manageHook, numlockMask) +import XMonad.Layouts hiding ( (|||) ) +import XMonad.Operations +import qualified XMonad.StackSet as W +import Data.Ratio +import Data.Bits ((.|.)) +import qualified Data.Map as M +import System.Exit +import Graphics.X11.Xlib +import XMonad.EventLoop + +-- % Extension-provided imports + +import XMonad.Layout.Tabbed +import XMonad.Layout.Combo +import XMonad.Layout.LayoutCombinators +import XMonad.Layout.TwoPane +import XMonad.Layout.Square +import XMonad.Layout.LayoutScreens +import XMonad.Layout.WindowNavigation +import XMonad.Layout.NoBorders +import XMonad.Layout.WorkspaceDir +import XMonad.Layout.ToggleLayouts + +import XMonad.Prompt +import XMonad.Prompt.Workspace +import XMonad.Prompt.Shell + +import XMonad.Actions.CopyWindow +import XMonad.Actions.DynamicWorkspaces +import XMonad.Actions.RotView + +myXPConfig :: XPConfig +myXPConfig = defaultXPConfig {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*" + ,height=22} + +-- | The default number of workspaces (virtual screens) and their names. +-- By default we use numeric strings, but any string may be used as a +-- workspace name. The number of workspaces is determined by the length +-- of this list. +-- +-- A tagging example: +-- +-- > workspaces = ["web", "irc", "code" ] ++ map show [4..9] +-- +workspaces :: [WorkspaceId] +workspaces = ["1:mutt","2:iceweasel"] + +-- | modMask lets you specify which modkey you want to use. The default +-- is mod1Mask ("left alt"). You may also consider using mod3Mask +-- ("right alt"), which does not conflict with emacs keybindings. The +-- "windows key" is usually mod4Mask. +-- +modMask :: KeyMask +modMask = mod1Mask + +-- | The mask for the numlock key. Numlock status is "masked" from the +-- current modifier status, so the keybindings will work with numlock on or +-- off. You may need to change this on some systems. +-- +-- You can find the numlock modifier by running "xmodmap" and looking for a +-- modifier with Num_Lock bound to it: +-- +-- > $ xmodmap | grep Num +-- > mod2 Num_Lock (0x4d) +-- +-- Set numlockMask = 0 if you don't have a numlock key, or want to treat +-- numlock status separately. +-- +numlockMask :: KeyMask +numlockMask = mod2Mask + +-- | Default offset of drawable screen boundaries from each physical +-- screen. Anything non-zero here will leave a gap of that many pixels +-- on the given edge, on the that screen. A useful gap at top of screen +-- for a menu bar (e.g. 15) +-- +-- An example, to set a top gap on monitor 1, and a gap on the bottom of +-- monitor 2, you'd use a list of geometries like so: +-- +-- > defaultGaps = [(18,0,0,0),(0,18,0,0)] -- 2 gaps on 2 monitors +-- +-- Fields are: top, bottom, left, right. +-- +--defaultGaps :: [(Int,Int,Int,Int)] + + +------------------------------------------------------------------------ +-- Window rules + +-- | Execute arbitrary actions and WindowSet manipulations when managing +-- a new window. You can use this to, for example, always float a +-- particular program, or have a client always appear on a particular +-- workspace. +-- +-- To find the property name associated with a program, use +-- xprop | grep WM_CLASS +-- and click on the client you're interested in. +-- +manageHook :: Window -- ^ the new window to manage + -> String -- ^ window title + -> String -- ^ window resource name + -> String -- ^ window resource class + -> X (WindowSet -> WindowSet) + +-- Always float various programs: +manageHook w _ _ c | c `elem` floats = fmap (W.float w . snd) (floatLocation w) + where floats = ["MPlayer", "Gimp"] + +-- Desktop panels and dock apps should be ignored by xmonad: +manageHook w _ n _ | n `elem` ignore = reveal w >> return (W.delete w) + where ignore = ["gnome-panel", "desktop_window", "kicker", "kdesktop"] + +-- Automatically send Firefox windows to the "web" workspace: +-- If a workspace named "web" doesn't exist, the window will appear on the +-- current workspace. +manageHook _ _ "Gecko" _ = return $ W.shift "web" + +-- The default rule: return the WindowSet unmodified. You typically do not +-- want to modify this line. +manageHook _ _ _ _ = return id + +------------------------------------------------------------------------ +-- Extensible layouts +-- +-- You can specify and transform your layouts by modifying these values. +-- If you change layout bindings be sure to use 'mod-shift-space' after +-- restarting (with 'mod-q') to reset your layout state to the new +-- defaults, as xmonad preserves your old layout settings by default. +-- + +-- | The available layouts. Note that each layout is separated by |||, which +-- denotes layout choice. +layout = -- tiled ||| Mirror tiled ||| Full + -- Add extra layouts you want to use here: + -- % Extension-provided layouts + workspaceDir "~" $ windowNavigation $ toggleLayouts (noBorders Full) $ + (noBorders mytab) ||| + (combineTwo (Mirror $ TwoPane 0.03 0.8) mytab (combineTwo Square mytab mytab)) ||| + (mytab mytab) + where + mytab = tabbed shrinkText defaultTConf + -- default tiling algorithm partitions the screen into two panes + tiled = Tall nmaster delta ratio + + -- The default number of windows in the master pane + nmaster = 1 + + -- Default proportion of screen occupied by master pane + ratio = 1%2 + + -- Percent of screen to increment by when resizing panes + delta = 3%100 + +------------------------------------------------------------------------ +-- Key bindings: + +-- | The xmonad key bindings. Add, modify or remove key bindings here. +-- +-- (The comment formatting character is used when generating the manpage) +-- +keys :: M.Map (KeyMask, KeySym) (X ()) +keys = M.fromList $ + -- launching and killing programs + [ ((modMask .|. shiftMask, xK_Return), asks (terminal . config) >>= spawn) -- %! Launch terminal + , ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu + , ((modMask .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun + , ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window + + , ((modMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms + , ((modMask .|. shiftMask, xK_space ), setLayout $ Layout layout) -- %! Reset the layouts on the current workspace to default + + , ((modMask, xK_n ), refresh) -- %! Resize viewed windows to the correct size + + -- move focus up or down the window stack + , ((modMask, xK_Tab ), windows W.focusDown) -- %! Move focus to the next window + , ((modMask, xK_j ), windows W.focusDown) -- %! Move focus to the next window + , ((modMask, xK_k ), windows W.focusUp ) -- %! Move focus to the previous window + , ((modMask, xK_m ), windows W.focusMaster ) -- %! Move focus to the master window + + -- modifying the window order + , ((modMask, xK_Return), windows W.swapMaster) -- %! Swap the focused window and the master window + , ((modMask .|. shiftMask, xK_j ), windows W.swapDown ) -- %! Swap the focused window with the next window + , ((modMask .|. shiftMask, xK_k ), windows W.swapUp ) -- %! Swap the focused window with the previous window + + -- resizing the master/slave ratio + , ((modMask, xK_h ), sendMessage Shrink) -- %! Shrink the master area + , ((modMask, xK_l ), sendMessage Expand) -- %! Expand the master area + + -- floating layer support + , ((modMask, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling + + -- increase or decrease number of windows in the master area + , ((modMask , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area + , ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area + + -- toggle the status bar gap + , ((modMask , xK_b ), modifyGap (\i n -> let x = (defaultGaps defaultConfig ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap + + -- quit, or restart + , ((modMask .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad + , ((modMask , xK_Escape), broadcastMessage ReleaseResources >> restart Nothing True) -- %! Restart xmonad + + -- % Extension-provided key bindings + + , ((modMask .|. shiftMask, xK_z ), + layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768])) + , ((modMask .|. shiftMask .|. controlMask, xK_z), + layoutScreens 1 (fixedLayout [Rectangle 0 0 1440 900])) + , ((modMask .|. shiftMask, xK_Right), rotView True) + , ((modMask .|. shiftMask, xK_Left), rotView False) + , ((modMask, xK_Right), sendMessage $ Go R) + , ((modMask, xK_Left), sendMessage $ Go L) + , ((modMask, xK_Up), sendMessage $ Go U) + , ((modMask, xK_Down), sendMessage $ Go D) + , ((modMask .|. controlMask, xK_Right), sendMessage $ Swap R) + , ((modMask .|. controlMask, xK_Left), sendMessage $ Swap L) + , ((modMask .|. controlMask, xK_Up), sendMessage $ Swap U) + , ((modMask .|. controlMask, xK_Down), sendMessage $ Swap D) + , ((modMask .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) + , ((modMask .|. controlMask .|. shiftMask, xK_Left), sendMessage $ Move L) + , ((modMask .|. controlMask .|. shiftMask, xK_Up), sendMessage $ Move U) + , ((modMask .|. controlMask .|. shiftMask, xK_Down), sendMessage $ Move D) + + , ((0, xK_F2 ), spawn "gnome-terminal") -- %! Launch gnome-terminal + , ((0, xK_F3 ), shellPrompt myXPConfig) -- %! Launch program + , ((0, xK_F11 ), spawn "ksnapshot") -- %! Take snapshot + , ((modMask .|. shiftMask, xK_x ), changeDir myXPConfig) + , ((modMask .|. shiftMask, xK_BackSpace), removeWorkspace) + , ((modMask .|. shiftMask, xK_v ), selectWorkspace myXPConfig) + , ((modMask .|. shiftMask, xK_m ), workspacePrompt myXPConfig (windows . copy)) + , ((modMask .|. shiftMask, xK_r), renameWorkspace myXPConfig) + , ((modMask .|. controlMask, xK_space), sendMessage ToggleLayout) + , ((modMask .|. controlMask, xK_f), sendMessage (JumpToLayout "Full")) + ] +{- + ++ + -- mod-[1..9] %! Switch to workspace N + -- mod-shift-[1..9] %! Move client to workspace N + [((m .|. modMask, k), windows $ f i) + | (i, k) <- zip workspaces [xK_1 .. xK_9] + , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] + ++ + -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 + -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3 + [((m .|. modMask, key), screenWorkspace sc >>= flip whenJust (windows . f)) + | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..] + , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] +-} + + -- % Extension-provided key bindings lists + + ++ + zip (zip (repeat modMask) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..]) + ++ + zip (zip (repeat (modMask .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..]) + +-- | Mouse bindings: default actions bound to mouse events +-- +mouseBindings :: M.Map (KeyMask, Button) (Window -> X ()) +mouseBindings = M.fromList $ + -- mod-button1 %! Set the window to floating mode and move by dragging + [ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w)) + -- mod-button2 %! Raise the window to the top of the stack + , ((modMask, button2), (\w -> focus w >> windows W.swapMaster)) + -- mod-button3 %! Set the window to floating mode and resize by dragging + , ((modMask, button3), (\w -> focus w >> mouseResizeWindow w)) + -- you may also bind events to the mouse scroll wheel (button4 and button5) + + -- % Extension-provided mouse bindings + ] + +-- % Extension-provided definitions + +defaultConfig :: XConfig +defaultConfig = XConfig { borderWidth = 1 -- Width of the window border in pixels. + , XMonad.workspaces = workspaces + , defaultGaps = [(0,0,0,0)] -- 15 for default dzen font + -- | The top level layout switcher. Most users will not need to modify this binding. + -- + -- By default, we simply switch between the layouts listed in `layouts' + -- above, but you may program your own selection behaviour here. Layout + -- transformers, for example, would be hooked in here. + -- + , layoutHook = Layout layout + , terminal = "xterm" -- The preferred terminal program. + , normalBorderColor = "#dddddd" -- Border color for unfocused windows. + , focusedBorderColor = "#ff0000" -- Border color for focused windows. + , XMonad.numlockMask = numlockMask + , XMonad.keys = Main.keys + , XMonad.mouseBindings = Main.mouseBindings + -- | Perform an arbitrary action on each internal state change or X event. + -- Examples include: + -- * do nothing + -- * log the state to stdout + -- + -- See the 'DynamicLog' extension for examples. + , logHook = return () + , XMonad.manageHook = manageHook + } + +main = makeMain defaultConfig changepref test runhaskell Setup.lhs configure && runhaskell Setup.lhs build hunk ./XMonad/Layout/LayoutCombinators.hs 20 - (<|>), (), (<||>), (), (|||), JumpToLayout(JumpToLayout) + (<|>), (), (<||>), (), (|||), JumpToLayout(JumpToLayout), + (<-/>), (), (<-|>), (<|->), + (<-//>), (), (<-||>), (<||->), + hunk ./XMonad/Layout/LayoutCombinators.hs 36 -(<||>), () :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => - l1 a -> l2 a -> CombineTwo DragPane l1 l2 a -(<|>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) - => l1 a -> l2 a -> CombineTwo Tall l1 l2 a -() :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) - => l1 a -> l2 a -> CombineTwo (Mirror Tall) l1 l2 a +infixr 6 <||>, , <-||>, <-//>, <||->, , <|>, <-|>, <|->, , <-/>, + +(<||>), (), (<-||>), (<-//>), (<||->), () + :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => + l1 a -> l2 a -> CombineTwo DragPane l1 l2 a +(<|>), (<-|>), (<|->) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) + => l1 a -> l2 a -> CombineTwo Tall l1 l2 a +(), (<-/>), () :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) + => l1 a -> l2 a -> CombineTwo (Mirror Tall) l1 l2 a hunk ./XMonad/Layout/LayoutCombinators.hs 47 +(<-||>) = combineTwo (dragPane Vertical 0.1 0.2) +(<||->) = combineTwo (dragPane Vertical 0.1 0.8) hunk ./XMonad/Layout/LayoutCombinators.hs 50 +(<-//>) = combineTwo (dragPane Horizontal 0.1 0.2) +() = combineTwo (dragPane Horizontal 0.1 0.8) hunk ./XMonad/Layout/LayoutCombinators.hs 53 +(<-|>) = combineTwo (Tall 1 0.1 0.8) +(<|->) = combineTwo (Tall 1 0.1 0.1) hunk ./XMonad/Layout/LayoutCombinators.hs 56 +(<-/>) = combineTwo (Mirror $ Tall 1 0.1 0.8) +() = combineTwo (Mirror $ Tall 1 0.1 0.2) hunk ./XMonad/Layout/LayoutCombinators.hs 59 +infixr 5 ||| hunk ./XMonad/Layout/LayoutCombinators.hs 106 - | Just (JumpToLayout d) <- fromMessage m + | Just (JumpToLayout _) <- fromMessage m hunk ./XMonad/Layout/LayoutCombinators.hs 121 - | Just (JumpToLayout d) <- fromMessage m + | Just (JumpToLayout _) <- fromMessage m hunk ./configs/droundy.hs 28 -import Data.Ratio hunk ./configs/droundy.hs 39 -import XMonad.Layout.TwoPane hunk ./configs/droundy.hs 159 - (noBorders mytab) ||| - (combineTwo (Mirror $ TwoPane 0.03 0.8) mytab (combineTwo Square mytab mytab)) ||| - (mytab mytab) + noBorders mytab ||| + mytab <-/> combineTwo Square mytab mytab ||| + mytab mytab hunk ./configs/droundy.hs 164 - -- default tiling algorithm partitions the screen into two panes - tiled = Tall nmaster delta ratio - - -- The default number of windows in the master pane - nmaster = 1 - - -- Default proportion of screen occupied by master pane - ratio = 1%2 - - -- Percent of screen to increment by when resizing panes - delta = 3%100 hunk ./configs/droundy.hs 203 - -- increase or decrease number of windows in the master area - , ((modMask , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area - , ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area - hunk ./configs/droundy.hs 208 - , ((modMask , xK_Escape), broadcastMessage ReleaseResources >> restart Nothing True) -- %! Restart xmonad + , ((modMask , xK_Escape), broadcastMessage ReleaseResources >> restart (Just "xmonad-droundy") True) -- %! Restart xmonad hunk ./configs/droundy.hs 294 - , focusedBorderColor = "#ff0000" -- Border color for focused windows. + , focusedBorderColor = "#00ff00" -- Border color for focused windows. hunk ./configs/droundy.hs 308 +main :: IO () hunk ./XMonad/Layout/WorkspaceDir.hs 32 -import System.Directory ( setCurrentDirectory ) +import System.Directory ( setCurrentDirectory, getCurrentDirectory ) hunk ./XMonad/Layout/WorkspaceDir.hs 66 - handleMess (WorkspaceDir _) m = return $ do Chdir wd <- fromMessage m - Just (WorkspaceDir wd) + handleMess (WorkspaceDir _) m + | Just (Chdir wd) <- fromMessage m = do wd' <- cleanDir wd + return $ Just $ WorkspaceDir wd' + | otherwise = return Nothing hunk ./XMonad/Layout/WorkspaceDir.hs 75 +cleanDir :: String -> X String +cleanDir x = scd x >> io getCurrentDirectory + hunk ./XMonad/Layout/Combo.hs 24 -import Control.Arrow ( first ) hunk ./XMonad/Layout/Combo.hs 28 -import XMonad.Util.Invisible changepref test runhaskell Setup.lhs configure && runhaskell Setup.lhs build runhaskell Setup.lhs configure --disable-optimization --user && runhaskell Setup.lhs build adddir ./XMonad/Config move ./configs/droundy.hs ./XMonad/Config/Droundy.hs hunk ./XMonadContrib.cabal 92 - -executable: xmonad-droundy -main-is: configs/droundy.hs -ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s -ghc-prof-options: -prof -auto-all -extensions: GeneralizedNewtypeDeriving --- Also requires deriving Typeable, PatternGuards - addfile ./XMonad/Config/Sjanssen.hs hunk ./XMonad/Config/Sjanssen.hs 1 +module XMonad.Config.Sjanssen (sjanssenConfig) where + +import XMonad +import qualified XMonad.StackSet as W +import XMonad.Layouts +import XMonad.Layout.Tabbed +import XMonad.Operations +import XMonad.DefaultConfig (defaultConfig) +import XMonad.Layout.NoBorders +import XMonad.Hooks.DynamicLog +import XMonad.Prompt +import XMonad.Prompt.Shell + +import Data.Ratio +import Data.Bits +import qualified Data.Map as M +import Graphics.X11 + +sjanssenConfig = defaultConfig + { defaultGaps = [(15,0,0,0)] + , terminal = "urxvt" + , workspaces = ["irc", "web"] ++ map show [3..7] ++ ["mail", "im"] + , logHook = dynamicLogWithPP sjanssenPP + , modMask = mod4Mask + , mouseBindings = \(XConfig {modMask = modMask}) -> M.fromList $ + [ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w)) + , ((modMask, button2), (\w -> focus w >> windows W.swapMaster)) + , ((modMask .|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ] + , keys = \c -> mykeys c `M.union` keys defaultConfig c + , layoutHook = Layout (smartBorders (tiled ||| Mirror tiled ||| Full ||| tabbed shrinkText defaultTConf)) + } + where + mykeys (XConfig {modMask = modMask}) = M.fromList $ + [((modMask, xK_p ), shellPrompt myPromptConfig)] + -- default tiling algorithm partitions the screen into two panes + tiled = Tall nmaster delta ratio + + -- The default number of windows in the master pane + nmaster = 1 + + -- Default proportion of screen occupied by master pane + ratio = 1%2 + + -- Percent of screen to increment by when resizing panes + delta = 3%100 + +myPromptConfig = defaultXPConfig + { position = Top + , promptBorderWidth = 0 + } hunk ./XMonadContrib.cabal 41 + XMonad.Config.Sjanssen hunk ./XMonad/Config/Droundy.hs 3 --- Module : DefaultConfig.hs hunk ./XMonad/Config/Droundy.hs 16 -module Main (main) where +module XMonad.Config.Droundy where hunk ./XMonad/Config/Droundy.hs 22 -import XMonad hiding (workspaces, manageHook, numlockMask) -import qualified XMonad (workspaces, manageHook, numlockMask) + +import XMonad hiding + (workspaces,manageHook,numlockMask,keys,mouseBindings) +import qualified XMonad + (workspaces,manageHook,numlockMask,keys,mouseBindings) + hunk ./XMonad/Config/Droundy.hs 35 -import XMonad.EventLoop +import XMonad.Core hunk ./XMonad/Config/Droundy.hs 299 - , XMonad.keys = Main.keys - , XMonad.mouseBindings = Main.mouseBindings + , XMonad.keys = keys + , XMonad.mouseBindings = mouseBindings hunk ./XMonad/Config/Droundy.hs 311 -main :: IO () -main = makeMain defaultConfig +-- main :: IO () +-- main = makeMain defaultConfig hunk ./XMonad/Config/Sjanssen.hs 8 -import XMonad.DefaultConfig (defaultConfig) +import XMonad.Config (defaultConfig) hunk ./XMonadContrib.cabal 13 +ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s +ghc-prof-options: -prof -auto-all hunk ./XMonadContrib.cabal 19 - configs/droundy.hs hunk ./XMonadContrib.cabal 43 + XMonad.Config.Dons + -- XMonad.Config.Droundy rmdir ./configs addfile ./XMonad/Config/Dons.hs hunk ./XMonad/Config/Dons.hs 1 +-------------------------------------------------------------------- +-- | +-- Module : XMonad.Config.Dons +-- Copyright : (c) Galois, Inc. 2007 +-- License : BSD3 +-- +-- Maintainer: Don Stewart +-- +-- An example, simple configuration file. +-- +-------------------------------------------------------------------- + +module XMonad.Config.Dons where + +import XMonad +import XMonad.Config +import XMonad.Hooks.DynamicLog + +config :: XConfig +config = defaultConfig + { borderWidth = 2 + , defaultGaps = [(18,0,0,0)] + , terminal = "term" + , normalBorderColor = "#cccccc" + , focusedBorderColor = "#cd8b00" + , logHook = dynamicLogDzen } + hunk ./XMonadContrib.cabal 13 -ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s -ghc-prof-options: -prof -auto-all hunk ./XMonadContrib.cabal 17 +ghc-options: -Wall hunk ./XMonadContrib.cabal 12 -build-depends: base>=2.0, mtl, unix, X11==1.3.0, xmonad==0.4 hunk ./XMonadContrib.cabal 16 -ghc-options: -Wall -exposed-modules: XMonad.Actions.Commands - XMonad.Actions.ConstrainedResize - XMonad.Actions.CopyWindow - XMonad.Actions.CycleWS - XMonad.Actions.DeManage - XMonad.Actions.DwmPromote - XMonad.Actions.DynamicWorkspaces - XMonad.Actions.FindEmptyWorkspace - XMonad.Actions.FlexibleManipulate - XMonad.Actions.FlexibleResize - XMonad.Actions.FloatKeys - XMonad.Actions.FocusNth - XMonad.Actions.MouseGestures - XMonad.Actions.RotSlaves - XMonad.Actions.RotView - XMonad.Actions.SimpleDate - XMonad.Actions.SinkAll - XMonad.Actions.Submap - XMonad.Actions.SwapWorkspaces - XMonad.Actions.TagWindows - XMonad.Actions.Warp - XMonad.Actions.WindowBringer - XMonad.Actions.WmiiActions - XMonad.Config.Sjanssen - XMonad.Config.Dons - -- XMonad.Config.Droundy - XMonad.Hooks.DynamicLog - -- XMonad.Hooks.ManageDocks - XMonad.Hooks.SetWMName - -- XMonad.Hooks.UrgencyHook - XMonad.Hooks.XPropManage - XMonad.Layout.Accordion - XMonad.Layout.Circle - XMonad.Layout.Combo - XMonad.Layout.Dishes - XMonad.Layout.DragPane - XMonad.Layout.Grid - -- XMonad.Layout.HintedTile - -- XMonad.Layout.LayoutCombinators - -- XMonad.Layout.LayoutHints - XMonad.Layout.LayoutModifier - XMonad.Layout.LayoutScreens - XMonad.Layout.MagicFocus - -- XMonad.Layout.Magnifier - XMonad.Layout.Maximize - XMonad.Layout.MosaicAlt - -- XMonad.Layout.Mosaic - XMonad.Layout.NoBorders - XMonad.Layout.ResizableTile - XMonad.Layout.Roledex - XMonad.Layout.Spiral - XMonad.Layout.Square - -- XMonad.Layout.SwitchTrans - XMonad.Layout.Tabbed - XMonad.Layout.ThreeColumns - -- XMonad.Layout.TilePrime - XMonad.Layout.ToggleLayouts - XMonad.Layout.TwoPane - XMonad.Layout.WindowNavigation - XMonad.Layout.WorkspaceDir - XMonad.Prompt.Directory - XMonad.Prompt - XMonad.Prompt.Man - XMonad.Prompt.Shell - XMonad.Prompt.Ssh - XMonad.Prompt.Window - XMonad.Prompt.Workspace - XMonad.Prompt.XMonad - XMonad.Util.Anneal - XMonad.Util.Dmenu - XMonad.Util.Dzen - XMonad.Util.Invisible - XMonad.Util.NamedWindows - XMonad.Util.Run - XMonad.Util.XSelection - XMonad.Util.XUtils +cabal-version: >= 1.2 + +flag small_base + description: Choose the new smaller, split-up base package. + +library + if flag(small_base) + build-depends: base >= 3, containers, directory, process, random + else + build-depends: base < 3 + + build-depends: mtl, unix, X11==1.3.0, xmonad==0.4 + ghc-options: -Wall + exposed-modules: XMonad.Actions.Commands + XMonad.Actions.ConstrainedResize + XMonad.Actions.CopyWindow + XMonad.Actions.CycleWS + XMonad.Actions.DeManage + XMonad.Actions.DwmPromote + XMonad.Actions.DynamicWorkspaces + XMonad.Actions.FindEmptyWorkspace + XMonad.Actions.FlexibleManipulate + XMonad.Actions.FlexibleResize + XMonad.Actions.FloatKeys + XMonad.Actions.FocusNth + XMonad.Actions.MouseGestures + XMonad.Actions.RotSlaves + XMonad.Actions.RotView + XMonad.Actions.SimpleDate + XMonad.Actions.SinkAll + XMonad.Actions.Submap + XMonad.Actions.SwapWorkspaces + XMonad.Actions.TagWindows + XMonad.Actions.Warp + XMonad.Actions.WindowBringer + XMonad.Actions.WmiiActions + XMonad.Config.Sjanssen + XMonad.Config.Dons + -- XMonad.Config.Droundy + XMonad.Hooks.DynamicLog + -- XMonad.Hooks.ManageDocks + XMonad.Hooks.SetWMName + -- XMonad.Hooks.UrgencyHook + XMonad.Hooks.XPropManage + XMonad.Layout.Accordion + XMonad.Layout.Circle + -- XMonad.Layout.Combo + XMonad.Layout.Dishes + XMonad.Layout.DragPane + XMonad.Layout.Grid + -- XMonad.Layout.HintedTile + -- XMonad.Layout.LayoutCombinators + -- XMonad.Layout.LayoutHints + XMonad.Layout.LayoutModifier + XMonad.Layout.LayoutScreens + XMonad.Layout.MagicFocus + -- XMonad.Layout.Magnifier + XMonad.Layout.Maximize + XMonad.Layout.MosaicAlt + -- XMonad.Layout.Mosaic + XMonad.Layout.NoBorders + XMonad.Layout.ResizableTile + XMonad.Layout.Roledex + XMonad.Layout.Spiral + XMonad.Layout.Square + -- XMonad.Layout.SwitchTrans + XMonad.Layout.Tabbed + XMonad.Layout.ThreeColumns + -- XMonad.Layout.TilePrime + XMonad.Layout.ToggleLayouts + XMonad.Layout.TwoPane + XMonad.Layout.WindowNavigation + XMonad.Layout.WorkspaceDir + XMonad.Prompt.Directory + XMonad.Prompt + XMonad.Prompt.Man + XMonad.Prompt.Shell + XMonad.Prompt.Ssh + XMonad.Prompt.Window + XMonad.Prompt.Workspace + XMonad.Prompt.XMonad + XMonad.Util.Anneal + XMonad.Util.Dmenu + XMonad.Util.Dzen + XMonad.Util.Invisible + XMonad.Util.NamedWindows + XMonad.Util.Run + XMonad.Util.XSelection + XMonad.Util.XUtils hunk ./XMonad/Config/Sjanssen.hs 19 +sjanssenConfig :: XConfig hunk ./XMonad/Config/Sjanssen.hs 37 - tiled = Tall nmaster delta ratio - - -- The default number of windows in the master pane - nmaster = 1 - - -- Default proportion of screen occupied by master pane - ratio = 1%2 - - -- Percent of screen to increment by when resizing panes - delta = 3%100 + tiled = Tall 1 0.5 0.03 hunk ./XMonad/Actions/Submap.hs 23 -import XMonad +import XMonad hiding (keys) hunk ./XMonad/Config/Sjanssen.hs 14 -import Data.Ratio hunk ./XMonad/Config/Sjanssen.hs 22 - , workspaces = ["irc", "web"] ++ map show [3..7] ++ ["mail", "im"] + , workspaces = ["irc", "web"] ++ map show [3 .. 7 :: Int] ++ ["mail", "im"] hunk ./XMonad/Config/Sjanssen.hs 25 - , mouseBindings = \(XConfig {modMask = modMask}) -> M.fromList $ - [ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w)) - , ((modMask, button2), (\w -> focus w >> windows W.swapMaster)) - , ((modMask .|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ] + , mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $ + [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w)) + , ((modm, button2), (\w -> focus w >> windows W.swapMaster)) + , ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ] hunk ./XMonad/Config/Sjanssen.hs 33 - mykeys (XConfig {modMask = modMask}) = M.fromList $ - [((modMask, xK_p ), shellPrompt myPromptConfig)] - -- default tiling algorithm partitions the screen into two panes hunk ./XMonad/Config/Sjanssen.hs 35 -myPromptConfig = defaultXPConfig - { position = Top - , promptBorderWidth = 0 - } + mykeys (XConfig {modMask = modm}) = M.fromList $ + [((modm, xK_p ), shellPrompt myPromptConfig)] + + myPromptConfig = defaultXPConfig + { position = Top + , promptBorderWidth = 0 } hunk ./XMonad/Layout/Spiral.hs 27 -import XMonad.Operations hunk ./XMonad/Prompt/Shell.hs 31 -import XMonad +import XMonad hiding (config) hunk ./XMonad/Config/Droundy.hs 21 -import Control.Monad.Reader ( asks ) - -import XMonad hiding - (workspaces,manageHook,numlockMask,keys,mouseBindings) -import qualified XMonad - (workspaces,manageHook,numlockMask,keys,mouseBindings) +import XMonad hiding (keys,mouseBindings) +import qualified XMonad (keys,mouseBindings) +import XMonad.Config ( defaultConfig ) hunk ./XMonad/Config/Droundy.hs 32 -import XMonad.Core hunk ./XMonad/Config/Droundy.hs 56 - --- | The default number of workspaces (virtual screens) and their names. --- By default we use numeric strings, but any string may be used as a --- workspace name. The number of workspaces is determined by the length --- of this list. --- --- A tagging example: --- --- > workspaces = ["web", "irc", "code" ] ++ map show [4..9] --- -workspaces :: [WorkspaceId] -workspaces = ["1:mutt","2:iceweasel"] - --- | modMask lets you specify which modkey you want to use. The default --- is mod1Mask ("left alt"). You may also consider using mod3Mask --- ("right alt"), which does not conflict with emacs keybindings. The --- "windows key" is usually mod4Mask. --- -modMask :: KeyMask -modMask = mod1Mask - --- | The mask for the numlock key. Numlock status is "masked" from the --- current modifier status, so the keybindings will work with numlock on or --- off. You may need to change this on some systems. --- --- You can find the numlock modifier by running "xmodmap" and looking for a --- modifier with Num_Lock bound to it: --- --- > $ xmodmap | grep Num --- > mod2 Num_Lock (0x4d) --- --- Set numlockMask = 0 if you don't have a numlock key, or want to treat --- numlock status separately. --- -numlockMask :: KeyMask -numlockMask = mod2Mask - --- | Default offset of drawable screen boundaries from each physical --- screen. Anything non-zero here will leave a gap of that many pixels --- on the given edge, on the that screen. A useful gap at top of screen --- for a menu bar (e.g. 15) --- --- An example, to set a top gap on monitor 1, and a gap on the bottom of --- monitor 2, you'd use a list of geometries like so: --- --- > defaultGaps = [(18,0,0,0),(0,18,0,0)] -- 2 gaps on 2 monitors --- --- Fields are: top, bottom, left, right. --- ---defaultGaps :: [(Int,Int,Int,Int)] - hunk ./XMonad/Config/Droundy.hs 57 ------------------------------------------------------------------------- --- Window rules - --- | Execute arbitrary actions and WindowSet manipulations when managing --- a new window. You can use this to, for example, always float a --- particular program, or have a client always appear on a particular --- workspace. --- --- To find the property name associated with a program, use --- xprop | grep WM_CLASS --- and click on the client you're interested in. --- -manageHook :: Window -- ^ the new window to manage - -> String -- ^ window title - -> String -- ^ window resource name - -> String -- ^ window resource class - -> X (WindowSet -> WindowSet) - --- Always float various programs: -manageHook w _ _ c | c `elem` floats = fmap (W.float w . snd) (floatLocation w) - where floats = ["MPlayer", "Gimp"] - --- Desktop panels and dock apps should be ignored by xmonad: -manageHook w _ n _ | n `elem` ignore = reveal w >> return (W.delete w) - where ignore = ["gnome-panel", "desktop_window", "kicker", "kdesktop"] - --- Automatically send Firefox windows to the "web" workspace: --- If a workspace named "web" doesn't exist, the window will appear on the --- current workspace. -manageHook _ _ "Gecko" _ = return $ W.shift "web" - --- The default rule: return the WindowSet unmodified. You typically do not --- want to modify this line. -manageHook _ _ _ _ = return id - ------------------------------------------------------------------------- --- Extensible layouts --- --- You can specify and transform your layouts by modifying these values. --- If you change layout bindings be sure to use 'mod-shift-space' after --- restarting (with 'mod-q') to reset your layout state to the new --- defaults, as xmonad preserves your old layout settings by default. --- - --- | The available layouts. Note that each layout is separated by |||, which --- denotes layout choice. -layout = -- tiled ||| Mirror tiled ||| Full - -- Add extra layouts you want to use here: - -- % Extension-provided layouts - workspaceDir "~" $ windowNavigation $ toggleLayouts (noBorders Full) $ - noBorders mytab ||| - mytab <-/> combineTwo Square mytab mytab ||| - mytab mytab - where - mytab = tabbed shrinkText defaultTConf hunk ./XMonad/Config/Droundy.hs 65 -keys :: M.Map (KeyMask, KeySym) (X ()) -keys = M.fromList $ +keys :: XConfig -> M.Map (KeyMask, KeySym) (X ()) +keys x = M.fromList $ hunk ./XMonad/Config/Droundy.hs 68 - [ ((modMask .|. shiftMask, xK_Return), asks (terminal . config) >>= spawn) -- %! Launch terminal - , ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu - , ((modMask .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun - , ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window + [ ((modMask x .|. shiftMask, xK_c ), kill) -- %! Close the focused window hunk ./XMonad/Config/Droundy.hs 70 - , ((modMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms - , ((modMask .|. shiftMask, xK_space ), setLayout $ Layout layout) -- %! Reset the layouts on the current workspace to default + , ((modMask x, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms + , ((modMask x .|. shiftMask, xK_space ), setLayout $ layoutHook x) -- %! Reset the layouts on the current workspace to default hunk ./XMonad/Config/Droundy.hs 73 - , ((modMask, xK_n ), refresh) -- %! Resize viewed windows to the correct size + , ((modMask x, xK_n ), refresh) -- %! Resize viewed windows to the correct size hunk ./XMonad/Config/Droundy.hs 76 - , ((modMask, xK_Tab ), windows W.focusDown) -- %! Move focus to the next window - , ((modMask, xK_j ), windows W.focusDown) -- %! Move focus to the next window - , ((modMask, xK_k ), windows W.focusUp ) -- %! Move focus to the previous window - , ((modMask, xK_m ), windows W.focusMaster ) -- %! Move focus to the master window - - -- modifying the window order - , ((modMask, xK_Return), windows W.swapMaster) -- %! Swap the focused window and the master window - , ((modMask .|. shiftMask, xK_j ), windows W.swapDown ) -- %! Swap the focused window with the next window - , ((modMask .|. shiftMask, xK_k ), windows W.swapUp ) -- %! Swap the focused window with the previous window + , ((modMask x, xK_Tab ), windows W.focusDown) -- %! Move focus to the next window + , ((modMask x, xK_j ), windows W.focusDown) -- %! Move focus to the next window + , ((modMask x, xK_k ), windows W.focusUp ) -- %! Move focus to the previous window + , ((modMask x, xK_m ), windows W.focusMaster ) -- %! Move focus to the master window hunk ./XMonad/Config/Droundy.hs 81 - -- resizing the master/slave ratio - , ((modMask, xK_h ), sendMessage Shrink) -- %! Shrink the master area - , ((modMask, xK_l ), sendMessage Expand) -- %! Expand the master area + , ((modMask x .|. shiftMask, xK_j ), windows W.swapDown ) -- %! Swap the focused window with the next window + , ((modMask x .|. shiftMask, xK_k ), windows W.swapUp ) -- %! Swap the focused window with the previous window hunk ./XMonad/Config/Droundy.hs 85 - , ((modMask, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling - - -- toggle the status bar gap - , ((modMask , xK_b ), modifyGap (\i n -> let x = (defaultGaps defaultConfig ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap + , ((modMask x, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling hunk ./XMonad/Config/Droundy.hs 88 - , ((modMask .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad - , ((modMask , xK_Escape), broadcastMessage ReleaseResources >> restart (Just "xmonad-droundy") True) -- %! Restart xmonad - - -- % Extension-provided key bindings + , ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad + , ((modMask x , xK_Escape), broadcastMessage ReleaseResources >> restart (Just "xmonad-droundy") True) -- %! Restart xmonad hunk ./XMonad/Config/Droundy.hs 91 - , ((modMask .|. shiftMask, xK_z ), + , ((modMask x .|. shiftMask, xK_z ), hunk ./XMonad/Config/Droundy.hs 93 - , ((modMask .|. shiftMask .|. controlMask, xK_z), + , ((modMask x .|. shiftMask .|. controlMask, xK_z), hunk ./XMonad/Config/Droundy.hs 95 - , ((modMask .|. shiftMask, xK_Right), rotView True) - , ((modMask .|. shiftMask, xK_Left), rotView False) - , ((modMask, xK_Right), sendMessage $ Go R) - , ((modMask, xK_Left), sendMessage $ Go L) - , ((modMask, xK_Up), sendMessage $ Go U) - , ((modMask, xK_Down), sendMessage $ Go D) - , ((modMask .|. controlMask, xK_Right), sendMessage $ Swap R) - , ((modMask .|. controlMask, xK_Left), sendMessage $ Swap L) - , ((modMask .|. controlMask, xK_Up), sendMessage $ Swap U) - , ((modMask .|. controlMask, xK_Down), sendMessage $ Swap D) - , ((modMask .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) - , ((modMask .|. controlMask .|. shiftMask, xK_Left), sendMessage $ Move L) - , ((modMask .|. controlMask .|. shiftMask, xK_Up), sendMessage $ Move U) - , ((modMask .|. controlMask .|. shiftMask, xK_Down), sendMessage $ Move D) + , ((modMask x .|. shiftMask, xK_Right), rotView True) + , ((modMask x .|. shiftMask, xK_Left), rotView False) + , ((modMask x, xK_Right), sendMessage $ Go R) + , ((modMask x, xK_Left), sendMessage $ Go L) + , ((modMask x, xK_Up), sendMessage $ Go U) + , ((modMask x, xK_Down), sendMessage $ Go D) + , ((modMask x .|. controlMask, xK_Right), sendMessage $ Swap R) + , ((modMask x .|. controlMask, xK_Left), sendMessage $ Swap L) + , ((modMask x .|. controlMask, xK_Up), sendMessage $ Swap U) + , ((modMask x .|. controlMask, xK_Down), sendMessage $ Swap D) + , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) + , ((modMask x .|. controlMask .|. shiftMask, xK_Left), sendMessage $ Move L) + , ((modMask x .|. controlMask .|. shiftMask, xK_Up), sendMessage $ Move U) + , ((modMask x .|. controlMask .|. shiftMask, xK_Down), sendMessage $ Move D) hunk ./XMonad/Config/Droundy.hs 113 - , ((modMask .|. shiftMask, xK_x ), changeDir myXPConfig) - , ((modMask .|. shiftMask, xK_BackSpace), removeWorkspace) - , ((modMask .|. shiftMask, xK_v ), selectWorkspace myXPConfig) - , ((modMask .|. shiftMask, xK_m ), workspacePrompt myXPConfig (windows . copy)) - , ((modMask .|. shiftMask, xK_r), renameWorkspace myXPConfig) - , ((modMask .|. controlMask, xK_space), sendMessage ToggleLayout) - , ((modMask .|. controlMask, xK_f), sendMessage (JumpToLayout "Full")) + , ((modMask x .|. shiftMask, xK_x ), changeDir myXPConfig) + , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace) + , ((modMask x .|. shiftMask, xK_v ), selectWorkspace myXPConfig) + , ((modMask x .|. shiftMask, xK_m ), workspacePrompt myXPConfig (windows . copy)) + , ((modMask x .|. shiftMask, xK_r), renameWorkspace myXPConfig) + , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout) + , ((modMask x .|. controlMask, xK_f), sendMessage (JumpToLayout "Full")) hunk ./XMonad/Config/Droundy.hs 121 -{- - ++ - -- mod-[1..9] %! Switch to workspace N - -- mod-shift-[1..9] %! Move client to workspace N - [((m .|. modMask, k), windows $ f i) - | (i, k) <- zip workspaces [xK_1 .. xK_9] - , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] - ++ - -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 - -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3 - [((m .|. modMask, key), screenWorkspace sc >>= flip whenJust (windows . f)) - | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..] - , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] --} hunk ./XMonad/Config/Droundy.hs 125 - zip (zip (repeat modMask) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..]) + zip (zip (repeat $ modMask x) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..]) hunk ./XMonad/Config/Droundy.hs 127 - zip (zip (repeat (modMask .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..]) + zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..]) hunk ./XMonad/Config/Droundy.hs 131 -mouseBindings :: M.Map (KeyMask, Button) (Window -> X ()) -mouseBindings = M.fromList $ +mouseBindings :: XConfig -> M.Map (KeyMask, Button) (Window -> X ()) +mouseBindings x = M.fromList $ hunk ./XMonad/Config/Droundy.hs 134 - [ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w)) + [ ((modMask x, button1), (\w -> focus w >> mouseMoveWindow w)) hunk ./XMonad/Config/Droundy.hs 136 - , ((modMask, button2), (\w -> focus w >> windows W.swapMaster)) + , ((modMask x, button2), (\w -> focus w >> windows W.swapMaster)) hunk ./XMonad/Config/Droundy.hs 138 - , ((modMask, button3), (\w -> focus w >> mouseResizeWindow w)) + , ((modMask x, button3), (\w -> focus w >> mouseResizeWindow w)) hunk ./XMonad/Config/Droundy.hs 146 -defaultConfig :: XConfig -defaultConfig = XConfig { borderWidth = 1 -- Width of the window border in pixels. - , XMonad.workspaces = workspaces - , defaultGaps = [(0,0,0,0)] -- 15 for default dzen font - -- | The top level layout switcher. Most users will not need to modify this binding. - -- - -- By default, we simply switch between the layouts listed in `layouts' - -- above, but you may program your own selection behaviour here. Layout - -- transformers, for example, would be hooked in here. - -- - , layoutHook = Layout layout - , terminal = "xterm" -- The preferred terminal program. - , normalBorderColor = "#dddddd" -- Border color for unfocused windows. - , focusedBorderColor = "#00ff00" -- Border color for focused windows. - , XMonad.numlockMask = numlockMask - , XMonad.keys = keys - , XMonad.mouseBindings = mouseBindings - -- | Perform an arbitrary action on each internal state change or X event. - -- Examples include: - -- * do nothing - -- * log the state to stdout - -- - -- See the 'DynamicLog' extension for examples. - , logHook = return () - , XMonad.manageHook = manageHook - } +config :: XConfig +config = defaultConfig + { borderWidth = 1 -- Width of the window border in pixels. + , XMonad.workspaces = ["1:mutt","2:iceweasel"] + , layoutHook = Layout $ workspaceDir "~" $ windowNavigation $ toggleLayouts (noBorders Full) $ + noBorders mytab ||| + mytab <-/> combineTwo Square mytab mytab ||| + mytab mytab + , terminal = "xterm" -- The preferred terminal program. + , normalBorderColor = "#dddddd" -- Border color for unfocused windows. + , focusedBorderColor = "#00ff00" -- Border color for focused windows. + , XMonad.modMask = mod1Mask + , XMonad.keys = keys + , XMonad.mouseBindings = mouseBindings + } + where mytab = tabbed shrinkText defaultTConf hunk ./XMonad/Config/Droundy.hs 163 --- main :: IO () --- main = makeMain defaultConfig hunk ./XMonadContrib.cabal 54 - -- XMonad.Config.Droundy + XMonad.Config.Droundy hunk ./XMonadContrib.cabal 28 - ghc-options: -Wall + ghc-options: -Wall -Werror hunk ./XMonad/Config/Sjanssen.hs 33 - tiled = Tall 1 0.5 0.03 + tiled = Tall 1 0.03 0.5 hunk ./XMonad/Layout/Combo.hs 1 -{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, + UndecidableInstances, PatternGuards #-} hunk ./XMonad/Layout/Combo.hs 67 -data CombineTwo l l1 l2 a = C2 [a] [a] (l ()) (l1 a) (l2 a) +data CombineTwo l l1 l2 a = C2 [a] [a] l (l1 a) (l2 a) hunk ./XMonad/Layout/Combo.hs 71 - super () -> l1 a -> l2 a -> CombineTwo super l1 l2 a + super () -> l1 a -> l2 a -> CombineTwo (super ()) l1 l2 a hunk ./XMonad/Layout/Combo.hs 75 - => LayoutClass (CombineTwo l l1 l2) a where + => LayoutClass (CombineTwo (l ()) l1 l2) a where hunk ./XMonad/Layout/LayoutCombinators.hs 40 - l1 a -> l2 a -> CombineTwo DragPane l1 l2 a + l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a hunk ./XMonad/Layout/LayoutCombinators.hs 42 - => l1 a -> l2 a -> CombineTwo Tall l1 l2 a + => l1 a -> l2 a -> CombineTwo (Tall ()) l1 l2 a hunk ./XMonad/Layout/LayoutCombinators.hs 44 - => l1 a -> l2 a -> CombineTwo (Mirror Tall) l1 l2 a + => l1 a -> l2 a -> CombineTwo (Mirror Tall ()) l1 l2 a hunk ./XMonadContrib.cabal 62 - -- XMonad.Layout.Combo + XMonad.Layout.Combo hunk ./XMonad/Hooks/ManageDocks.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} hunk ./XMonadContrib.cabal 56 - -- XMonad.Hooks.ManageDocks + XMonad.Hooks.ManageDocks hunk ./XMonadContrib.cabal 67 - -- XMonad.Layout.LayoutCombinators + XMonad.Layout.LayoutCombinators hunk ./XMonad/Layout/LayoutHints.hs 25 -import {-#SOURCE#-} Config (borderWidth) hunk ./XMonad/Layout/LayoutHints.hs 27 +import Control.Monad.Reader ( asks ) hunk ./XMonad/Layout/LayoutHints.hs 42 -adjBorders :: Dimension -> D -> D -adjBorders mult (w,h) = (w+2*mult*borderWidth, h+2*mult*borderWidth) +adjBorders :: Dimension -> Dimension -> D -> D +adjBorders bW mult (w,h) = (w+2*mult*bW, h+2*mult*bW) hunk ./XMonad/Layout/LayoutHints.hs 50 - xs' <- mapM applyHint xs + bW <- asks (borderWidth . config) + xs' <- mapM (applyHint bW) xs hunk ./XMonad/Layout/LayoutHints.hs 54 - applyHint (w,Rectangle a b c d) = + applyHint bW (w,Rectangle a b c d) = hunk ./XMonad/Layout/LayoutHints.hs 57 - let (c',d') = adjBorders 1 . applySizeHints sh . adjBorders (-1) $ (c,d) + let (c',d') = adjBorders 1 bW . applySizeHints sh . adjBorders bW (-1) $ (c,d) hunk ./XMonadContrib.cabal 68 - -- XMonad.Layout.LayoutHints + XMonad.Layout.LayoutHints hunk ./MetaModule.hs 50 --- import XMonad.LayoutHints () +import XMonad.LayoutHints () hunk ./MetaModule.hs 80 --- import XMonad.TilePrime () +import XMonad.TilePrime () hunk ./XMonad/Layout/TilePrime.hs 24 +import Control.Monad.Reader (asks) hunk ./XMonad/Layout/TilePrime.hs 29 +import XMonad.Layouts hunk ./XMonad/Layout/TilePrime.hs 32 -import {-#SOURCE#-} Config (borderWidth) hunk ./XMonad/Layout/TilePrime.hs 65 + bW <- asks (borderWidth . config) hunk ./XMonad/Layout/TilePrime.hs 75 - masters = fillWindows leftRect leftXs - slaves = fillWindows rightRect rightXs + masters = fillWindows bW leftRect leftXs + slaves = fillWindows bW rightRect rightXs hunk ./XMonad/Layout/TilePrime.hs 80 - fillWindows r xs = snd $ mapAccumL aux (r,n) xs + fillWindows bW r xs = snd $ mapAccumL (aux bW) (r,n) xs hunk ./XMonad/Layout/TilePrime.hs 83 - aux (r,n) (x,hint) = ((rest,n-1),(x,r')) + aux bW (r,n) (x,hint) = ((rest,n-1),(x,r')) hunk ./XMonad/Layout/TilePrime.hs 88 - (w,h) = applySizeHints hint `underBorders` rect_D allocated + (w,h) = underBorders bW (applySizeHints hint) (rect_D allocated) hunk ./XMonad/Layout/TilePrime.hs 101 -underBorders :: (D -> D) -> D -> D -underBorders f = adjBorders 1 . f . adjBorders (-1) +underBorders :: Dimension -> (D -> D) -> D -> D +underBorders bW f = adjBorders bW 1 . f . adjBorders bW (-1) hunk ./XMonad/Layout/TilePrime.hs 105 -adjBorders :: Dimension -> D -> D -adjBorders mult (w,h) = (w+2*mult*borderWidth, h+2*mult*borderWidth) +adjBorders :: Dimension -> Dimension -> D -> D +adjBorders bW mult (w,h) = (w+2*mult*bW, h+2*mult*bW) hunk ./XMonadContrib.cabal 84 - -- XMonad.Layout.TilePrime + XMonad.Layout.TilePrime hunk ./MetaModule.hs 60 +import XMonad.MultiToggle () addfile ./XMonad/Layout/MultiToggle.hs hunk ./XMonad/Layout/MultiToggle.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.MultiToggle +-- Copyright : (c) Lukas Mai +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable + + +module XMonad.Layout.MultiToggle ( + EL(..), + unEL, + LayoutTransformer(..), + Toggle(..), + (.*.), + HNil(..), + mkToggle +) where + + +import XMonad + +import Control.Arrow +import Data.Typeable +import Data.Maybe + +data EL a = forall l. (LayoutClass l a) => EL (l a) + +unEL :: EL a -> (forall l. (LayoutClass l a) => l a -> b) -> b +unEL (EL x) k = k x + +class (Eq t, Typeable t) => LayoutTransformer t a | t -> a where + transform :: t -> EL a -> EL a + +data Toggle a = forall t. (LayoutTransformer t a) => Toggle t + deriving (Typeable) + +instance (Typeable a) => Message (Toggle a) + +data MultiToggleS ts l a = MultiToggleS (l a) (Maybe Int) ts + deriving (Read, Show) + +data MultiToggle ts l a = MultiToggle{ + baseLayout :: l a, + currLayout :: EL a, + currIndex :: Maybe Int, + currTrans :: EL a -> EL a, + transformers :: ts +} + +expand :: (LayoutClass l a, HList ts a) => MultiToggleS ts l a -> MultiToggle ts l a +expand (MultiToggleS b i ts) = + resolve ts (fromMaybe (-1) i) id + (\x mt -> + let g = transform x in + mt{ + currLayout = g . EL $ baseLayout mt, + currTrans = g + } + ) + (MultiToggle b (EL b) i id ts) + +collapse :: MultiToggle ts l a -> MultiToggleS ts l a +collapse mt = MultiToggleS (baseLayout mt) (currIndex mt) (transformers mt) + +instance (LayoutClass l a, Read (l a), HList ts a, Read ts) => Read (MultiToggle ts l a) where + readsPrec p s = map (first expand) $ readsPrec p s + +instance (Show ts, Show (l a)) => Show (MultiToggle ts l a) where + showsPrec p = showsPrec p . collapse + +mkToggle :: (LayoutClass l a) => ts -> l a -> MultiToggle ts l a +mkToggle ts l = MultiToggle l (EL l) Nothing id ts + +data HNil = HNil deriving (Read, Show) +data HCons a b = HCons a b deriving (Read, Show) + +infixr 0 .*. +(.*.) :: (HList b w) => a -> b -> HCons a b +(.*.) = HCons + +class HList c a where + find :: (LayoutTransformer t a) => c -> t -> Maybe Int + resolve :: c -> Int -> b -> (forall t. (LayoutTransformer t a) => t -> b) -> b + +instance HList HNil w where + find HNil _ = Nothing + resolve HNil _ d _ = d + +instance (LayoutTransformer a w, HList b w) => HList (HCons a b) w where + find (HCons x xs) t + | t `geq` x = Just 0 + | otherwise = fmap succ (find xs t) + resolve (HCons x xs) n d k = + case n `compare` 0 of + LT -> d + EQ -> k x + GT -> resolve xs (pred n) d k + +geq :: (Typeable a, Eq a, Typeable b) => a -> b -> Bool +geq a b = Just a == cast b + +acceptChange :: (LayoutClass l' a) => MultiToggle ts l a -> ((l' a -> MultiToggle ts l a) -> b -> c) -> X b -> X c +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" + + pureLayout mt r s = currLayout mt `unEL` \l -> pureLayout l r s + + doLayout mt r s = currLayout mt `unEL` \l -> acceptChange mt (fmap . fmap) (doLayout l r s) + + handleMessage mt m + | Just (Toggle t) <- fromMessage m + , i@(Just _) <- find (transformers mt) t + = currLayout mt `unEL` \l -> + if i == currIndex mt + then do + handleMessage l (SomeMessage ReleaseResources) + return . Just $ + mt{ + currLayout = EL $ baseLayout mt, + currIndex = Nothing, + currTrans = id + } + else do + handleMessage l (SomeMessage ReleaseResources) + let f = transform t + return . Just $ + mt{ + currLayout = f . EL $ baseLayout mt, + currIndex = i, + currTrans = f + } + | fromMessage m == Just ReleaseResources || + fromMessage m == Just Hide + = currLayout mt `unEL` \l -> acceptChange mt fmap (handleMessage l m) + | otherwise = do + ml <- handleMessage (baseLayout mt) m + case ml of + Nothing -> return Nothing + Just b' -> currLayout mt `unEL` \l -> do + handleMessage l (SomeMessage ReleaseResources) + return . Just $ + mt{ baseLayout = b', currLayout = currTrans mt . EL $ b' } hunk ./XMonadContrib.cabal 76 + XMonad.Layout.MultiToggle hunk ./MetaModule.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonad.MetaModule --- Copyright : (c) 2007 Spencer Janssen --- License : BSD3-style (see LICENSE) --- --- Maintainer : Spencer Janssen --- Stability : unstable --- Portability : unportable --- --- This is an artificial dependency on all the XMonad.* modules. It is --- intended to help xmonad hackers ensure that contrib modules build after API --- changes. --- --- Please add new modules to this list (in alphabetical order). --- ------------------------------------------------------------------------------ - - -module XMonad.MetaModule () where - -import XMonad.Accordion () -import XMonad.Anneal () -import XMonad.Circle () -import XMonad.Commands () --- import XMonad.Combo () -- broken under ghc head -import XMonad.ConstrainedResize () -import XMonad.CopyWindow () -import XMonad.CycleWS () -import XMonad.DeManage () -import XMonad.DirectoryPrompt () -import XMonad.Dishes () -import XMonad.Dmenu () -import XMonad.DragPane () -import XMonad.DwmPromote () -import XMonad.DynamicLog () -import XMonad.DynamicWorkspaces () -import XMonad.Dzen () -import XMonad.EwmhDesktops () -import XMonad.FindEmptyWorkspace () -import XMonad.FlexibleResize () -import XMonad.FlexibleManipulate () -import XMonad.FloatKeys () -import XMonad.FocusNth () -import XMonad.Grid () -import XMonad.Invisible () --- import XMonad.HintedTile () --- import XMonad.LayoutCombinators () -import XMonad.LayoutModifier () -import XMonad.LayoutHints () -import XMonad.LayoutScreens () -import XMonad.MagicFocus () --- import XMonad.ManageDocks () -import XMonad.ManPrompt () --- import XMonad.Magnifier () -import XMonad.Maximize () --- import XMonad.Mosaic () -import XMonad.MosaicAlt () -import XMonad.MouseGestures () -import XMonad.MultiToggle () -import XMonad.NamedWindows () -import XMonad.NoBorders () -import XMonad.ResizableTile () -import XMonad.Roledex () -import XMonad.RotSlaves () -import XMonad.RotView () -import XMonad.Run () -import XMonad.SetWMName () -import XMonad.ShellPrompt () -import XMonad.SimpleDate () -import XMonad.SinkAll () -import XMonad.Spiral () -import XMonad.Square () -import XMonad.SshPrompt () -import XMonad.Submap () -import XMonad.SwapWorkspaces () --- import XMonad.SwitchTrans () -import XMonad.Tabbed () -import XMonad.TagWindows () -import XMonad.ThreeColumns () -import XMonad.TilePrime () -import XMonad.ToggleLayouts () -import XMonad.TwoPane () -import XMonad.XMonadPrompt () -import XMonad.XPrompt () -import XMonad.XPropManage () -import XMonad.XSelection () -import XMonad.XUtils () -import XMonad.Warp () -import XMonad.WindowBringer () -import XMonad.WindowNavigation () -import XMonad.WindowPrompt () -import XMonad.WmiiActions () -import XMonad.WorkspaceDir () -import XMonad.WorkspacePrompt () rmfile ./MetaModule.hs hunk ./XMonad/Layout/SwitchTrans.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} - ------------------------------------------------------------------------------ --- | --- Module : XMonad.Layout.SwitchTrans --- Copyright : (c) Lukas Mai --- License : BSD-style (see LICENSE) --- --- Maintainer : --- Stability : unstable --- Portability : unportable --- --- --- Ordinary layout transformers are simple and easy to use but inflexible. --- This module provides a more structured interface to them. --- --- The basic idea is to have a base layout and a set of layout transformers, --- of which at most one is active at any time. Enabling another transformer --- first disables any currently active transformer; i.e. it works like --- a 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 --- undo the current layout transformer, pass the message on to the base layout, --- then reapply the transformer. --- --- Another potential problem is that functions can't be (de-)serialized so this --- layout will not preserve state across xmonad restarts. --- --- Here's how you might use this in Config.hs: --- --- > layouts = --- > map ( --- > mkSwitch (M.fromList [ --- > ("full", const $ Layout $ noBorders Full) --- > ]) . --- > mkSwitch (M.fromList [ --- > ("mirror", Layout . Mirror) --- > ]) --- > ) [ Layout tiled ] --- --- (The @noBorders@ transformer is from "XMonad.Layout.NoBorders".) --- --- This example is probably overkill but it's very close to what I actually use. --- Anyway, this layout behaves like the default @tiled@ layout, until you send it --- @Enable@\/@Disable@\/@Toggle@ messages. From the definition of @keys@: --- --- > ... --- > , ((modMask, xK_f ), sendMessage $ Toggle "full") --- > , ((modMask, xK_r ), sendMessage $ Toggle "mirror") --- --- (You may want to use other keys. I don't use Xinerama so the default mod-r --- binding is useless to me.) --- --- After this, pressing @mod-f@ switches the current window to fullscreen mode. --- Pressing @mod-f@ again switches it back. Similarly, @mod-r@ rotates the layout --- by 90 degrees (and back). The nice thing is that your changes are kept: --- Rotating first then changing the size of the master area then rotating back --- does not undo the master area changes. --- --- The reason I use two stacked @SwitchTrans@ transformers instead of @mkSwitch --- (M.fromList [(\"full\", const $ Layout $ noBorders Full), (\"mirror\", --- Layout . Mirror)])@ is that I use @mod-f@ to \"zoom in\" on interesting --- windows, no matter what other layout transformers may be active. Having an --- extra fullscreen mode on top of everything else means I can zoom in and out --- without implicitly undoing \"normal\" layout transformers, like @Mirror@. --- Remember, inside a @SwitchTrans@ there can be at most one active layout --- transformer. ------------------------------------------------------------------------------ - -module XMonad.Layout.SwitchTrans ( - Toggle(..), - Enable(..), - Disable(..), - mkSwitch -) where - -import XMonad -import XMonad.Operations - -import qualified Data.Map as M -import Data.Map (Map) - ---import System.IO - - --- | Toggle the specified layout transformer. -data Toggle = Toggle String deriving (Eq, Typeable) -instance Message Toggle --- | Enable the specified transformer. -data Enable = Enable String deriving (Eq, Typeable) -instance Message Enable --- | Disable the specified transformer. -data Disable = Disable String deriving (Eq, Typeable) -instance Message Disable - -data SwitchTrans a = SwitchTrans { - base :: Layout a, - currTag :: Maybe String, - currLayout :: Layout a, - currFilt :: Layout a -> Layout a, - filters :: Map String (Layout a -> Layout a) -} - -instance Show (SwitchTrans a) where - show st = "SwitchTrans #" - -instance Read (SwitchTrans a) where - readsPrec _ _ = [] - -unLayout :: Layout a -> (forall l. (LayoutClass l a) => l a -> r) -> r -unLayout (Layout l) k = k l - -acceptChange :: (LayoutClass l a) => SwitchTrans a -> ((l a -> SwitchTrans a) -> b -> c) -> X b -> X c -acceptChange st f action = - -- seriously, Dave, you need to stop this - fmap (f (\l -> st{ currLayout = Layout l})) action - -instance LayoutClass SwitchTrans a where - description _ = "SwitchTrans" - - doLayout st r s = currLayout st `unLayout` \l -> do - --io $ hPutStrLn stderr $ "[ST]{ " ++ show st - x{- @(_, w) -} <- acceptChange st (fmap . fmap) (doLayout l r s) - --io $ hPutStrLn stderr $ "[ST]} " ++ show w - return x - - pureLayout st r s = currLayout st `unLayout` \l -> pureLayout l r s - - handleMessage st m - | Just (Disable tag) <- fromMessage m - , M.member tag (filters st) - = provided (currTag st == Just tag) $ disable - | Just (Enable tag) <- fromMessage m - , Just alt <- M.lookup tag (filters st) - = provided (currTag st /= Just tag) $ enable tag alt - | Just (Toggle tag) <- fromMessage m - , Just alt <- M.lookup tag (filters st) - = - if (currTag st == Just tag) then - disable - else - enable tag alt - | Just ReleaseResources <- fromMessage m - = currLayout st `unLayout` \cl -> do - --io $ hPutStrLn stderr $ "[ST]~ " ++ show st - acceptChange st fmap (handleMessage cl m) - | Just Hide <- fromMessage m - = currLayout st `unLayout` \cl -> do - --io $ hPutStrLn stderr $ "[ST]< " ++ show st - x <- acceptChange st fmap (handleMessage cl m) - --io $ hPutStrLn stderr $ "[ST]> " ++ show x - return x - | otherwise = base st `unLayout` \b -> do - x <- handleMessage b m - case x of - Nothing -> return Nothing - Just b' -> currLayout st `unLayout` \cl -> do - handleMessage cl (SomeMessage ReleaseResources) - let b'' = Layout b' - return . Just $ st{ base = b'', currLayout = currFilt st b'' } - where - enable tag alt = currLayout st `unLayout` \cl -> do - --io $ hPutStrLn stderr $ "[ST]+ " ++ show cl ++ " -> " ++ show (alt (base st)) - handleMessage cl (SomeMessage ReleaseResources) - return . Just $ st{ - currTag = Just tag, - currFilt = alt, - currLayout = alt (base st) } - disable = currLayout st `unLayout` \cl -> do - --io $ hPutStrLn stderr $ "[ST]- " ++ show cl ++ " -> " ++ show (base st) - handleMessage cl (SomeMessage ReleaseResources) - return . Just $ st{ - currTag = Nothing, - currFilt = id, - currLayout = base st } - --- | Take a transformer table and a base layout, and return a --- SwitchTrans layout. -mkSwitch :: Map String (Layout a -> Layout a) -> Layout a -> Layout a -mkSwitch fs b = Layout st - where - st = SwitchTrans{ - base = b, - currTag = Nothing, - currLayout = b, - currFilt = id, - filters = fs } - -provided :: Bool -> X (Maybe a) -> X (Maybe a) -provided c x - | c = x - | otherwise = return Nothing - rmfile ./XMonad/Layout/SwitchTrans.hs hunk ./XMonadContrib.cabal 82 - -- XMonad.Layout.SwitchTrans hunk ./XMonad/Layout/MultiToggle.hs 12 +-- +-- Dynamically apply and unapply transformers to your window layout. This can +-- be used to rotate your window layout by 90 degrees, or to make the +-- currently focused window occupy the whole screen (\"zoom in\") then undo +-- the transformation (\"zoom out\"). hunk ./XMonad/Layout/MultiToggle.hs 20 - EL(..), - unEL, - LayoutTransformer(..), + -- * Usage + -- $usage + Transformer(..), hunk ./XMonad/Layout/MultiToggle.hs 24 - (.*.), - HNil(..), + (??), + EOT(..), hunk ./XMonad/Layout/MultiToggle.hs 29 - hunk ./XMonad/Layout/MultiToggle.hs 35 +-- $usage +-- The basic idea is to have a base layout and a set of layout transformers, +-- of which at most one is active at any time. Enabling another transformer +-- first disables any currently active transformer; i.e. it works like a +-- 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 +-- undo the current layout transformer, pass the message on to the base +-- layout, then reapply the transformer. +-- +-- To use this module, you first have to define the transformers that you +-- want to be handled by @MultiToggle@. For example, if the transformer is +-- 'XMonad.Layouts.Mirror': +-- +-- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable) +-- > instance Transformer MIRROR Window where +-- > transform _ x k = k (Mirror x) +-- +-- @MIRROR@ can be any identifier (it has to start with an uppercase letter, +-- of course); I've chosen an all-uppercase version of the transforming +-- function's name here. You need to put @{-\# OPTIONS_GHC -fglasgow-exts \#-}@ +-- at the beginning of your file to be able to derive "Data.Typeable". +-- +-- Somewhere else in your file you probably have a definition of @layout@; +-- the default looks like this: +-- +-- > layout = tiled ||| Mirror tiled ||| Full +-- +-- After changing this to +-- +-- > layout = mkToggle (MIRROR ?? EOT) (tiled ||| Full) +-- +-- you can now dynamically apply the 'XMonad.Layouts.Mirror' transformation: +-- +-- > ... +-- > , ((modMask, xK_x ), sendMessage $ Toggle MIRROR) +-- > ... +-- +-- (That should be part of your key bindings.) When you press @mod-x@, the +-- active layout is mirrored. Another @mod-x@ and it's back to normal. +-- +-- It's also possible to stack @MultiToggle@s. Let's define a few more +-- transformers ('XMonad.Layout.NoBorders.noBorders' is in +-- "XMonad.Layout.NoBorders"): +-- +-- > 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 +-- +-- @ +-- layout = id +-- . 'XMonad.Layout.NoBorders.smartBorders' +-- . mkToggle (NOBORDERS ?? FULL ?? EOT) +-- . mkToggle (MIRROR ?? EOT) +-- $ tiled ||| 'XMonad.Layout.Grid.Grid' ||| 'XMonad.Layout.Circle.Circle' +-- @ +-- +-- By binding a key to @(sendMessage $ Toggle FULL)@ you can temporarily +-- maximize windows, in addition to being able to rotate layouts and remove +-- window borders. + +-- | A class to identify custom transformers (and look up transforming +-- functions by type). +class (Eq t, Typeable t) => Transformer t a | t -> a where + transform :: (LayoutClass l a) => t -> l a -> (forall l'. (LayoutClass l' a) => l' a -> b) -> b + hunk ./XMonad/Layout/MultiToggle.hs 111 -class (Eq t, Typeable t) => LayoutTransformer t a | t -> a where - transform :: t -> EL a -> EL a +transform' :: (Transformer t a) => t -> EL a -> EL a +transform' t el = el `unEL` \l -> transform t l EL hunk ./XMonad/Layout/MultiToggle.hs 114 -data Toggle a = forall t. (LayoutTransformer t a) => Toggle t +-- | Toggle the specified layout transformer. +data Toggle a = forall t. (Transformer t a) => Toggle t hunk ./XMonad/Layout/MultiToggle.hs 135 - let g = transform x in + let g = transform' x in hunk ./XMonad/Layout/MultiToggle.hs 152 +-- | Construct a @MultiToggle@ layout from a transformer table and a base +-- layout. hunk ./XMonad/Layout/MultiToggle.hs 157 -data HNil = HNil deriving (Read, Show) +-- | Marks the end of a transformer list. +data EOT = EOT deriving (Read, Show) hunk ./XMonad/Layout/MultiToggle.hs 161 -infixr 0 .*. -(.*.) :: (HList b w) => a -> b -> HCons a b -(.*.) = HCons +infixr 0 ?? +-- | Prepend an element to a heterogenuous list. Used to build transformer +-- tables for 'mkToggle'. +(??) :: (HList b w) => a -> b -> HCons a b +(??) = HCons hunk ./XMonad/Layout/MultiToggle.hs 168 - find :: (LayoutTransformer t a) => c -> t -> Maybe Int - resolve :: c -> Int -> b -> (forall t. (LayoutTransformer t a) => t -> b) -> b + find :: (Transformer t a) => c -> t -> Maybe Int + resolve :: c -> Int -> b -> (forall t. (Transformer t a) => t -> b) -> b hunk ./XMonad/Layout/MultiToggle.hs 171 -instance HList HNil w where - find HNil _ = Nothing - resolve HNil _ d _ = d +instance HList EOT w where + find EOT _ = Nothing + resolve EOT _ d _ = d hunk ./XMonad/Layout/MultiToggle.hs 175 -instance (LayoutTransformer a w, HList b w) => HList (HCons a b) w where +instance (Transformer a w, HList b w) => HList (HCons a b) w where hunk ./XMonad/Layout/MultiToggle.hs 213 - let f = transform t + let f = transform' t hunk ./XMonad/Layout/ToggleLayouts.hs 35 +-- hunk ./XMonad/Layout/ToggleLayouts.hs 39 +-- hunk ./XMonad/Util/Dzen.hs 32 +-- hunk ./XMonad/Util/Dzen.hs 39 +-- hunk ./XMonad/Util/Dzen.hs 57 +-- hunk ./XMonad/Util/Dzen.hs 64 +-- hunk ./XMonad/Util/Run.hs 13 --- Spenver Jannsen), XMonad.Util.Dzen (by glasser@mit.edu) and +-- Spenver Jannsen), XMonad.Util.Dzen (by glasser\@mit.edu) and hunk ./XMonad/Util/Run.hs 84 + hunk ./XMonad/Util/Run.hs 97 + hunk ./XMonad/Util/XSelection.hs 26 -import Graphics.X11.Xlib.Extras (Graphics.X11.Xlib.Extras.Event(ev_event_display, +import Graphics.X11.Xlib.Extras (Event(ev_event_display, hunk ./XMonad/Util/XSelection.hs 40 -import Foreign(Word8, Data.Bits.Bits (shiftL, (.&.), (.|.))) +import Foreign (Word8) +import Data.Bits (shiftL, (.&.), (.|.)) hunk ./XMonad/Prompt/Man.hs 1 -{-# OPTIONS_GHC -Wall #-} move ./XMonad/Hooks/EwmhDesktops ./XMonad/Hooks/EwmhDesktops.hs hunk ./XMonad/Hooks/EwmhDesktops.hs 3 --- Module : XMonadContrib.EwmhDesktops +-- Module : XMonad.Hooks.EwmhDesktops hunk ./XMonad/Hooks/EwmhDesktops.hs 14 -module XMonadContrib.EwmhDesktops ( +module XMonad.Hooks.EwmhDesktops ( hunk ./XMonad/Hooks/EwmhDesktops.hs 30 -import XMonadContrib.SetWMName +import XMonad.Hooks.SetWMName hunk ./XMonad/Hooks/EwmhDesktops.hs 35 --- > import XMonadContrib.EwmhDesktops +-- > import XMonad.Hooks.EwmhDesktops hunk ./XMonad/Hooks/EwmhDesktops.hs 41 --- %import XMonadContrib.EwmhDesktops +-- %import XMonad.Hooks.EwmhDesktops hunk ./XMonad/Layout/Magnifier.hs 28 -import XMonad.Layout.LayoutHelpers +-- import XMonad.Layout.LayoutHelpers hunk ./XMonad/Prompt.hs 5 --- Module : XMonadContrib.XPrompt +-- Module : XMonad.Prompt hunk ./XMonad/Prompt.hs 65 --- For usage examples see "XMonadContrib.ShellPrompt", --- "XMonadContrib.XMonadPrompt" or "XMonadContrib.SshPrompt" +-- For usage examples see "XMonad.Prompt.Shell", +-- "XMonad.Prompt.XMonad" or "XMonad.Prompt.Ssh" hunk ./XMonad/Actions/SinkAll.hs 3 --- Module : XmonadContrib.SinkAll +-- Module : Xmonad.Actions.SinkAll hunk ./XMonadContrib.cabal 56 + XMonad.Hooks.EwmhDesktops hunk ./XMonad/Hooks/DynamicLog.hs 84 - io . putStrLn . sepBy (ppSep pp) . ppOrder pp $ + io . ppOutput pp . sepBy (ppSep pp) . ppOrder pp $ hunk ./XMonad/Hooks/DynamicLog.hs 174 - , ppOrder :: [String] -> [String] } + , ppOrder :: [String] -> [String] + , ppOutput :: String -> IO () + } hunk ./XMonad/Hooks/DynamicLog.hs 188 - , ppOrder = id } + , ppOrder = id + , ppOutput = putStrLn + } hunk ./XMonad/Util/Run.hs 27 - seconds + seconds, + spawnPipe hunk ./XMonad/Util/Run.hs 32 +import System.Posix.IO hunk ./XMonad/Util/Run.hs 38 -import System.IO (IO, FilePath, hPutStr, hGetContents, hFlush, hClose) +import System.IO hunk ./XMonad/Util/Run.hs 120 +-- | Launch an external application and return a 'Handle' to its standard input. +spawnPipe :: String -> IO Handle +spawnPipe x = do + (rd, wr) <- createPipe + 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 + return h + hunk ./XMonad/Config/Sjanssen.hs 13 +import XMonad.Util.Run (spawnPipe) hunk ./XMonad/Config/Sjanssen.hs 18 +import System.IO (hPutStrLn) hunk ./XMonad/Config/Sjanssen.hs 20 -sjanssenConfig :: XConfig -sjanssenConfig = defaultConfig +sjanssenConfig :: IO XConfig +sjanssenConfig = do + xmobar <- spawnPipe "xmobar" + return $ defaultConfig hunk ./XMonad/Config/Sjanssen.hs 27 - , logHook = dynamicLogWithPP sjanssenPP + , logHook = dynamicLogWithPP $ sjanssenPP { ppOutput = hPutStrLn xmobar } hunk ./XMonad/Hooks/DynamicLog.hs 34 - xmobarColor, dzenColor, dzenEscape + xmobarColor, dzenColor, dzenEscape, + makeSimpleDzenConfig hunk ./XMonad/Hooks/DynamicLog.hs 48 +import System.IO hunk ./XMonad/Hooks/DynamicLog.hs 50 +import XMonad.Util.Run hunk ./XMonad/Hooks/DynamicLog.hs 63 +-- | An example xmonad config that spawns a new dzen toolbar and uses the default +-- dynamic log output +makeSimpleDzenConfig :: IO XConfig +makeSimpleDzenConfig = do + h <- spawnPipe "dzen2" + return defaultConfig + { logHook = dynamicLogWithPP defaultPP + { ppOutput = hPutStrLn h } } hunk ./XMonad/Hooks/DynamicLog.hs 69 - { logHook = dynamicLogWithPP defaultPP + { defaultGaps = [(18,0,0,0)] + , logHook = dynamicLogWithPP defaultPP hunk ./XMonad/Config/Dons.hs 16 -import XMonad.Config hunk ./XMonad/Config/Dons.hs 18 -config :: XConfig -config = defaultConfig - { borderWidth = 2 - , defaultGaps = [(18,0,0,0)] - , terminal = "term" - , normalBorderColor = "#cccccc" - , focusedBorderColor = "#cd8b00" - , logHook = dynamicLogDzen } +donsMain :: IO () +donsMain = dzen $ \conf -> xmonad $ conf + { borderWidth = 2 + , terminal = "term" + , normalBorderColor = "#cccccc" + , focusedBorderColor = "#cd8b00" } hunk ./XMonad/Hooks/DynamicLog.hs 28 + dzen, hunk ./XMonad/Hooks/DynamicLog.hs 71 - , logHook = dynamicLogWithPP defaultPP + , logHook = dynamicLogWithPP dzenPP hunk ./XMonad/Hooks/DynamicLog.hs 74 +-- | +-- +-- Run xmonad with a dzen status bar set to some nice defaults. Output +-- it taken fromthe dynamicLogWithPP hook. +-- +-- > main = dzen xmonad +-- +-- The intent is that the avove config file should provide a nice status +-- bar with minimal effort. +-- +dzen :: (XConfig -> IO ()) -> IO () +dzen f = do + h <- spawnPipe ("dzen2" ++ " " ++ flags) + f $ defaultConfig + { defaultGaps = [(18,0,0,0)] + , logHook = dynamicLogWithPP dzenPP + { ppOutput = hPutStrLn h } } + where + fg = "'#a8a3f7'" -- n.b quoting + bg = "'#3f3c6d'" + flags = "-e '' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg + addfile ./XMonad/Config/Arossato.hs hunk ./XMonad/Config/Arossato.hs 1 - +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Config.Arossato +-- Copyright : (c) Andrea Rossato 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : stable +-- Portability : portable +-- +-- This module specifies my xmonad defaults. +-- +------------------------------------------------------------------------ + +module XMonad.Config.Arossato where + +import XMonad +import XMonad.Layouts +import XMonad.Operations +import qualified XMonad.StackSet as W +import Data.Ratio +import Data.Bits ((.|.)) +import qualified Data.Map as M +import Graphics.X11.Xlib + +import XMonad.Layout.Accordion +import XMonad.Hooks.DynamicLog +import XMonad.Layout.Tabbed +import XMonad.Layout.NoBorders +import XMonad.Actions.CycleWS +import XMonad.Prompt +import XMonad.Prompt.XMonad +import XMonad.Prompt.Shell +import XMonad.Prompt.Ssh +import XMonad.Prompt.Window + +myXPConfig :: XPConfig +myXPConfig = defaultXPConfig + +-- ion3 clean style +myTabConfig :: TConf +myTabConfig = defaultTConf { + activeColor = "#8a999e" + , inactiveColor = "#545d75" + , activeBorderColor = "white" + , inactiveBorderColor = "grey" + , activeTextColor = "white" + , inactiveTextColor = "grey" + , tabSize = 15 + } + +------------------------------------------------------------------------ +-- +-- Key bindings: +-- I want to remove some of the default key bindings, such as those to exit XMonad +defaultKeys :: XConfig -> M.Map (KeyMask, KeySym) (X ()) +defaultKeys x = M.fromList $ + -- launching and killing programs + [ ((modMask x .|. shiftMask, xK_Return), spawn "xterm") -- %! Launch an xterm + , ((modMask x, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu + , ((modMask x .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun + , ((modMask x .|. shiftMask, xK_c ), kill) -- %! Close the focused window + + , ((modMask x, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms + , ((modMask x .|. shiftMask, xK_space ), setLayout $ layoutHook x) -- %! Reset the layouts on the current workspace to default + + , ((modMask x, xK_n ), refresh) -- %! Resize viewed windows to the correct size + + -- move focus up or down the window stack + , ((modMask x, xK_Tab ), windows W.focusDown) -- %! Move focus to the next window + , ((modMask x, xK_m ), windows W.focusMaster ) -- %! Move focus to the master window + + -- modifying the window order + , ((modMask x, xK_Return), windows W.swapMaster) -- %! Swap the focused window and the master window + , ((modMask x .|. shiftMask, xK_j ), windows W.swapDown ) -- %! Swap the focused window with the next window + , ((modMask x .|. shiftMask, xK_k ), windows W.swapUp ) -- %! Swap the focused window with the previous window + + -- resizing the master/slave ratio + , ((modMask x, xK_h ), sendMessage Shrink) -- %! Shrink the master area + , ((modMask x, xK_l ), sendMessage Expand) -- %! Expand the master area + + -- floating layer support + , ((modMask x, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling + + -- increase or decrease number of windows in the master area + , ((modMask x , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area + , ((modMask x , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area + + -- toggle the status bar gap + , ((modMask x , xK_b ), modifyGap (\i n -> let s = (defaultGaps x ++ repeat (0,0,0,0)) !! i in if n == s then (0,0,0,0) else s)) -- %! Toggle the status bar gap + + ] + ++ + -- mod-[1..9] %! Switch to workspace N + -- mod-shift-[1..9] %! Move client to workspace N + [((m .|. modMask x, k), windows $ f i) + | (i, k) <- zip (workspaces x) [xK_1 ..] + , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)]] + ++ + -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 + -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3 + [((m .|. modMask x, key), screenWorkspace sc >>= flip whenJust (windows . f)) + | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..] + , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] + + ++ mykeys x + +-- These are my personal key bindings +mykeys :: XConfig -> [((KeyMask, KeySym), (X ()))] +mykeys x = + [ ((modMask x , xK_F12 ), xmonadPrompt myXPConfig ) + , ((modMask x , xK_F3 ), shellPrompt myXPConfig ) + , ((modMask x , xK_F4 ), sshPrompt myXPConfig ) + , ((modMask x , xK_F5 ), windowPromptGoto myXPConfig ) + , ((modMask x .|. shiftMask , xK_F5 ), windowPromptBring myXPConfig ) + -- mod . mod , + , ((modMask x , xK_comma ), prevWS ) + , ((modMask x , xK_period), nextWS ) + -- mod left mod right + , ((modMask x , xK_Right ), windows W.focusDown ) + , ((modMask x , xK_Left ), windows W.focusUp ) + -- other stuff: launch some useful utilities + , ((modMask x , xK_F2 ), spawn "urxvt -fg white -bg black +sb" ) + , ((modMask x .|. shiftMask , xK_F4 ), spawn "~/bin/dict.sh" ) + , ((modMask x .|. shiftMask , xK_F5 ), spawn "~/bin/urlOpen.sh" ) + , ((modMask x , xK_c ), kill ) + ] + + +arossatoConfig :: XConfig +arossatoConfig = defaultConfig + { borderWidth = 1 + , workspaces = map show [1 .. 9 :: Int] + , logHook = dynamicLogWithPP sjanssenPP + , layoutHook = Layout $ noBorders mytab ||| + noBorders Full ||| tiled ||| + Mirror tiled ||| Accordion + , terminal = "xterm" + , normalBorderColor = "white" + , focusedBorderColor = "black" + , modMask = mod1Mask + , keys = defaultKeys + } + where mytab = tabbed shrinkText myTabConfig + tiled = Tall 1 0.03 0.5 hunk ./XMonadContrib.cabal 54 + XMonad.Config.Arossato hunk ./XMonad/Config/Arossato.hs 21 -import Data.Ratio hunk ./XMonad/Layout/Spiral.hs 43 -fibs = 1 : 1 : (zipWith (+) fibs (tail fibs)) +fibs = 1 : 1 : zipWith (+) fibs (tail fibs) hunk ./XMonad/Hooks/DynamicLog.hs 77 --- it taken fromthe dynamicLogWithPP hook. +-- it taken from the dynamicLogWithPP hook. hunk ./XMonad/Config/Droundy.hs 68 - [ ((modMask x .|. shiftMask, xK_c ), kill) -- %! Close the focused window + [ ((modMask x .|. shiftMask, xK_c ), kill1) -- %! Close the focused window hunk ./XMonad/Config/Droundy.hs 79 - , ((modMask x, xK_m ), windows W.focusMaster ) -- %! Move focus to the master window hunk ./XMonad/Config/Droundy.hs 88 - , ((modMask x , xK_Escape), broadcastMessage ReleaseResources >> restart (Just "xmonad-droundy") True) -- %! Restart xmonad + , ((modMask x , xK_Escape), broadcastMessage ReleaseResources >> restart (Just "xmonad") True) -- %! Restart xmonad hunk ./XMonad/Config/Droundy.hs 115 + , ((modMask x, xK_m ), workspacePrompt myXPConfig (windows . W.shift)) hunk ./XMonad/Hooks/ManageDocks.hs 19 + +-- The avoidStruts layout modifier allows you to make xmonad dynamically +-- avoid overlapping windows with panels. You can (optionally) enable this +-- on a selective basis, so that some layouts will effectively hide the +-- panel, by placing windows on top of it. An example use of avoidStruts +-- would be: + +-- > layoutHook = Layout $ toggleLayouts (noBorders Full) $ avoidStruts $ +-- > your actual layouts here ||| ... + +-- This would enable a full-screen mode that overlaps the panel, while all +-- other layouts avoid the panel. + hunk ./XMonad/Hooks/ManageDocks.hs 160 - let rect = Rectangle (x+10+fromIntegral l) (y+fromIntegral t) + let rect = Rectangle (x+fromIntegral l) (y+fromIntegral t) hunk ./XMonad/Hooks/ManageDocks.hs 48 -import Data.Word (Word32) +import Foreign.C.Types (CLong) hunk ./XMonad/Hooks/ManageDocks.hs 112 -getProp :: Atom -> Window -> X (Maybe [Word32]) +getProp :: Atom -> Window -> X (Maybe [CLong]) hunk ./XMonad/Hooks/SetWMName.hs 44 -import Data.Word (Word8) +import Foreign.C.Types (CChar) hunk ./XMonad/Hooks/SetWMName.hs 68 - changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToWord8List name) + changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToCCharList name) hunk ./XMonad/Hooks/SetWMName.hs 76 - latin1StringToWord8List :: String -> [Word8] - latin1StringToWord8List str = map (fromIntegral . ord) str + latin1StringToCCharList :: String -> [CChar] + latin1StringToCCharList str = map (fromIntegral . ord) str hunk ./XMonad/Util/XSelection.hs 40 -import Foreign (Word8) +import Foreign.C.Types (CChar) hunk ./XMonad/Util/XSelection.hs 149 -decode :: [Word8] -> String +decode :: [CChar] -> String hunk ./XMonad/Util/XSelection.hs 164 - multi_byte :: Int -> Word8 -> Int -> [Char] + multi_byte :: Int -> CChar -> Int -> [Char] hunk ./XMonad/Util/XSelection.hs 167 - aux :: Int -> [Word8] -> Int -> [Char] + aux :: Int -> [CChar] -> Int -> [Char] hunk ./XMonad/Util/Dzen.hs 57 --- hunk ./XMonad/Util/Dzen.hs 63 --- hunk ./XMonad/Util/NamedWindows.hs 19 - NamedWindow, - getName, - withNamedWindow, - unName + NamedWindow, + getName, + withNamedWindow, + unName hunk ./XMonad/Util/NamedWindows.hs 36 --- See "XMonadContrib.Mosaic" for an example of its use. +-- See "XMonad.Layout.Mosaic" for an example of its use. hunk ./XMonad/Util/XSelection.hs 3 --- Module : XMonadContrib.XSelection +-- Module : XMonad.Util.XSelection hunk ./XMonad/Util/XSelection.hs 46 - Add 'import XMonadContrib.XSelection' to the top of Config.hs + Add 'import XMonad.Util.XSelection' to the top of Config.hs hunk ./XMonad/Util/Dzen.hs 56 --- XMonadContrib.UrgencyHook. Usage: +-- XMonad.Hooks.UrgencyHook. Usage: hunk ./XMonad/Util/Dzen.hs 62 --- XMonadContrib.UrgencyHook. Usage: +-- XMonad.Hooks.UrgencyHook. Usage: hunk ./XMonad/Layout/Magnifier.hs 8 --- +-- hunk ./XMonad/Layout/Magnifier.hs 23 - magnifier, magnifier') where + magnifier, + Magnifier(..), + Magnifier'(..)) where hunk ./XMonad/Layout/Magnifier.hs 30 --- import XMonad.Layout.LayoutHelpers +import XMonad.Layout.LayoutModifier hunk ./XMonad/Layout/Magnifier.hs 41 -magnifier :: Layout Window -> Layout Window -magnifier = layoutModify (unlessMaster applyMagnifier) idModMod +data Magnifier a = Magnifier deriving (Read, Show) +instance LayoutModifier Magnifier Window where + modifierDescription _ = "Magnifier" + redoLayout _ = unlessMaster applyMagnifier hunk ./XMonad/Layout/Magnifier.hs 47 -magnifier' :: Layout Window -> Layout Window -magnifier' = layoutModify applyMagnifier idModMod +data Magnifier' a = Magnifier' deriving (Read, Show) +instance LayoutModifier Magnifier' Window where + modifierDescription _ = "Magnifier'" + redoLayout _ = applyMagnifier + +magnifier :: l a -> ModifiedLayout Magnifier l a +magnifier = ModifiedLayout Magnifier hunk ./XMonad/Layout/Magnifier.hs 55 -unlessMaster :: ModDo Window -> ModDo Window +unlessMaster :: forall t t1 a a1 (m :: * -> *). (Monad m) => (t -> Stack a -> t1 -> m (t1, Maybe a1)) -> t -> Stack a -> t1 -> m (t1, Maybe a1) hunk ./XMonad/Layout/Magnifier.hs 59 -applyMagnifier :: ModDo Window +applyMagnifier :: Rectangle -> t -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe a) hunk ./XMonad/Layout/Magnifier.hs 75 - where x' = max sx x + where x' = max sx x hunk ./XMonad/Util/Run.hs 107 -safeSpawn :: FilePath -> String -> X () -safeSpawn prog arg = io (try (forkProcess $ executeFile prog True [arg] Nothing) >> return ()) -unsafeSpawn :: String -> X () +safeSpawn :: MonadIO m => FilePath -> String -> m () +safeSpawn prog arg = liftIO (try (forkProcess $ executeFile prog True [arg] Nothing) >> return ()) +unsafeSpawn :: MonadIO m => String -> m () hunk ./XMonad/Actions/DynamicWorkspaces.hs 20 + withWorkspace, hunk ./XMonad/Actions/DynamicWorkspaces.hs 29 -import XMonad ( X, XState(..), Layout, WorkspaceId, WindowSet, config, layoutHook ) +import XMonad ( X, XState(..), WindowSet, config, layoutHook ) hunk ./XMonad/Actions/DynamicWorkspaces.hs 32 -import Graphics.X11.Xlib ( Window ) hunk ./XMonad/Actions/DynamicWorkspaces.hs 33 -import XMonad.Prompt ( XPConfig ) +import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) ) hunk ./XMonad/Actions/DynamicWorkspaces.hs 51 -allPossibleTags :: [WorkspaceId] -allPossibleTags = map (:"") ['0'..] +data Wor = Wor String + +instance XPrompt Wor where + showXPrompt (Wor x) = x + +mkCompl :: [String] -> String -> IO [String] +mkCompl l s = return $ filter (\x -> take (length s) x == s) l + +withWorkspace :: XPConfig -> (String -> X ()) -> X () +withWorkspace c job = do ws <- gets (workspaces . windowset) + let ts = sort $ map tag ws + job' t | t `elem` ts = job t + | otherwise = addHiddenWorkspace t >> job t + mkXPrompt (Wor "") c (mkCompl ts) job' hunk ./XMonad/Actions/DynamicWorkspaces.hs 87 - do l <- asks (layoutHook . config) - windows $ \s -> if tagMember w s - then greedyView w s - else addWorkspace' w l s + do s <- gets windowset + if tagMember w s + then windows $ greedyView w + else addWorkspace w + +addWorkspace :: String -> X () +addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag) hunk ./XMonad/Actions/DynamicWorkspaces.hs 95 -addWorkspace :: Layout Window -> X () -addWorkspace l = do s <- gets windowset - let newtag:_ = filter (not . (`tagMember` s)) allPossibleTags - windows (addWorkspace' newtag l) +addHiddenWorkspace :: String -> X () +addHiddenWorkspace newtag = do l <- asks (layoutHook . config) + windows (addHiddenWorkspace' newtag l) hunk ./XMonad/Actions/DynamicWorkspaces.hs 108 -addWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd -addWorkspace' newtag l s@(StackSet { current = scr@(Screen { workspace = w }) - , hidden = ws }) - = s { current = scr { workspace = Workspace newtag l Nothing } - , hidden = w:ws } +addHiddenWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd +addHiddenWorkspace' newtag l s@(StackSet { hidden = ws }) = s { hidden = Workspace newtag l Nothing:ws } hunk ./XMonad/Config/Droundy.hs 46 -import XMonad.Prompt.Workspace hunk ./XMonad/Config/Droundy.hs 72 - , ((modMask x, xK_n ), refresh) -- %! Resize viewed windows to the correct size - hunk ./XMonad/Config/Droundy.hs 112 - , ((modMask x, xK_m ), workspacePrompt myXPConfig (windows . W.shift)) - , ((modMask x .|. shiftMask, xK_m ), workspacePrompt myXPConfig (windows . copy)) + , ((modMask x, xK_m ), withWorkspace myXPConfig (windows . W.shift)) + , ((modMask x .|. shiftMask, xK_m ), withWorkspace myXPConfig (windows . copy)) hunk ./XMonad/Config/Droundy.hs 116 - , ((modMask x .|. controlMask, xK_f), sendMessage (JumpToLayout "Full")) hunk ./XMonad/Config/Droundy.hs 118 - -- % Extension-provided key bindings lists - hunk ./XMonad/Config/Droundy.hs 134 - - -- % Extension-provided mouse bindings hunk ./XMonad/Config/Droundy.hs 136 --- % Extension-provided definitions - hunk ./XMonad/Actions/DynamicWorkspaces.hs 40 --- > , ((modMask .|. shiftMask, xK_n), selectWorkspace defaultXPConfig) hunk ./XMonad/Actions/DynamicWorkspaces.hs 41 --- > , ((modMask .|. shiftMask .|. controlMask, xK_r), renameWorkspace defaultXPConfig) +-- > , ((modMask x .|. shiftMask, xK_v ), selectWorkspace defaultXPConfig) +-- > , ((modMask x, xK_m ), withWorkspace defaultXPConfig (windows . W.shift)) +-- > , ((modMask x .|. shiftMask, xK_m ), withWorkspace defaultXPConfig (windows . copy)) +-- > , ((modMask x .|. shiftMask, xK_r ), renameWorkspace defaultXPConfig) hunk ./XMonad/Util/Run.hs 13 --- Spenver Jannsen), XMonad.Util.Dzen (by glasser\@mit.edu) and +-- Spencer Jannsen), XMonad.Util.Dzen (by glasser\@mit.edu) and hunk ./XMonad/Hooks/ManageDocks.hs 159 - do (t,l,b,r) <- calcGap + do (t,b,l,r) <- calcGap hunk ./XMonad/Hooks/UrgencyHook.hs 28 -import {-# SOURCE #-} Config (urgencyHook, logHook) -import Operations (windows) -import qualified StackSet as W +import XMonad.Operations (windows) +import qualified XMonad.StackSet as W hunk ./XMonad/Hooks/UrgencyHook.hs 34 +import Control.Monad.Reader (asks) hunk ./XMonad/Hooks/UrgencyHook.hs 89 +-- (Hey, I don't like it any more than you do.) hunk ./XMonad/Hooks/UrgencyHook.hs 97 -data WithUrgencyHook a = WithUrgencyHook deriving (Read, Show) +data WithUrgencyHook h a = WithUrgencyHook h deriving (Read, Show) hunk ./XMonad/Hooks/UrgencyHook.hs 99 -instance LayoutModifier WithUrgencyHook Window where - handleMess _ mess +instance UrgencyHook h Window => LayoutModifier (WithUrgencyHook h) Window where + handleMess (WithUrgencyHook theHook) mess hunk ./XMonad/Hooks/UrgencyHook.hs 105 - urgencyHook w + urgencyHook theHook w hunk ./XMonad/Hooks/UrgencyHook.hs 113 - logHook -- call logHook after IORef has been modified + -- Call logHook after IORef has been modified. + theLogHook <- asks (logHook . config) + theLogHook hunk ./XMonad/Hooks/UrgencyHook.hs 136 -withUrgencyHook :: LayoutClass l Window => l Window -> ModifiedLayout WithUrgencyHook l Window -withUrgencyHook = ModifiedLayout WithUrgencyHook +withUrgencyHook :: (UrgencyHook h Window, LayoutClass l Window) => + h -> l Window -> ModifiedLayout (WithUrgencyHook h) l Window +withUrgencyHook theHook = ModifiedLayout $ WithUrgencyHook theHook + +class (Read h, Show h) => UrgencyHook h a where + urgencyHook :: h -> a -> X () hunk ./XMonadContrib.cabal 60 - -- XMonad.Hooks.UrgencyHook + XMonad.Hooks.UrgencyHook hunk ./XMonad/Util/Dzen.hs 16 - dzenUrgencyHook, dzenUrgencyHookWithArgs, - seconds) where + seconds) where hunk ./XMonad/Util/Dzen.hs 18 -import Control.Monad (when) -import Control.Monad.State (gets) -import qualified Data.Set as S -import Graphics.X11.Types (Window) - -import qualified XMonad.StackSet as W hunk ./XMonad/Util/Dzen.hs 19 - -import XMonad.Util.NamedWindows (getName) hunk ./XMonad/Util/Dzen.hs 46 --- | Flashes when a window requests your attention and you can't see it. For use with --- XMonad.Hooks.UrgencyHook. Usage: --- > urgencyHook = dzenUrgencyHook (5 `seconds`) -dzenUrgencyHook :: Int -> Window -> X () -dzenUrgencyHook = dzenUrgencyHookWithArgs [] - --- | Flashes when a window requests your attention and you can't see it. For use with --- XMonad.Hooks.UrgencyHook. Usage: --- > urgencyHook = dzenUrgencyHookWithArgs ["-bg", "darkgreen"] (5 `seconds`) -dzenUrgencyHookWithArgs :: [String] -> Int -> Window -> X () -dzenUrgencyHookWithArgs args duration w = do - visibles <- gets mapped - name <- getName w - ws <- gets windowset - whenJust (W.findTag w ws) (flash name visibles) - where flash name visibles index = - when (not $ S.member w visibles) $ - dzenWithArgs (show name ++ " requests your attention on workspace " ++ index) - args duration - hunk ./XMonad/Hooks/UrgencyHook.hs 24 - readUrgents, - withUrgents + readUrgents, withUrgents, + dzenUrgencyHook, seconds hunk ./XMonad/Hooks/UrgencyHook.hs 28 +import XMonad hunk ./XMonad/Hooks/UrgencyHook.hs 31 -import XMonad + hunk ./XMonad/Hooks/UrgencyHook.hs 33 +import XMonad.Util.Dzen (dzenWithArgs, seconds) +import XMonad.Util.NamedWindows (getName) hunk ./XMonad/Hooks/UrgencyHook.hs 144 - urgencyHook :: h -> a -> X () + urgencyHook :: h -> a -> X () + +data DzenUrgencyHook = DzenUrgencyHook { duration :: Int, args :: [String] } + deriving (Read, Show) + +instance UrgencyHook DzenUrgencyHook Window where + urgencyHook DzenUrgencyHook { duration = d, args = a } w = do + visibles <- gets mapped + name <- getName w + ws <- gets windowset + whenJust (W.findTag w ws) (flash name visibles) + where flash name visibles index = + when (not $ S.member w visibles) $ + dzenWithArgs (show name ++ " requests your attention on workspace " ++ index) a d + +-- | Flashes when a window requests your attention and you can't see it. For use with +-- XMonad.Hooks.UrgencyHook. Usage: +-- > urgencyHook = dzenUrgencyHook (5 `seconds`) +-- > urgencyHook = dzenUrgencyHookWithArgs ["-bg", "darkgreen"] (5 `seconds`) +dzenUrgencyHook :: DzenUrgencyHook +dzenUrgencyHook = DzenUrgencyHook { duration = (5 `seconds`), args = [] } hunk ./XMonad/Hooks/UrgencyHook.hs 25 - dzenUrgencyHook, seconds + dzenUrgencyHook, DzenUrgencyHook(..), + seconds hunk ./XMonad/Hooks/UrgencyHook.hs 25 + NoUrgencyHook(..), hunk ./XMonad/Hooks/UrgencyHook.hs 148 +data NoUrgencyHook = NoUrgencyHook deriving (Read, Show) + +instance UrgencyHook NoUrgencyHook Window where + urgencyHook _ _ = return () + hunk ./XMonad/Hooks/UrgencyHook.hs 51 --- To wire this up, add: +-- To wire this up, first add: hunk ./XMonad/Hooks/UrgencyHook.hs 55 --- to your import list in Config. Change your defaultLayout such that --- withUrgencyHook is applied along the chain. Mine, for example: +-- to your import list in your config file. Now, choose an urgency hook. If +-- you're just interested in displaying the urgency state in your custom +-- logHook, then choose NoUrgencyHook. Otherwise, you may use the provided +-- dzenUrgencyHook, or write your own. hunk ./XMonad/Hooks/UrgencyHook.hs 60 --- > layoutHook = Layout $ withUrgencyHook $ windowNavigation $ --- > Select layouts +-- Wire your urgency hook into the layoutHook by use of the withUrgencyHook +-- function. My setup, for example: +-- +-- > layoutHook' = Layout $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] } +-- > $ configurableNavigation noNavigateBorders +-- > $ layouts hunk ./XMonad/Hooks/UrgencyHook.hs 69 --- messages sent to it. Next, add your actual urgencyHook to Config. This --- needs to take a Window and return an X () action. Here's an example: --- --- > import XMonad.Util.Dzen --- ... --- > urgencyHook :: Window -> X () --- > urgencyHook = dzenUrgencyHook (5 `seconds`) --- --- If you're comfortable with programming in the X monad, then you can build --- whatever urgencyHook you like. Finally, in order to make this compile, --- open up your Config.hs-boot file and add the following to it: --- --- > urgencyHook :: Window -> X () --- --- Compile! +-- messages sent to it. hunk ./XMonad/Hooks/UrgencyHook.hs 71 --- You can also modify your logHook to print out information about urgent windows. --- The functions readUrgents and withUrgents are there to help you with that. +-- If you want to modify your logHook to print out information about urgent windows, +-- the functions readUrgents and withUrgents are there to help you with that. hunk ./XMonad/Hooks/UrgencyHook.hs 61 --- function. My setup, for example: +-- function. For example, add this to your config record: hunk ./XMonad/Hooks/UrgencyHook.hs 63 --- > layoutHook' = Layout $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] } --- > $ configurableNavigation noNavigateBorders --- > $ layouts +-- > , layoutHook = Layout $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] } +-- > $ layout hunk ./XMonad/Hooks/UrgencyHook.hs 157 --- | Flashes when a window requests your attention and you can't see it. For use with --- XMonad.Hooks.UrgencyHook. Usage: --- > urgencyHook = dzenUrgencyHook (5 `seconds`) --- > urgencyHook = dzenUrgencyHookWithArgs ["-bg", "darkgreen"] (5 `seconds`) +-- | Flashes when a window requests your attention and you can't see it. Configurable +-- duration and args to dzen. hunk ./XMonad/Hooks/UrgencyHook.hs 1 -{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} hunk ./XMonad/Hooks/UrgencyHook.hs 101 - urgencyHook theHook w + userCode $ urgencyHook theHook w hunk ./XMonad/Hooks/UrgencyHook.hs 110 - theLogHook <- asks (logHook . config) - theLogHook + userCode =<< asks (logHook . config) hunk ./XMonad/Hooks/UrgencyHook.hs 41 -import Data.Bits (testBit, clearBit) +import Data.Bits (testBit) hunk ./XMonad/Hooks/UrgencyHook.hs 43 -import Data.List ((\\), delete) +import Data.List (delete) hunk ./XMonad/Hooks/UrgencyHook.hs 99 - wmh@WMHints { wmh_flags = flags } <- io $ getWMHints dpy w - when (testBit flags urgencyHintBit) $ do + WMHints { wmh_flags = flags } <- io $ getWMHints dpy w + if (testBit flags urgencyHintBit) + then do + -- Note: Broken clients, such as Xchat2, will set the urgency flag multiple + -- times (perhaps in an effort to get the task bar to "flash"). If this + -- bothers you, please submit a bug report. hunk ./XMonad/Hooks/UrgencyHook.hs 106 - -- Clear the urgency bit in the WMHints flags field. According to the - -- Xlib manual, the *client* is supposed to clear this flag when the urgency - -- has been resolved, but, Xchat2, for example, sets the WMHints several - -- times (e.g. causing the dzen to blink) unless it's cleared. XMonad is - -- not a typical WM, so we're just breaking one more rule, here. - io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit } hunk ./XMonad/Hooks/UrgencyHook.hs 107 - -- Call logHook after IORef has been modified. - userCode =<< asks (logHook . config) - -- Doing the setWMHints triggers another propertyNotify with the bit - -- cleared, so we ignore that message. This has the potentially wrong - -- effect of ignoring *all* urgency-clearing messages, some of which might - -- be legitimate. Let's wait for bug reports on that, though. + else + -- Remove window from urgents list when client removes urgency status. + -- The client should do this, e.g., when it receives focus. + adjustUrgents (delete w) + -- Call logHook after IORef has been modified. + userCode =<< asks (logHook . config) hunk ./XMonad/Hooks/UrgencyHook.hs 120 - -- Clear the urgency bit and remove from the urgent list when the window becomes visible. - redoLayout _ _ _ windowRects = do - visibles <- gets mapped - adjustUrgents (\\ (S.toList visibles)) - return (windowRects, Nothing) - addfile ./XMonad/Util/EZConfig.hs hunk ./XMonad/Util/EZConfig.hs 1 +-------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.EZConfig +-- Copyright : Devin Mullins +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Devin Mullins +-- +-- Useful helper functions for amending the defaultConfig. +-- +-------------------------------------------------------------------- + +module XMonad.Util.EZConfig ( + additionalKeys, removeKeys, + additionalMouseBindings, removeMouseBindings + ) where +-- TODO: write tests + +import XMonad + +import qualified Data.Map as M +import Graphics.X11.Xlib + +-- Add or override keybindings from the existing set. Example use: +-- > main = xmonad $ defaultConfig { terminal = "urxvt" } +-- > `additionalKeys` +-- > [ ((mod1Mask, xK_m ), spawn "echo 'Hi, mom!' | dzen2 -p 4") +-- > , ((mod1Mask, xK_BackSpace), withFocused hide) -- N.B. this is an absurd thing to do +-- > ] +-- This overrides the previous definition of mod-m. +-- +-- Note that, unlike in xmonad 0.4 and previous, you can't use modMask to refer +-- to the modMask you configured earlier. You must specify mod1Mask (or +-- whichever), or add your own @myModMask = mod1Mask@ line. +additionalKeys :: XConfig -> [((ButtonMask, KeySym), X ())] -> XConfig +additionalKeys conf keysList = + conf { keys = \cnf -> M.union (M.fromList keysList) (keys conf cnf) } + +-- Remove standard keybidings you're not using. Example use: +-- > main = xmonad $ defaultConfig { terminal = "urxvt" } +-- > `removeKeys` [(mod1Mask .|. shiftMask, n) | n <- [xK_1 .. xK_9]] +removeKeys :: XConfig -> [(ButtonMask, KeySym)] -> XConfig +removeKeys conf keyList = + conf { keys = \cnf -> keys conf cnf `M.difference` M.fromList (zip keyList $ return ()) } + +-- Like additionalKeys, but for mouseBindings. +additionalMouseBindings :: XConfig -> [((ButtonMask, Button), Window -> X ())] -> XConfig +additionalMouseBindings conf mouseBindingsList = + conf { mouseBindings = \cnf -> M.union (M.fromList mouseBindingsList) (mouseBindings conf cnf) } + +-- Like removeKeys, but for mouseBindings. +removeMouseBindings :: XConfig -> [(ButtonMask, Button)] -> XConfig +removeMouseBindings conf mouseBindingList = + conf { mouseBindings = \cnf -> mouseBindings conf cnf `M.difference` + M.fromList (zip mouseBindingList $ return ()) } hunk ./XMonadContrib.cabal 102 + XMonad.Util.EZConfig hunk ./XMonad/Config/Droundy.hs 37 +import XMonad.Layout.Named hunk ./XMonad/Config/Droundy.hs 47 +import XMonad.Prompt.Layout hunk ./XMonad/Config/Droundy.hs 117 + , ((modMask x, xK_l ), layoutPrompt myXPConfig) hunk ./XMonad/Config/Droundy.hs 144 - noBorders mytab ||| - mytab <-/> combineTwo Square mytab mytab ||| + Named "tabbed" (noBorders mytab) ||| + Named "xclock" (mytab <-/> combineTwo Square mytab mytab) ||| addfile ./XMonad/Layout/Named.hs hunk ./XMonad/Layout/Named.hs 1 +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Named +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.Named ( + -- * Usage + -- $usage + Named(Named) + ) where + +import XMonad + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonad.Layout.Named +-- +-- and change the name of a given layout by +-- +-- > layout = Named "real big" Full ||| ... + +data Named l a = Named String (l a) deriving ( Read, Show ) + +instance (LayoutClass l a) => LayoutClass (Named l) a where + doLayout (Named n l) r s = do (ws, ml') <- doLayout l r s + return (ws, Named n `fmap` ml') + handleMessage (Named n l) mess = do ml' <- handleMessage l mess + return $ Named n `fmap` ml' + description (Named n _) = n addfile ./XMonad/Prompt/Layout.hs hunk ./XMonad/Prompt/Layout.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Layout +-- Copyright : (C) 2007 Andrea Rossato, David Roundy +-- License : BSD3 +-- +-- Maintainer : droundy@darcs.net +-- Stability : unstable +-- Portability : unportable +-- +-- A layout-selection prompt for XMonad +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.Layout ( + -- * Usage + -- $usage + layoutPrompt + ) where + +import Control.Monad.State ( gets ) +import Data.List ( sort, nub ) +import XMonad hiding ( workspaces ) +import XMonad.Operations ( sendMessage ) +import XMonad.Prompt +import XMonad.StackSet ( workspaces, layout ) +import XMonad.Layout.LayoutCombinators ( JumpToLayout(..) ) + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonad.Prompt.Layout +-- +-- > , ((modMask .|. shiftMask, xK_m ), layoutPrompt defaultXPConfig) + +-- WARNING: This prompt won't display all possible layouts, because the +-- code to enable this was rejected from xmonad core. It only displays +-- layouts that are actually in use. Also, you can only select layouts if +-- you are using NewSelect, rather than the Select defined in xmonad core +-- (which doesn't have this feature). So all in all, this module is really +-- more a proof-of-principle than something you can actually use +-- productively. + +data Wor = Wor String + +instance XPrompt Wor where + showXPrompt (Wor x) = x + +layoutPrompt :: XPConfig -> X () +layoutPrompt c = do ls <- gets (map (description . layout) . workspaces . windowset) + mkXPrompt (Wor "") c (mkCompl $ sort $ nub ls) (sendMessage . JumpToLayout) + +mkCompl :: [String] -> String -> IO [String] +mkCompl l s = return $ filter (\x -> take (length s) x == s) l hunk ./XMonadContrib.cabal 79 + XMonad.Layout.Named hunk ./XMonadContrib.cabal 94 + XMonad.Prompt.Layout hunk ./XMonad/Hooks/DynamicLog.hs 88 - { defaultGaps = [(18,0,0,0)] + { defaultGaps = [(15,0,0,0)] -- for fixed hunk ./XMonadContrib.cabal 27 - build-depends: mtl, unix, X11==1.3.0, xmonad==0.4 + build-depends: mtl, unix, X11==1.3.0.20071111, xmonad==0.4 hunk ./XMonad/Config/Arossato.hs 1 +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} hunk ./XMonad/Config/Arossato.hs 56 -defaultKeys :: XConfig -> M.Map (KeyMask, KeySym) (X ()) +defaultKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) hunk ./XMonad/Config/Arossato.hs 109 -mykeys :: XConfig -> [((KeyMask, KeySym), (X ()))] +mykeys :: XConfig Layout -> [((KeyMask, KeySym), (X ()))] hunk ./XMonad/Config/Arossato.hs 130 -arossatoConfig :: XConfig hunk ./XMonad/Config/Droundy.hs 1 +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} hunk ./XMonad/Config/Droundy.hs 67 -keys :: XConfig -> M.Map (KeyMask, KeySym) (X ()) +keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) hunk ./XMonad/Config/Droundy.hs 129 -mouseBindings :: XConfig -> M.Map (KeyMask, Button) (Window -> X ()) +mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) hunk ./XMonad/Config/Droundy.hs 140 -config :: XConfig hunk ./XMonad/Config/Droundy.hs 143 - , layoutHook = Layout $ workspaceDir "~" $ windowNavigation $ toggleLayouts (noBorders Full) $ + , layoutHook = workspaceDir "~" $ windowNavigation $ toggleLayouts (noBorders Full) $ hunk ./XMonad/Config/Sjanssen.hs 1 +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} hunk ./XMonad/Config/Sjanssen.hs 21 -sjanssenConfig :: IO XConfig hunk ./XMonad/Config/Sjanssen.hs 34 - , layoutHook = Layout (smartBorders (tiled ||| Mirror tiled ||| Full ||| tabbed shrinkText defaultTConf)) + , layoutHook = smartBorders (tiled ||| Mirror tiled ||| Full ||| tabbed shrinkText defaultTConf) hunk ./XMonad/Hooks/DynamicLog.hs 43 +import XMonad.Layouts hunk ./XMonad/Hooks/DynamicLog.hs 67 -makeSimpleDzenConfig :: IO XConfig +makeSimpleDzenConfig :: IO (XConfig (Choose Tall (Choose (Mirror Tall) Full))) hunk ./XMonad/Hooks/DynamicLog.hs 85 -dzen :: (XConfig -> IO ()) -> IO () +dzen :: (XConfig (Choose Tall (Choose (Mirror Tall) Full)) -> IO ()) -> IO () hunk ./XMonad/Util/EZConfig.hs 35 -additionalKeys :: XConfig -> [((ButtonMask, KeySym), X ())] -> XConfig +additionalKeys :: XConfig a -> [((ButtonMask, KeySym), X ())] -> XConfig a hunk ./XMonad/Util/EZConfig.hs 42 -removeKeys :: XConfig -> [(ButtonMask, KeySym)] -> XConfig +removeKeys :: XConfig a -> [(ButtonMask, KeySym)] -> XConfig a hunk ./XMonad/Util/EZConfig.hs 47 -additionalMouseBindings :: XConfig -> [((ButtonMask, Button), Window -> X ())] -> XConfig +additionalMouseBindings :: XConfig a -> [((ButtonMask, Button), Window -> X ())] -> XConfig a hunk ./XMonad/Util/EZConfig.hs 52 -removeMouseBindings :: XConfig -> [(ButtonMask, Button)] -> XConfig +removeMouseBindings :: XConfig a -> [(ButtonMask, Button)] -> XConfig a hunk ./XMonad/Hooks/UrgencyHook.hs 25 - NoUrgencyHook(..), + NoUrgencyHook(..), StdoutUrgencyHook(..), hunk ./XMonad/Hooks/UrgencyHook.hs 107 - else + else do hunk ./XMonad/Hooks/UrgencyHook.hs 110 + userCode $ nonUrgencyHook theHook w hunk ./XMonad/Hooks/UrgencyHook.hs 129 - urgencyHook :: h -> a -> X () + urgencyHook, nonUrgencyHook :: h -> a -> X () + + nonUrgencyHook _ _ = return () hunk ./XMonad/Hooks/UrgencyHook.hs 156 +-- For debugging purposes, really. +data StdoutUrgencyHook = StdoutUrgencyHook deriving (Read, Show) + +instance UrgencyHook StdoutUrgencyHook Window where + urgencyHook _ w = io $ putStrLn $ "Urgent: " ++ show w + nonUrgencyHook _ w = io $ putStrLn $ "Not Urgent: " ++ show w + hunk ./XMonad/Hooks/UrgencyHook.hs 25 + urgencyLayoutHook, hunk ./XMonad/Hooks/UrgencyHook.hs 35 -import XMonad.Layout.LayoutModifier +import XMonad.Layout.LayoutModifier hiding (hook) hunk ./XMonad/Hooks/UrgencyHook.hs 42 -import Data.Bits (testBit) +import Data.Bits (testBit, clearBit) hunk ./XMonad/Hooks/UrgencyHook.hs 44 -import Data.List (delete) +import Data.List ((\\), delete) hunk ./XMonad/Hooks/UrgencyHook.hs 47 +import Foreign (unsafePerformIO) hunk ./XMonad/Hooks/UrgencyHook.hs 50 -import Foreign (unsafePerformIO) hunk ./XMonad/Hooks/UrgencyHook.hs 75 +-- | This is the preferred method of enabling an urgency hook. It will prepend +-- an action to your logHook that remove visible windows from the list of urgent +-- windows. If you don't like that behavior, use urgencyLayoutHook instead. +withUrgencyHook :: (LayoutClass l Window, UrgencyHook h Window) => + h -> XConfig l -> XConfig (ModifiedLayout (WithUrgencyHook h) l) +withUrgencyHook hook conf = conf { layoutHook = urgencyLayoutHook hook $ layoutHook conf + , logHook = removeVisiblesFromUrgents >> logHook conf + } + +-- | The logHook action used by withUrgencyHook. +removeVisiblesFromUrgents :: X () +removeVisiblesFromUrgents = do + visibles <- gets mapped + adjustUrgents (\\ (S.toList visibles)) + hunk ./XMonad/Hooks/UrgencyHook.hs 111 +-- The Non-ICCCM Manifesto: +-- Note: Some non-standard choices have been made in this implementation to +-- account for the fact that things are different in a tiling window manager: +-- 1. Several clients (e.g. Xchat2, rxvt-unicode) set the urgency flag +-- 9 or 10 times in a row. This would, in turn, trigger urgencyHook repeatedly. +-- so in order to prevent that, we immediately clear the urgency flag. +-- 2. In normal window managers, windows may overlap, so clients wait for focus to +-- be set before urgency is cleared. In a tiling WM, it's sufficient to be able +-- see the window, since we know that means you can see it completely. +-- 3. The urgentOnBell setting in rxvt-unicode sets urgency even when the window +-- has focus, and won't clear until it loses and regains focus. This is stupid. +-- In order to account for these quirks, we clear the urgency bit immediately upon +-- receiving notification (thus suppressing the repeated notifications) and track +-- the list of urgent windows ourselves, allowing us to clear urgency when a window +-- is visible, and not to set urgency if a window is visible. +-- If you have a better idea, please, let us know! hunk ./XMonad/Hooks/UrgencyHook.hs 128 - handleMess (WithUrgencyHook theHook) mess + handleMess (WithUrgencyHook hook) mess hunk ./XMonad/Hooks/UrgencyHook.hs 131 - WMHints { wmh_flags = flags } <- io $ getWMHints dpy w - if (testBit flags urgencyHintBit) - then do - -- Note: Broken clients, such as Xchat2, will set the urgency flag multiple - -- times (perhaps in an effort to get the task bar to "flash"). If this - -- bothers you, please submit a bug report. - userCode $ urgencyHook theHook w + wmh@WMHints { wmh_flags = flags } <- io $ getWMHints dpy w + when (testBit flags urgencyHintBit) $ do + -- Call the urgencyHook. + userCode $ urgencyHook hook w + -- Clear the bit to prevent repeated notifications, as described above. + io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit } + -- Add to list of urgents. hunk ./XMonad/Hooks/UrgencyHook.hs 139 - else do - -- Remove window from urgents list when client removes urgency status. - -- The client should do this, e.g., when it receives focus. - userCode $ nonUrgencyHook theHook w - adjustUrgents (delete w) - -- Call logHook after IORef has been modified. - userCode =<< asks (logHook . config) + -- Call logHook after IORef has been modified. + userCode =<< asks (logHook . config) hunk ./XMonad/Hooks/UrgencyHook.hs 151 -withUrgencyHook :: (UrgencyHook h Window, LayoutClass l Window) => +urgencyLayoutHook :: (UrgencyHook h Window, LayoutClass l Window) => hunk ./XMonad/Hooks/UrgencyHook.hs 153 -withUrgencyHook theHook = ModifiedLayout $ WithUrgencyHook theHook +urgencyLayoutHook hook = ModifiedLayout $ WithUrgencyHook hook + +-------------------------------------------------------------------------------- +-- Urgency Hooks + +-- | The class definition, and some pre-defined instances. hunk ./XMonad/Hooks/UrgencyHook.hs 61 --- Wire your urgency hook into the layoutHook by use of the withUrgencyHook --- function. For example, add this to your config record: +-- Enable your urgency hook by wrapping your config record in a call to +-- withUrgencyHook. For example: hunk ./XMonad/Hooks/UrgencyHook.hs 64 --- > , layoutHook = Layout $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] } --- > $ layout --- --- It shouldn't hurt to have the "withUrgencyHook $" at the outermost layer, --- as above, as UrgencyHook is a LayoutModifier, and hence passes on any --- messages sent to it. +-- > main = xmonad $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] } +-- > $ defaultConfig hunk ./XMonad/Hooks/UrgencyHook.hs 73 --- windows. If you don't like that behavior, use urgencyLayoutHook instead. +-- windows. If you don't like that behavior, you may use urgencyLayoutHook instead. hunk ./XMonad/Layout/NoBorders.hs 38 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your ~/.xmonad/xmonad.hs file: hunk ./XMonad/Layout/NoBorders.hs 43 --- borders +-- borders: hunk ./XMonad/Layout/NoBorders.hs 45 --- > layouts = [ Layout (noBorders Full), ... ] +-- > layoutHook = ... ||| noBorders Full ||| ... hunk ./XMonad/Layout/NoBorders.hs 103 --- > layoutHook = Layout $ smartBorders $ Select layouts +-- > layoutHook = smartBorders $ tiled ||| Mirror tiled ||| ... hunk ./XMonad/Layout/NoBorders.hs 56 - modifierDescription (WithBorder 0 _) = "NoBorders" - modifierDescription (WithBorder n _) = "Borders " ++ show n - hunk ./XMonad/Layout/NoBorders.hs 77 - modifierDescription _ = "SmartBorder" - hunk ./XMonad/Config/Droundy.hs 7 --- Maintainer : dons@galois.com --- Stability : stable --- Portability : portable --- --- This module specifies configurable defaults for xmonad. If you change --- values here, be sure to recompile and restart (mod-q) xmonad, --- for the changes to take effect. --- hunk ./XMonad/Config/Droundy.hs 14 -import XMonad hiding (keys,mouseBindings) -import qualified XMonad (keys,mouseBindings) +import XMonad hiding (keys) +import qualified XMonad (keys) hunk ./XMonad/Config/Droundy.hs 119 --- | Mouse bindings: default actions bound to mouse events --- -mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) -mouseBindings x = M.fromList $ - -- mod-button1 %! Set the window to floating mode and move by dragging - [ ((modMask x, button1), (\w -> focus w >> mouseMoveWindow w)) - -- mod-button2 %! Raise the window to the top of the stack - , ((modMask x, button2), (\w -> focus w >> windows W.swapMaster)) - -- mod-button3 %! Set the window to floating mode and resize by dragging - , ((modMask x, button3), (\w -> focus w >> mouseResizeWindow w)) - -- you may also bind events to the mouse scroll wheel (button4 and button5) - ] - hunk ./XMonad/Config/Droundy.hs 131 - , XMonad.mouseBindings = mouseBindings addfile ./XMonad/Config/CustomKeys.hs hunk ./XMonad/Config/CustomKeys.hs 1 +-------------------------------------------------------------------- +-- | +-- Module : XMonad.Config.CustomKeys +-- Copyright : (c) 2007 Valery V. Vorotyntsev +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Valery V. Vorotynsev +-- +-- Customized key bindings. +-- +-- (See also "XMonad.Util.EZConfig" in XMonadContrib.) +-------------------------------------------------------------------- + +module XMonad.Config.CustomKeys ( + -- * Usage + -- $usage + customKeys + ) where + +import XMonad +import Graphics.X11.Xlib + +import Control.Monad.Reader +import qualified Data.Map as M + +-- $usage +-- +-- 1. In @~\/.xmonad\/xmonad.hs@ add: +-- +-- > import XMonad.Config.CustomKeys +-- +-- 2. Set key bindings with 'customKeys': +-- +-- > main = xmonad defaultConfig { keys = customKeys delkeys inskeys } +-- > where +-- > delkeys :: XConfig l -> [(KeyMask, KeySym)] +-- > delkeys XConfig {modMask = modm} = +-- > -- we're preferring Futurama to Xinerama here +-- > [ (modm .|. m, k) | (m, k) <- zip [0, shiftMas] [xK_w, xK_e, xK_r] ] +-- > +-- > inskeys :: XConfig l -> [((KeyMask, KeySym), X ())] +-- > inskeys conf@(XConfig {modMask = modm}) = +-- > [ ((mod1Mask, xK_F2 ), spawn $ terminal conf) +-- > , ((modm .|. controlMask, xK_F11 ), spawn "xscreensaver-command -lock") +-- > , ((mod1Mask, xK_Down), spawn "amixer set Master 1-") +-- > , ((mod1Mask, xK_Up ), spawn "amixer set Master 1+") +-- > ] + +-- | XXX comment me (no tautology please) +customKeys :: (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ unused shortcuts + -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ new bindings + -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) +customKeys = (runReader .) . customize + +customize :: (XConfig Layout -> [(KeyMask, KeySym)]) + -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) + -> Reader (XConfig Layout) (M.Map (KeyMask, KeySym) (X ())) +customize ds is = Reader (keys defaultConfig) >>= delete ds >>= insert is + +delete :: (MonadReader r m, Ord a) => (r -> [a]) -> M.Map a b -> m (M.Map a b) +delete dels kmap = asks dels >>= return . foldr M.delete kmap + +insert :: (MonadReader r m, Ord a) => + (r -> [(a, b)]) -> M.Map a b -> m (M.Map a b) +insert ins kmap = asks ins >>= return . foldr (uncurry M.insert) kmap hunk ./XMonadContrib.cabal 56 + XMonad.Config.CustomKeys move ./XMonadContrib.cabal ./xmonad-contrib.cabal hunk ./README 3 -This repository can be overlayed on an xmonad repository. -Users may then import Haskell src from here, to extend their config -files. +Build and install as for other haskell packages: hunk ./README 5 -scripts/ contains further external programs useful with xmonad. - -Haskell code contributed to this repo should live under the - - XMonadContrib. - -name space. For example: - - XMonadContrib.Mosaic + runhaskell Setup.lhs configure --user --prefix=$HOME + runhaskell Setup.lhs build + runhaskell Setup.lhs install --user hunk ./xmonad-contrib.cabal 1 -name: XMonadContrib +name: xmonad-contrib hunk ./xmonad-contrib.cabal 3 -homepage: http://xmonad.org -synopsis: third party extensions for xmonad +homepage: http://xmonad.org/ +synopsis: Third party extensions for xmonad hunk ./xmonad-contrib.cabal 6 - third party extensions for xmonad + Third party tiling algorithms, configurations and scripts to xmonad. hunk ./scripts/generate-configs 53 -# -- %import XMonadContrib.Accordion -# -- %import qualified XMonadContrib.FlexibleManipulate as Flex +# -- %import XMonad.Layout.Accordion +# -- %import qualified XMonad.Actions.FlexibleManipulate as Flex hunk ./README 1 -3rd party xmonad extensions and contributions. +3rd party XMonad extensions and contributions. hunk ./README 3 -Build and install as for other haskell packages: +Build and install through Cabal as for other Haskell packages: + + runhaskell Setup configure --user --prefix=$HOME + runhaskell Setup build + runhaskell Setup install --user + +(You may want to remove the --user flag when installing as root.) + +scripts/ contains further external programs useful with xmonad. + +Haskell code contributed to this repo should live under the appropriate subdivision of the 'XMonad.' namespace (currently includes Actions, Config, Hooks, Layout, Prompt, and Util). For example, to use the Mosaic layout, one would import: + + XMonad.Layout.Mosaic hunk ./README 17 - runhaskell Setup.lhs configure --user --prefix=$HOME - runhaskell Setup.lhs build - runhaskell Setup.lhs install --user hunk ./README 21 -xmonad itself, with copyright held by the authors. +XMonad itself, with copyright held by the authors. hunk ./XMonad/Config/Droundy.hs 1 -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures -fglasgow-exts #-} hunk ./XMonad/Config/Droundy.hs 9 -module XMonad.Config.Droundy where +module XMonad.Config.Droundy ( config, mytab ) where hunk ./XMonad/Config/Droundy.hs 14 -import XMonad hiding (keys) +import XMonad hiding (keys, config) hunk ./XMonad/Config/Droundy.hs 132 - where mytab = tabbed shrinkText defaultTConf hunk ./XMonad/Config/Droundy.hs 133 +mytab = tabbed CustomShrink defaultTConf + +instance Shrinker CustomShrink where + shrinkIt shr s | Just s' <- dropFromTail " " s = shrinkIt shr s' + shrinkIt shr s | Just s' <- dropFromTail "- Iceweasel" s = shrinkIt shr s' + shrinkIt _ s | n > 9 = s : map cut [2..(halfn-3)] ++ shrinkIt shrinkText s + where n = length s + halfn = n `div` 2 + rs = reverse s + cut x = take (halfn - x) s ++ "..." ++ reverse (take (halfn-x) rs) + shrinkIt _ s = shrinkIt shrinkText s + +dropFromTail :: String -> String -> Maybe String +dropFromTail t s | drop (length s - length t) s == t = Just $ take (length s - length t) s + | otherwise = Nothing hunk ./XMonad/Layout/Tabbed.hs 21 - , shrinkText + , shrinkText, CustomShrink(CustomShrink) hunk ./XMonad/Layout/Tabbed.hs 23 + , Shrinker(..) hunk ./XMonad/Layout/Tabbed.hs 72 -tabbed :: Shrinker -> TConf -> Tabbed a -tabbed s t = Tabbed (I Nothing) (I (Just s)) t +tabbed :: Shrinker s => s -> TConf -> Tabbed s a +tabbed s t = Tabbed (I Nothing) s t hunk ./XMonad/Layout/Tabbed.hs 104 -data Tabbed a = - Tabbed (Invisible Maybe TabState) (Invisible Maybe Shrinker) TConf +data Tabbed s a = + Tabbed (Invisible Maybe TabState) s TConf hunk ./XMonad/Layout/Tabbed.hs 108 -instance LayoutClass Tabbed Window where +instance Shrinker s => LayoutClass (Tabbed s) Window where hunk ./XMonad/Layout/Tabbed.hs 113 -doLay :: Invisible Maybe TabState -> Invisible Maybe Shrinker -> TConf - -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed Window)) +doLay :: Shrinker s => Invisible Maybe TabState -> s -> TConf + -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed s Window)) hunk ./XMonad/Layout/Tabbed.hs 133 -handleMess :: Tabbed Window -> SomeMessage -> X (Maybe (Tabbed Window)) +handleMess :: Shrinker s => Tabbed s Window -> SomeMessage -> X (Maybe (Tabbed s Window)) hunk ./XMonad/Layout/Tabbed.hs 139 - return $ Just $ Tabbed (I Nothing) (I Nothing) conf + return $ Just $ Tabbed (I Nothing) ishr conf hunk ./XMonad/Layout/Tabbed.hs 142 -handleEvent :: Invisible Maybe Shrinker -> TConf -> TabState -> Event -> X () +handleEvent :: Shrinker s => s -> TConf -> TabState -> Event -> X () hunk ./XMonad/Layout/Tabbed.hs 185 -updateTab :: Invisible Maybe Shrinker -> TConf -> FontStruct -> Dimension -> (Window,Window) -> X () +updateTab :: Shrinker s => s -> TConf -> FontStruct -> Dimension -> (Window,Window) -> X () hunk ./XMonad/Layout/Tabbed.hs 195 - let s = fromIMaybe shrinkText ishr + let s = shrinkIt ishr hunk ./XMonad/Layout/Tabbed.hs 204 -type Shrinker = String -> [String] - -shrinkWhile :: Shrinker -> (String -> Bool) -> String -> String +shrinkWhile :: (String -> [String]) -> (String -> Bool) -> String -> String hunk ./XMonad/Layout/Tabbed.hs 211 -shrinkText :: Shrinker -shrinkText "" = [""] -shrinkText cs = cs : shrinkText (init cs) + +data CustomShrink = CustomShrink +instance Show CustomShrink where show _ = "" +instance Read CustomShrink where readsPrec _ s = [(CustomShrink,s)] + +class (Read s, Show s) => Shrinker s where + shrinkIt :: s -> String -> [String] + +data DefaultShrinker = DefaultShrinker +instance Show DefaultShrinker where show _ = "" +instance Read DefaultShrinker where readsPrec _ s = [(DefaultShrinker,s)] +instance Shrinker DefaultShrinker where + shrinkIt _ "" = [""] + shrinkIt s cs = cs : shrinkIt s (init cs) + +shrinkText :: DefaultShrinker +shrinkText = DefaultShrinker hunk ./XMonad/Config/Arossato.hs 53 --- +-- | hunk ./XMonad/Config/Arossato.hs 55 --- I want to remove some of the default key bindings, such as those to exit XMonad +-- +-- I want to remove some of the default key bindings, such as those to +-- exit XMonad hunk ./XMonad/Config/Arossato.hs 61 - [ ((modMask x .|. shiftMask, xK_Return), spawn "xterm") -- %! Launch an xterm - , ((modMask x, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu - , ((modMask x .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun - , ((modMask x .|. shiftMask, xK_c ), kill) -- %! Close the focused window + [ ((modMask x .|. shiftMask, xK_Return), spawn "xterm" ) + , ((modMask x .|. shiftMask, xK_c ), kill ) hunk ./XMonad/Config/Arossato.hs 64 - , ((modMask x, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms - , ((modMask x .|. shiftMask, xK_space ), setLayout $ layoutHook x) -- %! Reset the layouts on the current workspace to default + , ((modMask x, xK_space ), sendMessage NextLayout ) + , ((modMask x .|. shiftMask, xK_space ), setLayout $ layoutHook x ) hunk ./XMonad/Config/Arossato.hs 67 - , ((modMask x, xK_n ), refresh) -- %! Resize viewed windows to the correct size + , ((modMask x, xK_n ), refresh ) hunk ./XMonad/Config/Arossato.hs 70 - , ((modMask x, xK_Tab ), windows W.focusDown) -- %! Move focus to the next window - , ((modMask x, xK_m ), windows W.focusMaster ) -- %! Move focus to the master window + , ((modMask x, xK_Tab ), windows W.focusDown ) + , ((modMask x, xK_m ), windows W.focusMaster ) hunk ./XMonad/Config/Arossato.hs 74 - , ((modMask x, xK_Return), windows W.swapMaster) -- %! Swap the focused window and the master window - , ((modMask x .|. shiftMask, xK_j ), windows W.swapDown ) -- %! Swap the focused window with the next window - , ((modMask x .|. shiftMask, xK_k ), windows W.swapUp ) -- %! Swap the focused window with the previous window + , ((modMask x, xK_Return), windows W.swapMaster ) + , ((modMask x .|. shiftMask, xK_j ), windows W.swapDown ) + , ((modMask x .|. shiftMask, xK_k ), windows W.swapUp ) hunk ./XMonad/Config/Arossato.hs 79 - , ((modMask x, xK_h ), sendMessage Shrink) -- %! Shrink the master area - , ((modMask x, xK_l ), sendMessage Expand) -- %! Expand the master area + , ((modMask x, xK_h ), sendMessage Shrink ) + , ((modMask x, xK_l ), sendMessage Expand ) hunk ./XMonad/Config/Arossato.hs 83 - , ((modMask x, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling + , ((modMask x, xK_t ), withFocused $ windows . W.sink ) hunk ./XMonad/Config/Arossato.hs 86 - , ((modMask x , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area - , ((modMask x , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area + , ((modMask x .|. shiftMask, xK_comma ), sendMessage (IncMasterN 1 ) ) + , ((modMask x .|. shiftMask, xK_period), sendMessage (IncMasterN (-1)) ) hunk ./XMonad/Config/Arossato.hs 90 - , ((modMask x , xK_b ), modifyGap (\i n -> let s = (defaultGaps x ++ repeat (0,0,0,0)) !! i in if n == s then (0,0,0,0) else s)) -- %! Toggle the status bar gap + , ((modMask x , xK_b ), modifyGap (\i n -> let s = (defaultGaps x ++ repeat (0,0,0,0)) !! i in if n == s then (0,0,0,0) else s)) hunk ./XMonad/Config/Arossato.hs 133 - , logHook = dynamicLogWithPP sjanssenPP - , layoutHook = Layout $ noBorders mytab ||| - noBorders Full ||| tiled ||| - Mirror tiled ||| Accordion + , logHook = dynamicLogWithPP myPP + , layoutHook = noBorders mytab ||| + noBorders Full ||| + tiled ||| + Mirror tiled ||| + Accordion hunk ./XMonad/Config/Arossato.hs 144 + , defaultGaps = [(15,0,0,0)] hunk ./XMonad/Config/Arossato.hs 148 + myPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" + , ppTitle = xmobarColor "#00ee00" "" . shorten 80 + } + hunk ./XMonad/Hooks/ManageDocks.hs 29 +-- You may also wish to bind a key to sendMessage ToggleStruts, which will +-- toggle the avoidStruts behavior, so you can hide your panel at will. + hunk ./XMonad/Hooks/ManageDocks.hs 42 - ,avoidStruts + ,avoidStruts, ToggleStruts(ToggleStruts) hunk ./XMonad/Hooks/ManageDocks.hs 156 -avoidStruts = AvoidStruts +avoidStruts = AvoidStruts True + +data AvoidStruts l a = AvoidStruts Bool (l a) deriving ( Read, Show ) hunk ./XMonad/Hooks/ManageDocks.hs 160 -data AvoidStruts l a = AvoidStruts (l a) deriving ( Read, Show ) +data ToggleStruts = ToggleStruts deriving (Read,Show,Typeable) +instance Message ToggleStruts hunk ./XMonad/Hooks/ManageDocks.hs 164 - doLayout (AvoidStruts lo) (Rectangle x y w h) s = + doLayout (AvoidStruts True lo) (Rectangle x y w h) s = hunk ./XMonad/Hooks/ManageDocks.hs 169 - return (wrs, AvoidStruts `fmap` mlo') - handleMessage (AvoidStruts l) m = - do ml' <- handleMessage l m - return (AvoidStruts `fmap` ml') - description (AvoidStruts l) = description l + return (wrs, AvoidStruts True `fmap` mlo') + doLayout (AvoidStruts False lo) r s = do (wrs,mlo') <- doLayout lo r s + return (wrs, AvoidStruts False `fmap` mlo') + handleMessage (AvoidStruts b l) m + | Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (not b) l + | otherwise = do ml' <- handleMessage l m + return (AvoidStruts b `fmap` ml') + description (AvoidStruts _ l) = description l hunk ./XMonad/Hooks/ManageDocks.hs 1 -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-} +{-# OPTIONS -fglasgow-exts #-} +-- ^ deriving Typeable hunk ./XMonad/Config/CustomKeys.hs 15 - -- * Usage - -- $usage - customKeys + -- * Usage + -- $usage + customKeys + , customKeysFrom hunk ./XMonad/Config/CustomKeys.hs 50 --- | XXX comment me (no tautology please) -customKeys :: (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ unused shortcuts - -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ new bindings +-- | Customize 'XMonad.Config.defaultConfig' -- delete needless +-- shortcuts and insert the ones you use. +customKeys :: (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ shortcuts to delete + -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ key bindings to insert hunk ./XMonad/Config/CustomKeys.hs 55 -customKeys = (runReader .) . customize +customKeys = customKeysFrom defaultConfig hunk ./XMonad/Config/CustomKeys.hs 57 -customize :: (XConfig Layout -> [(KeyMask, KeySym)]) +-- | General variant of 'customKeys': customize key bindings of +-- third-party configuration. +customKeysFrom :: XConfig l -- ^ original configuration + -> (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ shortcuts to delete + -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ key bindings to insert + -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) +customKeysFrom conf = (runReader .) . customize conf + +customize :: XConfig l + -> (XConfig Layout -> [(KeyMask, KeySym)]) hunk ./XMonad/Config/CustomKeys.hs 69 -customize ds is = Reader (keys defaultConfig) >>= delete ds >>= insert is +customize conf ds is = Reader (keys conf) >>= delete ds >>= insert is hunk ./XMonad/Hooks/UrgencyHook.hs 157 - urgencyHook, nonUrgencyHook :: h -> a -> X () - - nonUrgencyHook _ _ = return () + urgencyHook :: h -> a -> X () hunk ./XMonad/Hooks/UrgencyHook.hs 187 - nonUrgencyHook _ w = io $ putStrLn $ "Not Urgent: " ++ show w hunk ./XMonad/Config/CustomKeys.hs 11 --- (See also "XMonad.Util.EZConfig" in XMonadContrib.) +-- (See also "XMonad.Util.EZConfig" in xmonad-contrib.) hunk ./XMonad/Util/EZConfig.hs 11 +-- (See also "XMonad.Config.CustomKeys" in xmonad-contrib.) +-- hunk ./XMonad/Util/EZConfig.hs 26 +-- | hunk ./XMonad/Util/EZConfig.hs 42 +-- | hunk ./XMonad/Util/EZConfig.hs 50 --- Like additionalKeys, but for mouseBindings. +-- | Like additionalKeys, but for mouseBindings. hunk ./XMonad/Util/EZConfig.hs 55 --- Like removeKeys, but for mouseBindings. +-- | Like removeKeys, but for mouseBindings. hunk ./XMonad/Hooks/UrgencyHook.hs 88 +-- hunk ./XMonad/Config/Arossato.hs 37 -myXPConfig :: XPConfig -myXPConfig = defaultXPConfig - --- ion3 clean style +-- The Ion3 clean style hunk ./XMonad/Config/Arossato.hs 39 -myTabConfig = defaultTConf { - activeColor = "#8a999e" - , inactiveColor = "#545d75" - , activeBorderColor = "white" - , inactiveBorderColor = "grey" - , activeTextColor = "white" - , inactiveTextColor = "grey" - , tabSize = 15 - } - ------------------------------------------------------------------------- --- | --- Key bindings: --- --- I want to remove some of the default key bindings, such as those to --- exit XMonad -defaultKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) -defaultKeys x = M.fromList $ - -- launching and killing programs - [ ((modMask x .|. shiftMask, xK_Return), spawn "xterm" ) - , ((modMask x .|. shiftMask, xK_c ), kill ) - - , ((modMask x, xK_space ), sendMessage NextLayout ) - , ((modMask x .|. shiftMask, xK_space ), setLayout $ layoutHook x ) - - , ((modMask x, xK_n ), refresh ) - - -- move focus up or down the window stack - , ((modMask x, xK_Tab ), windows W.focusDown ) - , ((modMask x, xK_m ), windows W.focusMaster ) - - -- modifying the window order - , ((modMask x, xK_Return), windows W.swapMaster ) - , ((modMask x .|. shiftMask, xK_j ), windows W.swapDown ) - , ((modMask x .|. shiftMask, xK_k ), windows W.swapUp ) - - -- resizing the master/slave ratio - , ((modMask x, xK_h ), sendMessage Shrink ) - , ((modMask x, xK_l ), sendMessage Expand ) - - -- floating layer support - , ((modMask x, xK_t ), withFocused $ windows . W.sink ) - - -- increase or decrease number of windows in the master area - , ((modMask x .|. shiftMask, xK_comma ), sendMessage (IncMasterN 1 ) ) - , ((modMask x .|. shiftMask, xK_period), sendMessage (IncMasterN (-1)) ) - - -- toggle the status bar gap - , ((modMask x , xK_b ), modifyGap (\i n -> let s = (defaultGaps x ++ repeat (0,0,0,0)) !! i in if n == s then (0,0,0,0) else s)) - - ] - ++ - -- mod-[1..9] %! Switch to workspace N - -- mod-shift-[1..9] %! Move client to workspace N - [((m .|. modMask x, k), windows $ f i) - | (i, k) <- zip (workspaces x) [xK_1 ..] - , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)]] - ++ - -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 - -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3 - [((m .|. modMask x, key), screenWorkspace sc >>= flip whenJust (windows . f)) - | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..] - , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] - - ++ mykeys x - --- These are my personal key bindings -mykeys :: XConfig Layout -> [((KeyMask, KeySym), (X ()))] -mykeys x = - [ ((modMask x , xK_F12 ), xmonadPrompt myXPConfig ) - , ((modMask x , xK_F3 ), shellPrompt myXPConfig ) - , ((modMask x , xK_F4 ), sshPrompt myXPConfig ) - , ((modMask x , xK_F5 ), windowPromptGoto myXPConfig ) - , ((modMask x .|. shiftMask , xK_F5 ), windowPromptBring myXPConfig ) - -- mod . mod , - , ((modMask x , xK_comma ), prevWS ) - , ((modMask x , xK_period), nextWS ) - -- mod left mod right - , ((modMask x , xK_Right ), windows W.focusDown ) - , ((modMask x , xK_Left ), windows W.focusUp ) - -- other stuff: launch some useful utilities - , ((modMask x , xK_F2 ), spawn "urxvt -fg white -bg black +sb" ) - , ((modMask x .|. shiftMask , xK_F4 ), spawn "~/bin/dict.sh" ) - , ((modMask x .|. shiftMask , xK_F5 ), spawn "~/bin/urlOpen.sh" ) - , ((modMask x , xK_c ), kill ) - ] - +myTabConfig = + defaultTConf { activeColor = "#8a999e" + , inactiveColor = "#545d75" + , activeBorderColor = "white" + , inactiveBorderColor = "grey" + , activeTextColor = "white" + , inactiveTextColor = "grey" + , tabSize = 15 + } hunk ./XMonad/Config/Arossato.hs 50 - { borderWidth = 1 - , workspaces = map show [1 .. 9 :: Int] + { workspaces = ["1", "2"] ++ + ["dev","mail","web"] ++ + map show [6 .. 9 :: Int] hunk ./XMonad/Config/Arossato.hs 63 - , keys = defaultKeys + , keys = newKeys hunk ./XMonad/Config/Arossato.hs 66 - where mytab = tabbed shrinkText myTabConfig - tiled = Tall 1 0.03 0.5 - myPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" - , ppTitle = xmobarColor "#00ee00" "" . shorten 80 - } + where + mytab = tabbed shrinkText myTabConfig + tiled = Tall 1 0.03 0.5 + myPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" + , ppTitle = xmobarColor "green" "" . shorten 80 + } + + -- key bindings stuff + defKeys = keys defaultConfig + newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x) + delKeys x = foldr M.delete (defKeys x) (toRemove x) + -- remove some of the default key bindings + toRemove x = + [ (modMask x , xK_j ) + , (modMask x , xK_k ) + , (modMask x , xK_p ) + , (modMask x .|. shiftMask, xK_p ) + , (modMask x , xK_comma ) + , (modMask x , xK_period) + ] + -- These are my personal key bindings + toAdd x = + [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) + , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) + , ((modMask x , xK_F4 ), sshPrompt defaultXPConfig ) + , ((modMask x , xK_F5 ), windowPromptGoto defaultXPConfig ) + , ((modMask x .|. shiftMask , xK_F5 ), windowPromptBring defaultXPConfig ) + , ((modMask x , xK_comma ), prevWS ) + , ((modMask x , xK_period), nextWS ) + , ((modMask x , xK_Right ), windows W.focusDown ) + , ((modMask x , xK_Left ), windows W.focusUp ) + -- other stuff: launch some useful utilities + , ((modMask x , xK_F2 ), spawn "urxvt -fg white -bg black +sb" ) + , ((modMask x .|. shiftMask , xK_F4 ), spawn "~/bin/dict.sh" ) + , ((modMask x .|. shiftMask , xK_F5 ), spawn "~/bin/urlOpen.sh" ) + , ((modMask x , xK_c ), kill ) + , ((modMask x .|. shiftMask , xK_comma ), sendMessage (IncMasterN 1 ) ) + , ((modMask x .|. shiftMask , xK_period), sendMessage (IncMasterN (-1)) ) + ] hunk ./XMonad/Config/Arossato.hs 67 + -- layouts hunk ./XMonad/Config/Arossato.hs 70 + + -- the logHook pretty-printer hunk ./XMonad/Config/Arossato.hs 78 - newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x) hunk ./XMonad/Config/Arossato.hs 79 + newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x) hunk ./XMonad/Config/Arossato.hs 91 - [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) - , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) - , ((modMask x , xK_F4 ), sshPrompt defaultXPConfig ) - , ((modMask x , xK_F5 ), windowPromptGoto defaultXPConfig ) - , ((modMask x .|. shiftMask , xK_F5 ), windowPromptBring defaultXPConfig ) - , ((modMask x , xK_comma ), prevWS ) - , ((modMask x , xK_period), nextWS ) - , ((modMask x , xK_Right ), windows W.focusDown ) - , ((modMask x , xK_Left ), windows W.focusUp ) + [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) + , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) + , ((modMask x , xK_F4 ), sshPrompt defaultXPConfig ) + , ((modMask x , xK_F5 ), windowPromptGoto defaultXPConfig ) + , ((modMask x .|. shiftMask, xK_F5 ), windowPromptBring defaultXPConfig ) + , ((modMask x , xK_comma ), prevWS ) + , ((modMask x , xK_period), nextWS ) + , ((modMask x , xK_Right ), windows W.focusDown ) + , ((modMask x , xK_Left ), windows W.focusUp ) hunk ./XMonad/Config/Arossato.hs 101 - , ((modMask x , xK_F2 ), spawn "urxvt -fg white -bg black +sb" ) - , ((modMask x .|. shiftMask , xK_F4 ), spawn "~/bin/dict.sh" ) - , ((modMask x .|. shiftMask , xK_F5 ), spawn "~/bin/urlOpen.sh" ) - , ((modMask x , xK_c ), kill ) - , ((modMask x .|. shiftMask , xK_comma ), sendMessage (IncMasterN 1 ) ) - , ((modMask x .|. shiftMask , xK_period), sendMessage (IncMasterN (-1)) ) + , ((modMask x , xK_F2 ), spawn "urxvt -fg white -bg black +sb") + , ((modMask x .|. shiftMask, xK_F4 ), spawn "~/bin/dict.sh" ) + , ((modMask x .|. shiftMask, xK_F5 ), spawn "~/bin/urlOpen.sh" ) + , ((modMask x , xK_c ), kill ) + , ((modMask x .|. shiftMask, xK_comma ), sendMessage (IncMasterN 1 ) ) + , ((modMask x .|. shiftMask, xK_period), sendMessage (IncMasterN (-1)) ) hunk ./XMonad/Layout/Tabbed.hs 2 - +{-# OPTIONS_GHC -fno-warn-orphans #-} hunk ./XMonad/Config/Arossato.hs 86 + , (modMask x .|. shiftMask, xK_q ) + , (modMask x , xK_q ) hunk ./XMonad/Config/Arossato.hs 90 - ] + ] ++ + -- I want modMask .|. shiftMusk 1-9 to be free! + [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]] + hunk ./XMonad/Config/Arossato.hs 112 + ] ++ + -- Use modMask .|. shiftMusk .|. controlMask 1-9 instead + [( (m .|. modMask x, k), windows $ f i) + | (i, k) <- zip (workspaces x) [xK_1 .. xK_9] + , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)] hunk ./XMonad/Config/Arossato.hs 119 + hunk ./XMonad/Config/Arossato.hs 113 - -- Use modMask .|. shiftMusk .|. controlMask 1-9 instead + -- Use modMask .|. shiftMask .|. controlMask 1-9 instead hunk ./XMonad/Config/Arossato.hs 18 +import Data.Bits ((.|.)) +import qualified Data.Map as M +import Graphics.X11.Xlib + hunk ./XMonad/Config/Arossato.hs 26 -import Data.Bits ((.|.)) -import qualified Data.Map as M -import Graphics.X11.Xlib hunk ./XMonad/Config/Arossato.hs 27 -import XMonad.Layout.Accordion +import XMonad.Actions.CycleWS hunk ./XMonad/Config/Arossato.hs 29 -import XMonad.Layout.Tabbed +import XMonad.Layout.Accordion hunk ./XMonad/Config/Arossato.hs 31 -import XMonad.Actions.CycleWS +import XMonad.Layout.Tabbed hunk ./XMonad/Config/Arossato.hs 33 -import XMonad.Prompt.XMonad hunk ./XMonad/Config/Arossato.hs 36 +import XMonad.Prompt.XMonad hunk ./XMonad/Config/Droundy.hs 136 + shrinkIt shr s | Just s' <- dropFromHead " " s = shrinkIt shr s' hunk ./XMonad/Config/Droundy.hs 139 + shrinkIt shr s | Just s' <- dropFromTail "- KPDF" s = shrinkIt shr s' + shrinkIt shr s | Just s' <- dropFromHead "file://" s = shrinkIt shr s' + shrinkIt shr s | Just s' <- dropFromHead "http://" s = shrinkIt shr s' hunk ./XMonad/Config/Droundy.hs 152 + +dropFromHead :: String -> String -> Maybe String +dropFromHead h s | take (length h) s == h = Just $ drop (length h) s + | otherwise = Nothing hunk ./XMonad/Config/Arossato.hs 89 - , (modMask x , xK_comma ) - , (modMask x , xK_period) hunk ./XMonad/Config/Arossato.hs 90 - -- I want modMask .|. shiftMusk 1-9 to be free! + -- I want modMask .|. shiftMask 1-9 to be free! hunk ./XMonad/Config/Arossato.hs 118 - move ./XMonad/Config/CustomKeys.hs ./XMonad/Util/CustomKeys.hs hunk ./XMonad/Util/CustomKeys.hs 3 --- Module : XMonad.Config.CustomKeys +-- Module : XMonad.Util.CustomKeys hunk ./XMonad/Util/CustomKeys.hs 14 -module XMonad.Config.CustomKeys ( - -- * Usage - -- $usage - customKeys - , customKeysFrom - ) where +module XMonad.Util.CustomKeys ( + -- * Usage + -- $usage + customKeys + , customKeysFrom + ) where hunk ./XMonad/Util/CustomKeys.hs 31 --- > import XMonad.Config.CustomKeys +-- > import XMonad.Util.CustomKeys hunk ./XMonad/Util/CustomKeys.hs 51 --- shortcuts and insert the ones you use. +-- shortcuts and insert those you will use. hunk ./XMonad/Util/EZConfig.hs 11 --- (See also "XMonad.Config.CustomKeys" in xmonad-contrib.) +-- (See also "XMonad.Util.CustomKeys" in xmonad-contrib.) hunk ./xmonad-contrib.cabal 56 - XMonad.Config.CustomKeys hunk ./xmonad-contrib.cabal 102 + XMonad.Util.CustomKeys hunk ./XMonad/Util/EZConfig.hs 28 +-- hunk ./XMonad/Util/EZConfig.hs 34 +-- hunk ./XMonad/Util/EZConfig.hs 46 +-- hunk ./XMonad/Hooks/ManageDocks.hs 3 --- ^ deriving Typeable +-- deriving Typeable hunk ./XMonad/Hooks/ManageDocks.hs 21 - +-- hunk ./XMonad/Hooks/ManageDocks.hs 27 - +-- hunk ./XMonad/Hooks/ManageDocks.hs 30 - +-- hunk ./XMonad/Hooks/ManageDocks.hs 33 - +-- hunk ./XMonad/Hooks/ManageDocks.hs 36 - +-- hunk ./XMonad/Hooks/ManageDocks.hs 38 + hunk ./XMonad/Hooks/SetWMName.hs 40 -import Data.Bits ((.|.)) hunk ./XMonad/Layout/Tabbed.hs 29 -import Data.Bits hunk ./XMonad/Layout/LayoutCombinators.hs 50 -(<-//>) = combineTwo (dragPane Horizontal 0.1 0.2) -() = combineTwo (dragPane Horizontal 0.1 0.8) +(<-//>) = combineTwo (dragPane Horizontal 0.1 0.8) +() = combineTwo (dragPane Horizontal 0.1 0.2) hunk ./XMonad/Layout/LayoutCombinators.hs 26 -import Data.Maybe ( isJust ) +import Data.Maybe ( isJust, isNothing ) hunk ./XMonad/Layout/LayoutCombinators.hs 78 - handleMessage (NewSelect False l1 l2) m - | Just Wrap <- fromMessage m = - do ml2' <- handleMessage l2 (SomeMessage Hide) - ml1' <- handleMessage l1 m - return $ Just $ NewSelect True (maybe l1 id ml1') (maybe l2 id ml2') - handleMessage (NewSelect True l1 l2) m + handleMessage l@(NewSelect False _ _) m + | Just Wrap <- fromMessage m = fmap Just $ swap l >>= passOn m + handleMessage l@(NewSelect amfirst _ _) m hunk ./XMonad/Layout/LayoutCombinators.hs 82 - do ml1' <- handleMessage l1 m - case ml1' of - Just l1' -> return $ Just (NewSelect True l1' l2) - Nothing -> do ml1'' <- handleMessage l1 (SomeMessage Hide) - ml2' <- handleMessage l2 (SomeMessage Wrap) - return $ Just $ NewSelect False (maybe l1 id ml1'') (maybe l2 id ml2') - handleMessage l@(NewSelect True _ _) m - | Just NextLayout <- fromMessage m = handleMessage l (SomeMessage NextLayoutNoWrap) - handleMessage l@(NewSelect False l1 l2) m - | Just NextLayout <- fromMessage m = - do ml' <- handleMessage l (SomeMessage NextLayoutNoWrap) - case ml' of - Just l' -> return $ Just l' - Nothing -> do ml2' <- handleMessage l2 (SomeMessage Hide) - ml1' <- handleMessage l1 (SomeMessage Wrap) - return $ Just $ NewSelect True (maybe l1 id ml1') (maybe l2 id ml2') - handleMessage (NewSelect True l1 l2) m - | Just (JumpToLayout d) <- fromMessage m, - d == description l2 = do ml1' <- handleMessage l1 (SomeMessage Hide) - return $ Just $ NewSelect False (maybe l1 id ml1') l2 - handleMessage (NewSelect True l1 l2) m - | Just (JumpToLayout _) <- fromMessage m - = do ml1' <- handleMessage l1 m - case ml1' of - Just l1' -> return $ Just $ NewSelect True l1' l2 - Nothing -> - do ml2' <- handleMessage l2 m - case ml2' of - Nothing -> return Nothing - Just l2' -> do ml1'' <- handleMessage l1 (SomeMessage Hide) - return $ Just $ NewSelect False (maybe l1 id ml1'') l2' - handleMessage (NewSelect False l1 l2) m - | Just (JumpToLayout d) <- fromMessage m, - d == description l1 = do ml2' <- handleMessage l2 (SomeMessage Hide) - return $ Just $ NewSelect True l1 (maybe l2 id ml2') - handleMessage (NewSelect False l1 l2) m - | Just (JumpToLayout _) <- fromMessage m - = do ml2' <- handleMessage l2 m - case ml2' of - Just l2' -> return $ Just $ NewSelect False l1 l2' - Nothing -> - do ml1' <- handleMessage l1 m - case ml1' of - Nothing -> return Nothing - Just l1' -> do ml2'' <- handleMessage l2 (SomeMessage Hide) - return $ Just $ NewSelect True l1' (maybe l2 id ml2'') + if amfirst then when' isNothing (passOnM m l) $ + fmap Just $ swap l >>= passOn (SomeMessage Wrap) + else passOnM m l + handleMessage l m + | Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $ + fmap Just $ swap l >>= passOn (SomeMessage Wrap) + handleMessage l@(NewSelect True _ l2) m + | Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just `fmap` swap l + handleMessage l@(NewSelect False l1 _) m + | Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just `fmap` swap l + handleMessage l m + | Just (JumpToLayout _) <- fromMessage m = when' isNothing (passOnM m l) $ + do ml' <- passOnM m $ sw l + case ml' of + Nothing -> return Nothing + Just l' -> Just `fmap` swap (sw l') hunk ./XMonad/Layout/LayoutCombinators.hs 105 - handleMessage (NewSelect True l1 l2) m = - do ml1' <- handleMessage l1 m - return $ (\l1' -> NewSelect True l1' l2) `fmap` ml1' - handleMessage (NewSelect False l1 l2) m = - do ml2' <- handleMessage l2 m - return $ (\l2' -> NewSelect False l1 l2') `fmap` ml2' + handleMessage l m = passOnM m l + +swap :: (LayoutClass l1 a, LayoutClass l2 a) => NewSelect l1 l2 a -> X (NewSelect l1 l2 a) +swap l = sw `fmap` passOn (SomeMessage Hide) l + +sw :: NewSelect l1 l2 a -> NewSelect l1 l2 a +sw (NewSelect b lt lf) = NewSelect (not b) lt lf + +passOn :: (LayoutClass l1 a, LayoutClass l2 a) => + SomeMessage -> NewSelect l1 l2 a -> X (NewSelect l1 l2 a) +passOn m l = maybe l id `fmap` passOnM m l + +passOnM :: (LayoutClass l1 a, LayoutClass l2 a) => + SomeMessage -> NewSelect l1 l2 a -> X (Maybe (NewSelect l1 l2 a)) +passOnM m (NewSelect True lt lf) = do mlt' <- handleMessage lt m + return $ (\lt' -> NewSelect True lt' lf) `fmap` mlt' +passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m + return $ (\lf' -> NewSelect False lt lf') `fmap` mlf' + +when' :: Monad m => (a -> Bool) -> m a -> m a -> m a +when' f a b = do a1 <- a; if f a1 then b else return a1 hunk ./XMonad/Layout/Tabbed.hs 2 -{-# OPTIONS_GHC -fno-warn-orphans #-} hunk ./XMonad/Layout/WindowNavigation.hs 30 -import Control.Monad.State ( gets ) +import Control.Monad.State ( gets, modify ) hunk ./XMonad/Layout/WindowNavigation.hs 34 -import XMonad.Operations ( windows, focus ) +import XMonad.Operations ( windows ) hunk ./XMonad/Layout/WindowNavigation.hs 147 - ((w,r):_) -> do focus w + ((w,r):_) -> do modify focusWindowHere hunk ./XMonad/Layout/WindowNavigation.hs 150 + where focusWindowHere :: XState -> XState + focusWindowHere s + | Just w == W.peek (windowset s) = s + | has w $ W.stack $ W.workspace $ W.current $ windowset s = + s { windowset = until ((Just w ==) . W.peek) + W.focusUp $ windowset s } + | otherwise = s + has _ Nothing = False + has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr) + hunk ./XMonad/Hooks/SetWMName.hs 40 +import Data.Bits ((.|.)) hunk ./XMonad/Layout/Tabbed.hs 7 --- +-- hunk ./XMonad/Layout/Tabbed.hs 12 --- A tabbed layout for the Xmonad Window Manager +-- A tabbed layout for the Xmonad Window Manager hunk ./XMonad/Layout/Tabbed.hs 16 -module XMonad.Layout.Tabbed ( +module XMonad.Layout.Tabbed ( hunk ./XMonad/Layout/Tabbed.hs 29 +import Data.Bits ((.|.)) hunk ./XMonad/Layout/Tabbed.hs 55 --- > +-- > hunk ./XMonad/Layout/Tabbed.hs 74 -data TConf = +data TConf = hunk ./XMonad/Layout/Tabbed.hs 86 -defaultTConf = +defaultTConf = hunk ./XMonad/Layout/Tabbed.hs 97 -data TabState = +data TabState = hunk ./XMonad/Layout/Tabbed.hs 112 -doLay :: Shrinker s => Invisible Maybe TabState -> s -> TConf +doLay :: Shrinker s => Invisible Maybe TabState -> s -> TConf hunk ./XMonad/Layout/Tabbed.hs 143 -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) hunk ./XMonad/Layout/Tabbed.hs 146 - case lookup thisw tws of + case lookup thisw tws of hunk ./XMonad/Layout/Tabbed.hs 152 -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) hunk ./XMonad/Layout/Tabbed.hs 159 -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) hunk ./XMonad/Layout/Tabbed.hs 188 - focusColor win ic ac = (maybe ic (\focusw -> if focusw == win - then ac else ic) . W.peek) + focusColor win ic ac = (maybe ic (\focusw -> if focusw == win + then ac else ic) . W.peek) hunk ./XMonad/Layout/Tabbed.hs 192 - (inactiveColor c, inactiveBorderColor c, inactiveTextColor c) + (inactiveColor c, inactiveBorderColor c, inactiveTextColor c) hunk ./XMonad/Layout/Tabbed.hs 200 -shrink c (Rectangle x y w h) = +shrink c (Rectangle x y w h) = hunk ./XMonad/Util/CustomKeys.hs 49 +-- +-- 0 (/hidden feature/). You can always replace bindings map +-- entirely. No need to import "CustomKeys" this time: +-- +-- > import XMonad +-- > import Graphics.X11.Xlib +-- > import System.Exit +-- > import qualified Data.Map as M +-- > +-- > main = xmonad defaultConfig { +-- > keys = \_ -> M.fromList [ +-- > -- Let me out of here! I want my KDE back! Help! Help! +-- > ( (0, xK_Escape), io (exitWith ExitSuccess) ) ] } hunk ./XMonad/Config/Arossato.hs 18 -import Data.Bits ((.|.)) hunk ./XMonad/Hooks/SetWMName.hs 40 -import Data.Bits ((.|.)) hunk ./XMonad/Layout/Tabbed.hs 29 -import Data.Bits ((.|.)) hunk ./XMonad/Prompt.hs 273 - _ | ks == xK_u -> killBefore >> go - | ks == xK_k -> killAfter >> go - | ks == xK_a -> startOfLine >> go - | ks == xK_e -> endOfLine >> go - | ks == xK_y -> pasteString >> go + _ | ks == xK_u -> killBefore >> go + | ks == xK_k -> killAfter >> go + | ks == xK_a -> startOfLine >> go + | ks == xK_e -> endOfLine >> go + | ks == xK_y -> pasteString >> go + | ks == xK_Delete -> killWord Next >> go + | ks == xK_BackSpace -> killWord Prev >> go hunk ./XMonad/Prompt.hs 315 +-- | Kill the next/previous word +killWord :: Direction -> XP () +killWord d = do + XPS { command = c, offset = o } <- get + let (f,ss) = splitAt o c + delNextWord w = + case w of + ' ':x -> x + word -> snd . break isSpace $ word + delPrevWord = reverse . delNextWord . reverse + (ncom,noff) = + case d of + Next -> (f ++ delNextWord ss, o) + Prev -> (delPrevWord f ++ ss, length $ delPrevWord f) -- laziness!! + modify $ \s -> s { command = ncom, offset = noff} + hunk ./XMonad/Prompt.hs 289 - | ks == xK_Home = startOfLine >> go - | ks == xK_End = endOfLine >> go + | ks == xK_Home = startOfLine >> go + | ks == xK_End = endOfLine >> go hunk ./XMonad/Prompt.hs 334 - modify $ \s -> s { offset = length (command s) } + modify $ \s -> s { offset = length (command s)} hunk ./XMonad/Prompt.hs 344 - modify (\s -> s { command = "", offset = 0} ) + modify $ \s -> s { command = "", offset = 0} hunk ./XMonad/Prompt.hs 349 - modify (\s -> s { command = c (command s) (offset s), offset = o (offset s)} ) + modify $ \s -> s { command = c (command s) (offset s), offset = o (offset s)} hunk ./XMonad/Prompt.hs 362 - modify (\s -> s { command = c (command s) (offset s), offset = o (offset s)} ) + modify $ \s -> s { command = c (command s) (offset s), offset = o (offset s)} hunk ./XMonad/Prompt.hs 374 - modify (\s -> s { offset = o (offset s) (command s)} ) + modify $ \s -> s { offset = o (offset s) (command s)} hunk ./XMonad/Prompt.hs 387 - modify (\s -> s { command = nc, offset = length nc }) + modify $ \s -> s { command = nc, offset = length nc} hunk ./XMonad/Config/Arossato.hs 16 -module XMonad.Config.Arossato where +module XMonad.Config.Arossato + ( -- * Usage + -- $usage + arossatoConfig + , arossatoTabbedConfig + ) where hunk ./XMonad/Config/Arossato.hs 42 --- The Ion3 clean style -myTabConfig :: TConf -myTabConfig = +-- $usage +-- The simplest way to use this configuration module is to use an +-- @~\/.xmonad\/xmonad.hs@ like this: +-- +-- > module Main (main) where +-- > +-- > import XMonad +-- > import XMonad.Config.Arossato (arossatoConfig) +-- > +-- > main :: IO () +-- > main = xmonad arossatoConfig +-- +-- +-- You can use this module also as a starting point for writing your +-- own configuration module from scratch. Save it as your +-- @~\/.xmonad\/xmonad.hs@ and: +-- +-- 1. Change the module name from +-- +-- > module XMonad.Config.Arossato +-- > ( -- * Usage +-- > -- $usage +-- > arossatoConfig +-- > , arossatoTabbedConfig +-- > ) where +-- +-- to +-- +-- > module Main where +-- +-- 2. Add a line like: +-- +-- > main = xmonad arossatoConfig +-- +-- 3. Start playing with the configuration options...;) + +-- | My configuration for the Tabbed Layout. Basically this is the +-- Ion3 clean style. +arossatoTabbedConfig :: TConf +arossatoTabbedConfig = hunk ./XMonad/Config/Arossato.hs 110 - mytab = tabbed shrinkText myTabConfig + mytab = tabbed shrinkText arossatoTabbedConfig hunk ./XMonad/Config/Arossato.hs 133 - hunk ./XMonad/Prompt.hs 71 --- --- * commands to edit the command line hunk ./XMonad/Prompt.hs 313 --- | Kill the next/previous word +-- | Kill the next\/previous word hunk ./scripts/xinitrc 3 +xrandr -s 0 + hunk ./scripts/xinitrc 7 - -xpmroot ~/.bg/ISS013-E-54329_lrg.xpm & +xsetroot -solid '#80a0af' hunk ./scripts/xinitrc 19 -# some other things -tpb -d & -unclutter -idle 1 & - hunk ./scripts/xinitrc 21 -# xset fp+ /usr/local/lib/X11/fonts/bitstream-vera -# xset fp+ /usr/local/lib/X11/fonts/mscorefonts +xset fp+ /usr/X11R6/lib/X11/fonts/TTF/ hunk ./scripts/xinitrc 23 -xset fp rehash +# xset fp rehash hunk ./scripts/xinitrc 33 -/home/dons/bin/run-xmonad.sh +PATH=/home/dons/bin:$PATH + +# launch the external 60 second clock, and launch the workspace status bar +FG='#a8a3f7' +BG='#3f3c6d' +xmonad-clock | dzen2 -e '' -x 400 -w 1200 -ta r -fg $FG -bg $BG & + +xmonad & + +# wait for xmonad +wait $! +pkill -HUP dzen2 +pkill -HUP -f xmonad-clock +wait hunk ./XMonad/Actions/RotSlaves.hs 15 - -- $usag + -- $usage hunk ./XMonad/Config/Arossato.hs 104 - , modMask = mod1Mask addfile ./Documentation.hs hunk ./Documentation.hs 1 - +----------------------------------------------------------------------------- +-- | +-- Module : Documentation +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- This is a module for documenting the xmonad-contrib library +-- +----------------------------------------------------------------------------- + +module Documentation + ( + -- * Configuring XMonad: A Quick Start + -- $configure + + -- ** A simple example + -- $example + + -- ** Checking your xmonad.hs is correct + -- $check + + -- ** Loading your configuration + -- $load + + -- ** Where are the defaults? + -- $where + + -- * The XmonadContrib Library + -- $library + + -- * Extending XMonad + -- $extending + + -- ** Editing Key Bindings + -- $keys + + -- *** Adding Key Bindings + -- $keyAdding + + -- *** Removing Key Bindings + -- $keyDel + + -- *** Adding and Removing Key Bindings + -- $keyAddDel + + + -- ** Adding\/Removing Layouts + -- $layout + + -- ** Hooks Management + -- $hooks + + -- * Writing Other Extensions + -- $writing + ) where + +-------------------------------------------------------------------------------- +-- +-- Configuring Xmonad +-- +-------------------------------------------------------------------------------- + +{- $configure + +xmonad is configure by creating and editing the Haskell file: + +> ~/.xmonad/xmonad.hs + +xmonad then uses default settings from this file as arguments to the +window manager. + +-} + +{- $example + +Here is a basic example, which takes defaults from xmonad, and overrides +the border width, default terminal, and some colours: + +> -- +> -- An example, simple ~/.xmonad/xmonad.hs file. +> -- It overrides a few basic settings, reusing all the other defaults, +> -- +> +> import XMonad +> +> main = xmonad $ defaultConfig +> { borderWidth = 2 +> , terminal = "urxvt" +> , normalBorderColor = "#cccccc" +> , focusedBorderColor = "#cd8b00" } + +This will run \'xmonad\', the window manager, with your settings passed as +arguments. + +Overriding default settings like this (using \"record update syntax\"), +will yield the shortest config file, as you only have to describe values +that differ from the defaults. + +An alternative is to inline the entire default config file from xmonad, +and edit values you wish to change. This is requires more work, but some +users may find this easier. You can find the defaults in the file: + +> XMonad/Config.hs + +-} + +{- $check + +Place this text in @~/.xmonad/xmonad.hs@, and then check that it is +syntactically and type correct, by loading it in the Haskell +interpreter: + +> $ ghci ~/.xmonad/xmonad.hs +> GHCi, version 6.8.1: http://www.haskell.org/ghc/ :? for help +> Loading package base ... linking ... done. +> Ok, modules loaded: Main. +> +> Prelude Main> :t main +> main :: IO () + +Ok, looks good. + +-} + +{- $load + +To have xmonad start using your settings, try @mod-q@. xmonad will +attempt to compile this file, and run it. If it is unable to, the +defaults are used. This requires GHC and xmonad are in your @$PATH@ +settings. If GHC isn't in your path, you can still compile the +@xmonad.hs@ file yourself: + +> $ cd ~/.xmonad +> $ ghc --make xmonad.hs +> $ ls +> xmonad xmonad.hi xmonad.hs xmonad.o + +When you hit @mod-q@, this newly compiled xmonad will be used. + +-} + +{- $where + +The default configuration values are defined in the source file: + +> XMonad/Config.hs + +the 'XMonad.Core.XConfig' data structure itself is defined in: + +> XMonad/Core.hs + +See "XMonad.Core". +-} + +-------------------------------------------------------------------------------- +-- +-- The XmonadContrib Library +-- +-------------------------------------------------------------------------------- + +{- $library + +Put here an overview of the library with a description of the various +directories: Actions, Config, Hooks, Layout, Prompt, and Util. + +-} + +-------------------------------------------------------------------------------- +-- +-- Extending Xmonad +-- +-------------------------------------------------------------------------------- + +{- $extending + +Extending XMonad + +Since the @xmonad.hs@ file is just another Haskell module, you may +import and use any Haskell code or libraries you wish, such as +extensions from the xmonad-contrib library, or other code you write +yourself. + +-} + +{- $keys + +Editing key bindings means changing the 'XMonad.Core.XConfig.keys' +record of the 'XMonad.Core.XConfig' data type, like: + +> main = xmonad defaultConfig { keys = myKeys } + +and by providing a proper definition of @myKeys@ such as: + +> myKeys x = +> [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) +> , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) +> ] + +Remember that this definition requires importing "Graphics.X11.Xlib", +"XMonad.Prompt", "XMonad.Prompt.Shell", and "XMonad.Prompt.XMonad" + +-} + +{- $keyAdding + +Adding key bindings can be done in different ways. The type signature +of "XMonad.Core.XConfig.keys" is: + +> keys :: XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()) + +which means you need to use 'Data.Map.insert' in order to add some +bindings to the map of the existing key bindings. + +For instance, if you have defined some additional key bindings like +these: + +> myKeys x = +> [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) +> , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) +> ] + +you may wish to edit accordingly the default configuration +'XMonad.Core.XConfig.keys' record: + +> main = xmonad defaultConfig { keys = newKeys } +> where newKeys x = foldr (uncurry Data.Map.insert) (keys defaultKeys) (myKeys x) + +And that's it. + +At the end you @~\/.xmonad\/xmonad.hs@ would look like this: + + +> module Main (main) where +> +> import XMonad +> +> import qualified Data.Map as M +> import Graphics.X11.Xlib +> import XMonad.Prompt +> import XMonad.Prompt.Shell +> import XMonad.Prompt.XMonad +> +> main :: IO () +> main = xmonad defaultConfig { keys = newKeys } +> where newKeys x = foldr (uncurry M.insert) (keys defaultConfig x) (myKeys x) +> +> myKeys x = +> [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) +> , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) +> ] + + +Alternatively you may wish to use some of the utilities provided by +the xmonad-contrib library. + +For instance, "XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" +provide useful function to edit you key bindings. + + -} + +{- $keyDel + +keyDel +-} + +{- $keyAddDel + +keyAddDel + +-} + +{- $layout + +layouts +-} + +{- $hooks + +-} + +-------------------------------------------------------------------------------- +-- +-- Writing Extensions +-- +-------------------------------------------------------------------------------- + +{- $writing + +Writing Other Extensions + +-} hunk ./xmonad-contrib.cabal 7 + . + As a starting point you can have a look at the "Documentation". hunk ./xmonad-contrib.cabal 31 - exposed-modules: XMonad.Actions.Commands + exposed-modules: Documentation + XMonad.Actions.Commands hunk ./README 13 -Haskell code contributed to this repo should live under the appropriate subdivision of the 'XMonad.' namespace (currently includes Actions, Config, Hooks, Layout, Prompt, and Util). For example, to use the Mosaic layout, one would import: +Haskell code contributed to this repo should live under the +appropriate subdivision of the 'XMonad.' namespace (currently includes +Actions, Config, Hooks, Layout, Prompt, and Util). For example, to use +the Mosaic layout, one would import: hunk ./XMonad/Util/CustomKeys.hs 40 --- > [ (modm .|. m, k) | (m, k) <- zip [0, shiftMas] [xK_w, xK_e, xK_r] ] +-- > [ (modm .|. m, k) | (m, k) <- zip [0, shiftMask] [xK_w, xK_e, xK_r] ] hunk ./XMonad/Util/Run.hs 12 --- It is composed of functions formerly defined in XMonad.Util.Dmenu (by --- Spencer Jannsen), XMonad.Util.Dzen (by glasser\@mit.edu) and +-- It is composed of functions formerly defined in "XMonad.Util.Dmenu" (by +-- Spencer Jannsen), "XMonad.Util.Dzen" (by glasser\@mit.edu) and hunk ./XMonad/Util/Run.hs 43 --- For an example usage of runInTerm see XMonad.Prompt.Ssh +-- For an example usage of 'runInTerm' see "XMonad.Prompt.Ssh" hunk ./XMonad/Util/Run.hs 45 --- For an example usage of runProcessWithInput see --- XMonad.Prompt.{DirectoryPrompt,Dmenu,ShellPrompt,WmiiActions,WorkspaceDir} +-- For an example usage of 'runProcessWithInput' see +-- "XMonad.Prompt.DirectoryPrompt", "XMonad.Util.Dmenu", +-- "XMonad.Prompt.ShellPrompt", "XMonad.Actions.WmiiActions", +-- "XMonad.Prompt.WorkspaceDir" hunk ./XMonad/Util/Run.hs 50 --- For an example usage of runProcessWithInputAndWait see XMonad.Util.Dzen +-- For an example usage of 'runProcessWithInputAndWait' see +-- "XMonad.Util.Dzen" hunk ./XMonad/Util/Run.hs 67 --- wait is in us +-- | Wait is in us hunk ./XMonad/Util/Run.hs 87 -{- | Multiplies by ONE MILLION, for use with runProcessWithInputAndWait. - Use like: - - > (5.5 `seconds`) --} +-- | Multiplies by ONE MILLION, for use with +-- 'runProcessWithInputAndWait'. +-- +-- Use like: +-- +-- > (5.5 `seconds`) hunk ./XMonad/Util/Run.hs 96 -{- | safeSpawn bypasses XMonad's 'spawn' command, because spawn passes strings to /bin/sh to be interpreted as shell - commands. This is often what one wants, but in many cases the passed string will contain shell metacharacters - which one does not want interpreted as such (URLs particularly often have shell metacharacters like '&' in them). - In this case, it is more useful to specify a file or program to be run and a string to give it as an argument so - as to bypass the shell and be certain the program will receive the string as you typed it. - 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 bypasses XMonad's 'spawn' command, because 'spawn' passes +-- strings to \/bin\/sh to be interpreted as shell commands. This is +-- often what one wants, but in many cases the passed string will contain +-- shell metacharacters which one does not want interpreted as such (URLs +-- particularly often have shell metacharacters like \'&\' in them). In +-- this case, it is more useful to specify a file or program to be run +-- and a string to give it as an argument so as to bypass the shell and +-- be certain the program will receive the string as you typed it. +-- 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. hunk ./XMonad/Util/Run.hs 117 + hunk ./XMonad/Util/Run.hs 121 --- | Run a given program in the preferred terminal emulator. This uses safeSpawn. +-- | Run a given program in the preferred terminal emulator. This uses +-- 'safeSpawn'. hunk ./XMonad/Util/XUtils.hs 42 --- See Tabbed or DragPane for usage examples +-- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" for usage +-- examples hunk ./Documentation.hs 180 -Extending XMonad - hunk ./Documentation.hs 194 -and by providing a proper definition of @myKeys@ such as: +and providing a proper definition of @myKeys@ such as: hunk ./Documentation.hs 220 -> [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) -> , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) +> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) hunk ./Documentation.hs 228 -> where newKeys x = foldr (uncurry Data.Map.insert) (keys defaultKeys) (myKeys x) +> where newKeys x = foldr (uncurry Data.Map.insert) (keys defaultConfig x) (myKeys x) hunk ./Documentation.hs 250 -> [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) -> , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) -> ] +> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) +> ] hunk ./Documentation.hs 259 -provide useful function to edit you key bindings. +provide useful functions to edit you key bindings. hunk ./XMonad/Layout/Tabbed.hs 40 +import XMonad.Util.Font hunk ./XMonad/Layout/Tabbed.hs 100 - , fontS :: FontStruct -- FontSet + , font :: XMonadFont hunk ./XMonad/Layout/Tabbed.hs 129 - mapM_ (updateTab ishr conf (fontS st) width) $ tabsWindows st + mapM_ (updateTab ishr conf (font st) width) $ tabsWindows st hunk ./XMonad/Layout/Tabbed.hs 137 - releaseFont (fontS st) + releaseXMF (font st) hunk ./XMonad/Layout/Tabbed.hs 143 -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs }) hunk ./XMonad/Layout/Tabbed.hs 150 - where width = rect_width screen `div` fromIntegral (length tws) + where + width = rect_width screen`div` fromIntegral (length tws) + +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs }) + (AnyEvent {ev_window = thisw, ev_event_type = t }) +-- expose + | thisw `elem` (map fst tws) && t == expose = do + updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws) + where + width = rect_width screen`div` fromIntegral (length tws) + hunk ./XMonad/Layout/Tabbed.hs 162 -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs }) hunk ./XMonad/Layout/Tabbed.hs 169 -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, fontS = fs }) +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs }) hunk ./XMonad/Layout/Tabbed.hs 178 - fs <- initFont (fontName conf) + fs <- initXMF (fontName conf) hunk ./XMonad/Layout/Tabbed.hs 194 -updateTab :: Shrinker s => s -> TConf -> FontStruct -> Dimension -> (Window,Window) -> X () +updateTab :: Shrinker s => s -> TConf -> XMonadFont -> Dimension -> (Window,Window) -> X () hunk ./XMonad/Layout/Tabbed.hs 204 - let s = shrinkIt ishr - name = shrinkWhile s (\n -> textWidth fs n > - fromIntegral wh - fromIntegral (ht `div` 2)) (show nw) + 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) hunk ./XMonad/Layout/Tabbed.hs 215 -shrinkWhile :: (String -> [String]) -> (String -> Bool) -> String -> String +shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String hunk ./XMonad/Layout/Tabbed.hs 217 - where sw [n] = n - sw [] = "" - sw (n:ns) | p n = sw ns - | otherwise = n - + where sw [n] = return n + sw [] = return "" + sw (n:ns) = do + cond <- p n + if cond + then sw ns + else return n hunk ./XMonad/Prompt.hs 49 -import XMonad.Util.XUtils +import XMonad.Util.Font hunk ./XMonad/Prompt.hs 172 - fs <- initFont (font conf) + fs <- initCoreFont (font conf) hunk ./XMonad/Prompt.hs 177 - releaseFont fs + releaseCoreFont fs hunk ./XMonad/Prompt.hs 448 - (_,asc,desc,_) = textExtents fs str - y = fi $ ((ht - fi (asc + desc)) `div` 2) + fi asc + (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) (Left fs) str + let y = fi $ ((ht - fi (asc + desc)) `div` 2) + fi asc hunk ./XMonad/Prompt.hs 514 - - let (_,asc,desc,_) = textExtents fs $ head compl - yp = fi $ (ht + fi (asc - desc)) `div` 2 + (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) (Left fs) $ head compl + let yp = fi $ (ht + fi (asc - desc)) `div` 2 addfile ./XMonad/Util/Font.hs hunk ./XMonad/Util/Font.hs 1 +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Font +-- Copyright : (c) 2007 Andrea Rossato +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A module for abstracting a font facility over Core fonts and Xft +-- +----------------------------------------------------------------------------- + +module XMonad.Util.Font ( + -- * Usage: + -- $usage + XMonadFont + , initXMF + , releaseXMF + , initCoreFont + , releaseCoreFont + , Align (..) + , stringPosition + , textWidthXMF + , textExtentsXMF + , printStringXMF + , stringToPixel + ) where + + +import Graphics.X11.Xlib +import Graphics.X11.Xft +import Graphics.X11.Xrender + +import Control.Monad.Reader +import Data.List +import XMonad +import Foreign +import XMonad.Operations + +-- Hide the Core Font/Xft switching here +type XMonadFont = Either FontStruct XftFont + +-- $usage +-- See Tabbed or Prompt for usage examples + +-- | Get the Pixel value for a named color: if an invalid name is +-- given the black pixel will be returned. +stringToPixel :: String -> X Pixel +stringToPixel s = do + d <- asks display + io $ catch (getIt d) (fallBack d) + where getIt d = initColor d s + fallBack d = const $ return $ blackPixel d (defaultScreen d) + + +-- | Given a fontname returns the font structure. If the font name is +-- not valid the default font will be loaded and returned. +initCoreFont :: String -> X FontStruct +initCoreFont s = do + d <- asks display + io $ catch (getIt d) (fallBack d) + where getIt d = loadQueryFont d s + fallBack d = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + +releaseCoreFont :: FontStruct -> X () +releaseCoreFont fs = do + d <- asks display + io $ freeFont d fs + +-- | When initXMF gets a font name that starts with 'xft:' it switchs to the Xft backend +-- Example: 'xft: Sans-10' +initXMF :: String -> X XMonadFont +initXMF s = + if xftPrefix `isPrefixOf` s then + do + dpy <- asks display + xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s) + return (Right xftdraw) + else + (initCoreFont s >>= (return . Left)) + where xftPrefix = "xft:" + +releaseXMF :: XMonadFont -> X () +releaseXMF (Left fs) = releaseCoreFont fs +releaseXMF (Right xftfont) = do + dpy <- asks display + io $ xftFontClose dpy xftfont + +textWidthXMF :: Display -> XMonadFont -> String -> IO Int +textWidthXMF _ (Left fs) s = return $ fi $ textWidth fs s +textWidthXMF dpy (Right xftdraw) s = do + gi <- xftTextExtents dpy xftdraw s + return $ xglyphinfo_width gi + +textExtentsXMF :: Display -> XMonadFont -> String -> IO (FontDirection,Int32,Int32,CharStruct) +textExtentsXMF _ (Left fs) s = return $ textExtents fs s +textExtentsXMF _ (Right xftfont) _ = do + ascent <- xftfont_ascent xftfont + descent <- xftfont_descent xftfont + return (error "Font direction touched", fi ascent, fi descent, error "Font overall size touched") + +-- | String position +data Align = AlignCenter | AlignRight | AlignLeft + +-- | Return the string x and y 'Position' in a 'Rectangle', given a +-- 'FontStruct' and the 'Align'ment +stringPosition :: XMonadFont -> Rectangle -> Align -> String -> X (Position,Position) +stringPosition fs (Rectangle _ _ w h) al s = do + dpy <- asks display + width <- io $ textWidthXMF dpy fs s + (_,a,d,_) <- io $ textExtentsXMF dpy 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) + AlignLeft -> 1 + AlignRight -> fi (w - (fi width + 1)); + return (x,y) + + +printStringXMF :: Display -> Drawable -> XMonadFont -> GC -> String -> String + -> Position -> Position -> String -> X () +printStringXMF d p (Left fs) gc fc bc x y s = do + io $ setFont d gc $ fontFromFontStruct fs + [fc',bc'] <- mapM stringToPixel [fc,bc] + io $ setForeground d gc fc' + io $ setBackground d gc bc' + io $ drawImageString d p gc x y s + +printStringXMF dpy drw (Right font) _ fc _ x y s = do + let screen = defaultScreenOfDisplay dpy; + colormap = defaultColormapOfScreen screen; + visual = defaultVisualOfScreen screen; + io $ withXftDraw dpy drw visual colormap $ + \draw -> withXftColorName dpy visual colormap fc $ + \color -> xftDrawString draw color font x y s + + +-- | Short-hand for 'fromIntegral' +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral hunk ./XMonad/Util/XUtils.hs 18 - stringToPixel - , averagePixels - , initFont - , releaseFont + averagePixels hunk ./XMonad/Util/XUtils.hs 24 - , Align (..) - , stringPosition hunk ./XMonad/Util/XUtils.hs 25 + , stringToPixel hunk ./XMonad/Util/XUtils.hs 35 -import XMonad.Operations +import XMonad.Util.Font hunk ./XMonad/Util/XUtils.hs 38 --- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" for usage --- examples +-- See Tabbed or DragPane for usage examples hunk ./XMonad/Util/XUtils.hs 58 - --- | Given a fontname returns the fonstructure. If the font name is --- not valid the default font will be loaded and returned. -initFont :: String -> X FontStruct -initFont s = do - d <- asks display - io $ catch (getIt d) (fallBack d) - where getIt d = loadQueryFont d s - fallBack d = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - -releaseFont :: FontStruct -> X () -releaseFont fs = do - d <- asks display - io $ freeFont d fs - hunk ./XMonad/Util/XUtils.hs 101 --- | String position -data Align = AlignCenter | AlignRight | AlignLeft - --- | Return the string x and y 'Position' in a 'Rectangle', given a --- 'FontStruct' and the 'Align'ment -stringPosition :: FontStruct -> Rectangle -> Align -> String -> (Position,Position) -stringPosition fs (Rectangle _ _ w h) al s = (x,y) - where width = textWidth fs s - (_,a,d,_) = textExtents fs s - y = fi $ ((h - fi (a + d)) `div` 2) + fi a - x = case al of - AlignCenter -> fi (w `div` 2) - fi (width `div` 2) - AlignLeft -> 1 - AlignRight -> fi (w - (fi width + 1)) - hunk ./XMonad/Util/XUtils.hs 103 - -> FontStruct -- ^ The FontStruct + -> XMonadFont -- ^ XMonad Font for drawing hunk ./XMonad/Util/XUtils.hs 114 -paintAndWrite w fs wh ht bw bc borc ffc fbc al str = - paintWindow' w r bw bc borc ms +paintAndWrite w fs wh ht bw bc borc ffc fbc al str = do + (x,y) <- stringPosition fs (Rectangle 0 0 wh ht) al str + paintWindow' w (Rectangle x y wh ht) bw bc borc ms hunk ./XMonad/Util/XUtils.hs 118 - r = Rectangle x y wh ht - (x,y) = stringPosition fs (Rectangle 0 0 wh ht) al str hunk ./XMonad/Util/XUtils.hs 121 -paintWindow' :: Window -> Rectangle -> Dimension -> String -> String -> Maybe (FontStruct,String,String,String) -> X () +paintWindow' :: Window -> Rectangle -> Dimension -> String -> String -> Maybe (XMonadFont,String,String,String) -> X () hunk ./XMonad/Util/XUtils.hs 128 - [c',bc'] <- mapM stringToPixel [color,b_color] + [color',b_color'] <- mapM stringToPixel [color,b_color] hunk ./XMonad/Util/XUtils.hs 130 - io $ setForeground d gc bc' + io $ setForeground d gc b_color' hunk ./XMonad/Util/XUtils.hs 133 - io $ setForeground d gc c' + io $ setForeground d gc color' hunk ./XMonad/Util/XUtils.hs 136 - let (fs,fc,bc,s) = fromJust str - io $ setFont d gc $ fontFromFontStruct fs - printString d p gc fc bc x y s + let (xmf,fc,bc,s) = fromJust str + printStringXMF d p xmf gc fc bc x y s hunk ./XMonad/Util/XUtils.hs 144 --- | Prints a string on a 'Drawable' -printString :: Display -> Drawable -> GC -> String -> String - -> Position -> Position -> String -> X () -printString d drw gc fc bc x y s = do - [fc',bc'] <- mapM stringToPixel [fc,bc] - io $ setForeground d gc fc' - io $ setBackground d gc bc' - io $ drawImageString d drw gc x y s - hunk ./xmonad-contrib.cabal 29 - build-depends: mtl, unix, X11==1.3.0.20071111, xmonad==0.4 + build-depends: mtl, unix, X11==1.3.0.20071111, xmonad==0.4, utf8-string, X11-xft hunk ./xmonad-contrib.cabal 109 + XMonad.Util.Font hunk ./XMonad/Util/Font.hs 18 - XMonadFont + XMonadFont hunk ./XMonad/Util/Font.hs 25 - , textWidthXMF - , textExtentsXMF - , printStringXMF - , stringToPixel + , textWidthXMF + , textExtentsXMF + , printStringXMF + , stringToPixel hunk ./XMonad/Util/Font.hs 125 - io $ setFont d gc $ fontFromFontStruct fs + io $ setFont d gc $ fontFromFontStruct fs hunk ./XMonad/Util/Font.hs 127 - io $ setForeground d gc fc' - io $ setBackground d gc bc' - io $ drawImageString d p gc x y s + io $ setForeground d gc fc' + io $ setBackground d gc bc' + io $ drawImageString d p gc x y s hunk ./XMonad/Util/Font.hs 136 - \draw -> withXftColorName dpy visual colormap fc $ - \color -> xftDrawString draw color font x y s + \draw -> withXftColorName dpy visual colormap fc $ + \color -> xftDrawString draw color font x y s hunk ./XMonad/Util/Font.hs 1 +{-# LANGUAGE CPP #-} + hunk ./XMonad/Util/Font.hs 35 -import Graphics.X11.Xft -import Graphics.X11.Xrender - hunk ./XMonad/Util/Font.hs 36 -import Data.List hunk ./XMonad/Util/Font.hs 40 +#ifdef XFT +import Data.List +import Graphics.X11.Xft +import Graphics.X11.Xrender +#endif + hunk ./XMonad/Util/Font.hs 47 -type XMonadFont = Either FontStruct XftFont +data XMonadFont = Core FontStruct +#ifdef XFT + | Xft XftFont +#endif hunk ./XMonad/Util/Font.hs 83 +#ifdef XFT hunk ./XMonad/Util/Font.hs 90 - (initCoreFont s >>= (return . Left)) +#endif + (initCoreFont s >>= (return . Core)) +#ifdef XFT hunk ./XMonad/Util/Font.hs 94 +#endif hunk ./XMonad/Util/Font.hs 97 -releaseXMF (Left fs) = releaseCoreFont fs -releaseXMF (Right xftfont) = do +releaseXMF (Core fs) = releaseCoreFont fs +#ifdef XFT +releaseXMF (Xft xftfont) = do hunk ./XMonad/Util/Font.hs 102 +#endif hunk ./XMonad/Util/Font.hs 105 -textWidthXMF _ (Left fs) s = return $ fi $ textWidth fs s +textWidthXMF _ (Core fs) s = return $ fi $ textWidth fs s +#ifdef XFT hunk ./XMonad/Util/Font.hs 110 +#endif hunk ./XMonad/Util/Font.hs 113 -textExtentsXMF _ (Left fs) s = return $ textExtents fs s +textExtentsXMF _ (Core fs) s = return $ textExtents fs s +#ifdef XFT hunk ./XMonad/Util/Font.hs 119 +#endif hunk ./XMonad/Util/Font.hs 141 -printStringXMF d p (Left fs) gc fc bc x y s = do +printStringXMF d p (Core fs) gc fc bc x y s = do hunk ./XMonad/Util/Font.hs 148 +#ifdef XFT hunk ./XMonad/Util/Font.hs 156 +#endif hunk ./XMonad/Util/Font.hs 88 - return (Right xftdraw) + return (Xft xftdraw) hunk ./XMonad/Util/Font.hs 107 -textWidthXMF dpy (Right xftdraw) s = do +textWidthXMF dpy (Xft xftdraw) s = do hunk ./XMonad/Util/Font.hs 115 -textExtentsXMF _ (Right xftfont) _ = do +textExtentsXMF _ (Xft xftfont) _ = do hunk ./XMonad/Util/Font.hs 149 -printStringXMF dpy drw (Right font) _ fc _ x y s = do +printStringXMF dpy drw (Xft font) _ fc _ x y s = do hunk ./xmonad-contrib.cabal 23 +flag use_xft + description: Use Xft to render text + hunk ./xmonad-contrib.cabal 32 - build-depends: mtl, unix, X11==1.3.0.20071111, xmonad==0.4, utf8-string, X11-xft + if flag(use_xft) + build-depends: X11-xft + ghc-options: -DXFT + + build-depends: mtl, unix, X11==1.3.0.20071111, xmonad==0.4, utf8-string hunk ./XMonad/Prompt.hs 448 - (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) (Left fs) str + (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) (Core fs) str hunk ./XMonad/Prompt.hs 514 - (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) (Left fs) $ head compl + (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) (Core fs) $ head compl hunk ./XMonad/Util/Font.hs 20 - XMonadFont + XMonadFont(..) hunk ./XMonad/Util/XUtils.hs 39 - --- | Get the Pixel value for a named color: if an invalid name is --- given the black pixel will be returned. -stringToPixel :: String -> X Pixel -stringToPixel s = do - d <- asks display - io $ catch (getIt d) (fallBack d) - where getIt d = initColor d s - fallBack d = const $ return $ blackPixel d (defaultScreen d) hunk ./xmonad-contrib.cabal 33 - build-depends: X11-xft + build-depends: X11-xft >= 0.2 hunk ./xmonad-contrib.cabal 36 - build-depends: mtl, unix, X11==1.3.0.20071111, xmonad==0.4, utf8-string + build-depends: mtl, unix, X11==1.3.0.20071111, xmonad==0.4 hunk ./Documentation.hs 17 - -- * Configuring XMonad: A Quick Start + -- * Configuring XMonad hunk ./Documentation.hs 50 - hunk ./Documentation.hs 68 -xmonad is configure by creating and editing the Haskell file: +xmonad is configured by creating and editing the Haskell file: hunk ./Documentation.hs 79 -Here is a basic example, which takes defaults from xmonad, and overrides -the border width, default terminal, and some colours: +Here is a basic example, which takes defaults from xmonad, and +overrides the border width, default terminal, and some colours: hunk ./Documentation.hs 95 -This will run \'xmonad\', the window manager, with your settings passed as -arguments. +This will run \'xmonad\', the window manager, with your settings +passed as arguments. hunk ./Documentation.hs 98 -Overriding default settings like this (using \"record update syntax\"), -will yield the shortest config file, as you only have to describe values -that differ from the defaults. +Overriding default settings like this (using \"record update +syntax\"), will yield the shortest config file, as you only have to +describe values that differ from the defaults. hunk ./Documentation.hs 102 -An alternative is to inline the entire default config file from xmonad, -and edit values you wish to change. This is requires more work, but some -users may find this easier. You can find the defaults in the file: +An alternative is to inline the entire default config file from +xmonad, and edit values you wish to change. This is requires more +work, but some users may find this easier. You can find the defaults +in the file: hunk ./Documentation.hs 157 + hunk ./Documentation.hs 168 -Put here an overview of the library with a description of the various -directories: Actions, Config, Hooks, Layout, Prompt, and Util. +The xmonad-contrib (xmc) library is a set of modules contributed by +xmonad hackers and users. Examples include an ion3-like tabbed layout, +a prompt\/program launcher, and various other useful modules. + +Some of these modules provide libraries and other useful functions to +write other modules and extensions. + +Here is a short overview of the xmc content: + + [@Actions@] The content of Action + + [@Config@] The content of Config + + [@Hooks@] The content of Hooks + + [@Layout@] The content of Layout + + [@Prompt@] The content of Prompt + + [@Util@] The content of Util hunk ./Documentation.hs 216 -> [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) -> , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) +> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) hunk ./Documentation.hs 232 -which means you need to use 'Data.Map.insert' in order to add some -bindings to the map of the existing key bindings. +which means you need to create a 'Data.Map.Map' from the list of your +bindings, with 'Data.Map.fromList', and join it with the exist one +with 'Data.Map.union'. hunk ./Documentation.hs 244 -you may wish to edit accordingly the default configuration + +then you create a new map by joining the default one with yours: + +> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) + +Finally you need to update accordingly the default configuration hunk ./Documentation.hs 253 -> where newKeys x = foldr (uncurry Data.Map.insert) (keys defaultConfig x) (myKeys x) + hunk ./Documentation.hs 257 -At the end you @~\/.xmonad\/xmonad.hs@ would look like this: +At the end your @~\/.xmonad\/xmonad.hs@ would look like this: hunk ./Documentation.hs 272 -> where newKeys x = foldr (uncurry M.insert) (keys defaultConfig x) (myKeys x) hunk ./Documentation.hs 273 -> myKeys x = +> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) +> +> myKeys x = hunk ./Documentation.hs 281 -Alternatively you may wish to use some of the utilities provided by -the xmonad-contrib library. +Obviously there are other ways of defining @newKeys@. For instance, +you could define it like this: + +> newKeys x = foldr (uncurry M.insert) (keys defaultConfig x) (myKeys x) hunk ./Documentation.hs 286 -For instance, "XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" -provide useful functions to edit you key bindings. +A simpler way to add new keybindings is the use of some of the +utilities provided by the xmonad-contrib library. For instance, +"XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" both provide +useful functions for editing your key bindings. Look, for instance, at +'XMonad.Util.EZConfig.additionalKeys'. hunk ./Documentation.hs 296 -keyDel +Removing key bindings requires modifying the binding 'Data.Map.Map'. +This can be done with 'Data.Map.difference' or with 'Data.Map.delete'. + +Suppose you wan to get rid of @mod-q@ and @mod-shift-q@. To do this +you just need to define a @newKeys@ as a 'Data.Map.difference' between +the default map and the map of the key bindings you want to remove. + +> newKeys x = M.difference (keys defaultConfig x) (M.fromList $ keysToRemove x) +> +> keysToRemove :: XConfig Layout -> [((KeyMask, KeySym),X ())] +> keysToRemove x = +> [ ((modMask x , xK_q ), return ()) +> , ((modMask x .|. shiftMask, xK_q ), return ()) +> ] + +As you may see we do not need to define an action for the key bindings +we want to get rid of. We just build a map of keys to remove. + +It is also possible to define a list of key bindings and then use +'Data.Map.delete' to remove them from the default key bindings, in +which case we should write something like: + +> newKeys x = foldr M.delete (keys defaultConfig x) (keysToRemove x) +> +> keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)] +> keysToRemove x = +> [ (modMask x , xK_q ) +> , (modMask x .|. shiftMask, xK_q ) +> ] + +Another even simpler possibility is the use of some of the utilities +provided by the xmonad-contrib library. Look, for instance, at +'XMonad.Util.EZConfig.removeKeys'. + hunk ./Documentation.hs 340 -layouts +Layouts hunk ./Documentation.hs 345 +Hooks hunk ./Documentation.hs 334 -keyAddDel +Adding and removing key bindings requires to compose the action of +removing and, after that, the action of adding. + +This is an example you may find in "XMonad.Config.Arossato": + + +> defKeys = keys defaultConfig +> delKeys x = foldr M.delete (defKeys x) (toRemove x) +> newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x) +> -- remove some of the default key bindings +> toRemove x = +> [ (modMask x , xK_j ) +> , (modMask x , xK_k ) +> , (modMask x , xK_p ) +> , (modMask x .|. shiftMask, xK_p ) +> , (modMask x .|. shiftMask, xK_q ) +> , (modMask x , xK_q ) +> ] ++ +> -- I want modMask .|. shiftMask 1-9 to be free! +> [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]] +> -- These are my personal key bindings +> toAdd x = +> [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) +> , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) +> ] ++ +> -- Use modMask .|. shiftMask .|. controlMask 1-9 instead +> [( (m .|. modMask x, k), windows $ f i) +> | (i, k) <- zip (workspaces x) [xK_1 .. xK_9] +> , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)] +> ] + +You can achieve the same result by using "XMonad.Util.CustomKeys" and, +specifically, 'XMonad.Util.CustomKeys.customKeys'. hunk ./XMonad/Config/Arossato.hs 101 - , terminal = "xterm" + , terminal = "urxvt -fg white -bg black +sb" hunk ./Documentation.hs 113 -Place this text in @~/.xmonad/xmonad.hs@, and then check that it is +Place this text in @~\/.xmonad\/xmonad.hs@, and then check that it is hunk ./Documentation.hs 215 -> myKeys x = +> myKeys x = hunk ./Documentation.hs 232 -which means you need to create a 'Data.Map.Map' from the list of your -bindings, with 'Data.Map.fromList', and join it with the exist one -with 'Data.Map.union'. +which means thatm in order to add new bindings you need to create a +'Data.Map.Map' from the list of your new key bindings, you can do that +with 'Data.Map.fromList', and then join this newly created map with +the one of the existing bindings. This can be done with +'Data.Map.union'. hunk ./Documentation.hs 241 -> myKeys x = +> myKeys x = hunk ./Documentation.hs 246 +then you create a new key bindings map by joining the default one with +yours: hunk ./Documentation.hs 249 -then you create a new map by joining the default one with yours: - -> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) +> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) hunk ./Documentation.hs 254 -> main = xmonad defaultConfig { keys = newKeys } +> main = xmonad defaultConfig { keys = newKeys } hunk ./Documentation.hs 288 -A simpler way to add new keybindings is the use of some of the +An even simpler way to add new key bindings is the use of some of the hunk ./xmonad-contrib.cabal 8 - As a starting point you can have a look at the "Documentation". + As a starting point you can have a look at the Haddock "Documentation". move ./XMonad/Util/Font.hs ./XMonad/Util/Font.cpphs hunk ./XMonad/Util/Font.cpphs 1 -{-# LANGUAGE CPP #-} - hunk ./XMonad/Config/Droundy.hs 1 -{-# OPTIONS_GHC -fno-warn-missing-signatures -fglasgow-exts #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures -fglasgow-exts -fno-warn-orphans #-} hunk ./xmonad-contrib.cabal 34 - ghc-options: -DXFT + cpp-options: -DXFT hunk ./xmonad-contrib.cabal 18 -cabal-version: >= 1.2 +cabal-version: >= 1.2.1 hunk ./Documentation.hs 16 - ( + ( hunk ./Documentation.hs 19 - + hunk ./Documentation.hs 22 - + hunk ./Documentation.hs 25 - + hunk ./Documentation.hs 28 - + hunk ./Documentation.hs 31 - + hunk ./Documentation.hs 34 - + + -- ** Actions + -- $actions + + -- ** Configurations + -- $configs + + -- ** Hooks + -- $hooks + + -- ** Layouts + -- $layouts + + -- ** Prompts + -- $prompts + + -- ** Utilities + -- $utils + hunk ./Documentation.hs 55 - + hunk ./Documentation.hs 68 - -- ** Adding\/Removing Layouts - -- $layout + -- ** Editing the Layout Hook + -- $layoutHook hunk ./Documentation.hs 71 - -- ** Hooks Management - -- $hooks + -- ** Editing the Manage Hook + -- $manageHook + + -- ** The Log Hook and External Status Bars + -- $logHook hunk ./Documentation.hs 79 + + -- ** XMonad Internals + -- $internals + + -- *** The 'LayoutClass' + -- $layoutClass + + -- *** The X Monad and the Internal State + -- $internalState + + -- *** Event Handling and Messages + -- $events + + -- ** Coding Style + -- $style + + -- ** License Policy + -- $license hunk ./Documentation.hs 99 + hunk ./Documentation.hs 125 -> -- +> -- hunk ./Documentation.hs 157 -> $ ghci ~/.xmonad/xmonad.hs +> $ ghci ~/.xmonad/xmonad.hs hunk ./Documentation.hs 165 -Ok, looks good. +Ok, looks good. hunk ./Documentation.hs 190 -> XMonad/Config.hs +> XMonad/Config.hs hunk ./Documentation.hs 194 -> XMonad/Core.hs +> XMonad/Core.hs hunk ./Documentation.hs 215 -Here is a short overview of the xmc content: - - [@Actions@] The content of Action +This is a short overview of the xmc content. + +-} + +{- $actions + +In the @XMonad.Actions@ name space you can find modules exporting +functions that can be usually attached to, and thus called with, some +key bindings. hunk ./Documentation.hs 225 - [@Config@] The content of Config +Each module should come with extensive documentation. hunk ./Documentation.hs 227 - [@Hooks@] The content of Hooks +There are many examples. Just to name two of them: hunk ./Documentation.hs 229 - [@Layout@] The content of Layout +* "XMonad.Actions.CycleWS" provides functions to switch to the next or + the previous workspace ('XMonad.Actions.CycleWS.nextWS' and + 'XMonad.Actions.CycleWS.prevWS', or to move the focused window to + the next of previous workspace + ('XMonad.Actions.CycleWS.shiftToNext' and + 'XMonad.Actions.CycleWS.shiftToPrev') hunk ./Documentation.hs 236 - [@Prompt@] The content of Prompt +* "XMonad.Actions.DeManage" provides an a method to cease management + of a window, without unmapping it + ('XMonad.Actions.DeManage.demanage') hunk ./Documentation.hs 240 - [@Util@] The content of Util + +-} + +{- $configs + +In the @XMonad.Config@ name space you can find modules exporting the +default configuration of some of the XMonad and XMonadContrig +libraries developers. + +You can use the source code of these configuration examples also as +starting points for writing your own personal configuration. + +-} + +{- $hooks + +TODO + +-} + +{- $layouts + +TODO + +-} + +{- $prompts + +TODO + +-} + +{- $utils + +TODO hunk ./Documentation.hs 302 -> myKeys x = -> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) -> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) -> ] +> myKeys x = +> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) +> ] hunk ./Documentation.hs 317 -> keys :: XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()) +> keys :: XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()) hunk ./Documentation.hs 328 -> myKeys x = -> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) -> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) -> ] +> myKeys x = +> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) +> ] hunk ./Documentation.hs 336 -> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) +> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) hunk ./Documentation.hs 341 -> main = xmonad defaultConfig { keys = newKeys } +> main = xmonad defaultConfig { keys = newKeys } hunk ./Documentation.hs 349 -> module Main (main) where -> -> import XMonad -> -> import qualified Data.Map as M -> import Graphics.X11.Xlib -> import XMonad.Prompt -> import XMonad.Prompt.Shell -> import XMonad.Prompt.XMonad +> module Main (main) where +> +> import XMonad +> +> import qualified Data.Map as M +> import Graphics.X11.Xlib +> import XMonad.Prompt +> import XMonad.Prompt.Shell +> import XMonad.Prompt.XMonad hunk ./Documentation.hs 359 -> main :: IO () -> main = xmonad defaultConfig { keys = newKeys } +> main :: IO () +> main = xmonad defaultConfig { keys = newKeys } hunk ./Documentation.hs 362 -> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) +> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) hunk ./Documentation.hs 364 -> myKeys x = -> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) -> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) -> ] +> myKeys x = +> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) +> ] hunk ./Documentation.hs 373 -> newKeys x = foldr (uncurry M.insert) (keys defaultConfig x) (myKeys x) +> newKeys x = foldr (uncurry M.insert) (keys defaultConfig x) (myKeys x) hunk ./Documentation.hs 392 -> newKeys x = M.difference (keys defaultConfig x) (M.fromList $ keysToRemove x) -> -> keysToRemove :: XConfig Layout -> [((KeyMask, KeySym),X ())] -> keysToRemove x = -> [ ((modMask x , xK_q ), return ()) -> , ((modMask x .|. shiftMask, xK_q ), return ()) -> ] +> newKeys x = M.difference (keys defaultConfig x) (M.fromList $ keysToRemove x) +> +> keysToRemove :: XConfig Layout -> [((KeyMask, KeySym),X ())] +> keysToRemove x = +> [ ((modMask x , xK_q ), return ()) +> , ((modMask x .|. shiftMask, xK_q ), return ()) +> ] hunk ./Documentation.hs 407 -> newKeys x = foldr M.delete (keys defaultConfig x) (keysToRemove x) -> -> keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)] -> keysToRemove x = -> [ (modMask x , xK_q ) -> , (modMask x .|. shiftMask, xK_q ) -> ] +> newKeys x = foldr M.delete (keys defaultConfig x) (keysToRemove x) +> +> keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)] +> keysToRemove x = +> [ (modMask x , xK_q ) +> , (modMask x .|. shiftMask, xK_q ) +> ] hunk ./Documentation.hs 429 -> defKeys = keys defaultConfig -> delKeys x = foldr M.delete (defKeys x) (toRemove x) -> newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x) -> -- remove some of the default key bindings -> toRemove x = -> [ (modMask x , xK_j ) -> , (modMask x , xK_k ) -> , (modMask x , xK_p ) -> , (modMask x .|. shiftMask, xK_p ) -> , (modMask x .|. shiftMask, xK_q ) -> , (modMask x , xK_q ) -> ] ++ -> -- I want modMask .|. shiftMask 1-9 to be free! -> [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]] -> -- These are my personal key bindings -> toAdd x = -> [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) -> , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) -> ] ++ -> -- Use modMask .|. shiftMask .|. controlMask 1-9 instead -> [( (m .|. modMask x, k), windows $ f i) -> | (i, k) <- zip (workspaces x) [xK_1 .. xK_9] -> , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)] -> ] +> defKeys = keys defaultConfig +> delKeys x = foldr M.delete (defKeys x) (toRemove x) +> newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x) +> -- remove some of the default key bindings +> toRemove x = +> [ (modMask x , xK_j ) +> , (modMask x , xK_k ) +> , (modMask x , xK_p ) +> , (modMask x .|. shiftMask, xK_p ) +> , (modMask x .|. shiftMask, xK_q ) +> , (modMask x , xK_q ) +> ] ++ +> -- I want modMask .|. shiftMask 1-9 to be free! +> [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]] +> -- These are my personal key bindings +> toAdd x = +> [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) +> , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) +> ] ++ +> -- Use modMask .|. shiftMask .|. controlMask 1-9 instead +> [( (m .|. modMask x, k), windows $ f i) +> | (i, k) <- zip (workspaces x) [xK_1 .. xK_9] +> , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)] +> ] hunk ./Documentation.hs 459 -{- $layout +{- $layoutHook + +TODO: Layouts hunk ./Documentation.hs 463 -Layouts hunk ./Documentation.hs 465 -{- $hooks +{- $manageHook + +TODO: Manage Hook + +-} + +{- $logHook + +TODO: Log Hook hunk ./Documentation.hs 475 -Hooks hunk ./Documentation.hs 484 - +#label# hunk ./Documentation.hs 488 + +{- $internals + +TODO + +-} + + +{- $layoutClass + +TODO + +-} + +{- $internalState + +TODO + +-} + +{- $events + +TODO + +-} + +{- $style + +TODO + +-} + +{- $license + +TODO + +-} + hunk ./Documentation.hs 17 - -- * Configuring XMonad + -- * Configuring xmonad hunk ./Documentation.hs 32 - -- * The XmonadContrib Library + -- * The xmonad-contrib library hunk ./Documentation.hs 53 - -- * Extending XMonad + -- * Extending xmonad hunk ./Documentation.hs 56 - -- ** Editing Key Bindings + -- ** Editing key bindings hunk ./Documentation.hs 59 - -- *** Adding Key Bindings + -- *** Adding key bindings hunk ./Documentation.hs 62 - -- *** Removing Key Bindings + -- *** Removing key bindings hunk ./Documentation.hs 65 - -- *** Adding and Removing Key Bindings + -- *** Adding and removing key bindings hunk ./Documentation.hs 68 - -- ** Editing the Layout Hook + -- ** Editing the layout hook hunk ./Documentation.hs 71 - -- ** Editing the Manage Hook + -- ** Editing the manage hook hunk ./Documentation.hs 74 - -- ** The Log Hook and External Status Bars + -- ** The log hook and external status bars hunk ./Documentation.hs 77 - -- * Writing Other Extensions + -- * Writing new extensions hunk ./Documentation.hs 80 - -- ** XMonad Internals + -- ** xmonad internals hunk ./Documentation.hs 86 - -- *** The X Monad and the Internal State + -- *** The X monad and the internal state hunk ./Documentation.hs 89 - -- *** Event Handling and Messages + -- *** Event handling and messages hunk ./Documentation.hs 92 - -- ** Coding Style + -- ** Coding style hunk ./Documentation.hs 95 - -- ** License Policy + -- ** Licensing policy hunk ./Documentation.hs 240 +See "Documentation#keys" for instruction on how to edit key bindings +for adding actions. hunk ./Documentation.hs 248 -default configuration of some of the XMonad and XMonadContrig +default configuration of some of the xmonad and xmonad-contrig hunk ./Documentation.hs 258 -TODO +In the @XMonad.Hooks@ name space you can find modules exporting hooks. + +Hooks are actions that xmonad performs when some events occur. The two +most important hooks are: + +* 'XMonad.Core.manageHook': this hook is called when a new window + xmonad must take care of is created. This is a very powerful hook, + since it let us look at the new window's properties and act + accordingly. For instance, we can configure xmonad to put windows + belonging to a given application in the float layer, not to manage + dock applications, or open them in a given workspace. See + "Documentation#manageHook" for more information on customizing the + 'XMonad.Core.manageHook'. + +* 'XMonad.Core.logHook': this hook is called when the stack of windows + managed by xmonad has been changed, by calling the + 'XMonad.Operations.windows' function. For instance + "XMonad.Hooks.DynamicLog" will produce a string (whose format can be + configured) to be printed to the standard output. This can be used + to display some information about the xmonad state in a Status Bar. + See "Documentation#StatusBar" for more information. hunk ./Documentation.hs 284 -TODO +In the @XMonad.Layout@ name space you can find modules exporting +contributed tiling algorithms, such as a tabbed layout, a circle and a +three columns ones, etc. + +Other modules provide facilities for combining different layouts, such +as "XMonad.Layout.Combo", or a complete set of layout combinators, +like "XMonad.Layout.LayoutCombinators" + +Layouts can be also modified with layout modifiers. A general +interface for writing layout modifiers is implemented in +"XMonad.Layout.LayoutModifier". + +For more information on using those modules for customizing your +'XMonad.Core.layoutHook' see "Documentation#layout". hunk ./Documentation.hs 303 -TODO +In the @XMonad.Prompt@ name space you can find modules exporting +graphical prompts for getting user input and performing, with it, +different actions. + +"XMonad.Prompt" provides a library for easily writing prompts. + +These are the available prompts: + +* "XMonad.Prompt.Directory" + +* "XMonad.Prompt.Layout" + +* "XMonad.Prompt.Man" + +* "XMonad.Prompt.Shell" + +* "XMonad.Prompt.Ssh" + +* "XMonad.Prompt.Window" + +* "XMonad.Prompt.Workspace" + +* "XMonad.Prompt.XMonad" + +Usually a prompt is called by some key binding. See +"Documentation#keys" on how to configure xmonad to use some prompts. +The give examples include adding some prompts. hunk ./Documentation.hs 335 -TODO +In the @XMonad.Util@ name space you can find modules exporting various +utility functions that are used by the othe modules of the +xmonad-contrib library. hunk ./Documentation.hs 357 - +#keys# hunk ./Documentation.hs 373 +Sometimes, more than complitely redifining the key bindings, as we did +above, we may want to add some new bindings, or\/and remove existing +ones. + hunk ./Documentation.hs 527 - +#layout# hunk ./Documentation.hs 533 - +#manageHook# hunk ./Documentation.hs 539 +#StatusBar# hunk ./Documentation.hs 552 -#label# + hunk ./Documentation.hs 584 -TODO +These are the coding guidelines for contributing to xmonad and the +xmonad contributed extensions. + +* Comment every top level function (particularly exported funtions), and + provide a type signature. + +* Use Haddock syntax in the comments. + +* Follow the coding style of the other modules. + +* Code should be compilable with -Wall -Werror. There should be no warnings. + +* Partial functions should be avoided: the window manager should not + crash, so do not call 'error' or 'undefined' + +* Tabs are /illegal/. Use 4 spaces for indenting. + +* Any pure function added to the core should have QuickCheck properties + precisely defining its behaviour. hunk ./Documentation.hs 608 -TODO +New modules should identify the author, and be submitted under the +same license as xmonad (BSD3 license or freer). hunk ./Documentation.hs 11 --- This is a module for documenting the xmonad-contrib library +-- This is a module for documenting the xmonad-contrib library. hunk ./Documentation.hs 23 - -- ** Checking your xmonad.hs is correct + -- ** Checking whether your xmonad.hs is correct hunk ./Documentation.hs 108 -xmonad is configured by creating and editing the Haskell file: +xmonad can be configured by creating and editing the Haskell file: hunk ./Documentation.hs 112 -xmonad then uses default settings from this file as arguments to the -window manager. +If this file does not exist, xmonad will simply use default settings; +if it does exist, xmonad will use whatever settings you specify. Note +that this file can contain arbitrary Haskell code, which means that +you have quite a lot of flexibility in configuring xmonad. + +NOTE for users of previous versions (< 0.5) of xmonad: this is a major +change in the way xmonad is configured. Prior to version 0.5, +configuring xmonad required editing an xmonad source file called +Config.hs, recompiling xmonad, and then restarting. From version 0.5 +onwards, however, all you have to do is edit xmonad.hs and restart +with @mod-q@; xmonad does the recompiling itself. The format of the +configuration file has also changed; it is now simpler and much +shorter, only requiring you to list those settings which are different +from the defaults. hunk ./Documentation.hs 131 -Here is a basic example, which takes defaults from xmonad, and -overrides the border width, default terminal, and some colours: +Here is a basic example, which starts with the default xmonad +configuration and overrides the border width, default terminal, and +some colours: hunk ./Documentation.hs 137 -> -- It overrides a few basic settings, reusing all the other defaults, +> -- It overrides a few basic settings, reusing all the other defaults. hunk ./Documentation.hs 162 +However, note that you should not edit Config.hs itself. + hunk ./Documentation.hs 168 -Place this text in @~\/.xmonad\/xmonad.hs@, and then check that it is -syntactically and type correct, by loading it in the Haskell -interpreter: +After changing your configuration, it is a good idea to check that it +is syntactically and type correct. You can do this easily by loading +your configuration file in the Haskell interpreter: hunk ./Documentation.hs 186 -To have xmonad start using your settings, try @mod-q@. xmonad will -attempt to compile this file, and run it. If it is unable to, the -defaults are used. This requires GHC and xmonad are in your @$PATH@ -settings. If GHC isn't in your path, you can still compile the -@xmonad.hs@ file yourself: +To get xmonad to use your new settings, type @mod-q@. xmonad will +attempt to compile this file, and run it. If everything goes well, +xmonad will seamlessly restart itself with the new settings, keeping +all your windows, layouts, etc. intact. If something goes wrong, the +previous (default) settings will be used. Note this requires +that GHC and xmonad are in your @$PATH@. If GHC isn't in your +path, you can still compile @xmonad.hs@ yourself: hunk ./Documentation.hs 195 -> $ ghc --make xmonad.hs +> $ /path/to/ghc --make xmonad.hs hunk ./XMonad/Layout/Grid.hs 46 - where - nwins = length st - ncols = ceiling . (sqrt :: Double -> Double) . fromIntegral $ nwins - mincs = nwins `div` ncols - extrs = nwins - ncols * mincs - chop :: Int -> Dimension -> [(Position, Dimension)] - chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m' - where - k :: Dimension - k = m `div` fromIntegral n - m' = fromIntegral m - k' :: Position - k' = fromIntegral k - xcoords = chop ncols rw - ycoords = chop mincs rh - ycoords' = chop (succ mincs) rh - (xbase, xext) = splitAt (ncols - extrs) xcoords - rectangles = combine ycoords xbase ++ combine ycoords' xext - where - combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys] + where + nwins = length st + ncols = ceiling . (sqrt :: Double -> Double) . fromIntegral $ nwins + mincs = nwins `div` ncols + extrs = nwins - ncols * mincs + chop :: Int -> Dimension -> [(Position, Dimension)] + chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m' + where + k :: Dimension + k = m `div` fromIntegral n + m' = fromIntegral m + k' :: Position + k' = fromIntegral k + xcoords = chop ncols rw + ycoords = chop mincs rh + ycoords' = chop (succ mincs) rh + (xbase, xext) = splitAt (ncols - extrs) xcoords + rectangles = combine ycoords xbase ++ combine ycoords' xext + where + combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys] addfile ./XMonad/Hooks/MessageHooks.hs hunk ./XMonad/Hooks/MessageHooks.hs 1 +{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.MessageHooks +-- Copyright : (c) Spencer Janssen 2007, Devin Mullins 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Devin Mullins , +-- David Roundy +-- Stability : experimental +-- Portability : not portable, uses mtl, X11, posix +-- +-- Provides an alternative main event loop that unifies event handlers into +-- the concept of a message filter chain. This module is experimental. +-- You'd have to be crazy to want to use it. +----------------------------------------------------------------------------- + +-- This module was started by copying the entire contents of XMonad.Main. Any +-- future changes to the original module should be replicated here. + +-- TODO: +-- * add state to messageHooks +-- * add messageHooks to the XConfig, if possible +-- * sendMessage should pass through the filter chain (broadcastMessage excepted) +-- * intercept broadcastMessage: +-- * * don't export broadcastMessage: +-- * * handle should just return True / False instead of calling broadcastMessage +-- * * broadcastMessage should be the last filter called by processMessage +-- * * users should be able to call broadcastMessage' (= processMessage $ messageHooks config) +-- * ability to schedule a message for delivery? +-- * ability to modify a message during transport? +-- * xmonad sends an InitMessage once? + +module XMonad.Hooks.MessageHooks (xmonad) where + +import Data.Bits +import qualified Data.Map as M +import qualified Data.Set as S +import Control.Monad.Reader +import Control.Monad.State +import Data.Maybe (fromMaybe) + +import System.Environment (getArgs) + +import Graphics.X11.Xlib hiding (refreshKeyboardMapping) +import Graphics.X11.Xlib.Extras +import Graphics.X11.Xinerama (getScreenInfo) + +import XMonad.Core +import XMonad.StackSet (new, floating, member) +import qualified XMonad.StackSet as W +import XMonad.Operations + +import System.IO + +-- True if message may continue; False to halt the filter chain. +type MessageHook = SomeMessage -> X Bool + +-- | +-- The main entry point +-- +xmonad :: (LayoutClass l Window, Read (l Window)) => [MessageHook] -> XConfig l -> IO () +xmonad messageHooks initxmc = do + -- First, wrap the layout in an existential, to keep things pretty: + let xmc = initxmc { layoutHook = Layout $ layoutHook initxmc } + dpy <- openDisplay "" + let dflt = defaultScreen dpy + + rootw <- rootWindow dpy dflt + xinesc <- getScreenInfo dpy + nbc <- initColor dpy $ normalBorderColor xmc + fbc <- initColor dpy $ focusedBorderColor xmc + hSetBuffering stdout NoBuffering + args <- getArgs + + let layout = layoutHook xmc + lreads = readsLayout layout + initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps + + maybeRead reads' s = case reads' s of + [(x, "")] -> Just x + _ -> Nothing + + winset = fromMaybe initialWinset $ do + ("--resume" : s : _) <- return args + ws <- maybeRead reads s + return . W.ensureTags layout (workspaces xmc) + $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws + + gaps = take (length xinesc) $ defaultGaps xmc ++ repeat (0,0,0,0) + + cf = XConf + { display = dpy + , config = xmc + , theRoot = rootw + , normalBorder = nbc + , focusedBorder = fbc + , keyActions = keys xmc xmc + , buttonActions = mouseBindings xmc xmc } + st = XState + { windowset = initialWinset + , mapped = S.empty + , waitingUnmap = M.empty + , dragging = Nothing } + + xSetErrorHandler -- in C, I'm too lazy to write the binding: dons + + -- setup initial X environment + sync dpy False + selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask + .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask + + allocaXEvent $ \e -> + runX cf st $ do + + grabKeys + grabButtons + + io $ sync dpy False + + -- bootstrap the windowset, Operations.windows will identify all + -- the windows in winset as new and set initial properties for + -- those windows + windows (const winset) + + -- scan for all top-level windows, add the unmanaged ones to the + -- windowset + ws <- io $ scan dpy rootw + mapM_ manage ws + + -- main loop, for all you HOF/recursion fans out there. + forever_ $ processMessage messageHooks . SomeMessage =<< io (nextEvent dpy e >> getEvent e) + + return () + where forever_ a = a >> forever_ a + + +processMessage :: [MessageHook] -> SomeMessage -> X () +processMessage (mh : mhs) msg = whenX (mh msg) $ processMessage mhs msg +processMessage [] msg + | Just event <- fromMessage msg = handle event +processMessage [] _ = return () + +-- --------------------------------------------------------------------- +-- | Event handler. Map X events onto calls into Operations.hs, which +-- modify our internal model of the window manager state. +-- +-- Events dwm handles that we don't: +-- +-- [ButtonPress] = buttonpress, +-- [Expose] = expose, +-- [PropertyNotify] = propertynotify, +-- +handle :: Event -> X () + +-- run window manager command +handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code}) + | t == keyPress = withDisplay $ \dpy -> do + s <- io $ keycodeToKeysym dpy code 0 + mClean <- cleanMask m + ks <- asks keyActions + userCode $ whenJust (M.lookup (mClean, s) ks) id + +-- manage a new window +handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do + wa <- io $ getWindowAttributes dpy w -- ignore override windows + -- need to ignore mapping requests by managed windows not on the current workspace + managed <- isClient w + when (not (wa_override_redirect wa) && not managed) $ do manage w + +-- window destroyed, unmanage it +-- window gone, unmanage it +handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ unmanage w + +-- We track expected unmap events in waitingUnmap. We ignore this event unless +-- it is synthetic or we are not expecting an unmap notification from a window. +handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do + e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap) + if (synthetic || e == 0) + then unmanage w + else modify (\s -> s { waitingUnmap = M.adjust pred w (waitingUnmap s) }) + +-- set keyboard mapping +handle e@(MappingNotifyEvent {}) = do + io $ refreshKeyboardMapping e + when (ev_request e == mappingKeyboard) grabKeys + +-- handle button release, which may finish dragging. +handle e@(ButtonEvent {ev_event_type = t}) + | t == buttonRelease = do + drag <- gets dragging + case drag of + -- we're done dragging and have released the mouse: + Just (_,f) -> modify (\s -> s { dragging = Nothing }) >> f + Nothing -> broadcastMessage e + +-- handle motionNotify event, which may mean we are dragging. +handle e@(MotionEvent {ev_event_type = _t, ev_x = x, ev_y = y}) = do + drag <- gets dragging + case drag of + Just (d,_) -> d (fromIntegral x) (fromIntegral y) -- we're dragging + Nothing -> broadcastMessage e + +-- click on an unfocused window, makes it focused on this workspace +handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b }) + | t == buttonPress = do + -- If it's the root window, then it's something we + -- grabbed in grabButtons. Otherwise, it's click-to-focus. + isr <- isRoot w + m <- cleanMask $ ev_state e + ba <- asks buttonActions + if isr then userCode $ whenJust (M.lookup (m, b) ba) ($ ev_subwindow e) + else focus w + sendMessage e -- Always send button events. + +-- entered a normal window, makes this focused. +handle e@(CrossingEvent {ev_window = w, ev_event_type = t}) + | t == enterNotify && ev_mode e == notifyNormal + && ev_detail e /= notifyInferior = focus w + +-- left a window, check if we need to focus root +handle e@(CrossingEvent {ev_event_type = t}) + | t == leaveNotify + = do rootw <- asks theRoot + when (ev_window e == rootw && not (ev_same_screen e)) $ setFocusX rootw + +-- configure a window +handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do + ws <- gets windowset + wa <- io $ getWindowAttributes dpy w + + bw <- asks (borderWidth . config) + + if M.member w (floating ws) + || not (member w ws) + then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges + { wc_x = ev_x e + , wc_y = ev_y e + , wc_width = ev_width e + , wc_height = ev_height e + , wc_border_width = fromIntegral bw + , wc_sibling = ev_above e + , wc_stack_mode = ev_detail e } + when (member w ws) (float w) + else io $ allocaXEvent $ \ev -> do + setEventType ev configureNotify + setConfigureEvent ev w w + (wa_x wa) (wa_y wa) (wa_width wa) + (wa_height wa) (ev_border_width e) none (wa_override_redirect wa) + sendEvent dpy w False 0 ev + io $ sync dpy False + +-- configuration changes in the root may mean display settings have changed +handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen + +-- property notify +handle PropertyEvent { ev_event_type = t, ev_atom = a } + | t == propertyNotify && a == wM_NAME = userCode =<< asks (logHook . config) + +handle e = broadcastMessage e -- trace (eventName e) -- ignoring + + +-- --------------------------------------------------------------------- +-- IO stuff. Doesn't require any X state +-- Most of these things run only on startup (bar grabkeys) + +-- | scan for any new windows to manage. If they're already managed, +-- this should be idempotent. +scan :: Display -> Window -> IO [Window] +scan dpy rootw = do + (_, _, ws) <- queryTree dpy rootw + filterM ok ws + -- TODO: scan for windows that are either 'IsViewable' or where WM_STATE == + -- Iconic + where ok w = do wa <- getWindowAttributes dpy w + a <- internAtom dpy "WM_STATE" False + p <- getWindowProperty32 dpy a w + let ic = case p of + Just (3:_) -> True -- 3 for iconified + _ -> False + return $ not (wa_override_redirect wa) + && (wa_map_state wa == waIsViewable || ic) + +-- | Grab the keys back +grabKeys :: X () +grabKeys = do + XConf { display = dpy, theRoot = rootw } <- ask + let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync + io $ ungrabKey dpy anyKey anyModifier rootw + ks <- asks keyActions + forM_ (M.keys ks) $ \(mask,sym) -> do + kc <- io $ keysymToKeycode dpy sym + -- "If the specified KeySym is not defined for any KeyCode, + -- XKeysymToKeycode() returns zero." + when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) =<< extraModifiers + +-- | XXX comment me +grabButtons :: X () +grabButtons = do + XConf { display = dpy, theRoot = rootw } <- ask + let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask + grabModeAsync grabModeSync none none + io $ ungrabButton dpy anyButton anyModifier rootw + ems <- extraModifiers + ba <- asks buttonActions + mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba) hunk ./xmonad-contrib.cabal 69 + XMonad.Hooks.MessageHooks hunk ./XMonad/Prompt/Shell.hs 47 --- %import XMonad.Prompt.ShellPrompt +-- %import XMonad.Prompt.Shell hunk ./XMonad/Prompt/Layout.hs 31 --- +-- +-- > import XMonad.Prompt hunk ./XMonad/Prompt/Man.hs 45 --- > import XMonad.Prompt.ManPrompt +-- > import XMonad.Prompt +-- > import XMonad.Prompt.Man hunk ./XMonad/Prompt/Man.hs 52 --- %import XMonad.Prompt.XPrompt --- %import XMonad.Prompt.ManPrompt +-- %import XMonad.Prompt +-- %import XMonad.Prompt.Man hunk ./XMonad/Prompt/Ssh.hs 36 --- > import XMonad.Prompt.SshPrompt +-- > import XMonad.Prompt.Ssh hunk ./XMonad/Prompt/Ssh.hs 44 --- %import XMonad.Prompt.SshPrompt +-- %import XMonad.Prompt.Ssh hunk ./XMonad/Prompt/Window.hs 42 --- > import XMonad.Prompt.WindowPrompt +-- > import XMonad.Prompt.Window hunk ./XMonad/Prompt/Window.hs 50 --- %import XMonad.Prompt.WindowPrompt +-- %import XMonad.Prompt.Window hunk ./XMonad/Prompt/Workspace.hs 11 --- A directory prompt for XMonad +-- A workspace prompt for XMonad hunk ./XMonad/Prompt/Workspace.hs 30 --- > import XMonad.Prompt.WorkspacePrompt +-- > import XMonad.Prompt +-- > import XMonad.Prompt.Workspace hunk ./XMonad/Prompt/Workspace.hs 33 --- > , ((modMask .|. shiftMask, xK_m ), workspacePrompt myXPConfig (windows . W.shift)) +-- > , ((modMask .|. shiftMask, xK_m ), workspacePrompt defaultXPConfig (windows . W.shift)) hunk ./XMonad/Hooks/MessageHooks.hs 1 -{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, PatternGuards #-} hunk ./Documentation.hs 80 + -- ** Libraries for writing window managers + -- $xmonad-libs + hunk ./Documentation.hs 86 - -- *** The 'LayoutClass' - -- $layoutClass + -- *** The @main@ entry point + -- $main hunk ./Documentation.hs 95 + -- *** The 'LayoutClass' + -- $layoutClass + hunk ./Documentation.hs 113 - +#Configuring_xmonad# hunk ./Documentation.hs 136 +#A_simple_example# hunk ./Documentation.hs 174 +#Checking_whether_your_xmonad.hs_is_correct# hunk ./Documentation.hs 193 +#Loading_your_configuration# hunk ./Documentation.hs 213 +#Where_are_the_defaults?# hunk ./Documentation.hs 267 -See "Documentation#keys" for instruction on how to edit key bindings -for adding actions. +See "Documentation#Editing_key_bindings" for instruction on how to +edit key bindings for adding actions. hunk ./Documentation.hs 296 - "Documentation#manageHook" for more information on customizing the - 'XMonad.Core.manageHook'. + "Documentation#Editing_the_manage_hook" for more information on + customizing the 'XMonad.Core.manageHook'. hunk ./Documentation.hs 305 - See "Documentation#StatusBar" for more information. + See "Documentation#The_log_hook_and_external_status_bars" for more + information. hunk ./Documentation.hs 325 -'XMonad.Core.layoutHook' see "Documentation#layout". +'XMonad.Core.layoutHook' see "Documentation#Editing_the_layout_hook". hunk ./Documentation.hs 356 -"Documentation#keys" on how to configure xmonad to use some prompts. -The give examples include adding some prompts. +"Documentation#Editing_key_bindings" on how to configure xmonad to use +some prompts. The give examples include adding some prompts. hunk ./Documentation.hs 364 -utility functions that are used by the othe modules of the +utility functions that are used by the other modules of the hunk ./Documentation.hs 367 +There are also utilities for helping in configuring xmonad or using +external utilities. + +A non complete list with a brief description: + +* "XMonad.Util.CustomKeys" or "XMonad.Util.EZConfig" can be used to + configure key bindings (see "Documentation#Editing_key_bindings"); + +* "XMonad.Util.Dzen" "XMonad.Util.Dmenu" provide useful functions for + running dzen as a xmonad status bar and dmenu as a program launcher; + +* "XMonad.Util.XSelection" provide utilities for using the mouse + selection; + +* "XMonad.Util.XUtils" and "XMonad.Util.Font" are libraries for + accessing Xlib and XFT function in a convenient way. + hunk ./Documentation.hs 393 +#Extending_xmonad# hunk ./Documentation.hs 403 -#keys# +#Editing_key_bindings# + hunk ./Documentation.hs 420 -Sometimes, more than complitely redifining the key bindings, as we did +Sometimes, more than completely redefining the key bindings, as we did hunk ./Documentation.hs 427 +#Adding_key_bindings# hunk ./Documentation.hs 499 +#Removing_key_bindings# hunk ./Documentation.hs 538 +#Adding_and_removing_key_bindings# hunk ./Documentation.hs 577 -#layout# -TODO: Layouts +#Editing_the_layout_hook# + +When you start an application that opens a new window, when you change +the focused window, or move it to another workspace, or change that +workspace's layout, xmonad will use the 'XMonad.Core.layoutHook' for +reordering the visible windows on the visible workspace(s). + +Since different layouts may be attached to different workspaces, and +you can change them, xmonad needs to know which one to pick up, so, +the layoutHook may be thought as a stack, or even better a combination +of layouts. This also means an order, i.e. a list. + +The problem is that the layout subsystem is implemented with an +advanced feature of the Haskell programming language: type classes. +This allows us to very easily write new layouts, combine or modify +existing layouts, have some of them with a state, etc. See +"Documentation#The_LayoutClass" for more information. + +The price we have to pay to get all that for free - which is something +that makes xmonad so powerful with such a ridiculously low number of +lines - is that we cannot simply have a list of layouts as we used to +have before the 0.5 release. + +Instead the combination of layouts to be used by xmonad is created +with a specific layout combinator: 'XMonad.Layouts.|||' + +Suppose we want a list with the 'XMonad.Layouts.Full', the +'XMonad.Layout.Tabbed.tabbed' and the +'XMonad.Layout.Accordion.Accordion' layouts. First we import, in our +@~\/.xmonad\/xmonad.hs@, all the needed module: + +> import XMonad +> import XMonad.Layouts +> +> import XMonad.Layout.Tabbed +> import XMonad.Layout.Accordion + +Then we create the combination of layouts we need: + +> mylayoutHook = Full ||| tabbed shrinkText defaultTConf ||| Accordion + + +Now, all we need to do is to change the 'XMonad.Core.layoutHook' +record of the 'XMonad.Core.XConfig' data type, like: + +> main = xmonad defaultConfig { layoutHook = mylayoutHook } + +Thanks to the new combinator we can apply a layout modifier to the +combination of layouts, instead of applying it to each one. Suppose we +want to use the 'XMonad.Layout.NoBorders.noBorders' layout modifier, +from the "XMonad.Layout.NoBorders" module (which must be imported): + +> mylayoutHook = noBorders (Full ||| tabbed shrinkText defaultTConf ||| Accordion) + +Obviously, if we want only the tabbed layout without borders, then we +may write: + +> mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion + +The @~\/.xmonad\/xmonad.hs@ will now look like this: + +> import XMonad.Layouts +> +> import XMonad.Layout.Tabbed +> import XMonad.Layout.Accordion +> import XMonad.Layout.NoBorders +> +> mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion +> +> main = xmonad defaultConfig { layoutHook = mylayoutHook } + +That's it! hunk ./Documentation.hs 653 -#manageHook# +#Editing_the_manage_hook# hunk ./Documentation.hs 659 -#StatusBar# +#The_log_hook_and_external_status_bars# hunk ./Documentation.hs 677 +{- $xmonad-libs + +xmonad and xmonad-contrib are just libraries for letting users write +their own window managers. This is what makes xmonad such a powerful +and still simple application. + +Give some examples: +arossato_vm +droundy_wm + +In the previous sections we show how simple it can be to write your +own window manager by using the core code (xmonad) and some of the +contributed code (xmonad-contrib). + +In this section we will give you a brief overview of the programming +techniques that have been used in order to make writing new extensions +very simple. + +-} + hunk ./Documentation.hs 703 - -{- $layoutClass +{- $main +#The_main_entry_point# hunk ./Documentation.hs 719 + +-} + +{- $layoutClass +#The_LayoutClass# +TODO hunk ./XMonad/Prompt/Man.hs 50 --- > , ((modMask, xK_F1), manPrompt defaultXPConfig) -- mod-f1 %! Query for manual page to be displayed +-- > , ((modMask, xK_F1), manPrompt defaultXPConfig) hunk ./XMonad/Actions/SinkAll.hs 25 --- > keys = [ ((modMask .|. shiftMask, xK_t), sinkAll) ] +-- > keys x = [ ((modMask x .|. shiftMask, xK_t), sinkAll) ] +-- +-- where 'x' is your XConfig. hunk ./XMonad/Actions/SinkAll.hs 30 --- %keybind , ((modMask .|. shiftMask, xK_t), sinkAll) +-- %keybind , ((modMask x .|. shiftMask, xK_t), sinkAll) hunk ./XMonad/Prompt/XMonad.hs 33 --- in you keybindings add: +-- in your keybindings add: hunk ./XMonad/Prompt/Layout.hs 35 --- > , ((modMask .|. shiftMask, xK_m ), layoutPrompt defaultXPConfig) +-- > , ((modMask x .|. shiftMask, xK_m ), layoutPrompt defaultXPConfig) hunk ./XMonad/Prompt/Man.hs 50 --- > , ((modMask, xK_F1), manPrompt defaultXPConfig) +-- > , ((modMask x, xK_F1), manPrompt defaultXPConfig) hunk ./XMonad/Prompt/Man.hs 54 --- %keybind , ((modMask, xK_F1), manPrompt defaultXPConfig) +-- %keybind , ((modMask x, xK_F1), manPrompt defaultXPConfig) hunk ./XMonad/Prompt/Shell.hs 43 --- > , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig) +-- > , ((modMask x .|. controlMask, xK_x), shellPrompt defaultXPConfig) hunk ./XMonad/Prompt/Shell.hs 48 --- %keybind , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig) +-- %keybind , ((modMask x .|. controlMask, xK_x), shellPrompt defaultXPConfig) hunk ./XMonad/Prompt/Ssh.hs 40 --- > , ((modMask .|. controlMask, xK_s), sshPrompt defaultXPConfig) +-- > , ((modMask x .|. controlMask, xK_s), sshPrompt defaultXPConfig) hunk ./XMonad/Prompt/Ssh.hs 45 --- %keybind , ((modMask .|. controlMask, xK_s), sshPrompt defaultXPConfig) +-- %keybind , ((modMask x .|. controlMask, xK_s), sshPrompt defaultXPConfig) hunk ./XMonad/Prompt/Window.hs 46 --- > , ((modMask .|. shiftMask, xK_g ), windowPromptGoto defaultXPConfig) --- > , ((modMask .|. shiftMask, xK_b ), windowPromptBring defaultXPConfig) +-- > , ((modMask x .|. shiftMask, xK_g ), windowPromptGoto defaultXPConfig) +-- > , ((modMask x .|. shiftMask, xK_b ), windowPromptBring defaultXPConfig) hunk ./XMonad/Prompt/Window.hs 51 --- %keybind , ((modMask .|. shiftMask, xK_g ), windowPromptGoto defaultXPConfig) --- %keybind , ((modMask .|. shiftMask, xK_b ), windowPromptBring defaultXPConfig) +-- %keybind , ((modMask x .|. shiftMask, xK_g ), windowPromptGoto defaultXPConfig) +-- %keybind , ((modMask x .|. shiftMask, xK_b ), windowPromptBring defaultXPConfig) hunk ./XMonad/Prompt/Workspace.hs 33 --- > , ((modMask .|. shiftMask, xK_m ), workspacePrompt defaultXPConfig (windows . W.shift)) +-- > , ((modMask x .|. shiftMask, xK_m ), workspacePrompt defaultXPConfig (windows . W.shift)) hunk ./XMonad/Prompt/XMonad.hs 35 --- > , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) +-- > , ((modMask x .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) hunk ./XMonad/Prompt/XMonad.hs 40 --- %keybind , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) +-- %keybind , ((modMask x .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) hunk ./Documentation.hs 198 -all your windows, layouts, etc. intact. If something goes wrong, the -previous (default) settings will be used. Note this requires -that GHC and xmonad are in your @$PATH@. If GHC isn't in your -path, you can still compile @xmonad.hs@ yourself: +all your windows, layouts, etc. intact. (If you change anything +related to your layouts, you may need to hit @mod-shift-space@ after +restarting to see the changes take effect.) If something goes wrong, +the previous (default) settings will be used. Note this requires that +GHC and xmonad are in your @$PATH@. If GHC isn't in your path, you can +still compile @xmonad.hs@ yourself: hunk ./Documentation.hs 237 -The xmonad-contrib (xmc) library is a set of modules contributed by -xmonad hackers and users. Examples include an ion3-like tabbed layout, -a prompt\/program launcher, and various other useful modules. +The xmonad-contrib (xmc) library is a set of extension modules +contributed by xmonad hackers and users, which provide additional +xmonad features. Examples include various layout modes (tabbed, +spiral, three-column...), prompts, program launchers, the ability to +manipulate windows and workspaces in various ways, alternate +navigation modes, and much more. There are also \"meta-modules\" +which make it easier to write new modules and extensions. hunk ./Documentation.hs 245 -Some of these modules provide libraries and other useful functions to -write other modules and extensions. - -This is a short overview of the xmc content. +This is a short overview of the xmonad-contrib modules. For more +information about any particular module, just click on its name to +view its Haddock documentation; each module should come with extensive +documentation. If you find a module that could be better documented, +or has incorrect documentation, please report it as a bug +()! hunk ./Documentation.hs 256 -In the @XMonad.Actions@ name space you can find modules exporting -functions that can be usually attached to, and thus called with, some -key bindings. +In the @XMonad.Actions@ namespace you can find modules exporting +various functions that are usually intended to be bound to key +combinations or mouse actions, in order to provide functionality +beyond the standard keybindings provided by xmonad. + +See "Documentation#Editing_key_bindings" for instructions on how to +edit your key bindings. + +* "XMonad.Actions.Commands": running internal xmonad actions + interactively. + +* "XMonad.Actions.ConstrainedResize": an aspect-ratio-constrained + window resizing mode. + +* "XMonad.Actions.CopyWindow": duplicating windows on multiple + workspaces. + +* "XMonad.Actions.CycleWS": move between workspaces. + +* "XMonad.Actions.DeManage": cease management of a window without + unmapping it. + +* "XMonad.Actions.DwmPromote": dwm-like master window swapping. + +* "XMonad.Actions.DynamicWorkspaces": add and delete workspaces. + +* "XMonad.Actions.FindEmptyWorkspace": find an empty workspace. + +* "XMonad.Actions.FlexibleManipulate": move\/resize windows without + warping the mouse. + +* "XMonad.Actions.FlexibleResize": resize windows from any corner. hunk ./Documentation.hs 289 -Each module should come with extensive documentation. +* "XMonad.Actions.FloatKeys": move\/resize floating windows with + keybindings. hunk ./Documentation.hs 292 -There are many examples. Just to name two of them: +* "XMonad.Actions.FocusNth": focus the nth window on the screen. hunk ./Documentation.hs 294 -* "XMonad.Actions.CycleWS" provides functions to switch to the next or - the previous workspace ('XMonad.Actions.CycleWS.nextWS' and - 'XMonad.Actions.CycleWS.prevWS', or to move the focused window to - the next of previous workspace - ('XMonad.Actions.CycleWS.shiftToNext' and - 'XMonad.Actions.CycleWS.shiftToPrev') +* "XMonad.Actions.MouseGestures": bind mouse gestures to actions. hunk ./Documentation.hs 296 -* "XMonad.Actions.DeManage" provides an a method to cease management - of a window, without unmapping it - ('XMonad.Actions.DeManage.demanage') +* "XMonad.Actions.RotSlaves": rotate non-master windows. hunk ./Documentation.hs 298 -See "Documentation#Editing_key_bindings" for instruction on how to -edit key bindings for adding actions. +* "XMonad.Actions.RotView": cycle through non-empty workspaces. + +* "XMonad.Actions.SimpleDate": display the date in a popup menu. + +* "XMonad.Actions.SinkAll": sink all floating windows. + +* "XMonad.Actions.Submap": create key submaps, i.e. the ability to + bind actions to key sequences rather than being limited to single + key combinations. + +* "XMonad.Actions.SwapWorkspaces": swap workspace tags. + +* "XMonad.Actions.TagWindows": tag windows and select by tag. + +* "XMonad.Actions.Warp": warp the pointer. + +* "XMonad.Actions.WindowBringer": bring windows to you, and you to + windows. + +* "XMonad.Actions.WmiiActions": wmii-style actions. hunk ./Documentation.hs 323 -In the @XMonad.Config@ name space you can find modules exporting the -default configuration of some of the xmonad and xmonad-contrig -libraries developers. - -You can use the source code of these configuration examples also as -starting points for writing your own personal configuration. +In the @XMonad.Config@ namespace you can find modules exporting the +configurations used by some of the xmonad and xmonad-contrib +developers. You can look at them for examples while creating your own +configuration; you can also simply import them and use them as your +own configuration, possibly with some modifications. hunk ./Documentation.hs 333 -In the @XMonad.Hooks@ name space you can find modules exporting hooks. +In the @XMonad.Hooks@ namespace you can find modules exporting hooks. hunk ./Documentation.hs 411 -In the @XMonad.Util@ name space you can find modules exporting various +In the @XMonad.Util@ namespace you can find modules exporting various hunk ./Documentation.hs 687 -> +> hunk ./Documentation.hs 691 -> +> hunk ./Documentation.hs 693 -> +> hunk ./XMonad/Actions/RotSlaves.hs 11 --- Rotate all windows except the master window +-- Rotate all windows except the master window hunk ./XMonad/Actions/RotSlaves.hs 36 --- stays where it is. It is useful together with the TwoPane-Layout (see XMonad.Actions.TwoPane). +-- stays where it is. It is useful together with the TwoPane-Layout (see "XMonad.Layout.TwoPane"). hunk ./XMonad/Actions/CopyWindow.hs 67 --- | Remove the focussed window from this workspace. If it's present in no +-- | Remove the focused window from this workspace. If it's present in no hunk ./XMonad/Actions/FloatKeys.hs 56 --- absolut point (ax, ay) fixed +-- absolute point (ax, ay) fixed hunk ./XMonad/Actions/TagWindows.hs 62 --- NOTE: Tags are saved as space seperated string and split with 'unwords' thus +-- NOTE: Tags are saved as space separated string and split with 'unwords' thus hunk ./XMonad/Hooks/DynamicLog.hs 82 --- The intent is that the avove config file should provide a nice status +-- The intent is that the above config file should provide a nice status hunk ./XMonad/Hooks/DynamicLog.hs 195 --- | Escape any dzen metacharaters. +-- | Escape any dzen metacharacters. hunk ./XMonad/Hooks/ManageDocks.hs 58 --- Add the imports to your configuration file and add the mangeHook: +-- Add the imports to your configuration file and add the manageHook: hunk ./XMonad/Layout/Combo.hs 58 --- weirdness in combineTwo, in that the mod-tab focus order is not very --- closely related to the layout order. This is because we're forced to --- keep track of the window positions sparately, and this is ugly. If you --- don't like this, lobby for hierarchical stacks in core xmonad or go --- reimelement the core of xmonad yourself. +-- weirdness in combineTwo, in that the mod-tab focus order is not very closely +-- related to the layout order. This is because we're forced to keep track of +-- the window positions separately, and this is ugly. If you don't like this, +-- lobby for hierarchical stacks in core xmonad or go reim:lement the core of +-- xmonad yourself. hunk ./XMonad/Layout/MultiToggle.hs 162 --- | Prepend an element to a heterogenuous list. Used to build transformer +-- | Prepend an element to a heterogeneous list. Used to build transformer hunk ./XMonad/Prompt.hs 93 - , bgColor :: String -- ^ Backgroud color + , bgColor :: String -- ^ Background color hunk ./XMonad/Prompt.hs 96 - , bgHLight :: String -- ^ Backgroud color of a highlighted completion entry + , bgHLight :: String -- ^ Background color of a highlighted completion entry hunk ./XMonad/Prompt.hs 339 --- | Flush the command string and reset the offest +-- | Flush the command string and reset the offset hunk ./XMonad/Prompt.hs 441 - -- scompose the string in 3 part: till the cursor, the cursor and the rest + -- compose the string in 3 parts: till the cursor, the cursor and the rest hunk ./XMonad/Util/EZConfig.hs 45 --- Remove standard keybidings you're not using. Example use: +-- Remove standard keybindings you're not using. Example use: hunk ./XMonad/Util/Run.hs 13 --- Spencer Jannsen), "XMonad.Util.Dzen" (by glasser\@mit.edu) and +-- Spencer Janssen), "XMonad.Util.Dzen" (by glasser\@mit.edu) and hunk ./XMonad/Util/XUtils.hs 110 --- This stuf is not exported +-- This stuff is not exported hunk ./XMonad/Layout/WindowNavigation.hs 115 - do XConf { normalBorder = nbc, focusedBorder = fbc } <- ask + do XConf { normalBorder = nbc, focusedBorder = fbc, display = dpy } <- ask hunk ./XMonad/Layout/WindowNavigation.hs 120 - Nothing -> mapM stringToPixel [upColor conf, downColor conf, - leftColor conf, rightColor conf] + Nothing -> mapM (stringToPixel dpy) [upColor conf, downColor conf, + leftColor conf, rightColor conf] hunk ./XMonad/Prompt.hs 32 - , printString hunk ./XMonad/Prompt.hs 51 -import Control.Arrow ((***),(&&&)) +import Control.Arrow ((&&&)) hunk ./XMonad/Prompt.hs 82 - , fontS :: FontStruct + , fontS :: XMonadFont hunk ./XMonad/Prompt.hs 145 - -> GC -> FontStruct -> p -> [History] -> XPConfig -> XPState + -> GC -> XMonadFont -> p -> [History] -> XPConfig -> XPState hunk ./XMonad/Prompt.hs 171 - fs <- initCoreFont (font conf) - liftIO $ setFont d gc $ fontFromFontStruct fs + fs <- initXMF (font conf) hunk ./XMonad/Prompt.hs 175 - releaseCoreFont fs + releaseXMF fs hunk ./XMonad/Prompt.hs 445 - (fsl,psl) = (textWidth fs *** textWidth fs) (f,p) - (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) (Core fs) str + fsl <- io $ textWidthXMF (dpy st) fs f + psl <- io $ textWidthXMF (dpy st) fs p + (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) fs str hunk ./XMonad/Prompt.hs 450 - fgcolor <- io $ initColor d $ fgColor c - bgcolor <- io $ initColor d $ bgColor c + + let draw = printStringXMF d drw fs gc hunk ./XMonad/Prompt.hs 453 - io $ printString d drw gc fgcolor bgcolor x y f + draw (fgColor c) (bgColor c) x y f hunk ./XMonad/Prompt.hs 455 - io $ printString d drw gc bgcolor fgcolor (x + fsl) y p + draw (bgColor c) (fgColor c) (x + fromIntegral fsl) y p hunk ./XMonad/Prompt.hs 457 - io $ printString d drw gc fgcolor bgcolor (x + fsl + psl) y ss + draw (fgColor c) (bgColor c) (x + fromIntegral (fsl + psl)) y ss hunk ./XMonad/Prompt.hs 502 - let max_compl_len = (fi ht `div` 2) + (maximum . map (textWidth fs) $ compl) + tws <- mapM (textWidthXMF (dpy st) fs) compl + let max_compl_len = fromIntegral ((fi ht `div` 2) + maximum tws) hunk ./XMonad/Prompt.hs 514 - (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) (Core fs) $ head compl + (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) fs $ head compl hunk ./XMonad/Prompt.hs 531 - fgcolor <- io $ initColor d (fgColor c) hunk ./XMonad/Prompt.hs 539 - printComplList d p gc fgcolor bgcolor xx yy ac + printComplList d p gc (fgColor c) (bgColor c) xx yy ac hunk ./XMonad/Prompt.hs 560 -printComplList :: Display -> Drawable -> GC -> Pixel -> Pixel +printComplList :: Display -> Drawable -> GC -> String -> String hunk ./XMonad/Prompt.hs 568 -printComplColumn :: Display -> Drawable -> GC -> Pixel -> Pixel +printComplColumn :: Display -> Drawable -> GC -> String -> String hunk ./XMonad/Prompt.hs 576 -printComplString :: Display -> Drawable -> GC -> Pixel -> Pixel +printComplString :: Display -> Drawable -> GC -> String -> String hunk ./XMonad/Prompt.hs 581 - then do bhc <- io $ initColor d (bgHLight $ config st) - fhc <- io $ initColor d (fgHLight $ config st) - io $ printString d drw gc fhc bhc x y s - else io $ printString d drw gc fc bc x y s + then printStringXMF d drw (fontS st) gc + (fgHLight $ config st) (bgHLight $ config st) x y s + else printStringXMF d drw (fontS st) gc fc bc x y s hunk ./XMonad/Prompt.hs 625 --- | Prints a string on a 'Drawable' -printString :: Display -> Drawable -> GC -> Pixel -> Pixel - -> Position -> Position -> String -> IO () -printString d drw gc fc bc x y s = do - setForeground d gc fc - setBackground d gc bc - drawImageString d drw gc x y s - hunk ./XMonad/Util/Font.cpphs 55 -stringToPixel :: String -> X Pixel -stringToPixel s = do - d <- asks display - io $ catch (getIt d) (fallBack d) - where getIt d = initColor d s - fallBack d = const $ return $ blackPixel d (defaultScreen d) +stringToPixel :: MonadIO m => Display -> String -> m Pixel +stringToPixel d s = liftIO $ catch getIt fallBack + where getIt = initColor d s + fallBack = const $ return $ blackPixel d (defaultScreen d) hunk ./XMonad/Util/Font.cpphs 100 -textWidthXMF :: Display -> XMonadFont -> String -> IO Int +textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int hunk ./XMonad/Util/Font.cpphs 103 -textWidthXMF dpy (Xft xftdraw) s = do +textWidthXMF dpy (Xft xftdraw) s = liftIO $ do hunk ./XMonad/Util/Font.cpphs 108 -textExtentsXMF :: Display -> XMonadFont -> String -> IO (FontDirection,Int32,Int32,CharStruct) +textExtentsXMF :: MonadIO m => Display -> XMonadFont -> String -> m (FontDirection,Int32,Int32,CharStruct) hunk ./XMonad/Util/Font.cpphs 111 -textExtentsXMF _ (Xft xftfont) _ = do +textExtentsXMF _ (Xft xftfont) _ = liftIO $ do hunk ./XMonad/Util/Font.cpphs 135 -printStringXMF :: Display -> Drawable -> XMonadFont -> GC -> String -> String - -> Position -> Position -> String -> X () -printStringXMF d p (Core fs) gc fc bc x y s = do - io $ setFont d gc $ fontFromFontStruct fs - [fc',bc'] <- mapM stringToPixel [fc,bc] - io $ setForeground d gc fc' - io $ setBackground d gc bc' - io $ drawImageString d p gc x y s +printStringXMF :: MonadIO m => Display -> Drawable -> XMonadFont -> GC -> String -> String + -> Position -> Position -> String -> m () +printStringXMF d p (Core fs) gc fc bc x y s = liftIO $ do + setFont d gc $ fontFromFontStruct fs + [fc',bc'] <- mapM (stringToPixel d) [fc,bc] + setForeground d gc fc' + setBackground d gc bc' + drawImageString d p gc x y s hunk ./XMonad/Util/Font.cpphs 149 - io $ withXftDraw dpy drw visual colormap $ + liftIO $ withXftDraw dpy drw visual colormap $ hunk ./XMonad/Util/XUtils.hs 56 - c <- stringToPixel col + c <- stringToPixel d col hunk ./XMonad/Util/XUtils.hs 119 - [color',b_color'] <- mapM stringToPixel [color,b_color] + [color',b_color'] <- mapM (stringToPixel d) [color,b_color] hunk ./XMonad/Prompt.hs 439 - -- compose the string in 3 parts: till the cursor, the cursor and the rest + -- break the string in 3 parts: till the cursor, the cursor and the rest hunk ./xmonad-contrib.cabal 112 - XMonad.Util.Anneal + -- XMonad.Util.Anneal hunk ./XMonad/Hooks/MessageHooks.hs 12 --- Portability : not portable, uses mtl, X11, posix +-- Portability : not portable, uses mtl, X11, posix, pattern guards hunk ./XMonad/Hooks/MessageHooks.hs 35 -module XMonad.Hooks.MessageHooks (xmonad) where +module XMonad.Hooks.MessageHooks (xmonad, MessageHook) where hunk ./XMonad/Hooks/MessageHooks.hs 64 -xmonad messageHooks initxmc = do +xmonad mhs initxmc = do hunk ./XMonad/Hooks/MessageHooks.hs 67 + + -- Add handle as last messageHook. + let mhs' = mhs ++ [builtinMessageHook] + hunk ./XMonad/Hooks/MessageHooks.hs 137 - forever_ $ processMessage messageHooks . SomeMessage =<< io (nextEvent dpy e >> getEvent e) + forever_ $ processMessage mhs' . SomeMessage =<< io (nextEvent dpy e >> getEvent e) hunk ./XMonad/Hooks/MessageHooks.hs 144 -processMessage (mh : mhs) msg = whenX (mh msg) $ processMessage mhs msg -processMessage [] msg - | Just event <- fromMessage msg = handle event -processMessage [] _ = return () +processMessage (mh : mhs) msg = whenX (mh msg) $ processMessage mhs msg +processMessage [] _ = return () + +-- MessageHook version of handle +-- TODO: just modify handle to return True in place of broadcastMessage +builtinMessageHook :: MessageHook +builtinMessageHook msg | Just event <- fromMessage msg = handle event >> return False + | otherwise = return True hunk ./XMonad/Hooks/MessageHooks.hs 1 -{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, PatternGuards #-} - ------------------------------------------------------------------------------ --- | --- Module : XMonad.Hooks.MessageHooks --- Copyright : (c) Spencer Janssen 2007, Devin Mullins 2007 --- License : BSD3-style (see LICENSE) --- --- Maintainer : Devin Mullins , --- David Roundy --- Stability : experimental --- Portability : not portable, uses mtl, X11, posix, pattern guards --- --- Provides an alternative main event loop that unifies event handlers into --- the concept of a message filter chain. This module is experimental. --- You'd have to be crazy to want to use it. ------------------------------------------------------------------------------ - --- This module was started by copying the entire contents of XMonad.Main. Any --- future changes to the original module should be replicated here. - --- TODO: --- * add state to messageHooks --- * add messageHooks to the XConfig, if possible --- * sendMessage should pass through the filter chain (broadcastMessage excepted) --- * intercept broadcastMessage: --- * * don't export broadcastMessage: --- * * handle should just return True / False instead of calling broadcastMessage --- * * broadcastMessage should be the last filter called by processMessage --- * * users should be able to call broadcastMessage' (= processMessage $ messageHooks config) --- * ability to schedule a message for delivery? --- * ability to modify a message during transport? --- * xmonad sends an InitMessage once? - -module XMonad.Hooks.MessageHooks (xmonad, MessageHook) where - -import Data.Bits -import qualified Data.Map as M -import qualified Data.Set as S -import Control.Monad.Reader -import Control.Monad.State -import Data.Maybe (fromMaybe) - -import System.Environment (getArgs) - -import Graphics.X11.Xlib hiding (refreshKeyboardMapping) -import Graphics.X11.Xlib.Extras -import Graphics.X11.Xinerama (getScreenInfo) - -import XMonad.Core -import XMonad.StackSet (new, floating, member) -import qualified XMonad.StackSet as W -import XMonad.Operations - -import System.IO - --- True if message may continue; False to halt the filter chain. -type MessageHook = SomeMessage -> X Bool - --- | --- The main entry point --- -xmonad :: (LayoutClass l Window, Read (l Window)) => [MessageHook] -> XConfig l -> IO () -xmonad mhs initxmc = do - -- First, wrap the layout in an existential, to keep things pretty: - let xmc = initxmc { layoutHook = Layout $ layoutHook initxmc } - - -- Add handle as last messageHook. - let mhs' = mhs ++ [builtinMessageHook] - - dpy <- openDisplay "" - let dflt = defaultScreen dpy - - rootw <- rootWindow dpy dflt - xinesc <- getScreenInfo dpy - nbc <- initColor dpy $ normalBorderColor xmc - fbc <- initColor dpy $ focusedBorderColor xmc - hSetBuffering stdout NoBuffering - args <- getArgs - - let layout = layoutHook xmc - lreads = readsLayout layout - initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps - - maybeRead reads' s = case reads' s of - [(x, "")] -> Just x - _ -> Nothing - - winset = fromMaybe initialWinset $ do - ("--resume" : s : _) <- return args - ws <- maybeRead reads s - return . W.ensureTags layout (workspaces xmc) - $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws - - gaps = take (length xinesc) $ defaultGaps xmc ++ repeat (0,0,0,0) - - cf = XConf - { display = dpy - , config = xmc - , theRoot = rootw - , normalBorder = nbc - , focusedBorder = fbc - , keyActions = keys xmc xmc - , buttonActions = mouseBindings xmc xmc } - st = XState - { windowset = initialWinset - , mapped = S.empty - , waitingUnmap = M.empty - , dragging = Nothing } - - xSetErrorHandler -- in C, I'm too lazy to write the binding: dons - - -- setup initial X environment - sync dpy False - selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask - .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask - - allocaXEvent $ \e -> - runX cf st $ do - - grabKeys - grabButtons - - io $ sync dpy False - - -- bootstrap the windowset, Operations.windows will identify all - -- the windows in winset as new and set initial properties for - -- those windows - windows (const winset) - - -- scan for all top-level windows, add the unmanaged ones to the - -- windowset - ws <- io $ scan dpy rootw - mapM_ manage ws - - -- main loop, for all you HOF/recursion fans out there. - forever_ $ processMessage mhs' . SomeMessage =<< io (nextEvent dpy e >> getEvent e) - - return () - where forever_ a = a >> forever_ a - - -processMessage :: [MessageHook] -> SomeMessage -> X () -processMessage (mh : mhs) msg = whenX (mh msg) $ processMessage mhs msg -processMessage [] _ = return () - --- MessageHook version of handle --- TODO: just modify handle to return True in place of broadcastMessage -builtinMessageHook :: MessageHook -builtinMessageHook msg | Just event <- fromMessage msg = handle event >> return False - | otherwise = return True - --- --------------------------------------------------------------------- --- | Event handler. Map X events onto calls into Operations.hs, which --- modify our internal model of the window manager state. --- --- Events dwm handles that we don't: --- --- [ButtonPress] = buttonpress, --- [Expose] = expose, --- [PropertyNotify] = propertynotify, --- -handle :: Event -> X () - --- run window manager command -handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code}) - | t == keyPress = withDisplay $ \dpy -> do - s <- io $ keycodeToKeysym dpy code 0 - mClean <- cleanMask m - ks <- asks keyActions - userCode $ whenJust (M.lookup (mClean, s) ks) id - --- manage a new window -handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do - wa <- io $ getWindowAttributes dpy w -- ignore override windows - -- need to ignore mapping requests by managed windows not on the current workspace - managed <- isClient w - when (not (wa_override_redirect wa) && not managed) $ do manage w - --- window destroyed, unmanage it --- window gone, unmanage it -handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ unmanage w - --- We track expected unmap events in waitingUnmap. We ignore this event unless --- it is synthetic or we are not expecting an unmap notification from a window. -handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do - e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap) - if (synthetic || e == 0) - then unmanage w - else modify (\s -> s { waitingUnmap = M.adjust pred w (waitingUnmap s) }) - --- set keyboard mapping -handle e@(MappingNotifyEvent {}) = do - io $ refreshKeyboardMapping e - when (ev_request e == mappingKeyboard) grabKeys - --- handle button release, which may finish dragging. -handle e@(ButtonEvent {ev_event_type = t}) - | t == buttonRelease = do - drag <- gets dragging - case drag of - -- we're done dragging and have released the mouse: - Just (_,f) -> modify (\s -> s { dragging = Nothing }) >> f - Nothing -> broadcastMessage e - --- handle motionNotify event, which may mean we are dragging. -handle e@(MotionEvent {ev_event_type = _t, ev_x = x, ev_y = y}) = do - drag <- gets dragging - case drag of - Just (d,_) -> d (fromIntegral x) (fromIntegral y) -- we're dragging - Nothing -> broadcastMessage e - --- click on an unfocused window, makes it focused on this workspace -handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b }) - | t == buttonPress = do - -- If it's the root window, then it's something we - -- grabbed in grabButtons. Otherwise, it's click-to-focus. - isr <- isRoot w - m <- cleanMask $ ev_state e - ba <- asks buttonActions - if isr then userCode $ whenJust (M.lookup (m, b) ba) ($ ev_subwindow e) - else focus w - sendMessage e -- Always send button events. - --- entered a normal window, makes this focused. -handle e@(CrossingEvent {ev_window = w, ev_event_type = t}) - | t == enterNotify && ev_mode e == notifyNormal - && ev_detail e /= notifyInferior = focus w - --- left a window, check if we need to focus root -handle e@(CrossingEvent {ev_event_type = t}) - | t == leaveNotify - = do rootw <- asks theRoot - when (ev_window e == rootw && not (ev_same_screen e)) $ setFocusX rootw - --- configure a window -handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do - ws <- gets windowset - wa <- io $ getWindowAttributes dpy w - - bw <- asks (borderWidth . config) - - if M.member w (floating ws) - || not (member w ws) - then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges - { wc_x = ev_x e - , wc_y = ev_y e - , wc_width = ev_width e - , wc_height = ev_height e - , wc_border_width = fromIntegral bw - , wc_sibling = ev_above e - , wc_stack_mode = ev_detail e } - when (member w ws) (float w) - else io $ allocaXEvent $ \ev -> do - setEventType ev configureNotify - setConfigureEvent ev w w - (wa_x wa) (wa_y wa) (wa_width wa) - (wa_height wa) (ev_border_width e) none (wa_override_redirect wa) - sendEvent dpy w False 0 ev - io $ sync dpy False - --- configuration changes in the root may mean display settings have changed -handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen - --- property notify -handle PropertyEvent { ev_event_type = t, ev_atom = a } - | t == propertyNotify && a == wM_NAME = userCode =<< asks (logHook . config) - -handle e = broadcastMessage e -- trace (eventName e) -- ignoring - - --- --------------------------------------------------------------------- --- IO stuff. Doesn't require any X state --- Most of these things run only on startup (bar grabkeys) - --- | scan for any new windows to manage. If they're already managed, --- this should be idempotent. -scan :: Display -> Window -> IO [Window] -scan dpy rootw = do - (_, _, ws) <- queryTree dpy rootw - filterM ok ws - -- TODO: scan for windows that are either 'IsViewable' or where WM_STATE == - -- Iconic - where ok w = do wa <- getWindowAttributes dpy w - a <- internAtom dpy "WM_STATE" False - p <- getWindowProperty32 dpy a w - let ic = case p of - Just (3:_) -> True -- 3 for iconified - _ -> False - return $ not (wa_override_redirect wa) - && (wa_map_state wa == waIsViewable || ic) - --- | Grab the keys back -grabKeys :: X () -grabKeys = do - XConf { display = dpy, theRoot = rootw } <- ask - let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync - io $ ungrabKey dpy anyKey anyModifier rootw - ks <- asks keyActions - forM_ (M.keys ks) $ \(mask,sym) -> do - kc <- io $ keysymToKeycode dpy sym - -- "If the specified KeySym is not defined for any KeyCode, - -- XKeysymToKeycode() returns zero." - when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) =<< extraModifiers - --- | XXX comment me -grabButtons :: X () -grabButtons = do - XConf { display = dpy, theRoot = rootw } <- ask - let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask - grabModeAsync grabModeSync none none - io $ ungrabButton dpy anyButton anyModifier rootw - ems <- extraModifiers - ba <- asks buttonActions - mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba) rmfile ./XMonad/Hooks/MessageHooks.hs hunk ./xmonad-contrib.cabal 69 - XMonad.Hooks.MessageHooks hunk ./XMonad/Layout/Mosaic.hs 1 -{-# OPTIONS -fglasgow-exts #-} - ------------------------------------------------------------------------------ --- | --- Module : XMonad.Layout.Mosaic --- Copyright : (c) David Roundy --- License : BSD3-style (see LICENSE) --- --- Maintainer : David Roundy --- Stability : unstable --- Portability : unportable --- --- This module defines a \"mosaic\" layout, which tries to give each window a --- user-configurable relative area, while also trying to give them aspect --- ratios configurable at run-time by the user. --- ------------------------------------------------------------------------------ -module XMonad.Layout.Mosaic ( - -- * Usage - -- $usage - mosaic, expandWindow, shrinkWindow, squareWindow, myclearWindow, - tallWindow, wideWindow, flexibleWindow, - getName, withNamedWindow ) where - -import Control.Monad.State ( State, put, get, runState ) -import System.Random ( StdGen, mkStdGen ) - -import Data.Ratio -import Graphics.X11.Xlib -import XMonad hiding ( trace ) -import XMonad.Operations ( full, Resize(Shrink, Expand) ) -import qualified XMonad.StackSet as W -import qualified Data.Map as M -import Data.List ( sort ) -import Data.Typeable ( Typeable ) -import Control.Monad ( mplus ) - -import XMonad.Util.NamedWindows -import XMonad.Util.Anneal - --- $usage --- --- Key bindings: --- --- You can use this module with the following in your Config.hs: --- --- > import XMonad.Layout.Mosaic --- --- > layouts :: [Layout Window] --- > layouts = [ mosaic 0.25 0.5 M.empty, full ] --- --- In the key-bindings, do something like: --- --- > , ((controlMask .|. modMask .|. shiftMask, xK_h), withNamedWindow (sendMessage . tallWindow)) --- > , ((controlMask .|. modMask .|. shiftMask, xK_l), withNamedWindow (sendMessage . wideWindow)) --- > , ((modMask .|. shiftMask, xK_h ), withNamedWindow (sendMessage . shrinkWindow)) --- > , ((modMask .|. shiftMask, xK_l ), withNamedWindow (sendMessage . expandWindow)) --- > , ((modMask .|. shiftMask, xK_s ), withNamedWindow (sendMessage . squareWindow)) --- > , ((modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . myclearWindow)) --- > , ((controlMask .|. modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . flexibleWindow)) --- - --- %import XMonad.Layout.Mosaic --- %keybind , ((controlMask .|. modMask .|. shiftMask, xK_h), withNamedWindow (sendMessage . tallWindow)) --- %keybind , ((controlMask .|. modMask .|. shiftMask, xK_l), withNamedWindow (sendMessage . wideWindow)) --- %keybind , ((modMask .|. shiftMask, xK_h ), withNamedWindow (sendMessage . shrinkWindow)) --- %keybind , ((modMask .|. shiftMask, xK_l ), withNamedWindow (sendMessage . expandWindow)) --- %keybind , ((modMask .|. shiftMask, xK_s ), withNamedWindow (sendMessage . squareWindow)) --- %keybind , ((modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . myclearWindow)) --- %keybind , ((controlMask .|. modMask .|. shiftMask, xK_o ), withNamedWindow (sendMessage . flexibleWindow)) --- %layout , mosaic 0.25 0.5 M.empty - -data HandleWindow = ExpandWindow NamedWindow | ShrinkWindow NamedWindow - | SquareWindow NamedWindow | ClearWindow NamedWindow - | TallWindow NamedWindow | WideWindow NamedWindow - | FlexibleWindow NamedWindow - deriving ( Typeable, Eq ) - -instance Message HandleWindow - -expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: NamedWindow -> HandleWindow -expandWindow = ExpandWindow -shrinkWindow = ShrinkWindow -squareWindow = SquareWindow -flexibleWindow = FlexibleWindow -myclearWindow = ClearWindow -tallWindow = TallWindow -wideWindow = WideWindow - -largeNumber :: Int -largeNumber = 50 - -defaultArea :: Double -defaultArea = 1 - -flexibility :: Double -flexibility = 0.1 - -mosaic :: Double -> Double -> M.Map NamedWindow [WindowHint] -> Layout Window -mosaic delta tileFrac hints = full { doLayout = \r -> mosaicL tileFrac hints r . W.integrate - , modifyLayout = return . mlayout } - where mlayout x = (m1 `fmap` fromMessage x) `mplus` (m2 `fmap` fromMessage x) - m1 Shrink = mosaic delta (tileFrac/(1+delta)) hints - m1 Expand = mosaic delta (tileFrac*(1+delta)) hints - m2 (ExpandWindow w) = mosaic delta tileFrac (multiply_area (1+delta) w hints) - m2 (ShrinkWindow w) = mosaic delta tileFrac (multiply_area (1/(1+ delta)) w hints) - m2 (SquareWindow w) = mosaic delta tileFrac (set_aspect_ratio 1 w hints) - m2 (FlexibleWindow w) = mosaic delta tileFrac (make_flexible w hints) - m2 (TallWindow w) = mosaic delta tileFrac (multiply_aspect (1/(1+delta)) w hints) - m2 (WideWindow w) = mosaic delta tileFrac (multiply_aspect (1+delta) w hints) - m2 (ClearWindow w) = mosaic delta tileFrac (M.delete w hints) - -multiply_area :: Double -> NamedWindow - -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] -multiply_area a = alterlist f where f [] = [RelArea (defaultArea*a)] - f (RelArea a':xs) = RelArea (a'*a) : xs - f (x:xs) = x : f xs - -set_aspect_ratio :: Double -> NamedWindow - -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] -set_aspect_ratio r = alterlist f where f [] = [AspectRatio r] - f (FlexibleAspectRatio _:x) = AspectRatio r:x - f (AspectRatio _:x) = AspectRatio r:x - f (x:xs) = x:f xs - -make_flexible :: NamedWindow - -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] -make_flexible = alterlist (map f) where f (AspectRatio r) = FlexibleAspectRatio r - f (FlexibleAspectRatio r) = AspectRatio r - f x = x - -multiply_aspect :: Double -> NamedWindow - -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] -multiply_aspect r = alterlist f where f [] = [FlexibleAspectRatio r] - f (AspectRatio r':x) = AspectRatio (r*r'):x - f (FlexibleAspectRatio r':x) = FlexibleAspectRatio (r*r'):x - f (x:xs) = x:f xs - -findlist :: Ord k => k -> M.Map k [a] -> [a] -findlist = M.findWithDefault [] - -alterlist :: (Ord k, Ord a) => ([a] -> [a]) -> k -> M.Map k [a] -> M.Map k [a] -alterlist f k = M.alter f' k - where f' Nothing = f' (Just []) - f' (Just xs) = case f xs of - [] -> Nothing - xs' -> Just xs' - -mosaicL :: Double -> M.Map NamedWindow [WindowHint] - -> Rectangle -> [Window] -> X ([(Window, Rectangle)],Maybe (Layout Window)) -mosaicL _ _ _ [] = return ([], Nothing) -mosaicL f hints origRect origws - = do namedws <- mapM getName origws - let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) namedws - -- TODO: remove all this dead code - myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws - myv2 = mc_mosaic sortedws Vertical - myh2 = mc_mosaic sortedws Horizontal --- myv2 = maxL $ runCountDown largeNumber $ --- sequence $ replicate mediumNumber $ --- mosaic_splits one_split origRect Vertical sortedws - myh = runCountDown largeNumber $ mosaic_splits even_split origRect Horizontal sortedws --- myh2 = maxL $ runCountDown largeNumber $ --- sequence $ replicate mediumNumber $ --- mosaic_splits one_split origRect Horizontal sortedws - return (map (\(nw,r)->(--trace ("rate1:"++ unlines [show nw, - -- show $ rate f meanarea (findlist nw hints) r, - -- show r, - -- show $ area r/meanarea, - -- show $ findlist nw hints]) $ - unName nw,crop' (findlist nw hints) r)) $ - flattenMosaic $ the_value $ maxL [myh,myv,myh2,myv2], Nothing) - where mosaic_splits _ _ _ [] = return $ Rated 0 $ M [] - mosaic_splits _ r _ [w] = return $ Rated (rate f meanarea (findlist w hints) r) $ OM (w,r) - mosaic_splits spl r d ws = maxL `fmap` mapCD (spl r d) (init $ allsplits ws) - even_split :: Rectangle -> CutDirection -> [[NamedWindow]] - -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle))) - even_split r d [ws] = even_split r d $ map (:[]) ws - even_split r d wss = - do let areas = map sumareas wss - let wsr_s :: [([NamedWindow], Rectangle)] - wsr_s = zip wss (partitionR d r areas) - submosaics <- mapM (\(ws',r') -> - mosaic_splits even_split r' (otherDirection d) ws') wsr_s - return $ fmap M $ catRated submosaics - {- - another_mosaic :: [NamedWindow] -> CutDirection - -> Rated Double (Mosaic (NamedWindow,Rectangle)) - another_mosaic ws d = rate_mosaic ratew $ - rect_mosaic origRect d $ - zipML (example_mosaic ws) (map findarea ws) - -} - mc_mosaic :: [NamedWindow] -> CutDirection - -> Rated Double (Mosaic (NamedWindow,Rectangle)) - mc_mosaic ws d = fmap (rect_mosaic origRect d) $ - annealMax (zipML (example_mosaic ws) (map findarea ws)) - (the_rating . rate_mosaic ratew . rect_mosaic origRect d ) - changeMosaic - - ratew :: (NamedWindow,Rectangle) -> Double - ratew (w,r) = rate f meanarea (findlist w hints) r - example_mosaic :: [NamedWindow] -> Mosaic NamedWindow - example_mosaic ws = M (map OM ws) - rect_mosaic :: Rectangle -> CutDirection -> Mosaic (a,Double) -> Mosaic (a,Rectangle) - rect_mosaic r _ (OM (w,_)) = OM (w,r) - rect_mosaic r d (M ws) = M $ zipWith (\w' r' -> rect_mosaic r' d' w') ws rs - where areas = map (sum . map snd . flattenMosaic) ws - rs = partitionR d r areas - d' = otherDirection d - rate_mosaic :: ((NamedWindow,Rectangle) -> Double) - -> Mosaic (NamedWindow,Rectangle) -> Rated Double (Mosaic (NamedWindow,Rectangle)) - rate_mosaic r m = catRatedM $ fmap (\x -> Rated (r x) x) m -{- - one_split :: Rectangle -> CutDirection -> [[NamedWindow]] - -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle))) - one_split r d [ws] = one_split r d $ map (:[]) ws - one_split r d wss = - do rnd <- mapM (const (fractional resolutionNumber)) [1..length wss] - let wsr_s :: [([NamedWindow], Rectangle)] - wsr_s = zip wss (partitionR d r rnd) - submosaics <- mapM (\(ws',r') -> - mosaic_splits even_split r' (otherDirection d) ws') wsr_s - return $ fmap M $ catRated submosaics --} - partitionR :: CutDirection -> Rectangle -> [Double] -> [Rectangle] - partitionR _ _ [] = [] - partitionR _ r [_] = [r] - partitionR d r (a:ars) = r1 : partitionR d r2 ars - where totarea = sum (a:ars) - (r1,r2) = split d (a/totarea) r - theareas = hints2area `fmap` hints - sumareas ws = sum $ map findarea ws - findarea :: NamedWindow -> Double - findarea w = M.findWithDefault 1 w theareas - meanarea = area origRect / fromIntegral (length origws) - -maxL :: Ord a => [a] -> a -maxL [] = error "maxL on empty list" -maxL [a] = a -maxL (a:b:c) = maxL (max a b:c) - -catRated :: Floating v => [Rated v a] -> Rated v [a] -catRated xs = Rated (product $ map the_rating xs) (map the_value xs) - -catRatedM :: Floating v => Mosaic (Rated v a) -> Rated v (Mosaic a) -catRatedM (OM (Rated v x)) = Rated v (OM x) -catRatedM (M xs) = case catRated $ map catRatedM xs of Rated v xs' -> Rated v (M xs') - -data CountDown = CD !StdGen !Int - -tries_left :: State CountDown Int -tries_left = do CD _ n <- get - return (max 0 n) - -mapCD :: (a -> State CountDown b) -> [a] -> State CountDown [b] -mapCD f xs = do n <- tries_left - let len = length xs - mapM (run_with_only ((n `div` len)+1) . f) $ take (n+1) xs - -run_with_only :: Int -> State CountDown a -> State CountDown a -run_with_only limit j = - do CD g n <- get - let leftover = n - limit - if leftover < 0 then j - else do put $ CD g limit - x <- j - CD g' n' <- get - put $ CD g' (leftover + n') - return x - -data WindowHint = RelArea Double - | AspectRatio Double - | FlexibleAspectRatio Double - deriving ( Show, Read, Eq, Ord ) - -fixedAspect :: [WindowHint] -> Bool -fixedAspect [] = False -fixedAspect (AspectRatio _:_) = True -fixedAspect (_:x) = fixedAspect x - -rate :: Double -> Double -> [WindowHint] -> Rectangle -> Double -rate defaulta meanarea xs rr - | fixedAspect xs = (area (crop xs rr) / meanarea) ** weight - | otherwise = (area rr / meanarea)**(weight-flexibility) - * (area (crop (xs++[FlexibleAspectRatio defaulta]) rr) / meanarea)**flexibility - where weight = hints2area xs - -crop :: [WindowHint] -> Rectangle -> Rectangle -crop (AspectRatio f:_) = cropit f -crop (FlexibleAspectRatio f:_) = cropit f -crop (_:hs) = crop hs -crop [] = id - -crop' :: [WindowHint] -> Rectangle -> Rectangle -crop' (AspectRatio f:_) = cropit f -crop' (_:hs) = crop' hs -crop' [] = id - -cropit :: Double -> Rectangle -> Rectangle -cropit f (Rectangle a b w h) | w -/- h > f = Rectangle a b (ceiling $ h -* f) h - | otherwise = Rectangle a b w (ceiling $ w -/ f) - -hints2area :: [WindowHint] -> Double -hints2area [] = defaultArea -hints2area (RelArea r:_) = r -hints2area (_:x) = hints2area x - -area :: Rectangle -> Double -area (Rectangle _ _ w h) = fromIntegral w * fromIntegral h - -(-/-) :: (Integral a, Integral b) => a -> b -> Double -a -/- b = fromIntegral a / fromIntegral b - -(-/) :: (Integral a) => a -> Double -> Double -a -/ b = fromIntegral a / b - -(-*) :: (Integral a) => a -> Double -> Double -a -* b = fromIntegral a * b - -split :: CutDirection -> Double -> Rectangle -> (Rectangle, Rectangle) -split Vertical frac (Rectangle sx sy sw sh) = (Rectangle sx sy sw h, - Rectangle sx (sy+fromIntegral h) sw (sh-h)) - where h = floor $ fromIntegral sh * frac -split Horizontal frac (Rectangle sx sy sw sh) = (Rectangle sx sy w sh, - Rectangle (sx+fromIntegral w) sy (sw-w) sh) - where w = floor $ fromIntegral sw * frac - -data CutDirection = Vertical | Horizontal -otherDirection :: CutDirection -> CutDirection -otherDirection Vertical = Horizontal -otherDirection Horizontal = Vertical - -data Mosaic a = M [Mosaic a] | OM a - deriving ( Show ) - -instance Functor Mosaic where - fmap f (OM x) = OM (f x) - fmap f (M xs) = M (map (fmap f) xs) - -zipMLwith :: (a -> b -> c) -> Mosaic a -> [b] -> Mosaic c -zipMLwith f (OM x) (y:_) = OM (f x y) -zipMLwith _ (OM _) [] = error "bad zipMLwith" -zipMLwith f (M xxs) yys = makeM $ foo xxs yys - where foo (x:xs) ys = zipMLwith f x (take (lengthM x) ys) : - foo xs (drop (lengthM x) ys) - foo [] _ = [] - -zipML :: Mosaic a -> [b] -> Mosaic (a,b) -zipML = zipMLwith (\a b -> (a,b)) - -lengthM :: Mosaic a -> Int -lengthM (OM _) = 1 -lengthM (M x) = sum $ map lengthM x - -changeMosaic :: Mosaic a -> [Mosaic a] -changeMosaic (OM _) = [] -changeMosaic (M xs) = map makeM (concatenations xs) ++ - map makeM (splits xs) ++ - map M (tryAll changeMosaic xs) - -tryAll :: (a -> [a]) -> [a] -> [[a]] -tryAll _ [] = [] -tryAll f (x:xs) = map (:xs) (f x) ++ map (x:) (tryAll f xs) - -splits :: [Mosaic a] -> [[Mosaic a]] -splits [] = [] -splits (OM x:y) = map (OM x:) $ splits y -splits (M (x:y):z) = (x:makeM y:z) : map (makeM (x:y) :) (splits z) -splits (M []:x) = splits x - -concatenations :: [Mosaic a] -> [[Mosaic a]] -concatenations (x:y:z) = (concatenateMosaic x y:z):(map (x:) $ concatenations (y:z)) -concatenations _ = [] - -concatenateMosaic :: Mosaic a -> Mosaic a -> Mosaic a -concatenateMosaic (OM a) (OM b) = M [OM a, OM b] -concatenateMosaic (OM a) (M b) = M (OM a:b) -concatenateMosaic (M a) (OM b) = M (a++[OM b]) -concatenateMosaic (M a) (M b) = M (a++b) - -makeM :: [Mosaic a] -> Mosaic a -makeM [m] = m -makeM [] = error "makeM []" -makeM ms = M ms - -flattenMosaic :: Mosaic a -> [a] -flattenMosaic (OM a) = [a] -flattenMosaic (M xs) = concatMap flattenMosaic xs - -allsplits :: [a] -> [[[a]]] -allsplits [] = [[[]]] -allsplits [a] = [[[a]]] -allsplits (x:xs) = (map ([x]:) splitsrest) ++ (map (maphead (x:)) splitsrest) - where splitsrest = allsplits' xs - -allsplits' :: [a] -> [[[a]]] -allsplits' [] = [[[]]] -allsplits' [a] = [[[a]]] -allsplits' (x:xs) = (map (maphead (x:)) splitsrest) ++ (map ([x]:) splitsrest) - where splitsrest = allsplits xs - -maphead :: (a->a) -> [a] -> [a] -maphead f (x:xs) = f x : xs -maphead _ [] = [] - -runCountDown :: Int -> State CountDown a -> a -runCountDown n x = fst $ runState x (CD (mkStdGen n) n) rmfile ./XMonad/Layout/Mosaic.hs hunk ./XMonad/Util/Anneal.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonad.Util.Anneal --- Copyright : (c) David Roundy --- License : BSD-style (see LICENSE) --- --- Maintainer : David Roundy --- Stability : unstable --- Portability : unportable --- --- Requires the 'random' package --- ------------------------------------------------------------------------------ - -module XMonad.Util.Anneal ( Rated(Rated), the_value, the_rating - , anneal, annealMax ) where - -import System.Random ( StdGen, Random, mkStdGen, randomR ) -import Control.Monad.State ( State, runState, put, get, gets, modify ) - --- %import XMonad.Util.Anneal - -data Rated a b = Rated !a !b - deriving ( Show ) -instance Functor (Rated a) where - f `fmap` (Rated v a) = Rated v (f a) - -the_value :: Rated a b -> b -the_value (Rated _ b) = b -the_rating :: Rated a b -> a -the_rating (Rated a _) = a - -instance Eq a => Eq (Rated a b) where - (Rated a _) == (Rated a' _) = a == a' -instance Ord a => Ord (Rated a b) where - compare (Rated a _) (Rated a' _) = compare a a' - -anneal :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a -anneal st r sel = runAnneal st r (do_anneal sel) - -annealMax :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a -annealMax st r sel = runAnneal st (negate . r) (do_anneal sel) - -do_anneal :: (a -> [a]) -> State (Anneal a) (Rated Double a) -do_anneal sel = do sequence_ $ replicate 100 da - gets best - where da = do select_metropolis sel - modify $ \s -> s { temperature = temperature s *0.99 } - -data Anneal a = A { g :: StdGen - , best :: Rated Double a - , current :: Rated Double a - , rate :: a -> Rated Double a - , temperature :: Double } - -runAnneal :: a -> (a -> Double) -> State (Anneal a) b -> b -runAnneal start r x = fst $ runState x (A { g = mkStdGen 137 - , best = Rated (r start) start - , current = Rated (r start) start - , rate = \xx -> Rated (r xx) xx - , temperature = 1.0 }) - -select_metropolis :: (a -> [a]) -> State (Anneal a) () -select_metropolis x = do c <- gets current - a <- select $ x $ the_value c - metropolis a - -metropolis :: a -> State (Anneal a) () -metropolis x = do r <- gets rate - c <- gets current - t <- gets temperature - let rx = r x - boltz = exp $ (the_rating c - the_rating rx) / t - if rx < c then do modify $ \s -> s { current = rx, best = rx } - else do p <- getOne (0,1) - if p < boltz - then modify $ \s -> s { current = rx } - else return () - -select :: [a] -> State (Anneal a) a -select [] = the_value `fmap` gets best -select [x] = return x -select xs = do n <- getOne (0,length xs - 1) - return (xs !! n) - -getOne :: (Random a) => (a,a) -> State (Anneal x) a -getOne bounds = do s <- get - (x,g') <- return $ randomR bounds (g s) - put $ s { g = g' } - return x rmfile ./XMonad/Util/Anneal.hs hunk ./xmonad-contrib.cabal 87 - -- XMonad.Layout.Mosaic hunk ./xmonad-contrib.cabal 110 - -- XMonad.Util.Anneal hunk ./Documentation.hs 9 --- Portability : unportable +-- Portability : portable hunk ./Documentation.hs 17 + -- * Overview + -- $overview + hunk ./Documentation.hs 108 +-------------------------------------------------------------------------------- +-- +-- Overview +-- +-------------------------------------------------------------------------------- + +{- $overview +#Overview# + +xmonad is a tiling window manager for X. This library collects +third party tiling algorithms, hooks, configurations and scripts to +xmonad. The source for this library is available via darcs get + +Each stable release of xmonad comes with a stable release of the contrib +library too, which should be used if you're using the stable release. +You can find the tarball here () (Oct 2007) +-} hunk ./README 20 - hunk ./README 25 +------------------------------------------------------------------------ + +Documentation for the extensions and configuration system available in +Documentatoin.hs (a haddock source file). + hunk ./xmonad-contrib.cabal 6 - Third party tiling algorithms, configurations and scripts to xmonad. + Third party tiling algorithms, configurations and scripts to xmonad, + a tiling window manager for X. hunk ./xmonad-contrib.cabal 9 - As a starting point you can have a look at the Haddock "Documentation". + "Documentation" on building, configuring and using xmonad extensions. hunk ./README 1 -3rd party XMonad extensions and contributions. +3rd party xmonad extensions and contributions. hunk ./README 23 -XMonad itself, with copyright held by the authors. +xmonad itself, with copyright held by the authors. hunk ./README 27 -Documentation for the extensions and configuration system available in -Documentatoin.hs (a haddock source file). +Documentation for the extensions and configuration system is available in +Documentation.hs (a haddock source file). hunk ./XMonad/Layout/NoBorders.hs 38 --- 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: addfile ./XMonad/Layout/PerWorkspace.hs hunk ./XMonad/Layout/PerWorkspace.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.PerWorkspace +-- Copyright : (c) Brent Yorgey +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Configure layouts on a per-workspace basis. +----------------------------------------------------------------------------- + +module XMonad.Layout.PerWorkspace ( + -- * Usage + -- $usage + + onWorkspace + ) where + +import XMonad +import qualified XMonad.StackSet as W + +import Control.Monad.State (gets) +import Data.Maybe (fromMaybe) + +-- $usage +-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: +-- +-- > import XMonad.Layout.PerWorkspace +-- +-- and modifying your layoutHook as follows: +-- +-- > layoutHook = onWorkspace "foo" l1 $ -- layout l1 will be used on workspace "foo" +-- > onWorkspace "bar" l2 $ -- layout l2 will be used on workspace "bar" +-- > l3 -- layout l3 will be used on all other workspaces. +-- +-- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated layouts, +-- e.g. @(Full ||| smartBorders $ tabbed shrinkText defaultTConf ||| ...)@ +-- +-- In another scenario, suppose you wanted to have layouts A, B, and C +-- available on all workspaces, except that on workspace foo you want +-- layout D instead of C. You could do that as follows: +-- +-- > layoutHook = A ||| B ||| onWorkspace "foo" D C +-- + +-- %import XMonad.Layout.PerWorkspace +-- %layout onWorkspace "foo" l1 l2 $ -- l1 used on workspace foo, +-- %layout -- l2 used on all others. + +-- | Specify one layout to use on a particular workspace, and another +-- to use on all others. The second layout can be another call to +-- 'onWorkspace', and so on. +onWorkspace :: (LayoutClass l1 a, LayoutClass l2 a) + => WorkspaceId -- ^ the tag of the workspace to match + -> (l1 a) -- ^ layout to use on the matched workspace + -> (l2 a) -- ^ layout to use everywhere else + -> PerWorkspace l1 l2 a +onWorkspace wsId l1 l2 = PerWorkspace wsId Nothing l1 l2 + +-- | Structure for representing a workspace-specific layout along with +-- a layout for all other workspaces. We store the tag of the workspace +-- to be matched, and the two layouts. Since layouts are stored/tracked +-- per workspace, once we figure out which workspace we are on, we can +-- cache that information using a (Maybe Bool). This is necessary +-- to be able to correctly implement the 'description' method of +-- LayoutClass, since a call to description is not able to query the +-- WM state to find out which workspace it was called in. +data PerWorkspace l1 l2 a = PerWorkspace WorkspaceId + (Maybe Bool) + (l1 a) + (l2 a) + deriving (Read, Show) + +instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (PerWorkspace l1 l2) a where + + -- do layout with l1, then return a modified PerWorkspace caching + -- the fact that we're in the matched workspace. + doLayout p@(PerWorkspace _ (Just True) lt _) r s = do + (wrs, mlt') <- doLayout lt r s + return (wrs, Just $ mkNewPerWorkspaceT p mlt') + + -- do layout with l1, then return a modified PerWorkspace caching + -- the fact that we're not in the matched workspace. + doLayout p@(PerWorkspace _ (Just False) _ lf) r s = do + (wrs, mlf') <- doLayout lf r s + return (wrs, Just $ mkNewPerWorkspaceF p mlf') + + -- figure out which layout to use based on the current workspace. + doLayout (PerWorkspace wsId Nothing l1 l2) r s = do + t <- getCurrentTag + doLayout (PerWorkspace wsId (Just $ wsId == t) l1 l2) r s + + -- handle messages; same drill as doLayout. + handleMessage p@(PerWorkspace _ (Just True) lt _) m = do + mlt' <- handleMessage lt m + return . Just $ mkNewPerWorkspaceT p mlt' + + handleMessage p@(PerWorkspace _ (Just False) _ lf) m = do + mlf' <- handleMessage lf m + return . Just $ mkNewPerWorkspaceF p mlf' + + handleMessage (PerWorkspace wsId Nothing l1 l2) m = do + t <- getCurrentTag + handleMessage (PerWorkspace wsId (Just $ wsId == t) l1 l2) m + + description (PerWorkspace _ (Just True ) l1 _) = description l1 + description (PerWorkspace _ (Just False) _ l2) = description l2 + + -- description's result is not in the X monad, so we have to wait + -- until a doLayout or handleMessage for the information about + -- which workspace we're in to get cached. + description _ = "PerWorkspace" + +-- | Construct new PerWorkspace values with possibly modified layouts. +mkNewPerWorkspaceT :: PerWorkspace l1 l2 a -> Maybe (l1 a) -> + PerWorkspace l1 l2 a +mkNewPerWorkspaceT (PerWorkspace wsId b lt lf) mlt' = + (\lt' -> PerWorkspace wsId b lt' lf) $ fromMaybe lt mlt' + +mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) -> + PerWorkspace l1 l2 a +mkNewPerWorkspaceF (PerWorkspace wsId b lt lf) mlf' = + (\lf' -> PerWorkspace wsId b lt lf') $ fromMaybe lf mlf' + +-- | Get the tag of the currently active workspace. +getCurrentTag :: X WorkspaceId +getCurrentTag = gets windowset >>= return . W.tag . W.workspace . W.current hunk ./xmonad-contrib.cabal 91 + XMonad.Layout.PerWorkspace hunk ./XMonad/Layout/PerWorkspace.hs 48 --- - --- %import XMonad.Layout.PerWorkspace --- %layout onWorkspace "foo" l1 l2 $ -- l1 used on workspace foo, --- %layout -- l2 used on all others. hunk ./XMonad/Layout/PerWorkspace.hs 61 --- to be matched, and the two layouts. Since layouts are stored/tracked +-- to be matched, and the two layouts. Since layouts are stored\/tracked adddir ./XMonad/Doc hunk ./Documentation.hs 1 ------------------------------------------------------------------------------ --- | --- Module : Documentation --- Copyright : (C) 2007 Andrea Rossato --- License : BSD3 --- --- Maintainer : andrea.rossato@unibz.it --- Stability : unstable --- Portability : portable --- --- This is a module for documenting the xmonad-contrib library. --- ------------------------------------------------------------------------------ - -module Documentation - ( - -- * Overview - -- $overview - - -- * Configuring xmonad - -- $configure - - -- ** A simple example - -- $example - - -- ** Checking whether your xmonad.hs is correct - -- $check - - -- ** Loading your configuration - -- $load - - -- ** Where are the defaults? - -- $where - - -- * The xmonad-contrib library - -- $library - - -- ** Actions - -- $actions - - -- ** Configurations - -- $configs - - -- ** Hooks - -- $hooks - - -- ** Layouts - -- $layouts - - -- ** Prompts - -- $prompts - - -- ** Utilities - -- $utils - - -- * Extending xmonad - -- $extending - - -- ** Editing key bindings - -- $keys - - -- *** Adding key bindings - -- $keyAdding - - -- *** Removing key bindings - -- $keyDel - - -- *** Adding and removing key bindings - -- $keyAddDel - - -- ** Editing the layout hook - -- $layoutHook - - -- ** Editing the manage hook - -- $manageHook - - -- ** The log hook and external status bars - -- $logHook - - -- * Writing new extensions - -- $writing - - -- ** Libraries for writing window managers - -- $xmonad-libs - - -- ** xmonad internals - -- $internals - - -- *** The @main@ entry point - -- $main - - -- *** The X monad and the internal state - -- $internalState - - -- *** Event handling and messages - -- $events - - -- *** The 'LayoutClass' - -- $layoutClass - - -- ** Coding style - -- $style - - -- ** Licensing policy - -- $license - ) where - --------------------------------------------------------------------------------- --- --- Overview --- --------------------------------------------------------------------------------- - -{- $overview -#Overview# - -xmonad is a tiling window manager for X. This library collects -third party tiling algorithms, hooks, configurations and scripts to -xmonad. The source for this library is available via darcs get - -Each stable release of xmonad comes with a stable release of the contrib -library too, which should be used if you're using the stable release. -You can find the tarball here () (Oct 2007) --} - --------------------------------------------------------------------------------- --- --- Configuring Xmonad --- --------------------------------------------------------------------------------- - -{- $configure -#Configuring_xmonad# -xmonad can be configured by creating and editing the Haskell file: - -> ~/.xmonad/xmonad.hs - -If this file does not exist, xmonad will simply use default settings; -if it does exist, xmonad will use whatever settings you specify. Note -that this file can contain arbitrary Haskell code, which means that -you have quite a lot of flexibility in configuring xmonad. - -NOTE for users of previous versions (< 0.5) of xmonad: this is a major -change in the way xmonad is configured. Prior to version 0.5, -configuring xmonad required editing an xmonad source file called -Config.hs, recompiling xmonad, and then restarting. From version 0.5 -onwards, however, all you have to do is edit xmonad.hs and restart -with @mod-q@; xmonad does the recompiling itself. The format of the -configuration file has also changed; it is now simpler and much -shorter, only requiring you to list those settings which are different -from the defaults. - --} - -{- $example -#A_simple_example# - -Here is a basic example, which starts with the default xmonad -configuration and overrides the border width, default terminal, and -some colours: - -> -- -> -- An example, simple ~/.xmonad/xmonad.hs file. -> -- It overrides a few basic settings, reusing all the other defaults. -> -- -> -> import XMonad -> -> main = xmonad $ defaultConfig -> { borderWidth = 2 -> , terminal = "urxvt" -> , normalBorderColor = "#cccccc" -> , focusedBorderColor = "#cd8b00" } - -This will run \'xmonad\', the window manager, with your settings -passed as arguments. - -Overriding default settings like this (using \"record update -syntax\"), will yield the shortest config file, as you only have to -describe values that differ from the defaults. - -An alternative is to inline the entire default config file from -xmonad, and edit values you wish to change. This is requires more -work, but some users may find this easier. You can find the defaults -in the file: - -> XMonad/Config.hs - -However, note that you should not edit Config.hs itself. - --} - -{- $check -#Checking_whether_your_xmonad.hs_is_correct# - -After changing your configuration, it is a good idea to check that it -is syntactically and type correct. You can do this easily by loading -your configuration file in the Haskell interpreter: - -> $ ghci ~/.xmonad/xmonad.hs -> GHCi, version 6.8.1: http://www.haskell.org/ghc/ :? for help -> Loading package base ... linking ... done. -> Ok, modules loaded: Main. -> -> Prelude Main> :t main -> main :: IO () - -Ok, looks good. - --} - -{- $load -#Loading_your_configuration# - -To get xmonad to use your new settings, type @mod-q@. xmonad will -attempt to compile this file, and run it. If everything goes well, -xmonad will seamlessly restart itself with the new settings, keeping -all your windows, layouts, etc. intact. (If you change anything -related to your layouts, you may need to hit @mod-shift-space@ after -restarting to see the changes take effect.) If something goes wrong, -the previous (default) settings will be used. Note this requires that -GHC and xmonad are in your @$PATH@. If GHC isn't in your path, you can -still compile @xmonad.hs@ yourself: - -> $ cd ~/.xmonad -> $ /path/to/ghc --make xmonad.hs -> $ ls -> xmonad xmonad.hi xmonad.hs xmonad.o - -When you hit @mod-q@, this newly compiled xmonad will be used. - --} - -{- $where -#Where_are_the_defaults?# - -The default configuration values are defined in the source file: - -> XMonad/Config.hs - -the 'XMonad.Core.XConfig' data structure itself is defined in: - -> XMonad/Core.hs - -See "XMonad.Core". - --} - --------------------------------------------------------------------------------- --- --- The XmonadContrib Library --- --------------------------------------------------------------------------------- - -{- $library - -The xmonad-contrib (xmc) library is a set of extension modules -contributed by xmonad hackers and users, which provide additional -xmonad features. Examples include various layout modes (tabbed, -spiral, three-column...), prompts, program launchers, the ability to -manipulate windows and workspaces in various ways, alternate -navigation modes, and much more. There are also \"meta-modules\" -which make it easier to write new modules and extensions. - -This is a short overview of the xmonad-contrib modules. For more -information about any particular module, just click on its name to -view its Haddock documentation; each module should come with extensive -documentation. If you find a module that could be better documented, -or has incorrect documentation, please report it as a bug -()! - --} - -{- $actions - -In the @XMonad.Actions@ namespace you can find modules exporting -various functions that are usually intended to be bound to key -combinations or mouse actions, in order to provide functionality -beyond the standard keybindings provided by xmonad. - -See "Documentation#Editing_key_bindings" for instructions on how to -edit your key bindings. - -* "XMonad.Actions.Commands": running internal xmonad actions - interactively. - -* "XMonad.Actions.ConstrainedResize": an aspect-ratio-constrained - window resizing mode. - -* "XMonad.Actions.CopyWindow": duplicating windows on multiple - workspaces. - -* "XMonad.Actions.CycleWS": move between workspaces. - -* "XMonad.Actions.DeManage": cease management of a window without - unmapping it. - -* "XMonad.Actions.DwmPromote": dwm-like master window swapping. - -* "XMonad.Actions.DynamicWorkspaces": add and delete workspaces. - -* "XMonad.Actions.FindEmptyWorkspace": find an empty workspace. - -* "XMonad.Actions.FlexibleManipulate": move\/resize windows without - warping the mouse. - -* "XMonad.Actions.FlexibleResize": resize windows from any corner. - -* "XMonad.Actions.FloatKeys": move\/resize floating windows with - keybindings. - -* "XMonad.Actions.FocusNth": focus the nth window on the screen. - -* "XMonad.Actions.MouseGestures": bind mouse gestures to actions. - -* "XMonad.Actions.RotSlaves": rotate non-master windows. - -* "XMonad.Actions.RotView": cycle through non-empty workspaces. - -* "XMonad.Actions.SimpleDate": display the date in a popup menu. - -* "XMonad.Actions.SinkAll": sink all floating windows. - -* "XMonad.Actions.Submap": create key submaps, i.e. the ability to - bind actions to key sequences rather than being limited to single - key combinations. - -* "XMonad.Actions.SwapWorkspaces": swap workspace tags. - -* "XMonad.Actions.TagWindows": tag windows and select by tag. - -* "XMonad.Actions.Warp": warp the pointer. - -* "XMonad.Actions.WindowBringer": bring windows to you, and you to - windows. - -* "XMonad.Actions.WmiiActions": wmii-style actions. - --} - -{- $configs - -In the @XMonad.Config@ namespace you can find modules exporting the -configurations used by some of the xmonad and xmonad-contrib -developers. You can look at them for examples while creating your own -configuration; you can also simply import them and use them as your -own configuration, possibly with some modifications. - --} - -{- $hooks - -In the @XMonad.Hooks@ namespace you can find modules exporting hooks. - -Hooks are actions that xmonad performs when some events occur. The two -most important hooks are: - -* 'XMonad.Core.manageHook': this hook is called when a new window - xmonad must take care of is created. This is a very powerful hook, - since it let us look at the new window's properties and act - accordingly. For instance, we can configure xmonad to put windows - belonging to a given application in the float layer, not to manage - dock applications, or open them in a given workspace. See - "Documentation#Editing_the_manage_hook" for more information on - customizing the 'XMonad.Core.manageHook'. - -* 'XMonad.Core.logHook': this hook is called when the stack of windows - managed by xmonad has been changed, by calling the - 'XMonad.Operations.windows' function. For instance - "XMonad.Hooks.DynamicLog" will produce a string (whose format can be - configured) to be printed to the standard output. This can be used - to display some information about the xmonad state in a Status Bar. - See "Documentation#The_log_hook_and_external_status_bars" for more - information. - --} - -{- $layouts - -In the @XMonad.Layout@ name space you can find modules exporting -contributed tiling algorithms, such as a tabbed layout, a circle and a -three columns ones, etc. - -Other modules provide facilities for combining different layouts, such -as "XMonad.Layout.Combo", or a complete set of layout combinators, -like "XMonad.Layout.LayoutCombinators" - -Layouts can be also modified with layout modifiers. A general -interface for writing layout modifiers is implemented in -"XMonad.Layout.LayoutModifier". - -For more information on using those modules for customizing your -'XMonad.Core.layoutHook' see "Documentation#Editing_the_layout_hook". - --} - -{- $prompts - -In the @XMonad.Prompt@ name space you can find modules exporting -graphical prompts for getting user input and performing, with it, -different actions. - -"XMonad.Prompt" provides a library for easily writing prompts. - -These are the available prompts: - -* "XMonad.Prompt.Directory" - -* "XMonad.Prompt.Layout" - -* "XMonad.Prompt.Man" - -* "XMonad.Prompt.Shell" - -* "XMonad.Prompt.Ssh" - -* "XMonad.Prompt.Window" - -* "XMonad.Prompt.Workspace" - -* "XMonad.Prompt.XMonad" - -Usually a prompt is called by some key binding. See -"Documentation#Editing_key_bindings" on how to configure xmonad to use -some prompts. The give examples include adding some prompts. - --} - -{- $utils - -In the @XMonad.Util@ namespace you can find modules exporting various -utility functions that are used by the other modules of the -xmonad-contrib library. - -There are also utilities for helping in configuring xmonad or using -external utilities. - -A non complete list with a brief description: - -* "XMonad.Util.CustomKeys" or "XMonad.Util.EZConfig" can be used to - configure key bindings (see "Documentation#Editing_key_bindings"); - -* "XMonad.Util.Dzen" "XMonad.Util.Dmenu" provide useful functions for - running dzen as a xmonad status bar and dmenu as a program launcher; - -* "XMonad.Util.XSelection" provide utilities for using the mouse - selection; - -* "XMonad.Util.XUtils" and "XMonad.Util.Font" are libraries for - accessing Xlib and XFT function in a convenient way. - --} - --------------------------------------------------------------------------------- --- --- Extending Xmonad --- --------------------------------------------------------------------------------- - -{- $extending -#Extending_xmonad# - -Since the @xmonad.hs@ file is just another Haskell module, you may -import and use any Haskell code or libraries you wish, such as -extensions from the xmonad-contrib library, or other code you write -yourself. - --} - -{- $keys -#Editing_key_bindings# - -Editing key bindings means changing the 'XMonad.Core.XConfig.keys' -record of the 'XMonad.Core.XConfig' data type, like: - -> main = xmonad defaultConfig { keys = myKeys } - -and providing a proper definition of @myKeys@ such as: - -> myKeys x = -> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) -> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) -> ] - -Remember that this definition requires importing "Graphics.X11.Xlib", -"XMonad.Prompt", "XMonad.Prompt.Shell", and "XMonad.Prompt.XMonad" - -Sometimes, more than completely redefining the key bindings, as we did -above, we may want to add some new bindings, or\/and remove existing -ones. - --} - -{- $keyAdding -#Adding_key_bindings# - -Adding key bindings can be done in different ways. The type signature -of "XMonad.Core.XConfig.keys" is: - -> keys :: XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()) - -which means thatm in order to add new bindings you need to create a -'Data.Map.Map' from the list of your new key bindings, you can do that -with 'Data.Map.fromList', and then join this newly created map with -the one of the existing bindings. This can be done with -'Data.Map.union'. - -For instance, if you have defined some additional key bindings like -these: - -> myKeys x = -> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) -> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) -> ] - -then you create a new key bindings map by joining the default one with -yours: - -> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) - -Finally you need to update accordingly the default configuration -'XMonad.Core.XConfig.keys' record: - -> main = xmonad defaultConfig { keys = newKeys } - - -And that's it. - -At the end your @~\/.xmonad\/xmonad.hs@ would look like this: - - -> module Main (main) where -> -> import XMonad -> -> import qualified Data.Map as M -> import Graphics.X11.Xlib -> import XMonad.Prompt -> import XMonad.Prompt.Shell -> import XMonad.Prompt.XMonad -> -> main :: IO () -> main = xmonad defaultConfig { keys = newKeys } -> -> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) -> -> myKeys x = -> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) -> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) -> ] - - -Obviously there are other ways of defining @newKeys@. For instance, -you could define it like this: - -> newKeys x = foldr (uncurry M.insert) (keys defaultConfig x) (myKeys x) - -An even simpler way to add new key bindings is the use of some of the -utilities provided by the xmonad-contrib library. For instance, -"XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" both provide -useful functions for editing your key bindings. Look, for instance, at -'XMonad.Util.EZConfig.additionalKeys'. - - -} - -{- $keyDel -#Removing_key_bindings# - -Removing key bindings requires modifying the binding 'Data.Map.Map'. -This can be done with 'Data.Map.difference' or with 'Data.Map.delete'. - -Suppose you wan to get rid of @mod-q@ and @mod-shift-q@. To do this -you just need to define a @newKeys@ as a 'Data.Map.difference' between -the default map and the map of the key bindings you want to remove. - -> newKeys x = M.difference (keys defaultConfig x) (M.fromList $ keysToRemove x) -> -> keysToRemove :: XConfig Layout -> [((KeyMask, KeySym),X ())] -> keysToRemove x = -> [ ((modMask x , xK_q ), return ()) -> , ((modMask x .|. shiftMask, xK_q ), return ()) -> ] - -As you may see we do not need to define an action for the key bindings -we want to get rid of. We just build a map of keys to remove. - -It is also possible to define a list of key bindings and then use -'Data.Map.delete' to remove them from the default key bindings, in -which case we should write something like: - -> newKeys x = foldr M.delete (keys defaultConfig x) (keysToRemove x) -> -> keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)] -> keysToRemove x = -> [ (modMask x , xK_q ) -> , (modMask x .|. shiftMask, xK_q ) -> ] - -Another even simpler possibility is the use of some of the utilities -provided by the xmonad-contrib library. Look, for instance, at -'XMonad.Util.EZConfig.removeKeys'. - --} - -{- $keyAddDel -#Adding_and_removing_key_bindings# - -Adding and removing key bindings requires to compose the action of -removing and, after that, the action of adding. - -This is an example you may find in "XMonad.Config.Arossato": - - -> defKeys = keys defaultConfig -> delKeys x = foldr M.delete (defKeys x) (toRemove x) -> newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x) -> -- remove some of the default key bindings -> toRemove x = -> [ (modMask x , xK_j ) -> , (modMask x , xK_k ) -> , (modMask x , xK_p ) -> , (modMask x .|. shiftMask, xK_p ) -> , (modMask x .|. shiftMask, xK_q ) -> , (modMask x , xK_q ) -> ] ++ -> -- I want modMask .|. shiftMask 1-9 to be free! -> [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]] -> -- These are my personal key bindings -> toAdd x = -> [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) -> , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) -> ] ++ -> -- Use modMask .|. shiftMask .|. controlMask 1-9 instead -> [( (m .|. modMask x, k), windows $ f i) -> | (i, k) <- zip (workspaces x) [xK_1 .. xK_9] -> , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)] -> ] - -You can achieve the same result by using "XMonad.Util.CustomKeys" and, -specifically, 'XMonad.Util.CustomKeys.customKeys'. - --} - -{- $layoutHook -#Editing_the_layout_hook# - -When you start an application that opens a new window, when you change -the focused window, or move it to another workspace, or change that -workspace's layout, xmonad will use the 'XMonad.Core.layoutHook' for -reordering the visible windows on the visible workspace(s). - -Since different layouts may be attached to different workspaces, and -you can change them, xmonad needs to know which one to pick up, so, -the layoutHook may be thought as a stack, or even better a combination -of layouts. This also means an order, i.e. a list. - -The problem is that the layout subsystem is implemented with an -advanced feature of the Haskell programming language: type classes. -This allows us to very easily write new layouts, combine or modify -existing layouts, have some of them with a state, etc. See -"Documentation#The_LayoutClass" for more information. - -The price we have to pay to get all that for free - which is something -that makes xmonad so powerful with such a ridiculously low number of -lines - is that we cannot simply have a list of layouts as we used to -have before the 0.5 release. - -Instead the combination of layouts to be used by xmonad is created -with a specific layout combinator: 'XMonad.Layouts.|||' - -Suppose we want a list with the 'XMonad.Layouts.Full', the -'XMonad.Layout.Tabbed.tabbed' and the -'XMonad.Layout.Accordion.Accordion' layouts. First we import, in our -@~\/.xmonad\/xmonad.hs@, all the needed module: - -> import XMonad -> import XMonad.Layouts -> -> import XMonad.Layout.Tabbed -> import XMonad.Layout.Accordion - -Then we create the combination of layouts we need: - -> mylayoutHook = Full ||| tabbed shrinkText defaultTConf ||| Accordion - - -Now, all we need to do is to change the 'XMonad.Core.layoutHook' -record of the 'XMonad.Core.XConfig' data type, like: - -> main = xmonad defaultConfig { layoutHook = mylayoutHook } - -Thanks to the new combinator we can apply a layout modifier to the -combination of layouts, instead of applying it to each one. Suppose we -want to use the 'XMonad.Layout.NoBorders.noBorders' layout modifier, -from the "XMonad.Layout.NoBorders" module (which must be imported): - -> mylayoutHook = noBorders (Full ||| tabbed shrinkText defaultTConf ||| Accordion) - -Obviously, if we want only the tabbed layout without borders, then we -may write: - -> mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion - -The @~\/.xmonad\/xmonad.hs@ will now look like this: - -> import XMonad.Layouts -> -> import XMonad.Layout.Tabbed -> import XMonad.Layout.Accordion -> import XMonad.Layout.NoBorders -> -> mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion -> -> main = xmonad defaultConfig { layoutHook = mylayoutHook } - -That's it! - --} - -{- $manageHook -#Editing_the_manage_hook# -TODO: Manage Hook - --} - -{- $logHook -#The_log_hook_and_external_status_bars# - -TODO: Log Hook - --} - --------------------------------------------------------------------------------- --- --- Writing Extensions --- --------------------------------------------------------------------------------- - -{- $writing - -Writing Other Extensions - --} - -{- $xmonad-libs - -xmonad and xmonad-contrib are just libraries for letting users write -their own window managers. This is what makes xmonad such a powerful -and still simple application. - -Give some examples: -arossato_vm -droundy_wm - -In the previous sections we show how simple it can be to write your -own window manager by using the core code (xmonad) and some of the -contributed code (xmonad-contrib). - -In this section we will give you a brief overview of the programming -techniques that have been used in order to make writing new extensions -very simple. - --} - -{- $internals - -TODO - --} - -{- $main -#The_main_entry_point# - -TODO - --} - -{- $internalState - -TODO - --} - -{- $events - -TODO - --} - -{- $layoutClass -#The_LayoutClass# -TODO - --} - -{- $style - -These are the coding guidelines for contributing to xmonad and the -xmonad contributed extensions. - -* Comment every top level function (particularly exported funtions), and - provide a type signature. - -* Use Haddock syntax in the comments. - -* Follow the coding style of the other modules. - -* Code should be compilable with -Wall -Werror. There should be no warnings. - -* Partial functions should be avoided: the window manager should not - crash, so do not call 'error' or 'undefined' - -* Tabs are /illegal/. Use 4 spaces for indenting. - -* Any pure function added to the core should have QuickCheck properties - precisely defining its behaviour. - --} - -{- $license - -New modules should identify the author, and be submitted under the -same license as xmonad (BSD3 license or freer). - --} rmfile ./Documentation.hs addfile ./XMonad/Doc.hs hunk ./XMonad/Doc.hs 1 - +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Doc +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : portable +-- +-- This is the main documentation module for the xmonad-contrib +-- library. +-- +-- The module provides a brief overview of xmonad and a link to the +-- documentation for configuring and extending your xmonad window +-- manager. +-- +-- A link to the module describing xmonad internals is also provided. +-- This module is mainly dedicated to those wanting to contribute code +-- for this library and for the curious ones, who want to know what's +-- going on behind the scene. +----------------------------------------------------------------------------- + +module XMonad.Doc + ( + -- * Overview + -- $overview + + -- * Configuring xmonad + -- $configuring + module XMonad.Doc.Configuring, + + -- * Extending xmonad with the xmonad-contrib library + -- $extending + module XMonad.Doc.Extending, + + -- * Developing xmonad: an brief code commentary + -- $developing + module XMonad.Doc.Developing + + ) where + + +import XMonad.Doc.Configuring +import XMonad.Doc.Extending +import XMonad.Doc.Developing + +-------------------------------------------------------------------------------- +-- +-- Overview +-- +-------------------------------------------------------------------------------- + +{- $overview +#Overview# + +xmonad is a tiling window manager for X. This library collects third +party tiling algorithms, hooks, configurations and scripts to xmonad. +The source for this library is available via darcs get + + +Each stable release of xmonad comes with a stable release of the +contrib library too, which should be used if you're using the stable +release. You can find the tarball here +() (Oct 2007) + +-} + +{- $configuring + +This module is dedicated at configuring xmonad. A brief tutorial will +guide you through the basic configuration steps. + +-} + +{- $extending + +This module is dedicated at extending xmonad with the xmonad-contrib +library. You will find an overview of the library and instruction on +installing contributed extensions. + +-} + +{- $developing + +This module consists of a brief description of the xmonad internals. +It is mainly intended for contributors and basically provides a brief +code commentary with link to the source code documentation. + +-} addfile ./XMonad/Doc/Configuring.hs hunk ./XMonad/Doc/Configuring.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Doc.Configuring +-- Copyright : (C) 2007 Don Stewart and Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : portable +-- +-- This is a brief tutorial that will teach you how to quickly write a +-- basic and simple xmonad configuration and cutomization. +-- +-- For more detailed instructions on extending xmonad with the +-- xmonad-contrib library see "XMonad.Doc.Extending" +-- +----------------------------------------------------------------------------- + +module XMonad.Doc.Configuring + ( + -- * Configuring xmonad + -- $configure + + -- * A simple example + -- $example + + -- * Checking whether your xmonad.hs is correct + -- $check + + -- * Loading your configuration + -- $load + + -- * Where are the defaults? + -- $where + ) where + +-------------------------------------------------------------------------------- +-- +-- Configuring Xmonad +-- +-------------------------------------------------------------------------------- + +{- $configure +#Configuring_xmonad# +xmonad can be configured by creating and editing the Haskell file: + +> ~/.xmonad/xmonad.hs + +If this file does not exist, xmonad will simply use default settings; +if it does exist, xmonad will use whatever settings you specify. Note +that this file can contain arbitrary Haskell code, which means that +you have quite a lot of flexibility in configuring xmonad. + +NOTE for users of previous versions (< 0.5) of xmonad: this is a major +change in the way xmonad is configured. Prior to version 0.5, +configuring xmonad required editing an xmonad source file called +Config.hs, recompiling xmonad, and then restarting. From version 0.5 +onwards, however, all you have to do is edit xmonad.hs and restart +with @mod-q@; xmonad does the recompiling itself. The format of the +configuration file has also changed; it is now simpler and much +shorter, only requiring you to list those settings which are different +from the defaults. + +-} + +{- $example +#A_simple_example# + +Here is a basic example, which starts with the default xmonad +configuration and overrides the border width, default terminal, and +some colours: + +> -- +> -- An example, simple ~/.xmonad/xmonad.hs file. +> -- It overrides a few basic settings, reusing all the other defaults. +> -- +> +> import XMonad +> +> main = xmonad $ defaultConfig +> { borderWidth = 2 +> , terminal = "urxvt" +> , normalBorderColor = "#cccccc" +> , focusedBorderColor = "#cd8b00" } + +This will run \'xmonad\', the window manager, with your settings +passed as arguments. + +Overriding default settings like this (using \"record update +syntax\"), will yield the shortest config file, as you only have to +describe values that differ from the defaults. + +An alternative is to inline the entire default config file from +xmonad, and edit values you wish to change. This is requires more +work, but some users may find this easier. You can find the defaults +in the file: + +> XMonad/Config.hs + +However, note that you should not edit Config.hs itself. + +-} + +{- $check +#Checking_whether_your_xmonad.hs_is_correct# + +After changing your configuration, it is a good idea to check that it +is syntactically and type correct. You can do this easily by loading +your configuration file in the Haskell interpreter: + +> $ ghci ~/.xmonad/xmonad.hs +> GHCi, version 6.8.1: http://www.haskell.org/ghc/ :? for help +> Loading package base ... linking ... done. +> Ok, modules loaded: Main. +> +> Prelude Main> :t main +> main :: IO () + +Ok, looks good. + +-} + +{- $load +#Loading_your_configuration# + +To get xmonad to use your new settings, type @mod-q@. xmonad will +attempt to compile this file, and run it. If everything goes well, +xmonad will seamlessly restart itself with the new settings, keeping +all your windows, layouts, etc. intact. (If you change anything +related to your layouts, you may need to hit @mod-shift-space@ after +restarting to see the changes take effect.) If something goes wrong, +the previous (default) settings will be used. Note this requires that +GHC and xmonad are in your @$PATH@. If GHC isn't in your path, you can +still compile @xmonad.hs@ yourself: + +> $ cd ~/.xmonad +> $ /path/to/ghc --make xmonad.hs +> $ ls +> xmonad xmonad.hi xmonad.hs xmonad.o + +When you hit @mod-q@, this newly compiled xmonad will be used. + +-} + +{- $where +#Where_are_the_defaults?# + +The default configuration values are defined in the source file: + +> XMonad/Config.hs + +the 'XMonad.Core.XConfig' data structure itself is defined in: + +> XMonad/Core.hs + +See "XMonad.Core". + +-} + addfile ./XMonad/Doc/Developing.hs hunk ./XMonad/Doc/Developing.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : Documentation +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : portable +-- +-- This module documents the xmonad internals. +-- +-- It is intended for the advanced users who are curious about the +-- xmonad code and want an brief overview of it. +-- +-- It may be useful also for those who would like to extend xmonad. If +-- you think your extension may be useful for other users too, you may +-- consider about releasing it. +-- +-- Coding guidelines and licencing policies must be followed if you +-- want your code to be included in the official repositories. +-- +----------------------------------------------------------------------------- + +module XMonad.Doc.Developing + ( + -- * Writing new extensions + -- $writing + + -- * Libraries for writing window managers + -- $xmonad-libs + + -- * xmonad internals + -- $internals + + -- ** The @main@ entry point + -- $main + + -- ** The X monad and the internal state + -- $internalState + + -- ** Event handling and messages + -- $events + + -- ** The 'LayoutClass' + -- $layoutClass + + -- * Coding style + -- $style + + -- * Licensing policy + -- $license + ) where + +-------------------------------------------------------------------------------- +-- +-- Writing Extensions +-- +-------------------------------------------------------------------------------- + +{- $writing + +Writing Other Extensions + +-} + +{- $xmonad-libs + +xmonad and xmonad-contrib are just libraries for letting users write +their own window managers. This is what makes xmonad such a powerful +and still simple application. + +Give some examples: +arossato_vm +droundy_wm + +In the previous sections we show how simple it can be to write your +own window manager by using the core code (xmonad) and some of the +contributed code (xmonad-contrib). + +In this section we will give you a brief overview of the programming +techniques that have been used in order to make writing new extensions +very simple. + +-} + +{- $internals + +TODO + +-} + +{- $main +#The_main_entry_point# + +TODO + +-} + +{- $internalState + +TODO + +-} + +{- $events + +TODO + +-} + +{- $layoutClass +#The_LayoutClass# +TODO + +-} + +{- $style + +These are the coding guidelines for contributing to xmonad and the +xmonad contributed extensions. + +* Comment every top level function (particularly exported funtions), and + provide a type signature. + +* Use Haddock syntax in the comments. + +* Follow the coding style of the other modules. + +* Code should be compilable with -Wall -Werror. There should be no warnings. + +* Partial functions should be avoided: the window manager should not + crash, so do not call 'error' or 'undefined' + +* Tabs are /illegal/. Use 4 spaces for indenting. + +* Any pure function added to the core should have QuickCheck properties + precisely defining its behaviour. + +-} + +{- $license + +New modules should identify the author, and be submitted under the +same license as xmonad (BSD3 license or freer). + +-} addfile ./XMonad/Doc/Extending.hs hunk ./XMonad/Doc/Extending.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Doc.Extending +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : portable +-- +-- This is a module for documenting the xmonad-contrib library and +-- describing how to use it to extend xmonad capabilities. +-- +-- While it should not require a deep knowledge of Haskell. this +-- document is intended also for the more advanced users, which +-- requires a reference to some features of Haskell. Still we hope the +-- examples may be useful also for those users who do not Haskell and +-- do not want to start learning it. +-- +-- More configuration examples may be fond on the Haskell wiki at this +-- address: +-- +-- +-- +----------------------------------------------------------------------------- + +module XMonad.Doc.Extending + ( + -- * The xmonad-contrib library + -- $library + + -- ** Actions + -- $actions + + -- ** Configurations + -- $configs + + -- ** Hooks + -- $hooks + + -- ** Layouts + -- $layouts + + -- ** Prompts + -- $prompts + + -- ** Utilities + -- $utils + + -- * Extending xmonad + -- $extending + + -- ** Editing key bindings + -- $keys + + -- *** Adding key bindings + -- $keyAdding + + -- *** Removing key bindings + -- $keyDel + + -- *** Adding and removing key bindings + -- $keyAddDel + + -- ** Editing the layout hook + -- $layoutHook + + -- ** Editing the manage hook + -- $manageHook + + -- ** The log hook and external status bars + -- $logHook + ) where + +-------------------------------------------------------------------------------- +-- +-- The XmonadContrib Library +-- +-------------------------------------------------------------------------------- + +{- $library + +The xmonad-contrib (xmc) library is a set of extension modules +contributed by xmonad hackers and users, which provide additional +xmonad features. Examples include various layout modes (tabbed, +spiral, three-column...), prompts, program launchers, the ability to +manipulate windows and workspaces in various ways, alternate +navigation modes, and much more. There are also \"meta-modules\" +which make it easier to write new modules and extensions. + +This is a short overview of the xmonad-contrib modules. For more +information about any particular module, just click on its name to +view its Haddock documentation; each module should come with extensive +documentation. If you find a module that could be better documented, +or has incorrect documentation, please report it as a bug +()! + +-} + +{- $actions + +In the @XMonad.Actions@ namespace you can find modules exporting +various functions that are usually intended to be bound to key +combinations or mouse actions, in order to provide functionality +beyond the standard keybindings provided by xmonad. + +See "XMonad.Doc.Extending#Editing_key_bindings" for instructions on how to +edit your key bindings. + +* "XMonad.Actions.Commands": running internal xmonad actions + interactively. + +* "XMonad.Actions.ConstrainedResize": an aspect-ratio-constrained + window resizing mode. + +* "XMonad.Actions.CopyWindow": duplicating windows on multiple + workspaces. + +* "XMonad.Actions.CycleWS": move between workspaces. + +* "XMonad.Actions.DeManage": cease management of a window without + unmapping it. + +* "XMonad.Actions.DwmPromote": dwm-like master window swapping. + +* "XMonad.Actions.DynamicWorkspaces": add and delete workspaces. + +* "XMonad.Actions.FindEmptyWorkspace": find an empty workspace. + +* "XMonad.Actions.FlexibleManipulate": move\/resize windows without + warping the mouse. + +* "XMonad.Actions.FlexibleResize": resize windows from any corner. + +* "XMonad.Actions.FloatKeys": move\/resize floating windows with + keybindings. + +* "XMonad.Actions.FocusNth": focus the nth window on the screen. + +* "XMonad.Actions.MouseGestures": bind mouse gestures to actions. + +* "XMonad.Actions.RotSlaves": rotate non-master windows. + +* "XMonad.Actions.RotView": cycle through non-empty workspaces. + +* "XMonad.Actions.SimpleDate": display the date in a popup menu. + +* "XMonad.Actions.SinkAll": sink all floating windows. + +* "XMonad.Actions.Submap": create key submaps, i.e. the ability to + bind actions to key sequences rather than being limited to single + key combinations. + +* "XMonad.Actions.SwapWorkspaces": swap workspace tags. + +* "XMonad.Actions.TagWindows": tag windows and select by tag. + +* "XMonad.Actions.Warp": warp the pointer. + +* "XMonad.Actions.WindowBringer": bring windows to you, and you to + windows. + +* "XMonad.Actions.WmiiActions": wmii-style actions. + +-} + +{- $configs + +In the @XMonad.Config@ namespace you can find modules exporting the +configurations used by some of the xmonad and xmonad-contrib +developers. You can look at them for examples while creating your own +configuration; you can also simply import them and use them as your +own configuration, possibly with some modifications. + +-} + +{- $hooks + +In the @XMonad.Hooks@ namespace you can find modules exporting hooks. + +Hooks are actions that xmonad performs when some events occur. The two +most important hooks are: + +* 'XMonad.Core.manageHook': this hook is called when a new window + xmonad must take care of is created. This is a very powerful hook, + since it let us look at the new window's properties and act + accordingly. For instance, we can configure xmonad to put windows + belonging to a given application in the float layer, not to manage + dock applications, or open them in a given workspace. See + "XMonad.Doc.Extending#Editing_the_manage_hook" for more information on + customizing the 'XMonad.Core.manageHook'. + +* 'XMonad.Core.logHook': this hook is called when the stack of windows + managed by xmonad has been changed, by calling the + 'XMonad.Operations.windows' function. For instance + "XMonad.Hooks.DynamicLog" will produce a string (whose format can be + configured) to be printed to the standard output. This can be used + to display some information about the xmonad state in a Status Bar. + See "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" for more + information. + +-} + +{- $layouts + +In the @XMonad.Layout@ name space you can find modules exporting +contributed tiling algorithms, such as a tabbed layout, a circle and a +three columns ones, etc. + +Other modules provide facilities for combining different layouts, such +as "XMonad.Layout.Combo", or a complete set of layout combinators, +like "XMonad.Layout.LayoutCombinators" + +Layouts can be also modified with layout modifiers. A general +interface for writing layout modifiers is implemented in +"XMonad.Layout.LayoutModifier". + +For more information on using those modules for customizing your +'XMonad.Core.layoutHook' see "XMonad.Doc.Extending#Editing_the_layout_hook". + + +-} + +{- $prompts + +In the @XMonad.Prompt@ name space you can find modules exporting +graphical prompts for getting user input and performing, with it, +different actions. + +"XMonad.Prompt" provides a library for easily writing prompts. + +These are the available prompts: + +* "XMonad.Prompt.Directory" + +* "XMonad.Prompt.Layout" + +* "XMonad.Prompt.Man" + +* "XMonad.Prompt.Shell" + +* "XMonad.Prompt.Ssh" + +* "XMonad.Prompt.Window" + +* "XMonad.Prompt.Workspace" + +* "XMonad.Prompt.XMonad" + +Usually a prompt is called by some key binding. See +"XMonad.Doc.Extending#Editing_key_bindings" on how to configure xmonad to use +some prompts. The give examples include adding some prompts. + +-} + +{- $utils + +In the @XMonad.Util@ namespace you can find modules exporting various +utility functions that are used by the other modules of the +xmonad-contrib library. + +There are also utilities for helping in configuring xmonad or using +external utilities. + +A non complete list with a brief description: + +* "XMonad.Util.CustomKeys" or "XMonad.Util.EZConfig" can be used to + configure key bindings (see "XMonad.Doc.Extending#Editing_key_bindings"); + +* "XMonad.Util.Dzen" "XMonad.Util.Dmenu" provide useful functions for + running dzen as a xmonad status bar and dmenu as a program launcher; + +* "XMonad.Util.XSelection" provide utilities for using the mouse + selection; + +* "XMonad.Util.XUtils" and "XMonad.Util.Font" are libraries for + accessing Xlib and XFT function in a convenient way. + +-} + +-------------------------------------------------------------------------------- +-- +-- Extending Xmonad +-- +-------------------------------------------------------------------------------- + +{- $extending +#Extending_xmonad# + +Since the @xmonad.hs@ file is just another Haskell module, you may +import and use any Haskell code or libraries you wish, such as +extensions from the xmonad-contrib library, or other code you write +yourself. + +-} + +{- $keys +#Editing_key_bindings# + +Editing key bindings means changing the 'XMonad.Core.XConfig.keys' +record of the 'XMonad.Core.XConfig' data type, like: + +> main = xmonad defaultConfig { keys = myKeys } + +and providing a proper definition of @myKeys@ such as: + +> myKeys x = +> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) +> ] + +Remember that this definition requires importing "Graphics.X11.Xlib", +"XMonad.Prompt", "XMonad.Prompt.Shell", and "XMonad.Prompt.XMonad" + +Sometimes, more than completely redefining the key bindings, as we did +above, we may want to add some new bindings, or\/and remove existing +ones. + +-} + +{- $keyAdding +#Adding_key_bindings# + +Adding key bindings can be done in different ways. The type signature +of "XMonad.Core.XConfig.keys" is: + +> keys :: XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()) + +which means thatm in order to add new bindings you need to create a +'Data.Map.Map' from the list of your new key bindings, you can do that +with 'Data.Map.fromList', and then join this newly created map with +the one of the existing bindings. This can be done with +'Data.Map.union'. + +For instance, if you have defined some additional key bindings like +these: + +> myKeys x = +> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) +> ] + +then you create a new key bindings map by joining the default one with +yours: + +> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) + +Finally you need to update accordingly the default configuration +'XMonad.Core.XConfig.keys' record: + +> main = xmonad defaultConfig { keys = newKeys } + + +And that's it. + +At the end your @~\/.xmonad\/xmonad.hs@ would look like this: + + +> module Main (main) where +> +> import XMonad +> +> import qualified Data.Map as M +> import Graphics.X11.Xlib +> import XMonad.Prompt +> import XMonad.Prompt.Shell +> import XMonad.Prompt.XMonad +> +> main :: IO () +> main = xmonad defaultConfig { keys = newKeys } +> +> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) +> +> myKeys x = +> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) +> ] + + +Obviously there are other ways of defining @newKeys@. For instance, +you could define it like this: + +> newKeys x = foldr (uncurry M.insert) (keys defaultConfig x) (myKeys x) + +An even simpler way to add new key bindings is the use of some of the +utilities provided by the xmonad-contrib library. For instance, +"XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" both provide +useful functions for editing your key bindings. Look, for instance, at +'XMonad.Util.EZConfig.additionalKeys'. + + -} + +{- $keyDel +#Removing_key_bindings# + +Removing key bindings requires modifying the binding 'Data.Map.Map'. +This can be done with 'Data.Map.difference' or with 'Data.Map.delete'. + +Suppose you wan to get rid of @mod-q@ and @mod-shift-q@. To do this +you just need to define a @newKeys@ as a 'Data.Map.difference' between +the default map and the map of the key bindings you want to remove. + +> newKeys x = M.difference (keys defaultConfig x) (M.fromList $ keysToRemove x) +> +> keysToRemove :: XConfig Layout -> [((KeyMask, KeySym),X ())] +> keysToRemove x = +> [ ((modMask x , xK_q ), return ()) +> , ((modMask x .|. shiftMask, xK_q ), return ()) +> ] + +As you may see we do not need to define an action for the key bindings +we want to get rid of. We just build a map of keys to remove. + +It is also possible to define a list of key bindings and then use +'Data.Map.delete' to remove them from the default key bindings, in +which case we should write something like: + +> newKeys x = foldr M.delete (keys defaultConfig x) (keysToRemove x) +> +> keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)] +> keysToRemove x = +> [ (modMask x , xK_q ) +> , (modMask x .|. shiftMask, xK_q ) +> ] + +Another even simpler possibility is the use of some of the utilities +provided by the xmonad-contrib library. Look, for instance, at +'XMonad.Util.EZConfig.removeKeys'. + +-} + +{- $keyAddDel +#Adding_and_removing_key_bindings# + +Adding and removing key bindings requires to compose the action of +removing and, after that, the action of adding. + +This is an example you may find in "XMonad.Config.Arossato": + + +> defKeys = keys defaultConfig +> delKeys x = foldr M.delete (defKeys x) (toRemove x) +> newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x) +> -- remove some of the default key bindings +> toRemove x = +> [ (modMask x , xK_j ) +> , (modMask x , xK_k ) +> , (modMask x , xK_p ) +> , (modMask x .|. shiftMask, xK_p ) +> , (modMask x .|. shiftMask, xK_q ) +> , (modMask x , xK_q ) +> ] ++ +> -- I want modMask .|. shiftMask 1-9 to be free! +> [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]] +> -- These are my personal key bindings +> toAdd x = +> [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) +> , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) +> ] ++ +> -- Use modMask .|. shiftMask .|. controlMask 1-9 instead +> [( (m .|. modMask x, k), windows $ f i) +> | (i, k) <- zip (workspaces x) [xK_1 .. xK_9] +> , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)] +> ] + +You can achieve the same result by using "XMonad.Util.CustomKeys" and, +specifically, 'XMonad.Util.CustomKeys.customKeys'. + +-} + +{- $layoutHook +#Editing_the_layout_hook# + +When you start an application that opens a new window, when you change +the focused window, or move it to another workspace, or change that +workspace's layout, xmonad will use the 'XMonad.Core.layoutHook' for +reordering the visible windows on the visible workspace(s). + +Since different layouts may be attached to different workspaces, and +you can change them, xmonad needs to know which one to pick up. In +this sense the layoutHook may be thought as the combination, or the +list, of layouts that xmonad will use for ordering windows on the +screen(s) + +The problem is that the layout subsystem is implemented with an +advanced feature of the Haskell programming language: type classes. +This allows us to very easily write new layouts, combine or modify +existing layouts, have some of them with a state, etc. See +"XMonad.Doc.Extending#The_LayoutClass" for more information. + +The price we have to pay to get all that for free - which is something +that makes xmonad so powerful with such a ridiculously low number of +lines - is that we cannot simply have a list of layouts as we used to +have before the 0.5 release: a list requires every member to belong to +the same type! + +Instead the combination of layouts to be used by xmonad is created +with a specific layout combinator: 'XMonad.Layouts.|||' + +Suppose we want a list with the 'XMonad.Layouts.Full', the +'XMonad.Layout.Tabbed.tabbed' and the +'XMonad.Layout.Accordion.Accordion' layouts. First we import, in our +@~\/.xmonad\/xmonad.hs@, all the needed module: + +> import XMonad +> import XMonad.Layouts +> +> import XMonad.Layout.Tabbed +> import XMonad.Layout.Accordion + +Then we create the combination of layouts we need: + +> mylayoutHook = Full ||| tabbed shrinkText defaultTConf ||| Accordion + + +Now, all we need to do is to change the 'XMonad.Core.layoutHook' +record of the 'XMonad.Core.XConfig' data type, like: + +> main = xmonad defaultConfig { layoutHook = mylayoutHook } + +Thanks to the new combinator we can apply a layout modifier to the +combination of layouts, instead of applying it to each one. Suppose we +want to use the 'XMonad.Layout.NoBorders.noBorders' layout modifier, +from the "XMonad.Layout.NoBorders" module (which must be imported): + +> mylayoutHook = noBorders (Full ||| tabbed shrinkText defaultTConf ||| Accordion) + +Obviously, if we want only the tabbed layout without borders, then we +may write: + +> mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion + +Our @~\/.xmonad\/xmonad.hs@ will now look like this: + +> import XMonad.Layouts +> +> import XMonad.Layout.Tabbed +> import XMonad.Layout.Accordion +> import XMonad.Layout.NoBorders +> +> mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion +> +> main = xmonad defaultConfig { layoutHook = mylayoutHook } + +That's it! + +-} + +{- $manageHook +#Editing_the_manage_hook# +TODO: Manage Hook + +-} + +{- $logHook +#The_log_hook_and_external_status_bars# + +TODO: Log Hook + +-} hunk ./xmonad-contrib.cabal 9 - "Documentation" on building, configuring and using xmonad extensions. + Documentation on building, configuring and using xmonad + extensions: "XMonad.Doc" hunk ./xmonad-contrib.cabal 40 - exposed-modules: Documentation + exposed-modules: XMonad.Doc + XMonad.Doc.Configuring + XMonad.Doc.Extending + XMonad.Doc.Developing hunk ./XMonad/Doc.hs 31 - module XMonad.Doc.Configuring, hunk ./XMonad/Doc.hs 34 - module XMonad.Doc.Extending, hunk ./XMonad/Doc.hs 37 - module XMonad.Doc.Developing hunk ./XMonad/Doc.hs 40 - -import XMonad.Doc.Configuring -import XMonad.Doc.Extending -import XMonad.Doc.Developing +import XMonad.Doc.Configuring () +import XMonad.Doc.Extending () +import XMonad.Doc.Developing () hunk ./XMonad/Doc.hs 67 -This module is dedicated at configuring xmonad. A brief tutorial will -guide you through the basic configuration steps. +"XMonad.Doc.Configuring" is dedicated at configuring xmonad. A brief +tutorial will guide you through the basic configuration steps. hunk ./XMonad/Doc.hs 74 -This module is dedicated at extending xmonad with the xmonad-contrib -library. You will find an overview of the library and instruction on -installing contributed extensions. +"XMonad.Doc.Extending" is dedicated at extending xmonad with the +xmonad-contrib library. You will find an overview of the library and +instruction on installing contributed extensions. hunk ./XMonad/Doc.hs 82 -This module consists of a brief description of the xmonad internals. -It is mainly intended for contributors and basically provides a brief -code commentary with link to the source code documentation. +"XMonad.Doc.Developing" consists of a brief description of the xmonad +internals. It is mainly intended for contributors and basically +provides a brief code commentary with link to the source code +documentation. hunk ./XMonad/Layout/PerWorkspace.hs 13 --- Configure layouts on a per-workspace basis. +-- Configure layouts on a per-workspace basis. NOTE that this module +-- does not (yet) work in conjunction with multiple screens! =( hunk ./XMonad/Layout/PerWorkspace.hs 21 - onWorkspace + onWorkspace, onWorkspaces hunk ./XMonad/Layout/PerWorkspace.hs 35 --- and modifying your layoutHook as follows: +-- and modifying your layoutHook as follows (for example): hunk ./XMonad/Layout/PerWorkspace.hs 37 --- > layoutHook = onWorkspace "foo" l1 $ -- layout l1 will be used on workspace "foo" --- > onWorkspace "bar" l2 $ -- layout l2 will be used on workspace "bar" +-- > layoutHook = onWorkspace "foo" l1 $ -- layout l1 will be used on workspace "foo". +-- > onWorkspaces ["bar","6"] l2 $ -- layout l2 will be used on workspaces "bar" and "6". hunk ./XMonad/Layout/PerWorkspace.hs 49 +-- +-- NOTE that this module does not (yet) work in conjunction with +-- multiple screens. =( hunk ./XMonad/Layout/PerWorkspace.hs 61 -onWorkspace wsId l1 l2 = PerWorkspace wsId Nothing l1 l2 +onWorkspace wsId l1 l2 = PerWorkspace [wsId] Nothing l1 l2 + +-- | Specify one layout to use on a particular set of workspaces, and +-- another to use on all other workspaces. +onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a) + => [WorkspaceId] -- ^ tags of workspaces to match + -> (l1 a) -- ^ layout to use on matched workspaces + -> (l2 a) -- ^ layout to use everywhere else + -> PerWorkspace l1 l2 a +onWorkspaces wsIds l1 l2 = PerWorkspace wsIds Nothing l1 l2 hunk ./XMonad/Layout/PerWorkspace.hs 73 --- a layout for all other workspaces. We store the tag of the workspace +-- a layout for all other workspaces. We store the tags of workspaces hunk ./XMonad/Layout/PerWorkspace.hs 75 --- per workspace, once we figure out which workspace we are on, we can --- cache that information using a (Maybe Bool). This is necessary +-- per workspace, once we figure out whether we're on a matched workspace, +-- we can cache that information using a (Maybe Bool). This is necessary hunk ./XMonad/Layout/PerWorkspace.hs 80 -data PerWorkspace l1 l2 a = PerWorkspace WorkspaceId - (Maybe Bool) - (l1 a) - (l2 a) +data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId] + (Maybe Bool) + (l1 a) + (l2 a) hunk ./XMonad/Layout/PerWorkspace.hs 101 - doLayout (PerWorkspace wsId Nothing l1 l2) r s = do + doLayout (PerWorkspace wsIds Nothing l1 l2) r s = do hunk ./XMonad/Layout/PerWorkspace.hs 103 - doLayout (PerWorkspace wsId (Just $ wsId == t) l1 l2) r s + doLayout (PerWorkspace wsIds (Just $ t `elem` wsIds) l1 l2) r s hunk ./XMonad/Layout/PerWorkspace.hs 114 - handleMessage (PerWorkspace wsId Nothing l1 l2) m = do - t <- getCurrentTag - handleMessage (PerWorkspace wsId (Just $ wsId == t) l1 l2) m + handleMessage (PerWorkspace _ Nothing _ _) _ = return Nothing hunk ./XMonad/Layout/PerWorkspace.hs 120 - -- until a doLayout or handleMessage for the information about - -- which workspace we're in to get cached. + -- until a doLayout for the information about which workspace + -- we're in to get cached. hunk ./XMonad/Layout/PerWorkspace.hs 127 -mkNewPerWorkspaceT (PerWorkspace wsId b lt lf) mlt' = - (\lt' -> PerWorkspace wsId b lt' lf) $ fromMaybe lt mlt' +mkNewPerWorkspaceT (PerWorkspace wsIds b lt lf) mlt' = + (\lt' -> PerWorkspace wsIds b lt' lf) $ fromMaybe lt mlt' hunk ./XMonad/Layout/PerWorkspace.hs 132 -mkNewPerWorkspaceF (PerWorkspace wsId b lt lf) mlf' = - (\lf' -> PerWorkspace wsId b lt lf') $ fromMaybe lf mlf' +mkNewPerWorkspaceF (PerWorkspace wsIds b lt lf) mlf' = + (\lf' -> PerWorkspace wsIds b lt lf') $ fromMaybe lf mlf' hunk ./XMonad/Layout/PerWorkspace.hs 135 --- | Get the tag of the currently active workspace. +-- | Get the tag of the currently active workspace. Note that this +-- is only guaranteed to be the same workspace for which doLayout +-- was called if there is only one screen. hunk ./XMonad/Layout/HintedTile.hs 1 +{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} + hunk ./XMonad/Layout/HintedTile.hs 10 +-- Andrea Rossato hunk ./XMonad/Layout/HintedTile.hs 14 --- A gapless tiled layout that attempts to obey window size hints, +-- A gapless tiled layout that attempts to obey window size hints, hunk ./XMonad/Layout/HintedTile.hs 22 - tall, wide) where + tall, wide ) where hunk ./XMonad/Layout/HintedTile.hs 25 -import XMonad.Operations (Resize(..), IncMasterN(..), applySizeHints) +import XMonad.Layouts ( Resize(..), IncMasterN(..) ) +import XMonad.Operations ( applySizeHints ) hunk ./XMonad/Layout/HintedTile.hs 28 -import {-# SOURCE #-} Config (borderWidth) hunk ./XMonad/Layout/HintedTile.hs 30 -import Control.Monad +import Control.Monad.Reader hunk ./XMonad/Layout/HintedTile.hs 33 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/HintedTile.hs 35 --- > import qualified XMonad.Layout.HintedTile +-- > import XMonad.Layout.HintedTile hunk ./XMonad/Layout/HintedTile.hs 37 --- > layouts = [ XMonad.Layout.HintedTile.tall nmaster delta ratio, ... ] - --- %import qualified XMonad.Layout.HintedTile +-- The edit your @layoutHook@ by adding the HintedTile layout: hunk ./XMonad/Layout/HintedTile.hs 39 --- %layout , XMonad.Layout.HintedTile.tall nmaster delta ratio +-- > mylayout = tall 1 0.1 0.5 ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = mylayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +data HintedTile a = + HT { nmaster :: Int + , delta, frac :: Rational + , orientation :: Orientation + } deriving ( Show, Read ) hunk ./XMonad/Layout/HintedTile.hs 51 --- this sucks -addBorder, substractBorder :: (Dimension, Dimension) -> (Dimension, Dimension) -addBorder (w, h) = (w + 2 * borderWidth, h + 2 * borderWidth) -substractBorder (w, h) = (w - 2 * borderWidth, h - 2 * borderWidth) +data Orientation = Wide | Tall deriving ( Show, Read ) hunk ./XMonad/Layout/HintedTile.hs 53 +tall, wide :: Int -> Rational -> Rational -> HintedTile Window +wide n d f = HT {nmaster = n, delta = d, frac = f, orientation = Tall } +tall n d f = HT {nmaster = n, delta = d, frac = f, orientation = Wide } hunk ./XMonad/Layout/HintedTile.hs 57 -tall, wide :: Int -> Rational -> Rational -> Layout Window -wide = tile splitVertically divideHorizontally -tall = tile splitHorizontally divideVertically +instance LayoutClass HintedTile Window where + doLayout c rect w' = let w = W.integrate w' + in do { hints <- sequence (map getHints w) + ; b <- asks (borderWidth . config) + ; return (zip w (tiler b (frac c) rect `uncurry` splitAt (nmaster c) hints) + , Nothing) } + where + (split, divide) = + case orientation c of + Wide -> (splitHorizontally, divideHorizontally) + Tall -> (splitVertically, divideVertically ) + tiler b f r masters slaves = + if null masters || null slaves + then divide b (masters ++ slaves) r + else split f r (divide b masters) (divide b slaves) hunk ./XMonad/Layout/HintedTile.hs 73 -tile split divide nmaster delta frac = - Layout { doLayout = \r w' -> let w = W.integrate w' - in do { hints <- sequence (map getHints w) - ; return (zip w (tiler frac r `uncurry` splitAt nmaster hints) - , Nothing) } - , modifyLayout = \m -> return $ fmap resize (fromMessage m) `mplus` - fmap incmastern (fromMessage m) } + pureMessage c m = fmap resize (fromMessage m) `mplus` + fmap incmastern (fromMessage m) + where + resize Shrink = c { frac = max 0 $ frac c - delta c } + resize Expand = c { frac = min 1 $ frac c + delta c } + incmastern (IncMasterN d) = c { nmaster = max 0 $ nmaster c + d } hunk ./XMonad/Layout/HintedTile.hs 80 - where resize Shrink = tile split divide nmaster delta (frac-delta) - resize Expand = tile split divide nmaster delta (frac+delta) - incmastern (IncMasterN d) = tile split divide (max 0 (nmaster+d)) delta frac + description l = "HintedTile " ++ show (orientation l) hunk ./XMonad/Layout/HintedTile.hs 82 - tiler f r masters slaves = if null masters || null slaves - then divide (masters ++ slaves) r - else split f r (divide masters) (divide slaves) +addBorder, substractBorder :: Dimension -> (Dimension, Dimension) -> (Dimension, Dimension) +addBorder b (w, h) = (w + 2 * b, h + 2 * b) +substractBorder b (w, h) = (w - 2 * b, h - 2 * b) hunk ./XMonad/Layout/HintedTile.hs 89 --- hunk ./XMonad/Layout/HintedTile.hs 90 --- -divideVertically, divideHorizontally :: [SizeHints] -> Rectangle -> [Rectangle] -divideVertically [] _ = [] -- there's a fold here, struggling to get out -divideVertically (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : - (divideVertically rest (Rectangle sx (sy + fromIntegral h) sw (sh - h))) - where (w, h) = addBorder $ applySizeHints hints $ substractBorder +divideVertically, divideHorizontally :: Dimension -> [SizeHints] -> Rectangle -> [Rectangle] +divideVertically _ [] _ = [] -- there's a fold here, struggling to get out +divideVertically b (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : + (divideVertically b rest (Rectangle sx (sy + fromIntegral h) sw (sh - h))) + where (w, h) = addBorder b $ applySizeHints hints $ substractBorder b hunk ./XMonad/Layout/HintedTile.hs 97 -divideHorizontally [] _ = [] -divideHorizontally (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : - (divideHorizontally rest (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) - where (w, h) = addBorder $ applySizeHints hints $ substractBorder +divideHorizontally _ [] _ = [] +divideHorizontally b (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : + (divideHorizontally b rest (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) + where (w, h) = addBorder b $ applySizeHints hints $ substractBorder b hunk ./XMonad/Layout/HintedTile.hs 103 - hunk ./xmonad-contrib.cabal 83 - -- XMonad.Layout.HintedTile + XMonad.Layout.HintedTile hunk ./XMonad/Layout/HintedTile.hs 2 - hunk ./XMonad/Layout/HintedTile.hs 36 --- The edit your @layoutHook@ by adding the HintedTile layout: +-- Then edit your @layoutHook@ by adding the HintedTile layout: hunk ./XMonad/Layout/Tabbed.hs 47 --- > layouts :: [Layout Window] --- > layouts = [ Layout tiled --- > , Layout $ Mirror tiled --- > , Layout Full --- > --- > -- Extension-provided layouts --- > , Layout $ tabbed shrinkText defaultTConf --- > ] --- > --- > , ... ] +-- Then edit your @layoutHook@ by adding the Tabbed layout: +-- +-- > mylayout = tabbed shrinkText defaultTConf ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = mylayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/Tabbed.hs 62 --- > layouts = [ ... --- > , Layout $ tabbed shrinkText myTabConfig ] - --- %import XMonad.Layout.Tabbed --- %layout , tabbed shrinkText defaultTConf +-- > mylayout = tabbed shrinkText myTabConfig ||| Full ||| etc.. hunk ./XMonad/Layout/Tabbed.hs 110 -doLay ist ishr conf sc@(Rectangle _ _ wid _) s@(W.Stack w _ _) = do +doLay ist ishr c sc@(Rectangle _ _ wid _) s@(W.Stack w _ _) = do hunk ./XMonad/Layout/Tabbed.hs 113 - -- initialize state + -- initialize state hunk ./XMonad/Layout/Tabbed.hs 115 - (I Nothing ) -> initState conf sc ws + (I Nothing ) -> initState c sc ws hunk ./XMonad/Layout/Tabbed.hs 119 - tws <- createTabs conf sc ws + tws <- createTabs c sc ws hunk ./XMonad/Layout/Tabbed.hs 122 - mapM_ (updateTab ishr conf (font st) width) $ tabsWindows st - return ([(w,shrink conf sc)], Just (Tabbed (I (Just st)) ishr conf)) + mapM_ (updateTab ishr c (font st) width) $ tabsWindows st + return ([(w,shrink c sc)], Just (Tabbed (I (Just st)) ishr c)) hunk ./XMonad/Layout/Tabbed.hs 136 -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}) hunk ./XMonad/Layout/Tabbed.hs 146 -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs }) - (AnyEvent {ev_window = thisw, ev_event_type = t }) +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs}) + (AnyEvent {ev_window = thisw, ev_event_type = t }) hunk ./XMonad/Layout/Tabbed.hs 155 -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs }) - (PropertyEvent {ev_window = thisw }) +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs}) + (PropertyEvent {ev_window = thisw}) hunk ./XMonad/Layout/Tabbed.hs 162 -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs }) - (ExposeEvent {ev_window = thisw }) +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs}) + (ExposeEvent {ev_window = thisw}) hunk ./XMonad/Prompt/Shell.hs 67 --- > , ((modMask, xK_b ), safePrompt "firefox" greenXPConfig) --- > , ((modMask .|. shiftMask, xK_c ), prompt ("xterm" ++ " -e") greenXPConfig) +-- > , ((modMask, xK_b), safePrompt "firefox" greenXPConfig) +-- > , ((modMask .|. shiftMask, xK_c), prompt ("xterm" ++ " -e") greenXPConfig) hunk ./XMonad/Util/XUtils.hs 38 --- See Tabbed or DragPane for usage examples +-- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" for usage +-- examples hunk ./XMonad/Util/NamedWindows.hs 36 --- See "XMonad.Layout.Mosaic" for an example of its use. +-- See "XMonad.Layout.Tabbed" for an example of its use. hunk ./XMonad/Util/Font.cpphs 4 --- Copyright : (c) 2007 Andrea Rossato +-- Copyright : (c) 2007 Andrea Rossato and Spencer Janssen hunk ./XMonad/Util/Font.cpphs 51 --- See Tabbed or Prompt for usage examples +-- See "Xmonad.Layout.Tabbed" or "XMonad.Prompt" for usage examples hunk ./XMonad/Prompt/Directory.hs 6 --- +-- hunk ./XMonad/Prompt/Layout.hs 6 --- +-- hunk ./XMonad/Prompt/Layout.hs 30 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Prompt/Layout.hs 36 - +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". +-- hunk ./XMonad/Prompt/Man.hs 43 --- 1. In Config.hs add: +-- 1. In your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Prompt/Man.hs 51 - --- %import XMonad.Prompt --- %import XMonad.Prompt.Man --- %keybind , ((modMask x, xK_F1), manPrompt defaultXPConfig) +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Prompt/Shell.hs 35 --- --- 1. In Config.hs add: +-- 1. In your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Prompt/Shell.hs 44 - --- %import XMonad.Prompt --- %import XMonad.Prompt.Shell --- %keybind , ((modMask x .|. controlMask, xK_x), shellPrompt defaultXPConfig) +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Prompt/Ssh.hs 33 --- 1. In Config.hs add: +-- 1. In your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Prompt/Ssh.hs 42 - --- %import XMonad.Prompt --- %import XMonad.Prompt.Ssh --- %keybind , ((modMask x .|. controlMask, xK_s), sshPrompt defaultXPConfig) +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Prompt/Window.hs 20 - -- $usage + -- $usage hunk ./XMonad/Prompt/Window.hs 39 --- Place in your Config.hs: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Prompt/Window.hs 48 - --- %import XMonad.Prompt --- %import XMonad.Prompt.Window --- %keybind , ((modMask x .|. shiftMask, xK_g ), windowPromptGoto defaultXPConfig) --- %keybind , ((modMask x .|. shiftMask, xK_b ), windowPromptBring defaultXPConfig) - +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Prompt/Window.hs 53 -instance XPrompt WindowPrompt where +instance XPrompt WindowPrompt where hunk ./XMonad/Prompt/Window.hs 66 - Goto -> return . gotoAction =<< windowMapWith (W.tag . fst) + Goto -> return . gotoAction =<< windowMapWith (W.tag . fst) hunk ./XMonad/Prompt/Window.hs 73 - winAction a m = flip whenJust (windows . a) . flip M.lookup m . unescape + winAction a m = flip whenJust (windows . a) . flip M.lookup m . unescape hunk ./XMonad/Prompt/Workspace.hs 6 --- +-- hunk ./XMonad/Prompt/Workspace.hs 28 --- You can use this module with the following in your Config.hs file: --- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- hunk ./XMonad/Prompt/Workspace.hs 34 +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Prompt/XMonad.hs 6 --- +-- hunk ./XMonad/Prompt/XMonad.hs 27 --- --- in Config.hs add: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Prompt/XMonad.hs 36 - --- %import XMonad.Prompt --- %import XMonad.Prompt.XMonad --- %keybind , ((modMask x .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Prompt/XMonad.hs 49 --- xmonad prompt with custom command list +-- | An xmonad prompt with a custom command list hunk ./XMonad/Layout/Accordion.hs 29 +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- hunk ./XMonad/Layout/Accordion.hs 32 --- > layouts = [ Layout Accordion ] - --- %import XMonad.Layout.Accordion --- %layout , Layout Accordion +-- +-- Then edit your @layoutHook@ by adding the Accordion layout: +-- +-- > myLayouts = Accordion ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/Circle.hs 29 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/Circle.hs 32 --- > layouts = [ Layout Circle ] - --- %import XMonad.Layout.Circle +-- +-- Then edit your @layoutHook@ by adding the Circle layout: +-- +-- > myLayouts = Circle ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/Combo.hs 33 --- --- To use this layout write, in your Config.hs: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/Combo.hs 42 - --- combineTwo is a new simple layout combinator. It allows the combination --- of two layouts using a third to split the screen between the two, but --- has the advantage of allowing you to dynamically adjust the layout, in --- terms of the number of windows in each sublayout. To do this, use --- WindowNavigation, and add the following key bindings (or something --- similar): - +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- combineTwo is a new simple layout combinator. It allows the +-- combination of two layouts using a third to split the screen +-- between the two, but has the advantage of allowing you to +-- dynamically adjust the layout, in terms of the number of windows in +-- each sublayout. To do this, use "XMonad.Layout.WindowNavigation", +-- and add the following key bindings (or something similar): +-- hunk ./XMonad/Layout/Combo.hs 58 - +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". +-- hunk ./XMonad/Layout/Combo.hs 63 --- up/down/left/right of its current position. Note that there is some +-- up\/down\/left\/right of its current position. Note that there is some hunk ./XMonad/Layout/Combo.hs 67 --- lobby for hierarchical stacks in core xmonad or go reim:lement the core of +-- lobby for hierarchical stacks in core xmonad or go reimplement the core of hunk ./XMonad/Layout/Combo.hs 70 --- %import XMonad.Layout.Combo --- %layout , combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) - hunk ./XMonad/Layout/Dishes.hs 32 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/Dishes.hs 36 --- and add the following line to your 'layouts' +-- Then edit your @layoutHook@ by adding the Dishes layout: hunk ./XMonad/Layout/Dishes.hs 38 --- > , Layout $ Dishes 2 (1%6) - --- %import XMonad.Layout.Dishes --- %layout , Layout $ Dishes 2 (1%6) +-- > myLayouts = Dishes 2 (1/6) ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/DragPane.hs 44 --- --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/DragPane.hs 48 --- and add, to the list of layouts: +-- Then edit your @layoutHook@ by adding the DragPane layout: +-- +-- > myLayouts = dragPane Horizontal 0.1 0.5 ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: hunk ./XMonad/Layout/DragPane.hs 55 --- > Layout $ dragPane Horizontal 0.1 0.5 +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/Grid.hs 28 --- Put the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/Grid.hs 31 --- > ... --- > layouts = [ ... --- > , Layout Grid --- > ] - --- %import XMonad.Layout.Grid --- %layout , Layout Grid +-- +-- Then edit your @layoutHook@ by adding the Grid layout: +-- +-- > myLayouts = Grid ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/HintedTile.hs 38 --- > mylayout = tall 1 0.1 0.5 ||| Full ||| etc.. --- > main = xmonad dafaultConfig { layoutHook = mylayouts } +-- > myLayouts = tall 1 0.1 0.5 ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } hunk ./XMonad/Layout/HintedTile.hs 42 +-- hunk ./XMonad/Layout/Tabbed.hs 43 --- You can use this module with the following in your configuration file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/Tabbed.hs 49 --- > mylayout = tabbed shrinkText defaultTConf ||| Full ||| etc.. --- > main = xmonad dafaultConfig { layoutHook = mylayouts } +-- > myLayouts = tabbed shrinkText defaultTConf ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } hunk ./XMonad/Layout/Tabbed.hs 53 +-- hunk ./README 27 -Documentation for the extensions and configuration system is available in -Documentation.hs (a haddock source file). +Documentation for the extensions and configuration system is available +in Haddock form in the XMonad.Doc module and submodules. hunk ./XMonad/Doc/Configuring.hs 11 --- This is a brief tutorial that will teach you how to quickly write a --- basic and simple xmonad configuration and cutomization. +-- This is a brief tutorial that will teach you how to create a +-- basic xmonad configuration. hunk ./XMonad/Doc/Configuring.hs 15 --- xmonad-contrib library see "XMonad.Doc.Extending" +-- xmonad-contrib library, see "XMonad.Doc.Extending". hunk ./XMonad/Doc/Configuring.hs 33 - -- * Where are the defaults? - -- $where hunk ./XMonad/Doc/Configuring.hs 94 -in the file: +in the "XMonad.Config" module of the core xmonad library. hunk ./XMonad/Doc/Configuring.hs 96 -> XMonad/Config.hs +However, note that (unlike previous versions of xmonad) you should not +edit Config.hs itself. hunk ./XMonad/Doc/Configuring.hs 99 -However, note that you should not edit Config.hs itself. +To see what fields can be customized beyond the ones in the example +above, the definition of the 'XMonad.Core.XConfig' data structure can +be found in "XMonad.Core". hunk ./XMonad/Doc/Configuring.hs 122 +Note, however, that if you skip this step and try restarting xmonad +with errors in your xmonad.hs, it's not the end of the world; xmonad +will simply display a window showing the errors and continue with the +previous configuration settings. + hunk ./XMonad/Doc/Configuring.hs 149 --} - -{- $where -#Where_are_the_defaults?# - -The default configuration values are defined in the source file: - -> XMonad/Config.hs - -the 'XMonad.Core.XConfig' data structure itself is defined in: - -> XMonad/Core.hs - -See "XMonad.Core". - hunk ./XMonad/Doc/Extending.hs 11 --- This is a module for documenting the xmonad-contrib library and --- describing how to use it to extend xmonad capabilities. +-- This module documents the xmonad-contrib library and +-- how to use it to extend the capabilities of xmonad. hunk ./XMonad/Doc/Extending.hs 14 --- While it should not require a deep knowledge of Haskell. this --- document is intended also for the more advanced users, which --- requires a reference to some features of Haskell. Still we hope the --- examples may be useful also for those users who do not Haskell and --- do not want to start learning it. +-- Reading this document should not require a deep knowledge of +-- Haskell; the examples are intended to be useful and understandable +-- for those users who do not know Haskell and don't want to have to +-- learn it just to configure xmonad. You should be able to get by +-- just fine by ignoring anything you don't understand and using the +-- provided examples as templates. However, relevant Haskell features +-- are discussed when appropriate, so this document will hopefully be +-- useful for more advanced Haskell users as well. hunk ./XMonad/Doc/Extending.hs 23 --- More configuration examples may be fond on the Haskell wiki at this --- address: +-- Those wishing to be totally hardcore and develop their own xmonad +-- extensions (it's easier than it sounds, we promise!) should read +-- the documentation in "XMonad.Doc.Developing". +-- +-- More configuration examples may be found on the Haskell wiki: hunk ./XMonad/Doc/Extending.hs 97 -This is a short overview of the xmonad-contrib modules. For more -information about any particular module, just click on its name to -view its Haddock documentation; each module should come with extensive -documentation. If you find a module that could be better documented, -or has incorrect documentation, please report it as a bug +This is a concise yet complete overview of the xmonad-contrib modules. +For more information about any particular module, just click on its +name to view its Haddock documentation; each module should come with +extensive documentation. If you find a module that could be better +documented, or has incorrect documentation, please report it as a bug hunk ./XMonad/Doc/Extending.hs 181 +* "XMonad.Config.Arossato" + +* "XMonad.Config.Dons" + +* "XMonad.Config.Droundy" + +* "XMonad.Config.Sjanssen" + hunk ./XMonad/Doc/Extending.hs 193 -In the @XMonad.Hooks@ namespace you can find modules exporting hooks. - -Hooks are actions that xmonad performs when some events occur. The two -most important hooks are: +In the @XMonad.Hooks@ namespace you can find modules exporting +hooks. Hooks are actions that xmonad performs when certain events +occur. The two most important hooks are: hunk ./XMonad/Doc/Extending.hs 199 - since it let us look at the new window's properties and act + since it lets us examine the new window's properties and act hunk ./XMonad/Doc/Extending.hs 204 - customizing the 'XMonad.Core.manageHook'. + customizing 'XMonad.Core.manageHook'. hunk ./XMonad/Doc/Extending.hs 211 - to display some information about the xmonad state in a Status Bar. + to display some information about the xmonad state in a status bar. hunk ./XMonad/Doc/Extending.hs 215 +Here is a list of the modules found in @XMonad.Hooks@: + +* "XMonad.Hooks.DynamicLog": for use with 'XMonad.Core.logHook'; send + information about xmonad's state to standard output, suitable for + putting in a status bar of some sort. See + "XMonad.Doc.Extending#The_log_hook_and_external_status_bars". + +* "XMonad.Hooks.EwmhDesktops": support for pagers in panel applications. + +* "XMonad.Hooks.ManageDocks": handle DOCK and STRUT windows appropriately. + +* "XMonad.Hooks.SetWMName": set the WM name. Useful when e.g. running + Java GUI programs. + +* "XMonad.Hooks.UrgencyHook": configure an action to occur when a window + sets the urgent flag. + +* "XMonad.Hooks.XPropManage": match on XProperties in your + 'XMonad.Core.manageHook'. + hunk ./XMonad/Doc/Extending.hs 239 -In the @XMonad.Layout@ name space you can find modules exporting -contributed tiling algorithms, such as a tabbed layout, a circle and a -three columns ones, etc. +In the @XMonad.Layout@ namespace you can find modules exporting +contributed tiling algorithms, such as a tabbed layout, a circle, a spiral, +three columns, and so on. hunk ./XMonad/Doc/Extending.hs 243 -Other modules provide facilities for combining different layouts, such -as "XMonad.Layout.Combo", or a complete set of layout combinators, -like "XMonad.Layout.LayoutCombinators" +You will also find modules which provide facilities for combining +different layouts, such as "XMonad.Layout.Combo", or +"XMonad.Layout.LayoutCombinators". hunk ./XMonad/Doc/Extending.hs 254 +* "XMonad.Layout.Accordion": put non-focused windows in ribbons at the + top and bottom of the screen. + +* "XMonad.Layout.Circle": an elliptical, overlapping layout. + +* "XMonad.Layout.Combo": combine multiple layouts into one. + +* "XMonad.Layout.Dishes": stack extra windows underneath the master windows. + +* "XMonad.Layout.DragPane": split the screen into two windows with a + draggable divider. + +* "XMonad.Layout.Grid": put windows in a square grid. + +* "XMonad.Layout.LayoutCombinators": general layout combining. + +* "XMonad.Layout.LayoutHints": make layouts respect window size hints. + +* "XMonad.Layout.LayoutModifier": a general framework for creating + layout \"modifiers\"; useful for creating new layout modules. + +* "XMonad.Layout.LayoutScreens": divide the screen into multiple + virtual \"screens\". + +* "XMonad.Layout.MagicFocus": automagically put the focused window in + the master area. + +* "XMonad.Layout.Maximize": temporarily maximize the focused window. + +* "XMonad.Layout.MosaicAlt": give each window a specified relative + amount of screen space. + +* "XMonad.Layout.MultiToggle": dynamically apply and unapply layout + transformers. + +* "XMonad.Layout.Named": change the names of layouts (as reported by + e.g. "XMonad.Hooks.DynamicLog"). + +* "XMonad.Layout.NoBorders": display windows without borders. + +* "XMonad.Layout.PerWorkspace": configure layouts on a per-workspace basis. + +* "XMonad.Layout.ResizableTile": tiled layout allowing you to change + width and height of windows. + +* "XMonad.Layout.Roledex": a \"completely pointless layout which acts + like Microsoft's Flip 3D\". + +* "XMonad.Layout.Spiral": Fibonacci spiral layout. + +* "XMonad.Layout.Square": split the screen into a square area plus the rest. + +* "XMonad.Layout.Tabbed": a tabbed layout. + +* "XMonad.Layout.ThreeColumns": a layout with three columns instead of two. + +* "XMonad.Layout.TilePrime": fill gaps created by resize hints. + +* "XMonad.Layout.ToggleLayouts": toggle between two layouts. + +* "XMonad.Layout.TwoPane": split the screen horizontally and show two + windows. + +* "XMonad.Layout.WindowNavigation": navigate around a workspace + directionally instead of using mod-j\/k. + +* "XMonad.Layout.WorkspaceDir": set the current working directory in a + workspace. hunk ./XMonad/Doc/Extending.hs 327 -In the @XMonad.Prompt@ name space you can find modules exporting -graphical prompts for getting user input and performing, with it, -different actions. +In the @XMonad.Prompt@ name space you can find modules providing +graphical prompts for getting user input and using it to perform +various actions. hunk ./XMonad/Doc/Extending.hs 331 -"XMonad.Prompt" provides a library for easily writing prompts. +The "XMonad.Prompt" provides a library for easily writing new prompt +modules. hunk ./XMonad/Doc/Extending.hs 353 -"XMonad.Doc.Extending#Editing_key_bindings" on how to configure xmonad to use -some prompts. The give examples include adding some prompts. +"XMonad.Doc.Extending#Editing_key_bindings", which includes examples +of adding some prompts. hunk ./XMonad/Doc/Extending.hs 414 -Remember that this definition requires importing "Graphics.X11.Xlib", -"XMonad.Prompt", "XMonad.Prompt.Shell", and "XMonad.Prompt.XMonad" +This particular definition also requires importing "Graphics.X11.Xlib" +(for the symbols such as @xK_F12@), "XMonad.Prompt", +"XMonad.Prompt.Shell", and "XMonad.Prompt.XMonad": + +> import Graphics.X11.Xlib +> import ... hunk ./XMonad/Doc.hs 12 --- library. +-- library. It provides a brief overview of xmonad and a link to +-- documentation for configuring and extending xmonad. hunk ./XMonad/Doc.hs 15 --- The module provides a brief overview of xmonad and a link to the --- documentation for configuring and extending your xmonad window --- manager. --- --- A link to the module describing xmonad internals is also provided. --- This module is mainly dedicated to those wanting to contribute code --- for this library and for the curious ones, who want to know what's --- going on behind the scene. +-- A link to documentation describing xmonad internals is also provided. +-- This module is mainly intended for those wanting to contribute code, +-- or for those who are curious to know what's going on behind the scenes. hunk ./XMonad/Doc.hs 49 -xmonad is a tiling window manager for X. This library collects third -party tiling algorithms, hooks, configurations and scripts to xmonad. -The source for this library is available via darcs get - +xmonad is a tiling window manager for X. The xmonad-contrib library +collects third party tiling algorithms, hooks, configurations, +scripts, and other extensions to xmonad. The source for this library +is available from via darcs: + +> darcs get http://code.haskell.org/XMonadContrib hunk ./XMonad/Doc.hs 56 -Each stable release of xmonad comes with a stable release of the -contrib library too, which should be used if you're using the stable -release. You can find the tarball here -() (Oct 2007) +Each stable release of xmonad is accompanied by a stable release of +the contrib library, which you should use if (and only if) you're +using a stable release of xmonad. You can find the most recent +(Oct. 2007) tarball here: +. hunk ./XMonad/Doc.hs 66 -"XMonad.Doc.Configuring" is dedicated at configuring xmonad. A brief -tutorial will guide you through the basic configuration steps. +"XMonad.Doc.Configuring" documents the process of configuring +xmonad. A brief tutorial will guide you through the basic +configuration steps. hunk ./XMonad/Doc.hs 74 -"XMonad.Doc.Extending" is dedicated at extending xmonad with the -xmonad-contrib library. You will find an overview of the library and -instruction on installing contributed extensions. +"XMonad.Doc.Extending" is dedicated to the xmonad-contrib library +itself. You will find an overview of extensions available in the +library and instructions for using them. hunk ./XMonad/Doc.hs 83 -internals. It is mainly intended for contributors and basically -provides a brief code commentary with link to the source code -documentation. +internals. It is mainly intended for contributors and provides a +brief code commentary with links to the source documentation. hunk ./XMonad/Doc/Extending.hs 403 -record of the 'XMonad.Core.XConfig' data type, like: +field of the 'XMonad.Core.XConfig' record used by xmonad. For +example, you could write: hunk ./XMonad/Doc/Extending.hs 406 -> main = xmonad defaultConfig { keys = myKeys } +> main = xmonad $ defaultConfig { keys = myKeys } hunk ./XMonad/Doc/Extending.hs 408 -and providing a proper definition of @myKeys@ such as: +and provide an appropriate definition of @myKeys@, such as: hunk ./XMonad/Doc/Extending.hs 420 -> import ... +> import ... -- and so on hunk ./XMonad/Doc/Extending.hs 422 -Sometimes, more than completely redefining the key bindings, as we did -above, we may want to add some new bindings, or\/and remove existing +Usually, rather than completely redefining the key bindings, as we did +above, we want to simply add some new bindings and\/or remove existing hunk ./XMonad/Doc/Extending.hs 432 -of "XMonad.Core.XConfig.keys" is: +of 'XMonad.Core.XConfig.keys' is: hunk ./XMonad/Doc/Extending.hs 436 -which means thatm in order to add new bindings you need to create a -'Data.Map.Map' from the list of your new key bindings, you can do that -with 'Data.Map.fromList', and then join this newly created map with -the one of the existing bindings. This can be done with +In order to add new key bindings, you need to first create an +appropriate 'Data.Map.Map' from a list of key bindings using +'Data.Map.fromList'. This 'Data.Map.Map' of new key bindings then +needs to be joined to a 'Data.Map.Map' of existing bindings using hunk ./XMonad/Doc/Extending.hs 450 -then you create a new key bindings map by joining the default one with -yours: +then you can create a new key bindings map by joining the default one +with yours: hunk ./XMonad/Doc/Extending.hs 455 -Finally you need to update accordingly the default configuration -'XMonad.Core.XConfig.keys' record: +Finally, you can use @newKeys@ in the 'XMonad.Core.XConfig.keys' field +of the configuration: hunk ./XMonad/Doc/Extending.hs 458 -> main = xmonad defaultConfig { keys = newKeys } +> main = xmonad $ defaultConfig { keys = newKeys } hunk ./XMonad/Doc/Extending.hs 460 - -And that's it. - -At the end your @~\/.xmonad\/xmonad.hs@ would look like this: +All together, your @~\/.xmonad\/xmonad.hs@ would now look like this: hunk ./XMonad/Doc/Extending.hs 474 -> main = xmonad defaultConfig { keys = newKeys } +> main = xmonad $ defaultConfig { keys = newKeys } hunk ./XMonad/Doc/Extending.hs 484 -Obviously there are other ways of defining @newKeys@. For instance, +There are other ways of defining @newKeys@; for instance, hunk ./XMonad/Doc/Extending.hs 489 -An even simpler way to add new key bindings is the use of some of the -utilities provided by the xmonad-contrib library. For instance, +However, the simplest way to add new key bindings is to use some +utilities provided by the xmonad-contrib library. For instance, hunk ./XMonad/Doc/Extending.hs 492 -useful functions for editing your key bindings. Look, for instance, at +useful functions for editing your key bindings. Look, for instance, at hunk ./XMonad/Doc/Extending.hs 500 -Removing key bindings requires modifying the binding 'Data.Map.Map'. -This can be done with 'Data.Map.difference' or with 'Data.Map.delete'. +Removing key bindings requires modifying the 'Data.Map.Map' which +stores the key bindings. This can be done with 'Data.Map.difference' +or with 'Data.Map.delete'. hunk ./XMonad/Doc/Extending.hs 504 -Suppose you wan to get rid of @mod-q@ and @mod-shift-q@. To do this -you just need to define a @newKeys@ as a 'Data.Map.difference' between -the default map and the map of the key bindings you want to remove. +For example, suppose you want to get rid of @mod-q@ and @mod-shift-q@ +(you just want to leave xmonad running forever). To do this you need +to define @newKeys@ as a 'Data.Map.difference' between the default +map and the map of the key bindings you want to remove. Like so: hunk ./XMonad/Doc/Extending.hs 517 -As you may see we do not need to define an action for the key bindings -we want to get rid of. We just build a map of keys to remove. +As you can see, it doesn't matter what actions we associate with the +keys listed in @keysToRemove@, so we just use @return ()@ (the +\"null\" action). hunk ./XMonad/Doc/Extending.hs 521 -It is also possible to define a list of key bindings and then use -'Data.Map.delete' to remove them from the default key bindings, in -which case we should write something like: +It is also possible to simply define a list of keys we want to unbind +and then use 'Data.Map.delete' to remove them. In that case we would +write something like: hunk ./XMonad/Doc/Extending.hs 542 -Adding and removing key bindings requires to compose the action of -removing and, after that, the action of adding. - -This is an example you may find in "XMonad.Config.Arossato": - +Adding and removing key bindings requires simply combining the steps +for removing and adding. Here is an example from +"XMonad.Config.Arossato": hunk ./XMonad/Doc/Extending.hs 571 -You can achieve the same result by using "XMonad.Util.CustomKeys" and, -specifically, 'XMonad.Util.CustomKeys.customKeys'. +You can achieve the same result using the "XMonad.Util.CustomKeys" +module; take a look at the 'XMonad.Util.CustomKeys.customKeys' +function in particular. hunk ./XMonad/Doc/Extending.hs 586 -you can change them, xmonad needs to know which one to pick up. In -this sense the layoutHook may be thought as the combination, or the -list, of layouts that xmonad will use for ordering windows on the -screen(s) +you can change them, xmonad needs to know which one to use. In this +sense the layoutHook may be thought as the list of layouts that +xmonad will use for laying out windows on the screen(s). hunk ./XMonad/Doc/Extending.hs 593 -existing layouts, have some of them with a state, etc. See -"XMonad.Doc.Extending#The_LayoutClass" for more information. - -The price we have to pay to get all that for free - which is something -that makes xmonad so powerful with such a ridiculously low number of -lines - is that we cannot simply have a list of layouts as we used to -have before the 0.5 release: a list requires every member to belong to -the same type! +existing layouts, create layouts with internal state, etc. See +"XMonad.Doc.Extending#The_LayoutClass" for more information. This +means that we cannot simply have a list of layouts as we used to have +before the 0.5 release: a list requires every member to belong to the +same type! hunk ./XMonad/Doc/Extending.hs 600 -with a specific layout combinator: 'XMonad.Layouts.|||' +with a specific layout combinator: 'XMonad.Layouts.|||'. hunk ./XMonad/Doc/Extending.hs 602 -Suppose we want a list with the 'XMonad.Layouts.Full', the -'XMonad.Layout.Tabbed.tabbed' and the +Suppose we want a list with the 'XMonad.Layouts.Full', +'XMonad.Layout.Tabbed.tabbed' and hunk ./XMonad/Doc/Extending.hs 605 -@~\/.xmonad\/xmonad.hs@, all the needed module: +@~\/.xmonad\/xmonad.hs@, all the needed modules: hunk ./XMonad/Doc/Extending.hs 618 -Now, all we need to do is to change the 'XMonad.Core.layoutHook' -record of the 'XMonad.Core.XConfig' data type, like: +Now, all we need to do is change the 'XMonad.Core.layoutHook' +field of the 'XMonad.Core.XConfig' record, like so: hunk ./XMonad/Doc/Extending.hs 621 -> main = xmonad defaultConfig { layoutHook = mylayoutHook } +> main = xmonad $ defaultConfig { layoutHook = mylayoutHook } hunk ./XMonad/Doc/Extending.hs 623 -Thanks to the new combinator we can apply a layout modifier to the -combination of layouts, instead of applying it to each one. Suppose we -want to use the 'XMonad.Layout.NoBorders.noBorders' layout modifier, -from the "XMonad.Layout.NoBorders" module (which must be imported): +Thanks to the new combinator, we can apply a layout modifier to a +whole combination of layouts, instead of applying it to each one. For +example, suppose we want to use the +'XMonad.Layout.NoBorders.noBorders' layout modifier, from the +"XMonad.Layout.NoBorders" module (which must be imported): hunk ./XMonad/Doc/Extending.hs 631 -Obviously, if we want only the tabbed layout without borders, then we -may write: +If we want only the tabbed layout without borders, then we may write: hunk ./XMonad/Doc/Extending.hs 645 -> main = xmonad defaultConfig { layoutHook = mylayoutHook } +> main = xmonad $ defaultConfig { layoutHook = mylayoutHook } hunk ./XMonad/Hooks/DynamicLog.hs 78 --- it taken from the dynamicLogWithPP hook. +-- is taken from the dynamicLogWithPP hook. hunk ./XMonad/Layout/HintedTile.hs 21 - tall, wide ) where + HintedTile(..), Orientation(..)) where hunk ./XMonad/Layout/HintedTile.hs 38 --- > myLayouts = tall 1 0.1 0.5 ||| Full ||| etc.. +-- > myLayouts = HintedTile 1 0.1 0.5 Tall ||| Full ||| etc.. hunk ./XMonad/Layout/HintedTile.hs 45 -data HintedTile a = - HT { nmaster :: Int - , delta, frac :: Rational - , orientation :: Orientation - } deriving ( Show, Read ) +data HintedTile a = HintedTile + { nmaster :: Int + , delta, frac :: Rational + , orientation :: Orientation + } deriving ( Show, Read ) hunk ./XMonad/Layout/HintedTile.hs 53 -tall, wide :: Int -> Rational -> Rational -> HintedTile Window -wide n d f = HT {nmaster = n, delta = d, frac = f, orientation = Tall } -tall n d f = HT {nmaster = n, delta = d, frac = f, orientation = Wide } - hunk ./XMonad/Layout/HintedTile.hs 62 - Wide -> (splitHorizontally, divideHorizontally) - Tall -> (splitVertically, divideVertically ) + Tall -> (splitHorizontally, divideVertically) + Wide -> (splitVertically, divideHorizontally) hunk ./XMonad/Layout/HintedTile.hs 24 -import XMonad.Layouts ( Resize(..), IncMasterN(..) ) -import XMonad.Operations ( applySizeHints ) +import XMonad.Layouts (Resize(..), IncMasterN(..)) +import XMonad.Operations (applySizeHints, D) hunk ./XMonad/Layout/HintedTile.hs 29 +import Control.Applicative ((<$>)) hunk ./XMonad/Layout/HintedTile.hs 55 - doLayout c rect w' = let w = W.integrate w' - in do { hints <- sequence (map getHints w) - ; b <- asks (borderWidth . config) - ; return (zip w (tiler b (frac c) rect `uncurry` splitAt (nmaster c) hints) - , Nothing) } - where - (split, divide) = - case orientation c of - Tall -> (splitHorizontally, divideVertically) - Wide -> (splitVertically, divideHorizontally) - tiler b f r masters slaves = - if null masters || null slaves - then divide b (masters ++ slaves) r - else split f r (divide b masters) (divide b slaves) + doLayout c rect w' = do + bhs <- mapM getHints w + let (masters, slaves) = splitAt (nmaster c) bhs + return (zip w (tiler (frac c) rect masters slaves), Nothing) + where + w = W.integrate w' + (split, divide) = case orientation c of + Tall -> (splitHorizontally, divideVertically) + Wide -> (splitVertically, divideHorizontally) + tiler f r masters slaves + | null masters || null slaves = divide (masters ++ slaves) r + | otherwise = split f r (divide masters) (divide slaves) hunk ./XMonad/Layout/HintedTile.hs 70 - where - resize Shrink = c { frac = max 0 $ frac c - delta c } - resize Expand = c { frac = min 1 $ frac c + delta c } - incmastern (IncMasterN d) = c { nmaster = max 0 $ nmaster c + d } + where + resize Shrink = c { frac = max 0 $ frac c - delta c } + resize Expand = c { frac = min 1 $ frac c + delta c } + incmastern (IncMasterN d) = c { nmaster = max 0 $ nmaster c + d } hunk ./XMonad/Layout/HintedTile.hs 77 -addBorder, substractBorder :: Dimension -> (Dimension, Dimension) -> (Dimension, Dimension) -addBorder b (w, h) = (w + 2 * b, h + 2 * b) -substractBorder b (w, h) = (w - 2 * b, h - 2 * b) +adjBorder :: Dimension -> Dimension -> D -> D +adjBorder n b (w, h) = (w + n * 2 * b, h + n * 2 * b) hunk ./XMonad/Layout/HintedTile.hs 80 -getHints :: Window -> X SizeHints -getHints w = withDisplay $ \d -> io $ getWMNormalHints d w +-- | Transform a function on dimensions into one without regard for borders +hintsUnderBorder :: (Dimension, SizeHints) -> D -> D +hintsUnderBorder (bW, h) = adjBorder bW 1 . applySizeHints h . adjBorder bW (-1) + +getHints :: Window -> X (Dimension, SizeHints) +getHints w = withDisplay $ \d -> io $ liftM2 (,) + (fromIntegral . wa_border_width <$> getWindowAttributes d w) + (getWMNormalHints d w) hunk ./XMonad/Layout/HintedTile.hs 90 -divideVertically, divideHorizontally :: Dimension -> [SizeHints] -> Rectangle -> [Rectangle] -divideVertically _ [] _ = [] -- there's a fold here, struggling to get out -divideVertically b (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : - (divideVertically b rest (Rectangle sx (sy + fromIntegral h) sw (sh - h))) - where (w, h) = addBorder b $ applySizeHints hints $ substractBorder b - (sw, sh `div` fromIntegral (1 + (length rest))) +divideVertically, divideHorizontally :: [(Dimension, SizeHints)] -> Rectangle -> [Rectangle] +divideVertically [] _ = [] -- there's a fold here, struggling to get out +divideVertically (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : + (divideVertically bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h))) + where (w, h) = hintsUnderBorder bh (sw, sh `div` fromIntegral (1 + (length bhs))) hunk ./XMonad/Layout/HintedTile.hs 96 -divideHorizontally _ [] _ = [] -divideHorizontally b (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : - (divideHorizontally b rest (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) - where (w, h) = addBorder b $ applySizeHints hints $ substractBorder b - (sw `div` fromIntegral (1 + (length rest)), sh) +divideHorizontally [] _ = [] +divideHorizontally (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : + (divideHorizontally bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) + where + (w, h) = hintsUnderBorder bh (sw `div` fromIntegral (1 + (length bhs)), sh) hunk ./XMonad/Layout/HintedTile.hs 103 -splitHorizontally, splitVertically :: Rational -> Rectangle -> (Rectangle -> [Rectangle]) -> (Rectangle -> [Rectangle]) -> [Rectangle] +splitHorizontally, splitVertically :: Rational -> Rectangle -> (Rectangle -> [Rectangle]) + -> (Rectangle -> [Rectangle]) -> [Rectangle] hunk ./XMonad/Layout/HintedTile.hs 106 - where leftw = floor $ fromIntegral sw * f - leftRects = left $ Rectangle sx sy leftw sh - rightx = (maximum . map rect_width) leftRects - rightRects = right $ Rectangle (sx + fromIntegral rightx) sy (sw - rightx) sh + where + leftw = floor $ fromIntegral sw * f + leftRects = left $ Rectangle sx sy leftw sh + rightx = (maximum . map rect_width) leftRects + rightRects = right $ Rectangle (sx + fromIntegral rightx) sy (sw - rightx) sh hunk ./XMonad/Layout/HintedTile.hs 113 - where toph = floor $ fromIntegral sh * f - topRects = top $ Rectangle sx sy sw toph - bottomy = (maximum . map rect_height) topRects - bottomRects = bottom $ Rectangle sx (sy + fromIntegral bottomy) sw (sh - bottomy) + where + toph = floor $ fromIntegral sh * f + topRects = top $ Rectangle sx sy sw toph + bottomy = (maximum . map rect_height) topRects + bottomRects = bottom $ Rectangle sx (sy + fromIntegral bottomy) sw (sh - bottomy) hunk ./XMonad/Layout/HintedTile.hs 55 - doLayout c rect w' = do + doLayout (HintedTile { orientation = o, nmaster = nm, frac = f }) r w' = do hunk ./XMonad/Layout/HintedTile.hs 57 - let (masters, slaves) = splitAt (nmaster c) bhs - return (zip w (tiler (frac c) rect masters slaves), Nothing) + let (masters, slaves) = splitAt nm bhs + return (zip w (tiler masters slaves), Nothing) hunk ./XMonad/Layout/HintedTile.hs 61 - (split, divide) = case orientation c of - Tall -> (splitHorizontally, divideVertically) - Wide -> (splitVertically, divideHorizontally) - tiler f r masters slaves - | null masters || null slaves = divide (masters ++ slaves) r - | otherwise = split f r (divide masters) (divide slaves) + tiler masters slaves + | null masters || null slaves = divide o (masters ++ slaves) r + | otherwise = split o f r (divide o masters) (divide o slaves) hunk ./XMonad/Layout/HintedTile.hs 87 -divideVertically, divideHorizontally :: [(Dimension, SizeHints)] -> Rectangle -> [Rectangle] -divideVertically [] _ = [] -- there's a fold here, struggling to get out -divideVertically (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : - (divideVertically bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h))) +divide :: Orientation -> [(Dimension, SizeHints)] -> Rectangle -> [Rectangle] +divide _ [] _ = [] +divide Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : + (divide Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h))) hunk ./XMonad/Layout/HintedTile.hs 93 -divideHorizontally [] _ = [] -divideHorizontally (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : - (divideHorizontally bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) +divide Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : + (divide Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) hunk ./XMonad/Layout/HintedTile.hs 99 -splitHorizontally, splitVertically :: Rational -> Rectangle -> (Rectangle -> [Rectangle]) - -> (Rectangle -> [Rectangle]) -> [Rectangle] -splitHorizontally f (Rectangle sx sy sw sh) left right = leftRects ++ rightRects +split :: Orientation -> Rational -> Rectangle -> (Rectangle -> [Rectangle]) + -> (Rectangle -> [Rectangle]) -> [Rectangle] +split Tall f (Rectangle sx sy sw sh) left right = leftRects ++ rightRects hunk ./XMonad/Layout/HintedTile.hs 108 -splitVertically f (Rectangle sx sy sw sh) top bottom = topRects ++ bottomRects +split Wide f (Rectangle sx sy sw sh) top bottom = topRects ++ bottomRects hunk ./XMonad/Hooks/XPropManage.hs 22 +import Data.Monoid (mconcat, Endo(..)) + +import Control.Monad.Reader hunk ./XMonad/Hooks/XPropManage.hs 26 -import Control.Monad.State hunk ./XMonad/Hooks/XPropManage.hs 30 +import XMonad.ManageHook ((-->)) hunk ./XMonad/Hooks/XPropManage.hs 70 -xPropManageHook :: [XPropMatch] -> Window -> X (WindowSet -> WindowSet) -xPropManageHook tms w = withDisplay $ \d -> do - fs <- mapM (matchProp d w `uncurry`) tms - return (foldr (.) id fs) - -matchProp :: Display -> Window -> [(Atom, [String] -> Bool)] -> (Window -> X (WindowSet -> WindowSet)) -> X (WindowSet -> WindowSet) -matchProp d w tm tf = do - m <- and `liftM` sequence (map (\(k,f) -> f `liftM` getProp d w k) tm) - case m of - True -> tf w - False -> return id +xPropManageHook :: [XPropMatch] -> ManageHook +xPropManageHook tms = mconcat $ map propToHook tms + where + propToHook (ms, f) = liftM and (mapM mkQuery ms) --> mkHook f + mkQuery (a, tf) = fmap tf (getQuery a) + mkHook func = ask >>= Query . lift . fmap Endo . func hunk ./XMonad/Hooks/XPropManage.hs 84 +getQuery :: Atom -> Query [String] +getQuery p = ask >>= \w -> Query . lift $ withDisplay $ \d -> getProp d w p + hunk ./XMonad/Hooks/XPropManage.hs 93 - hunk ./XMonad/Hooks/UrgencyHook.hs 14 --- your attention. (In traditional WMs, this takes the form of "flashing" --- on your "taskbar." Blech.) +-- your attention. (In traditional WMs, this takes the form of \"flashing\" +-- on your \"taskbar.\" Blech.) hunk ./XMonad/Hooks/UrgencyHook.hs 59 --- dzenUrgencyHook, or write your own. +-- 'dzenUrgencyHook', or write your own. hunk ./XMonad/Hooks/UrgencyHook.hs 62 --- withUrgencyHook. For example: +-- 'withUrgencyHook'. For example: hunk ./XMonad/Hooks/UrgencyHook.hs 68 --- the functions readUrgents and withUrgents are there to help you with that. +-- the functions 'readUrgents' and 'withUrgents' are there to help you with that. hunk ./XMonad/Hooks/UrgencyHook.hs 72 --- an action to your logHook that remove visible windows from the list of urgent --- windows. If you don't like that behavior, you may use urgencyLayoutHook instead. +-- an action to your logHook that removes visible windows from the list of urgent +-- windows. If you don't like that behavior, you may use 'urgencyLayoutHook' instead. hunk ./XMonad/Hooks/UrgencyHook.hs 80 --- | The logHook action used by withUrgencyHook. +-- | The logHook action used by 'withUrgencyHook'. hunk ./XMonad/Hooks/UrgencyHook.hs 94 --- @readUrgents@ or @withUrgents@ instead. +-- 'readUrgents' or 'withUrgents' instead. hunk ./XMonad/Hooks/UrgencyHook.hs 100 +-- | X action that returns a list of currently urgent windows. You might use +-- it, or 'withUrgents', in your custom logHook, to display the workspaces that +-- contain urgent windows. hunk ./XMonad/Hooks/UrgencyHook.hs 106 +-- | An HOF version of 'readUrgents', for those who prefer that sort of thing. hunk ./XMonad/Layout/HintedTile.hs 72 - description l = "HintedTile " ++ show (orientation l) + description l = show (orientation l) hunk ./XMonad/Prompt/Man.hs 7 --- Maintainer : valery.vv@gmail.com --- Stability : unstable --- Portability : non-portable (uses \"manpath\" and \"bash\") +-- Maintainer : Valery V. Vorotyntsev +-- Portability : non-portable (uses "manpath" and "bash") hunk ./XMonad/Prompt/Man.hs 17 --- * test with QuickCheck +-- * write QuickCheck properties hunk ./XMonad/Prompt/Man.hs 21 - -- * Usage - -- $usage - manPrompt - , getCommandOutput - ) where + -- * Usage + -- $usage + manPrompt + , getCommandOutput + ) where hunk ./XMonad/Prompt/Man.hs 82 --- XXX merge with 'Run.runProcessWithInput'? +-- XXX merge with 'XMonad.Util.Run.runProcessWithInput'? addfile ./XMonad/Layout/Mosaic.hs hunk ./XMonad/Layout/Mosaic.hs 1 +{-# OPTIONS -fglasgow-exts #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Mosaic +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- This module defines a \"mosaic\" layout, which tries to give each window a +-- user-configurable relative area, while also trying to give them aspect +-- ratios configurable at run-time by the user. +-- +----------------------------------------------------------------------------- +module XMonad.Layout.Mosaic ( + -- * Usage + -- $usage + mosaic, expandWindow, shrinkWindow, squareWindow, myclearWindow, + tallWindow, wideWindow, flexibleWindow, + getName, withNamedWindow ) where + +import Control.Monad.State ( State, put, get, runState ) +import System.Random ( StdGen, mkStdGen ) + +import Data.Ratio +import Graphics.X11.Xlib +import XMonad hiding ( trace ) +import XMonad.Layouts ( Resize(Shrink, Expand) ) +import qualified XMonad.StackSet as W +import qualified Data.Map as M +import Data.List ( sort ) +import Data.Typeable ( Typeable ) +import Control.Monad ( mplus ) + +import XMonad.Util.NamedWindows +import XMonad.Util.Anneal + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import qualified Data.Map as M +-- > import XMonad.Layout.Mosaic +-- > import XMonad.Operations +-- +-- Then edit your @layoutHook@ by adding the Mosaic layout: +-- +-- > myLayouts = mosaic 0.25 0.5 M.empty ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- In the key-bindings, do something like: +-- +-- > , ((controlMask .|. modMask x .|. shiftMask, xK_h), withNamedWindow (sendMessage . tallWindow)) +-- > , ((controlMask .|. modMask x .|. shiftMask, xK_l), withNamedWindow (sendMessage . wideWindow)) +-- > , ((modMask x .|. shiftMask, xK_h ), withNamedWindow (sendMessage . shrinkWindow)) +-- > , ((modMask x .|. shiftMask, xK_l ), withNamedWindow (sendMessage . expandWindow)) +-- > , ((modMask x .|. shiftMask, xK_s ), withNamedWindow (sendMessage . squareWindow)) +-- > , ((modMask x .|. shiftMask, xK_o ), withNamedWindow (sendMessage . myclearWindow)) +-- > , ((controlMask .|. modMask x .|. shiftMask, xK_o ), withNamedWindow (sendMessage . flexibleWindow)) +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data HandleWindow = ExpandWindow NamedWindow | ShrinkWindow NamedWindow + | SquareWindow NamedWindow | ClearWindow NamedWindow + | TallWindow NamedWindow | WideWindow NamedWindow + | FlexibleWindow NamedWindow + deriving ( Typeable, Eq ) + +instance Message HandleWindow + +expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: NamedWindow -> HandleWindow +expandWindow = ExpandWindow +shrinkWindow = ShrinkWindow +squareWindow = SquareWindow +flexibleWindow = FlexibleWindow +myclearWindow = ClearWindow +tallWindow = TallWindow +wideWindow = WideWindow + +largeNumber :: Int +largeNumber = 50 + +defaultArea :: Double +defaultArea = 1 + +flexibility :: Double +flexibility = 0.1 + +mosaic :: Double -> Double -> M.Map NamedWindow [WindowHint] -> MosaicLayout Window +mosaic d t h = Mosaic d t h + +data MosaicLayout a = Mosaic Double Double (M.Map NamedWindow [WindowHint]) + deriving ( Show, Read ) + +instance LayoutClass MosaicLayout Window where + doLayout (Mosaic _ t h) r w = mosaicL t h r (W.integrate w) + + pureMessage (Mosaic d t h) m = (m1 `fmap` fromMessage m) `mplus` (m2 `fmap` fromMessage m) + where + m1 Shrink = Mosaic d (t/(1+d)) h + m1 Expand = Mosaic d (t*(1+d)) h + m2 (ExpandWindow w) = Mosaic d t (multiply_area (1+d) w h) + m2 (ShrinkWindow w) = Mosaic d t (multiply_area (1/(1+ d)) w h) + m2 (SquareWindow w) = Mosaic d t (set_aspect_ratio 1 w h) + m2 (FlexibleWindow w) = Mosaic d t (make_flexible w h) + m2 (TallWindow w) = Mosaic d t (multiply_aspect (1/(1+d)) w h) + m2 (WideWindow w) = Mosaic d t (multiply_aspect (1+d) w h) + m2 (ClearWindow w) = Mosaic d t (M.delete w h) + + description _ = "The Original Mosaic" + +multiply_area :: Double -> NamedWindow + -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] +multiply_area a = alterlist f where f [] = [RelArea (defaultArea*a)] + f (RelArea a':xs) = RelArea (a'*a) : xs + f (x:xs) = x : f xs + +set_aspect_ratio :: Double -> NamedWindow + -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] +set_aspect_ratio r = alterlist f where f [] = [AspectRatio r] + f (FlexibleAspectRatio _:x) = AspectRatio r:x + f (AspectRatio _:x) = AspectRatio r:x + f (x:xs) = x:f xs + +make_flexible :: NamedWindow + -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] +make_flexible = alterlist (map f) where f (AspectRatio r) = FlexibleAspectRatio r + f (FlexibleAspectRatio r) = AspectRatio r + f x = x + +multiply_aspect :: Double -> NamedWindow + -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] +multiply_aspect r = alterlist f where f [] = [FlexibleAspectRatio r] + f (AspectRatio r':x) = AspectRatio (r*r'):x + f (FlexibleAspectRatio r':x) = FlexibleAspectRatio (r*r'):x + f (x:xs) = x:f xs + +findlist :: Ord k => k -> M.Map k [a] -> [a] +findlist = M.findWithDefault [] + +alterlist :: (Ord k, Ord a) => ([a] -> [a]) -> k -> M.Map k [a] -> M.Map k [a] +alterlist f k = M.alter f' k + where f' Nothing = f' (Just []) + f' (Just xs) = case f xs of + [] -> Nothing + xs' -> Just xs' + +mosaicL :: Double -> M.Map NamedWindow [WindowHint] + -> Rectangle -> [Window] -> X ([(Window, Rectangle)],Maybe (MosaicLayout Window)) +mosaicL _ _ _ [] = return ([], Nothing) +mosaicL f hints origRect origws + = do namedws <- mapM getName origws + let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) namedws + -- TODO: remove all this dead code + myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws + myv2 = mc_mosaic sortedws Vertical + myh2 = mc_mosaic sortedws Horizontal +-- myv2 = maxL $ runCountDown largeNumber $ +-- sequence $ replicate mediumNumber $ +-- mosaic_splits one_split origRect Vertical sortedws + myh = runCountDown largeNumber $ mosaic_splits even_split origRect Horizontal sortedws +-- myh2 = maxL $ runCountDown largeNumber $ +-- sequence $ replicate mediumNumber $ +-- mosaic_splits one_split origRect Horizontal sortedws + return (map (\(nw,r)->(--trace ("rate1:"++ unlines [show nw, + -- show $ rate f meanarea (findlist nw hints) r, + -- show r, + -- show $ area r/meanarea, + -- show $ findlist nw hints]) $ + unName nw,crop' (findlist nw hints) r)) $ + flattenMosaic $ the_value $ maxL [myh,myv,myh2,myv2], Nothing) + where mosaic_splits _ _ _ [] = return $ Rated 0 $ M [] + mosaic_splits _ r _ [w] = return $ Rated (rate f meanarea (findlist w hints) r) $ OM (w,r) + mosaic_splits spl r d ws = maxL `fmap` mapCD (spl r d) (init $ allsplits ws) + even_split :: Rectangle -> CutDirection -> [[NamedWindow]] + -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle))) + even_split r d [ws] = even_split r d $ map (:[]) ws + even_split r d wss = + do let areas = map sumareas wss + let wsr_s :: [([NamedWindow], Rectangle)] + wsr_s = zip wss (partitionR d r areas) + submosaics <- mapM (\(ws',r') -> + mosaic_splits even_split r' (otherDirection d) ws') wsr_s + return $ fmap M $ catRated submosaics + {- + another_mosaic :: [NamedWindow] -> CutDirection + -> Rated Double (Mosaic (NamedWindow,Rectangle)) + another_mosaic ws d = rate_mosaic ratew $ + rect_mosaic origRect d $ + zipML (example_mosaic ws) (map findarea ws) + -} + mc_mosaic :: [NamedWindow] -> CutDirection + -> Rated Double (Mosaic (NamedWindow,Rectangle)) + mc_mosaic ws d = fmap (rect_mosaic origRect d) $ + annealMax (zipML (example_mosaic ws) (map findarea ws)) + (the_rating . rate_mosaic ratew . rect_mosaic origRect d ) + changeMosaic + + ratew :: (NamedWindow,Rectangle) -> Double + ratew (w,r) = rate f meanarea (findlist w hints) r + example_mosaic :: [NamedWindow] -> Mosaic NamedWindow + example_mosaic ws = M (map OM ws) + rect_mosaic :: Rectangle -> CutDirection -> Mosaic (a,Double) -> Mosaic (a,Rectangle) + rect_mosaic r _ (OM (w,_)) = OM (w,r) + rect_mosaic r d (M ws) = M $ zipWith (\w' r' -> rect_mosaic r' d' w') ws rs + where areas = map (sum . map snd . flattenMosaic) ws + rs = partitionR d r areas + d' = otherDirection d + rate_mosaic :: ((NamedWindow,Rectangle) -> Double) + -> Mosaic (NamedWindow,Rectangle) -> Rated Double (Mosaic (NamedWindow,Rectangle)) + rate_mosaic r m = catRatedM $ fmap (\x -> Rated (r x) x) m +{- + one_split :: Rectangle -> CutDirection -> [[NamedWindow]] + -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle))) + one_split r d [ws] = one_split r d $ map (:[]) ws + one_split r d wss = + do rnd <- mapM (const (fractional resolutionNumber)) [1..length wss] + let wsr_s :: [([NamedWindow], Rectangle)] + wsr_s = zip wss (partitionR d r rnd) + submosaics <- mapM (\(ws',r') -> + mosaic_splits even_split r' (otherDirection d) ws') wsr_s + return $ fmap M $ catRated submosaics +-} + partitionR :: CutDirection -> Rectangle -> [Double] -> [Rectangle] + partitionR _ _ [] = [] + partitionR _ r [_] = [r] + partitionR d r (a:ars) = r1 : partitionR d r2 ars + where totarea = sum (a:ars) + (r1,r2) = split d (a/totarea) r + theareas = hints2area `fmap` hints + sumareas ws = sum $ map findarea ws + findarea :: NamedWindow -> Double + findarea w = M.findWithDefault 1 w theareas + meanarea = area origRect / fromIntegral (length origws) + +maxL :: Ord a => [a] -> a +maxL [] = error "maxL on empty list" +maxL [a] = a +maxL (a:b:c) = maxL (max a b:c) + +catRated :: Floating v => [Rated v a] -> Rated v [a] +catRated xs = Rated (product $ map the_rating xs) (map the_value xs) + +catRatedM :: Floating v => Mosaic (Rated v a) -> Rated v (Mosaic a) +catRatedM (OM (Rated v x)) = Rated v (OM x) +catRatedM (M xs) = case catRated $ map catRatedM xs of Rated v xs' -> Rated v (M xs') + +data CountDown = CD !StdGen !Int + +tries_left :: State CountDown Int +tries_left = do CD _ n <- get + return (max 0 n) + +mapCD :: (a -> State CountDown b) -> [a] -> State CountDown [b] +mapCD f xs = do n <- tries_left + let len = length xs + mapM (run_with_only ((n `div` len)+1) . f) $ take (n+1) xs + +run_with_only :: Int -> State CountDown a -> State CountDown a +run_with_only limit j = + do CD g n <- get + let leftover = n - limit + if leftover < 0 then j + else do put $ CD g limit + x <- j + CD g' n' <- get + put $ CD g' (leftover + n') + return x + +data WindowHint = RelArea Double + | AspectRatio Double + | FlexibleAspectRatio Double + deriving ( Show, Read, Eq, Ord ) + +fixedAspect :: [WindowHint] -> Bool +fixedAspect [] = False +fixedAspect (AspectRatio _:_) = True +fixedAspect (_:x) = fixedAspect x + +rate :: Double -> Double -> [WindowHint] -> Rectangle -> Double +rate defaulta meanarea xs rr + | fixedAspect xs = (area (crop xs rr) / meanarea) ** weight + | otherwise = (area rr / meanarea)**(weight-flexibility) + * (area (crop (xs++[FlexibleAspectRatio defaulta]) rr) / meanarea)**flexibility + where weight = hints2area xs + +crop :: [WindowHint] -> Rectangle -> Rectangle +crop (AspectRatio f:_) = cropit f +crop (FlexibleAspectRatio f:_) = cropit f +crop (_:hs) = crop hs +crop [] = id + +crop' :: [WindowHint] -> Rectangle -> Rectangle +crop' (AspectRatio f:_) = cropit f +crop' (_:hs) = crop' hs +crop' [] = id + +cropit :: Double -> Rectangle -> Rectangle +cropit f (Rectangle a b w h) | w -/- h > f = Rectangle a b (ceiling $ h -* f) h + | otherwise = Rectangle a b w (ceiling $ w -/ f) + +hints2area :: [WindowHint] -> Double +hints2area [] = defaultArea +hints2area (RelArea r:_) = r +hints2area (_:x) = hints2area x + +area :: Rectangle -> Double +area (Rectangle _ _ w h) = fromIntegral w * fromIntegral h + +(-/-) :: (Integral a, Integral b) => a -> b -> Double +a -/- b = fromIntegral a / fromIntegral b + +(-/) :: (Integral a) => a -> Double -> Double +a -/ b = fromIntegral a / b + +(-*) :: (Integral a) => a -> Double -> Double +a -* b = fromIntegral a * b + +split :: CutDirection -> Double -> Rectangle -> (Rectangle, Rectangle) +split Vertical frac (Rectangle sx sy sw sh) = (Rectangle sx sy sw h, + Rectangle sx (sy+fromIntegral h) sw (sh-h)) + where h = floor $ fromIntegral sh * frac +split Horizontal frac (Rectangle sx sy sw sh) = (Rectangle sx sy w sh, + Rectangle (sx+fromIntegral w) sy (sw-w) sh) + where w = floor $ fromIntegral sw * frac + +data CutDirection = Vertical | Horizontal +otherDirection :: CutDirection -> CutDirection +otherDirection Vertical = Horizontal +otherDirection Horizontal = Vertical + +data Mosaic a = M [Mosaic a] | OM a + deriving ( Show ) + +instance Functor Mosaic where + fmap f (OM x) = OM (f x) + fmap f (M xs) = M (map (fmap f) xs) + +zipMLwith :: (a -> b -> c) -> Mosaic a -> [b] -> Mosaic c +zipMLwith f (OM x) (y:_) = OM (f x y) +zipMLwith _ (OM _) [] = error "bad zipMLwith" +zipMLwith f (M xxs) yys = makeM $ foo xxs yys + where foo (x:xs) ys = zipMLwith f x (take (lengthM x) ys) : + foo xs (drop (lengthM x) ys) + foo [] _ = [] + +zipML :: Mosaic a -> [b] -> Mosaic (a,b) +zipML = zipMLwith (\a b -> (a,b)) + +lengthM :: Mosaic a -> Int +lengthM (OM _) = 1 +lengthM (M x) = sum $ map lengthM x + +changeMosaic :: Mosaic a -> [Mosaic a] +changeMosaic (OM _) = [] +changeMosaic (M xs) = map makeM (concatenations xs) ++ + map makeM (splits xs) ++ + map M (tryAll changeMosaic xs) + +tryAll :: (a -> [a]) -> [a] -> [[a]] +tryAll _ [] = [] +tryAll f (x:xs) = map (:xs) (f x) ++ map (x:) (tryAll f xs) + +splits :: [Mosaic a] -> [[Mosaic a]] +splits [] = [] +splits (OM x:y) = map (OM x:) $ splits y +splits (M (x:y):z) = (x:makeM y:z) : map (makeM (x:y) :) (splits z) +splits (M []:x) = splits x + +concatenations :: [Mosaic a] -> [[Mosaic a]] +concatenations (x:y:z) = (concatenateMosaic x y:z):(map (x:) $ concatenations (y:z)) +concatenations _ = [] + +concatenateMosaic :: Mosaic a -> Mosaic a -> Mosaic a +concatenateMosaic (OM a) (OM b) = M [OM a, OM b] +concatenateMosaic (OM a) (M b) = M (OM a:b) +concatenateMosaic (M a) (OM b) = M (a++[OM b]) +concatenateMosaic (M a) (M b) = M (a++b) + +makeM :: [Mosaic a] -> Mosaic a +makeM [m] = m +makeM [] = error "makeM []" +makeM ms = M ms + +flattenMosaic :: Mosaic a -> [a] +flattenMosaic (OM a) = [a] +flattenMosaic (M xs) = concatMap flattenMosaic xs + +allsplits :: [a] -> [[[a]]] +allsplits [] = [[[]]] +allsplits [a] = [[[a]]] +allsplits (x:xs) = (map ([x]:) splitsrest) ++ (map (maphead (x:)) splitsrest) + where splitsrest = allsplits' xs + +allsplits' :: [a] -> [[[a]]] +allsplits' [] = [[[]]] +allsplits' [a] = [[[a]]] +allsplits' (x:xs) = (map (maphead (x:)) splitsrest) ++ (map ([x]:) splitsrest) + where splitsrest = allsplits xs + +maphead :: (a->a) -> [a] -> [a] +maphead f (x:xs) = f x : xs +maphead _ [] = [] + +runCountDown :: Int -> State CountDown a -> a +runCountDown n x = fst $ runState x (CD (mkStdGen n) n) addfile ./XMonad/Util/Anneal.hs hunk ./XMonad/Util/Anneal.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Anneal +-- Copyright : (c) David Roundy +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- Requires the 'random' package +-- +----------------------------------------------------------------------------- + +module XMonad.Util.Anneal (-- * Usage + -- $usage + Rated(Rated), the_value, the_rating + , anneal, annealMax ) where + +import System.Random ( StdGen, Random, mkStdGen, randomR ) +import Control.Monad.State ( State, runState, put, get, gets, modify ) + +-- $usage +-- See "XMonad.Layout.Mosaic" for an usage example. + +data Rated a b = Rated !a !b + deriving ( Show ) +instance Functor (Rated a) where + f `fmap` (Rated v a) = Rated v (f a) + +the_value :: Rated a b -> b +the_value (Rated _ b) = b +the_rating :: Rated a b -> a +the_rating (Rated a _) = a + +instance Eq a => Eq (Rated a b) where + (Rated a _) == (Rated a' _) = a == a' +instance Ord a => Ord (Rated a b) where + compare (Rated a _) (Rated a' _) = compare a a' + +anneal :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a +anneal st r sel = runAnneal st r (do_anneal sel) + +annealMax :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a +annealMax st r sel = runAnneal st (negate . r) (do_anneal sel) + +do_anneal :: (a -> [a]) -> State (Anneal a) (Rated Double a) +do_anneal sel = do sequence_ $ replicate 100 da + gets best + where da = do select_metropolis sel + modify $ \s -> s { temperature = temperature s *0.99 } + +data Anneal a = A { g :: StdGen + , best :: Rated Double a + , current :: Rated Double a + , rate :: a -> Rated Double a + , temperature :: Double } + +runAnneal :: a -> (a -> Double) -> State (Anneal a) b -> b +runAnneal start r x = fst $ runState x (A { g = mkStdGen 137 + , best = Rated (r start) start + , current = Rated (r start) start + , rate = \xx -> Rated (r xx) xx + , temperature = 1.0 }) + +select_metropolis :: (a -> [a]) -> State (Anneal a) () +select_metropolis x = do c <- gets current + a <- select $ x $ the_value c + metropolis a + +metropolis :: a -> State (Anneal a) () +metropolis x = do r <- gets rate + c <- gets current + t <- gets temperature + let rx = r x + boltz = exp $ (the_rating c - the_rating rx) / t + if rx < c then do modify $ \s -> s { current = rx, best = rx } + else do p <- getOne (0,1) + if p < boltz + then modify $ \s -> s { current = rx } + else return () + +select :: [a] -> State (Anneal a) a +select [] = the_value `fmap` gets best +select [x] = return x +select xs = do n <- getOne (0,length xs - 1) + return (xs !! n) + +getOne :: (Random a) => (a,a) -> State (Anneal x) a +getOne bounds = do s <- get + (x,g') <- return $ randomR bounds (g s) + put $ s { g = g' } + return x hunk ./XMonad/Util/NamedWindows.hs 39 -data NamedWindow = NW !String !Window +data NamedWindow = NW !String !Window deriving ( Read ) hunk ./xmonad-contrib.cabal 91 + XMonad.Layout.Mosaic hunk ./xmonad-contrib.cabal 117 + XMonad.Util.Anneal hunk ./XMonad/Doc/Extending.hs 441 + +Since we are going to need functions from the "Data.Map" module, it +must be imported first: + +> import qualified Data.Map as M + hunk ./XMonad/Layout/Mosaic.hs 28 -import Data.Ratio hunk ./XMonad/Layout/Magnifier.hs 2 - hunk ./XMonad/Layout/Magnifier.hs 8 --- Maintainer : Peter De Wachter +-- Maintainer : Peter De Wachter , +-- andrea.rossato@unibz.it hunk ./XMonad/Layout/Magnifier.hs 15 --- This layout hack increases the size of the window that has focus. +-- This is a layout modifier that will make a layout increase the size +-- of the window that has focus. hunk ./XMonad/Layout/Magnifier.hs 25 - Magnifier(..), - Magnifier'(..)) where + magnifier') where hunk ./XMonad/Layout/Magnifier.hs 33 +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- hunk ./XMonad/Layout/Magnifier.hs 36 --- > layouts = [ magnifier tiled , magnifier $ mirror tiled ] +-- +-- 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 dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/Magnifier.hs 47 --- %import XMonad.Layout.Magnifier --- %layout , magnifier tiled --- %layout , magnifier $ mirror tiled +-- | Increase the size of the window that has focus, unless it is the +-- master window. +magnifier :: l a -> ModifiedLayout Magnifier l a +magnifier = ModifiedLayout (M True) hunk ./XMonad/Layout/Magnifier.hs 52 --- | Increase the size of the window that has focus, unless it is the master window. -data Magnifier a = Magnifier deriving (Read, Show) -instance LayoutModifier Magnifier Window where - modifierDescription _ = "Magnifier" - redoLayout _ = unlessMaster applyMagnifier +-- | Increase the size of the window that has focus, even if it is the +-- master window. +magnifier' :: l a -> ModifiedLayout Magnifier l a +magnifier' = ModifiedLayout (M False) hunk ./XMonad/Layout/Magnifier.hs 57 --- | Increase the size of the window that has focus, even if it is the master window. -data Magnifier' a = Magnifier' deriving (Read, Show) -instance LayoutModifier Magnifier' Window where - modifierDescription _ = "Magnifier'" - redoLayout _ = applyMagnifier +data Magnifier a = M Bool deriving (Read, Show) hunk ./XMonad/Layout/Magnifier.hs 59 -magnifier :: l a -> ModifiedLayout Magnifier l a -magnifier = ModifiedLayout Magnifier +instance LayoutModifier Magnifier Window where + modifierDescription (M b) = (if b then "" else "All") ++ "Magnifier" + redoLayout (M b) = if b + then unlessMaster applyMagnifier + else applyMagnifier + +type NewLayout a = Rectangle -> Stack a -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe (Magnifier a)) hunk ./XMonad/Layout/Magnifier.hs 67 -unlessMaster :: forall t t1 a a1 (m :: * -> *). (Monad m) => (t -> Stack a -> t1 -> m (t1, Maybe a1)) -> t -> Stack a -> t1 -> m (t1, Maybe a1) +unlessMaster :: NewLayout a -> NewLayout a hunk ./xmonad-contrib.cabal 89 - -- XMonad.Layout.Magnifier + XMonad.Layout.Magnifier hunk ./XMonad/Layout/Magnifier.hs 5 --- Copyright : (c) Peter De Wachter 2007 +-- Copyright : (c) Peter De Wachter and Andrea Rossato 2007 hunk ./XMonad/Layout/Magnifier.hs 8 --- Maintainer : Peter De Wachter , --- andrea.rossato@unibz.it +-- Maintainer : andrea.rossato@unibz.it hunk ./XMonad/Layout/Magnifier.hs 20 -module XMonad.Layout.Magnifier ( - -- * Usage - -- $usage - magnifier, - magnifier') where +module XMonad.Layout.Magnifier + ( -- * Usage + -- $usage + magnifier, + magnifier', + MagnifyMsg (..) + ) where hunk ./XMonad/Layout/Magnifier.hs 47 +-- +-- Magnifier supports some commands. To used them add something like +-- that to your key bindings: +-- +-- > , ((modMask x .|. controlMask , xK_plus ), sendMessage MagnifyMore) +-- > , ((modMask x .|. controlMask , xK_minus), sendMessage MagnifyLess) +-- > , ((modMask x .|. controlMask , xK_o ), sendMessage ToggleOff ) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_o ), sendMessage ToggleOn ) +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Layout/Magnifier.hs 59 --- | Increase the size of the window that has focus, unless it is the --- master window. +-- | Increase the size of the window that has focus hunk ./XMonad/Layout/Magnifier.hs 61 -magnifier = ModifiedLayout (M True) +magnifier = ModifiedLayout (Mag 1.5 On All) hunk ./XMonad/Layout/Magnifier.hs 63 --- | Increase the size of the window that has focus, even if it is the +-- | Increase the size of the window that has focus, unless if it is the hunk ./XMonad/Layout/Magnifier.hs 66 -magnifier' = ModifiedLayout (M False) +magnifier' = ModifiedLayout (Mag 1.5 On NoMaster) + +data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff deriving ( Typeable ) +instance Message MagnifyMsg hunk ./XMonad/Layout/Magnifier.hs 71 -data Magnifier a = M Bool deriving (Read, Show) +data Magnifier a = Mag Zoom Toggle MagnifyMaster deriving (Read, Show) + +type Zoom = Double + +data Toggle = On | Off deriving (Read, Show) +data MagnifyMaster = All | NoMaster deriving (Read, Show) hunk ./XMonad/Layout/Magnifier.hs 79 - modifierDescription (M b) = (if b then "" else "All") ++ "Magnifier" - redoLayout (M b) = if b - then unlessMaster applyMagnifier - else applyMagnifier + redoLayout (Mag z On All ) = applyMagnifier z + redoLayout (Mag z On NoMaster) = unlessMaster $ applyMagnifier z + redoLayout _ = nothing + where nothing _ _ wrs = return (wrs, Nothing) + + handleMess (Mag z On t) m + | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z + 0.1) On t) + | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z - 0.1) On t) + | Just ToggleOff <- fromMessage m = return . Just $ (Mag (z + 0.1) Off t) + handleMess (Mag z Off t) m + | Just ToggleOn <- fromMessage m = return . Just $ (Mag z On t) + handleMess _ _ = return Nothing + + modifierDescription (Mag _ On All ) = "Magnifier" + modifierDescription (Mag _ On NoMaster) = "Magnifier NoMaster" + modifierDescription (Mag _ Off _ ) = "Magnifier (off)" hunk ./XMonad/Layout/Magnifier.hs 102 -applyMagnifier :: Rectangle -> t -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe a) -applyMagnifier r _ wrs = do focused <- withWindowSet (return . peek) - let mag (w,wr) ws | focused == Just w = ws ++ [(w, shrink r $ magnify wr)] - | otherwise = (w,wr) : ws - return (reverse $ foldr mag [] wrs, Nothing) +applyMagnifier :: Double -> Rectangle -> t -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe a) +applyMagnifier z r _ wrs = do focused <- withWindowSet (return . peek) + let mag (w,wr) ws | focused == Just w = ws ++ [(w, shrink r $ magnify z wr)] + | otherwise = (w,wr) : ws + return (reverse $ foldr mag [] wrs, Nothing) hunk ./XMonad/Layout/Magnifier.hs 108 -magnify :: Rectangle -> Rectangle -magnify (Rectangle x y w h) = Rectangle x' y' w' h' +magnify :: Double -> Rectangle -> Rectangle +magnify zoom (Rectangle x y w h) = Rectangle x' y' w' h' hunk ./XMonad/Layout/Magnifier.hs 114 - zoom = 1.5 :: Double hunk ./XMonad/Layout/Mosaic.hs 96 -mosaic :: Double -> Double -> M.Map NamedWindow [WindowHint] -> MosaicLayout Window -mosaic d t h = Mosaic d t h +mosaic :: Double -> Double -> MosaicLayout Window +mosaic d t = Mosaic d t M.empty hunk ./XMonad/Layout/Mosaic.hs 99 -data MosaicLayout a = Mosaic Double Double (M.Map NamedWindow [WindowHint]) +data MosaicLayout a = Mosaic Double Double (M.Map String [WindowHint]) hunk ./XMonad/Layout/Mosaic.hs 115 - m2 (ClearWindow w) = Mosaic d t (M.delete w h) + m2 (ClearWindow w) = Mosaic d t (M.delete (show w) h) hunk ./XMonad/Layout/Mosaic.hs 120 - -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] + -> M.Map String [WindowHint] -> M.Map String [WindowHint] hunk ./XMonad/Layout/Mosaic.hs 126 - -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] + -> M.Map String [WindowHint] -> M.Map String [WindowHint] hunk ./XMonad/Layout/Mosaic.hs 133 - -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] + -> M.Map String [WindowHint] -> M.Map String [WindowHint] hunk ./XMonad/Layout/Mosaic.hs 139 - -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint] + -> M.Map String [WindowHint] -> M.Map String [WindowHint] hunk ./XMonad/Layout/Mosaic.hs 145 -findlist :: Ord k => k -> M.Map k [a] -> [a] -findlist = M.findWithDefault [] +findlist :: NamedWindow -> M.Map String [a] -> [a] +findlist = M.findWithDefault [] . show hunk ./XMonad/Layout/Mosaic.hs 148 -alterlist :: (Ord k, Ord a) => ([a] -> [a]) -> k -> M.Map k [a] -> M.Map k [a] -alterlist f k = M.alter f' k +alterlist :: (Ord a) => ([a] -> [a]) -> NamedWindow -> M.Map String [a] -> M.Map String [a] +alterlist f k = M.alter f' $ show k hunk ./XMonad/Layout/Mosaic.hs 155 -mosaicL :: Double -> M.Map NamedWindow [WindowHint] +mosaicL :: Double -> M.Map String [WindowHint] hunk ./XMonad/Layout/Mosaic.hs 240 - findarea w = M.findWithDefault 1 w theareas + findarea w = M.findWithDefault 1 (show w) theareas hunk ./XMonad/Util/NamedWindows.hs 39 -data NamedWindow = NW !String !Window deriving ( Read ) +data NamedWindow = NW !String !Window hunk ./XMonad/Actions/CopyWindow.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} hunk ./XMonad/Actions/CopyWindow.hs 20 - copy, kill1 + copy, copyWindow, kill1 hunk ./XMonad/Actions/CopyWindow.hs 24 +import Graphics.X11.Xlib ( Window ) hunk ./XMonad/Actions/CopyWindow.hs 59 --- | copy. Copy a window to a new workspace. +-- | copy. Copy the focussed window to a new workspace. hunk ./XMonad/Actions/CopyWindow.hs 61 -copy n = copy' - where copy' s = if n `tagMember` s && n /= tag (workspace (current s)) - then maybe s (go s) (peek s) +copy n s | Just w <- peek s = copyWindow w n s + | otherwise = s + +-- | copyWindow. Copy a window to a new workspace +copyWindow :: Window -> WorkspaceId -> WindowSet -> WindowSet +copyWindow w n = copy' + where copy' s = if n `tagMember` s + then view (tag (workspace (current s))) $ insertUp' w $ view n s hunk ./XMonad/Actions/CopyWindow.hs 70 - go s w = view (tag (workspace (current s))) $ insertUp' w $ view n s hunk ./XMonad/Actions/CopyWindow.hs 71 - (\(Stack t l r) -> Just $ Stack a (L.delete a l) (L.delete a (t:r))) s + (\(Stack t l r) -> if a `elem` t:l++r + then Just $ Stack t l r + else Just $ Stack a (L.delete a l) (L.delete a (t:r))) s + hunk ./XMonad/Layout/Combo.hs 54 --- , ((modMask .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) --- , ((modMask .|. controlMask .|. shiftMask, xK_Left), sendMessage $ Move L) --- , ((modMask .|. controlMask .|. shiftMask, xK_Up), sendMessage $ Move U) --- , ((modMask .|. controlMask .|. shiftMask, xK_Down), sendMessage $ Move D) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Up ), sendMessage $ Move U) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D) hunk ./XMonad/Layout/HintedTile.hs 65 - pureMessage c m = fmap resize (fromMessage m) `mplus` + pureMessage c m = fmap resize (fromMessage m) `mplus` hunk ./XMonad/Layout/WorkspaceDir.hs 9 --- +-- hunk ./XMonad/Layout/WorkspaceDir.hs 20 --- +-- hunk ./XMonad/Layout/WorkspaceDir.hs 25 -module XMonad.Layout.WorkspaceDir ( +module XMonad.Layout.WorkspaceDir ( hunk ./XMonad/Layout/WorkspaceDir.hs 28 - workspaceDir, + workspaceDir, hunk ./XMonad/Layout/WorkspaceDir.hs 42 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/WorkspaceDir.hs 45 --- > --- > layouts = map (workspaceDir "~") [ tiled, ... ] hunk ./XMonad/Layout/WorkspaceDir.hs 46 --- In keybindings: +-- Then edit your @layoutHook@ by adding the Workspace layout modifier +-- to some layout: hunk ./XMonad/Layout/WorkspaceDir.hs 49 --- > , ((modMask .|. shiftMask, xK_x ), changeDir defaultXPConfig) - --- %import XMonad.Layout.WorkspaceDir --- %keybind , ((modMask .|. shiftMask, xK_x ), changeDir defaultXPConfig) --- %layout -- prepend 'map (workspaceDir "~")' to layouts definition above, --- %layout -- just before the list, like the following (don't uncomment next line): --- %layout -- layouts = map (workspaceDir "~") [ tiled, ... ] - +-- > myLayouts = workspaceDir "~" (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- WorkspaceDir provides also a prompt. To use it you need to import +-- "XMonad.Prompt" and add something like this to your key bindings: +-- +-- > , ((modMask x .|. shiftMask, xK_x ), changeDir defaultXPConfig) +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Layout/WindowNavigation.hs 9 --- +-- hunk ./XMonad/Layout/WindowNavigation.hs 18 -module XMonad.Layout.WindowNavigation ( +module XMonad.Layout.WindowNavigation ( hunk ./XMonad/Layout/WindowNavigation.hs 40 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/WindowNavigation.hs 43 --- > --- > layoutHook = Layout $ windowNavigation $ Select ... hunk ./XMonad/Layout/WindowNavigation.hs 44 --- or perhaps +-- Then edit your @layoutHook@ by adding the WindowNavigation layout modifier +-- to some layout: +-- +-- > myLayouts = windowNavigation (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: hunk ./XMonad/Layout/WindowNavigation.hs 52 --- > layoutHook = Layout $ configurableNavigation (navigateColor "green") $ Select ... +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/WindowNavigation.hs 56 --- > , ((modMask, xK_Right), sendMessage $ Go R) --- > , ((modMask, xK_Left ), sendMessage $ Go L) --- > , ((modMask, xK_Up ), sendMessage $ Go U) --- > , ((modMask, xK_Down ), sendMessage $ Go D) +-- > , ((modMask x, xK_Right), sendMessage $ Go R) +-- > , ((modMask x, xK_Left ), sendMessage $ Go L) +-- > , ((modMask x, xK_Up ), sendMessage $ Go U) +-- > , ((modMask x, xK_Down ), sendMessage $ Go D) +-- > , ((modMask x .|. controlMask, xK_Right), sendMessage $ Swap R) +-- > , ((modMask x .|. controlMask, xK_Left ), sendMessage $ Swap L) +-- > , ((modMask x .|. controlMask, xK_Up ), sendMessage $ Swap U) +-- > , ((modMask x .|. controlMask, xK_Down ), sendMessage $ Swap D) +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Layout/WindowNavigation.hs 69 --- %import XMonad.Layout.WindowNavigation --- %keybind , ((modMask, xK_Right), sendMessage $ Go R) --- %keybind , ((modMask, xK_Left ), sendMessage $ Go L) --- %keybind , ((modMask, xK_Up ), sendMessage $ Go U) --- %keybind , ((modMask, xK_Down ), sendMessage $ Go D) --- %keybind , ((modMask .|. controlMask, xK_Right), sendMessage $ Swap R) --- %keybind , ((modMask .|. controlMask, xK_Left ), sendMessage $ Swap L) --- %keybind , ((modMask .|. controlMask, xK_Up ), sendMessage $ Swap U) --- %keybind , ((modMask .|. controlMask, xK_Down ), sendMessage $ Swap D) --- %layout -- include 'windowNavigation' in layoutHook definition above. --- %layout -- just before the list, like the following (don't uncomment next line): --- %layout -- layoutHook = Layout $ windowNavigation $ ... --- %layout -- or --- %layout -- layoutHook = Layout $ configurableNavigation (navigateColor "green") $ ... hunk ./XMonad/Layout/WindowNavigation.hs 77 -data WNConfig = +data WNConfig = hunk ./XMonad/Layout/WindowNavigation.hs 86 -noNavigateBorders = +noNavigateBorders = hunk ./XMonad/Layout/TwoPane.hs 30 --- --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/TwoPane.hs 34 --- and add, to the list of layouts: +-- Then edit your @layoutHook@ by adding the TwoPane layout: hunk ./XMonad/Layout/TwoPane.hs 36 --- > , (Layout $ TwoPane 0.03 0.5) - --- %import XMonad.Layout.TwoPane --- %layout , (Layout $ TwoPane 0.03 0.5) +-- > myLayouts = TwoPane (3/100) (1/2) ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/TilePrime.hs 34 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/TilePrime.hs 38 --- and add the following line to your 'layouts' +-- Then edit your @layoutHook@ by adding the TilePrime layout: hunk ./XMonad/Layout/TilePrime.hs 40 --- > , Layout $ TilePrime nmaster delta ratio False +-- > myLayouts = TilePrime 1 (3/100) (1/2) False ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } hunk ./XMonad/Layout/TilePrime.hs 43 --- Use True as the last argument to get a wide layout. - --- %import XMonad.Layout.TilePrime --- %layout , Layout $ TilePrime nmaster delta ratio False +-- Use @True@ as the last argument to get a wide layout. +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/ThreeColumns.hs 35 --- --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/ThreeColumns.hs 39 --- and add, to the list of layouts: +-- Then edit your @layoutHook@ by adding the ThreeCol layout: hunk ./XMonad/Layout/ThreeColumns.hs 41 --- > ThreeCol nmaster delta ratio - --- %import XMonad.Layout.ThreeColumns --- %layout , ThreeCol nmaster delta ratio +-- > myLayouts = ThreeCol 1 (3/100) (1/2) False ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- Use @True@ as the last argument to get a wide layout. +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/Mosaic.hs 43 --- > import qualified Data.Map as M hunk ./XMonad/Layout/Mosaic.hs 48 --- > myLayouts = mosaic 0.25 0.5 M.empty ||| Full ||| etc.. +-- > myLayouts = mosaic 0.25 0.5 ||| Full ||| etc.. hunk ./XMonad/Config/Droundy.hs 30 +import XMonad.Layout.Mosaic hunk ./XMonad/Config/Droundy.hs 113 + +-- keybindings for Mosaic: + , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow)) + , ((controlMask .|. modMask x .|. shiftMask, xK_l), withFocused (sendMessage . wideWindow)) + , ((modMask x .|. shiftMask, xK_h ), withFocused (sendMessage . shrinkWindow)) + , ((modMask x .|. shiftMask, xK_l ), withFocused (sendMessage . expandWindow)) + , ((modMask x .|. shiftMask, xK_s ), withFocused (sendMessage . squareWindow)) + , ((modMask x .|. shiftMask, xK_o ), withFocused (sendMessage . myclearWindow)) + , ((controlMask .|. modMask x .|. shiftMask, xK_o ), withFocused (sendMessage . flexibleWindow)) + hunk ./XMonad/Config/Droundy.hs 133 - , layoutHook = workspaceDir "~" $ windowNavigation $ toggleLayouts (noBorders Full) $ + , layoutHook = workspaceDir "~" $ windowNavigation $ + toggleLayouts (noBorders Full) $ -- avoidStruts $ hunk ./XMonad/Config/Droundy.hs 136 - Named "xclock" (mytab <-/> combineTwo Square mytab mytab) ||| - mytab mytab + Named "xclock" (mytab <-//> combineTwo Square mytab mytab) ||| + Named "widescreen" ((mytab <||> mytab) + <-//> combineTwo Square mytab mytab) ||| + mosaic 0.25 0.5 hunk ./XMonad/Layout/Mosaic.hs 23 - getName, withNamedWindow ) where + getName ) where hunk ./XMonad/Layout/Mosaic.hs 29 +import Graphics.X11.Xlib.Extras ( getWMNormalHints, sh_aspect ) hunk ./XMonad/Layout/Mosaic.hs 58 --- > , ((controlMask .|. modMask x .|. shiftMask, xK_h), withNamedWindow (sendMessage . tallWindow)) --- > , ((controlMask .|. modMask x .|. shiftMask, xK_l), withNamedWindow (sendMessage . wideWindow)) --- > , ((modMask x .|. shiftMask, xK_h ), withNamedWindow (sendMessage . shrinkWindow)) --- > , ((modMask x .|. shiftMask, xK_l ), withNamedWindow (sendMessage . expandWindow)) --- > , ((modMask x .|. shiftMask, xK_s ), withNamedWindow (sendMessage . squareWindow)) --- > , ((modMask x .|. shiftMask, xK_o ), withNamedWindow (sendMessage . myclearWindow)) --- > , ((controlMask .|. modMask x .|. shiftMask, xK_o ), withNamedWindow (sendMessage . flexibleWindow)) +-- > , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow)) +-- > , ((controlMask .|. modMask x .|. shiftMask, xK_l), withFocused (sendMessage . wideWindow)) +-- > , ((modMask x .|. shiftMask, xK_h ), withFocused (sendMessage . shrinkWindow)) +-- > , ((modMask x .|. shiftMask, xK_l ), withFocused (sendMessage . expandWindow)) +-- > , ((modMask x .|. shiftMask, xK_s ), withFocused (sendMessage . squareWindow)) +-- > , ((modMask x .|. shiftMask, xK_o ), withFocused (sendMessage . myclearWindow)) +-- > , ((controlMask .|. modMask x .|. shiftMask, xK_o ), withFocused (sendMessage . flexibleWindow)) hunk ./XMonad/Layout/Mosaic.hs 70 -data HandleWindow = ExpandWindow NamedWindow | ShrinkWindow NamedWindow - | SquareWindow NamedWindow | ClearWindow NamedWindow - | TallWindow NamedWindow | WideWindow NamedWindow - | FlexibleWindow NamedWindow +data HandleWindow = ExpandWindow Window | ShrinkWindow Window + | SquareWindow Window | ClearWindow Window + | TallWindow Window | WideWindow Window + | FlexibleWindow Window hunk ./XMonad/Layout/Mosaic.hs 78 -expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: NamedWindow -> HandleWindow +expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: Window -> HandleWindow hunk ./XMonad/Layout/Mosaic.hs 99 -data MosaicLayout a = Mosaic Double Double (M.Map String [WindowHint]) +data MosaicLayout a = Mosaic Double Double (M.Map Window [WindowHint]) hunk ./XMonad/Layout/Mosaic.hs 115 - m2 (ClearWindow w) = Mosaic d t (M.delete (show w) h) + m2 (ClearWindow w) = Mosaic d t (M.delete w h) hunk ./XMonad/Layout/Mosaic.hs 117 - description _ = "The Original Mosaic" + description _ = "mosaic" hunk ./XMonad/Layout/Mosaic.hs 119 -multiply_area :: Double -> NamedWindow - -> M.Map String [WindowHint] -> M.Map String [WindowHint] +multiply_area :: Double -> Window + -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] hunk ./XMonad/Layout/Mosaic.hs 125 -set_aspect_ratio :: Double -> NamedWindow - -> M.Map String [WindowHint] -> M.Map String [WindowHint] +set_aspect_ratio :: Double -> Window + -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] hunk ./XMonad/Layout/Mosaic.hs 132 -make_flexible :: NamedWindow - -> M.Map String [WindowHint] -> M.Map String [WindowHint] +make_flexible :: Window + -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] hunk ./XMonad/Layout/Mosaic.hs 138 -multiply_aspect :: Double -> NamedWindow - -> M.Map String [WindowHint] -> M.Map String [WindowHint] +multiply_aspect :: Double -> Window + -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] hunk ./XMonad/Layout/Mosaic.hs 145 -findlist :: NamedWindow -> M.Map String [a] -> [a] -findlist = M.findWithDefault [] . show +findlist :: Window -> M.Map Window [a] -> [a] +findlist = M.findWithDefault [] hunk ./XMonad/Layout/Mosaic.hs 148 -alterlist :: (Ord a) => ([a] -> [a]) -> NamedWindow -> M.Map String [a] -> M.Map String [a] -alterlist f k = M.alter f' $ show k +alterlist :: (Ord a) => ([a] -> [a]) -> Window -> M.Map Window [a] -> M.Map Window [a] +alterlist f k = M.alter f' k hunk ./XMonad/Layout/Mosaic.hs 155 -mosaicL :: Double -> M.Map String [WindowHint] +mosaicL :: Double -> M.Map Window [WindowHint] hunk ./XMonad/Layout/Mosaic.hs 159 - = do namedws <- mapM getName origws - let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) namedws + = do let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) origws hunk ./XMonad/Layout/Mosaic.hs 171 - return (map (\(nw,r)->(--trace ("rate1:"++ unlines [show nw, + all_hints <- add_hints origws hints + return (map (\(w,r)->(--trace ("rate1:"++ unlines [show nw, hunk ./XMonad/Layout/Mosaic.hs 177 - unName nw,crop' (findlist nw hints) r)) $ + w,crop' (findlist w all_hints) r)) $ hunk ./XMonad/Layout/Mosaic.hs 182 - even_split :: Rectangle -> CutDirection -> [[NamedWindow]] - -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle))) + even_split :: Rectangle -> CutDirection -> [[Window]] + -> State CountDown (Rated Double (Mosaic (Window, Rectangle))) hunk ./XMonad/Layout/Mosaic.hs 187 - let wsr_s :: [([NamedWindow], Rectangle)] + let wsr_s :: [([Window], Rectangle)] hunk ./XMonad/Layout/Mosaic.hs 193 - another_mosaic :: [NamedWindow] -> CutDirection - -> Rated Double (Mosaic (NamedWindow,Rectangle)) + another_mosaic :: [Window] -> CutDirection + -> Rated Double (Mosaic (Window,Rectangle)) hunk ./XMonad/Layout/Mosaic.hs 199 - mc_mosaic :: [NamedWindow] -> CutDirection - -> Rated Double (Mosaic (NamedWindow,Rectangle)) + mc_mosaic :: [Window] -> CutDirection + -> Rated Double (Mosaic (Window,Rectangle)) hunk ./XMonad/Layout/Mosaic.hs 206 - ratew :: (NamedWindow,Rectangle) -> Double + ratew :: (Window,Rectangle) -> Double hunk ./XMonad/Layout/Mosaic.hs 208 - example_mosaic :: [NamedWindow] -> Mosaic NamedWindow + example_mosaic :: [Window] -> Mosaic Window hunk ./XMonad/Layout/Mosaic.hs 216 - rate_mosaic :: ((NamedWindow,Rectangle) -> Double) - -> Mosaic (NamedWindow,Rectangle) -> Rated Double (Mosaic (NamedWindow,Rectangle)) + rate_mosaic :: ((Window,Rectangle) -> Double) + -> Mosaic (Window,Rectangle) -> Rated Double (Mosaic (Window,Rectangle)) hunk ./XMonad/Layout/Mosaic.hs 220 - one_split :: Rectangle -> CutDirection -> [[NamedWindow]] - -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle))) + one_split :: Rectangle -> CutDirection -> [[Window]] + -> State CountDown (Rated Double (Mosaic (Window, Rectangle))) hunk ./XMonad/Layout/Mosaic.hs 225 - let wsr_s :: [([NamedWindow], Rectangle)] + let wsr_s :: [([Window], Rectangle)] hunk ./XMonad/Layout/Mosaic.hs 239 - findarea :: NamedWindow -> Double - findarea w = M.findWithDefault 1 (show w) theareas + findarea :: Window -> Double + findarea w = M.findWithDefault 1 w theareas hunk ./XMonad/Layout/Mosaic.hs 242 + add_hints [] x = return x + add_hints (w:ws) x = + do h <- withDisplay $ \d -> io $ getWMNormalHints d w + case map4 `fmap` sh_aspect h of + Just ((minx,miny),(maxx,maxy)) + | or [minx < 1, miny < 1, maxx < 1, maxy < 1] -> add_hints ws x + | minx/miny == maxx/maxy -> add_hints ws $ set_aspect_ratio (minx/miny) w x + | otherwise -> add_hints ws $ make_flexible w $ + set_aspect_ratio (sqrt $ minx*maxx/miny/maxy) w x + Nothing -> add_hints ws x + map4 :: Integral a => ((a,a),(a,a)) -> ((Double,Double),(Double,Double)) + map4 ((a,b),(c,d)) = ((fromIntegral a,fromIntegral b),(fromIntegral c,fromIntegral d)) hunk ./XMonad/Layout/Spiral.hs 8 --- +-- hunk ./XMonad/Layout/Spiral.hs 33 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/Spiral.hs 35 --- > import XMonad.Layout.Spiral +-- > import XMonad.Layout.Spiral +-- > import Data.Ratio hunk ./XMonad/Layout/Spiral.hs 38 --- > layouts = [ ..., Layout $ spiral (1 % 1), ... ] - --- %import XMonad.Layout.Spiral --- %layout , Layout $ spiral (1 % 1) +-- Then edit your @layoutHook@ by adding the Spiral layout: +-- +-- > myLayouts = spiral (1 % 1) ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/Spiral.hs 79 - CW -> cycle [East .. North] + CW -> cycle [East .. North] hunk ./XMonad/Layout/Roledex.hs 30 +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/Roledex.hs 33 --- > layouts = [ Layout Roledex ] - --- %import XMonad.Layout.Roledex --- %layout , Layout Roledex +-- +-- Then edit your @layoutHook@ by adding the Roledex layout: +-- +-- > myLayouts = Roledex ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/ResizableTile.hs 32 +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/ResizableTile.hs 34 --- To use, modify your Config.hs to: +-- > import XMonad.Layout.ResizableTile hunk ./XMonad/Layout/ResizableTile.hs 36 --- > import XMonad.Layout.ResizableTile +-- Then edit your @layoutHook@ by adding the ResizableTile layout: hunk ./XMonad/Layout/ResizableTile.hs 38 --- and add a keybinding: +-- > myLayouts = ResizableTall 1 (3/100) (1/2) [] ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } hunk ./XMonad/Layout/ResizableTile.hs 41 --- > , ((modMask, xK_a ), sendMessage MirrorShrink) --- > , ((modMask, xK_z ), sendMessage MirrorExpand) +-- For more detailed instructions on editing the layoutHook see: hunk ./XMonad/Layout/ResizableTile.hs 43 --- and redefine "tiled" as: +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/ResizableTile.hs 45 --- > tiled = ResizableTall nmaster delta ratio [] +-- You may also want to add the following key bindings: +-- +-- > , ((modMask x, xK_a), sendMessage MirrorShrink) +-- > , ((modMask x, xK_z), sendMessage MirrorExpand) +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Layout/NoBorders.hs 47 - --- %import XMonad.Layout.NoBorders --- %layout -- prepend noBorders to default layouts above to remove their borders, like so: --- %layout , noBorders Full +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/Named.hs 13 +-- A module for assigning a name to a given layout. +-- hunk ./XMonad/Layout/Named.hs 26 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/Named.hs 30 --- and change the name of a given layout by +-- Then edit your @layoutHook@ by adding the Named layout modifier +-- to some layout: +-- +-- > myLayouts = Named "real big" Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: hunk ./XMonad/Layout/Named.hs 38 --- > layout = Named "real big" Full ||| ... +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/MosaicAlt.hs 41 --- You can use this module with the following in your configuration file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/MosaicAlt.hs 44 +-- > import qualified Data.Map as M hunk ./XMonad/Layout/MosaicAlt.hs 46 --- > layouts = ... --- > , Layout $ MosaicAlt M.empty --- > ... +-- Then edit your @layoutHook@ by adding the MosaicAlt layout: hunk ./XMonad/Layout/MosaicAlt.hs 48 --- > keys = ... --- > , ((modMask .|. shiftMask, xK_a), withFocused (sendMessage . expandWindowAlt)) --- > , ((modMask .|. shiftMask, xK_z), withFocused (sendMessage . shrinkWindowAlt)) --- > , ((modMask .|. shiftMask, xK_s), withFocused (sendMessage . tallWindowAlt)) --- > , ((modMask .|. shiftMask, xK_d), withFocused (sendMessage . wideWindowAlt)) --- > , ((modMask .|. controlMask, xK_space), sendMessage resetAlt) +-- > myLayouts = MosaicAlt M.empty ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- In the key-bindings, do something like: +-- +-- > , ((modMask x .|. shiftMask , xK_a ), withFocused (sendMessage . expandWindowAlt)) +-- > , ((modMask x .|. shiftMask , xK_z ), withFocused (sendMessage . shrinkWindowAlt)) +-- > , ((modMask x .|. shiftMask , xK_s ), withFocused (sendMessage . tallWindowAlt)) +-- > , ((modMask x .|. shiftMask , xK_d ), withFocused (sendMessage . wideWindowAlt)) +-- > , ((modMask x .|. controlMask, xK_space), sendMessage resetAlt) hunk ./XMonad/Layout/MosaicAlt.hs 63 - --- %import XMonad.Layout.MosaicAlt --- %layout , Layout $ MosaicAlt M.empty +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Layout/Maximize.hs 32 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/Maximize.hs 36 --- > layouts = ... --- > , Layout $ maximize $ tiled ... --- > ... +-- Then edit your @layoutHook@ by adding the Maximize layout modifier: hunk ./XMonad/Layout/Maximize.hs 38 --- > keys = ... --- > , ((modMask, xK_backslash), withFocused (sendMessage . maximizeRestore)) +-- > myLayouts = maximize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- In the key-bindings, do something like: +-- +-- > , ((modMask x, xK_backslash), withFocused (sendMessage . maximizeRestore)) hunk ./XMonad/Layout/Maximize.hs 49 - --- %import XMonad.Layout.Maximize --- %layout , Layout $ maximize $ tiled +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Layout/MagicFocus.hs 27 +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- hunk ./XMonad/Layout/MagicFocus.hs 30 --- > layouts = [ Layout $ MagicFocus tiled , Layout $ MagicFocus $ Mirror tiled ] - --- %import XMonad.Layout.MagicFocus --- %layout , Layout $ MagicFocus tiled --- %layout , Layout $ MagicFocus $ Mirror tiled - +-- +-- Then edit your @layoutHook@ by adding the MagicFocus layout +-- modifier: +-- +-- > myLayouts = MagicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/LayoutModifier.hs 14 --- A module for writing easy Layouts +-- A module for writing easy Llayouts and layout modifiers hunk ./XMonad/Layout/LayoutModifier.hs 28 --- Use LayoutHelpers to help write easy Layouts. +-- Use LayoutModifier to help write easy Layouts. +-- +-- LayouModifier defines a class 'LayoutModifier'. Each method as a +-- default implementation. +-- +-- For usage examples you can see "XMonad.Layout.WorkspaceDir", +-- "XMonad.Layout.Magnifier", "XMonad.Layout.NoBorder", hunk ./XMonad/Layout/LayoutModifier.hs 39 - | Just ReleaseResources <- fromMessage mess = doUnhook - | otherwise = return Nothing + | Just ReleaseResources <- fromMessage mess = doUnhook + | otherwise = return Nothing hunk ./XMonad/Layout/LayoutHints.hs 30 +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- hunk ./XMonad/Layout/LayoutHints.hs 33 --- > layouts = [ layoutHints tiled , layoutHints $ Mirror tiled ] - --- %import XMonad.Layout.LayoutHints --- %layout , layoutHints $ tiled --- %layout , layoutHints $ Mirror tiled +-- +-- Then edit your @layoutHook@ by adding the LayoutHints layout modifier +-- to some layout: +-- +-- > myLayouts = layoutHints (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/ToggleLayouts.hs 14 --- A module for writing easy Layouts +-- A module to toggle between two layouts. hunk ./XMonad/Layout/ToggleLayouts.hs 26 --- Use toggleLayouts to toggle between two layouts. +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Layout/ToggleLayouts.hs 28 --- import XMonad.Layout.ToggleLayouts +-- > import XMonad.Layout.ToggleLayouts hunk ./XMonad/Layout/ToggleLayouts.hs 30 --- and add to your layoutHook something like +-- Then edit your @layoutHook@ by adding the ToggleLayouts layout: hunk ./XMonad/Layout/ToggleLayouts.hs 32 --- > layoutHook = Layout $ toggleLayouts (noBorders Full) $ Select layouts +-- > myLayouts = toggleLayouts Full (Tall 1 (3/100) (1/2)) ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } hunk ./XMonad/Layout/ToggleLayouts.hs 35 --- and a key binding like +-- For more detailed instructions on editing the layoutHook see: hunk ./XMonad/Layout/ToggleLayouts.hs 37 --- > , ((modMask .|. controlMask, xK_space), sendMessage ToggleLayout) +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- To toggle between layouts add a key binding like +-- +-- > , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout) hunk ./XMonad/Layout/ToggleLayouts.hs 45 --- > , ((modMask .|. controlMask, xK_space), sendMessage (Toggle "Full")) +-- > , ((modMask x .|. controlMask, xK_space), sendMessage (Toggle "Full")) +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Layout/LayoutCombinators.hs 3 - hunk ./XMonad/Layout/LayoutCombinators.hs 13 --- A module for combining XMonad.Layouts +-- A module for combining other layouts. hunk ./XMonad/Layout/LayoutCombinators.hs 19 - (<|>), (), (<||>), (), (|||), JumpToLayout(JumpToLayout), - (<-/>), (), (<-|>), (<|->), - (<-//>), (), (<-||>), (<||->), - + (<||>),(<-||>),(<||->), + (),(<-//>),(), + (<|>),(<-|>),(<|->), + (),(<-/>),(), + (|||), + JumpToLayout(JumpToLayout) hunk ./XMonad/Layout/LayoutCombinators.hs 35 --- Use LayoutCombinators to easily combine Layouts. +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.LayoutCombinators +-- +-- Then edit your @layoutHook@ by using the new layout combinators: +-- +-- > myLayouts = (Tall 1 (3/100) (1/2) <-/> Full) ||| (Tall 1 (3/100) (1/2) <||-> Full) ||| Full ||| etc.. +-- > main = xmonad dafaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Layout/LayoutCombinators.hs 50 -(<||>), (), (<-||>), (<-//>), (<||->), () - :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => - l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a -(<|>), (<-|>), (<|->) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) - => l1 a -> l2 a -> CombineTwo (Tall ()) l1 l2 a -(), (<-/>), () :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) - => l1 a -> l2 a -> CombineTwo (Mirror Tall ()) l1 l2 a +-- | Combines two layouts vertically using dragPane +(<||>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => + l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a + +-- | Combines two layouts vertically using dragPane giving more screen +-- to the first layout +(<-||>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => + l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a + +-- | Combines two layouts vertically using dragPane giving more screen +-- to the second layout +(<||->) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => + l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a + +-- | Combines two layouts horizzontally using dragPane +() :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => + l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a hunk ./XMonad/Layout/LayoutCombinators.hs 68 -(<||>) = combineTwo (dragPane Vertical 0.1 0.5) +-- | Combines two layouts horizzontally using dragPane giving more screen +-- to the first layout +(<-//>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => + l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a + +-- | Combines two layouts horizzontally using dragPane giving more screen +-- to the first layout +() :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => + l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a + +-- | Combines two layouts vertically using Tall +(<|>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) + => l1 a -> l2 a -> CombineTwo (Tall ()) l1 l2 a + +-- | Combines two layouts vertically using Tall giving more screen +-- to the first layout +(<-|>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) + => l1 a -> l2 a -> CombineTwo (Tall ()) l1 l2 a + +-- | Combines two layouts vertically using Tall giving more screen +-- to the second layout +(<|->) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) + => l1 a -> l2 a -> CombineTwo (Tall ()) l1 l2 a + +-- | Combines two layouts horizzontally using Mirror Tall (a wide +-- layout) +() :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) + => l1 a -> l2 a -> CombineTwo (Mirror Tall ()) l1 l2 a + +-- | Combines two layouts horizzontally using Mirror Tall (a wide +-- layout) giving more screen to the first layout +(<-/>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) + => l1 a -> l2 a -> CombineTwo (Mirror Tall ()) l1 l2 a + +-- | Combines two layouts horizzontally using Mirror Tall (a wide +-- layout) giving more screen to the second layout +() :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) + => l1 a -> l2 a -> CombineTwo (Mirror Tall ()) l1 l2 a + +-- implementation +(<||>) = combineTwo (dragPane Vertical 0.1 0.5) hunk ./XMonad/Layout/LayoutCombinators.hs 111 -() = combineTwo (dragPane Horizontal 0.1 0.5) +() = combineTwo (dragPane Horizontal 0.1 0.5) hunk ./XMonad/Layout/LayoutCombinators.hs 114 -(<|>) = combineTwo (Tall 1 0.1 0.5) -(<-|>) = combineTwo (Tall 1 0.1 0.8) -(<|->) = combineTwo (Tall 1 0.1 0.1) -() = combineTwo (Mirror $ Tall 1 0.1 0.5) -(<-/>) = combineTwo (Mirror $ Tall 1 0.1 0.8) -() = combineTwo (Mirror $ Tall 1 0.1 0.2) +(<|>) = combineTwo (Tall 1 0.1 0.5) +(<-|>) = combineTwo (Tall 1 0.1 0.8) +(<|->) = combineTwo (Tall 1 0.1 0.1) +() = combineTwo (Mirror $ Tall 1 0.1 0.5) +(<-/>) = combineTwo (Mirror $ Tall 1 0.1 0.8) +() = combineTwo (Mirror $ Tall 1 0.1 0.2) hunk ./XMonad/Layout/LayoutCombinators.hs 122 + +-- | A new layout combinator that allows the use of a prompt to change +-- layout. For more information see "Xmonad.Prompt.Layout" hunk ./XMonad/Layout/LayoutCombinators.hs 192 +-- LocalWords: horizzontally + replace ./XMonad/Layout/Accordion.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/Circle.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/Combo.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/Dishes.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/DragPane.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/Grid.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/HintedTile.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/LayoutCombinators.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/LayoutHints.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/LayoutModifier.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/LayoutScreens.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/MagicFocus.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/Magnifier.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/Maximize.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/Mosaic.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/MosaicAlt.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/MultiToggle.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/Named.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/NoBorders.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/PerWorkspace.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/ResizableTile.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/Roledex.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/Spiral.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/Square.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/Tabbed.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/ThreeColumns.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/TilePrime.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/ToggleLayouts.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/TwoPane.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/WindowNavigation.hs [A-Za-z_0-9] dafaultConfig defaultConfig replace ./XMonad/Layout/WorkspaceDir.hs [A-Za-z_0-9] dafaultConfig defaultConfig hunk ./XMonad/Actions/Commands.hs 6 --- +-- hunk ./XMonad/Actions/Commands.hs 41 --- To use, modify your Config.hs to: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Actions/Commands.hs 45 --- and add a keybinding to the runCommand action: +-- Then add a keybinding to the runCommand action: hunk ./XMonad/Actions/Commands.hs 49 --- and define the list commands: +-- and define the list of commands you want to use: hunk ./XMonad/Actions/Commands.hs 54 --- A popup menu of internal xmonad commands will appear. You can --- change the commands by changing the contents of the list --- 'commands'. (If you like it enough, you may even want to get rid --- of many of your other key bindings!) - --- %def commands :: [(String, X ())] --- %def commands = defaultCommands --- %import XMonad.Actions.Commands --- %keybind , ((modMask .|. controlMask, xK_y), runCommand commands) +-- Whatever key you bound to will now cause a popup menu of internal +-- xmonad commands to appear. You can change the commands by +-- changing the contents of the list 'commands'. (If you like it +-- enough, you may even want to get rid of many of your other key +-- bindings!) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/Commands.hs 63 +-- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a +-- list of pairs. hunk ./XMonad/Actions/Commands.hs 68 +-- | Generate a list of commands to switch to\/send windows to workspaces. hunk ./XMonad/Actions/Commands.hs 75 +-- | Generate a list of commands dealing with multiple screens. hunk ./XMonad/Actions/Commands.hs 82 +-- | A nice pre-defined list of commands. hunk ./XMonad/Actions/Commands.hs 109 +-- | Given a list of command\/action pairs, prompt the user to choose a +-- command and return the corresponding action. hunk ./XMonad/Actions/Commands.hs 117 +-- | Given the name of a command from 'defaultCommands', return the +-- corresponding action (or the null action if the command is not +-- found). hunk ./XMonad/Doc/Extending.hs 71 + -- ** Editing mouse bindings + -- $mouse + hunk ./XMonad/Doc/Extending.hs 584 +-} + +{- $mouse +#Editing_mouse_bindings# + +Most of the previous discussion of key bindings applies to mouse +bindings as well. For example, you could configure button4 to close +the window you click on like so: + +> import qualified Data.Map as M +> +> myMouse x = [ (0, button4), (\w -> focus w >> kill) ] +> +> newMouse x = M.union (mouseBindings defaultConfig x) (M.fromList (myMouse x)) +> +> main = xmonad $ defaultConfig { ..., mouseBindings = newMouse, ... } + +Overriding or deleting mouse bindings works similarly. You can also +configure mouse bindings much more easily using the +'XMonad.Util.EZConfig.additionalMouseBindings' and +'XMonad.Util.EZConfig.removeMouseBindings' functions from the +"XMonad.Util.EZConfig" module. + hunk ./XMonad/Actions/ConstrainedResize.hs 6 --- +-- hunk ./XMonad/Actions/ConstrainedResize.hs 12 --- window by holding shift while you resize. +-- window (by, say, holding shift while you resize). hunk ./XMonad/Actions/ConstrainedResize.hs 30 --- Put something like this in your Config.hs file: +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Actions/ConstrainedResize.hs 34 --- > mouseBindings = M.fromList --- > [ ... +-- +-- Then add something like the following to your mouse bindings: +-- hunk ./XMonad/Actions/ConstrainedResize.hs 38 --- > , ((modMask .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True )) ] +-- > , ((modMask .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True )) hunk ./XMonad/Actions/ConstrainedResize.hs 40 --- The line without the shiftMask replaces the standard mouse resize function call, so it's --- not completely necessary but seems neater this way. - --- %import qualified XMonad.Actions.ConstrainedResize as Sqr --- %mousebind , ((modMask, button3), (\\w -> focus w >> Sqr.mouseResizeWindow w False)) --- %mousebind , ((modMask .|. shiftMask, button3), (\\w -> focus w >> Sqr.mouseResizeWindow w True)) +-- The line without the shiftMask replaces the standard mouse resize +-- function call, so it's not completely necessary but seems neater +-- this way. +-- +-- For detailed instructions on editing your mouse bindings, see +-- "XMonad.Doc.Extending#Editing_mouse_bindings". hunk ./XMonad/Actions/CopyWindow.hs 32 --- You can use this module with the following in your Config.hs file: --- +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- hunk ./XMonad/Actions/CopyWindow.hs 37 +-- Then add something like this to your keybindings: +-- hunk ./XMonad/Actions/CopyWindow.hs 46 --- you may also wish to redefine the binding to kill a window so it only +-- You may also wish to redefine the binding to kill a window so it only hunk ./XMonad/Actions/CopyWindow.hs 50 - --- %import XMonad.Actions.CopyWindow --- %keybind -- comment out default close window binding above if you uncomment this: --- %keybind , ((modMask .|. shiftMask, xK_c ), kill1) -- @@ Close the focused window --- %keybindlist ++ --- %keybindlist -- mod-[1..9] @@ Switch to workspace N --- %keybindlist -- mod-shift-[1..9] @@ Move client to workspace N --- %keybindlist -- mod-control-shift-[1..9] @@ Copy client to workspace N --- %keybindlist [((m .|. modMask, k), f i) --- %keybindlist | (i, k) <- zip workspaces [xK_1 ..] --- %keybindlist , (f, m) <- [(view, 0), (shift, shiftMask), (copy, shiftMask .|. controlMask)]] +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/CycleWS.hs 39 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: hunk ./XMonad/Actions/CycleWS.hs 54 - --- %import XMonad.Actions.CycleWS --- %keybind , ((modMask, xK_Right), nextWS) --- %keybind , ((modMask, xK_Left), prevWS) --- %keybind , ((modMask .|. shiftMask, xK_Right), shiftToNext) --- %keybind , ((modMask .|. shiftMask, xK_Left), shiftToPrev) --- %keybind , ((modMask, xK_t), toggleWS) +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/DeManage.hs 11 --- This module provides a method to cease management of a window, without --- unmapping it. This is especially useful for applications like kicker and --- gnome-panel. +-- This module provides a method to cease management of a window +-- without unmapping it. This is especially useful for applications +-- like kicker and gnome-panel. hunk ./XMonad/Actions/DeManage.hs 17 --- * Determine the pixel size of the panel, add that value to defaultGaps +-- * Determine the pixel size of the panel, add that value to +-- 'XMonad.Core.XConfig.defaultGaps' hunk ./XMonad/Actions/DeManage.hs 22 --- * Give the panel window focus, then press mod-d +-- * Give the panel window focus, then press @mod-d@ (or whatever key +-- you have bound 'demanage' to) hunk ./XMonad/Actions/DeManage.hs 43 --- To use demanage, add this import: +-- To use demanage, add this import to your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Actions/DeManage.hs 47 --- And add a keybinding to it: +-- And add a keybinding, such as: hunk ./XMonad/Actions/DeManage.hs 51 +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/DeManage.hs 54 --- %import XMonad.Actions.DeManage --- %keybind , ((modMask, xK_d ), withFocused demanage) - --- | Stop managing the current focused window. +-- | Stop managing the currently focused window. hunk ./XMonad/Actions/DwmPromote.hs 12 --- +-- hunk ./XMonad/Actions/DwmPromote.hs 21 - -- $usage + -- $usage hunk ./XMonad/Actions/DwmPromote.hs 31 --- To use, modify your Config.hs to: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Actions/DwmPromote.hs 35 --- and add a keybinding or substitute promote with dwmpromote: +-- then add a keybinding or substitute 'dwmpromote' in place of promote: hunk ./XMonad/Actions/DwmPromote.hs 38 +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/DwmPromote.hs 42 --- %import XMonad.Actions.DwmPromote --- %keybind , ((modMask, xK_Return), dwmpromote) - +-- | Swap the focused window with the master window. If focus is in +-- the master, swap it with the next window in the stack. Focus +-- stays in the master. hunk ./XMonad/Layout/LayoutCombinators.hs 37 --- > import XMonad.Layout.LayoutCombinators +-- > import XMonad.Layout.LayoutCombinators hiding ( (|||) ) hunk ./XMonad/Layout/Magnifier.hs 48 --- Magnifier supports some commands. To used them add something like --- that to your key bindings: +-- Magnifier supports some commands. To use them add something like +-- this to your key bindings: hunk ./XMonad/Doc/Extending.hs 284 +* "XMonad.Layout.Magnifier": increase the size of the focused window + hunk ./XMonad/Doc/Extending.hs 288 +* "XMonad.Layout.Mosaic": tries to give each window a + user-configurable relative area + hunk ./XMonad/Doc/Extending.hs 377 +* "XMonad.Util.Anneal": The goal is to bring the system, from an + arbitrary initial state, to a state with the minimum possible + energy. + hunk ./XMonad/Doc/Extending.hs 454 -Since we are going to need functions from the "Data.Map" module, it -must be imported first: +Since we are going to need some of the functions of the "Data.Map" +module, before starting we must first import this modules: hunk ./XMonad/Doc/Extending.hs 457 -> import qualified Data.Map as M +> import qualified Data.Map as M hunk ./XMonad/Doc/Extending.hs 694 -TODO: Manage Hook + +Whenever a new window which must be managed is created, xmonad calls +the 'XMonad.Core.manageHook', which can thus be used to perform some +tasks with the new window, such as placing it in a specific workspace, +or ignoring it, or placing it in the float layer. + +In other words, the 'XMonad.Core.manageHook' is a very powerful tool +for customizing the behavior of xmonad with regard to new windows. + +By default xmonad will place on the float layer Mplayer and Gimp and +will ignore gnome-panel, desktop_window, kicker, kdesktop. + +"XMonad.ManageHook" provides some simple combinators that can be used +to extend the manageHook and add custom actions to the default one. + +We can start analyzing the default 'XMonad.Config.manageHook', defined +in "XMonad.Config": + +> manageHook :: ManageHook +> manageHook = composeAll . concat $ +> [ [ className =? c --> doFloat | c <- floats] +> , [ resource =? r --> doIgnore | r <- ignore] +> , [ resource =? "Gecko" --> doF (W.shift "web") ]] +> where floats = ["MPlayer", "Gimp"] +> ignore = ["gnome-panel", "desktop_window", "kicker", "kdesktop"] + +'XMonad.ManageHook.composeAll' can be used to compose a list of +different 'XMonad.Config.manageHook's. In this example with have three +lists of 'XMonad.Config.manageHook's: the first one is the list of the +windows to be placed in the float layer with the +'XMonad.ManageHook.doFloat' function (MPlayer and Gimp); the second +one is the list of windows the be ignored by xmonad, which can be done +by using 'XMonad.ManageHook.doIgnore'. The third one, with just one, +is a 'XMonad.Config.manageHook' that will match firefox, or mozilla, +and will put them in the workspace named \"web\", with +'XMonad.ManageHook.doF' and 'XMonad.StackSet.shift'. + + +Each manageHook has the form + +> property =? match --> action + +Where @property@ can be: + +* 'XMonad.ManageHook.title': the window's title + +* 'XMonad.ManageHook.resource': the resource name + + 'XMonad.ManageHook.className': the resource class name. + +You can retrieve the needed information using the X utility named +@xprop@. + +@match@ is string that will match the property value; + +And @action@ can be: + +* 'XMonad.ManageHook.doFloat': to place the window in the float layer; + +* 'XMonad.ManageHook.doIgnore': to ignore the window + +* 'XMonad.ManageHook.doF': execute a function with the window. + +Suppose we want to add a 'XMonad.Config.manageHook' to float +RealPlayer, which usually has a 'XMonad.ManageHook.resource' name with +the string \"realplay.bin\". + +First we need to import "XMonad.ManageHook": + +> import XMonad.ManageHook + +Then we create our own 'XMonad.Config.manageHook': + +> myManageHook = resource =? "realplay.bin" --> doFloat + +We can now use the 'XMonad.ManageHook.<+>' combinator to add our +'XMonad.Config.manageHook' to the default one: + +> newManageHook = myManageHook <+> (manageHook defaultConfig) + +Now, all we need to do is change the 'XMonad.Core.manageHook' field of +the 'XMonad.Core.XConfig' record, like so: + +> main = xmonad defaultConfig { manageHook = newManageHook } + +And we are done. hunk ./XMonad/Doc/Extending.hs 786 -TODO: Log Hook +When the stack of the windows managed by xmonad changes, for any +reason, xmonad will call 'XMonad.Core.logHook', which can be used to +dump some information of the internal state of xmonad, such as the +layout that is presently in use, the workspace we are in, the focused +window's title, and so on. + +Dumping the internal xmonad state can be somehow difficult, if you are +not familiar with the source code. It can be helpful to use a module +that has been designed specifically for logging some of the most +interesting information about the internal state of xmonad: +"XMonad.Hooks.DynamicLog". + +This module can be used with some external status bar that can be +configure to print, in a convenient way, the produced logs. + +dzen and xmobar are the most common status bars used by xmonad users. + +XXX add some examples. + +By default the 'XMonad.Core.logHook' doesn't produce anything. To +enable it you need first to import "XMonad.Hooks.DynamicLog": + +> import XMonad.Hooks.DynamicLog + +Then you just need to update the 'XMonad.Core.logHook' field of the +'XMonad.Core.XConfig' record, like so: + +> main = xmonad defaultConfig { logHook = dynamicLog } + +You may now enjoy your extended xmonad experience. + +Have fun! hunk ./XMonad/Doc/Extending.hs 695 -Whenever a new window which must be managed is created, xmonad calls -the 'XMonad.Core.manageHook', which can thus be used to perform some -tasks with the new window, such as placing it in a specific workspace, -or ignoring it, or placing it in the float layer. +The 'XMonad.Core.manageHook' is a very powerful tool for customizing +the behavior of xmonad with regard to new windows. Whenever a new +window is created, xmonad calls the 'XMonad.Core.manageHook', which +can thus be used to perform certain actions on the new window, such as +placing it in a specific workspace, ignoring it, or placing it in the +float layer. hunk ./XMonad/Doc/Extending.hs 702 -In other words, the 'XMonad.Core.manageHook' is a very powerful tool -for customizing the behavior of xmonad with regard to new windows. +The default 'XMonad.Core.manageHook' causes xmonad to float MPlayer +and Gimp, and to ignore gnome-panel, desktop_window, kicker, and +kdesktop. hunk ./XMonad/Doc/Extending.hs 706 -By default xmonad will place on the float layer Mplayer and Gimp and -will ignore gnome-panel, desktop_window, kicker, kdesktop. +The "XMonad.ManageHook" module provides some simple combinators that +can be used to alter the 'XMonad.Core.manageHook' by replacing or adding +to the default actions. hunk ./XMonad/Doc/Extending.hs 710 -"XMonad.ManageHook" provides some simple combinators that can be used -to extend the manageHook and add custom actions to the default one. - -We can start analyzing the default 'XMonad.Config.manageHook', defined +Let's start by analyzing the default 'XMonad.Config.manageHook', defined hunk ./XMonad/Doc/Extending.hs 722 -different 'XMonad.Config.manageHook's. In this example with have three -lists of 'XMonad.Config.manageHook's: the first one is the list of the +different 'XMonad.Config.ManageHook's. In this example we have three +lists of 'XMonad.Config.ManageHook's: the first one is the list of the hunk ./XMonad/Doc/Extending.hs 726 -one is the list of windows the be ignored by xmonad, which can be done -by using 'XMonad.ManageHook.doIgnore'. The third one, with just one, -is a 'XMonad.Config.manageHook' that will match firefox, or mozilla, -and will put them in the workspace named \"web\", with -'XMonad.ManageHook.doF' and 'XMonad.StackSet.shift'. - +one is the list of windows to be ignored; the third (which contains +only one 'XMonad.Config.ManageHook') will match firefox, or mozilla, +and put them in the workspace named \"web\", with +'XMonad.ManageHook.doF' and 'XMonad.StackSet.shift'. (@concat@ simply +combines these three lists into a single list.) hunk ./XMonad/Doc/Extending.hs 732 -Each manageHook has the form +Each 'XMonad.Config.ManageHook' has the form hunk ./XMonad/Doc/Extending.hs 742 - 'XMonad.ManageHook.className': the resource class name. +* 'XMonad.ManageHook.className': the resource class name. + +(You can retrieve the needed information using the X utility named +@xprop@; for example, to find the resource class name, you can type hunk ./XMonad/Doc/Extending.hs 747 -You can retrieve the needed information using the X utility named -@xprop@. +> xprop | grep WM_CLASS + +at a prompt, then click on the window whose resource class you want to +know.) hunk ./XMonad/Doc/Extending.hs 754 -And @action@ can be: +and @action@ can be: hunk ./XMonad/Doc/Extending.hs 758 -* 'XMonad.ManageHook.doIgnore': to ignore the window +* 'XMonad.ManageHook.doIgnore': to ignore the window; hunk ./XMonad/Doc/Extending.hs 760 -* 'XMonad.ManageHook.doF': execute a function with the window. +* 'XMonad.ManageHook.doF': to execute a function with the window. hunk ./XMonad/Doc/Extending.hs 762 -Suppose we want to add a 'XMonad.Config.manageHook' to float -RealPlayer, which usually has a 'XMonad.ManageHook.resource' name with -the string \"realplay.bin\". +For example, suppose we want to add a 'XMonad.Config.manageHook' to +float RealPlayer, which usually has a 'XMonad.ManageHook.resource' +name of \"realplay.bin\". hunk ./XMonad/Doc/Extending.hs 772 -> myManageHook = resource =? "realplay.bin" --> doFloat +> myManageHook = resource =? "realplay.bin" --> doFloat hunk ./XMonad/Doc/Extending.hs 779 -Now, all we need to do is change the 'XMonad.Core.manageHook' field of -the 'XMonad.Core.XConfig' record, like so: +(Of course, if we wanted to completely replace the default +'XMonad.Config.manageHook', this step would not be necessary.) Now, +all we need to do is change the 'XMonad.Core.manageHook' field of the +'XMonad.Core.XConfig' record, like so: hunk ./XMonad/Doc/Extending.hs 784 -> main = xmonad defaultConfig { manageHook = newManageHook } +> main = xmonad defaultConfig { ..., manageHook = newManageHook, ... } hunk ./XMonad/Doc/Extending.hs 786 -And we are done. +And we are done. One more thing to note about this system is that if +a window matches multiple rules in a 'XMonad.Config.manageHook', /all/ +of the corresponding actions will be run (in the order in which they +are defined). This is a change from versions before 0.5, when only +the first rule that matched was run. hunk ./XMonad/Doc/Extending.hs 797 -When the stack of the windows managed by xmonad changes, for any +When the stack of the windows managed by xmonad changes for any hunk ./XMonad/Doc/Extending.hs 799 -dump some information of the internal state of xmonad, such as the +output some information about the internal state of xmonad, such as the hunk ./XMonad/Doc/Extending.hs 803 -Dumping the internal xmonad state can be somehow difficult, if you are -not familiar with the source code. It can be helpful to use a module -that has been designed specifically for logging some of the most -interesting information about the internal state of xmonad: -"XMonad.Hooks.DynamicLog". - -This module can be used with some external status bar that can be -configure to print, in a convenient way, the produced logs. - -dzen and xmobar are the most common status bars used by xmonad users. +Extracting information about the internal xmonad state can be somewhat +difficult if you are not familiar with the source code. Therefore, +it's usually easiest to use a module that has been designed +specifically for logging some of the most interesting information +about the internal state of xmonad: "XMonad.Hooks.DynamicLog". This +module can be used with an external status bar to print the produced +logs in a convenient way; the most commonly used status bars are dzen +and xmobar. hunk ./XMonad/Doc/Extending.hs 820 -'XMonad.Core.XConfig' record, like so: +'XMonad.Core.XConfig' record with one of the provided functions. For +example: hunk ./XMonad/Doc/Extending.hs 825 +More interesting configurations are also possible; see the +"XMonad.Hooks.DynamicLog" module for more possibilities. + hunk ./XMonad/Actions/FindEmptyWorkspace.hs 11 --- Find an empty workspace in XMonad. +-- Find an empty workspace. hunk ./XMonad/Actions/FindEmptyWorkspace.hs 31 --- --- To use, modify your Config.hs to: +-- +-- To use, import this module into your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Actions/FindEmptyWorkspace.hs 36 --- and add a keybinding: +-- and add the desired keybindings, for example: hunk ./XMonad/Actions/FindEmptyWorkspace.hs 41 --- Now you can jump to an empty workspace with mod-m. Mod-shift-m will --- tag the current window to an empty workspace and view it. - --- %import XMonad.Actions.FindEmptyWorkspace --- %keybind , ((modMask, xK_m ), viewEmptyWorkspace) --- %keybind , ((modMask .|. shiftMask, xK_m ), tagToEmptyWorkspace) - +-- Now you can jump to an empty workspace with @mod-m@. @Mod-shift-m@ +-- will tag the current window to an empty workspace and view it. +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/FlexibleManipulate.hs 8 --- +-- hunk ./XMonad/Actions/FlexibleManipulate.hs 13 --- Lets you move and resize floating windows without warping the mouse. +-- Move and resize floating windows without warping the mouse. hunk ./XMonad/Actions/FlexibleManipulate.hs 17 --- Based on the FlexibleResize code by Lukas Mai (Mauke) +-- Based on the FlexibleResize code by Lukas Mai (mauke). hunk ./XMonad/Actions/FlexibleManipulate.hs 31 --- Add this import to your Config.hs file: +-- First, add this import to your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Actions/FlexibleManipulate.hs 35 --- Set one of the mouse button bindings up like this: +-- Now set up the desired mouse binding, for example: +-- +-- > , ((modMask, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w)) +-- +-- * Flex.'linear' indicates that positions between the edges and the +-- middle indicate a combination scale\/position. +-- +-- * Flex.'discrete' indicates that there are discrete pick +-- regions. (The window is divided by thirds for each axis.) hunk ./XMonad/Actions/FlexibleManipulate.hs 45 --- > mouseBindings = M.fromList --- > [ ((modMask, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w)) ], ... +-- * Flex.'resize' performs only a resize of the window, based on which +-- quadrant the mouse is in. hunk ./XMonad/Actions/FlexibleManipulate.hs 48 --- Flex.linear indicates that positions between the edges and the middle --- indicate a combination scale\/position. --- Flex.discrete indicates that there are discrete pick regions. (window --- is divided by thirds for each axis) --- Flex.resize performs only resize of the window, based on which quadrant --- the mouse is in --- Flex.position is similar to the built-in mouseMoveWindow +-- * Flex.'position' is similar to the built-in +-- 'XMonad.Operations.mouseMoveWindow'. hunk ./XMonad/Actions/FlexibleManipulate.hs 53 --- the corresponding position if plain Flex.linear was used. - --- %import qualified XMonad.Actions.FlexibleManipulate as Flex --- %mousebind , ((modMask, button1), (\\w -> focus w >> Flex.mouseWindow Flex.linear w)) +-- the corresponding position if plain Flex.'linear' was used. hunk ./XMonad/Actions/FlexibleManipulate.hs 57 +-- | Manipulate the window based on discrete pick regions; the window +-- is divided into regions by thirds along each axis. hunk ./XMonad/Actions/FlexibleManipulate.hs 63 +-- | Scale\/reposition the window by factors obtained from the mouse +-- position by linear interpolation. Dragging precisely on a corner +-- resizes that corner; dragging precisely in the middle moves the +-- window without resizing; anything else is an interpolation +-- between the two. hunk ./XMonad/Actions/FlexibleManipulate.hs 70 +-- | Only resize the window, based on the window quadrant the mouse is in. hunk ./XMonad/Actions/FlexibleManipulate.hs 72 + +-- | Only reposition the window. hunk ./XMonad/Actions/FlexibleManipulate.hs 76 +-- | Given an interpolation function, implement an appropriate window +-- manipulation action. hunk ./XMonad/Actions/FlexibleManipulate.hs 101 - + hunk ./XMonad/Actions/FlexibleManipulate.hs 118 -zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c) +zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c) hunk ./XMonad/Actions/FlexibleManipulate.hs 54 +-- +-- For detailed instructions on editing your mouse bindings, see +-- "XMonad.Doc.Extending#Editing_mouse_bindings". hunk ./XMonad/Actions/FlexibleResize.hs 6 --- +-- hunk ./XMonad/Actions/FlexibleResize.hs 11 --- Lets you resize floating windows from any corner. +-- Resize floating windows from any corner. hunk ./XMonad/Actions/FlexibleResize.hs 28 --- Put something like this in your Config.hs file: +-- To use, first import this module into your @~\/.xmonad\/xmonad.hs@ file: hunk ./XMonad/Actions/FlexibleResize.hs 31 --- > mouseBindings = M.fromList --- > [ ... --- > , ((modMask, button3), (\w -> focus w >> Flex.mouseResizeWindow w)) ] - --- %import qualified XMonad.Actions.FlexibleResize as Flex --- %mousebind , ((modMask, button3), (\\w -> focus w >> Flex.mouseResizeWindow w)) +-- +-- Then add an appropriate mouse binding: +-- +-- > , ((modMask, button3), (\w -> focus w >> Flex.mouseResizeWindow w)) +-- +-- For detailed instructions on editing your mouse bindings, see +-- "XMonad.Doc.Extending#Editing_mouse_bindings". hunk ./XMonad/Actions/FlexibleResize.hs 39 +-- | Resize a floating window from whichever corner the mouse is +-- closest to. hunk ./XMonad/Actions/FloatKeys.hs 28 --- > import XMonad.Actions.FloatKeys +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Actions/FloatKeys.hs 30 --- > , ((modMask, xK_d ), withFocused (keysResizeWindow (-10,-10) (1,1))) --- > , ((modMask, xK_s ), withFocused (keysResizeWindow (10,10) (1,1))) --- > , ((modMask .|. shiftMask, xK_d ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752))) --- > , ((modMask .|. shiftMask, xK_s ), withFocused (keysAbsResizeWindow (10,10) (1024,752))) --- > , ((modMask, xK_a ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2))) --- --- --- keysMoveWindow (dx, dy) moves the window by dx pixels to the right and dy pixels down --- --- keysMoveWindowTo (x, y) (gx, gy) moves the window relative point (gx, gy) to the point (x,y) --- where (gx,gy) gives a position relative to the window border, i.e. --- gx = 0 is the left border and gx = 1 the right border --- gy = 0 is the top border and gy = 1 the bottom border +-- > import XMonad.Actions.FloatKeys hunk ./XMonad/Actions/FloatKeys.hs 32 --- examples on a 1024x768 screen: keysMoveWindowTo (512,384) (1%2, 1%2) centers the window on screen --- keysMoveWindowTo (1024,0) (1, 0) puts it into the top right corner +-- Then add appropriate key bindings, for example: hunk ./XMonad/Actions/FloatKeys.hs 34 --- keysResizeWindow (dx, dy) (gx, gy) changes the width by dx and the height by dy leaving the window --- relative point (gx, gy) fixed --- --- examples: keysResizeWindow (10, 0) (0, 0) makes the window 10 pixels larger to the right --- keysResizeWindow (10, 0) (0, 1%2) does the same, unless sizeHints are applied --- keysResizeWindow (10, 10) (1%2, 1%2) adds 5 pixels on each side --- keysResizeWindow (-10, -10) (0, 1) shrinks the window in direction of the bottom-left corner --- --- keysAbsResizeWindow (dx, dy) (ax, ay) changes the width by dx and the height by dy leaving the screen --- absolute point (ax, ay) fixed --- --- examples on a 1024x768 screen: keysAbsResizeWindow (10, 10) (0, 0) enlarge the window and if it is not in the top-left corner it will also be moved away +-- > , ((modMask, xK_d ), withFocused (keysResizeWindow (-10,-10) (1,1))) +-- > , ((modMask, xK_s ), withFocused (keysResizeWindow (10,10) (1,1))) +-- > , ((modMask .|. shiftMask, xK_d ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752))) +-- > , ((modMask .|. shiftMask, xK_s ), withFocused (keysAbsResizeWindow (10,10) (1024,752))) +-- > , ((modMask, xK_a ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2))) hunk ./XMonad/Actions/FloatKeys.hs 40 +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the +-- right and @dy@ pixels down. hunk ./XMonad/Actions/FloatKeys.hs 53 +-- | @keysMoveWindowTo (x, y) (gx, gy)@ moves the window relative +-- point @(gx, gy)@ to the point @(x,y)@, where @(gx,gy)@ gives a +-- position relative to the window border, i.e. @gx = 0@ is the left +-- border, @gx = 1@ is the right border, @gy = 0@ is the top border, and +-- @gy = 1@ the bottom border. +-- +-- For example, on a 1024x768 screen: +-- +-- > keysMoveWindowTo (512,384) (1%2, 1%2) -- center the window on screen +-- > keysMoveWindowTo (1024,0) (1, 0) -- put window in the top right corner hunk ./XMonad/Actions/FloatKeys.hs 74 +-- | @keysResizeWindow (dx, dy) (gx, gy)@ changes the width by @dx@ +-- and the height by @dy@, leaving the window-relative point @(gx, +-- gy)@ fixed. +-- +-- For example: +-- +-- > keysResizeWindow (10, 0) (0, 0) -- make the window 10 pixels larger to the right +-- > keysResizeWindow (10, 0) (0, 1%2) -- does the same, unless sizeHints are applied +-- > keysResizeWindow (10, 10) (1%2, 1%2) -- add 5 pixels on each side +-- > keysResizeWindow (-10, -10) (0, 1) -- shrink the window in direction of the bottom-left corner hunk ./XMonad/Actions/FloatKeys.hs 87 +-- | @keysAbsResizeWindow (dx, dy) (ax, ay)@ changes the width by @dx@ +-- and the height by @dy@, leaving the screen absolute point @(ax, +-- ay)@ fixed. +-- +-- For example: +-- +-- > keysAbsResizeWindow (10, 10) (0, 0) -- enlarge the window; if it is not in the top-left corner it will also be moved down and to the right. hunk ./XMonad/Actions/FloatKeys.hs 120 - (wn_pos, wn_dim) = f sh wa_pos wa_dim move resize + (wn_pos, wn_dim) = f sh wa_pos wa_dim move resize hunk ./XMonad/Actions/FocusNth.hs 11 --- Focus the nth window on the screen. +-- Focus the nth window of the current workspace. hunk ./XMonad/Actions/FocusNth.hs 24 +-- Add the import to your @~\/.xmonad\/xmonad.hs@: +-- hunk ./XMonad/Actions/FocusNth.hs 27 - +-- +-- Then add appropriate keybindings, for example: +-- hunk ./XMonad/Actions/FocusNth.hs 31 --- > ++ [((mod4Mask, k), focusNth i) +-- > ++ [((modMask x, k), focusNth i) hunk ./XMonad/Actions/FocusNth.hs 33 - --- %import XMonad.Actions.FocusNth --- %keybdindextra ++ --- %keybdindextra -- mod4-[1..9] @@ Switch to window N --- %keybdindextra [((mod4Mask, k), focusNth i) --- %keybdindextra | (i, k) <- zip [0 .. 8] [xK_1 ..]] +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/FocusNth.hs 37 +-- | Give focus to the nth window of the current workspace. hunk ./XMonad/Actions/Commands.hs 47 --- > , ((modMask .|. controlMask, xK_y), runCommand commands) +-- > , ((modMask x .|. controlMask, xK_y), runCommand commands) hunk ./XMonad/Actions/ConstrainedResize.hs 37 --- > , ((modMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w False)) --- > , ((modMask .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True )) +-- > , ((modMask x, button3), (\w -> focus w >> Sqr.mouseResizeWindow w False)) +-- > , ((modMask x .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True )) hunk ./XMonad/Actions/CopyWindow.hs 42 --- > [((m .|. modMask, k), f i) +-- > [((m .|. modMask x, k), f i) hunk ./XMonad/Actions/CopyWindow.hs 49 --- > , ((modMask .|. shiftMask, xK_c ), kill1) -- @@ Close the focused window +-- > , ((modMask x .|. shiftMask, xK_c ), kill1) -- @@ Close the focused window hunk ./XMonad/Actions/CycleWS.hs 43 --- > , ((modMask, xK_Right), nextWS) --- > , ((modMask, xK_Left), prevWS) --- > , ((modMask .|. shiftMask, xK_Right), shiftToNext) --- > , ((modMask .|. shiftMask, xK_Left), shiftToPrev) --- > , ((modMask, xK_t), toggleWS) +-- > , ((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_t), toggleWS) hunk ./XMonad/Actions/CycleWS.hs 51 --- > , ((modMask .|. shiftMask, xK_Right), shiftToNext >> nextWS) --- > , ((modMask .|. shiftMask, xK_Left), shiftToPrev >> prevWS) +-- > , ((modMask x .|. shiftMask, xK_Right), shiftToNext >> nextWS) +-- > , ((modMask x .|. shiftMask, xK_Left), shiftToPrev >> prevWS) hunk ./XMonad/Actions/DeManage.hs 49 --- > , ((modMask, xK_d ), withFocused demanage) +-- > , ((modMask x, xK_d ), withFocused demanage) hunk ./XMonad/Actions/DwmPromote.hs 37 --- > , ((modMask, xK_Return), dwmpromote) +-- > , ((modMask x, xK_Return), dwmpromote) hunk ./XMonad/Actions/FindEmptyWorkspace.hs 38 --- > , ((modMask, xK_m ), viewEmptyWorkspace) --- > , ((modMask .|. shiftMask, xK_m ), tagToEmptyWorkspace) +-- > , ((modMask x, xK_m ), viewEmptyWorkspace) +-- > , ((modMask x .|. shiftMask, xK_m ), tagToEmptyWorkspace) hunk ./XMonad/Actions/FlexibleManipulate.hs 37 --- > , ((modMask, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w)) +-- > , ((modMask x, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w)) hunk ./XMonad/Actions/FlexibleResize.hs 34 --- > , ((modMask, button3), (\w -> focus w >> Flex.mouseResizeWindow w)) +-- > , ((modMask x, button3), (\w -> focus w >> Flex.mouseResizeWindow w)) hunk ./XMonad/Actions/FloatKeys.hs 34 --- > , ((modMask, xK_d ), withFocused (keysResizeWindow (-10,-10) (1,1))) --- > , ((modMask, xK_s ), withFocused (keysResizeWindow (10,10) (1,1))) --- > , ((modMask .|. shiftMask, xK_d ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752))) --- > , ((modMask .|. shiftMask, xK_s ), withFocused (keysAbsResizeWindow (10,10) (1024,752))) --- > , ((modMask, xK_a ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2))) +-- > , ((modMask x, xK_d ), withFocused (keysResizeWindow (-10,-10) (1,1))) +-- > , ((modMask x, xK_s ), withFocused (keysResizeWindow (10,10) (1,1))) +-- > , ((modMask x .|. shiftMask, xK_d ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752))) +-- > , ((modMask x .|. shiftMask, xK_s ), withFocused (keysAbsResizeWindow (10,10) (1024,752))) +-- > , ((modMask x, xK_a ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2))) hunk ./XMonad/Hooks/DynamicLog.hs 26 + dynamicLogXmobar, hunk ./XMonad/Hooks/DynamicLog.hs 254 +-- | These are good defaults to be used with the xmobar status bar +dynamicLogXmobar :: X () +dynamicLogXmobar = + dynamicLogWithPP defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" + , ppTitle = xmobarColor "green" "" . shorten 40 + , ppVisible = wrap "(" ")" + } + hunk ./XMonad/Config/Arossato.hs 1 -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fglasgow-exts -fno-warn-missing-signatures #-} hunk ./XMonad/Config/Arossato.hs 16 -module XMonad.Config.Arossato +module XMonad.Config.Arossato hunk ./XMonad/Config/Arossato.hs 28 +import XMonad.ManageHook hunk ./XMonad/Config/Arossato.hs 35 +import XMonad.Layout.Magnifier hunk ./XMonad/Config/Arossato.hs 44 --- $usage +-- $usage hunk ./XMonad/Config/Arossato.hs 49 --- > +-- > hunk ./XMonad/Config/Arossato.hs 52 --- > +-- > hunk ./XMonad/Config/Arossato.hs 63 --- > module XMonad.Config.Arossato +-- > module XMonad.Config.Arossato hunk ./XMonad/Config/Arossato.hs 84 - defaultTConf { activeColor = "#8a999e" + defaultTConf { activeColor = "#8a999e" hunk ./XMonad/Config/Arossato.hs 94 - { workspaces = ["1", "2"] ++ - ["dev","mail","web"] ++ - map show [6 .. 9 :: Int] - , logHook = dynamicLogWithPP myPP + { workspaces = ["home","var","dev","mail","web","doc"] ++ + map show [7 .. 9 :: Int] + , logHook = dynamicLogXmobar + , manageHook = newManageHook hunk ./XMonad/Config/Arossato.hs 99 + magnifier tiled ||| hunk ./XMonad/Config/Arossato.hs 101 - tiled ||| - Mirror tiled ||| + tiled ||| + Mirror tiled ||| hunk ./XMonad/Config/Arossato.hs 104 - , terminal = "urxvt -fg white -bg black +sb" + , terminal = "urxvt +sb" hunk ./XMonad/Config/Arossato.hs 110 - where + where hunk ./XMonad/Config/Arossato.hs 113 - tiled = Tall 1 0.03 0.5 - - -- the logHook pretty-printer - myPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" - , ppTitle = xmobarColor "green" "" . shorten 80 - } + tiled = Tall 1 (3/100) (1/2) + + -- manageHook + myManageHook = composeAll [ resource =? "realplay.bin" --> doFloat + , resource =? "win" --> doF (W.shift "doc") -- xpdf + , resource =? "firefox-bin" --> doF (W.shift "web") + ] + newManageHook = myManageHook <+> manageHook defaultConfig hunk ./XMonad/Config/Arossato.hs 127 - toRemove x = - [ (modMask x , xK_j ) - , (modMask x , xK_k ) - , (modMask x , xK_p ) - , (modMask x .|. shiftMask, xK_p ) - , (modMask x .|. shiftMask, xK_q ) - , (modMask x , xK_q ) + toRemove x = + [ (modMask x , xK_j) + , (modMask x , xK_k) + , (modMask x , xK_p) + , (modMask x .|. shiftMask, xK_p) + , (modMask x .|. shiftMask, xK_q) + , (modMask x , xK_q) hunk ./XMonad/Config/Arossato.hs 138 - toAdd x = - [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) - , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) - , ((modMask x , xK_F4 ), sshPrompt defaultXPConfig ) - , ((modMask x , xK_F5 ), windowPromptGoto defaultXPConfig ) - , ((modMask x .|. shiftMask, xK_F5 ), windowPromptBring defaultXPConfig ) - , ((modMask x , xK_comma ), prevWS ) - , ((modMask x , xK_period), nextWS ) - , ((modMask x , xK_Right ), windows W.focusDown ) - , ((modMask x , xK_Left ), windows W.focusUp ) + toAdd x = + [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) + , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) + , ((modMask x , xK_F4 ), sshPrompt defaultXPConfig ) + , ((modMask x , xK_F5 ), windowPromptGoto defaultXPConfig ) + , ((modMask x , xK_F6 ), windowPromptBring defaultXPConfig ) + , ((modMask x , xK_comma ), prevWS ) + , ((modMask x , xK_period), nextWS ) + , ((modMask x , xK_Right ), windows W.focusDown ) + , ((modMask x , xK_Left ), windows W.focusUp ) hunk ./XMonad/Config/Arossato.hs 149 - , ((modMask x , xK_F2 ), spawn "urxvt -fg white -bg black +sb") - , ((modMask x .|. shiftMask, xK_F4 ), spawn "~/bin/dict.sh" ) - , ((modMask x .|. shiftMask, xK_F5 ), spawn "~/bin/urlOpen.sh" ) - , ((modMask x , xK_c ), kill ) - , ((modMask x .|. shiftMask, xK_comma ), sendMessage (IncMasterN 1 ) ) - , ((modMask x .|. shiftMask, xK_period), sendMessage (IncMasterN (-1)) ) + , ((modMask x , xK_F2 ), spawn "urxvt -fg white -bg black +sb" ) + , ((modMask x .|. shiftMask, xK_F4 ), spawn "~/bin/dict.sh" ) + , ((modMask x .|. shiftMask, xK_F5 ), spawn "~/bin/urlOpen.sh" ) + , ((modMask x , xK_c ), kill ) + , ((modMask x .|. shiftMask, xK_comma ), sendMessage (IncMasterN 1 ) ) + , ((modMask x .|. shiftMask, xK_period), sendMessage (IncMasterN (-1)) ) + -- commands fo the Magnifier layout + , ((modMask x .|. controlMask , xK_plus ), sendMessage MagnifyMore) + , ((modMask x .|. controlMask , xK_minus), sendMessage MagnifyLess) + , ((modMask x .|. controlMask , xK_o ), sendMessage ToggleOff ) + , ((modMask x .|. controlMask .|. shiftMask, xK_o ), sendMessage ToggleOn ) hunk ./XMonad/Doc/Extending.hs 732 -Each 'XMonad.Config.ManageHook' has the form +Each 'XMonad.Config.ManageHook' has the form: hunk ./XMonad/Doc/Extending.hs 752 -@match@ is string that will match the property value; +@match@ is the string that will match the property value (for instance +the one you retrieved with @xprop@). hunk ./XMonad/Doc/Extending.hs 755 -and @action@ can be: +An @action@ can be: hunk ./XMonad/Doc/Extending.hs 761 -* 'XMonad.ManageHook.doF': to execute a function with the window. +* 'XMonad.ManageHook.doF': to execute a function with the window as + argument. hunk ./XMonad/Doc/Extending.hs 779 -> newManageHook = myManageHook <+> (manageHook defaultConfig) +> newManageHook = myManageHook <+> manageHook defaultConfig hunk ./XMonad/Doc/Extending.hs 794 +Obviously we may be willing to add more then one +'XMonad.Config.manageHook'. In this case we can use a list of hooks, +compose them all with 'XMonad.ManageHook.composeAll', and add the +composed to the default one. + +For instance, if we want RealPlayer to float and thunderbird always +opened in the workspace named "mail" we can do like this: + +> myManageHook = composeAll [ resource =? "realplay.bin" --> doFloat +> , resource =? "thunderbird-bin" --> doF (W.shift "mail") +> ] + +Remember to import the module that defines the 'XMonad.StackSet.shift' +function, "XMonad.StackSet", like this: + +> import qualified XMonad.StackSet as W + +And then we can add @myManageHook@ to the default one to create +@newManageHook@ as we did in the previous example. + hunk ./XMonad/Doc/Developing.hs 3 --- Module : Documentation +-- Module : XMonad.Doc.Developing hunk ./XMonad/Doc/Developing.hs 14 --- xmonad code and want an brief overview of it. +-- xmonad source code and want an brief overview of it. +-- +-- While some knowledge of Haskell is required, still this document is +-- also intended for the beginner\/intermediate Haskell programmer who +-- could find writing an xmonad extension a motivation for deepening +-- her understanding of this powerful functional language. hunk ./XMonad/Doc/Developing.hs 32 - -- * Writing new extensions - -- $writing + -- -- * Writing new extensions + -- -- $writing hunk ./XMonad/Doc/Developing.hs 67 - -Writing Other Extensions - hunk ./XMonad/Doc/Developing.hs 71 -xmonad and xmonad-contrib are just libraries for letting users write -their own window managers. This is what makes xmonad such a powerful -and still simple application. +Starting from version 0.5, xmonad and xmonad-contrib are packaged and +distributed as libraries. This way of distributing xmonad has many +advantages, since it allows the packaging by GNU\/Linux distributions +while letting the user have the possibility of greatly customizing the +window manager to fit her needs. hunk ./XMonad/Doc/Developing.hs 77 -Give some examples: -arossato_vm -droundy_wm +Basically, xmonad and the xmonad-contrib libraries let users write +their own window manager in a matter of a few lines of code. hunk ./XMonad/Doc/Developing.hs 80 -In the previous sections we show how simple it can be to write your -own window manager by using the core code (xmonad) and some of the -contributed code (xmonad-contrib). +In fact, what seems to be just a configuration file, +@~\/.xmonad\/xmonad.hs@ (whose presence is not necessary for running +the default configuration), is indeed a full Haskell program, with its +@main@ entry point. hunk ./XMonad/Doc/Developing.hs 85 -In this section we will give you a brief overview of the programming -techniques that have been used in order to make writing new extensions -very simple. +This makes it possible, not only to edit the xmonad default +configuration, as we have seen the "XMonad.Doc.Extending" document, +but also to use the Haskell programming language to extend the tasks +performed by the window manager you are writing every time you write +your own @~\/.xmonad\/xmonad.hs@. + +This is obviously out of the scope of this document, which instead +will be focused on the xmonad internals, by describing, very briefly, +the programming techniques that have been employed in order to make +writing new extensions very simple. hunk ./XMonad/Doc/Developing.hs 99 - -TODO - hunk ./XMonad/Doc/Developing.hs 104 -TODO +xmonad installs a binary, @xmonad@, which must be executed by the +Xsession starting script. This binary, whose code can be read in +@Main.hs@ of the xmonad source tree, will use 'XMonad.Core.recompile' +to run @ghc@ in order to build a binary from @~\/.xmonad\/xmonad.hs@. +If this compilation process fails, for any reason, a default @main@ +entry point will be used, which calls 'XMonad.Main.xmonad', from the +"XMonad.Main" module. + +So, the real @main@ entry point, the one that even users' application +in @~\/.xmonad\/xmonad.hs@ must call, is 'XMonad.Main.xmonad' + +'XMonad.Main.xmonad' takes the configuration as its only argument, +configuration whose type ('XMonad.Core.XConfig') is defined in +"XMonad.Core". + +'XMonad.Main.xmonad' takes care of opening the connection with the X +server, initializing the state (or deserializing it when restarted) +and the configuration, and calling the event handler +('XMonad.Main.handle') that will 'Prelude.forever' loop waiting for +events and acting accordingly. hunk ./XMonad/Doc/Developing.hs 129 -TODO +The event loop which calls 'XMonad.Main.handle' to react to events is +run within the 'XMonad.Core.X' monad, which is a +'Control.Monad.State.StateT' transformer over 'IO', encapsulated +within a 'Control.Monad.Reader.ReaderT' transformer. The +'Control.Monad.State.StateT' transformer encapsulates the (writable) +state of the window manager ('XMonad.Core.XState'), whereas the +'Control.Monad.Reader.ReaderT' transformer encapsulates the +(read-only) configuration ('XMonad.Core.XConf'). + +Thanks to the @newtype deriving@ clause the instance of the +'Control.Monad.State.MonadState' class parametrized over +'XMonad.Core.XState' and the instance of the +'Control.Monad.Reader.MonadReader' class parametrized over +'XMonad.Core.XConf' are automatically derived from us by ghc. This way +we can use 'Control.Monad.State.get', 'Control.Monad.State.gets' and +'Control.Monad.State.modify' for the 'XMonad.Core.XState', and +'Control.Monad.Reader.ask' and 'Control.Monad.Reader.asks' for +reading the 'XMonad.Core.XConf'. + +'XMonad.Core.XState' is where all the sensitive information about +windows managing is stored. And the main record of the +'XMonad.Core.XState' is the 'XMonad.Core.windowset', whose type +('XMonad.Core.WindowSet') is a type synonymous for a +'XMonad.StackSet.StackSet' parametrized over a +'XMonad.Core.WorkspaceID' (a 'String'), a layout type wrapped inside +the 'XMonad.Layout.Layout' existential data type, the +'Graphics.X11.Types.Window' type, the 'XMonad.Core.ScreenID' and the +'XMonad.Core.ScreenDetail's. + +What a 'XMonad.StackSet.StackSet' is and how it can be manipulated +with pure functions is perfectly described in the Haddock +documentation of the "XMonad.StackSet" module, and will not be repeated +here. + +The 'XMonad.StackSet.StackSet' ('XMonad.Core.WindowSet') has 4 +records: + +* 'XMonad.StackSet.current', for the current, focused workspace. This + is a 'XMonad.StackSet.Screen', composed by a + 'XMonad.StackSet.Workspace', and the screen information (for + Xinerama support). + +* 'XMonad.StackSet.visible', a list of 'XMonad.StackSet.Screen's for + the other visible (with Xinerama) workspaces. + +* 'XMonad.StackSet.hidden', the list of 'XMonad.StackSet.Screen's for + non visible workspaces. + +The 'XMonad.StackSet.Workspace' type is made of a +'XMonad.StackSet.tag', a 'XMonad.StackSet.layout' and +'XMonad.StackSet.stack', possibly empy, of windows. + +"XMonad.StackSet", to be imported qualified, provides many pure +functions to manipulate the 'XMonad.StackSet.StackSet'. These +functions are usually used as the argument of +'XMonad.Operations.windows', which indeed takes a pure function to +manipulate the 'XMonad.Core.WindowSet' and does all the needed +operations to refresh the screen and save the modified +'XMonad.Core.XState'. + +During 'XMonad.Operations.windows' calls the 'XMonad.StackSet.layout' +record of the 'XMonad.StackSet.current' and 'XMonad.StackSet.visible' +'XMonad.StackSet.Workspace's is used to arrange the +'XMonad.StackSet.stack' of windows of each workspace. + +The possibility of manipulating the 'XMonad.StackSet.StackSet' +('XMonad.Core.WindowSet') with pure functions makes it possible to +test all the properties of those functions with QuickCheck, providing +greater reliability of the core code. + +Every change to the "XMonad.StackSet" module must be accompanied with +the set of property to be tested with QuickCheck before being applied. hunk ./XMonad/Doc/Developing.hs 206 -TODO +Events and event handling are the main data and activity xmonad is +involved with. And X Events are one of the most important. + +Still there may be events that are generated by layouts, or by the +user, for sending commands to layouts, for instance. + +"XMonad.Core" defines a class that generalizes the concept of events, +'XMonad.Core.Message', constrained to types with a +'Data.Typeable.Typeable' instance definition (which can be +automatically derived by ghc). + +'XMonad.Core.Message's are wrapped within an existential type +'XMonad.Core.SomeMessage'. + +The 'Data.Typeable.Typeable' constraint allows us to define a +'XMonad.Core.fromMessage' function that can unwrap the message with +'Data.Typeable.cast'. + +X Events are instances of this class. + +By using the 'Data.Typeable.Typeable' class for any kind of +'XMonad.Core.Message's and events we can define polymorphic functions +and use them for processing messages or unhandled events. + +This is precisely what happens with X events: xmonad passes them to +'XMonad.Main.handle'. If the main event handling function doesn't have +anything to do with the event, the event is sent to all visible +layouts by 'XMonad.Operations.bradcastMessage'. + +This messaging system allows the user to create new message types, +simply declare an instance of the 'Data.Typeable.Typeable' and use +'XMonad.Operations.sendMessage' to send commands to layouts. + +And, finally, layouts may handle X events and other messages within the +same function... miracles of polymorphism. hunk ./XMonad/Doc/Developing.hs 246 -TODO - +to do hunk ./XMonad/Doc/Extending.hs 788 -And we are done. One more thing to note about this system is that if -a window matches multiple rules in a 'XMonad.Config.manageHook', /all/ -of the corresponding actions will be run (in the order in which they -are defined). This is a change from versions before 0.5, when only -the first rule that matched was run. +And we are done. hunk ./XMonad/Doc/Extending.hs 790 -Obviously we may be willing to add more then one +Obviously, we may wish to add more then one hunk ./XMonad/Doc/Extending.hs 796 -opened in the workspace named "mail" we can do like this: +opened in the workspace named "mail", we can do so like this: hunk ./XMonad/Doc/Extending.hs 810 +One more thing to note about this system is that if +a window matches multiple rules in a 'XMonad.Config.manageHook', /all/ +of the corresponding actions will be run (in the order in which they +are defined). This is a change from versions before 0.5, when only +the first rule that matched was run. + hunk ./XMonad/Actions/MouseGestures.hs 6 --- +-- hunk ./XMonad/Actions/MouseGestures.hs 11 --- Support for simple mouse gestures +-- Support for simple mouse gestures. hunk ./XMonad/Actions/MouseGestures.hs 35 --- In your Config.hs: hunk ./XMonad/Actions/MouseGestures.hs 36 --- > import XMonad.Actions.MouseGestures --- > ... --- > mouseBindings = M.fromList $ --- > [ ... --- > , ((modMask .|. shiftMask, button3), mouseGesture gestures) --- > ] --- > where +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.Commands +-- > import qualified XMonad.StackSet as W +-- +-- then add an appropriate mouse binding: +-- +-- > , ((modMask x .|. shiftMask, button3), mouseGesture gestures) +-- +-- where @gestures@ is a 'Data.Map.Map' from gestures to actions on +-- windows, for example: +-- hunk ./XMonad/Actions/MouseGestures.hs 55 --- This is just an example, of course. You can use any mouse button and +-- This is just an example, of course; you can use any mouse button and hunk ./XMonad/Actions/MouseGestures.hs 57 +-- +-- For detailed instructions on editing your mouse bindings, see +-- "XMonad.Doc.Extending#Editing_mouse_bindings". hunk ./XMonad/Actions/MouseGestures.hs 61 +-- | The four cardinal screen directions. A \"gesture\" is a sequence of +-- directions. hunk ./XMonad/Actions/MouseGestures.hs 111 +-- | Given a 'Data.Map.Map' from lists of directions to actions with +-- windows, figure out which one the user is performing, and return +-- the corresponding action. hunk ./XMonad/Actions/RotSlaves.hs 11 --- Rotate all windows except the master window --- and keep the focus in place. +-- Rotate all windows except the master window and keep the focus in +-- place. hunk ./XMonad/Actions/RotSlaves.hs 30 --- and add a keybinding: +-- and add whatever keybindings you would like, for example: hunk ./XMonad/Actions/RotSlaves.hs 32 --- > , ((modMask .|. shiftMask, xK_Tab ), rotSlavesUp) +-- > , ((modMask x .|. shiftMask, xK_Tab ), rotSlavesUp) hunk ./XMonad/Actions/RotSlaves.hs 34 +-- This operation will rotate all windows except the master window, +-- while the focus stays where it is. It is useful together with the +-- TwoPane layout (see "XMonad.Layout.TwoPane"). hunk ./XMonad/Actions/RotSlaves.hs 38 --- This operation will rotate all windows except the master window, while the focus --- stays where it is. It is useful together with the TwoPane-Layout (see "XMonad.Layout.TwoPane"). +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/RotSlaves.hs 41 --- %import XMonad.Actions.RotSlaves --- %keybind , ((modMask .|. shiftMask, xK_Tab ), rotSlavesUp) - --- | Rotate the windows in the current stack excluding the first one +-- | Rotate the windows in the current stack, excluding the first one +-- (master). hunk ./XMonad/Actions/RotSlaves.hs 47 +-- | The actual rotation, as a pure function on the window stack. hunk ./XMonad/Actions/RotSlaves.hs 55 --- | Rotate the windows in the current stack +-- | Rotate all the windows in the current stack. hunk ./XMonad/Actions/RotSlaves.hs 60 +-- | The actual rotation, as a pure function on the window stack. hunk ./xmonad-contrib.cabal 9 - Documentation on building, configuring and using xmonad - extensions: "XMonad.Doc" + For an introduction to building, configuring and using xmonad + extensions, see "XMonad.Doc" hunk ./xmonad-contrib.cabal 38 - build-depends: mtl, unix, X11==1.3.0.20071111, xmonad==0.4 + build-depends: mtl, unix, X11==1.4.0, xmonad==0.4 hunk ./xmonad-contrib.cabal 10 - extensions, see "XMonad.Doc" + extensions, see "XMonad.Doc". In particular: + . + "XMonad.Doc.Configuring", a guide to configuring xmonad + . + "XMonad.Doc.Developing", introduction to xmonad internals + . + "XMonad.Doc.Extending", how to extend xmonad yourself + . hunk ./xmonad-contrib.cabal 14 - "XMonad.Doc.Developing", introduction to xmonad internals + "XMonad.Doc.Extending", using the contributed extensions library hunk ./xmonad-contrib.cabal 16 - "XMonad.Doc.Extending", how to extend xmonad yourself + "XMonad.Doc.Developing", introduction to xmonad internals and writing + your own extensions. hunk ./XMonad/Config/Droundy.hs 137 - Named "widescreen" ((mytab <||> mytab) + Named "widescreen" ((mytab XMonad.Layout.LayoutCombinators.<||> mytab) hunk ./XMonad/Layout/LayoutCombinators.hs 29 -import XMonad +import XMonad.Core hunk ./XMonad/Actions/CopyWindow.hs 42 --- > [((m .|. modMask x, k), f i) --- > | (i, k) <- zip workspaces [xK_1 ..] --- > , (f, m) <- [(view, 0), (shift, shiftMask), (copy, shiftMask .|. controlMask)]] +-- > [((m .|. modMask x, k), windows $ f i) +-- > | (i, k) <- zip (workspaces x) [xK_1 ..] +-- > , (f, m) <- [(W.view, 0), (W.shift, shiftMask), (copy, shiftMask .|. controlMask)]] +-- +-- To use the above key bindings you need also to import +-- "XMonad.StackSet": +-- +-- > import qualified XMonad.StackSet as W hunk ./XMonad/Config/Droundy.hs 136 - Named "xclock" (mytab <-//> combineTwo Square mytab mytab) ||| - Named "widescreen" ((mytab XMonad.Layout.LayoutCombinators.<||> mytab) - <-//> combineTwo Square mytab mytab) ||| + Named "xclock" (mytab **//* combineTwo Square mytab mytab) ||| + Named "widescreen" ((mytab *||* mytab) + **//* combineTwo Square mytab mytab) ||| hunk ./XMonad/Layout/LayoutCombinators.hs 19 - (<||>),(<-||>),(<||->), - (),(<-//>),(), - (<|>),(<-|>),(<|->), - (),(<-/>),(), + + -- * Combinators using DragPane vertical + -- $dpv + (*||*), (**||*),(***||*),(****||*),(***||**),(****||***), + (***||****),(*||****),(**||***),(*||***),(*||**), + + -- * Combinators using DragPane Horizontal + -- $dph + (*//*), (**//*),(***//*),(****//*),(***//**),(****//***), + (***//****),(*//****),(**//***),(*//***),(*//**), + + -- * Combinators using Mirror Tall Vertical + -- $mtv + (*|*), (**|*),(***|*),(****|*),(***|**),(****|***), + (***|****),(*|****),(**|***),(*|***),(*|**), + + -- * Combinators using Mirror Tall Horizontal + -- $mth + (*/*), (**/*),(***/*),(****/*),(***/**),(****/***), + (***/****),(*/****),(**/***),(*/***),(*/**), + + -- * A new combinator + -- $nc hunk ./XMonad/Layout/LayoutCombinators.hs 60 --- > myLayouts = (Tall 1 (3/100) (1/2) <-/> Full) ||| (Tall 1 (3/100) (1/2) <||-> Full) ||| Full ||| etc.. +-- > myLayouts = (Tall 1 (3/100) (1/2) *//* Full) ||| (Tall 1 (3/100) (1/2) ***||** Full) ||| Full ||| etc.. hunk ./XMonad/Layout/LayoutCombinators.hs 67 -infixr 6 <||>, , <-||>, <-//>, <||->, , <|>, <-|>, <|->, , <-/>, +infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, **||***, *||***, *||**, + *//*, **//*, ***//*, ****//*, ***//**, ****//***, ***//****, *//****, **//***, *//***, *//**, + *|* , **|* , ***|* , ****|* , ***|** , ****|*** , ***|**** , *|**** , **|*** , *|*** , *|** , + */* , **/* , ***/* , ****/* , ***/** , ****/*** , ***/**** , */**** , **/*** , */*** , */** hunk ./XMonad/Layout/LayoutCombinators.hs 72 --- | Combines two layouts vertically using dragPane -(<||>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => +-- $dpv +-- These combinators combine 2 layouts using "XMonad.DragPane" in +-- vertical mode. +(*||*),(**||*),(***||*),(****||*), (***||**),(****||***), + (***||****),(*||****),(**||***),(*||***),(*||**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => hunk ./XMonad/Layout/LayoutCombinators.hs 79 --- | Combines two layouts vertically using dragPane giving more screen --- to the first layout -(<-||>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => - l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a +(*||*) = combineTwo (dragPane Vertical 0.1 (1/2)) +(**||*) = combineTwo (dragPane Vertical 0.1 (2/3)) +(***||*) = combineTwo (dragPane Vertical 0.1 (3/4)) +(****||*) = combineTwo (dragPane Vertical 0.1 (4/5)) +(***||**) = combineTwo (dragPane Vertical 0.1 (3/5)) +(****||***) = combineTwo (dragPane Vertical 0.1 (4/7)) +(***||****) = combineTwo (dragPane Vertical 0.1 (3/7)) +(*||****) = combineTwo (dragPane Vertical 0.1 (1/5)) +(**||***) = combineTwo (dragPane Vertical 0.1 (2/5)) +(*||***) = combineTwo (dragPane Vertical 0.1 (1/4)) +(*||**) = combineTwo (dragPane Vertical 0.1 (1/3)) hunk ./XMonad/Layout/LayoutCombinators.hs 91 --- | Combines two layouts vertically using dragPane giving more screen --- to the second layout -(<||->) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => +-- $dph +-- These combinators combine 2 layouts using "XMonad.DragPane" in +-- horizontal mode. +(*//*),(**//*),(***//*),(****//*), (***//**),(****//***), + (***//****),(*//****),(**//***),(*//***),(*//**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => hunk ./XMonad/Layout/LayoutCombinators.hs 98 --- | Combines two layouts horizzontally using dragPane -() :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => - l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a +(*//*) = combineTwo (dragPane Horizontal 0.1 (1/2)) +(**//*) = combineTwo (dragPane Horizontal 0.1 (2/3)) +(***//*) = combineTwo (dragPane Horizontal 0.1 (3/4)) +(****//*) = combineTwo (dragPane Horizontal 0.1 (4/5)) +(***//**) = combineTwo (dragPane Horizontal 0.1 (3/5)) +(****//***) = combineTwo (dragPane Horizontal 0.1 (4/7)) +(***//****) = combineTwo (dragPane Horizontal 0.1 (3/7)) +(*//****) = combineTwo (dragPane Horizontal 0.1 (1/5)) +(**//***) = combineTwo (dragPane Horizontal 0.1 (2/5)) +(*//***) = combineTwo (dragPane Horizontal 0.1 (1/4)) +(*//**) = combineTwo (dragPane Horizontal 0.1 (1/3)) hunk ./XMonad/Layout/LayoutCombinators.hs 110 --- | Combines two layouts horizzontally using dragPane giving more screen --- to the first layout -(<-//>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => - l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a - --- | Combines two layouts horizzontally using dragPane giving more screen --- to the first layout -() :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => - l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a - --- | Combines two layouts vertically using Tall -(<|>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) +-- $mtv +-- These combinators combine two layouts vertivally using Mirror +-- Tall. +(*|*),(**|*),(***|*),(****|*), (***|**),(****|***), + (***|****),(*|****),(**|***),(*|***),(*|**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) hunk ./XMonad/Layout/LayoutCombinators.hs 116 +(*|*) = combineTwo (Tall 1 0.1 (1/2)) +(**|*) = combineTwo (Tall 1 0.1 (2/3)) +(***|*) = combineTwo (Tall 1 0.1 (3/4)) +(****|*) = combineTwo (Tall 1 0.1 (4/5)) +(***|**) = combineTwo (Tall 1 0.1 (3/5)) +(****|***) = combineTwo (Tall 1 0.1 (4/7)) +(***|****) = combineTwo (Tall 1 0.1 (3/7)) +(*|****) = combineTwo (Tall 1 0.1 (1/5)) +(**|***) = combineTwo (Tall 1 0.1 (2/5)) +(*|***) = combineTwo (Tall 1 0.1 (1/4)) +(*|**) = combineTwo (Tall 1 0.1 (1/3)) hunk ./XMonad/Layout/LayoutCombinators.hs 128 --- | Combines two layouts vertically using Tall giving more screen --- to the first layout -(<-|>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) - => l1 a -> l2 a -> CombineTwo (Tall ()) l1 l2 a hunk ./XMonad/Layout/LayoutCombinators.hs 129 --- | Combines two layouts vertically using Tall giving more screen --- to the second layout -(<|->) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) - => l1 a -> l2 a -> CombineTwo (Tall ()) l1 l2 a - --- | Combines two layouts horizzontally using Mirror Tall (a wide --- layout) -() :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) +-- $mtv +-- These combinators combine two layouts horizzontally using Mirror +-- Tall (a wide layout) +(*/*),(**/*),(***/*),(****/*), (***/**),(****/***), + (***/****),(*/****),(**/***),(*/***),(*/**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) hunk ./XMonad/Layout/LayoutCombinators.hs 135 - --- | Combines two layouts horizzontally using Mirror Tall (a wide --- layout) giving more screen to the first layout -(<-/>) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) - => l1 a -> l2 a -> CombineTwo (Mirror Tall ()) l1 l2 a - --- | Combines two layouts horizzontally using Mirror Tall (a wide --- layout) giving more screen to the second layout -() :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) - => l1 a -> l2 a -> CombineTwo (Mirror Tall ()) l1 l2 a - --- implementation -(<||>) = combineTwo (dragPane Vertical 0.1 0.5) -(<-||>) = combineTwo (dragPane Vertical 0.1 0.2) -(<||->) = combineTwo (dragPane Vertical 0.1 0.8) -() = combineTwo (dragPane Horizontal 0.1 0.5) -(<-//>) = combineTwo (dragPane Horizontal 0.1 0.8) -() = combineTwo (dragPane Horizontal 0.1 0.2) -(<|>) = combineTwo (Tall 1 0.1 0.5) -(<-|>) = combineTwo (Tall 1 0.1 0.8) -(<|->) = combineTwo (Tall 1 0.1 0.1) -() = combineTwo (Mirror $ Tall 1 0.1 0.5) -(<-/>) = combineTwo (Mirror $ Tall 1 0.1 0.8) -() = combineTwo (Mirror $ Tall 1 0.1 0.2) +(*/*) = combineTwo (Mirror $ Tall 1 0.1 (1/2)) +(**/*) = combineTwo (Mirror $ Tall 1 0.1 (2/3)) +(***/*) = combineTwo (Mirror $ Tall 1 0.1 (3/4)) +(****/*) = combineTwo (Mirror $ Tall 1 0.1 (4/5)) +(***/**) = combineTwo (Mirror $ Tall 1 0.1 (3/5)) +(****/***) = combineTwo (Mirror $ Tall 1 0.1 (4/7)) +(***/****) = combineTwo (Mirror $ Tall 1 0.1 (3/7)) +(*/****) = combineTwo (Mirror $ Tall 1 0.1 (1/5)) +(**/***) = combineTwo (Mirror $ Tall 1 0.1 (2/5)) +(*/***) = combineTwo (Mirror $ Tall 1 0.1 (1/4)) +(*/**) = combineTwo (Mirror $ Tall 1 0.1 (1/3)) hunk ./XMonad/Layout/LayoutCombinators.hs 149 --- | A new layout combinator that allows the use of a prompt to change +-- $nc +-- A new layout combinator that allows the use of a prompt to change hunk ./XMonad/Layout/LayoutCombinators.hs 25 - -- * Combinators using DragPane Horizontal + -- * Combinators using DragPane horizontal hunk ./XMonad/Layout/LayoutCombinators.hs 30 - -- * Combinators using Mirror Tall Vertical - -- $mtv + -- * Combinators using Tall (vertical) + -- $tv hunk ./XMonad/Layout/LayoutCombinators.hs 35 - -- * Combinators using Mirror Tall Horizontal + -- * Combinators using Mirror Tall (horizontal) hunk ./XMonad/Layout/LayoutCombinators.hs 73 --- These combinators combine 2 layouts using "XMonad.DragPane" in +-- These combinators combine two layouts using "XMonad.DragPane" in hunk ./XMonad/Layout/LayoutCombinators.hs 92 --- These combinators combine 2 layouts using "XMonad.DragPane" in +-- These combinators combine two layouts using "XMonad.DragPane" in hunk ./XMonad/Layout/LayoutCombinators.hs 110 --- $mtv --- These combinators combine two layouts vertivally using Mirror --- Tall. +-- $tv +-- These combinators combine two layouts vertically using Tall. hunk ./XMonad/Layout/LayoutCombinators.hs 128 --- $mtv --- These combinators combine two layouts horizzontally using Mirror --- Tall (a wide layout) +-- $mth +-- These combinators combine two layouts horizontally using Mirror +-- Tall (a wide layout). hunk ./XMonad/Layout/LayoutCombinators.hs 218 --- LocalWords: horizzontally hunk ./XMonad/Actions/RotView.hs 31 --- You can use this module with the following in your Config.hs file: +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Actions/RotView.hs 36 --- > , ((modMask .|. shiftMask, xK_Right), rotView True) --- > , ((modMask .|. shiftMask, xK_Left), rotView False) - --- %import XMonad.Actions.RotView --- %keybind , ((modMask .|. shiftMask, xK_Right), rotView True) --- %keybind , ((modMask .|. shiftMask, xK_Left), rotView False) +-- Then add appropriate key bindings, such as: +-- +-- > , ((modMask x .|. shiftMask, xK_Right), rotView True) +-- > , ((modMask x .|. shiftMask, xK_Left), rotView False) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/RotView.hs 44 +-- | Cycle through non-empty workspaces. True --> cycle in the forward +-- direction. Note that workspaces cycle in order by tag, so if your +-- workspaces are not in tag-order, the cycling might seem wonky. hunk ./XMonad/Doc/Developing.hs 11 --- This module documents the xmonad internals. +-- This module documents the xmonad internals. It is intended for +-- advanced users who are curious about the xmonad source code and +-- want an brief overview. This document may also be helpful for the +-- beginner\/intermediate Haskell programmer who is motivated to write +-- an xmonad extension as a way to deepen her understanding of this +-- powerful functional language; however, there is not space here to +-- go into much detail. A more comprehensive document introducing +-- beginner\/intermediate Haskell programmers to the xmonad source is +-- planned for the xmonad users' wiki +-- (). hunk ./XMonad/Doc/Developing.hs 22 --- It is intended for the advanced users who are curious about the --- xmonad source code and want an brief overview of it. --- --- While some knowledge of Haskell is required, still this document is --- also intended for the beginner\/intermediate Haskell programmer who --- could find writing an xmonad extension a motivation for deepening --- her understanding of this powerful functional language. --- --- It may be useful also for those who would like to extend xmonad. If --- you think your extension may be useful for other users too, you may --- consider about releasing it. --- --- Coding guidelines and licencing policies must be followed if you --- want your code to be included in the official repositories. +-- If you write an extension module and think it may be useful for +-- others, consider releasing it. Coding guidelines and licensing +-- policies are covered at the end of this document, and must be +-- followed if you want your code to be included in the official +-- repositories. hunk ./XMonad/Doc/Developing.hs 32 - -- -- * Writing new extensions - -- -- $writing + -- * Writing new extensions + -- $writing hunk ./XMonad/Doc/Developing.hs 71 -Starting from version 0.5, xmonad and xmonad-contrib are packaged and -distributed as libraries. This way of distributing xmonad has many -advantages, since it allows the packaging by GNU\/Linux distributions -while letting the user have the possibility of greatly customizing the -window manager to fit her needs. +Starting with version 0.5, xmonad and xmonad-contrib are packaged and +distributed as libraries, instead of components which must be compiled +by the user into a binary (as they were prior to version 0.5). This +way of distributing xmonad has many advantages, since it allows +packaging by GNU\/Linux distributions while still allowing the user to +customize the window manager to fit her needs. hunk ./XMonad/Doc/Developing.hs 79 -their own window manager in a matter of a few lines of code. +their own window manager in just a few lines of code. While +@~\/.xmonad\/xmonad.hs@ at first seems to be simply a configuration +file, it is actually a complete Haskell program which uses the xmonad +and xmonad-contrib libraries to create a custom window manager. hunk ./XMonad/Doc/Developing.hs 84 -In fact, what seems to be just a configuration file, -@~\/.xmonad\/xmonad.hs@ (whose presence is not necessary for running -the default configuration), is indeed a full Haskell program, with its -@main@ entry point. - -This makes it possible, not only to edit the xmonad default -configuration, as we have seen the "XMonad.Doc.Extending" document, -but also to use the Haskell programming language to extend the tasks -performed by the window manager you are writing every time you write -your own @~\/.xmonad\/xmonad.hs@. - -This is obviously out of the scope of this document, which instead -will be focused on the xmonad internals, by describing, very briefly, -the programming techniques that have been employed in order to make -writing new extensions very simple. +This makes it possible not only to edit the default xmonad +configuration, as we have seen in the "XMonad.Doc.Extending" document, +but to use the Haskell programming language to extend the window +manager you are writing in any way you see fit. hunk ./XMonad/Doc/Developing.hs 102 -entry point will be used, which calls 'XMonad.Main.xmonad', from the -"XMonad.Main" module. - -So, the real @main@ entry point, the one that even users' application -in @~\/.xmonad\/xmonad.hs@ must call, is 'XMonad.Main.xmonad' +entry point will be used, which calls the 'XMonad.Main.xmonad' +function with a default configuration. hunk ./XMonad/Doc/Developing.hs 105 -'XMonad.Main.xmonad' takes the configuration as its only argument, -configuration whose type ('XMonad.Core.XConfig') is defined in -"XMonad.Core". +Thus, the real @main@ entry point, the one that even the users' custom +window manager application in @~\/.xmonad\/xmonad.hs@ must call, is +the 'XMonad.Main.xmonad' function. This function takes a configuration +as its only argument, whose type ('XMonad.Core.XConfig') +is defined in "XMonad.Core". hunk ./XMonad/Doc/Developing.hs 114 -('XMonad.Main.handle') that will 'Prelude.forever' loop waiting for -events and acting accordingly. +('XMonad.Main.handle') that goes into an infinite loop (using +'Prelude.forever') waiting for events and acting accordingly. hunk ./XMonad/Doc/Developing.hs 125 -'Control.Monad.State.StateT' transformer encapsulates the (writable) -state of the window manager ('XMonad.Core.XState'), whereas the -'Control.Monad.Reader.ReaderT' transformer encapsulates the -(read-only) configuration ('XMonad.Core.XConf'). +'Control.Monad.State.StateT' transformer encapsulates the +(read\/writable) state of the window manager (of type +'XMonad.Core.XState'), whereas the 'Control.Monad.Reader.ReaderT' +transformer encapsulates the (read-only) configuration (of type +'XMonad.Core.XConf'). hunk ./XMonad/Doc/Developing.hs 131 -Thanks to the @newtype deriving@ clause the instance of the +Thanks to GHC's newtype deriving feature, the instance of the hunk ./XMonad/Doc/Developing.hs 135 -'XMonad.Core.XConf' are automatically derived from us by ghc. This way -we can use 'Control.Monad.State.get', 'Control.Monad.State.gets' and -'Control.Monad.State.modify' for the 'XMonad.Core.XState', and -'Control.Monad.Reader.ask' and 'Control.Monad.Reader.asks' for -reading the 'XMonad.Core.XConf'. +'XMonad.Core.XConf' are automatically derived for the 'XMonad.Core.X' +monad. This way we can use 'Control.Monad.State.get', +'Control.Monad.State.gets' and 'Control.Monad.State.modify' for the +'XMonad.Core.XState', and 'Control.Monad.Reader.ask' and +'Control.Monad.Reader.asks' for reading the 'XMonad.Core.XConf'. hunk ./XMonad/Doc/Developing.hs 142 -windows managing is stored. And the main record of the +window management is stored. The most important field of the hunk ./XMonad/Doc/Developing.hs 144 -('XMonad.Core.WindowSet') is a type synonymous for a +('XMonad.Core.WindowSet') is a synonym for a hunk ./XMonad/Doc/Developing.hs 152 -with pure functions is perfectly described in the Haddock -documentation of the "XMonad.StackSet" module, and will not be repeated -here. +with pure functions is described in the Haddock documentation of the +"XMonad.StackSet" module. hunk ./XMonad/Doc/Developing.hs 155 -The 'XMonad.StackSet.StackSet' ('XMonad.Core.WindowSet') has 4 -records: +The 'XMonad.StackSet.StackSet' ('XMonad.Core.WindowSet') has four +fields: hunk ./XMonad/Doc/Developing.hs 159 - is a 'XMonad.StackSet.Screen', composed by a - 'XMonad.StackSet.Workspace', and the screen information (for + is a 'XMonad.StackSet.Screen', which is composed of a + 'XMonad.StackSet.Workspace' together with the screen information (for hunk ./XMonad/Doc/Developing.hs 164 - the other visible (with Xinerama) workspaces. + the other visible (with Xinerama) workspaces. For non-Xinerama + setups, this list is always empty. hunk ./XMonad/Doc/Developing.hs 167 -* 'XMonad.StackSet.hidden', the list of 'XMonad.StackSet.Screen's for - non visible workspaces. +* 'XMonad.StackSet.hidden', the list of non-visible + 'XMonad.StackSet.Workspace's. + +* 'XMonad.StackSet.floating', a map from floating + 'Graphics.X11.Types.Window's to 'XMonad.StackSet.RationalRect's + specifying their geometry. hunk ./XMonad/Doc/Developing.hs 176 -'XMonad.StackSet.stack', possibly empy, of windows. +a (possibly empty) 'XMonad.StackSet.stack' of windows. hunk ./XMonad/Doc/Developing.hs 178 -"XMonad.StackSet", to be imported qualified, provides many pure -functions to manipulate the 'XMonad.StackSet.StackSet'. These -functions are usually used as the argument of -'XMonad.Operations.windows', which indeed takes a pure function to -manipulate the 'XMonad.Core.WindowSet' and does all the needed -operations to refresh the screen and save the modified +"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 +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 hunk ./XMonad/Doc/Developing.hs 187 -During 'XMonad.Operations.windows' calls the 'XMonad.StackSet.layout' -record of the 'XMonad.StackSet.current' and 'XMonad.StackSet.visible' -'XMonad.StackSet.Workspace's is used to arrange the -'XMonad.StackSet.stack' of windows of each workspace. +During each 'XMonad.Operations.windows' call, the +'XMonad.StackSet.layout' field of the 'XMonad.StackSet.current' and +'XMonad.StackSet.visible' 'XMonad.StackSet.Workspace's are used to +physically arrange the 'XMonad.StackSet.stack' of windows on each +workspace. hunk ./XMonad/Doc/Developing.hs 196 -greater reliability of the core code. - -Every change to the "XMonad.StackSet" module must be accompanied with -the set of property to be tested with QuickCheck before being applied. +greater reliability of the core code. Every change to the +"XMonad.StackSet" module must be accompanied by appropriate QuickCheck +properties before being applied. hunk ./XMonad/Doc/Developing.hs 204 -Events and event handling are the main data and activity xmonad is -involved with. And X Events are one of the most important. - -Still there may be events that are generated by layouts, or by the -user, for sending commands to layouts, for instance. +Event handling is the core activity of xmonad. Events generated by +the X server are most important, but there may also be events +generated by layouts or the user. hunk ./XMonad/Doc/Developing.hs 211 -automatically derived by ghc). - -'XMonad.Core.Message's are wrapped within an existential type -'XMonad.Core.SomeMessage'. - -The 'Data.Typeable.Typeable' constraint allows us to define a +automatically derived by ghc). 'XMonad.Core.Message's are wrapped +within an existential type 'XMonad.Core.SomeMessage'. The +'Data.Typeable.Typeable' constraint allows for the definition of a hunk ./XMonad/Doc/Developing.hs 215 -'Data.Typeable.cast'. - -X Events are instances of this class. +'Data.Typeable.cast'. X Events are instances of this class, along +with any messages used by xmonad itself or by extension modules. hunk ./XMonad/Doc/Developing.hs 218 -By using the 'Data.Typeable.Typeable' class for any kind of -'XMonad.Core.Message's and events we can define polymorphic functions -and use them for processing messages or unhandled events. +Using the 'Data.Typeable.Typeable' class for any kind of +'XMonad.Core.Message's and events allows us to define polymorphic functions +for processing messages or unhandled events. hunk ./XMonad/Doc/Developing.hs 225 -layouts by 'XMonad.Operations.bradcastMessage'. +layouts by 'XMonad.Operations.broadcastMessage'. hunk ./XMonad/Doc/Developing.hs 256 - crash, so do not call 'error' or 'undefined' + crash, so do not call 'error' or 'undefined'. hunk ./XMonad/Actions/SimpleDate.hs 6 --- +-- hunk ./XMonad/Actions/SimpleDate.hs 22 -import XMonad +import XMonad.Core +import XMonad.Util.Run hunk ./XMonad/Actions/SimpleDate.hs 26 --- To use, modify your Config.hs to: +-- To use, import this module into @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Actions/SimpleDate.hs 30 --- and add a keybinding: +-- and add a keybinding, for example: hunk ./XMonad/Actions/SimpleDate.hs 34 --- a popup date menu will now be bound to mod-d - --- %import XMonad.Actions.SimpleDate --- %keybind , ((modMask, xK_d ), date) +-- In this example, a popup date menu will now be bound to @mod-d@. +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/SimpleDate.hs 40 -date = spawn "(date; sleep 10) | dzen2" +date = unsafeSpawn "(date; sleep 10) | dzen2" hunk ./XMonad/Actions/SinkAll.hs 18 -import XMonad +import XMonad.Core hunk ./XMonad/Actions/SinkAll.hs 22 - hunk ./XMonad/Actions/SinkAll.hs 23 +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- hunk ./XMonad/Actions/SinkAll.hs 27 --- > keys x = [ ((modMask x .|. shiftMask, xK_t), sinkAll) ] hunk ./XMonad/Actions/SinkAll.hs 28 --- where 'x' is your XConfig. - --- %import XMonad.Actions.SinkAll --- %keybind , ((modMask x .|. shiftMask, xK_t), sinkAll) +-- then add a keybinding; for example: +-- +-- , ((modMask x .|. shiftMask, xK_t), sinkAll) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/SinkAll.hs 35 +-- | Un-float all floating windows on the current workspace. hunk ./XMonad/Actions/SinkAll.hs 39 --- Apply a function to all windows on current workspace. +-- | Apply a function to all windows on current workspace. hunk ./XMonad/Actions/Submap.hs 6 --- +-- hunk ./XMonad/Actions/Submap.hs 11 --- A module that allows the user to create a sub-mapping of keys bindings. +-- A module that allows the user to create a sub-mapping of key bindings. hunk ./XMonad/Actions/Submap.hs 30 + + + + +First, import this module into your @~\/.xmonad\/xmonad.hs@: + +> import XMonad.Actions.Submap + hunk ./XMonad/Actions/Submap.hs 47 -So, for example, to run 'spawn \"mpc next\"', you would hit mod-a (to trigger the -submapping) and then 'n' to run that action. (0 means \"no modifier\"). You are, -of course, free to use any combination of modifiers in the submapping. However, -anyModifier will not work, because that is a special value passed to XGrabKey() -and not an actual modifier. --} +So, for example, to run 'spawn \"mpc next\"', you would hit mod-a (to +trigger the submapping) and then 'n' to run that action. (0 means \"no +modifier\"). You are, of course, free to use any combination of +modifiers in the submapping. However, anyModifier will not work, +because that is a special value passed to XGrabKey() and not an actual +modifier. hunk ./XMonad/Actions/Submap.hs 54 --- %import XMonad.Actions.Submap --- %keybind , ((modMask, xK_a), submap . M.fromList $ --- %keybind [ ((0, xK_n), spawn "mpc next") --- %keybind , ((0, xK_p), spawn "mpc prev") --- %keybind , ((0, xK_z), spawn "mpc random") --- %keybind , ((0, xK_space), spawn "mpc toggle") --- %keybind ]) +For detailed instructions on editing your key bindings, see +"XMonad.Doc.Extending#Editing_key_bindings". + +-} hunk ./XMonad/Actions/Submap.hs 59 +-- | Given a 'Data.Map.Map' from key bindings to X () actions, return +-- an action which waits for a user keypress and executes the +-- corresponding action, or does nothing if the key is not found in +-- the map. hunk ./XMonad/Actions/SimpleDate.hs 32 --- > , ((modMask, xK_d ), date) +-- > , ((modMask x, xK_d ), date) hunk ./XMonad/Actions/Submap.hs 40 -> , ((modMask, xK_a), submap . M.fromList $ +> , ((modMask x, xK_a), submap . M.fromList $ hunk ./XMonad/Actions/SwapWorkspaces.hs 25 + hunk ./XMonad/Actions/SwapWorkspaces.hs 27 --- Add this import to your Config.hs: +-- Add this import to your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Actions/SwapWorkspaces.hs 31 --- Throw this in your keys definition: +-- Then throw something like this in your keys definition: hunk ./XMonad/Actions/SwapWorkspaces.hs 34 --- > [((modMask .|. controlMask, k), windows $ swapWithCurrent i) +-- > [((modMask x .|. controlMask, k), windows $ swapWithCurrent i) hunk ./XMonad/Actions/SwapWorkspaces.hs 36 - --- %import XMonad.Actions.SwapWorkspaces --- %keybindlist ++ --- %keybindlist [((modMask .|. controlMask, k), windows $ swapWithCurrent i) --- %keybindlist | (i, k) <- zip workspaces [xK_1 ..]] hunk ./XMonad/Actions/SwapWorkspaces.hs 39 +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/TagWindows.hs 41 --- --- To use window tags add in your Config.hs: +-- +-- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Actions/TagWindows.hs 46 --- --- and add keybindings like as follows: hunk ./XMonad/Actions/TagWindows.hs 47 --- > , ((modMask, xK_f ), withFocused (addTag "abc")) --- > , ((modMask .|. controlMask, xK_f ), withFocused (delTag "abc")) --- > , ((modMask .|. shiftMask, xK_f ), withTaggedGlobal "abc" sink) --- > , ((modMask, xK_d ), withTaggedP "abc" (shiftWin "2")) --- > , ((modMask .|. shiftMask, xK_d ), withTaggedGlobalP "abc" shiftHere) --- > , ((modMask .|. controlMask, xK_d ), focusUpTaggedGlobal "abc") --- > , ((modMask, xK_g ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s))) --- > , ((modMask .|. controlMask, xK_g ), tagDelPrompt defaultXPConfig) --- > , ((modMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float)) --- > , ((modWinMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedP s (shiftWin "2"))) --- > , ((modWinMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere)) --- > , ((modWinMask .|. controlMask, xK_g), tagPrompt defaultXPConfig (\s -> focusUpTaggedGlobal s)) +-- and add keybindings such as the following: hunk ./XMonad/Actions/TagWindows.hs 49 --- NOTE: Tags are saved as space separated string and split with 'unwords' thus --- if you add a tag "a b" the window will have the tags "a" and "b" but not "a b". - --- %import XMonad.Actions.TagWindows --- %import XMonad.Prompt -- to use tagPrompt +-- > , ((modMask x, xK_f ), withFocused (addTag "abc")) +-- > , ((modMask x .|. controlMask, xK_f ), withFocused (delTag "abc")) +-- > , ((modMask x .|. shiftMask, xK_f ), withTaggedGlobal "abc" sink) +-- > , ((modMask x, xK_d ), withTaggedP "abc" (shiftWin "2")) +-- > , ((modMask x .|. shiftMask, xK_d ), withTaggedGlobalP "abc" shiftHere) +-- > , ((modMask x .|. controlMask, xK_d ), focusUpTaggedGlobal "abc") +-- > , ((modMask x, xK_g ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s))) +-- > , ((modMask x .|. controlMask, xK_g ), tagDelPrompt defaultXPConfig) +-- > , ((modMask x .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float)) +-- > , ((modWinMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedP s (shiftWin "2"))) +-- > , ((modWinMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere)) +-- > , ((modWinMask .|. controlMask, xK_g ), tagPrompt defaultXPConfig (\s -> focusUpTaggedGlobal s)) +-- +-- NOTE: Tags are saved as space separated strings and split with +-- 'unwords'. Thus if you add a tag \"a b\" the window will have +-- the tags \"a\" and \"b\" but not \"a b\". +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/TagWindows.hs 69 --- set multiple tags for a window at once (overriding any previous tags) +-- | set multiple tags for a window at once (overriding any previous tags) hunk ./XMonad/Actions/TagWindows.hs 73 --- set a tag for a window (overriding any previous tags) --- writes it to the "_XMONAD_TAGS" window property +-- | set a tag for a window (overriding any previous tags) +-- writes it to the \"_XMONAD_TAGS\" window property hunk ./XMonad/Actions/TagWindows.hs 79 --- read all tags of a window --- reads from the "_XMONAD_TAGS" window property +-- | read all tags of a window +-- reads from the \"_XMONAD_TAGS\" window property hunk ./XMonad/Actions/TagWindows.hs 89 --- check a window for the given tag +-- | check a window for the given tag hunk ./XMonad/Actions/TagWindows.hs 93 --- add a tag to the existing ones +-- | add a tag to the existing ones hunk ./XMonad/Actions/TagWindows.hs 99 --- remove a tag from a window, if it exists +-- | remove a tag from a window, if it exists hunk ./XMonad/Actions/TagWindows.hs 105 --- remove all tags +-- | remove all tags hunk ./XMonad/Actions/TagWindows.hs 109 --- Move the focus in a group of windows, which share the same given tag. --- The Global variants move through all workspaces, whereas the other --- ones operate only on the current workspace +-- | Move the focus in a group of windows, which share the same given tag. +-- The Global variants move through all workspaces, whereas the other +-- ones operate only on the current workspace hunk ./XMonad/Actions/TagWindows.hs 118 --- hunk ./XMonad/Actions/TagWindows.hs 143 --- apply a pure function to windows with a tag +-- | apply a pure function to windows with a tag hunk ./XMonad/Actions/TagWindows.hs 194 - if (sc /= []) + if (sc /= []) hunk ./XMonad/Actions/Warp.hs 6 --- +-- hunk ./XMonad/Actions/Warp.hs 11 --- This can be used to make a keybinding that warps the pointer to a given --- window or screen. +-- Warp the pointer to a given window or screen. hunk ./XMonad/Actions/Warp.hs 18 - warpToScreen, + warpToScreen, hunk ./XMonad/Actions/Warp.hs 32 -This can be used to make a keybinding that warps the pointer to a given -window or screen. For example, I've added the following keybindings to -my Config.hs: +You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: + +> import XMonad.Actions.Warp + +then add appropriate keybindings to warp the pointer; for example: hunk ./XMonad/Actions/Warp.hs 38 -> , ((modMask, xK_z ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window -> +> , ((modMask x, xK_z ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window +> hunk ./XMonad/Actions/Warp.hs 41 -> -> [((modMask .|. controlMask, key), warpToScreen sc (1%2) (1%2)) +> +> [((modMask x .|. controlMask, key), warpToScreen sc (1%2) (1%2)) hunk ./XMonad/Actions/Warp.hs 48 --- %import XMonad.Actions.Warp --- %keybind , ((modMask, xK_z ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window --- %keybindlist ++ --- %keybindlist -- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3 --- %keybindlist [((modMask .|. controlMask, key), warpToScreen sc (1%2) (1%2)) --- %keybindlist | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]] +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/Warp.hs 57 +-- | Warp the pointer to a given position relative to the currently +-- focused window. Top left = (0,0), bottom right = (1,1). hunk ./XMonad/Actions/Warp.hs 66 +-- | Warp the pointer to the given position (top left = (0,0), bottom +-- right = (1,1)) on the given screen. hunk ./XMonad/Actions/WindowBringer.hs 37 --- Place in your Config.hs: +-- Import the module into your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Actions/WindowBringer.hs 41 --- and in the keys definition: +-- and define appropriate key bindings: hunk ./XMonad/Actions/WindowBringer.hs 43 --- > , ((modMask .|. shiftMask, xK_g ), gotoMenu) --- > , ((modMask .|. shiftMask, xK_b ), bringMenu) +-- > , ((modMask x .|. shiftMask, xK_g ), gotoMenu) +-- > , ((modMask x .|. shiftMask, xK_b ), bringMenu) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/WindowBringer.hs 49 --- %import XMonad.Actions.WindowBringer --- %keybind , ((modMask .|. shiftMask, xK_g ), gotoMenu) --- %keybind , ((modMask .|. shiftMask, xK_b ), bringMenu) hunk ./XMonad/Actions/WindowBringer.hs 68 --- | Generates a Map from window name to . For use with --- dmenuMap. +-- | Generates a Map from window name to \. For +-- use with dmenuMap. hunk ./XMonad/Actions/WmiiActions.hs 11 --- Provides `actions' as known from Wmii window manager ( --- ). It also provides slightly better interface for --- running dmenu on xinerama screens. If you want to use xinerama functions, --- you have to apply following patch (see Dmenu.hs extension): --- . Don't forget to --- recompile dmenu afterwards ;-). +-- Provides \"actions\" as in the Wmii window manager +-- (). It also provides a slightly better +-- interface for running dmenu on xinerama screens. If you want to use +-- xinerama functions, you have to apply the following patch (see the +-- "XMonad.Util.Dmenu" module): +-- . Don't +-- forget to recompile dmenu afterwards ;-). hunk ./XMonad/Actions/WmiiActions.hs 38 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: hunk ./XMonad/Actions/WmiiActions.hs 42 --- and add following to the list of keyboard bindings: +-- and add something like the following to your key bindings: hunk ./XMonad/Actions/WmiiActions.hs 44 --- > ,((modMask, xK_a), wmiiActions "/home/joe/.wmii-3.5/") +-- > ,((modMask x, xK_a), wmiiActions "/home/joe/.wmii-3.5/") hunk ./XMonad/Actions/WmiiActions.hs 48 --- > ,((modMask, xK_a), wmiiActionsXinerama "/home/joe/.wmii-3.5/") +-- > ,((modMask x, xK_a), wmiiActionsXinerama "/home/joe/.wmii-3.5/") hunk ./XMonad/Actions/WmiiActions.hs 50 --- however, make sure you have also xinerama build of dmenu (for more --- information see "XMonad.Util.Dmenu" extension). +-- However, make sure you also have the xinerama build of dmenu (for more +-- information see the "XMonad.Util.Dmenu" extension). +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/WmiiActions.hs 57 --- executes dmenu with all executables found in the provided path. +-- executes dmenu with all the executables found in the provided path. hunk ./XMonad/Actions/WmiiActions.hs 63 --- dmenu only on workspace which currently owns focus. +-- dmenu only on the currently focused workspace. hunk ./XMonad/Actions/WmiiActions.hs 89 --- | The 'executables' function runs dmenu_path script providing list of --- executable files accessible from $PATH variable. +-- | The 'executables' function runs the dmenu_path script, providing list of +-- executable files accessible from the $PATH variable. hunk ./XMonad/Actions/WmiiActions.hs 94 --- | The 'executablesXinerama' function does the same as 'executables' function --- but on workspace which currently owns focus. +-- | The 'executablesXinerama' function does the same as the +-- 'executables' function, but on the workspace which currently has focus. hunk ./XMonad/Layout/WorkspaceDir.hs 21 --- Requires the 'directory' package +-- Note this extension requires the 'directory' package to be installed. hunk ./XMonad/Actions/DynamicWorkspaces.hs 36 --- You can use this module with the following in your Config.hs file: --- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- hunk ./XMonad/Actions/DynamicWorkspaces.hs 40 --- > , ((modMask .|. shiftMask, xK_BackSpace), removeWorkspace) +-- Then add keybindings like the following: +-- +-- > , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace) hunk ./XMonad/Actions/DynamicWorkspaces.hs 47 --- --- > -- mod-[1..9] %! Switch to workspace N +-- +-- > -- mod-[1..9] %! Switch to workspace N hunk ./XMonad/Actions/DynamicWorkspaces.hs 51 --- > zip (zip (repeat modMask) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..]) +-- > zip (zip (repeat (modMask x)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..]) hunk ./XMonad/Actions/DynamicWorkspaces.hs 53 --- > zip (zip (repeat (modMask .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..]) +-- > zip (zip (repeat (modMask x .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..]) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + hunk ./XMonad/Actions/DynamicWorkspaces.hs 100 +-- | Add a new workspace with the given name. hunk ./XMonad/Actions/DynamicWorkspaces.hs 108 +-- | Remove the current workspace if it contains no windows. addfile ./XMonad/Prompt/AppendFile.hs hunk ./XMonad/Prompt/AppendFile.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.AppendFile +-- Copyright : (c) 2007 Brent Yorgey +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- A prompt for appending a single line of text to a file. Useful for +-- keeping a file of notes, things to remember for later, and so on--- +-- using a keybinding, you can write things down just about as quickly +-- as you think of them, so it doesn't have to interrupt whatever else +-- you're doing. +-- +-- Who knows, it might be useful for other purposes as well! +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.AppendFile ( + -- * Usage + -- $usage + + appendFilePrompt + ) where + +import XMonad.Core +import XMonad.Prompt + +import System.IO +import Control.Exception + +-- $usage +-- +-- You can use this module by importing it, along with +-- "XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file: +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.AppendFile +-- +-- and adding an appropriate keybinding, for example: +-- +-- > , ((modMask x .|. controlMask, xK_n), appendFilePrompt defaultXPConfig "/home/me/NOTES") +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data AppendFile = AppendFile FilePath + +instance XPrompt AppendFile where + showXPrompt (AppendFile fn) = "Add to " ++ fn ++ ": " + +-- | Given an XPrompt configuration and a file path, prompt the user +-- for a line of text, and append it to the given file. +appendFilePrompt :: XPConfig -> FilePath -> X () +appendFilePrompt c fn = mkXPrompt (AppendFile fn) + c + (const (return [])) + (doAppend fn) + +-- | Append a string to a file. +doAppend :: FilePath -> String -> X () +doAppend fn s = io $ bracket (openFile fn AppendMode) + hClose + (flip hPutStrLn s) hunk ./xmonad-contrib.cabal 125 + XMonad.Prompt.AppendFile hunk ./XMonad/Prompt.hs 21 + , mkXPromptWithReturn hunk ./XMonad/Prompt.hs 55 +import Control.Applicative ((<$>)) hunk ./XMonad/Prompt.hs 151 --- | Creates a prompt given: --- --- * a prompt type, instance of the 'XPrompt' class. --- --- * a prompt configuration ('defaultXPConfig' can be used as a --- starting point) --- --- * a completion function ('mkComplFunFromList' can be used to --- create a completions function given a list of possible completions) --- --- * an action to be run: the action must take a string and return 'XMonad.X' () -mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X () -mkXPrompt t conf compl action = do +-- | Same as 'mkXPrompt', except that the action function can have +-- type @String -> X a@, for any @a@, and the final action returned +-- by 'mkXPromptWithReturn' will have type @X (Maybe a)@. @Nothing@ +-- is yielded if the user cancels the prompt (by e.g. hitting Esc or +-- Ctrl-G). For an example of use, see the 'XMonad.Prompt.Input' +-- module. +mkXPromptWithReturn :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X a) -> X (Maybe a) +mkXPromptWithReturn t conf compl action = do hunk ./XMonad/Prompt.hs 175 - when (command st' /= "") $ do - let htw = take (historySize conf) (history st') - liftIO $ writeHistory htw - action (command st') + if (command st' /= "") + then do + let htw = take (historySize conf) (history st') + liftIO $ writeHistory htw + Just <$> action (command st') + else + return Nothing + +-- | Creates a prompt given: +-- +-- * a prompt type, instance of the 'XPrompt' class. +-- +-- * a prompt configuration ('defaultXPConfig' can be used as a +-- starting point) +-- +-- * a completion function ('mkComplFunFromList' can be used to +-- create a completions function given a list of possible completions) +-- +-- * an action to be run: the action must take a string and return 'XMonad.X' () +mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X () +mkXPrompt t conf compl action = mkXPromptWithReturn t conf compl action >> return () hunk ./XMonad/Prompt.hs 330 - delNextWord w = + delNextWord w = hunk ./XMonad/Prompt.hs 335 - (ncom,noff) = + (ncom,noff) = addfile ./XMonad/Prompt/Email.hs hunk ./XMonad/Prompt/Email.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Email +-- Copyright : (c) 2007 Brent Yorgey +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- A prompt for sending quick, one-line emails, via the standard GNU +-- \'mail\' utility (which must be in your $PATH). This module is +-- intended mostly as an example of using "XMonad.Prompt.Input" to +-- build an action requiring user input. +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.Email ( + -- * Usage + -- $usage + emailPrompt + ) where + +import XMonad.Core +import XMonad.Util.Run +import XMonad.Prompt +import XMonad.Prompt.Input + +-- $usage +-- +-- You can use this module by importing it, along with +-- "XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file: +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.Email +-- +-- and adding an appropriate keybinding, for example: +-- +-- > , ((modMask x .|. controlMask, xK_e), emailPrompt defaultXPConfig addresses) +-- +-- where @addresses@ is a list of email addresses that should +-- autocomplete, for example: +-- +-- > addresses = ["me@me.com", "mr@big.com", "tom.jones@foo.bar"] +-- +-- You can still send email to any address, but sending to these +-- addresses will be faster since you only have to type a few +-- characters and then hit \'tab\'. +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + + +-- | Prompt the user for a recipient, subject, and body, and send an +-- email via the GNU \'mail\' utility. The second argument is a list +-- of addresses for autocompletion. +emailPrompt :: XPConfig -> [String] -> X () +emailPrompt c addrs = + inputPromptWithCompl c "To" (mkComplFunFromList addrs) ?+ \to -> + inputPrompt c "Subject" ?+ \subj -> + inputPrompt c "Body" ?+ \body -> + io $ runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n") + >> return () addfile ./XMonad/Prompt/Input.hs hunk ./XMonad/Prompt/Input.hs 1 - +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Input +-- Copyright : (c) 2007 Brent Yorgey +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- A generic framework for prompting the user for input and passing it +-- along to some other action. +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.Input ( + -- * Usage + -- $usage + inputPrompt, + inputPromptWithCompl, + (?+) + ) where + +import XMonad.Core +import XMonad.Prompt + +-- $usage +-- +-- To use this module, import it along with "XMonad.Prompt": +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.Input +-- +-- This module provides no useful functionality in isolation, but +-- is intended for use in building other actions which require user +-- input. +-- +-- For example, suppose Mr. Big wants a way to easily fire his +-- employees. We'll assume that he already has a function +-- +-- > fireEmployee :: String -> X () +-- +-- which takes as input the name of an employee, and fires them. He +-- just wants a convenient way to provide the input for this function +-- from within xmonad. Here is where the "XMonad.Prompt.Input" module +-- comes into play. He can use the 'inputPrompt' function to create a +-- prompt, and the '?+' operator to compose the prompt with the +-- @fireEmployee@ action, like so: +-- +-- > firingPrompt :: X () +-- > firingPrompt = inputPrompt defaultXPConfig \"Fire\" ?+ fireEmployee +-- +-- If @employees@ contains a list of all his employees, he could also +-- create an autocompleting version, like this: +-- +-- > firingPrompt' = inputPromptWithCompl defaultXPConfig \"Fire\" +-- > (mkComplFunFromList employees) ?+ fireEmployee +-- +-- Now all he has to do is add a keybinding to @firingPrompt@ (or +-- @firingPrompt'@), such as +-- +-- > , ((modMask x .|. controlMask, xK_f), firingPrompt) +-- +-- Now when Mr. Big hits mod-ctrl-f, a prompt will pop up saying +-- \"Fire: \", waiting for him to type the name of someone to fire. +-- If he thinks better of it after hitting mod-ctrl-f and cancels the +-- prompt (e.g. by hitting Esc), the @fireEmployee@ action will not be +-- invoked. +-- +-- (For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings".) +-- +-- "XMonad.Prompt.Input" is also intended to ease the process of +-- developing other modules which require user input. For an example +-- of a module developed using this functionality, see +-- "XMonad.Prompt.Email", which prompts the user for a recipient, +-- subject, and one-line body, and sends a quick email. + +data InputPrompt = InputPrompt String + +instance XPrompt InputPrompt where + showXPrompt (InputPrompt s) = s ++ ": " + +-- | Given a prompt configuration and some prompt text, create an X +-- action which pops up a prompt waiting for user input, and returns +-- whatever they type. Note that the type of the action is @X +-- (Maybe String)@, which reflects the fact that the user might +-- cancel the prompt (resulting in @Nothing@), or enter an input +-- string @s@ (resulting in @Just s@). +inputPrompt :: XPConfig -> String -> X (Maybe String) +inputPrompt c p = inputPromptWithCompl c p (const (return [])) + +-- | The same as 'inputPrompt', but with a completion function. The +-- type @ComplFunction@ is @String -> IO [String]@, as defined in +-- "XMonad.Prompt". The 'mkComplFunFromList' utility function, also +-- defined in "XMonad.Prompt", is useful for creating such a +-- function from a known list of possibilities. +inputPromptWithCompl :: XPConfig -> String -> ComplFunction -> X (Maybe String) +inputPromptWithCompl c p compl = mkXPromptWithReturn (InputPrompt p) c compl return + + +infixr 1 ?+ + +-- | A combinator for hooking up an input prompt action to a function +-- which can take the result of the input prompt and produce another +-- action. If the user cancels the input prompt, the +-- second function will not be run. +-- +-- The astute student of types will note that this is actually a +-- very general combinator and has nothing in particular to do +-- with input prompts. If you find a more general use for it and +-- want to move it to a different module, be my guest. +(?+) :: (Monad m) => m (Maybe a) -> (a -> m ()) -> m () +x ?+ k = x >>= maybe (return ()) k hunk ./xmonad-contrib.cabal 126 + XMonad.Prompt.Input + XMonad.Prompt.Email hunk ./XMonad/Layout/Mosaic.hs 29 -import Graphics.X11.Xlib.Extras ( getWMNormalHints, sh_aspect ) +import Graphics.X11.Xlib.Extras ( SizeHints, getWMNormalHints, sh_aspect, sh_min_size, sh_max_size ) hunk ./XMonad/Layout/Mosaic.hs 145 +set_MaxX :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] +set_MaxX h | Just (mx,_) <- sh_max_size h = replaceinmap isMaxX (MaxX $ fromIntegral mx) + | otherwise = const id + where isMaxX (MaxX _) = True + isMaxX _ = False + +set_MaxY :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] +set_MaxY h | Just (_,mx) <- sh_max_size h = replaceinmap isMaxY (MaxY $ fromIntegral mx) + | otherwise = const id + where isMaxY (MaxY _) = True + isMaxY _ = False + +set_MinX :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] +set_MinX h | Just (mx,_) <- sh_min_size h = replaceinmap isMinX (MinX $ fromIntegral mx) + | otherwise = const id + where isMinX (MinX _) = True + isMinX _ = False + +set_MinY :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] +set_MinY h | Just (_,mx) <- sh_min_size h = replaceinmap isMinY (MinY $ fromIntegral mx) + | otherwise = const id + where isMinY (MinY _) = True + isMinY _ = False + +replaceinmap :: Ord a => (a -> Bool) -> a -> Window -> M.Map Window [a] -> M.Map Window [a] +replaceinmap repl v = alterlist f where f [] = [v] + f (x:xs) | repl x = v:xs + | otherwise = x:f xs + hunk ./XMonad/Layout/Mosaic.hs 229 - -> Rated Double (Mosaic (Window,Rectangle)) + -> Rated Double (Mosaic (Window,Rectangle)) hunk ./XMonad/Layout/Mosaic.hs 274 - case map4 `fmap` sh_aspect h of - Just ((minx,miny),(maxx,maxy)) - | or [minx < 1, miny < 1, maxx < 1, maxy < 1] -> add_hints ws x - | minx/miny == maxx/maxy -> add_hints ws $ set_aspect_ratio (minx/miny) w x - | otherwise -> add_hints ws $ make_flexible w $ - set_aspect_ratio (sqrt $ minx*maxx/miny/maxy) w x - Nothing -> add_hints ws x + let set_asp = case map4 `fmap` sh_aspect h of + Just ((minx,miny),(maxx,maxy)) + | or [minx < 1, miny < 1, maxx < 1, maxy < 1] -> id + | minx/miny == maxx/maxy -> set_aspect_ratio (minx/miny) w + _ -> id + add_hints ws $ set_MinX h w $ set_MinY h w $ set_MaxX h w $ set_MaxY h w $ set_asp x hunk ./XMonad/Layout/Mosaic.hs 318 + | MaxX Double + | MaxY Double + | MinX Double + | MinY Double hunk ./XMonad/Layout/Mosaic.hs 338 +crop1 :: WindowHint -> Rectangle -> Rectangle +crop1 (FlexibleAspectRatio f) r = cropit f r +crop1 h r = crop1' h r + +crop1' :: WindowHint -> Rectangle -> Rectangle +crop1' (AspectRatio f) r = cropit f r +crop1' (FlexibleAspectRatio f) r = cropit f r +crop1' (MaxX xm) (Rectangle x y w h) | fromIntegral w > xm = Rectangle x y (floor xm) h + | otherwise = Rectangle x y w h +crop1' (MaxY xm) (Rectangle x y w h) | fromIntegral h > xm = Rectangle x y w (floor xm) + | otherwise = Rectangle x y w h +crop1' _ r = r + hunk ./XMonad/Layout/Mosaic.hs 352 -crop (AspectRatio f:_) = cropit f -crop (FlexibleAspectRatio f:_) = cropit f -crop (_:hs) = crop hs +crop (h:hs) = crop hs . crop1 h hunk ./XMonad/Layout/Mosaic.hs 356 -crop' (AspectRatio f:_) = cropit f -crop' (_:hs) = crop' hs +crop' (h:hs) = crop' hs . crop1' h hunk ./XMonad/Layout/Mosaic.hs 27 +import Data.Maybe ( isJust ) hunk ./XMonad/Layout/Mosaic.hs 104 - doLayout (Mosaic _ t h) r w = mosaicL t h r (W.integrate w) + doLayout (Mosaic _ t h) r st = do all_hints <- add_hints (W.integrate st) h + mosaicL t all_hints r (W.integrate st) + where add_hints [] x = return x + add_hints (w:ws) x = + do z <- withDisplay $ \d -> io $ getWMNormalHints d w + let set_asp = case map4 `fmap` sh_aspect z of + Just ((minx,miny),(maxx,maxy)) + | or [minx < 1, miny < 1, maxx < 1, maxy < 1] -> id + | minx/miny == maxx/maxy -> set_aspect_ratio (minx/miny) w + _ -> id + add_hints ws $ set_MinX z w $ set_MinY z w $ set_MaxX z w $ set_MaxY z w $ set_asp x + map4 :: Integral a => ((a,a),(a,a)) -> ((Double,Double),(Double,Double)) + map4 ((a,b),(c,d)) = ((fromIntegral a,fromIntegral b),(fromIntegral c,fromIntegral d)) hunk ./XMonad/Layout/Mosaic.hs 159 -set_MaxX h | Just (mx,_) <- sh_max_size h = replaceinmap isMaxX (MaxX $ fromIntegral mx) +set_MaxX h | Just (_,mx) <- sh_max_size h = replaceinmap (isJust . isMaxX) (MaxX $ fromIntegral mx) hunk ./XMonad/Layout/Mosaic.hs 161 - where isMaxX (MaxX _) = True - isMaxX _ = False hunk ./XMonad/Layout/Mosaic.hs 163 -set_MaxY h | Just (_,mx) <- sh_max_size h = replaceinmap isMaxY (MaxY $ fromIntegral mx) +set_MaxY h | Just (_,mx) <- sh_max_size h = replaceinmap (isJust . isMaxY) (MaxY $ fromIntegral mx) hunk ./XMonad/Layout/Mosaic.hs 165 - where isMaxY (MaxY _) = True - isMaxY _ = False + +isMaxX,isMaxY :: WindowHint -> Maybe Dimension +isMaxX (MaxX x) = Just x +isMaxX _ = Nothing +isMaxY (MaxY x) = Just x +isMaxY _ = Nothing hunk ./XMonad/Layout/Mosaic.hs 215 - all_hints <- add_hints origws hints hunk ./XMonad/Layout/Mosaic.hs 220 - w,crop' (findlist w all_hints) r)) $ + w,crop' (findlist w hints) r)) $ hunk ./XMonad/Layout/Mosaic.hs 230 + maxds = map (maxd d) wss hunk ./XMonad/Layout/Mosaic.hs 232 - wsr_s = zip wss (partitionR d r areas) + wsr_s = zip wss (partitionR d r maxds areas) hunk ./XMonad/Layout/Mosaic.hs 258 - rs = partitionR d r areas + maxds = repeat 1 + rs = partitionR d r maxds areas hunk ./XMonad/Layout/Mosaic.hs 276 - partitionR :: CutDirection -> Rectangle -> [Double] -> [Rectangle] - partitionR _ _ [] = [] - partitionR _ r [_] = [r] - partitionR d r (a:ars) = r1 : partitionR d r2 ars + partitionR :: CutDirection -> Rectangle -> [Dimension] -> [Double] -> [Rectangle] + partitionR _ _ _ [] = [] + partitionR _ _ [] _ = [] + partitionR _ r _ [_] = [r] + partitionR d r (m:ms) (a:ars) = r1 : partitionR d r2 ms ars hunk ./XMonad/Layout/Mosaic.hs 282 - (r1,r2) = split d (a/totarea) r + totd = fromIntegral $ dimR d r + (r1,r2) = if a/totarea > fromIntegral m / totd + then if a/totarea > 1 - fromIntegral (sum ms) / totd + then split d (1 - fromIntegral (sum ms) / totd) r + else split d (a/totarea) r + else split d (fromIntegral m / totd) r hunk ./XMonad/Layout/Mosaic.hs 290 + maxd Vertical ws = maximum $ map (findhinted isMaxY 3) ws + maxd Horizontal ws = maximum $ map (findhinted isMaxX 3) ws hunk ./XMonad/Layout/Mosaic.hs 294 + findhinted fh d w = fh' $ M.findWithDefault [] w hints + where fh' [] = d + fh' (h:hs) | Just x <- fh h = x + | otherwise = fh' hs hunk ./XMonad/Layout/Mosaic.hs 299 - add_hints [] x = return x - add_hints (w:ws) x = - do h <- withDisplay $ \d -> io $ getWMNormalHints d w - let set_asp = case map4 `fmap` sh_aspect h of - Just ((minx,miny),(maxx,maxy)) - | or [minx < 1, miny < 1, maxx < 1, maxy < 1] -> id - | minx/miny == maxx/maxy -> set_aspect_ratio (minx/miny) w - _ -> id - add_hints ws $ set_MinX h w $ set_MinY h w $ set_MaxX h w $ set_MaxY h w $ set_asp x - map4 :: Integral a => ((a,a),(a,a)) -> ((Double,Double),(Double,Double)) - map4 ((a,b),(c,d)) = ((fromIntegral a,fromIntegral b),(fromIntegral c,fromIntegral d)) + +dimR :: CutDirection -> Rectangle -> Dimension +dimR Vertical (Rectangle _ _ _ h) = h +dimR Horizontal (Rectangle _ _ w _) = w hunk ./XMonad/Layout/Mosaic.hs 339 - | MaxX Double - | MaxY Double - | MinX Double - | MinY Double + | MaxX Dimension + | MaxY Dimension + | MinX Dimension + | MinY Dimension hunk ./XMonad/Layout/Mosaic.hs 366 -crop1' (MaxX xm) (Rectangle x y w h) | fromIntegral w > xm = Rectangle x y (floor xm) h +crop1' (MaxX xm) (Rectangle x y w h) | w > xm = Rectangle x y xm h hunk ./XMonad/Layout/Mosaic.hs 368 -crop1' (MaxY xm) (Rectangle x y w h) | fromIntegral h > xm = Rectangle x y w (floor xm) +crop1' (MaxY xm) (Rectangle x y w h) | h > xm = Rectangle x y w xm hunk ./XMonad/Layout/Mosaic.hs 402 +split d frac r | frac <= 0 || frac >= 1 = split d 0.5 r hunk ./XMonad/Config/Droundy.hs 136 - Named "xclock" (mytab **//* combineTwo Square mytab mytab) ||| + Named "xclock" (mytab ****//* combineTwo Square mytab mytab) ||| hunk ./XMonad/Config/Droundy.hs 138 - **//* combineTwo Square mytab mytab) ||| - mosaic 0.25 0.5 + ****//* combineTwo Square mytab mytab) -- ||| + --mosaic 0.25 0.5 hunk ./XMonad/Layout/LayoutScreens.hs 39 --- +-- hunk ./XMonad/Layout/LayoutScreens.hs 48 --- +-- hunk ./XMonad/Layout/LayoutScreens.hs 52 --- > layoutScreens 1 (fixedLayout $ Rectangle 0 0 1024 768)) +-- > layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768])) hunk ./XMonad/Util/XSelection.hs 26 -import Graphics.X11.Xlib.Extras (Event(ev_event_display, - ev_time, ev_property, ev_target, ev_selection, - ev_requestor, ev_event_type), - xConvertSelection, xGetSelectionOwner, xSetSelectionOwner, getEvent, - currentTime, setSelectionNotify, getWindowProperty8, changeProperty8, - propModeReplace) -import Graphics.X11.Xlib (destroyWindow, createSimpleWindow, Display, XEventPtr, - sendEvent, nextEvent, sync, allocaXEvent, openDisplay, rootWindow, - defaultScreen, internAtom, Atom, selectionNotify, selectionRequest, noEventMask) hunk ./XMonad/Util/XSelection.hs 29 +import Data.Bits (shiftL, (.&.), (.|.)) hunk ./XMonad/Util/XSelection.hs 32 -import Foreign.C.Types (CChar) -import Data.Bits (shiftL, (.&.), (.|.)) -import XMonad.Util.Run (safeSpawn, unsafeSpawn) +import Data.Word (Word8) +import Graphics.X11.Xlib.Extras (Event(ev_event_display, + ev_time, ev_property, ev_target, ev_selection, + ev_requestor, ev_event_type), + xConvertSelection, xGetSelectionOwner, xSetSelectionOwner, getEvent, + currentTime, setSelectionNotify, getWindowProperty8, changeProperty8, + propModeReplace) +import Graphics.X11.Xlib (destroyWindow, createSimpleWindow, Display, XEventPtr, + sendEvent, nextEvent, sync, allocaXEvent, openDisplay, rootWindow, + defaultScreen, internAtom, Atom, selectionNotify, selectionRequest, noEventMask) hunk ./XMonad/Util/XSelection.hs 43 +import XMonad.Util.Run (safeSpawn, unsafeSpawn) hunk ./XMonad/Util/XSelection.hs 55 - hunk ./XMonad/Util/XSelection.hs 65 - * Possibly add some more elaborate functionality: Emacs' registers are nice. --} + * Possibly add some more elaborate functionality: Emacs' registers are nice. -} hunk ./XMonad/Util/XSelection.hs 88 - return $ decode . fromMaybe [] $ res + return $ decode . map fromIntegral . fromMaybe [] $ res hunk ./XMonad/Util/XSelection.hs 113 - -- selection == eg PRIMARY - -- target == type eg UTF8 - -- property == property name or None hunk ./XMonad/Util/XSelection.hs 120 - setSelectionNotify replyPtr (ev_requestor ev) (ev_selection ev) (ev_target ev) (ev_property ev) (ev_time ev) + setSelectionNotify replyPtr (ev_requestor ev) (ev_selection ev) + (ev_target ev) (ev_property ev) (ev_time ev) hunk ./XMonad/Util/XSelection.hs 141 -{- UTF-8 decoding for internal use in getSelection. This code is copied from Eric Mertens's utf-string library +{- | Decode a UTF8 string packed into a list of Word8 values, directly to + String; does not deal with CChar, hence you will want the counter-intuitive 'map fromIntegral'. + UTF-8 decoding for internal use in getSelection. This code is copied from Eric Mertens's utf-string library hunk ./XMonad/Util/XSelection.hs 147 -decode :: [CChar] -> String +decode :: [Word8] -> String hunk ./XMonad/Util/XSelection.hs 159 + hunk ./XMonad/Util/XSelection.hs 163 - multi_byte :: Int -> CChar -> Int -> [Char] + multi_byte :: Int -> Word8 -> Int -> [Char] hunk ./XMonad/Util/XSelection.hs 166 - aux :: Int -> [CChar] -> Int -> [Char] hunk ./XMonad/Util/XSelection.hs 171 + hunk ./XMonad/Util/XSelection.hs 175 + hunk ./XMonad/Config/Droundy.hs 11 --- --- Useful imports --- +import Control.Monad.State ( modify ) + hunk ./XMonad/Config/Droundy.hs 17 +import XMonad.Core ( windowset ) hunk ./XMonad/Config/Droundy.hs 48 +import XMonad.Hooks.ManageDocks +import XMonad.Hooks.UrgencyHook + hunk ./XMonad/Config/Droundy.hs 133 -config = defaultConfig +config = withUrgencyHook FocusUrgencyHook $ defaultConfig hunk ./XMonad/Config/Droundy.hs 137 - toggleLayouts (noBorders Full) $ -- avoidStruts $ + toggleLayouts (noBorders Full) $ avoidStruts $ hunk ./XMonad/Config/Droundy.hs 174 +data FocusUrgencyHook = FocusUrgencyHook deriving (Read, Show) + +instance UrgencyHook FocusUrgencyHook Window where + urgencyHook _ w = modify copyAndFocus + where copyAndFocus s + | Just w == W.peek (windowset s) = s + | has w $ W.stack $ W.workspace $ W.current $ windowset s = + s { windowset = until ((Just w ==) . W.peek) + W.focusUp $ windowset s } + | otherwise = + let t = W.tag $ W.workspace $ W.current $ windowset s + in s { windowset = until ((Just w ==) . W.peek) + W.focusUp $ copyWindow w t $ windowset s } + has _ Nothing = False + has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr) + + hunk ./XMonad/Hooks/UrgencyHook.hs 28 + UrgencyHook(urgencyHook), hunk ./XMonad/Layout/Combo.hs 80 - where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage Hide) - l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage Hide) - return ([], Just $ C2 [] [] super l1' l2') - arrange [w] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage Hide) - l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage Hide) - return ([(w,rinput)], Just $ C2 [w] [w] super l1' l2') + where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources) + l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources) + super' <- maybe super id `fmap` + handleMessage super (SomeMessage ReleaseResources) + return ([], Just $ C2 [] [] super' l1' l2') + arrange [w] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources) + l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources) + super' <- maybe super id `fmap` + handleMessage super (SomeMessage ReleaseResources) + return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2') hunk ./XMonad/Config/Droundy.hs 48 -import XMonad.Hooks.ManageDocks +--import XMonad.Hooks.ManageDocks hunk ./XMonad/Config/Droundy.hs 137 - toggleLayouts (noBorders Full) $ avoidStruts $ + toggleLayouts (noBorders Full) $ -- avoidStruts $ hunk ./XMonad/Config/Droundy.hs 11 -import Control.Monad.State ( modify ) +--import Control.Monad.State ( modify ) hunk ./XMonad/Config/Droundy.hs 17 -import XMonad.Core ( windowset ) +--import XMonad.Core ( windowset ) hunk ./XMonad/Config/Droundy.hs 49 -import XMonad.Hooks.UrgencyHook +--import XMonad.Hooks.UrgencyHook hunk ./XMonad/Config/Droundy.hs 133 -config = withUrgencyHook FocusUrgencyHook $ defaultConfig +config = -- withUrgencyHook FocusUrgencyHook $ + defaultConfig hunk ./XMonad/Config/Droundy.hs 175 +{- hunk ./XMonad/Config/Droundy.hs 192 +-} hunk ./XMonad/Config/Droundy.hs 142 - ****//* combineTwo Square mytab mytab) -- ||| + ****//* combineTwo Square mytab mytab) -- ||| hunk ./XMonad/Layout/LayoutScreens.hs 38 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: hunk ./XMonad/Layout/LayoutScreens.hs 42 +-- Then add some keybindings; for example: +-- hunk ./XMonad/Layout/LayoutScreens.hs 56 - --- %import XMonad.Layout.LayoutScreens --- %keybind , ((modMask .|. shiftMask, xK_space), layoutScreens 2 (twoPane 0.5 0.5)) --- %keybind , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Layout/Square.hs 8 --- +-- hunk ./XMonad/Layout/Square.hs 15 --- This is probably only ever useful in combination with +-- This is probably only ever useful in combination with hunk ./XMonad/Layout/Square.hs 32 --- You can use this module with the following in your Config.hs file: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: hunk ./XMonad/Layout/Square.hs 43 --- %import XMonad.Layout.Square +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Config/Sjanssen.hs 6 -import XMonad.Layouts +import XMonad.Layouts hiding (Tall) hunk ./XMonad/Config/Sjanssen.hs 8 +import XMonad.Layout.HintedTile hunk ./XMonad/Config/Sjanssen.hs 35 - , layoutHook = smartBorders (tiled ||| Mirror tiled ||| Full ||| tabbed shrinkText defaultTConf) + , layoutHook = smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTConf) hunk ./XMonad/Config/Sjanssen.hs 38 - tiled = Tall 1 0.03 0.5 + tiled = HintedTile 1 0.03 0.5 hunk ./XMonad/Config/Sjanssen.hs 43 + myFont = "xft:Bitstream Vera Sans Mono:pixelsize=10" + myTConf = defaultTConf { fontName = myFont } hunk ./XMonad/Config/Sjanssen.hs 47 + , font = myFont hunk ./XMonad/Layout/TilePrime.hs 1 -{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} --- -------------------------------------------------------------------------- --- -- | --- -- Module : TilePrime.hs --- -- Copyright : (c) Eric Mertens 2007 --- -- License : BSD3-style (see LICENSE) --- -- --- -- Maintainer : emertens@gmail.com --- -- Stability : unstable --- -- Portability : not portable --- -- --- -- TilePrime. Tile windows filling gaps created by resize hints --- -- --- ----------------------------------------------------------------------------- --- - -module XMonad.Layout.TilePrime ( - -- * Usage - -- $usage - TilePrime(TilePrime) - ) where - -import Control.Monad (mplus) -import Control.Monad.Reader (asks) -import Data.List (mapAccumL) -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras (getWMNormalHints) -import XMonad.Operations -import XMonad.Layouts -import XMonad hiding (trace) -import qualified XMonad.StackSet as W - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Layout.TilePrime --- --- Then edit your @layoutHook@ by adding the TilePrime layout: --- --- > myLayouts = TilePrime 1 (3/100) (1/2) False ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } --- --- Use @True@ as the last argument to get a wide layout. --- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" - -data TilePrime a = TilePrime - { nmaster :: Int - , delta, frac :: Rational - , flipped :: Bool - } deriving (Show, Read) - -instance LayoutClass TilePrime Window where - description c | flipped c = "TilePrime Horizontal" - | otherwise = "TilePrime Vertical" - - pureMessage c m = fmap resize (fromMessage m) `mplus` - fmap incmastern (fromMessage m) - where - resize Shrink = c { frac = max 0 $ frac c - delta c } - resize Expand = c { frac = min 1 $ frac c + delta c } - incmastern (IncMasterN d) = c { nmaster = max 0 $ nmaster c + d } - - doLayout TilePrime { frac = f, nmaster = m, flipped = flp } rect s = do - bW <- asks (borderWidth . config) - let xs = W.integrate s - hints <- withDisplay $ \ disp -> io (mapM (getWMNormalHints disp) xs) - let xs' = zip xs hints - (leftXs, rightXs) = splitAt m xs' - (leftRect, rightRect) - | null rightXs = (rect, Rectangle 0 0 0 0) - | null leftXs = (Rectangle 0 0 0 0, rect) - | flp = splitVerticallyBy f rect - | otherwise = splitHorizontallyBy f rect - masters = fillWindows bW leftRect leftXs - slaves = fillWindows bW rightRect rightXs - return (masters ++ slaves, Nothing) - - where - fillWindows bW r xs = snd $ mapAccumL (aux bW) (r,n) xs - where n = fromIntegral (length xs) :: Rational - - aux bW (r,n) (x,hint) = ((rest,n-1),(x,r')) - where - (allocated, _) | flp = splitHorizontallyBy (recip n) r - | otherwise = splitVerticallyBy (recip n) r - - (w,h) = underBorders bW (applySizeHints hint) (rect_D allocated) - - r' = r { rect_width = w, rect_height = h } - - rest | flp = r { rect_x = rect_x r + toEnum (fromEnum w) - , rect_width = rect_width r - w } - | otherwise = r { rect_y = rect_y r + toEnum (fromEnum h) - , rect_height = rect_height r - h } - -rect_D :: Rectangle -> D -rect_D Rectangle { rect_width = w, rect_height = h } = (w,h) - --- | Transform a function on dimensions into one without regard for borders -underBorders :: Dimension -> (D -> D) -> D -> D -underBorders bW f = adjBorders bW 1 . f . adjBorders bW (-1) - --- | Modify dimensions by a multiple of the current borders -adjBorders :: Dimension -> Dimension -> D -> D -adjBorders bW mult (w,h) = (w+2*mult*bW, h+2*mult*bW) rmfile ./XMonad/Layout/TilePrime.hs hunk ./xmonad-contrib.cabal 111 - XMonad.Layout.TilePrime hunk ./xmonad-contrib.cabal 46 - build-depends: mtl, unix, X11==1.4.0, xmonad==0.4 + build-depends: mtl, unix, X11>=1.4.0, xmonad==0.4 hunk ./xmonad-contrib.cabal 27 - tests/tests_XPrompt.hs + tests/test_XPrompt.hs hunk ./XMonad/Actions/Commands.hs 34 -import Control.Monad.Reader hunk ./XMonad/Actions/CopyWindow.hs 24 -import Graphics.X11.Xlib ( Window ) -import Control.Monad.State ( gets ) hunk ./XMonad/Actions/CopyWindow.hs 25 -import XMonad +import XMonad hiding (modify) hunk ./XMonad/Actions/CycleWS.hs 27 -import Control.Monad.Reader ( asks ) -import Control.Monad.State ( gets ) hunk ./XMonad/Actions/DeManage.hs 39 -import Control.Monad.State hunk ./XMonad/Actions/DynamicWorkspaces.hs 25 -import Control.Monad.Reader ( asks ) -import Control.Monad.State ( gets ) hunk ./XMonad/Actions/DynamicWorkspaces.hs 27 -import XMonad ( X, XState(..), WindowSet, config, layoutHook ) +import XMonad hiding (workspaces) hunk ./XMonad/Actions/FindEmptyWorkspace.hs 21 -import Control.Monad.State hunk ./XMonad/Actions/MouseGestures.hs 27 -import Control.Monad.Reader hunk ./XMonad/Actions/MouseGestures.hs 30 +import Control.Monad hunk ./XMonad/Actions/RotView.hs 21 -import Control.Monad.State ( gets ) hunk ./XMonad/Actions/Submap.hs 21 -import Control.Monad.Reader - hunk ./XMonad/Actions/Submap.hs 26 +import Control.Monad.Fix (fix) hunk ./XMonad/Actions/TagWindows.hs 29 +import Control.Monad hunk ./XMonad/Actions/TagWindows.hs 31 -import Control.Monad.State hunk ./XMonad/Actions/TagWindows.hs 34 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras - hunk ./XMonad/Actions/TagWindows.hs 88 -hasTag s w = (s `elem`) `liftM` getTags w +hasTag s w = (s `elem`) `fmap` getTags w hunk ./XMonad/Actions/Warp.hs 24 -import Control.Monad.RWS -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Actions/WindowBringer.hs 23 -import Control.Monad.State (gets) hunk ./XMonad/Actions/WindowBringer.hs 25 -import Graphics.X11.Xlib (Window()) hunk ./XMonad/Actions/WindowBringer.hs 28 -import XMonad (X) +import XMonad hunk ./XMonad/Config/Arossato.hs 24 -import Graphics.X11.Xlib hunk ./XMonad/Hooks/DynamicLog.hs 45 -import Control.Monad.Reader hunk ./XMonad/Hooks/EwmhDesktops.hs 24 -import Control.Monad.Reader hunk ./XMonad/Hooks/EwmhDesktops.hs 25 +import Control.Monad hunk ./XMonad/Hooks/ManageDocks.hs 48 -import Control.Monad.Reader hunk ./XMonad/Hooks/SetWMName.hs 39 -import Control.Monad.Reader (asks) hunk ./XMonad/Hooks/UrgencyHook.hs 41 -import Control.Monad.Reader (asks) -import Control.Monad.State (gets) hunk ./XMonad/Hooks/XPropManage.hs 23 - -import Control.Monad.Reader hunk ./XMonad/Hooks/XPropManage.hs 24 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras +import Control.Monad.Trans (lift) hunk ./XMonad/Hooks/XPropManage.hs 70 - propToHook (ms, f) = liftM and (mapM mkQuery ms) --> mkHook f + propToHook (ms, f) = fmap and (mapM mkQuery ms) --> mkHook f hunk ./XMonad/Layout/Circle.hs 24 -import Graphics.X11.Xlib hunk ./XMonad/Layout/DragPane.hs 31 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Layout/HintedTile.hs 30 -import Control.Monad.Reader +import Control.Monad hunk ./XMonad/Layout/LayoutHints.hs 23 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras ( getWMNormalHints ) hunk ./XMonad/Layout/LayoutHints.hs 25 -import Control.Monad.Reader ( asks ) hunk ./XMonad/Layout/LayoutModifier.hs 23 -import Graphics.X11.Xlib ( Rectangle ) hunk ./XMonad/Layout/LayoutScreens.hs 21 -import Control.Monad.Reader ( asks ) - hunk ./XMonad/Layout/LayoutScreens.hs 24 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Layout/MagicFocus.hs 22 -import Graphics.X11.Xlib hunk ./XMonad/Layout/Magnifier.hs 28 -import Graphics.X11.Xlib (Window, Rectangle(..)) hunk ./XMonad/Layout/Maximize.hs 26 -import Graphics.X11.Xlib hunk ./XMonad/Layout/Mosaic.hs 29 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras ( SizeHints, getWMNormalHints, sh_aspect, sh_min_size, sh_max_size ) hunk ./XMonad/Layout/NoBorders.hs 27 - -import Control.Monad.State (gets) -import Control.Monad.Reader (asks) -import Graphics.X11.Xlib hunk ./XMonad/Layout/PerWorkspace.hs 27 -import Control.Monad.State (gets) hunk ./XMonad/Layout/ResizableTile.hs 28 -import Control.Monad.State hunk ./XMonad/Layout/Spiral.hs 26 -import Graphics.X11.Xlib hunk ./XMonad/Layout/Tabbed.hs 25 -import Control.Monad.State ( gets ) -import Control.Monad.Reader hunk ./XMonad/Layout/Tabbed.hs 28 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras - hunk ./XMonad/Layout/ThreeColumns.hs 29 ---import Control.Monad.State -import Control.Monad.Reader - -import Graphics.X11.Xlib +import Control.Monad hunk ./XMonad/Layout/WindowNavigation.hs 28 -import Graphics.X11.Xlib ( Rectangle(..), Window, Pixel, setWindowBorder ) -import Control.Monad.Reader ( ask ) -import Control.Monad.State ( gets, modify ) hunk ./XMonad/Layout/WindowNavigation.hs 29 -import XMonad +import XMonad hiding (Point) hunk ./XMonad/Prompt/Layout.hs 21 -import Control.Monad.State ( gets ) hunk ./XMonad/Prompt/Workspace.hs 21 -import Control.Monad.State ( gets ) hunk ./XMonad/Prompt.hs 44 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Util/CustomKeys.hs 22 +import Control.Monad.Reader hunk ./XMonad/Util/CustomKeys.hs 25 -import Control.Monad.Reader hunk ./XMonad/Util/Dmenu.hs 26 -import Control.Monad.State hunk ./XMonad/Util/Dmenu.hs 39 - curscreen <- (fromIntegral . W.screen . W.current) `liftM` gets windowset :: X Int + curscreen <- (fromIntegral . W.screen . W.current) `fmap` gets windowset :: X Int hunk ./XMonad/Util/Font.cpphs 32 -import Graphics.X11.Xlib -import Control.Monad.Reader hunk ./XMonad/Util/NamedWindows.hs 25 -import Control.Monad.Reader ( asks ) -import Control.Monad.State ( gets ) - hunk ./XMonad/Util/NamedWindows.hs 27 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Util/Run.hs 31 -import Control.Monad.Reader hunk ./XMonad/Util/Run.hs 40 +import Control.Monad hunk ./XMonad/Util/XUtils.hs 29 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras - -import Control.Monad.Reader hunk ./XMonad/Util/XUtils.hs 32 +import Control.Monad hunk ./XMonad/Config/Sjanssen.hs 6 +import XMonad.Actions.CopyWindow hunk ./XMonad/Config/Sjanssen.hs 41 - mykeys (XConfig {modMask = modm}) = M.fromList $ - [((modm, xK_p ), shellPrompt myPromptConfig)] + mykeys (XConfig {modMask = modm, workspaces = ws}) = M.fromList $ + [((modm, xK_p ), shellPrompt myPromptConfig) + ,((modm .|. shiftMask, xK_c ), kill1) + ,((modm .|. shiftMask .|. controlMask, xK_c ), kill) + ,((modm .|. shiftMask, xK_0 ), windows $ \w -> foldr copy w ws) + ] hunk ./XMonad/Actions/ConstrainedResize.hs 26 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Actions/DeManage.hs 39 -import Graphics.X11 (Window) hunk ./XMonad/Actions/FlexibleManipulate.hs 27 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Actions/FlexibleResize.hs 23 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Actions/FloatKeys.hs 24 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Actions/MouseGestures.hs 24 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Actions/SinkAll.hs 18 -import XMonad.Core +import XMonad hunk ./XMonad/Actions/SinkAll.hs 21 -import Graphics.X11.Xlib hunk ./XMonad/Actions/Submap.hs 23 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Config/Droundy.hs 21 -import Data.Bits ((.|.)) hunk ./XMonad/Config/Droundy.hs 23 -import Graphics.X11.Xlib hunk ./XMonad/Config/Sjanssen.hs 18 -import Data.Bits hunk ./XMonad/Config/Sjanssen.hs 19 -import Graphics.X11 hunk ./XMonad/Hooks/EwmhDesktops.hs 27 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Hooks/ManageDocks.hs 51 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Hooks/SetWMName.hs 47 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Atom -import Graphics.X11.Xlib.Extras hunk ./XMonad/Hooks/UrgencyHook.hs 47 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Layout/Accordion.hs 25 -import Graphics.X11.Xlib hunk ./XMonad/Layout/Dishes.hs 29 -import Graphics.X11.Xlib hunk ./XMonad/Layout/DragPane.hs 32 -import Data.Bits hunk ./XMonad/Layout/Grid.hs 25 -import Graphics.X11.Xlib.Types hunk ./XMonad/Layout/HintedTile.hs 27 -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras hunk ./XMonad/Layout/MosaicAlt.hs 33 -import Graphics.X11.Xlib hunk ./XMonad/Layout/MosaicAlt.hs 37 -import Graphics.X11.Types ( Window ) hunk ./XMonad/Layout/ResizableTile.hs 27 -import Graphics.X11.Xlib hunk ./XMonad/Layout/Roledex.hs 26 -import Graphics.X11.Xlib hunk ./XMonad/Layout/Square.hs 28 -import Graphics.X11.Xlib hunk ./XMonad/Prompt.hs 54 -import Data.Bits hunk ./XMonad/Util/CustomKeys.hs 23 -import Graphics.X11.Xlib hunk ./XMonad/Util/CustomKeys.hs 53 --- > import Graphics.X11.Xlib hunk ./XMonad/Util/EZConfig.hs 24 -import Graphics.X11.Xlib hunk ./XMonad/Util/XSelection.hs 33 -import Graphics.X11.Xlib.Extras (Event(ev_event_display, - ev_time, ev_property, ev_target, ev_selection, - ev_requestor, ev_event_type), - xConvertSelection, xGetSelectionOwner, xSetSelectionOwner, getEvent, - currentTime, setSelectionNotify, getWindowProperty8, changeProperty8, - propModeReplace) -import Graphics.X11.Xlib (destroyWindow, createSimpleWindow, Display, XEventPtr, - sendEvent, nextEvent, sync, allocaXEvent, openDisplay, rootWindow, - defaultScreen, internAtom, Atom, selectionNotify, selectionRequest, noEventMask) -import XMonad (X, io) +import XMonad hunk ./XMonad/Actions/Commands.hs 29 -import XMonad.Operations hunk ./XMonad/Actions/ConstrainedResize.hs 25 -import XMonad.Operations hunk ./XMonad/Actions/CopyWindow.hs 26 -import XMonad.Operations ( windows, kill ) hunk ./XMonad/Actions/CycleWS.hs 34 -import XMonad.Operations hunk ./XMonad/Actions/DeManage.hs 38 -import XMonad.Operations hunk ./XMonad/Actions/DwmPromote.hs 26 -import XMonad.Operations (windows) hunk ./XMonad/Actions/DynamicWorkspaces.hs 28 -import XMonad.Operations hunk ./XMonad/Actions/FindEmptyWorkspace.hs 26 - -import XMonad.Operations hunk ./XMonad/Actions/FlexibleManipulate.hs 26 -import XMonad.Operations hunk ./XMonad/Actions/FlexibleResize.hs 22 -import XMonad.Operations hunk ./XMonad/Actions/FloatKeys.hs 22 -import XMonad.Operations hunk ./XMonad/Actions/FocusNth.hs 20 -import XMonad.Operations hunk ./XMonad/Actions/MouseGestures.hs 23 -import XMonad.Operations hunk ./XMonad/Actions/RotSlaves.hs 21 -import XMonad.Operations hunk ./XMonad/Actions/RotView.hs 27 -import XMonad.Operations hunk ./XMonad/Actions/SinkAll.hs 17 -import XMonad.Operations hunk ./XMonad/Actions/Submap.hs 22 -import XMonad.Operations (cleanMask) hunk ./XMonad/Actions/TagWindows.hs 32 -import XMonad.Operations (windows, withFocused) hunk ./XMonad/Actions/Warp.hs 24 -import XMonad.Operations hunk ./XMonad/Actions/WindowBringer.hs 26 -import XMonad.Operations (windows) hunk ./XMonad/Config/Arossato.hs 28 -import XMonad.Operations hunk ./XMonad/Config/Droundy.hs 19 -import XMonad.Operations hunk ./XMonad/Config/Sjanssen.hs 10 -import XMonad.Operations hunk ./XMonad/Hooks/ManageDocks.hs 49 -import XMonad.Operations hunk ./XMonad/Hooks/UrgencyHook.hs 33 -import XMonad.Operations (windows) hunk ./XMonad/Layout/Combo.hs 27 -import XMonad +import XMonad hiding (focus) hunk ./XMonad/Layout/DragPane.hs 35 -import XMonad.Operations hunk ./XMonad/Layout/HintedTile.hs 25 -import XMonad.Operations (applySizeHints, D) hunk ./XMonad/Layout/LayoutHints.hs 22 -import XMonad.Operations ( applySizeHints, D ) hunk ./XMonad/Layout/LayoutScreens.hs 23 -import qualified XMonad.Operations as O hunk ./XMonad/Layout/LayoutScreens.hs 60 - O.windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) -> + windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) -> hunk ./XMonad/Layout/Mosaic.hs 44 --- > import XMonad.Operations hunk ./XMonad/Layout/Tabbed.hs 29 -import XMonad.Operations hunk ./XMonad/Layout/TwoPane.hs 25 -import XMonad +import XMonad hiding (focus) hunk ./XMonad/Layout/WindowNavigation.hs 31 -import XMonad.Operations ( windows ) hunk ./XMonad/Layout/WorkspaceDir.hs 35 -import XMonad.Operations ( sendMessage ) hunk ./XMonad/Prompt/Layout.hs 23 -import XMonad.Operations ( sendMessage ) hunk ./XMonad/Prompt/Window.hs 30 -import XMonad.Operations (windows) hunk ./XMonad/Prompt.hs 45 -import XMonad.Operations (initColor) hunk ./XMonad/Util/Font.cpphs 34 -import XMonad.Operations hunk ./XMonad/Actions/Commands.hs 31 -import XMonad.Layouts hunk ./XMonad/Config/Arossato.hs 26 -import XMonad.Layouts hunk ./XMonad/Config/Droundy.hs 13 -import XMonad hiding (keys, config) +import XMonad hiding (keys, config, (|||)) hunk ./XMonad/Config/Droundy.hs 18 -import XMonad.Layouts hiding ( (|||) ) hunk ./XMonad/Config/Sjanssen.hs 4 -import XMonad +import XMonad hiding (Tall(..)) hunk ./XMonad/Config/Sjanssen.hs 7 -import XMonad.Layouts hiding (Tall) hunk ./XMonad/Hooks/DynamicLog.hs 44 -import XMonad.Layouts hunk ./XMonad/Layout/Accordion.hs 23 -import XMonad.Layouts hunk ./XMonad/Layout/Dishes.hs 26 -import XMonad.Layouts hunk ./XMonad/Layout/DragPane.hs 34 -import XMonad.Layouts hunk ./XMonad/Layout/HintedTile.hs 23 -import XMonad -import XMonad.Layouts (Resize(..), IncMasterN(..)) +import XMonad hiding (Tall(..)) hunk ./XMonad/Layout/LayoutCombinators.hs 48 -import XMonad.Core -import XMonad.Layouts ( Tall(..), Mirror(..), ChangeLayout(NextLayout) ) +import XMonad hiding ((|||)) hunk ./XMonad/Layout/Mosaic.hs 30 -import XMonad.Layouts ( Resize(Shrink, Expand) ) hunk ./XMonad/Layout/MosaicAlt.hs 32 -import XMonad.Layouts hunk ./XMonad/Layout/MultiToggle.hs 48 --- 'XMonad.Layouts.Mirror': +-- 'XMonad.Layout.Mirror': hunk ./XMonad/Layout/MultiToggle.hs 68 --- you can now dynamically apply the 'XMonad.Layouts.Mirror' transformation: +-- you can now dynamically apply the 'XMonad.Layout.Mirror' transformation: hunk ./XMonad/Layout/ResizableTile.hs 24 -import XMonad -import XMonad.Layouts (Resize(..), IncMasterN(..)) +import XMonad hiding (splitVertically, splitHorizontallyBy) hunk ./XMonad/Layout/Roledex.hs 24 -import XMonad.Layouts hunk ./XMonad/Layout/Spiral.hs 28 -import XMonad.Layouts hunk ./XMonad/Layout/ThreeColumns.hs 25 -import XMonad.Layouts ( Resize(..), IncMasterN(..), splitVertically, splitHorizontallyBy ) hunk ./XMonad/Layout/TwoPane.hs 26 -import XMonad.Layouts ( Resize(..), splitHorizontallyBy ) hunk ./XMonad/Prompt/Ssh.hs 41 +-- +-- Keep in mind, that if you want to use the completion you have to +-- disable the "HashKnownHosts" option in your ssh_config hunk ./XMonad/Hooks/DynamicLog.hs 54 --- --- To use, set: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Hooks/DynamicLog.hs 56 +-- > import XMonad hunk ./XMonad/Hooks/DynamicLog.hs 58 --- > logHook = dynamicLog - --- %import XMonad.Hooks.DynamicLog --- %def -- comment out default logHook definition above if you uncomment any of these: --- %def logHook = dynamicLog +-- > main = xmonad defaultConfig { logHook = dynamicLog } hunk ./XMonad/Hooks/EwmhDesktops.hs 31 --- Add the imports to your configuration file and add the logHook: +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Hooks/EwmhDesktops.hs 33 +-- > import XMonad hunk ./XMonad/Hooks/EwmhDesktops.hs 35 +-- > +-- > myLogHook :: X () +-- > myLogHook = do ewmhDesktopsLogHook +-- > return () +-- > +-- > main = xmonad defaultConfig { logHook = myLogHook } +-- +-- For more detailed instructions on editing the layoutHook see: hunk ./XMonad/Hooks/EwmhDesktops.hs 44 --- > logHook :: X() --- > logHook = do ewmhDesktopsLogHook --- > return () +-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" hunk ./XMonad/Hooks/EwmhDesktops.hs 46 --- %import XMonad.Hooks.EwmhDesktops --- %def -- comment out default logHook definition above if you uncomment this: --- %def logHook = ewmhDesktopsLogHook - - --- | +-- | hunk ./XMonad/Hooks/SetWMName.hs 20 --- > ((modMask .|. controlMask .|. shiftMask, xK_z), setWMName "LG3D") -- @@ Java hack +-- > ((modMask x .|. controlMask .|. shiftMask, xK_z), setWMName "LG3D") -- @@ Java hack hunk ./XMonad/Hooks/SetWMName.hs 33 +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Hooks/XPropManage.hs 30 --- --- Add something like the following lines to Config.hs to use this module +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Hooks/XPropManage.hs 33 --- +-- > import qualified XMonad.StackSet as W +-- > import XMonad.Actions.TagWindows +-- > import Data.List +-- hunk ./XMonad/Hooks/XPropManage.hs 40 --- > xPropMatches = [ ([ (wM_CLASS, any ("gimp"==)))], (\w -> float w >> return (W.shift "2"))) +-- > xPropMatches = [ ([ (wM_CLASS, any ("gimp"==))], (\w -> float w >> return (W.shift "2"))) hunk ./XMonad/Config/Arossato.hs 149 + , ((modMask x .|. shiftMask, xK_t ), spawn "~/bin/teaTime.sh" ) hunk ./XMonad/Doc/Extending.hs 641 -with a specific layout combinator: 'XMonad.Layouts.|||'. +with a specific layout combinator: 'XMonad.Layout.|||'. hunk ./XMonad/Doc/Extending.hs 643 -Suppose we want a list with the 'XMonad.Layouts.Full', +Suppose we want a list with the 'XMonad.Layout.Full', hunk ./XMonad/Doc/Extending.hs 836 -XXX add some examples. - hunk ./XMonad/Hooks/ManageDocks.hs 14 --- Makes xmonad detect windows with type DOCK and does not put them in --- layouts. It also detects window with STRUT set and modifies the --- gap accordingly. --- --- It also allows you to reset the gap to reflect the state of current STRUT --- windows (for example, after you resized or closed a panel), and to toggle the Gap --- in a STRUT-aware fashion. --- --- The avoidStruts layout modifier allows you to make xmonad dynamically --- avoid overlapping windows with panels. You can (optionally) enable this --- on a selective basis, so that some layouts will effectively hide the --- panel, by placing windows on top of it. An example use of avoidStruts --- would be: --- --- > layoutHook = Layout $ toggleLayouts (noBorders Full) $ avoidStruts $ --- > your actual layouts here ||| ... --- --- You may also wish to bind a key to sendMessage ToggleStruts, which will --- toggle the avoidStruts behavior, so you can hide your panel at will. --- --- This would enable a full-screen mode that overlaps the panel, while all --- other layouts avoid the panel. --- ------------------------------------------------------------------------------ +-- This module provides tools to automatically manage 'dock' type programs, +-- such as gnome-panel, kicker, dzen, and xmobar. hunk ./XMonad/Hooks/ManageDocks.hs 20 - manageDocksHook - ,resetGap - ,toggleGap - ,avoidStruts, ToggleStruts(ToggleStruts) + manageDocks, AvoidStruts, avoidStruts, ToggleStruts(ToggleStruts) hunk ./XMonad/Hooks/ManageDocks.hs 23 + +----------------------------------------------------------------------------- hunk ./XMonad/Hooks/ManageDocks.hs 26 -import qualified XMonad.StackSet as W hunk ./XMonad/Hooks/ManageDocks.hs 28 - hunk ./XMonad/Hooks/ManageDocks.hs 29 --- Add the imports to your configuration file and add the manageHook: +-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Hooks/ManageDocks.hs 33 --- > manageHook w _ _ _ = manageDocksHook w +-- The first component is a 'ManageHook' which recognizes these windows. To +-- enable it: hunk ./XMonad/Hooks/ManageDocks.hs 36 --- and comment out the default `manageHook _ _ _ _ = return id` line. +-- > manageHook = ... <+> manageDocks hunk ./XMonad/Hooks/ManageDocks.hs 38 --- Then you can bind resetGap or toggleGap as you wish: +-- The second component is a layout modifier that prevents windows from +-- overlapping these dock windows. It is intended to replace xmonad's +-- so-called "gap" support. First, you must add it to your list of layouts: +-- +-- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...) +-- +-- 'AvoidStruts' also supports toggling the dock gap, add a keybinding similar +-- to: +-- +-- > ,((modMask, xK_b ), sendMessage ToggleStruts) hunk ./XMonad/Hooks/ManageDocks.hs 49 --- > , ((modMask, xK_b), toggleGap) - --- %import XMonad.Hooks.ManageDocks --- %def -- comment out default manageHook definition above if you uncomment this: --- %def manageHook w _ _ _ = manageDocksHook w --- %keybind , ((modMask, xK_b), toggleGap) - hunk ./XMonad/Hooks/ManageDocks.hs 53 -manageDocksHook :: Window -> X (WindowSet -> WindowSet) -manageDocksHook w = do - hasStrut <- getStrut w - maybe (return ()) setGap hasStrut - - isDock <- checkDock w - if isDock then do - reveal w - return (W.delete w) - else do - return id +manageDocks :: ManageHook +manageDocks = checkDock --> doIgnore hunk ./XMonad/Hooks/ManageDocks.hs 58 -checkDock :: Window -> X (Bool) -checkDock w = do +checkDock :: Query Bool +checkDock = ask >>= \w -> liftX $ do hunk ./XMonad/Hooks/ManageDocks.hs 86 --- | --- Modifies the gap, setting new max -setGap :: (Int, Int, Int, Int) -> X () -setGap gap = modifyGap (\_ -> max4 gap) - - hunk ./XMonad/Hooks/ManageDocks.hs 89 -calcGap :: X (Int, Int, Int, Int) +calcGap :: X Rectangle hunk ./XMonad/Hooks/ManageDocks.hs 91 - 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 - return $ foldl max4 (0,0,0,0) struts + 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 hunk ./XMonad/Hooks/ManageDocks.hs 96 --- | --- Adjusts the gap to the STRUTs of all current Windows -resetGap :: X () -resetGap = do - newGap <- calcGap - modifyGap (\_ _ -> newGap) - --- | --- Removes the gap or, if already removed, sets the gap according to the windows’ STRUT -toggleGap :: X () -toggleGap = do - newGap <- calcGap - modifyGap (\_ old -> if old == (0,0,0,0) then newGap else (0,0,0,0)) + -- 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) hunk ./XMonad/Hooks/ManageDocks.hs 108 +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) + +-- | 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 + hunk ./XMonad/Hooks/ManageDocks.hs 142 - doLayout (AvoidStruts True lo) (Rectangle x y w h) s = - do (t,b,l,r) <- calcGap - let rect = Rectangle (x+fromIntegral l) (y+fromIntegral t) - (w-fromIntegral l-fromIntegral r) (h-fromIntegral t-fromIntegral b) + doLayout (AvoidStruts True lo) r s = + do rect <- fmap (flip fitRect r) calcGap hunk ./XMonad/Config/Sjanssen.hs 12 +import XMonad.Hooks.ManageDocks hunk ./XMonad/Config/Sjanssen.hs 23 - { defaultGaps = [(15,0,0,0)] - , terminal = "urxvt" + { terminal = "urxvt" hunk ./XMonad/Config/Sjanssen.hs 32 - , layoutHook = smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTConf) + , layoutHook = avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTConf) + , manageHook = manageHook defaultConfig <+> manageDocks hunk ./XMonad/Config/Sjanssen.hs 43 + ,((modm, xK_b ), sendMessage ToggleStruts) hunk ./XMonad/Doc/Extending.hs 713 + hunk ./XMonad/Doc/Extending.hs 715 -> manageHook = composeAll . concat $ -> [ [ className =? c --> doFloat | c <- floats] -> , [ resource =? r --> doIgnore | r <- ignore] -> , [ resource =? "Gecko" --> doF (W.shift "web") ]] -> where floats = ["MPlayer", "Gimp"] -> ignore = ["gnome-panel", "desktop_window", "kicker", "kdesktop"] +> manageHook = composeAll +> [ className =? "MPlayer" --> doFloat +> , className =? "Gimp" --> doFloat +> , resource =? "desktop_window" --> doIgnore +> , resource =? "kdesktop" --> doIgnore ] hunk ./XMonad/Doc/Extending.hs 722 -different 'XMonad.Config.ManageHook's. In this example we have three -lists of 'XMonad.Config.ManageHook's: the first one is the list of the -windows to be placed in the float layer with the -'XMonad.ManageHook.doFloat' function (MPlayer and Gimp); the second -one is the list of windows to be ignored; the third (which contains -only one 'XMonad.Config.ManageHook') will match firefox, or mozilla, -and put them in the workspace named \"web\", with -'XMonad.ManageHook.doF' and 'XMonad.StackSet.shift'. (@concat@ simply -combines these three lists into a single list.) +different 'XMonad.Config.ManageHook's. In this example we have a list +of 'XMonad.Config.ManageHook's formed by the following commands: the +Mplayer's and the Gimp's windows, whose 'XMonad.ManageHook.className' +are, respectively \"Mplayer\" and \"Gimp\", are to be placed in the +float layer with the 'XMonad.ManageHook.doFloat' function; the windows +whose resource names are respectively \"desktop_window\" and +\kdesktop\" are to be ignored with the 'XMonad.ManageHook.doIgnore' +function. + +This is another example of 'XMonad.Config.manageHook', taken from +"XMonad.Config.Arossato": + +> myManageHook = composeAll [ resource =? "realplay.bin" --> doFloat +> , resource =? "win" --> doF (W.shift "doc") -- xpdf +> , resource =? "firefox-bin" --> doF (W.shift "web") +> ] +> newManageHook = myManageHook <+> manageHook defaultConfig + + +Again we use 'XMonad.ManageHook.composeAll' to compose a list of +different 'XMonad.Config.ManageHook's. The first one will put +RealPlayer on the float layer, the second one will put the xpdf +windows in the workspace named \"doc\", with 'XMonad.ManageHook.doF' +and 'XMonad.StackSet.shift' functions, and the third one will put all +firefox windows on the workspace called "web". Then we use the +'XMonad.ManageHook.<+>' combinator to compose @myManageHook@ with the +default 'XMonad.Config.manageHook' to form @newManageHook@. hunk ./xmonad-contrib.cabal 2 -version: 0.4 +version: 0.5 hunk ./xmonad-contrib.cabal 46 - build-depends: mtl, unix, X11>=1.4.0, xmonad==0.4 + build-depends: mtl, unix, X11>=1.4.0, xmonad==0.5 hunk ./XMonad/Doc.hs 60 -. + hunk ./XMonad/Doc.hs 87 + hunk ./XMonad/Layout/Magnifier.hs 25 + magnifiercz, hunk ./XMonad/Layout/Magnifier.hs 43 +-- +-- By default magnifier increases the focused windows size by 1.5 +-- you can do: +-- > magnifiercz (12%10) +-- to use a custom level of magification. You can even make the focused +-- window smaller for a pop in effect. Keep in mind, you must +-- >import Data.Ratio +-- For to use rationals in your config. hunk ./XMonad/Layout/Magnifier.hs 71 +-- | 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) + hunk ./XMonad/Layout/Magnifier.hs 46 +-- hunk ./XMonad/Layout/Magnifier.hs 48 +-- hunk ./XMonad/Layout/Magnifier.hs 51 --- >import Data.Ratio +-- +-- > import Data.Ratio +-- hunk ./XMonad/Layout/Magnifier.hs 38 --- Then edit your @layoutHook@ by adding the Magnifier layout modifier +-- Then edit your @layoutHook@ by adding the 'magnifier' layout modifier hunk ./XMonad/Layout/Magnifier.hs 43 --- --- By default magnifier increases the focused windows size by 1.5 --- you can do: hunk ./XMonad/Layout/Magnifier.hs 44 --- > magnifiercz (12%10) +-- By default magnifier increases the focused window's size by 1.5. +-- You can also use: hunk ./XMonad/Layout/Magnifier.hs 47 --- to use a custom level of magification. You can even make the focused +-- > magnifiercz (12%10) +-- +-- to use a custom level of magnification. You can even make the focused hunk ./XMonad/Layout/Magnifier.hs 52 --- > import Data.Ratio +-- > import Data.Ratio hunk ./XMonad/Layout/Magnifier.hs 54 --- For to use rationals in your config. +-- in order to use rationals (such as @12%10@) in your config. hunk ./XMonad/Layout/Magnifier.hs 26 + magnifiercz', hunk ./XMonad/Layout/Magnifier.hs 85 +-- | 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) + addfile ./XMonad/Hooks/ManageHelpers.hs hunk ./XMonad/Hooks/ManageHelpers.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.ManageHelpers +-- Copyright : (c) Lukas Mai +-- License : BSD +-- +-- Maintainer : Lukas Mai +-- 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, + transience, + transience' +) where + +import XMonad +import qualified XMonad.StackSet as W + +import Data.Maybe +import Data.Monoid + +-- | 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 :: [Query (Maybe (Endo WindowSet))] -> ManageHook +composeOne = foldr try idHook + where + try q z = do + x <- q + case x of + Just h -> return h + Nothing -> z + +infixr 0 -?> +-- | 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 -> Query (Endo WindowSet) -> Query (Maybe (Endo WindowSet)) +p -?> f = do + x <- p + if x then fmap Just f 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 special rule that moves transient windows to the workspace of their +-- associated primary windows. +transience :: Query (Maybe (Endo WindowSet)) +transience = do + w <- ask + d <- (liftX . asks) display + x <- liftIO $ getTransientForHint d w + case x of + Nothing -> return Nothing + Just w' -> do + return . Just . Endo $ \s -> + maybe s (`W.shift` s) (W.findTag w' s) + +-- | Like 'transience' but with a type that can be used in 'composeAll'. +transience' :: ManageHook +transience' = fmap (fromMaybe mempty) transience hunk ./xmonad-contrib.cabal 82 + XMonad.Hooks.ManageHelpers hunk ./XMonad/Prompt/Man.hs 16 --- --- * write QuickCheck properties hunk ./XMonad/Prompt/Man.hs 59 -manPrompt c = mkXPrompt Man c manCompl $ runInTerm . (++) "man " +manPrompt c = do + mans <- io getMans + mkXPrompt Man c (manCompl mans) $ runInTerm . (++) "man " hunk ./XMonad/Prompt/Man.hs 63 -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 [] hunk ./XMonad/Prompt/Man.hs 67 - dirs = [d ++ "/" ++ s | d <- split ':' mp, s <- sects] - stripExt = reverse . drop 1 . dropWhile (/= '.') . reverse + dirs = [d ++ "/" ++ s | d <- split ':' paths, s <- sects] hunk ./XMonad/Prompt/Man.hs 74 - 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 hunk ./XMonad/Prompt/Man.hs 85 --- XXX merge with 'XMonad.Util.Run.runProcessWithInput'? +-- XXX Merge into 'XMonad.Util.Run'? hunk ./XMonad/Prompt/Man.hs 87 --- * update documentation of the latter (there is no 'Maybe' in result) --- --- * ask \"gurus\" whether @evaluate (length ...)@ approach is --- better\/more idiomatic +-- (Ask \"gurus\" whether @evaluate (length ...)@ approach is +-- better\/more idiomatic.) hunk ./XMonad/Prompt/Man.hs 99 +stripExt :: String -> String +stripExt = reverse . drop 1 . dropWhile (/= '.') . reverse + hunk ./XMonad/Util/Run.hs 53 --- | Returns Just output if the command succeeded, and Nothing if it didn't. +-- | Return output if the command succeeded, otherwise return @()@. hunk ./XMonad/Util/Run.hs 107 --- +-- hunk ./XMonad/Util/Run.hs 110 --- +-- hunk ./XMonad/Hooks/ManageDocks.hs 114 -reduceScreen (t, b, l, r) (Rectangle rx ry rw rh) - = Rectangle (rx + fi l) (ry + fi t) (rw - fi r) (rh - fi b) +reduceScreen (t, b, l, r) s + = case r2c s of + (x1, y1, x2, y2) -> c2r (x1 + fi l, y1 + fi t, x2 - fi r, y2 - fi b) hunk ./XMonad/Hooks/ManageDocks.hs 28 +import Control.Monad + hunk ./XMonad/Hooks/ManageDocks.hs 73 - 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 + s <- getAtom "_NET_WM_STRUT" + sp <- getAtom "_NET_WM_STRUT_PARTIAL" + liftM2 (\a b -> mplus (parse a) (parse b)) + (getProp s w) + (getProp sp w) + where + parse xs = case xs of + Just (l : r : t : b : _) -> Just (fi t, fi b, fi l, fi r) + _ -> Nothing addfile ./XMonad/Util/Search.hs hunk ./XMonad/Util/Search.hs 1 +{- | + Module : XMonad.Util.Search + Copyright : (C) 2007 Gwern Branwen + License : None; public domain + + Maintainer : + Stability : unstable + Portability : unportable + + A module for easily running Internet searches on web sites through XMonad. + Modeled after the handy Surfraw CLI search tools + . + + Additional sites welcomed. +--------------------------------------------------------------------------- -} +module XMonad.Util.Search ( -- * Usage + -- $usage + google, + googleSelection, + wayback, + waybackSelection, + wikipedia, + wikipediaSelection, + promptSearch, + search + ) where + +import Data.Char (isAlpha, isDigit, isMark) +import XMonad (io, X()) +import XMonad.Util.Run (safeSpawn) +import Network.URI (escapeURIString) +import XMonad.Prompt.Shell (getShellCompl) +import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig()) +import XMonad.Util.XSelection (getSelection) + +-- A customized prompt +data Search = Search +instance XPrompt Search where + showXPrompt Search = "Search: " + +-- | Escape the search string so search engines understand it. +-- We could just go (const False) and escape anything that even looks at us +-- funny, but that produces obfuscated search queries. So we merely escape +-- anything that doesn't look unfunny. +escape :: String -> String +escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c) + +-- | Given the base search URL, a browser to use, and the actual query, escape +-- the query, prepend the base URL, and hand it off to the browser. +search :: String -> FilePath -> String -> IO () +search site browser search = safeSpawn browser $ site ++ escape search + +promptSearch :: (String -> String -> IO ()) -> String -> XPConfig -> X () +promptSearch engine browser config = mkXPrompt Search config (getShellCompl []) $ io . (engine browser) + +-- The engines +googleSearch, waybackSearch, wikipediaSearch :: String -> String -> IO () +googleSearch = search "http://www.google.com/search?num=100&q=" +wikipediaSearch = search "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search=" +{- This doesn't seem to work, but nevertheless, it seems to be the official + method at to get the + latest backup. -} +waybackSearch = search "http://web.archive.org/" + +-- | Search the particular site; these are suitable for binding to a key. Use them like this: +-- > , ((modm, xK_g ), google "firefox" defaultXPConfig) +-- First argument is the browser you want to use, the second the prompt configuration +google, wayback, wikipedia :: String -> XPConfig -> X () +google = promptSearch googleSearch +wikipedia = promptSearch wikipediaSearch +wayback = promptSearch waybackSearch + +-- | See previous. Like google/wikipedia, but one less argument - the query is +-- extracted from the copy-paste buffer of X Windows. +googleSelection, waybackSelection, wikipediaSelection :: String -> X () +googleSelection browser = io $ googleSearch browser =<< getSelection +wikipediaSelection browser = io $ wikipediaSearch browser =<< getSelection +waybackSelection browser = io $ waybackSearch browser =<< getSelection hunk ./xmonad-contrib.cabal 38 - build-depends: base >= 3, containers, directory, process, random + build-depends: base >= 3, containers, directory, network, process, random hunk ./xmonad-contrib.cabal 137 + XMonad.Util.Search hunk ./XMonad/Util/Search.hs 51 -search site browser search = safeSpawn browser $ site ++ escape search +search site browser query = safeSpawn browser $ site ++ escape query hunk ./XMonad/Util/Search.hs 66 +-- hunk ./XMonad/Util/Search.hs 68 +-- hunk ./XMonad/Util/Search.hs 75 --- | See previous. Like google/wikipedia, but one less argument - the query is +-- | See previous. Like google\/wikipedia, but one less argument - the query is hunk ./XMonad/Util/Search.hs 28 -import Data.Char (isAlpha, isDigit, isMark) hunk ./XMonad/Util/Search.hs 30 -import Network.URI (escapeURIString) hunk ./XMonad/Util/Search.hs 44 -escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c) +escape = id hunk ./xmonad-contrib.cabal 38 - build-depends: base >= 3, containers, directory, network, process, random + build-depends: base >= 3, containers, directory, process, random hunk ./xmonad-contrib.cabal 46 - build-depends: mtl, unix, X11>=1.4.0, xmonad==0.5 + build-depends: mtl, unix, X11>=1.4.1, xmonad==0.5 hunk ./XMonad/Hooks/DynamicLog.hs 52 +import XMonad.Hooks.UrgencyHook hunk ./XMonad/Hooks/DynamicLog.hs 108 + winset <- gets windowset + urgents <- readUrgents hunk ./XMonad/Hooks/DynamicLog.hs 112 - ld <- withWindowSet $ return . description . S.layout . S.workspace . S.current + let ld = description . S.layout . S.workspace . S.current $ winset hunk ./XMonad/Hooks/DynamicLog.hs 114 - ws <- withWindowSet $ return . pprWindowSet spaces pp + let ws = pprWindowSet spaces urgents pp winset hunk ./XMonad/Hooks/DynamicLog.hs 116 - wt <- withWindowSet $ maybe (return "") (fmap show . getName) . S.peek + wt <- maybe (return "") (fmap show . getName) . S.peek $ winset hunk ./XMonad/Hooks/DynamicLog.hs 130 - -pprWindowSet :: [String] -> PP -> WindowSet -> String -pprWindowSet spaces pp s = sepBy (ppWsSep pp) $ map fmt $ sortBy cmp +pprWindowSet :: [String] -> [Window] -> PP -> WindowSet -> String +pprWindowSet spaces urgents pp s = sepBy (ppWsSep pp) $ map fmt $ sortBy cmp hunk ./XMonad/Hooks/DynamicLog.hs 146 - 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 = \pp -> ppUrgent pp . ppHidden pp + | isJust (S.stack w) = ppHidden + | otherwise = ppHiddenNoWindows hunk ./XMonad/Hooks/DynamicLog.hs 204 - , ppHidden, ppHiddenNoWindows :: WorkspaceId -> String + , ppHidden, ppHiddenNoWindows + , ppUrgent :: WorkspaceId -> String hunk ./XMonad/Hooks/DynamicLog.hs 219 + , ppUrgent = id hunk ./XMonad/Hooks/DynamicLog.hs 234 + , ppUrgent = dzenColor "red" "yellow" hunk ./XMonad/Hooks/DynamicLog.hs 148 - | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents = \pp -> ppUrgent pp . ppHidden pp + | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents = \ppC -> ppUrgent ppC . ppHidden ppC hunk ./XMonad/Hooks/DynamicLog.hs 13 --- Log events in: +-- By default, log events in: hunk ./XMonad/Hooks/DynamicLog.hs 17 --- format. Suitable to pipe into dzen. +-- format, although the format is highly customizable. +-- Suitable to pipe into dzen or xmobar. hunk ./XMonad/Hooks/DynamicLog.hs 24 - -- $usage + -- $usage hunk ./XMonad/Hooks/DynamicLog.hs 41 --- +-- hunk ./XMonad/Hooks/DynamicLog.hs 55 --- $usage +-- $usage hunk ./XMonad/Hooks/DynamicLog.hs 72 --- | +-- | hunk ./XMonad/Hooks/DynamicLog.hs 74 --- 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 hunk ./XMonad/Hooks/DynamicLog.hs 257 -dynamicLogXmobar = +dynamicLogXmobar = hunk ./XMonad/Layout/Tabbed.hs 36 +import XMonad.Hooks.UrgencyHook + hunk ./XMonad/Layout/Tabbed.hs 67 + , urgentColor :: String hunk ./XMonad/Layout/Tabbed.hs 69 - , inactiveTextColor :: String hunk ./XMonad/Layout/Tabbed.hs 70 + , urgentBorderColor :: String hunk ./XMonad/Layout/Tabbed.hs 72 + , inactiveTextColor :: String + , urgentTextColor :: String hunk ./XMonad/Layout/Tabbed.hs 82 + , urgentColor = "#FFFF00" hunk ./XMonad/Layout/Tabbed.hs 85 + , urgentBorderColor = "##00FF00" hunk ./XMonad/Layout/Tabbed.hs 88 + , urgentTextColor = "#FF0000" hunk ./XMonad/Layout/Tabbed.hs 193 + ur <- readUrgents hunk ./XMonad/Layout/Tabbed.hs 195 - 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 hunk ./XMonad/Layout/Tabbed.hs 203 + (urgentColor c, urgentBorderColor c, urgentTextColor c) hunk ./XMonad/Config/Droundy.hs 44 ---import XMonad.Hooks.ManageDocks ---import XMonad.Hooks.UrgencyHook +import XMonad.Hooks.ManageDocks +import XMonad.Hooks.UrgencyHook hunk ./XMonad/Config/Droundy.hs 130 + withUrgencyHook NoUrgencyHook $ hunk ./XMonad/Config/Droundy.hs 135 - toggleLayouts (noBorders Full) $ -- avoidStruts $ + toggleLayouts (noBorders Full) $ avoidStruts $ hunk ./XMonad/Config/Droundy.hs 138 + Named "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) ||| hunk ./XMonad/Util/Search.hs 33 +import Data.Char (chr, ord) +import Numeric (showIntAtBase) hunk ./XMonad/Util/Search.hs 42 --- We could just go (const False) and escape anything that even looks at us --- funny, but that produces obfuscated search queries. So we merely escape --- anything that doesn't look unfunny. +-- 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'. hunk ./XMonad/Util/Search.hs 45 -escape = id +escape = escapeURIString (const False) + where + escapeURIString :: + (Char -> Bool) -- ^ a predicate which returns 'False' + -- if the character should be escaped + -> 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" + [c] -> ['0',c] + cs -> cs + toChrHex d + | d < 10 = chr (ord '0' + fromIntegral d) + | otherwise = chr (ord 'A' + fromIntegral (d - 10)) hunk ./XMonad/Util/Search.hs 20 + googleSearch, hunk ./XMonad/Util/Search.hs 23 + waybackSearch, hunk ./XMonad/Util/Search.hs 26 + wikipediaSearch, hunk ./XMonad/Util/Search.hs 36 -import Data.Char (chr, ord) +import Data.Char (chr, ord, isAlpha, isMark, isDigit) hunk ./XMonad/Util/Search.hs 48 -escape = escapeURIString (const False) +escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c) hunk ./XMonad/Util/Search.hs 65 - [c] -> ['0',c] + [ch] -> ['0',ch] hunk ./XMonad/Actions/Warp.hs 42 + +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 + +And if you wanted to run it on every window or focus movement, you could put it +into your xmonad.hs's logHook (which activates on every change) like thus: + +> , logHook = banish hunk ./XMonad/Actions/Warp.hs 43 -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: +'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: + hunk ./XMonad/Actions/Warp.hs 50 -And if you wanted to run it on every window or focus movement, you could put it -into your xmonad.hs's logHook (which activates on every change) like thus: +And if you wanted to run it on every window or focus movement, you +could put it into your @xmonad.hs@'s logHook (which activates on every +change) like thus: hunk ./XMonad/Actions/Warp.hs 55 + hunk ./XMonad/Actions/Warp.hs 49 - -And if you wanted to run it on every window or focus movement, you -could put it into your @xmonad.hs@'s logHook (which activates on every -change) like thus: - -> , logHook = banish changepref test runhaskell Setup.lhs configure --disable-optimization --user && runhaskell Setup.lhs build runhaskell Setup.lhs configure --disable-optimization --user && runhaskell Setup.lhs build && runhaskell Setup.lhs haddock hunk ./XMonad/Doc/Developing.hs 249 -* Use Haddock syntax in the comments. +* Use Haddock syntax in the comments (see below). hunk ./XMonad/Doc/Developing.hs 263 +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: +. + hunk ./XMonad/Doc/Developing.hs 181 -'XMonad.StackSet.StackSet'. These functions are most commonlyq used as +'XMonad.StackSet.StackSet'. These functions are most commonly used as hunk ./XMonad/Actions/Commands.hs 91 - , ("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 ) hunk ./XMonad/Config/Droundy.hs 80 - , ((modMask x , xK_Escape), broadcastMessage ReleaseResources >> restart (Just "xmonad") True) -- %! Restart xmonad + , ((modMask x , xK_Escape), restart "xmonad" True) -- %! Restart xmonad hunk ./XMonad/Util/Search.hs 18 - google, - googleSelection, - googleSearch, - wayback, - waybackSelection, - waybackSearch, - wikipedia, - wikipediaSelection, - wikipediaSearch, + google, googleSelection, googleSearch, + wayback, waybackSelection, waybackSearch, + wikipedia, wikipediaSelection, wikipediaSearch, hunk ./XMonad/Util/Search.hs 25 +import Control.Monad.Trans (MonadIO()) -- for select's type signature +import Data.Char (chr, ord, isAlpha, isMark, isDigit) +import Numeric (showIntAtBase) hunk ./XMonad/Util/Search.hs 29 -import XMonad.Util.Run (safeSpawn) -import XMonad.Prompt.Shell (getShellCompl) hunk ./XMonad/Util/Search.hs 30 +import XMonad.Prompt.Shell (getShellCompl) +import XMonad.Util.Run (safeSpawn) hunk ./XMonad/Util/Search.hs 33 -import Data.Char (chr, ord, isAlpha, isMark, isDigit) -import Numeric (showIntAtBase) hunk ./XMonad/Util/Search.hs 34 --- A customized prompt +-- A customized prompt. hunk ./XMonad/Util/Search.hs 44 - where + where -- Copied from Network.URI. hunk ./XMonad/Util/Search.hs 46 - (Char -> Bool) -- ^ a predicate which returns 'False' - -- if the character should be escaped - -> String -- ^ the string to process - -> String -- ^ the resulting URI string + (Char -> Bool) -- a predicate which returns 'False' if should escape + -> String -- the string to process + -> String -- the resulting URI string hunk ./XMonad/Util/Search.hs 50 - hunk ./XMonad/Util/Search.hs 69 -promptSearch :: (String -> String -> IO ()) -> String -> XPConfig -> X () -promptSearch engine browser config = mkXPrompt Search config (getShellCompl []) $ io . (engine browser) - hunk ./XMonad/Util/Search.hs 73 +waybackSearch = search "http://web.archive.org/" hunk ./XMonad/Util/Search.hs 77 -waybackSearch = search "http://web.archive.org/" + +-- | Like 'search', but in this case, the string is not specified but grabbed +-- from the user's response to a prompt. +promptSearch :: (String -> String -> IO ()) -> String -> XPConfig -> X () +promptSearch searchEngine browser config = mkXPrompt Search config (getShellCompl []) $ io . (searchEngine browser) hunk ./XMonad/Util/Search.hs 87 --- First argument is the browser you want to use, the second the prompt configuration +-- First argument is the browser you want to use, the second the prompt configuration. hunk ./XMonad/Util/Search.hs 93 --- | See previous. Like google\/wikipedia, but one less argument - the query is +-- | Like search, but for use with the X selection; it grabs the selection, +-- passes it to a given searchEngine and opens it in a browser. The various +-- *Selection functions specialize this to a particular search engine to make +-- things easier. +select :: (Control.Monad.Trans.MonadIO m) => (t -> String -> IO a) -> t -> m a +select browser searchEngine = io $ browser searchEngine =<< getSelection + +-- | Like the google\/wikipedia functions, but one less argument - the query is hunk ./XMonad/Util/Search.hs 103 -googleSelection browser = io $ googleSearch browser =<< getSelection -wikipediaSelection browser = io $ wikipediaSearch browser =<< getSelection -waybackSelection browser = io $ waybackSearch browser =<< getSelection +googleSelection = select googleSearch +wikipediaSelection = select wikipediaSearch +waybackSelection = select waybackSearch hunk ./XMonad/Util/Search.hs 18 + amazon, amazonSelection, amazonSearch, hunk ./XMonad/Util/Search.hs 20 + imdb, imdbSelection, imdbSearch, hunk ./XMonad/Util/Search.hs 72 -googleSearch, waybackSearch, wikipediaSearch :: String -> String -> IO () +amazonSearch, googleSearch, imdbSearch, waybackSearch, wikipediaSearch :: String -> String -> IO () +amazonSearch = search "http://www.amazon.com/exec/obidos/external-search?index=all&keyword=" hunk ./XMonad/Util/Search.hs 75 +imdbSearch = search "http://www.imdb.com/Find?select=all&for=" hunk ./XMonad/Util/Search.hs 92 -google, wayback, wikipedia :: String -> XPConfig -> X () +amazon, google, imdb, wayback, wikipedia :: String -> XPConfig -> X () +amazon = promptSearch amazonSearch hunk ./XMonad/Util/Search.hs 95 +imdb = promptSearch imdbSearch hunk ./XMonad/Util/Search.hs 108 -googleSelection, waybackSelection, wikipediaSelection :: String -> X () +amazonSelection, googleSelection, imdbSelection, waybackSelection, wikipediaSelection :: String -> X () +amazonSelection = select amazonSearch hunk ./XMonad/Util/Search.hs 111 +imdbSelection = select imdbSearch hunk ./XMonad/Util/XSelection.hs 60 -getSelection :: IO String -getSelection = do +getSelection :: MonadIO m => m String +getSelection = io $ do hunk ./XMonad/Util/XSelection.hs 83 -putSelection :: String -> IO () -putSelection text = do +putSelection :: MonadIO m => String -> m () +putSelection text = io $ do hunk ./XMonad/Util/Search.hs 18 - amazon, amazonSelection, amazonSearch, - google, googleSelection, googleSearch, - imdb, imdbSelection, imdbSearch, - wayback, waybackSelection, waybackSearch, - wikipedia, wikipediaSelection, wikipediaSearch, + search, hunk ./XMonad/Util/Search.hs 20 - search + selectSearch, + + amazon, + google, + imdb, + wayback, + wikipedia hunk ./XMonad/Util/Search.hs 29 -import Control.Monad.Trans (MonadIO()) -- for select's type signature hunk ./XMonad/Util/Search.hs 31 -import XMonad (io, X()) +import XMonad (X(), MonadIO) hunk ./XMonad/Util/Search.hs 67 --- | Given the base search URL, a browser to use, and the actual query, escape --- the query, prepend the base URL, and hand it off to the browser. -search :: String -> FilePath -> String -> IO () -search site browser query = safeSpawn browser $ site ++ escape query +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 +simpleEngine :: String -> SearchEngine +simpleEngine site query = site ++ escape query hunk ./XMonad/Util/Search.hs 79 -amazonSearch, googleSearch, imdbSearch, waybackSearch, wikipediaSearch :: String -> String -> IO () -amazonSearch = search "http://www.amazon.com/exec/obidos/external-search?index=all&keyword=" -googleSearch = search "http://www.google.com/search?num=100&q=" -imdbSearch = search "http://www.imdb.com/Find?select=all&for=" -wikipediaSearch = search "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search=" -waybackSearch = search "http://web.archive.org/" +amazon, google, 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=" +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/" hunk ./XMonad/Util/Search.hs 91 -promptSearch :: (String -> String -> IO ()) -> String -> XPConfig -> X () -promptSearch searchEngine browser config = mkXPrompt Search config (getShellCompl []) $ io . (searchEngine browser) - --- | Search the particular site; these are suitable for binding to a key. Use them like this: --- --- > , ((modm, xK_g ), google "firefox" defaultXPConfig) --- --- First argument is the browser you want to use, the second the prompt configuration. -amazon, google, imdb, wayback, wikipedia :: String -> XPConfig -> X () -amazon = promptSearch amazonSearch -google = promptSearch googleSearch -imdb = promptSearch imdbSearch -wikipedia = promptSearch wikipediaSearch -wayback = promptSearch waybackSearch +promptSearch :: XPConfig -> Browser -> SearchEngine -> X () +promptSearch config browser site = mkXPrompt Search config (getShellCompl []) $ search browser site hunk ./XMonad/Util/Search.hs 98 -select :: (Control.Monad.Trans.MonadIO m) => (t -> String -> IO a) -> t -> m a -select browser searchEngine = io $ browser searchEngine =<< getSelection - --- | Like the google\/wikipedia functions, but one less argument - the query is --- extracted from the copy-paste buffer of X Windows. -amazonSelection, googleSelection, imdbSelection, waybackSelection, wikipediaSelection :: String -> X () -amazonSelection = select amazonSearch -googleSelection = select googleSearch -imdbSelection = select imdbSearch -wikipediaSelection = select wikipediaSearch -waybackSelection = select waybackSearch +selectSearch :: MonadIO m => Browser -> SearchEngine -> m () +selectSearch browser searchEngine = search browser searchEngine =<< getSelection hunk ./XMonad/Actions/ConstrainedResize.hs 19 - -- * Usage - -- $usage - XMonad.Actions.ConstrainedResize.mouseResizeWindow + -- * Usage + -- $usage + XMonad.Actions.ConstrainedResize.mouseResizeWindow hunk ./XMonad/Actions/FlexibleManipulate.hs 20 - -- * Usage - -- $usage - mouseWindow, discrete, linear, resize, position + -- * Usage + -- $usage + mouseWindow, discrete, linear, resize, position hunk ./XMonad/Actions/FlexibleResize.hs 16 - -- * Usage - -- $usage - XMonad.Actions.FlexibleResize.mouseResizeWindow + -- * Usage + -- $usage + XMonad.Actions.FlexibleResize.mouseResizeWindow hunk ./XMonad/Actions/FocusNth.hs 41 -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) hunk ./XMonad/Actions/FocusNth.hs 46 - where (t:rs) = drop n l - ls = reverse (take n l) + where + (t:rs) = drop n l + ls = reverse (take n l) hunk ./XMonad/Actions/MouseGestures.hs 18 - Direction(..), + Direction(..), hunk ./XMonad/Actions/RotSlaves.hs 15 - -- $usage - rotSlaves', rotSlavesUp, rotSlavesDown, - rotAll', rotAllUp, rotAllDown - ) where + -- $usage + rotSlaves', rotSlavesUp, rotSlavesDown, + rotAll', rotAllUp, rotAllDown + ) where hunk ./XMonad/Layout/DragPane.hs 110 - mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h + mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h hunk ./XMonad/Layout/Grid.hs 20 - Grid(..) + Grid(..) hunk ./XMonad/Layout/Tabbed.hs 207 - 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) hunk ./XMonad/Layout/Tabbed.hs 220 - cond <- p n - if cond - then sw ns - else return n + cond <- p n + if cond + then sw ns + else return n hunk ./XMonad/Util/XUtils.hs 25 - , stringToPixel + , stringToPixel hunk ./XMonad/Actions/CycleWS.hs 27 -import Data.List ( sortBy, findIndex ) +import Data.List ( findIndex ) hunk ./XMonad/Actions/CycleWS.hs 29 -import Data.Ord ( comparing ) hunk ./XMonad/Actions/CycleWS.hs 31 -import qualified XMonad (workspaces) hunk ./XMonad/Actions/CycleWS.hs 32 +import XMonad.Util.WorkspaceCompare hunk ./XMonad/Actions/CycleWS.hs 83 - spaces <- asks (XMonad.workspaces . config) - let orderedWs = sortBy (comparing (wsIndex spaces)) (workspaces ws) + sort' <- getSortByTag + let orderedWs = sort' (workspaces ws) hunk ./XMonad/Actions/CycleWS.hs 89 -wsIndex :: [WorkspaceId] -> WindowSpace -> Maybe Int -wsIndex spaces ws = findIndex (== tag ws) spaces - hunk ./XMonad/Hooks/DynamicLog.hs 49 -import Data.Monoid hunk ./XMonad/Hooks/DynamicLog.hs 50 +import XMonad.Util.WorkspaceCompare hunk ./XMonad/Hooks/DynamicLog.hs 111 - spaces <- asks (workspaces . config) + sort' <- getSortByTag hunk ./XMonad/Hooks/DynamicLog.hs 115 - let ws = pprWindowSet spaces urgents pp winset + let ws = pprWindowSet sort' urgents pp winset hunk ./XMonad/Hooks/DynamicLog.hs 131 -pprWindowSet :: [String] -> [Window] -> PP -> WindowSet -> String -pprWindowSet spaces urgents 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)) hunk ./XMonad/Hooks/EwmhDesktops.hs 20 -import Data.List (elemIndex, sortBy) -import Data.Ord (comparing) -import Data.Maybe (fromMaybe) +import Data.List +import Data.Maybe hunk ./XMonad/Hooks/EwmhDesktops.hs 28 +import XMonad.Util.WorkspaceCompare hunk ./XMonad/Hooks/EwmhDesktops.hs 51 - -- 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 hunk ./XMonad/Hooks/EwmhDesktops.hs 72 - forM (zip ws [(0::Int)..]) $ \(w, wn) -> - forM (W.integrate' (W.stack w)) $ \win -> do + forM_ (zip ws [(0::Int)..]) $ \(w, wn) -> + forM_ (W.integrate' (W.stack w)) $ \win -> do addfile ./XMonad/Util/WorkspaceCompare.hs hunk ./XMonad/Util/WorkspaceCompare.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.WorkspaceCompare +-- Copyright : (c) Spencer Janssen +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Spencer Janssen +-- 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 + +getWsIndex :: X (WorkspaceId -> Maybe Int) +getWsIndex = do + spaces <- asks (workspaces . config) + return $ flip elemIndex spaces + +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 + +getSortByTag :: X ([WindowSpace] -> [WindowSpace]) +getSortByTag = do + cmp <- getWsCompare + return $ sortBy (\a b -> cmp (S.tag a) (S.tag b)) hunk ./xmonad-contrib.cabal 138 + XMonad.Util.WorkspaceCompare hunk ./XMonad/Hooks/EwmhDesktops.hs 100 - concatMap (("Workspace "++) . (++['\0'])) names + concatMap ((++['\0'])) names hunk ./XMonad/Util/WorkspaceCompare.hs 19 +-- | Lookup the index of a workspace id in the user's config, return Nothing +-- if that workspace does not exist in the config. hunk ./XMonad/Util/WorkspaceCompare.hs 26 +-- | A comparison function for WorkspaceId hunk ./XMonad/Util/WorkspaceCompare.hs 37 +-- | Sort several workspaces according to the order in getWsCompare hunk ./XMonad/Hooks/EwmhDesktops.hs 76 + setActiveWindow + hunk ./XMonad/Hooks/EwmhDesktops.hs 131 - +setActiveWindow :: X () +setActiveWindow = withFocused $ \w -> withDisplay $ \dpy -> do + r <- asks theRoot + a <- getAtom "_NET_ACTIVE_WINDOW" + c <- getAtom "WINDOW" + io $ changeProperty32 dpy r a c propModeReplace [fromIntegral w] hunk ./XMonad/Hooks/EwmhDesktops.hs 102 - concatMap ((++['\0'])) names + concatMap (++['\0']) names hunk ./XMonad/Hooks/ManageDocks.hs 59 --- Checks if a window is a DOCK window +-- Checks if a window is a DOCK or DESKTOP window hunk ./XMonad/Hooks/ManageDocks.hs 63 - d <- getAtom "_NET_WM_WINDOW_TYPE_DOCK" + dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK" + desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP" hunk ./XMonad/Hooks/ManageDocks.hs 67 - Just [r] -> return (fromIntegral r == d) + Just [r] -> return $ elem (fromIntegral r) [dock, desk] hunk ./XMonad/Util/Search.hs 26 - wikipedia + wikipedia, + hoogle hunk ./XMonad/Util/Search.hs 80 -amazon, google, imdb, wayback, wikipedia :: SearchEngine +amazon, google, imdb, wayback, wikipedia, hoogle :: SearchEngine hunk ./XMonad/Util/Search.hs 89 +hoogle = simpleEngine "http://www.haskell.org/hoogle/?q=" hunk ./XMonad/Hooks/ManageDocks.hs 27 -import Data.Maybe (catMaybes) +-- import Data.Maybe (catMaybes, fromMaybe) hunk ./XMonad/Hooks/ManageDocks.hs 72 -getStrut :: Window -> X (Maybe (Int, Int, Int, Int)) +getStrut :: Window -> X [Strut] hunk ./XMonad/Hooks/ManageDocks.hs 74 - s <- getAtom "_NET_WM_STRUT" - sp <- getAtom "_NET_WM_STRUT_PARTIAL" - liftM2 (\a b -> mplus (parse a) (parse b)) - (getProp s w) - (getProp sp w) + 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 hunk ./XMonad/Hooks/ManageDocks.hs 81 - parse xs = case xs of - Just (l : r : t : b : _) -> Just (fi t, fi b, fi l, fi r) - _ -> Nothing + 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 _ = [] hunk ./XMonad/Hooks/ManageDocks.hs 97 -calcGap :: X Rectangle +calcGap :: X (Rectangle -> Rectangle) hunk ./XMonad/Hooks/ManageDocks.hs 102 - struts <- catMaybes `fmap` mapM getStrut wins + struts <- concat `fmap` mapM getStrut wins hunk ./XMonad/Hooks/ManageDocks.hs 108 - 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 hunk ./XMonad/Hooks/ManageDocks.hs 114 --- | Given strut values and the screen rectangle, compute a reduced screen --- rectangle. -reduceScreen :: (Int, Int, Int, Int) -> Rectangle -> Rectangle -reduceScreen (t, b, l, r) s - = case r2c s of - (x1, y1, x2, y2) -> c2r (x1 + fi l, y1 + fi t, x2 - fi r, y2 - fi b) +r2c :: Rectangle -> RectC +r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w, fi y + fi h) hunk ./XMonad/Hooks/ManageDocks.hs 117 -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) - --- | 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) hunk ./XMonad/Hooks/ManageDocks.hs 131 - do rect <- fmap (flip fitRect r) calcGap + do rect <- fmap ($ r) calcGap hunk ./XMonad/Hooks/ManageDocks.hs 142 +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 + addfile ./XMonad/Actions/NoBorders.hs hunk ./XMonad/Actions/NoBorders.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.NoBorders +-- Copyright : (c) Lukas Mai +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Lukas Mai +-- 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 hunk ./xmonad-contrib.cabal 65 + XMonad.Actions.NoBorders move ./XMonad/Util/Search.hs ./XMonad/Actions/Search.hs hunk ./XMonad/Actions/Search.hs 2 - Module : XMonad.Util.Search + Module : XMonad.Actions.Search hunk ./XMonad/Actions/Search.hs 16 -module XMonad.Util.Search ( -- * Usage +module XMonad.Actions.Search ( -- * Usage hunk ./xmonad-contrib.cabal 68 + XMonad.Actions.Search hunk ./xmonad-contrib.cabal 139 - XMonad.Util.Search hunk ./XMonad/Actions/Search.hs 19 + simpleEngine, hunk ./XMonad/Actions/Search.hs 39 +{- $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'. +-} + hunk ./XMonad/Actions/Search.hs 95 --- | Given a base URL, create the SearchEngine that escapes the query and --- appends it to the base +{- | 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. -} hunk ./XMonad/Actions/Search.hs 110 -amazon, google, imdb, wayback, wikipedia, hoogle :: SearchEngine +amazon, google, hoogle, imdb, wayback, wikipedia :: SearchEngine hunk ./XMonad/Actions/Search.hs 113 +hoogle = simpleEngine "http://www.haskell.org/hoogle/?q=" hunk ./XMonad/Actions/Search.hs 120 -hoogle = simpleEngine "http://www.haskell.org/hoogle/?q=" hunk ./XMonad/Actions/Search.hs 121 --- | Like 'search', but in this case, the string is not specified but grabbed --- from the user's response to a prompt. +{- | 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) + +-} hunk ./XMonad/Actions/Search.hs 130 --- | Like search, but for use with the X selection; it grabs the selection, --- passes it to a given searchEngine and opens it in a browser. The various --- *Selection functions specialize this to a particular search engine to make --- things easier. +{- | 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) + +-} hunk ./XMonad/Actions/Search.hs 138 - hunk ./XMonad/Prompt.hs 616 - let path = home ++ "/.xmonad_history" + let path = home ++ "/.xmonad/history" hunk ./XMonad/Prompt.hs 630 - let path = home ++ "/.xmonad_history" + let path = home ++ "/.xmonad/history" hunk ./XMonad/Layout/DragPane.hs 134 - w <- createNewWindow r mask handleColor + w <- createNewWindow r mask handleColor False hunk ./XMonad/Layout/Tabbed.hs 97 - } + } hunk ./XMonad/Layout/Tabbed.hs 139 -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 }) hunk ./XMonad/Layout/Tabbed.hs 185 - w <- createNewWindow (Rectangle x y wid height) mask (inactiveColor c) + w <- createNewWindow (Rectangle x y wid height) mask (inactiveColor c) True hunk ./XMonad/Util/XUtils.hs 6 --- +-- hunk ./XMonad/Util/XUtils.hs 15 -module XMonad.Util.XUtils ( +module XMonad.Util.XUtils ( hunk ./XMonad/Util/XUtils.hs 47 + hunk ./XMonad/Util/XUtils.hs 51 -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 hunk ./XMonad/Util/XUtils.hs 55 - 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 hunk ./XMonad/Util/XUtils.hs 81 -paintWindow :: Window -- ^ The window where to draw +paintWindow :: Window -- ^ The window where to draw hunk ./XMonad/Util/XUtils.hs 83 - -> Dimension -- ^ Window height + -> Dimension -- ^ Window height hunk ./XMonad/Util/XUtils.hs 92 -paintAndWrite :: Window -- ^ The window where to draw +paintAndWrite :: Window -- ^ The window where to draw hunk ./XMonad/Util/XUtils.hs 95 - -> Dimension -- ^ Window height + -> Dimension -- ^ Window height hunk ./XMonad/Util/XUtils.hs 134 +-- | 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 + hunk ./XMonad/Actions/Search.hs 46 - copy/paste buffer (perhaps you just highlighted the string of interest). + copy\/paste buffer (perhaps you just highlighted the string of interest). hunk ./XMonad/Layout/LayoutScreens.hs 33 --- 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: hunk ./XMonad/Layout/LayoutScreens.hs 37 +-- > import XMonad.Layout.TwoPane hunk ./XMonad/Layout/LayoutScreens.hs 41 --- > , ((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) hunk ./XMonad/Layout/LayoutScreens.hs 50 --- > , ((modMask .|. shiftMask, xK_space), +-- > , ((modMask x .|. shiftMask, xK_space), hunk ./XMonad/Layout/LayoutScreens.hs 52 --- > , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_space), rescreen) hunk ./XMonad/Layout/ResizableTile.hs 27 +import qualified Data.Map as M +import Data.List ((\\)) hunk ./XMonad/Layout/ResizableTile.hs 63 - 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 hunk ./XMonad/Prompt/Shell.hs 92 - fp d f = d ++ "/" ++ f hunk ./XMonad/Prompt/Shell.hs 95 - then getDirectoryContents d >>= filterM (isExecutable . fp d) + then getDirectoryContents d hunk ./XMonad/Prompt/Shell.hs 97 - 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 hunk ./XMonad/Prompt.hs 457 - (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) fs str + (_,asc,desc,_) <- io $ textExtentsXMF fs str hunk ./XMonad/Prompt.hs 524 - (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) fs $ head compl + (_,asc,desc,_) <- io $ textExtentsXMF fs $ head compl hunk ./XMonad/Util/Font.cpphs 105 -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 hunk ./XMonad/Util/Font.cpphs 108 -textExtentsXMF _ (Xft xftfont) _ = liftIO $ do +textExtentsXMF (Xft xftfont) _ = liftIO $ do hunk ./XMonad/Util/Font.cpphs 123 - (_,a,d,_) <- io $ textExtentsXMF dpy fs s + (_,a,d,_) <- io $ textExtentsXMF fs s hunk ./XMonad/Hooks/EwmhDesktops.hs 132 -setActiveWindow = withFocused $ \w -> withDisplay $ \dpy -> do +setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do + let w = fromMaybe 0 (W.peek s) hunk ./XMonad/Actions/CycleWS.hs 13 --- of workspaces, and to move windows there. +-- of workspaces, and to move windows there, and to cycle between the screens. hunk ./XMonad/Actions/CycleWS.hs 25 + nextScreen, + prevScreen hunk ./XMonad/Actions/CycleWS.hs 29 -import Data.List ( findIndex ) +import Data.List ( findIndex, sortBy ) hunk ./XMonad/Actions/CycleWS.hs 41 --- > , ((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) hunk ./XMonad/Actions/CycleWS.hs 51 --- > , ((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) hunk ./XMonad/Actions/CycleWS.hs 96 +-- | 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)) + hunk ./XMonad/Hooks/EwmhDesktops.hs 64 - 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 hunk ./XMonad/Hooks/EwmhDesktops.hs 71 - forM_ (zip ws [(0::Int)..]) $ \(w, wn) -> + -- To make gnome-panel accept our xinerama stuff, we display + -- all visible windows on the current desktop. + forM_ (W.current s : W.visible s) $ \s -> + forM_ (W.integrate' (W.stack (W.workspace s))) $ \win -> do + setWindowDesktop win curr + + forM_ (W.hidden s) $ \w -> + let wn = fromJust $ elemIndex (W.tag w) (map W.tag ws) in hunk ./XMonad/Hooks/EwmhDesktops.hs 132 - 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" + ] hunk ./XMonad/Actions/CycleWS.hs 29 -import Data.List ( findIndex, sortBy ) +import Data.List ( findIndex ) hunk ./XMonad/Hooks/EwmhDesktops.hs 73 - forM_ (W.current s : W.visible s) $ \s -> - forM_ (W.integrate' (W.stack (W.workspace s))) $ \win -> do + forM_ (W.current s : W.visible s) $ \x -> + forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do hunk ./XMonad/Hooks/ManageDocks.hs 45 +-- > where tall = Tall 1 (3/100) (1/2) hunk ./XMonad/Hooks/ManageDocks.hs 50 --- > ,((modMask, xK_b ), sendMessage ToggleStruts) +-- > ,((modMask x, xK_b ), sendMessage ToggleStruts) hunk ./XMonad/Hooks/ManageDocks.hs 52 +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". addfile ./XMonad/Layout/ShowWName.hs hunk ./XMonad/Layout/ShowWName.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} +----------------------------------------------------------------------------- +-- | +-- 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 using +-- dzen. +-- +----------------------------------------------------------------------------- + +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.Dzen + +-- $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" + +-- | XXX +showWName :: l a -> ModifiedLayout ShowWName l a +showWName = ModifiedLayout (SWN True defaultSWNConfig) + +-- | XXX +showWName' :: SWNConfig -> l a -> ModifiedLayout ShowWName l a +showWName' c = ModifiedLayout (SWN True c) + +data ShowWName a = SWN Bool SWNConfig deriving (Read, Show) + +data SWNConfig = + SWNC { swn_font :: String + , swn_bgcolor :: String + , swn_color :: String + , swn_fade :: Rational + } 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) r _ wrs = flashName c r >> return (wrs, Just $ SWN False c) + redoLayout (SWN False _) _ _ wrs = return (wrs, Nothing) + + handleMess (SWN _ c) m + | Just Hide <- fromMessage m = return . Just $ SWN True c + | otherwise = return Nothing + +flashName :: SWNConfig -> Rectangle -> X () +flashName c (Rectangle _ _ wh ht) = 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 + releaseXMF f + let hight = as + ds + 2 + y = (fromIntegral ht - hight) `div` 2 + x = (fromIntegral wh - width) `div` 2 + args = [ "-fn", swn_font c + , "-fg", swn_color c + , "-bg", swn_bgcolor c + , "-x" , show x + , "-y" , show y + , "-w" , show $ 3 * (width + 2) + ] + dzenWithArgs n args ((swn_fade c) `seconds`) hunk ./xmonad-contrib.cabal 112 + XMonad.Layout.ShowWName hunk ./XMonad/Layout/PerWorkspace.hs 15 +-- +-- 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). hunk ./XMonad/Util/Dzen.hs 15 -module XMonad.Util.Dzen (dzen, dzenWithArgs, dzenScreen, - seconds) where +module XMonad.Util.Dzen ( + dzen, + dzenWithArgs, + dzenScreen, + seconds + ) where hunk ./XMonad/Actions/CycleWS.hs 26 - prevScreen + prevScreen, + shiftNextScreen, + shiftPrevScreen hunk ./XMonad/Actions/CycleWS.hs 49 +-- > , ((modMask x .|. shiftMask, xK_Right), shiftNextScreen) +-- > , ((modMask x .|. shiftMask, xK_Left), shiftPrevScreen) hunk ./XMonad/Actions/CycleWS.hs 121 +-- | 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) + hunk ./XMonad/Actions/CopyWindow.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE PatternGuards #-} hunk ./XMonad/Actions/SinkAll.hs 3 --- Module : Xmonad.Actions.SinkAll +-- Module : XMonad.Actions.SinkAll hunk ./XMonad/Prompt.hs 99 + , defaultText :: String -- ^ The text by default in the prompt line hunk ./XMonad/Prompt.hs 139 + , defaultText = [] hunk ./XMonad/Prompt.hs 147 - XPS d rw w s Nothing Nothing compl gc fonts (XPT pt) "" 0 h c + XPS d rw w s Nothing Nothing compl gc fonts (XPT pt) (defaultText c) 0 h c hunk ./XMonad/Prompt.hs 147 - XPS d rw w s Nothing Nothing compl gc fonts (XPT pt) (defaultText c) 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 + } addfile ./XMonad/Util/Timer.hs hunk ./XMonad/Util/Timer.hs 1 +----------------------------------------------------------------------------- +-- | +-- 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 +import System.Environment +import System.Posix.Process + +-- $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 + dpy <- catch (getEnv "DISPLAY") (const $ return []) + d <- openDisplay dpy + rw <- rootWindow d $ defaultScreen d + u <- hashUnique <$> newUnique + forkProcess $ do + 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 dt /= [] && fromIntegral (head dt) == ti && mt == a + then action + else return Nothing +handleTimer _ _ _ = return Nothing hunk ./xmonad-contrib.cabal 140 + XMonad.Util.Timer hunk ./XMonad/Layout/ShowWName.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE PatternGuards, TypeSynonymInstances, MultiParamTypeClasses #-} hunk ./XMonad/Layout/ShowWName.hs 12 --- This is a layout modifier that will show the workspace name using --- dzen. --- +-- This is a layout modifier that will show the workspace name hunk ./XMonad/Layout/ShowWName.hs 28 -import XMonad.Util.Dzen +import XMonad.Util.Timer +import XMonad.Util.XUtils hunk ./XMonad/Layout/ShowWName.hs 43 --- | XXX +-- | A layout modifier to show the workspace name when switching hunk ./XMonad/Layout/ShowWName.hs 45 -showWName = ModifiedLayout (SWN True defaultSWNConfig) +showWName = ModifiedLayout (SWN True defaultSWNConfig Nothing) hunk ./XMonad/Layout/ShowWName.hs 47 --- | XXX +-- | A layout modifier to show the workspace name when switching. It +-- is possible to provide a costum configuration. hunk ./XMonad/Layout/ShowWName.hs 50 -showWName' c = ModifiedLayout (SWN True c) +showWName' c = ModifiedLayout (SWN True c Nothing) hunk ./XMonad/Layout/ShowWName.hs 52 -data ShowWName a = SWN Bool SWNConfig deriving (Read, Show) +type ShowWNState = Maybe (TimerId, Window) +data ShowWName a = SWN Bool SWNConfig ShowWNState deriving (Read, Show) hunk ./XMonad/Layout/ShowWName.hs 55 -data SWNConfig = - SWNC { swn_font :: String - , swn_bgcolor :: String - , swn_color :: String - , swn_fade :: Rational +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 hunk ./XMonad/Layout/ShowWName.hs 71 - redoLayout (SWN True c) r _ wrs = flashName c r >> return (wrs, Just $ SWN False c) - redoLayout (SWN False _) _ _ wrs = return (wrs, Nothing) + 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 hunk ./XMonad/Layout/ShowWName.hs 80 - handleMess (SWN _ c) m - | Just Hide <- fromMessage m = return . Just $ SWN True c - | otherwise = return Nothing + handleMess (SWN _ c s) m + | Just Hide <- fromMessage m = return . Just $ SWN True c s + | otherwise = return Nothing hunk ./XMonad/Layout/ShowWName.hs 84 -flashName :: SWNConfig -> Rectangle -> X () -flashName c (Rectangle _ _ wh ht) = do +flashName :: SWNConfig -> Rectangle -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a)) +flashName c (Rectangle _ _ wh ht) wrs = do hunk ./XMonad/Layout/ShowWName.hs 91 + 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_bgcolor c) (swn_color c) AlignCenter n hunk ./XMonad/Layout/ShowWName.hs 98 - let hight = as + ds + 2 - y = (fromIntegral ht - hight) `div` 2 - x = (fromIntegral wh - width) `div` 2 - args = [ "-fn", swn_font c - , "-fg", swn_color c - , "-bg", swn_bgcolor c - , "-x" , show x - , "-y" , show y - , "-w" , show $ 3 * (width + 2) - ] - dzenWithArgs n args ((swn_fade c) `seconds`) + 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 hunk ./XMonad/Actions/Search.hs 15 ---------------------------------------------------------------------------- -} +-} hunk ./XMonad/Actions/Search.hs 52 + hunk ./XMonad/Doc/Extending.hs 155 +* "XMonad.Actions.Search": provide helpful functions for easily + running web searchs. + hunk ./XMonad/Doc/Extending.hs 232 +* "XMonad.Hooks.ManageHelpers": provide helper functions to be used + in @manageHook@. + hunk ./XMonad/Doc/Extending.hs 316 +* "XMonad.Layout.ShowWName": Show the name of the current workspace when switching. + hunk ./XMonad/Prompt.hs 300 + | ks == xK_Right -> moveWord Next >> go + | ks == xK_Left -> moveWord Prev >> go hunk ./XMonad/Prompt.hs 401 +-- | move the cursor one word +moveWord :: Direction -> XP () +moveWord d = do + c <- gets command + o <- gets offset + let (f,ss) = splitAt o c + lp = length . reverse . fst . break isSpace + ln = length . fst . break isSpace + prev s = case reverse s of + ' ':x -> 1 + (lp x) + x -> lp x + next s = case s of + ' ':x -> 1 + (ln x) + x -> ln x + newoff = case d of + Prev -> o - prev f + _ -> o + next ss + modify $ \s -> s { offset = newoff } + hunk ./XMonad/Prompt.hs 407 - lp = length . reverse . fst . break isSpace - ln = length . fst . break isSpace - prev s = case reverse s of - ' ':x -> 1 + (lp x) - x -> lp x - next s = case s of - ' ':x -> 1 + (ln x) - x -> ln x + lenToS = length . fst . break isSpace + ln p s = case p s of + ' ':x -> 1 + lenToS x + x -> lenToS x hunk ./XMonad/Prompt.hs 412 - Prev -> o - prev f - _ -> o + next ss + Prev -> o - (ln reverse f ) + _ -> o + (ln id ss) hunk ./XMonad/Layout/ShowWName.hs 56 - SWNC { swn_font :: String -- ^ Font name + SWNC { swn_font :: String -- ^ Font name hunk ./XMonad/Layout/ShowWName.hs 96 - paintAndWrite w f (fi width) (fi hight) 0 "" "" (swn_bgcolor c) (swn_color c) AlignCenter n + paintAndWrite w f (fi width) (fi hight) 0 "" "" (swn_color c) (swn_bgcolor c) AlignCenter n addfile ./XMonad/Layout/Reflect.hs hunk ./XMonad/Layout/Reflect.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Reflect +-- Copyright : (c) Brent Yorgey +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Reflect a layout horizontally or vertically. +----------------------------------------------------------------------------- + +module XMonad.Layout.Reflect ( + -- * Usage + -- $usage + + reflectHoriz, reflectVert + + ) where + +import XMonad.Core +import Graphics.X11 (Rectangle(..)) +import Control.Arrow ((***), second) +import Control.Applicative ((<$>)) + +-- $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, +-- and will simply flip the physical layout of the windows vertically or +-- horizontally. + +-- | 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" } + hunk ./xmonad-contrib.cabal 108 + XMonad.Layout.Reflect hunk ./XMonad/Layout/MultiToggle.hs 84 --- > +-- > hunk ./XMonad/Layout/MultiToggle.hs 192 - description _ = "MultiToggle" + description (MultiToggle { currLayout = (EL l) }) = description l hunk ./XMonad/Layout/Reflect.hs 1 -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances #-} hunk ./XMonad/Layout/Reflect.hs 20 - reflectHoriz, reflectVert + reflectHoriz, reflectVert, + REFLECTX(..), REFLECTY(..) hunk ./XMonad/Layout/Reflect.hs 26 -import Graphics.X11 (Rectangle(..)) +import Graphics.X11 (Rectangle(..), Window) hunk ./XMonad/Layout/Reflect.hs 30 +import XMonad.Layout.MultiToggle + hunk ./XMonad/Layout/Reflect.hs 41 --- 'reflectHoriz' and 'reflectVert' can be applied to any sort of layout, --- and will simply flip the physical layout of the windows vertically or --- horizontally. +-- '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) +-- hunk ./XMonad/Layout/Reflect.hs 106 +-------- 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) hunk ./XMonad/Layout/Reflect.hs 1 -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances #-} +{-# 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 -} hunk ./XMonad/Layout/Reflect.hs 50 --- toggling layouts between reflected/non-reflected with a keybinding. +-- toggling layouts between reflected\/non-reflected with a keybinding. hunk ./XMonad/Util/Run.hs 32 -import System.Posix.Process (createSession, forkProcess, executeFile, - getProcessStatus) +import System.Posix.Process (executeFile) hunk ./XMonad/Util/Run.hs 35 -import System.Exit (ExitCode(ExitSuccess), exitWith) hunk ./XMonad/Util/Run.hs 68 - 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 () hunk ./XMonad/Util/Run.hs 108 -safeSpawn prog arg = liftIO (try (forkProcess $ executeFile prog True [arg] Nothing) >> return ()) +safeSpawn prog arg = liftIO (try (doubleFork $ executeFile prog True [arg] Nothing) >> return ()) hunk ./XMonad/Util/Run.hs 129 - 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 hunk ./XMonad/Util/Timer.hs 27 -import System.Posix.Process hunk ./XMonad/Util/Timer.hs 42 - forkProcess $ do + doubleFork $ do hunk ./XMonad/Util/Timer.hs 26 -import System.Environment hunk ./XMonad/Util/Timer.hs 37 - dpy <- catch (getEnv "DISPLAY") (const $ return []) - d <- openDisplay dpy - rw <- rootWindow d $ defaultScreen d hunk ./XMonad/Util/Timer.hs 39 - threadDelay (fromEnum $ s * 1000000) - a <- internAtom d "XMONAD_TIMER" False - allocaXEvent $ \e -> do + d <- openDisplay "" + rw <- rootWindow d $ defaultScreen d + threadDelay (fromEnum $ s * 1000000) + a <- internAtom d "XMONAD_TIMER" False + allocaXEvent $ \e -> do hunk ./XMonad/Util/Timer.hs 47 - sync d False + sync d False hunk ./XMonad/Util/Timer.hs 56 - if dt /= [] && fromIntegral (head dt) == ti && mt == a + if mt == a && dt /= [] && fromIntegral (head dt) == ti hunk ./xmonad-contrib.cabal 36 +flag testing + description: Testing mode + default: False + hunk ./xmonad-contrib.cabal 51 - ghc-options: -Wall -Werror + ghc-options: -Wall + + if flag(testing) + ghc-options: -Werror + hunk ./XMonad/Hooks/ManageHelpers.hs 28 - (-?>), + (-?>), (/=?), (<==?), (>), (-?>>), hunk ./XMonad/Hooks/ManageHelpers.hs 30 + transientTo, + maybeToDefinite, + MaybeManageHook, hunk ./XMonad/Hooks/ManageHelpers.hs 43 +-- | 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 + hunk ./XMonad/Hooks/ManageHelpers.hs 53 -composeOne :: [Query (Maybe (Endo WindowSet))] -> ManageHook +composeOne :: [MaybeManageHook] -> ManageHook hunk ./XMonad/Hooks/ManageHelpers.hs 62 -infixr 0 -?> +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 +( Query a -> a -> Query (Match a) +q ) :: Query Bool -> Query (Endo WindowSet) -> Query (Maybe (Endo WindowSet)) +(-?>) :: Query Bool -> ManageHook -> MaybeManageHook hunk ./XMonad/Hooks/ManageHelpers.hs 86 +-- | 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 + hunk ./XMonad/Hooks/ManageHelpers.hs 106 --- | A special rule that moves transient windows to the workspace of their --- associated primary windows. -transience :: Query (Maybe (Endo WindowSet)) -transience = do - w <- ask - d <- (liftX . asks) display - x <- liftIO $ getTransientForHint d w - case x of - Nothing -> return Nothing - Just w' -> do - return . Just . Endo $ \s -> - maybe s (`W.shift` s) (W.findTag w' s) +-- | 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 hunk ./XMonad/Hooks/ManageHelpers.hs 114 --- | Like 'transience' but with a type that can be used in 'composeAll'. +-- | 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 > move + where move :: Maybe Window -> ManageHook + move mw = do + case mw of + Just w -> do return . Endo $ \s -> + maybe s (`W.shift` s) (W.findTag w s) + Nothing -> do return . Endo $ \s -> s + +-- | 'transience' set to a 'ManageHook' hunk ./XMonad/Hooks/ManageHelpers.hs 128 -transience' = fmap (fromMaybe mempty) transience +transience' = maybeToDefinite transience + +-- | converts 'MaybeManageHook's to 'ManageHook's +maybeToDefinite :: MaybeManageHook -> ManageHook +maybeToDefinite = fmap (fromMaybe mempty) hunk ./XMonad/Hooks/ManageHelpers.hs 120 - move mw = do - case mw of - Just w -> do return . Endo $ \s -> - maybe s (`W.shift` s) (W.findTag w s) - Nothing -> do return . Endo $ \s -> s + move mw = maybe idHook (doF . move') mw + where move' :: Window -> (WindowSet -> WindowSet) + move' w = \s -> maybe s (`W.shift` s) (W.findTag w s) hunk ./XMonad/Layout/MultiToggle.hs 192 - description (MultiToggle { currLayout = (EL l) }) = description l + description mt = currLayout mt `unEL` \l -> description l hunk ./XMonad/Layout/MultiToggle.hs 42 --- receive any messages; any message not handled by SwitchTrans itself will +-- receive any messages; any message not handled by MultiToggle itself will hunk ./XMonad/Layout/MultiToggle.hs 26 + single, hunk ./XMonad/Layout/MultiToggle.hs 67 --- > layout = mkToggle (MIRROR ?? EOT) (tiled ||| Full) +-- > layout = mkToggle (single MIRROR) (tiled ||| Full) hunk ./XMonad/Layout/MultiToggle.hs 94 --- . mkToggle (MIRROR ?? EOT) +-- . mkToggle (single MIRROR) hunk ./XMonad/Layout/MultiToggle.hs 168 +-- | Construct a singleton transformer table. +single :: a -> HCons a EOT +single = (?? EOT) + changepref test runhaskell Setup.lhs configure --disable-optimization --user && runhaskell Setup.lhs build && runhaskell Setup.lhs haddock runhaskell Setup.lhs configure --disable-optimization --user -f testing && runhaskell Setup.lhs build && runhaskell Setup.lhs haddock hunk ./XMonad/Config/Sjanssen.hs 23 - { terminal = "urxvt" + { terminal = "urxvtc" hunk ./xmonad-contrib.cabal 2 -version: 0.5 +version: 0.6 hunk ./xmonad-contrib.cabal 50 - build-depends: mtl, unix, X11>=1.4.1, xmonad==0.5 + build-depends: mtl, unix, X11>=1.4.1, xmonad==0.6 hunk ./XMonad/Hooks/ManageHelpers.hs 115 --- is transient, and then move it to it's parent. +-- is transient, and then move it to its parent. hunk ./XMonad/Layout/MultiToggle.hs 202 + + emptyLayout mt r = currLayout mt `unEL` \l -> acceptChange mt (fmap . fmap) (emptyLayout l r) hunk ./XMonad/Layout/ShowWName.hs 1 -{-# LANGUAGE PatternGuards, TypeSynonymInstances, MultiParamTypeClasses #-} +{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-} hunk ./XMonad/Layout/ShowWName.hs 70 -instance LayoutModifier ShowWName Window where +instance LayoutModifier ShowWName a where hunk ./XMonad/Layout/LayoutModifier.hs 39 - | otherwise = return Nothing + | otherwise = return $ pureMess m mess hunk ./XMonad/Layout/LayoutModifier.hs 44 + pureMess :: m a -> SomeMessage -> Maybe (m a) + pureMess _ _ = Nothing hunk ./XMonad/Layout/LayoutModifier.hs 48 - redoLayout m _ _ wrs = do hook m; return (wrs, Nothing) + redoLayout m r s wrs = do hook m; return $ pureModifier m r s wrs + pureModifier :: m a -> Rectangle -> Stack a -> [(a, Rectangle)] + -> ([(a, Rectangle)], Maybe (m a)) + pureModifier _ _ _ wrs = (wrs, Nothing) hunk ./XMonad/Layout/LayoutModifier.hs 52 + emptyLayoutMod :: m a -> Rectangle -> [(a, Rectangle)] + -> X ([(a, Rectangle)], Maybe (m a)) + emptyLayoutMod _ _ _ = return ([], Nothing) hunk ./XMonad/Layout/LayoutModifier.hs 67 + Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml' + Nothing -> ModifiedLayout m `fmap` ml' + return (ws', ml'') + emptyLayout (ModifiedLayout m l) r = + do (ws, ml') <- emptyLayout l r + (ws',mm') <- emptyLayoutMod m r ws + let ml'' = case mm' of hunk ./XMonad/Util/XUtils.hs 15 -module XMonad.Util.XUtils ( - -- * Usage: - -- $usage - averagePixels - , createNewWindow - , showWindow - , hideWindow - , deleteWindow - , paintWindow - , paintAndWrite - , stringToPixel - ) where - +module XMonad.Util.XUtils + ( -- * Usage: + -- $usage + averagePixels + , createNewWindow + , showWindow + , showWindows + , hideWindow + , hideWindows + , deleteWindow + , deleteWindows + , paintWindow + , paintAndWrite + , stringToPixel + , fi + ) where hunk ./XMonad/Util/XUtils.hs 71 +-- | the list version +showWindows :: [Window] -> X () +showWindows = mapM_ showWindow + hunk ./XMonad/Util/XUtils.hs 81 +-- | the list version +hideWindows :: [Window] -> X () +hideWindows = mapM_ hideWindow + hunk ./XMonad/Util/XUtils.hs 91 +-- | the list version +deleteWindows :: [Window] -> X () +deleteWindows = mapM_ deleteWindow + hunk ./XMonad/Layout/ShowWName.hs 102 --- | Short-hand for 'fromIntegral' -fi :: (Integral a, Num b) => a -> b -fi = fromIntegral - addfile ./XMonad/Layout/WindowArranger.hs hunk ./XMonad/Layout/WindowArranger.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable +{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.WindowArranger +-- Copyright : (c) Andrea Rossato 2007 +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- This is a pure layout modifier that will let you move and resize +-- windows with the keyboard in any layout. +----------------------------------------------------------------------------- + +module XMonad.Layout.WindowArranger + ( -- * Usage + -- $usage + windowArranger + , WindowArrangerMsg (..) + , memberFromList + , listFromList + , diff + ) where + +import XMonad +import qualified XMonad.StackSet as S +import XMonad.Layout.LayoutModifier +import XMonad.Util.XUtils (fi) + +import Control.Arrow +import Data.List +import Data.Maybe + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.WindowArranger +-- > myLayout = layoutHook defaultConfig +-- > main = xmonad defaultConfig { layoutHook = windowArranger myLayout } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- You may also want to define some key binding to move or resize +-- windows. These are good defaults: +-- +-- > , ((modMask x .|. controlMask , xK_s ), sendMessage Arrange ) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_s ), sendMessage DeArrange ) +-- > , ((modMask x .|. controlMask , xK_Left ), sendMessage (MoveLeft 1)) +-- > , ((modMask x .|. controlMask , xK_Right), sendMessage (MoveRight 1)) +-- > , ((modMask x .|. controlMask , xK_Down ), sendMessage (MoveDown 1)) +-- > , ((modMask x .|. controlMask , xK_Up ), sendMessage (MoveUp 1)) +-- > , ((modMask x .|. shiftMask, xK_Left ), sendMessage (IncreaseLeft 1)) +-- > , ((modMask x .|. shiftMask, xK_Right), sendMessage (IncreaseRight 1)) +-- > , ((modMask x .|. shiftMask, xK_Down ), sendMessage (IncreaseDown 1)) +-- > , ((modMask x .|. shiftMask, xK_Up ), sendMessage (IncreaseUp 1)) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage (DecreaseLeft 1)) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage (DecreaseRight 1)) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage (DecreaseDown 1)) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Up ), sendMessage (DecreaseUp 1)) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | A layout modifier to float the windows in a workspace +windowArranger :: l a -> ModifiedLayout WindowArranger l a +windowArranger = ModifiedLayout (WA True []) + +data WindowArrangerMsg = DeArrange + | Arrange + | IncreaseLeft Int + | IncreaseRight Int + | IncreaseUp Int + | IncreaseDown Int + | DecreaseLeft Int + | DecreaseRight Int + | DecreaseUp Int + | DecreaseDown Int + | MoveLeft Int + | MoveRight Int + | MoveUp Int + | MoveDown Int + deriving ( Typeable ) +instance Message WindowArrangerMsg + +data ArrangedWindow a = WR (a, Rectangle) + | AWR (a, Rectangle) + deriving (Read, Show) + +data WindowArranger a = WA Bool [ArrangedWindow a] deriving (Read, Show) + +instance (Show a, Read a, Eq a) => LayoutModifier WindowArranger a where + pureModifier (WA True [] ) _ _ wrs = arrangeWindows wrs + + pureModifier (WA True awrs) _ (S.Stack w _ _) wrs = curry process wrs awrs + where + wins = map fst *** map awrWin + update (a,r) = mkNewAWRs a *** removeAWRs r >>> uncurry (++) + process = wins &&& id >>> first diff >>> uncurry update >>> + replaceWR wrs >>> putOnTop w >>> map fromAWR &&& Just . WA True + + pureModifier _ _ _ wrs = (wrs, Nothing) + + pureMess (WA True (wr:wrs)) m + -- increase the window's size + | Just (IncreaseRight i) <- fm, (win, Rectangle x y w h) <- fa = res win x y (w + fi i) h + | Just (IncreaseLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win (x - fi i) y (w + fi i) h + | Just (IncreaseUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y - fi i) w (h + fi i) + | Just (IncreaseDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x y w (h + fi i) + -- decrease the window's size + | Just (DecreaseRight i) <- fm, (win, Rectangle x y w h) <- fa = res win (x + fi i) y (chk w i) h + | Just (DecreaseLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win x y (chk w i) h + | Just (DecreaseUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x y w (chk h i) + | Just (DecreaseDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y + fi i) w (chk h i) + --move the window around + | Just (MoveRight i) <- fm, (win, Rectangle x y w h) <- fa = res win (x + fi i) y w h + | Just (MoveLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win (x - fi i) y w h + | Just (MoveUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y - fi i) w h + | Just (MoveDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y + fi i) w h + + where res wi x y w h = Just . WA True $ AWR (wi,Rectangle x y w h):wrs + fm = fromMessage m + fa = fromAWR wr + chk x y = fi $ max 1 (fi x - y) + + pureMess (WA _ l) m + | Just DeArrange <- fromMessage m = Just $ WA False l + | Just Arrange <- fromMessage m = Just $ WA True l + | otherwise = Nothing + +arrangeWindows :: [(a,Rectangle)] -> ([(a, Rectangle)], Maybe (WindowArranger a)) +arrangeWindows wrs = (wrs, Just $ WA True (map WR wrs)) + +fromAWR :: ArrangedWindow a -> (a, Rectangle) +fromAWR (WR x) = x +fromAWR (AWR x) = x + +awrWin :: ArrangedWindow a -> a +awrWin = fst . fromAWR + +getAWR :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a] +getAWR = memberFromList awrWin (==) + +getWR :: Eq a => a -> [(a,Rectangle)] -> [(a,Rectangle)] +getWR = memberFromList fst (==) + +mkNewAWRs :: Eq a => [a] -> [(a,Rectangle)] -> [ArrangedWindow a] +mkNewAWRs w wrs = map WR . concatMap (flip getWR wrs) $ w + +removeAWRs :: Eq a => [a] -> [ArrangedWindow a] -> [ArrangedWindow a] +removeAWRs = listFromList awrWin notElem + +putOnTop :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a] +putOnTop w awrs = awr ++ nawrs + where awr = getAWR w awrs + nawrs = filter ((/=w) . awrWin) awrs + +replaceWR :: Eq a => [(a, Rectangle)] -> [ArrangedWindow a] -> [ArrangedWindow a] +replaceWR wrs = foldr r [] + where r x xs + | WR wr <- x = case fst wr `elemIndex` map fst wrs of + Just i -> (WR $ wrs !! i):xs + Nothing -> x:xs + | otherwise = x:xs + +-- | Given a function to be applied to each member of a list, and a +-- function to check a condition by processing this transformed member +-- with the members of a list, you get the list of members that +-- satisfy the condition. +listFromList :: (b -> c) -> (c -> [a] -> Bool) -> [a] -> [b] -> [b] +listFromList f g l = foldr (h l) [] + where h x y ys = if g (f y) x then y:ys else ys + +-- | Given a function to be applied to each member of ta list, and a +-- function to check a condition by processing this transformed member +-- with something, you get the first member that satisfy the condition, +-- or an empty list. +memberFromList :: (b -> c) -> (c -> a -> Bool) -> a -> [b] -> [b] +memberFromList f g l = foldr (h l) [] + where h x y ys = if g (f y) x then [y] else ys + +-- | Get the list of elements to be deleted and the list ef elements to +-- be added to the first list in order to get the second list. +diff :: Eq a => ([a],[a]) -> ([a],[a]) +diff (x,y) = (x \\ y, y \\ x) hunk ./xmonad-contrib.cabal 126 + XMonad.Layout.WindowArranger addfile ./XMonad/Layout/Decoration.hs hunk ./XMonad/Layout/Decoration.hs 1 +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Decoration +-- Copyright : (c) 2007 Andrea Rossato +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A layout modifier and a class for easily creating decorated +-- layouts. +----------------------------------------------------------------------------- + +module XMonad.Layout.Decoration + ( -- * Usage: + -- $usage + decoration + , Decoration + , DecorationStyle (..) + , shrinkText, CustomShrink(CustomShrink) + , mkDefaultDeConfig + , DeConfig (..), defaultDeConfig + , Shrinker(..) + , module XMonad.Layout.LayoutModifier + , fi + ) where + +import Data.Maybe +import Data.List + +import XMonad +import qualified XMonad.StackSet as W + +import XMonad.Layout.LayoutModifier +import XMonad.Layout.WindowArranger + +import XMonad.Util.NamedWindows +import XMonad.Util.Invisible +import XMonad.Util.XUtils +import XMonad.Util.Font + +import XMonad.Hooks.UrgencyHook + +-- $usage +-- For usage examples you can see "XMonad.Layout.SimpleDecoration", +-- "XMonad.Layout.Tabbed", "XMonad.Layout.DwmStyle", + +decoration :: (DecorationStyle ds a, Shrinker s) => s -> DeConfig ds a + -> l a -> ModifiedLayout (Decoration ds s) l a +decoration s c = ModifiedLayout (Decoration (I Nothing) s c) + +data DeConfig ds a = + DeConfig { activeColor :: String + , inactiveColor :: String + , urgentColor :: String + , activeBorderColor :: String + , inactiveBorderColor :: String + , urgentBorderColor :: String + , activeTextColor :: String + , inactiveTextColor :: String + , urgentTextColor :: String + , fontName :: String + , decoWidth :: Dimension + , decoHeight :: Dimension + , style :: ds a + } deriving (Show, Read) + +mkDefaultDeConfig :: DecorationStyle ds a => ds a -> DeConfig ds a +mkDefaultDeConfig ds = + DeConfig { activeColor = "#999999" + , inactiveColor = "#666666" + , urgentColor = "#FFFF00" + , activeBorderColor = "#FFFFFF" + , inactiveBorderColor = "#BBBBBB" + , urgentBorderColor = "##00FF00" + , activeTextColor = "#FFFFFF" + , inactiveTextColor = "#BFBFBF" + , urgentTextColor = "#FF0000" + , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , decoWidth = 200 + , decoHeight = 20 + , style = ds + } + +type DecoWin = (Window,Maybe Rectangle) +type OrigWin = (Window,Rectangle) +data DecorationState = + DS { decos :: [(OrigWin,DecoWin)] + , font :: XMonadFont + } + +data Decoration ds s a = + Decoration (Invisible Maybe DecorationState) s (DeConfig ds a) + deriving (Show, Read) + +class (Read (ds a), Show (ds a)) => DecorationStyle ds a where + describeDeco :: ds a -> String + describeDeco ds = show ds + + decorateFirst :: ds a -> Bool + decorateFirst _ = True + + shrink :: ds a -> Rectangle -> Rectangle -> Rectangle + shrink _ (Rectangle _ _ _ dh) (Rectangle x y w h) = Rectangle x (y + fi dh) w (h - dh) + + pureDecoration :: ds a -> Dimension -> Dimension -> Rectangle + -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> Maybe Rectangle + pureDecoration _ _ h _ _ _ (_,Rectangle x y w _) = Just $ Rectangle x y w h + + decorate :: ds a -> Dimension -> Dimension -> Rectangle + -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> X (Maybe Rectangle) + decorate ds w h r s ars ar = return $ pureDecoration ds w h r s ars ar + +data DefaultStyle a = DefaultStyle deriving (Read, Show) +instance DecorationStyle DefaultStyle a + +defaultDeConfig :: DeConfig DefaultStyle a +defaultDeConfig = mkDefaultDeConfig DefaultStyle + +instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration ds s) Window where + redoLayout (Decoration st sh c) sc stack wrs + | decorate_first = do whenIJust st $ \s -> deleteWindows (getDWs $ decos s) + return (wrs, Just $ Decoration (I Nothing) sh c) + | I Nothing <- st = initState c wrs >>= processState + | I (Just s) <- st = do let dwrs = decos s + (d,a) = curry diff (get_ws dwrs) ws + toDel = todel d dwrs + toAdd = toadd a wrs + deleteWindows (getDWs toDel) + ndwrs <- createDecos c toAdd + processState (s {decos = ndwrs ++ del_dwrs d dwrs }) + | otherwise = return (wrs, Nothing) + + where + ws = map fst wrs + del_dwrs = listFromList get_w notElem + get_ws = map get_w + get_w = fst . fst + find_dw i = fst . snd . flip (!!) i + todel d = filter (flip elem d . get_w) + toadd a = filter (flip elem a . fst ) + + insert_dwr ((w,r),(dw,Just dr)) xs = (dw,dr):(w, shrink (style c) dr r):xs + insert_dwr (x ,(_ ,Nothing)) xs = x:xs + + resync _ [] = return [] + resync d ((w,r):xs) = case w `elemIndex` get_ws d of + Just i -> do dr <- decorate (style c) (decoWidth c) (decoHeight c) sc stack wrs (w,r) + dwrs <- resync d xs + return $ ((w,r),(find_dw i d, dr)) : dwrs + Nothing -> resync d xs + + decorate_first = length wrs == 1 && (not . decorateFirst . style $ c) + processState s = do ndwrs <- resync (decos s) wrs + showWindows (getDWs ndwrs) + updateDecos sh c (font s) ndwrs + return (foldr insert_dwr [] ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh c)) + + + handleMess (Decoration (I (Just s@(DS {decos = dwrs}))) sh c) m + | Just e <- fromMessage m :: Maybe Event = handleEvent sh c s e >> return Nothing + | Just Hide <- fromMessage m = hideWindows dws >> return Nothing + | Just ReleaseResources <- fromMessage m = do deleteWindows dws + releaseXMF (font s) + return $ Just $ Decoration (I Nothing) sh c + where dws = getDWs dwrs + + handleMess _ _ = return Nothing + + emptyLayoutMod (Decoration (I (Just (DS dwrs _))) _ _) _ _ = deleteWindows (getDWs dwrs) >> return ([], Nothing) + emptyLayoutMod _ _ _ = return ([], Nothing) + + modifierDescription (Decoration _ _ c) = describeDeco $ style c + +handleEvent :: (DecorationStyle ds a, Shrinker s) => s -> DeConfig ds a -> DecorationState-> Event -> X () +handleEvent sh c (DS dwrs fs) e + | PropertyEvent {ev_window = w} <- e, w `elem` (map (fst . fst) dwrs) = updateDecos sh c fs dwrs + | ExposeEvent {ev_window = w} <- e, w `elem` (map (fst . snd) dwrs) = updateDecos sh c fs dwrs +handleEvent _ _ _ _ = return () + + +getDWs :: [(OrigWin,DecoWin)] -> [Window] +getDWs = map (fst . snd) + +initState :: DecorationStyle ds a => DeConfig ds a -> [(Window,Rectangle)] -> X DecorationState +initState conf wrs = do + fs <- initXMF (fontName conf) + dwrs <- createDecos conf wrs + return $ DS dwrs fs + +createDecos :: DecorationStyle ds a => DeConfig ds a -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)] +createDecos _ [] = return [] +createDecos c (wr:wrs) = do + let rect = Rectangle 0 0 1 1 + mask = Just (exposureMask .|. buttonPressMask) + dw <- createNewWindow rect mask (inactiveColor c) True + dwrs <- createDecos c wrs + return ((wr,(dw,Nothing)):dwrs) + +updateDecos :: (DecorationStyle ds a, Shrinker s) => s -> DeConfig ds a -> XMonadFont -> [(OrigWin, DecoWin)] -> X () +updateDecos s c f = mapM_ $ updateDeco s c f + +updateDeco :: (DecorationStyle ds a, Shrinker s) => s -> DeConfig ds a -> XMonadFont -> (OrigWin, DecoWin) -> X () +updateDeco sh c fs ((w,_),(dw,Just (Rectangle _ _ wh ht))) = do + nw <- getName w + ur <- readUrgents + dpy <- asks display + let 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 w + (inactiveColor c, inactiveBorderColor c, inactiveTextColor c) + (activeColor c, activeBorderColor c, activeTextColor c) + (urgentColor c, urgentBorderColor c, urgentTextColor c) + let s = shrinkIt sh + name <- shrinkWhile s (\n -> do + size <- io $ textWidthXMF dpy fs n + return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw) + paintAndWrite dw fs wh ht 1 bc' borderc' tc' bc' AlignCenter name +updateDeco _ _ _ (_,(w,Nothing)) = hideWindow w + +shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String +shrinkWhile sh p x = sw $ sh x + where sw [n] = return n + sw [] = return "" + sw (n:ns) = do + cond <- p n + if cond + then sw ns + else return n + +data CustomShrink = CustomShrink +instance Show CustomShrink where show _ = "" +instance Read CustomShrink where readsPrec _ s = [(CustomShrink,s)] + +class (Read s, Show s) => Shrinker s where + shrinkIt :: s -> String -> [String] + +data DefaultShrinker = DefaultShrinker +instance Show DefaultShrinker where show _ = "" +instance Read DefaultShrinker where readsPrec _ s = [(DefaultShrinker,s)] +instance Shrinker DefaultShrinker where + shrinkIt _ "" = [""] + shrinkIt s cs = cs : shrinkIt s (init cs) + +shrinkText :: DefaultShrinker +shrinkText = DefaultShrinker hunk ./xmonad-contrib.cabal 99 + XMonad.Layout.Decoration addfile ./XMonad/Layout/Simplest.hs hunk ./XMonad/Layout/Simplest.hs 1 +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Simplest +-- Copyright : (c) 2007 Andrea Rossato +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A very simple layout. The simplest, afaik. +----------------------------------------------------------------------------- + +module XMonad.Layout.Simplest + ( -- * Usage: + -- $usage + Simplest (..) + ) where + +import XMonad +import qualified XMonad.StackSet as S + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Simplest +-- +-- Then edit your @layoutHook@ by adding the Simplest layout: +-- +-- > myLayouts = Simplest ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +data Simplest a = Simplest deriving (Show, Read) +instance LayoutClass Simplest Window where + pureLayout Simplest rec (S.Stack w l r) = zip (w : reverse l ++ r) (repeat rec) hunk ./xmonad-contrib.cabal 120 + XMonad.Layout.Simplest addfile ./XMonad/Layout/SimpleDecoration.hs hunk ./XMonad/Layout/SimpleDecoration.hs 1 - +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.SimpleDecoration +-- Copyright : (c) 2007 Andrea Rossato +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A layout modifier for adding simple decorations to the windows of a +-- given layout. +----------------------------------------------------------------------------- + +module XMonad.Layout.SimpleDecoration + ( -- * Usage: + -- $usage + simpleDeco + , SimpleDecoration (..), defaultSimpleConfig + , shrinkText, CustomShrink(CustomShrink) + , Shrinker(..) + ) where + +import XMonad +import XMonad.Layout.Decoration + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.SimpleDecoration +-- +-- Then edit your @layoutHook@ by adding the SimpleDecoration decoration to +-- your layout: +-- +-- > myL = simpleDeco shrinkText defaultSimpleConfig (layoutHook defaultConfig) +-- > main = xmonad defaultConfig { layoutHook = myL } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- You can also edit the default configuration options. +-- +-- > mySDConfig = defaultSimpleConfig { inactiveBorderColor = "red" +-- > , inactiveTextColor = "red"} +-- +-- and +-- +-- > myL = dwmStyle shrinkText mySDConfig (layoutHook defaultConfig) + +-- | Add simple decorations to windows of a layout. +simpleDeco :: Shrinker s => s -> DeConfig SimpleDecoration a + -> l a -> ModifiedLayout (Decoration SimpleDecoration s) l a +simpleDeco s c = decoration s c + +defaultSimpleConfig :: DeConfig SimpleDecoration a +defaultSimpleConfig = mkDefaultDeConfig $ Simple True + +data SimpleDecoration a = Simple Bool deriving (Show, Read) + +instance DecorationStyle SimpleDecoration a where + describeDeco _ = "Simple" + shrink (Simple b) (Rectangle _ _ _ dh) r@(Rectangle x y w h) = + if b then Rectangle x (y + fi dh) w (h - dh) else r + pureDecoration (Simple b) wh ht _ _ _ (_,Rectangle x y wid _) = + if b then Just $ Rectangle x y nwh ht else Just $ Rectangle x (y - fi ht) nwh ht + where nwh = min wid wh hunk ./xmonad-contrib.cabal 121 + XMonad.Layout.SimpleDecoration addfile ./XMonad/Layout/DwmStyle.hs hunk ./XMonad/Layout/DwmStyle.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.DwmStyle +-- Copyright : (c) 2007 Andrea Rossato +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A layout modifier for decorating windows in a dwm like style. +----------------------------------------------------------------------------- + +module XMonad.Layout.DwmStyle + ( -- * Usage: + -- $usage + dwmStyle + , DwmStyle (..), defaultDwmStyleConfig + , shrinkText, CustomShrink(CustomShrink) + , Shrinker(..) + ) where + +import XMonad +import XMonad.StackSet ( Stack (..) ) +import XMonad.Layout.Decoration + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.DwmStyle +-- +-- Then edit your @layoutHook@ by adding the DwmStyle decoration to +-- your layout: +-- +-- > myL = dwmStyle shrinkText defaultDwmStyleConfig (layoutHook defaultConfig) +-- > main = xmonad defaultConfig { layoutHook = myL } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- You can also edit the default configuration options. +-- +-- > myDWConfig = defaultDwmStyleConfig { inactiveBorderColor = "red" +-- > , inactiveTextColor = "red"} +-- +-- and +-- +-- > myL = dwmStyle shrinkText myDWConfig (layoutHook defaultConfig) + +-- | Add simple old dwm-style decorations to windows of a layout. +dwmStyle :: (Eq a, Shrinker s) => s -> DeConfig DwmStyle a + -> l a -> ModifiedLayout (Decoration DwmStyle s) l a +dwmStyle s c = decoration s c + +defaultDwmStyleConfig :: Eq a => DeConfig DwmStyle a +defaultDwmStyleConfig= mkDefaultDeConfig Dwm + +data DwmStyle a = Dwm deriving (Show, Read) + +instance Eq a => DecorationStyle DwmStyle a where + describeDeco _ = "DwmStyle" + shrink _ _ r = r + pureDecoration _ wh ht _ (Stack fw _ _) _ (win,Rectangle x y wid _) = + if win == fw then Nothing else Just $ Rectangle (fi nx) y nwh (fi ht) + where nwh = min wid $ fi wh + nx = fi x + wid - nwh hunk ./xmonad-contrib.cabal 102 + XMonad.Layout.DwmStyle hunk ./XMonad/Layout/Tabbed.hs 2 + hunk ./XMonad/Layout/Tabbed.hs 15 +-- This module has functions and types that conflict with those used +-- in Decoration.hs. These functions and types are deprecated and will +-- be removed. +-- +-- PLEASE: do not use 'tabbed'. Use 'tabDeco' instead. +-- hunk ./XMonad/Layout/Tabbed.hs 23 -module XMonad.Layout.Tabbed ( - -- * Usage: - -- $usage - tabbed - , shrinkText, CustomShrink(CustomShrink) - , TConf (..), defaultTConf - , Shrinker(..) - ) where +module XMonad.Layout.Tabbed + ( -- * Usage: + -- $usage + tabbed + , tabDeco + , TConf (..), defaultTConf + , TabbedDecoration (..), defaultTabbedConfig + , shrinkText, CustomShrink(CustomShrink) + , Shrinker(..) + ) where hunk ./XMonad/Layout/Tabbed.hs 38 -import qualified XMonad.StackSet as W - -import XMonad.Util.NamedWindows -import XMonad.Util.Invisible -import XMonad.Util.XUtils -import XMonad.Util.Font - -import XMonad.Hooks.UrgencyHook +import qualified XMonad.StackSet as S +import XMonad.Layout.Decoration +import XMonad.Layout.Simplest hunk ./XMonad/Layout/Tabbed.hs 49 --- > myLayouts = tabbed shrinkText defaultTConf ||| Full ||| etc.. +-- > myLayouts = tabDeco shrinkText defaultTabbedConfig ||| Full ||| etc.. hunk ./XMonad/Layout/Tabbed.hs 58 --- > myTabConfig = defaultTConf { inactiveBorderColor = "#FF0000" --- > , activeTextColor = "#00FF00"} +-- > myTabConfig = defaultTabbedConfig { inactiveBorderColor = "#FF0000" +-- > , activeTextColor = "#00FF00"} hunk ./XMonad/Layout/Tabbed.hs 63 --- > mylayout = tabbed shrinkText myTabConfig ||| Full ||| etc.. +-- > mylayout = tabDeco shrinkText myTabConfig ||| Full ||| etc.. + +-- | Create a tabbed layout with a shrinker and a tabbed configuration. +tabDeco :: (Eq a, Shrinker s) => s -> DeConfig TabbedDecoration a + -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a +tabDeco s c = decoration s c Simplest + +-- | This function is deprecated and will be removed before 0.7!! +tabbed :: (Eq a, Shrinker s) => s -> TConf + -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a +tabbed s c = decoration s (toNewConf c) Simplest hunk ./XMonad/Layout/Tabbed.hs 75 -tabbed :: Shrinker s => s -> TConf -> Tabbed s a -tabbed s t = Tabbed (I Nothing) s t +defaultTabbedConfig :: Eq a => DeConfig TabbedDecoration a +defaultTabbedConfig = mkDefaultDeConfig $ Tabbed hunk ./XMonad/Layout/Tabbed.hs 78 +data TabbedDecoration a = Tabbed deriving (Read, Show) + +instance Eq a => DecorationStyle TabbedDecoration a where + describeDeco _ = "Tabbed" + decorateFirst _ = False + pureDecoration _ _ ht (Rectangle x y wh _) s wrs (w,_) = Just $ Rectangle nx y nwh (fi ht) + where nwh = wh `div` max 1 (fi $ length wrs) + nx = case w `elemIndex` (S.integrate s) of + Just i -> x + (fi nwh * fi i) + Nothing -> x + +-- Backward compatibility stuff +-- DEPRECATED!! +toNewConf :: Eq a => TConf -> DeConfig TabbedDecoration a +toNewConf oc = + nc { XMonad.Layout.Decoration.activeColor = XMonad.Layout.Tabbed.activeColor oc + , XMonad.Layout.Decoration.inactiveColor = XMonad.Layout.Tabbed.inactiveColor oc + , XMonad.Layout.Decoration.urgentColor = XMonad.Layout.Tabbed.urgentColor oc + , XMonad.Layout.Decoration.activeBorderColor = XMonad.Layout.Tabbed.activeBorderColor oc + , XMonad.Layout.Decoration.inactiveBorderColor = XMonad.Layout.Tabbed.inactiveBorderColor oc + , XMonad.Layout.Decoration.urgentBorderColor = XMonad.Layout.Tabbed.urgentBorderColor oc + , XMonad.Layout.Decoration.activeTextColor = XMonad.Layout.Tabbed.activeTextColor oc + , XMonad.Layout.Decoration.inactiveTextColor = XMonad.Layout.Tabbed.inactiveTextColor oc + , XMonad.Layout.Decoration.urgentTextColor = XMonad.Layout.Tabbed.urgentTextColor oc + , XMonad.Layout.Decoration.fontName = XMonad.Layout.Tabbed.fontName oc + , XMonad.Layout.Decoration.decoHeight = fi $ XMonad.Layout.Tabbed.tabSize oc + } + where nc = mkDefaultDeConfig $ Tabbed + +-- | This datatype is deprecated and will be removed before 0.7!! hunk ./XMonad/Layout/Tabbed.hs 122 +-- | This function is deprecated and will be removed before 0.7!! hunk ./XMonad/Layout/Tabbed.hs 125 - 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 + TConf { XMonad.Layout.Tabbed.activeColor = "#999999" + , XMonad.Layout.Tabbed.inactiveColor = "#666666" + , XMonad.Layout.Tabbed.urgentColor = "#FFFF00" + , XMonad.Layout.Tabbed.activeBorderColor = "#FFFFFF" + , XMonad.Layout.Tabbed.inactiveBorderColor = "#BBBBBB" + , XMonad.Layout.Tabbed.urgentBorderColor = "##00FF00" + , XMonad.Layout.Tabbed.activeTextColor = "#FFFFFF" + , XMonad.Layout.Tabbed.inactiveTextColor = "#BFBFBF" + , XMonad.Layout.Tabbed.urgentTextColor = "#FF0000" + , XMonad.Layout.Tabbed.fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , XMonad.Layout.Tabbed.tabSize = 20 hunk ./XMonad/Layout/Tabbed.hs 138 -data TabState = - TabState { tabsWindows :: [(Window,Window)] - , scr :: Rectangle - , font :: XMonadFont - } - -data Tabbed s a = - Tabbed (Invisible Maybe TabState) s TConf - deriving (Show, Read) - -instance Shrinker s => LayoutClass (Tabbed s) Window where - doLayout (Tabbed ist ishr conf) = doLay ist ishr conf - handleMessage = handleMess - description _ = "Tabbed" - -doLay :: Shrinker s => Invisible Maybe TabState -> s -> TConf - -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed s Window)) -doLay ist ishr c sc (W.Stack w [] []) = do - whenIJust ist $ \st -> mapM_ deleteWindow (map fst $ tabsWindows st) - return ([(w,sc)], Just $ Tabbed (I Nothing) ishr c) -doLay ist ishr c sc@(Rectangle _ _ wid _) s@(W.Stack w _ _) = do - let ws = W.integrate s - width = wid `div` fromIntegral (length ws) - -- initialize state - st <- case ist of - (I Nothing ) -> initState c sc ws - (I (Just ts)) -> if map snd (tabsWindows ts) == ws && scr ts == sc - then return ts - else do mapM_ deleteWindow (map fst $ tabsWindows ts) - tws <- createTabs c sc ws - return (ts {scr = sc, tabsWindows = zip tws ws}) - mapM_ showWindow $ map fst $ tabsWindows st - mapM_ (updateTab ishr c (font st) width) $ tabsWindows st - return ([(w,shrink c sc)], Just (Tabbed (I (Just st)) ishr c)) - -handleMess :: Shrinker s => Tabbed s Window -> SomeMessage -> X (Maybe (Tabbed s Window)) -handleMess (Tabbed (I (Just st@(TabState {tabsWindows = tws}))) ishr conf) m - | Just e <- fromMessage m :: Maybe Event = handleEvent ishr conf st e >> return Nothing - | Just Hide == fromMessage m = mapM_ hideWindow (map fst tws) >> return Nothing - | Just ReleaseResources == fromMessage m = do mapM_ deleteWindow $ map fst tws - releaseXMF (font st) - return $ Just $ Tabbed (I Nothing) ishr conf -handleMess _ _ = return Nothing - -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 }) - | t == buttonPress, tl <- map fst tws, thisw `elem` tl || thisbw `elem` tl = do - case lookup thisw tws of - Just x -> do focus x - updateTab ishr conf fs width (thisw, x) - Nothing -> return () - where - width = rect_width screen`div` fromIntegral (length tws) - -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs}) - (AnyEvent {ev_window = thisw, ev_event_type = t }) --- expose - | thisw `elem` (map fst tws) && t == expose = do - updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws) - where - width = rect_width screen`div` fromIntegral (length tws) - --- propertyNotify -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs}) - (PropertyEvent {ev_window = thisw}) - | thisw `elem` (map snd tws) = do - let tabwin = (fst $ fromJust $ find ((== thisw) . snd) tws, thisw) - updateTab ishr conf fs width tabwin - where width = rect_width screen `div` fromIntegral (length tws) --- expose -handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs}) - (ExposeEvent {ev_window = thisw}) - | thisw `elem` (map fst tws) = do - updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws) - where width = rect_width screen `div` fromIntegral (length tws) -handleEvent _ _ _ _ = return () - -initState :: TConf -> Rectangle -> [Window] -> X TabState -initState conf sc ws = do - fs <- initXMF (fontName conf) - tws <- createTabs conf sc ws - return $ TabState (zip tws ws) sc fs - -createTabs :: TConf -> Rectangle -> [Window] -> X [Window] -createTabs _ _ [] = return [] -createTabs c (Rectangle x y wh ht) owl@(ow:ows) = do - let wid = wh `div` (fromIntegral $ length owl) - height = fromIntegral $ tabSize c - mask = Just (exposureMask .|. buttonPressMask) - d <- asks display - 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) - -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 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) - paintAndWrite tabw fs wh ht 1 bc' borderc' tc' bc' AlignCenter name - -shrink :: TConf -> Rectangle -> Rectangle -shrink c (Rectangle x y w h) = - Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c)) - -shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String -shrinkWhile sh p x = sw $ sh x - where sw [n] = return n - sw [] = return "" - sw (n:ns) = do - cond <- p n - if cond - then sw ns - else return n - -data CustomShrink = CustomShrink -instance Show CustomShrink where show _ = "" -instance Read CustomShrink where readsPrec _ s = [(CustomShrink,s)] - -class (Read s, Show s) => Shrinker s where - shrinkIt :: s -> String -> [String] - -data DefaultShrinker = DefaultShrinker -instance Show DefaultShrinker where show _ = "" -instance Read DefaultShrinker where readsPrec _ s = [(DefaultShrinker,s)] -instance Shrinker DefaultShrinker where - shrinkIt _ "" = [""] - shrinkIt s cs = cs : shrinkIt s (init cs) - -shrinkText :: DefaultShrinker -shrinkText = DefaultShrinker hunk ./XMonad/Config/Arossato.hs 79 -arossatoTabbedConfig :: TConf -arossatoTabbedConfig = - defaultTConf { activeColor = "#8a999e" - , inactiveColor = "#545d75" - , activeBorderColor = "white" - , inactiveBorderColor = "grey" - , activeTextColor = "white" - , inactiveTextColor = "grey" - , tabSize = 15 - } +arossatoTabbedConfig :: DeConfig TabbedDecoration Window +arossatoTabbedConfig = defaultTabbedConfig + { activeColor = "#8a999e" + , inactiveColor = "#545d75" + , activeBorderColor = "white" + , inactiveBorderColor = "grey" + , activeTextColor = "white" + , inactiveTextColor = "grey" + , decoHeight = 15 + } hunk ./XMonad/Config/Arossato.hs 109 - mytab = tabbed shrinkText arossatoTabbedConfig + mytab = tabDeco shrinkText arossatoTabbedConfig hunk ./XMonad/Config/Sjanssen.hs 32 - , layoutHook = avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTConf) + , layoutHook = avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabDeco shrinkText myTConf) hunk ./XMonad/Config/Sjanssen.hs 47 - myTConf = defaultTConf { fontName = myFont } + myTConf = defaultTabbedConfig { fontName = myFont } hunk ./XMonad/Layout/Tabbed.hs 28 - , TConf (..), defaultTConf + , defaultTConf + , DeConfig (..) hunk ./XMonad/Prompt.hs 2 - hunk ./XMonad/Prompt.hs 16 -module XMonad.Prompt ( - -- * Usage - -- $usage - mkXPrompt - , mkXPromptWithReturn - , defaultXPConfig - , mkComplFunFromList - , XPType (..) - , XPPosition (..) - , XPConfig (..) - , XPrompt (..) - , ComplFunction - -- * X Utilities - -- $xutils - , mkUnmanagedWindow - , fillDrawable - -- * Other Utilities - -- $utils - , getLastWord - , skipLastWord - , splitInSubListsAt - , breakAtSpace - , newIndex - , newCommand - , uniqSort - ) where +module XMonad.Prompt + ( -- * Usage + -- $usage + mkXPrompt + , mkXPromptWithReturn + , defaultXPConfig + , mkComplFunFromList + , XPType (..) + , XPPosition (..) + , XPConfig (..) + , XPrompt (..) + , ComplFunction + -- * X Utilities + -- $xutils + , mkUnmanagedWindow + , fillDrawable + -- * Other Utilities + -- $utils + , getLastWord + , skipLastWord + , splitInSubListsAt + , breakAtSpace + , newIndex + , newCommand + , uniqSort + ) where hunk ./XMonad/Prompt.hs 412 - _ -> o + (ln id ss) + Next -> o + (ln id ss) hunk ./XMonad/Prompt.hs 443 - case c of + case c of hunk ./XMonad/Layout/DwmStyle.hs 19 + , DeConfig (..) hunk ./XMonad/Layout/SimpleDecoration.hs 20 + , DeConfig (..) hunk ./XMonad/Layout/Decoration.hs 23 - , shrinkText, CustomShrink(CustomShrink) - , mkDefaultDeConfig - , DeConfig (..), defaultDeConfig - , Shrinker(..) + , DeConfig (..), defaultDeConfig, mkDefaultDeConfig + , shrinkText, CustomShrink ( CustomShrink ) + , Shrinker (..) hunk ./XMonad/Layout/Decoration.hs 90 - DS { decos :: [(OrigWin,DecoWin)] - , font :: XMonadFont + DS { decos :: [(OrigWin,DecoWin)] + , font :: XMonadFont hunk ./XMonad/Layout/Decoration.hs 139 - get_ws = map get_w hunk ./XMonad/Layout/Decoration.hs 140 + get_ws = map get_w hunk ./XMonad/Layout/Decoration.hs 161 - hunk ./XMonad/Layout/Decoration.hs 182 - hunk ./XMonad/Layout/Decoration.hs 196 - dw <- createNewWindow rect mask (inactiveColor c) True + dw <- createNewWindow rect mask (inactiveColor c) True hunk ./XMonad/Layout/Decoration.hs 213 - (bc',borderc',tc') <- focusColor w - (inactiveColor c, inactiveBorderColor c, inactiveTextColor c) - (activeColor c, activeBorderColor c, activeTextColor c) - (urgentColor c, urgentBorderColor c, urgentTextColor c) + (bc,borderc,tc) <- focusColor w + (inactiveColor c, inactiveBorderColor c, inactiveTextColor c) + (activeColor c, activeBorderColor c, activeTextColor c) + (urgentColor c, urgentBorderColor c, urgentTextColor c) hunk ./XMonad/Layout/Decoration.hs 221 - paintAndWrite dw fs wh ht 1 bc' borderc' tc' bc' AlignCenter name + paintAndWrite dw fs wh ht 1 bc borderc tc bc AlignCenter name hunk ./XMonad/Hooks/ManageDocks.hs 144 + + emptyLayout (AvoidStruts b l) r = do (wrs,ml) <- emptyLayout l r + return (wrs, AvoidStruts b `fmap` ml) hunk ./XMonad/Layout/ShowWName.hs 71 - 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) + redoLayout sn r _ wrs = doShow sn r wrs + + emptyLayoutMod sn r wrs = doShow sn r wrs hunk ./XMonad/Layout/ShowWName.hs 84 +doShow :: ShowWName a -> Rectangle -> [(a,Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a)) +doShow (SWN True c (Just (_,w))) r wrs = deleteWindow w >> flashName c r wrs +doShow (SWN True c Nothing ) r wrs = flashName c r wrs +doShow (SWN False _ _ ) _ wrs = return (wrs, Nothing) + hunk ./XMonad/Layout/WindowArranger.hs 22 + , WindowArranger hunk ./XMonad/Layout/Decoration.hs 25 - , Shrinker (..) + , Shrinker (..), DefaultShrinker hunk ./XMonad/Layout/Decoration.hs 35 - +import XMonad.Hooks.UrgencyHook hunk ./XMonad/Layout/Decoration.hs 38 - hunk ./XMonad/Layout/Decoration.hs 43 -import XMonad.Hooks.UrgencyHook - addfile ./XMonad/Layout/SimpleFloat.hs hunk ./XMonad/Layout/SimpleFloat.hs 1 +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.SimpleFloat +-- Copyright : (c) 2007 Andrea Rossato +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A very simple layout. The simplest, afaik. +----------------------------------------------------------------------------- + +module XMonad.Layout.SimpleFloat + ( -- * Usage: + -- $usage + simpleFloat + , simpleFloat' + , SimpleDecoration (..), defaultSFConfig + , shrinkText, CustomShrink(CustomShrink) + , Shrinker(..) + ) where + +import XMonad +import qualified XMonad.StackSet as S +import XMonad.Layout.Decoration +import XMonad.Layout.SimpleDecoration +import XMonad.Layout.WindowArranger + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.SimpleFloat +-- +-- Then edit your @layoutHook@ by adding the SimpleFloat layout: +-- +-- > myLayouts = simpleFloat ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +-- | FIXME +simpleFloat :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) + (ModifiedLayout WindowArranger SimpleFloat) a +simpleFloat = decoration shrinkText defaultSFConfig (windowArranger $ SF 20) + +-- | FIXME +simpleFloat' :: Shrinker s => s -> DeConfig SimpleDecoration a -> + ModifiedLayout (Decoration SimpleDecoration s) + (ModifiedLayout WindowArranger SimpleFloat) a +simpleFloat' s c = decoration s c (windowArranger $ SF (decoHeight c)) + +defaultSFConfig :: DeConfig SimpleDecoration a +defaultSFConfig = mkDefaultDeConfig $ Simple False + +data SimpleFloat a = SF Dimension deriving (Show, Read) +instance LayoutClass SimpleFloat Window where + doLayout (SF i) sc (S.Stack w l r) = do wrs <- mapM (getSize i sc) (w : reverse l ++ r) + return (wrs, Nothing) + description _ = "SimpleFloat" + +getSize :: Dimension -> Rectangle -> Window -> X (Window,Rectangle) +getSize i (Rectangle rx ry _ _) w = do + d <- asks display + bw <- asks (borderWidth . config) + wa <- io $ getWindowAttributes d w + let ny = ry + fi i + x = max rx $ fi $ wa_x wa + y = max ny $ fi $ wa_y wa + wh = (fi $ wa_width wa) + (bw * 2) + ht = (fi $ wa_height wa) + (bw * 2) + return (w, Rectangle x y wh ht) hunk ./xmonad-contrib.cabal 123 + XMonad.Layout.SimpleFloat hunk ./XMonad/Config/Arossato.hs 24 +import System.IO (hPutStrLn) hunk ./XMonad/Config/Arossato.hs 27 -import XMonad.ManageHook hunk ./XMonad/Config/Arossato.hs 31 +import XMonad.Hooks.ManageDocks hunk ./XMonad/Config/Arossato.hs 35 +import XMonad.Layout.SimpleFloat hunk ./XMonad/Config/Arossato.hs 37 +import XMonad.Layout.WindowArranger hunk ./XMonad/Config/Arossato.hs 43 +import XMonad.Util.Run hunk ./XMonad/Config/Arossato.hs 55 --- > main = xmonad arossatoConfig +-- > main = xmonad =<< arossatoConfig hunk ./XMonad/Config/Arossato.hs 77 --- > main = xmonad arossatoConfig +-- > main = xmonad =<< arossatoConfig hunk ./XMonad/Config/Arossato.hs 91 - , decoHeight = 15 + , decoHeight = 14 hunk ./XMonad/Config/Arossato.hs 94 -arossatoConfig = defaultConfig +arossatoSFConfig :: DeConfig SimpleDecoration Window +arossatoSFConfig = defaultSFConfig + { activeColor = "#8a999e" + , inactiveColor = "#545d75" + , activeBorderColor = "white" + , inactiveBorderColor = "grey" + , activeTextColor = "white" + , inactiveTextColor = "grey" + , decoHeight = 14 + } + +arossatoConfig = do + xmobar <- spawnPipe "xmobar" + return $ defaultConfig hunk ./XMonad/Config/Arossato.hs 110 - , logHook = dynamicLogXmobar + , logHook = myDynLog xmobar hunk ./XMonad/Config/Arossato.hs 112 - , layoutHook = noBorders mytab ||| - magnifier tiled ||| - noBorders Full ||| - tiled ||| - Mirror tiled ||| - Accordion + , layoutHook = avoidStruts $ + decorated ||| + noBorders mytabs ||| + otherLays hunk ./XMonad/Config/Arossato.hs 120 - , defaultGaps = [(15,0,0,0)] hunk ./XMonad/Config/Arossato.hs 123 - mytab = tabDeco shrinkText arossatoTabbedConfig - tiled = Tall 1 (3/100) (1/2) + mytabs = tabDeco shrinkText arossatoTabbedConfig + decorated = simpleFloat' shrinkText arossatoSFConfig + tiled = Tall 1 (3/100) (1/2) + otherLays = windowArranger $ + magnifier tiled ||| + noBorders Full ||| + Mirror tiled ||| + Accordion hunk ./XMonad/Config/Arossato.hs 137 - newManageHook = myManageHook <+> manageHook defaultConfig + newManageHook = myManageHook + + -- xmobar + myDynLog h = dynamicLogWithPP defaultPP + { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" + , ppTitle = xmobarColor "green" "" . shorten 40 + , ppVisible = wrap "(" ")" + , ppOutput = hPutStrLn h + } hunk ./XMonad/Config/Arossato.hs 186 + -- windowArranger + , ((modMask x .|. controlMask , xK_a ), sendMessage Arrange ) + , ((modMask x .|. controlMask .|. shiftMask, xK_a ), sendMessage DeArrange ) + , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage (DecreaseLeft 10)) + , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage (DecreaseRight 10)) + , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage (DecreaseDown 10)) + , ((modMask x .|. controlMask .|. shiftMask, xK_Up ), sendMessage (DecreaseUp 10)) + , ((modMask x .|. controlMask , xK_Left ), sendMessage (IncreaseLeft 10)) + , ((modMask x .|. controlMask , xK_Right), sendMessage (IncreaseRight 10)) + , ((modMask x .|. controlMask , xK_Down ), sendMessage (IncreaseDown 10)) + , ((modMask x .|. controlMask , xK_Up ), sendMessage (IncreaseUp 10)) + , ((modMask x .|. shiftMask , xK_Left ), sendMessage (MoveLeft 10)) + , ((modMask x .|. shiftMask , xK_Right), sendMessage (MoveRight 10)) + , ((modMask x .|. shiftMask , xK_Down ), sendMessage (MoveDown 10)) + , ((modMask x .|. shiftMask , xK_Up ), sendMessage (MoveUp 10)) + hunk ./XMonad/Config/Arossato.hs 126 - otherLays = windowArranger $ + otherLays = windowArrange $ hunk ./XMonad/Layout/SimpleFloat.hs 49 -simpleFloat = decoration shrinkText defaultSFConfig (windowArranger $ SF 20) +simpleFloat = decoration shrinkText defaultSFConfig (windowArrangeAll $ SF 20) hunk ./XMonad/Layout/SimpleFloat.hs 55 -simpleFloat' s c = decoration s c (windowArranger $ SF (decoHeight c)) +simpleFloat' s c = decoration s c (windowArrangeAll $ SF (decoHeight c)) hunk ./XMonad/Layout/SimpleFloat.hs 72 - x = max rx $ fi $ wa_x wa - y = max ny $ fi $ wa_y wa + x = max rx $ fi $ wa_x wa + y = max ny $ fi $ wa_y wa hunk ./XMonad/Layout/WindowArranger.hs 20 - windowArranger + windowArrange + , windowArrangeAll hunk ./XMonad/Layout/WindowArranger.hs 72 -windowArranger :: l a -> ModifiedLayout WindowArranger l a -windowArranger = ModifiedLayout (WA True []) +windowArrange :: l a -> ModifiedLayout WindowArranger l a +windowArrange = ModifiedLayout (WA True False []) + +-- | A layout modifier to float all the windows in a workspace +windowArrangeAll :: l a -> ModifiedLayout WindowArranger l a +windowArrangeAll = ModifiedLayout (WA True True []) hunk ./XMonad/Layout/WindowArranger.hs 100 -data WindowArranger a = WA Bool [ArrangedWindow a] deriving (Read, Show) +type ArrangeAll = Bool +data WindowArranger a = WA Bool ArrangeAll [ArrangedWindow a] deriving (Read, Show) hunk ./XMonad/Layout/WindowArranger.hs 104 - pureModifier (WA True [] ) _ _ wrs = arrangeWindows wrs + pureModifier (WA True b []) _ _ wrs = arrangeWindows b wrs hunk ./XMonad/Layout/WindowArranger.hs 106 - pureModifier (WA True awrs) _ (S.Stack w _ _) wrs = curry process wrs awrs + pureModifier (WA True b awrs) _ (S.Stack w _ _) wrs = curry process wrs awrs hunk ./XMonad/Layout/WindowArranger.hs 108 - wins = map fst *** map awrWin - update (a,r) = mkNewAWRs a *** removeAWRs r >>> uncurry (++) - process = wins &&& id >>> first diff >>> uncurry update >>> - replaceWR wrs >>> putOnTop w >>> map fromAWR &&& Just . WA True + wins = map fst *** map awrWin + update (a,r) = mkNewAWRs b a *** removeAWRs r >>> uncurry (++) + process = wins &&& id >>> first diff >>> uncurry update >>> + replaceWR wrs >>> putOnTop w >>> map fromAWR &&& Just . WA True b hunk ./XMonad/Layout/WindowArranger.hs 115 - pureMess (WA True (wr:wrs)) m + pureMess (WA True b (wr:wrs)) m hunk ./XMonad/Layout/WindowArranger.hs 132 - where res wi x y w h = Just . WA True $ AWR (wi,Rectangle x y w h):wrs + where res wi x y w h = Just . WA True b $ AWR (wi,Rectangle x y w h):wrs hunk ./XMonad/Layout/WindowArranger.hs 137 - pureMess (WA _ l) m - | Just DeArrange <- fromMessage m = Just $ WA False l - | Just Arrange <- fromMessage m = Just $ WA True l + pureMess (WA _ b l) m + | Just DeArrange <- fromMessage m = Just $ WA False b l + | Just Arrange <- fromMessage m = Just $ WA True b l hunk ./XMonad/Layout/WindowArranger.hs 142 -arrangeWindows :: [(a,Rectangle)] -> ([(a, Rectangle)], Maybe (WindowArranger a)) -arrangeWindows wrs = (wrs, Just $ WA True (map WR wrs)) +arrangeWindows :: ArrangeAll -> [(a,Rectangle)] -> ([(a, Rectangle)], Maybe (WindowArranger a)) +arrangeWindows b wrs = (wrs, Just $ WA True b (map t wrs)) + where t = if b then AWR else WR hunk ./XMonad/Layout/WindowArranger.hs 159 -mkNewAWRs :: Eq a => [a] -> [(a,Rectangle)] -> [ArrangedWindow a] -mkNewAWRs w wrs = map WR . concatMap (flip getWR wrs) $ w +mkNewAWRs :: Eq a => ArrangeAll -> [a] -> [(a,Rectangle)] -> [ArrangedWindow a] +mkNewAWRs b w wrs = map t . concatMap (flip getWR wrs) $ w + where t = if b then AWR else WR addfile ./XMonad/Layout/ResizeScreen.hs hunk ./XMonad/Layout/ResizeScreen.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.ResizeScreen +-- Copyright : (c) 2007 Andrea Rossato +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A layout transformer to have a layout respect a given screen +-- geometry +----------------------------------------------------------------------------- + +module XMonad.Layout.ResizeScreen + ( -- * Usage: + -- $usage + resizeHorizontal + , resizeVertical + , withNewRectangle + , ResizeScreen (..) + ) where + +import Control.Arrow (second) +import Control.Applicative ((<$>)) + +import XMonad +import XMonad.Util.XUtils (fi) + +-- $usage +-- You can use this module by importing it into your +-- @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Layout.ResizeScreen +-- +-- and modifying your layoutHook as follows (for example): +-- +-- > layoutHook = resizeHorizontal 40 Full +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +resizeHorizontal :: Int -> l a -> ResizeScreen l a +resizeHorizontal = ResizeScreen H + +resizeVertical :: Int -> l a -> ResizeScreen l a +resizeVertical = ResizeScreen V + +withNewRectangle :: Rectangle -> l a -> ResizeScreen l a +withNewRectangle = WithNewScreen + +data ResizeScreen l a = ResizeScreen ResizeMode Int (l a) + | WithNewScreen Rectangle (l a) + deriving (Read, Show) +data ResizeMode = H | V deriving (Read, Show) + +instance (LayoutClass l a) => LayoutClass (ResizeScreen l) a where + doLayout m (Rectangle x y w h ) s + | ResizeScreen H i l <- m = resize (ResizeScreen V i) l (Rectangle (x + fi i) y (w - fi i) h) + | ResizeScreen V i l <- m = resize (ResizeScreen H i) l (Rectangle x (y + fi i) w (h - fi i)) + | WithNewScreen r l <- m = resize (WithNewScreen r) l r + | otherwise = return ([],Nothing) + where resize t l' nr = second (fmap t) <$> doLayout l' nr s + + handleMessage rs m + | ResizeScreen t i l <- rs = go (ResizeScreen t i) l + | WithNewScreen r l <- rs = go (WithNewScreen r) l + | otherwise = return Nothing + where go tp lay = do ml' <- handleMessage lay m + return (tp `fmap` ml') + + emptyLayout rs re + | ResizeScreen t i l <- rs = go (ResizeScreen t i) l + | WithNewScreen r l <- rs = go (WithNewScreen r) l + | otherwise = return ([],Nothing) + where go tp lay = do (wrs,ml) <- emptyLayout lay re + return (wrs, tp `fmap` ml) + + description _ = [] hunk ./xmonad-contrib.cabal 120 + XMonad.Layout.ResizeScreen hunk ./XMonad/Layout/LayoutCombinators.hs 166 + emptyLayout (NewSelect True l1 l2) r = do (wrs, ml1') <- emptyLayout l1 r + return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1') + emptyLayout (NewSelect False l1 l2) r = do (wrs, ml2') <- emptyLayout l2 r + return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2') hunk ./XMonad/Layout/LayoutModifier.hs 36 + modifyLayout :: (LayoutClass l a) => m a -> l a -> Rectangle + -> Stack a -> X ([(a, Rectangle)], Maybe (l a)) + modifyLayout _ l r s = doLayout l r s hunk ./XMonad/Layout/LayoutModifier.hs 67 - do (ws, ml') <- doLayout l r s + do (ws, ml') <- modifyLayout m l r s hunk ./XMonad/Layout/ResizeScreen.hs 25 -import Control.Arrow (second) -import Control.Applicative ((<$>)) - hunk ./XMonad/Layout/ResizeScreen.hs 27 +import XMonad.Layout.LayoutModifier hunk ./XMonad/Layout/ResizeScreen.hs 43 -resizeHorizontal :: Int -> l a -> ResizeScreen l a -resizeHorizontal = ResizeScreen H +resizeHorizontal :: Int -> l a -> ModifiedLayout ResizeScreen l a +resizeHorizontal i = ModifiedLayout (ResizeScreen H i) hunk ./XMonad/Layout/ResizeScreen.hs 46 -resizeVertical :: Int -> l a -> ResizeScreen l a -resizeVertical = ResizeScreen V +resizeVertical :: Int -> l a -> ModifiedLayout ResizeScreen l a +resizeVertical i = ModifiedLayout (ResizeScreen V i) hunk ./XMonad/Layout/ResizeScreen.hs 49 -withNewRectangle :: Rectangle -> l a -> ResizeScreen l a -withNewRectangle = WithNewScreen +withNewRectangle :: Rectangle -> l a -> ModifiedLayout ResizeScreen l a +withNewRectangle r = ModifiedLayout (WithNewScreen r) hunk ./XMonad/Layout/ResizeScreen.hs 52 -data ResizeScreen l a = ResizeScreen ResizeMode Int (l a) - | WithNewScreen Rectangle (l a) - deriving (Read, Show) +data ResizeScreen a = ResizeScreen ResizeMode Int + | WithNewScreen Rectangle + deriving (Read, Show) hunk ./XMonad/Layout/ResizeScreen.hs 57 -instance (LayoutClass l a) => LayoutClass (ResizeScreen l) a where - doLayout m (Rectangle x y w h ) s - | ResizeScreen H i l <- m = resize (ResizeScreen V i) l (Rectangle (x + fi i) y (w - fi i) h) - | ResizeScreen V i l <- m = resize (ResizeScreen H i) l (Rectangle x (y + fi i) w (h - fi i)) - | WithNewScreen r l <- m = resize (WithNewScreen r) l r - | otherwise = return ([],Nothing) - where resize t l' nr = second (fmap t) <$> doLayout l' nr s - - handleMessage rs m - | ResizeScreen t i l <- rs = go (ResizeScreen t i) l - | WithNewScreen r l <- rs = go (WithNewScreen r) l - | otherwise = return Nothing - where go tp lay = do ml' <- handleMessage lay m - return (tp `fmap` ml') - - emptyLayout rs re - | ResizeScreen t i l <- rs = go (ResizeScreen t i) l - | WithNewScreen r l <- rs = go (WithNewScreen r) l - | otherwise = return ([],Nothing) - where go tp lay = do (wrs,ml) <- emptyLayout lay re - return (wrs, tp `fmap` ml) - - description _ = [] +instance LayoutModifier ResizeScreen a where + modifyLayout m l re@(Rectangle x y w h) s + | ResizeScreen H i <- m = resize (Rectangle (x + fi i) y (w - fi i) h) + | ResizeScreen V i <- m = resize (Rectangle x (y + fi i) w (h - fi i)) + | WithNewScreen r <- m = resize r + | otherwise = resize re + where resize nr = doLayout l nr s hunk ./XMonad/Hooks/ManageDocks.hs 29 +import XMonad.Layout.LayoutModifier hunk ./XMonad/Hooks/ManageDocks.hs 125 -avoidStruts :: LayoutClass l a => l a -> AvoidStruts l a -avoidStruts = AvoidStruts True +avoidStruts :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a +avoidStruts = ModifiedLayout (AvoidStruts True) hunk ./XMonad/Hooks/ManageDocks.hs 128 -data AvoidStruts l a = AvoidStruts Bool (l a) deriving ( Read, Show ) +data AvoidStruts a = AvoidStruts Bool deriving ( Read, Show ) hunk ./XMonad/Hooks/ManageDocks.hs 133 -instance LayoutClass l a => LayoutClass (AvoidStruts l) a where - doLayout (AvoidStruts True lo) r s = - 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 - return (wrs, AvoidStruts False `fmap` mlo') - handleMessage (AvoidStruts b l) m - | Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (not b) l - | otherwise = do ml' <- handleMessage l m - return (AvoidStruts b `fmap` ml') - description (AvoidStruts _ l) = description l +instance LayoutModifier AvoidStruts a where + modifyLayout (AvoidStruts b) l r s = do + nr <- if b then fmap ($ r) calcGap else return r + doLayout l nr s hunk ./XMonad/Hooks/ManageDocks.hs 138 - emptyLayout (AvoidStruts b l) r = do (wrs,ml) <- emptyLayout l r - return (wrs, AvoidStruts b `fmap` ml) + handleMess (AvoidStruts b ) m + | Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (not b) + | otherwise = return Nothing hunk ./XMonad/Layout/SimpleFloat.hs 64 - description _ = "SimpleFloat" + description _ = "Float" hunk ./XMonad/Layout/Reflect.hs 31 -import Control.Arrow ((***), second) -import Control.Applicative ((<$>)) +import Control.Arrow (second) hunk ./XMonad/Layout/Reflect.hs 33 +import XMonad.Layout.LayoutModifier hunk ./XMonad/Layout/Reflect.hs 71 -reflectHoriz :: (LayoutClass l a) => (l a) -> Reflect l a -reflectHoriz = Reflect Horiz +reflectHoriz :: l a -> ModifiedLayout Reflect l a +reflectHoriz = ModifiedLayout (Reflect Horiz) hunk ./XMonad/Layout/Reflect.hs 76 -reflectVert :: (LayoutClass l a) => (l a) -> Reflect l a -reflectVert = Reflect Vert +reflectVert :: l a -> ModifiedLayout Reflect l a +reflectVert = ModifiedLayout (Reflect Vert) hunk ./XMonad/Layout/Reflect.hs 95 -data Reflect l a = Reflect ReflectDir (l a) deriving (Show, Read) +data Reflect a = Reflect ReflectDir deriving (Show, Read) hunk ./XMonad/Layout/Reflect.hs 97 -instance LayoutClass l a => LayoutClass (Reflect l) a where +instance LayoutModifier Reflect a where hunk ./XMonad/Layout/Reflect.hs 99 - -- 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 + -- reflect all the generated Rectangles. + pureModifier (Reflect d) r _ wrs = (map (second $ reflectRect d r) wrs, Just $ Reflect d) hunk ./XMonad/Layout/Reflect.hs 102 - -- 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 + modifierDescription (Reflect d) = "Reflect" ++ xy hunk ./XMonad/Layout/Decoration.hs 168 - emptyLayoutMod (Decoration (I (Just (DS dwrs _))) _ _) _ _ = deleteWindows (getDWs dwrs) >> return ([], Nothing) + emptyLayoutMod (Decoration (I (Just (DS dwrs _))) sh c) _ _ = do deleteWindows (getDWs dwrs) + return ([], Just $ Decoration (I Nothing) sh c) hunk ./XMonad/Layout/Decoration.hs 168 - emptyLayoutMod (Decoration (I (Just (DS dwrs _))) sh c) _ _ = do deleteWindows (getDWs dwrs) + emptyLayoutMod (Decoration (I (Just (DS dwrs f))) sh c) _ _ = do deleteWindows (getDWs dwrs) + releaseXMF f hunk ./XMonad/Layout/Decoration.hs 121 - | decorate_first = do whenIJust st $ \s -> deleteWindows (getDWs $ decos s) + | decorate_first = do whenIJust st $ \s -> do + deleteWindows (getDWs $ decos s) + releaseXMF (font s) hunk ./XMonad/Layout/Named.hs 45 + emptyLayout (Named n l) r = do (ws, ml') <- emptyLayout l r + return (ws, Named n `fmap` ml') hunk ./XMonad/Layout/Named.hs 51 + hunk ./XMonad/Layout/ToggleLayouts.hs 63 + emptyLayout (ToggleLayouts True lt lf) r = do (ws,mlt') <- emptyLayout lt r + return (ws,fmap (\lt' -> ToggleLayouts True lt' lf) mlt') + emptyLayout (ToggleLayouts False lt lf) r = do (ws,mlf') <- emptyLayout lf r + return (ws,fmap (\lf' -> ToggleLayouts False lt lf') mlf') hunk ./XMonad/Layout/LayoutModifier.hs 64 + modifyDescription :: (LayoutClass l a) => m a -> l a -> String + modifyDescription m l = modifierDescription m <> description l + where "" <> x = x + x <> y = x ++ " " ++ y hunk ./XMonad/Layout/LayoutModifier.hs 92 - description (ModifiedLayout m l) = modifierDescription m <> description l - where "" <> x = x - x <> y = x ++ " " ++ y + description (ModifiedLayout m l) = modifyDescription m l hunk ./XMonad/Config/Droundy.hs 136 - Named "tabbed" (noBorders mytab) ||| - Named "xclock" (mytab ****//* combineTwo Square mytab mytab) ||| - Named "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) ||| - Named "widescreen" ((mytab *||* mytab) + named "tabbed" (noBorders mytab) ||| + named "xclock" (mytab ****//* combineTwo Square mytab mytab) ||| + named "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) ||| + named "widescreen" ((mytab *||* mytab) hunk ./XMonad/Layout/Named.hs 1 -{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} hunk ./XMonad/Layout/Named.hs 17 -module XMonad.Layout.Named ( - -- * Usage - -- $usage - Named(Named) - ) where +module XMonad.Layout.Named + ( -- * Usage + -- $usage + named + ) where hunk ./XMonad/Layout/Named.hs 23 -import XMonad +import XMonad.Layout.LayoutModifier hunk ./XMonad/Layout/Named.hs 33 --- > myLayouts = Named "real big" Full ||| etc.. +-- > myLayouts = named "real big" Full ||| etc.. hunk ./XMonad/Layout/Named.hs 40 -data Named l a = Named String (l a) deriving ( Read, Show ) +named :: String -> l a -> ModifiedLayout Named l a +named s = ModifiedLayout (Named s) hunk ./XMonad/Layout/Named.hs 43 -instance (LayoutClass l a) => LayoutClass (Named l) a where - doLayout (Named n l) r s = do (ws, ml') <- doLayout l r s - return (ws, Named n `fmap` ml') - emptyLayout (Named n l) r = do (ws, ml') <- emptyLayout l r - return (ws, Named n `fmap` ml') - handleMessage (Named n l) mess = do ml' <- handleMessage l mess - return $ Named n `fmap` ml' - description (Named n _) = n +data Named a = Named String deriving ( Read, Show ) hunk ./XMonad/Layout/Named.hs 45 +instance LayoutModifier Named a where + modifyDescription (Named n) _ = n hunk ./XMonad/Layout/LayoutCombinators.hs 16 -module XMonad.Layout.LayoutCombinators ( - -- * Usage - -- $usage +module XMonad.Layout.LayoutCombinators + ( -- * Usage + -- $usage hunk ./XMonad/Layout/LayoutCombinators.hs 20 - -- * Combinators using DragPane vertical - -- $dpv - (*||*), (**||*),(***||*),(****||*),(***||**),(****||***), - (***||****),(*||****),(**||***),(*||***),(*||**), + -- * Combinators using DragPane vertical + -- $dpv + (*||*), (**||*),(***||*),(****||*),(***||**),(****||***) + , (***||****),(*||****),(**||***),(*||***),(*||**) hunk ./XMonad/Layout/LayoutCombinators.hs 25 - -- * Combinators using DragPane horizontal - -- $dph - (*//*), (**//*),(***//*),(****//*),(***//**),(****//***), - (***//****),(*//****),(**//***),(*//***),(*//**), + -- * Combinators using DragPane horizontal + -- $dph + , (*//*), (**//*),(***//*),(****//*),(***//**),(****//***) + , (***//****),(*//****),(**//***),(*//***),(*//**) hunk ./XMonad/Layout/LayoutCombinators.hs 30 - -- * Combinators using Tall (vertical) - -- $tv - (*|*), (**|*),(***|*),(****|*),(***|**),(****|***), - (***|****),(*|****),(**|***),(*|***),(*|**), + -- * Combinators using Tall (vertical) + -- $tv + , (*|*), (**|*),(***|*),(****|*),(***|**),(****|***) + , (***|****),(*|****),(**|***),(*|***),(*|**) hunk ./XMonad/Layout/LayoutCombinators.hs 35 - -- * Combinators using Mirror Tall (horizontal) - -- $mth - (*/*), (**/*),(***/*),(****/*),(***/**),(****/***), - (***/****),(*/****),(**/***),(*/***),(*/**), + -- * Combinators using Mirror Tall (horizontal) + -- $mth + , (*/*), (**/*),(***/*),(****/*),(***/**),(****/***) + , (***/****),(*/****),(**/***),(*/***),(*/**) hunk ./XMonad/Layout/LayoutCombinators.hs 40 - -- * A new combinator - -- $nc - (|||), - JumpToLayout(JumpToLayout) + -- * A new combinator + -- $nc + , (|||) + , JumpToLayout(JumpToLayout) + , LayoutCombinator (..) + , CombinedLayout (..) + , ComboType (..) hunk ./XMonad/Layout/LayoutCombinators.hs 49 -import Data.Maybe ( isJust, isNothing ) +import Data.Maybe ( fromMaybe, isJust, isNothing ) hunk ./XMonad/Layout/LayoutCombinators.hs 225 +data ComboType = DoFirst | DoSecond | DoBoth deriving ( Eq, Show ) + +class (Read (lc a), Show (lc a)) => LayoutCombinator lc a where + chooser :: lc a -> X ComboType + chooser lc = return $ pureChooser lc + pureChooser :: lc a -> ComboType + pureChooser _ = DoFirst +-- doFirst lc = if (chooser lc) == DoSecond then False else True + doFirst :: lc a -> Bool + combineResult :: lc a -> [(a,Rectangle)] -> [(a,Rectangle)] -> [(a,Rectangle)] + combineResult _ wrs1 wrs2 = wrs1 ++ wrs2 + comboHandleMess :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> SomeMessage -> X (lc a) + comboHandleMess lc l1 l2 m = return $ pureComboHandleMess lc l1 l2 m + pureComboHandleMess :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> SomeMessage -> lc a + pureComboHandleMess lc _ _ _ = lc + sendToOther :: (LayoutClass l a) => lc a -> l a -> SomeMessage + sendToOther _ _ = SomeMessage Hide + comboName :: lc a -> String + comboName = show + comboDescription :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> String + comboDescription lc l1 l2 = show lc <> if doFirst lc then description l1 else description l2 + where "" <> x = x + x <> y = x ++ " " ++ y + +data CombinedLayout lc l1 l2 a = CombinedLayout (lc a) (l1 a) (l2 a) deriving ( Show, Read ) + +instance (LayoutClass l1 a, LayoutClass l2 a, LayoutCombinator lc a) => LayoutClass (CombinedLayout lc l1 l2) a where + doLayout (CombinedLayout lc l1 l2) r s = do + choose <- chooser lc + case choose of + DoSecond -> do (wrs, nl2) <- doLayout l2 r s + return (wrs, Just $ CombinedLayout lc l1 (fromMaybe l2 nl2)) + DoBoth -> do (wrs1, nl1) <- doLayout l1 r s + (wrs2, nl2) <- doLayout l2 r s + return (combineResult lc wrs1 wrs2 , Just $ CombinedLayout lc (fromMaybe l1 nl1) (fromMaybe l2 nl2)) + _ -> do (wrs, nl1) <- doLayout l1 r s + return (wrs, Just $ CombinedLayout lc (fromMaybe l1 nl1) l2) + emptyLayout (CombinedLayout lc l1 l2) r = do + choose <- chooser lc + case choose of + DoSecond -> do (wrs, nl2) <- emptyLayout l2 r + return (wrs, Just $ CombinedLayout lc l1 (fromMaybe l2 nl2)) + DoBoth -> do (wrs1, nl1) <- emptyLayout l1 r + (wrs2, nl2) <- emptyLayout l2 r + return (combineResult lc wrs1 wrs2 , Just $ CombinedLayout lc (fromMaybe l1 nl1) (fromMaybe l2 nl2)) + _ -> do (wrs, nl1) <- emptyLayout l1 r + return (wrs, Just $ CombinedLayout lc (fromMaybe l1 nl1) l2) + handleMessage (CombinedLayout lc l1 l2) m = do + nc <- comboHandleMess lc l1 l2 m + choose <- chooser nc + case choose of + DoFirst -> do nl1 <- handleMessage l1 m + nl2 <- handleMessage l2 (sendToOther nc l2) + return $ Just $ CombinedLayout nc (fromMaybe l1 nl1) (fromMaybe l2 nl2) + DoSecond -> do nl1 <- handleMessage l1 (sendToOther nc l1) + nl2 <- handleMessage l2 m + return $ Just $ CombinedLayout nc (fromMaybe l1 nl1) (fromMaybe l2 nl2) + DoBoth -> do nl1 <- handleMessage l1 m + nl2 <- handleMessage l2 m + return $ Just $ CombinedLayout nc (fromMaybe l1 nl1) (fromMaybe l2 nl2) + + description (CombinedLayout lc l1 l2) = comboDescription lc l1 l2 + hunk ./XMonad/Layout/PerWorkspace.hs 34 -import Data.Maybe (fromMaybe) - +import XMonad.Layout.LayoutCombinators hunk ./XMonad/Layout/PerWorkspace.hs 61 -onWorkspace :: (LayoutClass l1 a, LayoutClass l2 a) - => WorkspaceId -- ^ the tag of the workspace to match - -> (l1 a) -- ^ layout to use on the matched workspace - -> (l2 a) -- ^ layout to use everywhere else - -> PerWorkspace l1 l2 a -onWorkspace wsId l1 l2 = PerWorkspace [wsId] Nothing l1 l2 +onWorkspace :: WorkspaceId -- ^ tags of workspaces to match + -> (l1 a) -- ^ layout to use on matched workspaces + -> (l2 a) -- ^ layout to use everywhere else + -> CombinedLayout PerWorkspace l1 l2 a +onWorkspace wsId l1 l2 = CombinedLayout (PerWorkspace [wsId]) l1 l2 hunk ./XMonad/Layout/PerWorkspace.hs 69 -onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a) - => [WorkspaceId] -- ^ tags of workspaces to match +onWorkspaces :: [WorkspaceId] -- ^ tags of workspaces to match hunk ./XMonad/Layout/PerWorkspace.hs 72 - -> PerWorkspace l1 l2 a -onWorkspaces wsIds l1 l2 = PerWorkspace wsIds Nothing l1 l2 + -> CombinedLayout PerWorkspace l1 l2 a +onWorkspaces wsIds l1 l2 = CombinedLayout (PerWorkspace wsIds) l1 l2 hunk ./XMonad/Layout/PerWorkspace.hs 83 -data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId] - (Maybe Bool) - (l1 a) - (l2 a) - deriving (Read, Show) - -instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (PerWorkspace l1 l2) a where +data PerWorkspace a = PerWorkspace [WorkspaceId] deriving (Read, Show) hunk ./XMonad/Layout/PerWorkspace.hs 85 - -- do layout with l1, then return a modified PerWorkspace caching - -- the fact that we're in the matched workspace. - doLayout p@(PerWorkspace _ (Just True) lt _) r s = do - (wrs, mlt') <- doLayout lt r s - return (wrs, Just $ mkNewPerWorkspaceT p mlt') - - -- do layout with l1, then return a modified PerWorkspace caching - -- the fact that we're not in the matched workspace. - doLayout p@(PerWorkspace _ (Just False) _ lf) r s = do - (wrs, mlf') <- doLayout lf r s - return (wrs, Just $ mkNewPerWorkspaceF p mlf') - - -- figure out which layout to use based on the current workspace. - doLayout (PerWorkspace wsIds Nothing l1 l2) r s = do +instance LayoutCombinator PerWorkspace a where + chooser (PerWorkspace wsIds) = do hunk ./XMonad/Layout/PerWorkspace.hs 88 - doLayout (PerWorkspace wsIds (Just $ t `elem` wsIds) l1 l2) r s - - -- handle messages; same drill as doLayout. - handleMessage p@(PerWorkspace _ (Just True) lt _) m = do - mlt' <- handleMessage lt m - return . Just $ mkNewPerWorkspaceT p mlt' - - handleMessage p@(PerWorkspace _ (Just False) _ lf) m = do - mlf' <- handleMessage lf m - return . Just $ mkNewPerWorkspaceF p mlf' - - handleMessage (PerWorkspace _ Nothing _ _) _ = return Nothing - - description (PerWorkspace _ (Just True ) l1 _) = description l1 - description (PerWorkspace _ (Just False) _ l2) = description l2 - - -- description's result is not in the X monad, so we have to wait - -- until a doLayout for the information about which workspace - -- we're in to get cached. - description _ = "PerWorkspace" - --- | Construct new PerWorkspace values with possibly modified layouts. -mkNewPerWorkspaceT :: PerWorkspace l1 l2 a -> Maybe (l1 a) -> - PerWorkspace l1 l2 a -mkNewPerWorkspaceT (PerWorkspace wsIds b lt lf) mlt' = - (\lt' -> PerWorkspace wsIds b lt' lf) $ fromMaybe lt mlt' - -mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) -> - PerWorkspace l1 l2 a -mkNewPerWorkspaceF (PerWorkspace wsIds b lt lf) mlf' = - (\lf' -> PerWorkspace wsIds b lt lf') $ fromMaybe lf mlf' + return $ if t `elem` wsIds then DoFirst else DoSecond + doFirst (PerWorkspace _) = True hunk ./XMonad/Layout/LayoutCombinators.hs 46 - , ComboType (..) + , ComboChooser (..) hunk ./XMonad/Layout/LayoutCombinators.hs 225 -data ComboType = DoFirst | DoSecond | DoBoth deriving ( Eq, Show ) +data ComboChooser = DoFirst | DoSecond | DoBoth deriving ( Eq, Show ) hunk ./XMonad/Layout/LayoutCombinators.hs 228 - chooser :: lc a -> X ComboType + chooser :: lc a -> X ComboChooser hunk ./XMonad/Layout/LayoutCombinators.hs 230 - pureChooser :: lc a -> ComboType + pureChooser :: lc a -> ComboChooser hunk ./XMonad/Layout/LayoutCombinators.hs 232 --- doFirst lc = if (chooser lc) == DoSecond then False else True - doFirst :: lc a -> Bool hunk ./XMonad/Layout/LayoutCombinators.hs 240 - comboName :: lc a -> String - comboName = show - comboDescription :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> String - comboDescription lc l1 l2 = show lc <> if doFirst lc then description l1 else description l2 + comboDescription :: lc a -> String + comboDescription _ = "Combine" + combineDescription :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> String + combineDescription lc l1 l2 = comboDescription lc <> description l1 <> description l2 hunk ./XMonad/Layout/LayoutCombinators.hs 271 - nc <- comboHandleMess lc l1 l2 m + nc <- comboHandleMess lc l1 l2 m hunk ./XMonad/Layout/LayoutCombinators.hs 284 - description (CombinedLayout lc l1 l2) = comboDescription lc l1 l2 + description (CombinedLayout lc l1 l2) = combineDescription lc l1 l2 hunk ./XMonad/Layout/PerWorkspace.hs 65 -onWorkspace wsId l1 l2 = CombinedLayout (PerWorkspace [wsId]) l1 l2 +onWorkspace wsId = CombinedLayout (PerWorkspace [wsId]) hunk ./XMonad/Layout/PerWorkspace.hs 73 -onWorkspaces wsIds l1 l2 = CombinedLayout (PerWorkspace wsIds) l1 l2 +onWorkspaces wsIds = CombinedLayout (PerWorkspace wsIds) hunk ./XMonad/Layout/PerWorkspace.hs 89 - doFirst (PerWorkspace _) = True hunk ./xmonad-contrib.cabal 29 +build-type: Simple hunk ./XMonad/Actions/Search.hs 10 - A module for easily running Internet searches on web sites through XMonad. + A module for easily running Internet searches on web sites through xmonad. hunk ./XMonad/Actions/Search.hs 25 + hoogle, hunk ./XMonad/Actions/Search.hs 27 + mathworld, + scholar, hunk ./XMonad/Actions/Search.hs 30 - wikipedia, - hoogle + wikipedia hunk ./XMonad/Actions/Search.hs 43 - 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). + 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). hunk ./XMonad/Actions/Search.hs 51 - 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. + 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'. + + The currently available search engines are: + +* 'amazon' -- Amazon keyword search. + +* 'google' -- basic Google search. + +* 'hoogle' -- Hoogle, the Haskell libraries search engine. + +* 'imdb' -- the Internet Movie Database. + +* 'mathworld' -- Wolfram MathWorld search. + +* 'scholar' -- Google scholar academic search. + +* 'wayback' -- the Wayback Machine. + +* 'wikipedia' -- basic Wikipedia search. + +Feel free to add more! hunk ./XMonad/Actions/Search.hs 83 - 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'. hunk ./XMonad/Actions/Search.hs 118 +{- | Given a browser, a search engine, and a search term, perform the + requested search in the browser. -} hunk ./XMonad/Actions/Search.hs 137 --- The engines -amazon, google, hoogle, imdb, wayback, wikipedia :: SearchEngine +-- The engines. +amazon, google, hoogle, imdb, mathworld, scholar, wayback, wikipedia :: SearchEngine hunk ./XMonad/Actions/Search.hs 143 +mathworld = simpleEngine "http://mathworld.wolfram.com/search/?query=" +scholar = simpleEngine "http://scholar.google.com/scholar?q=" hunk ./XMonad/Actions/Search.hs 160 -{- | Like search, but for use with the X selection; it grabs the selection, +{- | Like 'search', but for use with the X selection; it grabs the selection, addfile ./XMonad/Actions/CycleSelectedLayouts.hs hunk ./XMonad/Actions/CycleSelectedLayouts.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.CycleSelectedLayouts +-- Copyright : (c) Roman Cheplyaka +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Roman Cheplyaka +-- Stability : unstable +-- Portability : unportable +-- +-- This module allows to cycle through the given subset of layouts. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.CycleSelectedLayouts ( + -- * Usage + -- $usage + cycleThroughLayouts) where + +import XMonad +import Data.List (findIndex) +import Data.Maybe (fromMaybe) +import XMonad.Layout.LayoutCombinators (JumpToLayout(..)) +import qualified XMonad.StackSet as S + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad hiding ((|||)) +-- > import XMonad.Layout.LayoutCombinators ((|||)) +-- > import XMonad.Actions.CycleSelectedLayouts +-- +-- > , ((modMask x, xK_t ), cycleThroughLayouts ["Tall", "Mirror Tall"]) +-- +-- Make sure you are using NewSelect from XMonad.Layout.LayoutCombinators, +-- rather than the Select defined in xmonad core. + +cycleToNext :: (Eq a) => [a] -> a -> Maybe a +cycleToNext lst a = do + -- not beautiful but simple and readable + ind <- findIndex (a==) lst + return $ lst !! if ind == length lst - 1 then 0 else ind+1 + +-- | If the current layout is in the list, cycle to the next layout. Otherwise, +-- apply the first layout from list. +cycleThroughLayouts :: [String] -> X () +cycleThroughLayouts lst = do + winset <- gets windowset + let ld = description . S.layout . S.workspace . S.current $ winset + let newld = fromMaybe (head lst) (cycleToNext lst ld) + sendMessage $ JumpToLayout newld hunk ./xmonad-contrib.cabal 64 + XMonad.Actions.CycleSelectedLayouts hunk ./XMonad/Layout/TwoPane.hs 62 + description _ = "TwoPane" hunk ./XMonad/Config/Arossato.hs 20 - , arossatoTabbedConfig + , arossatoTheme hunk ./XMonad/Config/Arossato.hs 83 -arossatoTabbedConfig :: DeConfig TabbedDecoration Window -arossatoTabbedConfig = defaultTabbedConfig - { activeColor = "#8a999e" - , inactiveColor = "#545d75" - , activeBorderColor = "white" - , inactiveBorderColor = "grey" - , activeTextColor = "white" - , inactiveTextColor = "grey" - , decoHeight = 14 - } - -arossatoSFConfig :: DeConfig SimpleDecoration Window -arossatoSFConfig = defaultSFConfig - { activeColor = "#8a999e" - , inactiveColor = "#545d75" - , activeBorderColor = "white" - , inactiveBorderColor = "grey" - , activeTextColor = "white" - , inactiveTextColor = "grey" - , decoHeight = 14 - } +arossatoTheme :: Theme +arossatoTheme = defaultTheme + { activeColor = "#8a999e" + , inactiveColor = "#545d75" + , activeBorderColor = "white" + , inactiveBorderColor = "grey" + , activeTextColor = "white" + , inactiveTextColor = "grey" + , decoHeight = 14 + } hunk ./XMonad/Config/Arossato.hs 112 - mytabs = tabDeco shrinkText arossatoTabbedConfig - decorated = simpleFloat' shrinkText arossatoSFConfig + mytabs = tabbed shrinkText arossatoTheme + decorated = simpleFloat' shrinkText arossatoTheme hunk ./XMonad/Config/Droundy.hs 149 -mytab = tabbed CustomShrink defaultTConf +mytab = tabbed CustomShrink defaultTheme hunk ./XMonad/Config/Sjanssen.hs 16 +import XMonad.Layout.DwmStyle hunk ./XMonad/Config/Sjanssen.hs 33 - , layoutHook = avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabDeco shrinkText myTConf) + , layoutHook = dwmStyle shrinkText myTheme $ avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTheme) hunk ./XMonad/Config/Sjanssen.hs 48 - myTConf = defaultTabbedConfig { fontName = myFont } + myTheme = defaultTheme { fontName = myFont } replace ./XMonad/Layout/Accordion.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/Circle.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/Combo.hs [A-Za-z_0-9] DeConfig Theme hunk ./XMonad/Layout/Decoration.hs 23 - , DeConfig (..), defaultDeConfig, mkDefaultDeConfig + , DeConfig (..), defaultTheme hunk ./XMonad/Layout/Decoration.hs 47 -decoration :: (DecorationStyle ds a, Shrinker s) => s -> DeConfig ds a +decoration :: (DecorationStyle ds a, Shrinker s) => s -> DeConfig -> ds a hunk ./XMonad/Layout/Decoration.hs 49 -decoration s c = ModifiedLayout (Decoration (I Nothing) s c) +decoration s t ds = ModifiedLayout (Decoration (I Nothing) s t ds) hunk ./XMonad/Layout/Decoration.hs 51 -data DeConfig ds a = +data DeConfig = hunk ./XMonad/Layout/Decoration.hs 53 - , inactiveColor :: String - , urgentColor :: String - , activeBorderColor :: String - , inactiveBorderColor :: String - , urgentBorderColor :: String - , activeTextColor :: String - , inactiveTextColor :: String - , urgentTextColor :: String - , fontName :: String - , decoWidth :: Dimension - , decoHeight :: Dimension - , style :: ds a - } deriving (Show, Read) + , inactiveColor :: String + , urgentColor :: String + , activeBorderColor :: String + , inactiveBorderColor :: String + , urgentBorderColor :: String + , activeTextColor :: String + , inactiveTextColor :: String + , urgentTextColor :: String + , fontName :: String + , decoWidth :: Dimension + , decoHeight :: Dimension + } deriving (Show, Read) hunk ./XMonad/Layout/Decoration.hs 66 -mkDefaultDeConfig :: DecorationStyle ds a => ds a -> DeConfig ds a -mkDefaultDeConfig ds = +defaultTheme :: DeConfig +defaultTheme = hunk ./XMonad/Layout/Decoration.hs 69 - , inactiveColor = "#666666" - , urgentColor = "#FFFF00" - , activeBorderColor = "#FFFFFF" - , inactiveBorderColor = "#BBBBBB" - , urgentBorderColor = "##00FF00" - , activeTextColor = "#FFFFFF" - , inactiveTextColor = "#BFBFBF" - , urgentTextColor = "#FF0000" - , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , decoWidth = 200 - , decoHeight = 20 - , style = ds - } + , inactiveColor = "#666666" + , urgentColor = "#FFFF00" + , activeBorderColor = "#FFFFFF" + , inactiveBorderColor = "#BBBBBB" + , urgentBorderColor = "##00FF00" + , activeTextColor = "#FFFFFF" + , inactiveTextColor = "#BFBFBF" + , urgentTextColor = "#FF0000" + , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , decoWidth = 200 + , decoHeight = 20 + } hunk ./XMonad/Layout/Decoration.hs 90 - Decoration (Invisible Maybe DecorationState) s (DeConfig ds a) + Decoration (Invisible Maybe DecorationState) s DeConfig (ds a) hunk ./XMonad/Layout/Decoration.hs 111 -data DefaultStyle a = DefaultStyle deriving (Read, Show) -instance DecorationStyle DefaultStyle a - -defaultDeConfig :: DeConfig DefaultStyle a -defaultDeConfig = mkDefaultDeConfig DefaultStyle - hunk ./XMonad/Layout/Decoration.hs 112 - redoLayout (Decoration st sh c) sc stack wrs + redoLayout (Decoration st sh c ds) sc stack wrs hunk ./XMonad/Layout/Decoration.hs 116 - return (wrs, Just $ Decoration (I Nothing) sh c) + return (wrs, Just $ Decoration (I Nothing) sh c ds) hunk ./XMonad/Layout/Decoration.hs 136 - insert_dwr ((w,r),(dw,Just dr)) xs = (dw,dr):(w, shrink (style c) dr r):xs + insert_dwr ((w,r),(dw,Just dr)) xs = (dw,dr):(w, shrink ds dr r):xs hunk ./XMonad/Layout/Decoration.hs 141 - Just i -> do dr <- decorate (style c) (decoWidth c) (decoHeight c) sc stack wrs (w,r) + Just i -> do dr <- decorate ds (decoWidth c) (decoHeight c) sc stack wrs (w,r) hunk ./XMonad/Layout/Decoration.hs 146 - decorate_first = length wrs == 1 && (not . decorateFirst . style $ c) + decorate_first = length wrs == 1 && (not . decorateFirst $ ds) hunk ./XMonad/Layout/Decoration.hs 150 - return (foldr insert_dwr [] ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh c)) + return (foldr insert_dwr [] ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh c ds)) hunk ./XMonad/Layout/Decoration.hs 152 - handleMess (Decoration (I (Just s@(DS {decos = dwrs}))) sh c) m + handleMess (Decoration (I (Just s@(DS {decos = dwrs}))) sh c ds) m hunk ./XMonad/Layout/Decoration.hs 157 - return $ Just $ Decoration (I Nothing) sh c + return $ Just $ Decoration (I Nothing) sh c ds hunk ./XMonad/Layout/Decoration.hs 162 - emptyLayoutMod (Decoration (I (Just (DS dwrs f))) sh c) _ _ = do deleteWindows (getDWs dwrs) - releaseXMF f - return ([], Just $ Decoration (I Nothing) sh c) + emptyLayoutMod (Decoration (I (Just (DS dwrs f))) sh c ds) _ _ = do + deleteWindows (getDWs dwrs) + releaseXMF f + return ([], Just $ Decoration (I Nothing) sh c ds) hunk ./XMonad/Layout/Decoration.hs 168 - modifierDescription (Decoration _ _ c) = describeDeco $ style c + modifierDescription (Decoration _ _ _ ds) = describeDeco ds hunk ./XMonad/Layout/Decoration.hs 170 -handleEvent :: (DecorationStyle ds a, Shrinker s) => s -> DeConfig ds a -> DecorationState-> Event -> X () +handleEvent :: Shrinker s => s -> DeConfig -> DecorationState -> Event -> X () hunk ./XMonad/Layout/Decoration.hs 179 -initState :: DecorationStyle ds a => DeConfig ds a -> [(Window,Rectangle)] -> X DecorationState +initState :: DeConfig -> [(Window,Rectangle)] -> X DecorationState hunk ./XMonad/Layout/Decoration.hs 185 -createDecos :: DecorationStyle ds a => DeConfig ds a -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)] +createDecos :: DeConfig -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)] hunk ./XMonad/Layout/Decoration.hs 194 -updateDecos :: (DecorationStyle ds a, Shrinker s) => s -> DeConfig ds a -> XMonadFont -> [(OrigWin, DecoWin)] -> X () +updateDecos :: Shrinker s => s -> DeConfig -> XMonadFont -> [(OrigWin, DecoWin)] -> X () hunk ./XMonad/Layout/Decoration.hs 197 -updateDeco :: (DecorationStyle ds a, Shrinker s) => s -> DeConfig ds a -> XMonadFont -> (OrigWin, DecoWin) -> X () +updateDeco :: Shrinker s => s -> DeConfig -> XMonadFont -> (OrigWin, DecoWin) -> X () replace ./XMonad/Layout/Decoration.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/Dishes.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/DragPane.hs [A-Za-z_0-9] DeConfig Theme hunk ./XMonad/Layout/DwmStyle.hs 20 - , DwmStyle (..), defaultDwmStyleConfig + , defaultTheme + , DwmStyle (..) hunk ./XMonad/Layout/DwmStyle.hs 39 --- > myL = dwmStyle shrinkText defaultDwmStyleConfig (layoutHook defaultConfig) +-- > myL = dwmStyle shrinkText defaultTheme (layoutHook defaultConfig) hunk ./XMonad/Layout/DwmStyle.hs 48 --- > myDWConfig = defaultDwmStyleConfig { inactiveBorderColor = "red" +-- > myDWConfig = defaultTheme { inactiveBorderColor = "red" hunk ./XMonad/Layout/DwmStyle.hs 56 -dwmStyle :: (Eq a, Shrinker s) => s -> DeConfig DwmStyle a +dwmStyle :: (Eq a, Shrinker s) => s -> DeConfig hunk ./XMonad/Layout/DwmStyle.hs 58 -dwmStyle s c = decoration s c - -defaultDwmStyleConfig :: Eq a => DeConfig DwmStyle a -defaultDwmStyleConfig= mkDefaultDeConfig Dwm +dwmStyle s c = decoration s c Dwm replace ./XMonad/Layout/DwmStyle.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/Grid.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/HintedTile.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/LayoutCombinators.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/LayoutHints.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/LayoutModifier.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/LayoutScreens.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/MagicFocus.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/Magnifier.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/Maximize.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/Mosaic.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/MosaicAlt.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/MultiToggle.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/Named.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/NoBorders.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/PerWorkspace.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/Reflect.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/ResizableTile.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/ResizeScreen.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/Roledex.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/ShowWName.hs [A-Za-z_0-9] DeConfig Theme hunk ./XMonad/Layout/SimpleDecoration.hs 21 - , SimpleDecoration (..), defaultSimpleConfig + , SimpleDecoration (..) hunk ./XMonad/Layout/SimpleDecoration.hs 38 --- > myL = simpleDeco shrinkText defaultSimpleConfig (layoutHook defaultConfig) +-- > myL = simpleDeco shrinkText defaultTheme (layoutHook defaultConfig) hunk ./XMonad/Layout/SimpleDecoration.hs 47 --- > mySDConfig = defaultSimpleConfig { inactiveBorderColor = "red" +-- > mySDConfig = defaultTheme { inactiveBorderColor = "red" hunk ./XMonad/Layout/SimpleDecoration.hs 52 --- > myL = dwmStyle shrinkText mySDConfig (layoutHook defaultConfig) +-- > myL = dwmStyle shrinkText mySDConfig (layoutHook defaultTheme) hunk ./XMonad/Layout/SimpleDecoration.hs 55 -simpleDeco :: Shrinker s => s -> DeConfig SimpleDecoration a +simpleDeco :: Shrinker s => s -> DeConfig hunk ./XMonad/Layout/SimpleDecoration.hs 57 -simpleDeco s c = decoration s c - -defaultSimpleConfig :: DeConfig SimpleDecoration a -defaultSimpleConfig = mkDefaultDeConfig $ Simple True +simpleDeco s c = decoration s c $ Simple True hunk ./XMonad/Layout/SimpleDecoration.hs 68 + replace ./XMonad/Layout/SimpleDecoration.hs [A-Za-z_0-9] DeConfig Theme hunk ./XMonad/Layout/SimpleFloat.hs 20 - , SimpleDecoration (..), defaultSFConfig + , SimpleDecoration (..) hunk ./XMonad/Layout/SimpleFloat.hs 49 -simpleFloat = decoration shrinkText defaultSFConfig (windowArrangeAll $ SF 20) +simpleFloat = decoration shrinkText defaultTheme (Simple False) (windowArrangeAll $ SF 20) hunk ./XMonad/Layout/SimpleFloat.hs 52 -simpleFloat' :: Shrinker s => s -> DeConfig SimpleDecoration a -> +simpleFloat' :: Shrinker s => s -> DeConfig -> hunk ./XMonad/Layout/SimpleFloat.hs 55 -simpleFloat' s c = decoration s c (windowArrangeAll $ SF (decoHeight c)) - -defaultSFConfig :: DeConfig SimpleDecoration a -defaultSFConfig = mkDefaultDeConfig $ Simple False +simpleFloat' s c = decoration s c (Simple False) (windowArrangeAll $ SF (decoHeight c)) replace ./XMonad/Layout/SimpleFloat.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/Simplest.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/Spiral.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/Square.hs [A-Za-z_0-9] DeConfig Theme hunk ./XMonad/Layout/Tabbed.hs 15 --- This module has functions and types that conflict with those used --- in Decoration.hs. These functions and types are deprecated and will --- be removed. --- --- PLEASE: do not use 'tabbed'. Use 'tabDeco' instead. --- hunk ./XMonad/Layout/Tabbed.hs 21 - , tabDeco - , defaultTConf hunk ./XMonad/Layout/Tabbed.hs 22 - , TabbedDecoration (..), defaultTabbedConfig + , defaultTheme + , TabbedDecoration (..) hunk ./XMonad/Layout/Tabbed.hs 34 -import XMonad.Layout.Simplest hunk ./XMonad/Layout/Tabbed.hs 42 --- > myLayouts = tabDeco shrinkText defaultTabbedConfig ||| Full ||| etc.. +-- > myLayouts = tabDeco shrinkText defaultTheme ||| Full ||| etc.. hunk ./XMonad/Layout/Tabbed.hs 51 --- > myTabConfig = defaultTabbedConfig { inactiveBorderColor = "#FF0000" +-- > myTabConfig = defaultTheme { inactiveBorderColor = "#FF0000" hunk ./XMonad/Layout/Tabbed.hs 58 --- | Create a tabbed layout with a shrinker and a tabbed configuration. -tabDeco :: (Eq a, Shrinker s) => s -> DeConfig TabbedDecoration a - -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a -tabDeco s c = decoration s c Simplest - hunk ./XMonad/Layout/Tabbed.hs 59 -tabbed :: (Eq a, Shrinker s) => s -> TConf - -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a -tabbed s c = decoration s (toNewConf c) Simplest - -defaultTabbedConfig :: Eq a => DeConfig TabbedDecoration a -defaultTabbedConfig = mkDefaultDeConfig $ Tabbed +tabbed :: (Eq a, Shrinker s) => s -> DeConfig + -> ModifiedLayout (Decoration TabbedDecoration s) Full a +tabbed s c = decoration s c Tabbed Full hunk ./XMonad/Layout/Tabbed.hs 74 --- Backward compatibility stuff --- DEPRECATED!! -toNewConf :: Eq a => TConf -> DeConfig TabbedDecoration a -toNewConf oc = - nc { XMonad.Layout.Decoration.activeColor = XMonad.Layout.Tabbed.activeColor oc - , XMonad.Layout.Decoration.inactiveColor = XMonad.Layout.Tabbed.inactiveColor oc - , XMonad.Layout.Decoration.urgentColor = XMonad.Layout.Tabbed.urgentColor oc - , XMonad.Layout.Decoration.activeBorderColor = XMonad.Layout.Tabbed.activeBorderColor oc - , XMonad.Layout.Decoration.inactiveBorderColor = XMonad.Layout.Tabbed.inactiveBorderColor oc - , XMonad.Layout.Decoration.urgentBorderColor = XMonad.Layout.Tabbed.urgentBorderColor oc - , XMonad.Layout.Decoration.activeTextColor = XMonad.Layout.Tabbed.activeTextColor oc - , XMonad.Layout.Decoration.inactiveTextColor = XMonad.Layout.Tabbed.inactiveTextColor oc - , XMonad.Layout.Decoration.urgentTextColor = XMonad.Layout.Tabbed.urgentTextColor oc - , XMonad.Layout.Decoration.fontName = XMonad.Layout.Tabbed.fontName oc - , XMonad.Layout.Decoration.decoHeight = fi $ XMonad.Layout.Tabbed.tabSize oc - } - where nc = mkDefaultDeConfig $ Tabbed - --- | This datatype is deprecated and will be removed before 0.7!! -data TConf = - TConf { activeColor :: String - , inactiveColor :: String - , urgentColor :: String - , activeBorderColor :: String - , inactiveBorderColor :: String - , urgentBorderColor :: String - , activeTextColor :: String - , inactiveTextColor :: String - , urgentTextColor :: String - , fontName :: String - , tabSize :: Int - } deriving (Show, Read) - --- | This function is deprecated and will be removed before 0.7!! -defaultTConf :: TConf -defaultTConf = - TConf { XMonad.Layout.Tabbed.activeColor = "#999999" - , XMonad.Layout.Tabbed.inactiveColor = "#666666" - , XMonad.Layout.Tabbed.urgentColor = "#FFFF00" - , XMonad.Layout.Tabbed.activeBorderColor = "#FFFFFF" - , XMonad.Layout.Tabbed.inactiveBorderColor = "#BBBBBB" - , XMonad.Layout.Tabbed.urgentBorderColor = "##00FF00" - , XMonad.Layout.Tabbed.activeTextColor = "#FFFFFF" - , XMonad.Layout.Tabbed.inactiveTextColor = "#BFBFBF" - , XMonad.Layout.Tabbed.urgentTextColor = "#FF0000" - , XMonad.Layout.Tabbed.fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , XMonad.Layout.Tabbed.tabSize = 20 - } - - replace ./XMonad/Layout/Tabbed.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/ThreeColumns.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/ToggleLayouts.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/TwoPane.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/WindowArranger.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/WindowNavigation.hs [A-Za-z_0-9] DeConfig Theme replace ./XMonad/Layout/WorkspaceDir.hs [A-Za-z_0-9] DeConfig Theme hunk ./XMonad/Layout/SimpleDecoration.hs 21 + , defaultTheme hunk ./XMonad/Hooks/DynamicLog.hs 111 - sort' <- getSortByTag + sort' <- ppSort pp hunk ./XMonad/Hooks/DynamicLog.hs 203 + , ppSort :: X ([WindowSpace] -> [WindowSpace]) hunk ./XMonad/Hooks/DynamicLog.hs 219 + , ppSort = getSortByTag hunk ./XMonad/Util/WorkspaceCompare.hs 12 -module XMonad.Util.WorkspaceCompare ( getWsIndex, getWsCompare, getSortByTag ) where +module XMonad.Util.WorkspaceCompare ( getWsIndex + , getWsCompare + , getSortByTag + , getSortByXineramaRule ) where hunk ./XMonad/Util/WorkspaceCompare.hs 21 +import Data.Ord +import Data.Maybe hunk ./XMonad/Util/WorkspaceCompare.hs 36 - where - f Nothing Nothing = EQ - f (Just _) Nothing = LT - f Nothing (Just _) = GT - f (Just x) (Just y) = compare x y + where + f Nothing Nothing = EQ + f (Just _) Nothing = LT + f Nothing (Just _) = GT + f (Just x) (Just y) = compare x y + +-- | A comparison function for Xinerama based on visibility, workspace and +-- screen id. It produces same ordering as pprWindowSetXinerama does. +getXineramaWsCompare :: X(WorkspaceId -> WorkspaceId -> Ordering) +getXineramaWsCompare = do + w <- gets windowset + return $ \ a b -> case (isOnScreen a w, isOnScreen b w) of + (True, True) -> comparing (tagToSid (onScreen w)) a b + (False, False) -> compare a b + (True, False) -> LT + (False, True) -> GT + where + onScreen w = S.current w : S.visible w + isOnScreen a w = a `elem` map (S.tag . S.workspace) (onScreen w) + tagToSid s x = S.screen $ fromJust $ find ((== x) . S.tag . S.workspace) s + --S.screen $ head $ filter ((== x) . S.tag . S.workspace) s hunk ./XMonad/Util/WorkspaceCompare.hs 64 +-- | Sort serveral workspaces for xinerama displays +getSortByXineramaRule :: X ([WindowSpace] -> [WindowSpace]) +getSortByXineramaRule = do + cmp <- getXineramaWsCompare + return $ sortBy (\a b -> cmp (S.tag a) (S.tag b)) + + hunk ./XMonad/Hooks/DynamicLog.hs 11 --- DynamicLog --- --- By default, log events in: --- --- > 1 2 [3] 4 8 --- --- format, although the format is highly customizable. --- Suitable to pipe into dzen or xmobar. +-- xmonad calls the logHook with every internal state update, which is +-- useful for (among other things) outputting status information to an +-- external status bar program such as xmobar or dzen. DynamicLog +-- provides several drop-in logHooks for this purpose, as well as +-- flexible tools for specifying your own formatting. hunk ./XMonad/Hooks/DynamicLog.hs 22 + + -- * Drop-in loggers + makeSimpleDzenConfig, + dzen, hunk ./XMonad/Hooks/DynamicLog.hs 31 - dzen, hunk ./XMonad/Hooks/DynamicLog.hs 32 - pprWindowSet, - pprWindowSetXinerama, + -- * Build your own formatter + PP(..), defaultPP, dzenPP, sjanssenPP, byorgeyPP, hunk ./XMonad/Hooks/DynamicLog.hs 35 - PP(..), defaultPP, dzenPP, sjanssenPP, + -- * Formatting utilities hunk ./XMonad/Hooks/DynamicLog.hs 38 - makeSimpleDzenConfig + + -- * Internal formatting functions + pprWindowSet, + pprWindowSetXinerama + hunk ./XMonad/Hooks/DynamicLog.hs 64 --- > main = xmonad defaultConfig { logHook = dynamicLog } +-- +-- Then set your logHook to an appropriate function, for example +-- +-- > logHook = dynamicLog +-- +-- or, for more flexibility, something like +-- +-- > logHook = dynamicLogWithPP myDynamicLogPP +-- > ... +-- > myDynamicLogPP = defaultPP { ... -- override pretty-printer with specific settings +-- hunk ./XMonad/Hooks/DynamicLog.hs 76 --- | An example xmonad config that spawns a new dzen toolbar and uses the default --- dynamic log output +-- | An example xmonad config that spawns a new dzen toolbar and uses +-- the default dynamic log output. hunk ./XMonad/Hooks/DynamicLog.hs 139 --- | An example log hook that emulates dwm's status bar, using colour codes printed to dzen --- Requires dzen. Workspaces, xinerama, layouts and the window title are handled. +-- | An example log hook that emulates dwm's status bar, using colour +-- codes printed to dzen. Requires dzen. Workspaces, xinerama, +-- layouts and the window title are handled. hunk ./XMonad/Hooks/DynamicLog.hs 146 +-- | Do the actual status formatting, using a pretty-printer. hunk ./XMonad/Hooks/DynamicLog.hs 166 --- and 2 and 7 are non-visible, non-empty workspaces +-- and 2 and 7 are non-visible, non-empty workspaces. hunk ./XMonad/Hooks/DynamicLog.hs 178 -wrap :: String -> String -> String -> String +-- | Wrap a string in delimiters, unless it is empty. +wrap :: String -- ^ left delimiter + -> String -- ^ right delimiter + -> String -- ^ output string + -> String hunk ./XMonad/Hooks/DynamicLog.hs 186 +-- | Pad a string with a leading and trailing space. hunk ./XMonad/Hooks/DynamicLog.hs 190 +-- | Limit a string to a certain length, adding "..." if truncated. hunk ./XMonad/Hooks/DynamicLog.hs 197 -sepBy :: String -> [String] -> String +-- | Output a list of strings, ignoring empty ones and separating the +-- rest with the given separator. +sepBy :: String -- ^ separator + -> [String] -- ^ fields to output + -> String hunk ./XMonad/Hooks/DynamicLog.hs 204 -dzenColor :: String -> String -> String -> String +-- | Use dzen escape codes to output a string with given foreground +-- and background colors. +dzenColor :: String -- ^ foreground color: a color name, or #rrggbb format + -> String -- ^ background color + -> String -- ^ output string + -> String hunk ./XMonad/Hooks/DynamicLog.hs 220 -xmobarColor :: String -> String -> String -> String +-- | Use xmobar escape codes to output a string with given foreground +-- and background colors. +xmobarColor :: String -- ^ foreground color: a color name, or #rrggbb format + -> String -- ^ background color + -> String -- ^ output string + -> String hunk ./XMonad/Hooks/DynamicLog.hs 230 --- dynamicLogPP -data PP = PP { ppCurrent, ppVisible - , ppHidden, ppHiddenNoWindows +-- dynamicLogPP. +data PP = PP { ppCurrent :: WorkspaceId -> String + -- ^ how to print the tag of the currently focused workspace + , ppVisible :: WorkspaceId -> String + -- ^ how to print tags of visible but not focused workspaces (xinerama only) + , ppHidden :: WorkspaceId -> String + -- ^ how to print tags of hidden workspaces which contain windows + , ppHiddenNoWindows :: WorkspaceId -> String + -- ^ how to print tags of empty hidden workspaces hunk ./XMonad/Hooks/DynamicLog.hs 240 - , ppSep, ppWsSep :: String + -- ^ format to be applied to tags of urgent workspaces. + -- NOTE that 'ppUrgent' is applied /in addition to/ 'ppHidden'! + , ppSep :: String + -- ^ separator to use between different log sections (window name, layout, workspaces) + , ppWsSep :: String + -- ^ separator to use between workspace tags hunk ./XMonad/Hooks/DynamicLog.hs 247 + -- ^ window title format hunk ./XMonad/Hooks/DynamicLog.hs 249 + -- ^ layout name format hunk ./XMonad/Hooks/DynamicLog.hs 251 - , ppOutput :: String -> IO () + -- ^ how to order the different log sections hunk ./XMonad/Hooks/DynamicLog.hs 253 + -- ^ how to sort the workspaces. See "XMonad.Util.WorkspaceCompare" for some useful sorts. + , ppOutput :: String -> IO () + -- ^ formatter that gets applied to the entire log string before it is output. hunk ./XMonad/Hooks/DynamicLog.hs 258 --- | The default pretty printing options, as seen in dynamicLog +-- | The default pretty printing options, as seen in 'dynamicLog'. hunk ./XMonad/Hooks/DynamicLog.hs 274 --- | Settings to emulate dwm's statusbar, dzen only +-- | Settings to emulate dwm's statusbar, dzen only. hunk ./XMonad/Hooks/DynamicLog.hs 294 --- 'xmobarColor' and the record update on defaultPP +-- 'xmobarColor' and the record update on 'defaultPP'. hunk ./XMonad/Hooks/DynamicLog.hs 300 --- | These are good defaults to be used with the xmobar status bar +-- | The options that byorgey likes to use with dzen, as another example. +byorgeyPP :: PP +byorgeyPP = defaultPP { ppHiddenNoWindows = showNamedWorkspaces + , ppHidden = dzenColor "black" "#a8a3f7" . pad + , ppCurrent = dzenColor "yellow" "#a8a3f7" . pad + , ppUrgent = dzenColor "red" "yellow" + , ppSep = " | " + , ppWsSep = "" + , ppTitle = shorten 65 + , ppOrder = reverse + } + where showNamedWorkspaces wsId = if (':' `elem` wsId) + then pad wsId + else "" + +-- | These are good defaults to be used with the xmobar status bar. hunk ./XMonad/Doc/Configuring.hs 56 -onwards, however, all you have to do is edit xmonad.hs and restart -with @mod-q@; xmonad does the recompiling itself. The format of the -configuration file has also changed; it is now simpler and much -shorter, only requiring you to list those settings which are different -from the defaults. +onwards, however, you should NOT edit this file. All you have to do +is edit xmonad.hs and restart with @mod-q@; xmonad does the +recompiling itself. The format of the configuration file has also +changed; it is now simpler and much shorter, only requiring you to +list those settings which are different from the defaults. hunk ./XMonad/Doc/Configuring.hs 91 -An alternative is to inline the entire default config file from -xmonad, and edit values you wish to change. This is requires more -work, but some users may find this easier. You can find the defaults -in the "XMonad.Config" module of the core xmonad library. - -However, note that (unlike previous versions of xmonad) you should not -edit Config.hs itself. +As an alternative, you can copy the template @xmonad.hs@ file (found +either in the @man@ directory, if you have the xmonad source, or on +the xmonad wiki at +@http:\/\/haskell.org\/haskellwiki\/Xmonad\/Config_archive\/Template_Config.hs@) +into your @~\/.xmonad\/@ directory. This template file contains all +the default settings spelled out, and you should be able to simply +change the ones you would like to change. hunk ./XMonad/Doc/Configuring.hs 113 -> GHCi, version 6.8.1: http://www.haskell.org/ghc/ :? for help +> GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help hunk ./XMonad/Doc/Extending.hs 441 + +For a list of the names of particular keys (such as xK_F12, and so on), see +. hunk ./XMonad/Layout/LayoutCombinators.hs 44 - , LayoutCombinator (..) - , CombinedLayout (..) - , ComboChooser (..) hunk ./XMonad/Layout/LayoutCombinators.hs 46 -import Data.Maybe ( fromMaybe, isJust, isNothing ) +import Data.Maybe ( isJust, isNothing ) hunk ./XMonad/Layout/LayoutCombinators.hs 221 - -data ComboChooser = DoFirst | DoSecond | DoBoth deriving ( Eq, Show ) - -class (Read (lc a), Show (lc a)) => LayoutCombinator lc a where - chooser :: lc a -> X ComboChooser - chooser lc = return $ pureChooser lc - pureChooser :: lc a -> ComboChooser - pureChooser _ = DoFirst - combineResult :: lc a -> [(a,Rectangle)] -> [(a,Rectangle)] -> [(a,Rectangle)] - combineResult _ wrs1 wrs2 = wrs1 ++ wrs2 - comboHandleMess :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> SomeMessage -> X (lc a) - comboHandleMess lc l1 l2 m = return $ pureComboHandleMess lc l1 l2 m - pureComboHandleMess :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> SomeMessage -> lc a - pureComboHandleMess lc _ _ _ = lc - sendToOther :: (LayoutClass l a) => lc a -> l a -> SomeMessage - sendToOther _ _ = SomeMessage Hide - comboDescription :: lc a -> String - comboDescription _ = "Combine" - combineDescription :: (LayoutClass l1 a, LayoutClass l2 a) => lc a -> l1 a -> l2 a -> String - combineDescription lc l1 l2 = comboDescription lc <> description l1 <> description l2 - where "" <> x = x - x <> y = x ++ " " ++ y - -data CombinedLayout lc l1 l2 a = CombinedLayout (lc a) (l1 a) (l2 a) deriving ( Show, Read ) - -instance (LayoutClass l1 a, LayoutClass l2 a, LayoutCombinator lc a) => LayoutClass (CombinedLayout lc l1 l2) a where - doLayout (CombinedLayout lc l1 l2) r s = do - choose <- chooser lc - case choose of - DoSecond -> do (wrs, nl2) <- doLayout l2 r s - return (wrs, Just $ CombinedLayout lc l1 (fromMaybe l2 nl2)) - DoBoth -> do (wrs1, nl1) <- doLayout l1 r s - (wrs2, nl2) <- doLayout l2 r s - return (combineResult lc wrs1 wrs2 , Just $ CombinedLayout lc (fromMaybe l1 nl1) (fromMaybe l2 nl2)) - _ -> do (wrs, nl1) <- doLayout l1 r s - return (wrs, Just $ CombinedLayout lc (fromMaybe l1 nl1) l2) - emptyLayout (CombinedLayout lc l1 l2) r = do - choose <- chooser lc - case choose of - DoSecond -> do (wrs, nl2) <- emptyLayout l2 r - return (wrs, Just $ CombinedLayout lc l1 (fromMaybe l2 nl2)) - DoBoth -> do (wrs1, nl1) <- emptyLayout l1 r - (wrs2, nl2) <- emptyLayout l2 r - return (combineResult lc wrs1 wrs2 , Just $ CombinedLayout lc (fromMaybe l1 nl1) (fromMaybe l2 nl2)) - _ -> do (wrs, nl1) <- emptyLayout l1 r - return (wrs, Just $ CombinedLayout lc (fromMaybe l1 nl1) l2) - handleMessage (CombinedLayout lc l1 l2) m = do - nc <- comboHandleMess lc l1 l2 m - choose <- chooser nc - case choose of - DoFirst -> do nl1 <- handleMessage l1 m - nl2 <- handleMessage l2 (sendToOther nc l2) - return $ Just $ CombinedLayout nc (fromMaybe l1 nl1) (fromMaybe l2 nl2) - DoSecond -> do nl1 <- handleMessage l1 (sendToOther nc l1) - nl2 <- handleMessage l2 m - return $ Just $ CombinedLayout nc (fromMaybe l1 nl1) (fromMaybe l2 nl2) - DoBoth -> do nl1 <- handleMessage l1 m - nl2 <- handleMessage l2 m - return $ Just $ CombinedLayout nc (fromMaybe l1 nl1) (fromMaybe l2 nl2) - - description (CombinedLayout lc l1 l2) = combineDescription lc l1 l2 - hunk ./XMonad/Layout/PerWorkspace.hs 34 -import XMonad.Layout.LayoutCombinators +import Data.Maybe (fromMaybe) + hunk ./XMonad/Layout/PerWorkspace.hs 62 -onWorkspace :: WorkspaceId -- ^ tags of workspaces to match - -> (l1 a) -- ^ layout to use on matched workspaces - -> (l2 a) -- ^ layout to use everywhere else - -> CombinedLayout PerWorkspace l1 l2 a -onWorkspace wsId = CombinedLayout (PerWorkspace [wsId]) +onWorkspace :: (LayoutClass l1 a, LayoutClass l2 a) + => WorkspaceId -- ^ the tag of the workspace to match + -> (l1 a) -- ^ layout to use on the matched workspace + -> (l2 a) -- ^ layout to use everywhere else + -> PerWorkspace l1 l2 a +onWorkspace wsId l1 l2 = PerWorkspace [wsId] Nothing l1 l2 hunk ./XMonad/Layout/PerWorkspace.hs 71 -onWorkspaces :: [WorkspaceId] -- ^ tags of workspaces to match +onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a) + => [WorkspaceId] -- ^ tags of workspaces to match hunk ./XMonad/Layout/PerWorkspace.hs 75 - -> CombinedLayout PerWorkspace l1 l2 a -onWorkspaces wsIds = CombinedLayout (PerWorkspace wsIds) + -> PerWorkspace l1 l2 a +onWorkspaces wsIds l1 l2 = PerWorkspace wsIds Nothing l1 l2 hunk ./XMonad/Layout/PerWorkspace.hs 86 -data PerWorkspace a = PerWorkspace [WorkspaceId] deriving (Read, Show) +data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId] + (Maybe Bool) + (l1 a) + (l2 a) + deriving (Read, Show) + +instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (PerWorkspace l1 l2) a where hunk ./XMonad/Layout/PerWorkspace.hs 94 -instance LayoutCombinator PerWorkspace a where - chooser (PerWorkspace wsIds) = do + -- do layout with l1, then return a modified PerWorkspace caching + -- the fact that we're in the matched workspace. + doLayout p@(PerWorkspace _ (Just True) lt _) r s = do + (wrs, mlt') <- doLayout lt r s + return (wrs, Just $ mkNewPerWorkspaceT p mlt') + + -- do layout with l1, then return a modified PerWorkspace caching + -- the fact that we're not in the matched workspace. + doLayout p@(PerWorkspace _ (Just False) _ lf) r s = do + (wrs, mlf') <- doLayout lf r s + return (wrs, Just $ mkNewPerWorkspaceF p mlf') + + -- figure out which layout to use based on the current workspace. + doLayout (PerWorkspace wsIds Nothing l1 l2) r s = do hunk ./XMonad/Layout/PerWorkspace.hs 109 - return $ if t `elem` wsIds then DoFirst else DoSecond + doLayout (PerWorkspace wsIds (Just $ t `elem` wsIds) l1 l2) r s + + -- handle messages; same drill as doLayout. + handleMessage p@(PerWorkspace _ (Just True) lt _) m = do + mlt' <- handleMessage lt m + return . Just $ mkNewPerWorkspaceT p mlt' + + handleMessage p@(PerWorkspace _ (Just False) _ lf) m = do + mlf' <- handleMessage lf m + return . Just $ mkNewPerWorkspaceF p mlf' + + handleMessage (PerWorkspace _ Nothing _ _) _ = return Nothing + + description (PerWorkspace _ (Just True ) l1 _) = description l1 + description (PerWorkspace _ (Just False) _ l2) = description l2 + + -- description's result is not in the X monad, so we have to wait + -- until a doLayout for the information about which workspace + -- we're in to get cached. + description _ = "PerWorkspace" + +-- | Construct new PerWorkspace values with possibly modified layouts. +mkNewPerWorkspaceT :: PerWorkspace l1 l2 a -> Maybe (l1 a) -> + PerWorkspace l1 l2 a +mkNewPerWorkspaceT (PerWorkspace wsIds b lt lf) mlt' = + (\lt' -> PerWorkspace wsIds b lt' lf) $ fromMaybe lt mlt' + +mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) -> + PerWorkspace l1 l2 a +mkNewPerWorkspaceF (PerWorkspace wsIds b lt lf) mlf' = + (\lf' -> PerWorkspace wsIds b lt lf') $ fromMaybe lf mlf' hunk ./XMonad/Layout/Decoration.hs 27 - , fi + , isDecoration, fi hunk ./XMonad/Layout/Decoration.hs 218 +isDecoration :: Window -> X Bool +isDecoration w = withDisplay (io . flip getWindowAttributes w) >>= return . wa_override_redirect + hunk ./XMonad/Layout/LayoutHints.hs 24 - +import XMonad.Layout.Decoration ( isDecoration ) hunk ./XMonad/Layout/LayoutHints.hs 57 - applyHint bW (w,Rectangle a b c d) = + applyHint bW (w,r@(Rectangle a b c d)) = hunk ./XMonad/Layout/LayoutHints.hs 59 - sh <- io $ getWMNormalHints disp w + isd <- isDecoration w + sh <- io $ getWMNormalHints disp w hunk ./XMonad/Layout/LayoutHints.hs 62 - return (w, Rectangle a b c' d') + return (w, if isd then r else Rectangle a b c' d') hunk ./XMonad/Actions/Search.hs 31 + -- * Tip + -- $tip + hunk ./XMonad/Actions/Search.hs 85 +-} + +{- $tip + +In combination with "XMonad.Actions.Submap" you can create a powerfull +and easy way to search without adding a whole bunch of bindings: + +First import the necessary modules: + +@ +import qualified XMonad.Prompt as P +import qualified XMonad.Actions.Submap as SM +import qualified XMonad.Actions.Search as S +@ + +Then add the following to your key bindings: hunk ./XMonad/Actions/Search.hs 102 +@ + -- Search commands + , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.defaultXPConfig) + , ((modm .|. shiftMask, xK_s), SM.submap $ searchEngineMap $ S.selectSearch) +@ + +where: + +@ + searchEngineMap method = M.fromList $ + [ ((0, xK_g), method \"firefox\" S.google) + , ((0, xK_h), method \"firefox\" S.hoogle) + , ((0, xK_w), method \"firefox\" S.wikipedia) + ] +@ + +Make sure to set firefox to open new pages in a new window instead of in a new tab: +Firefox -> Edit -> Preferences -> Tabs -> New pages should be opened in... + +Now /modm-s g/ \/ /h/ \/ /w/ prompts you for a search string, then opens a new +firefox window that performs the search on Google, Hoogle or +Wikipedia respectively. + +If you select something in whatever application and hit /modm-shift-s g/ \/ /h/ \/ /w/ +it will search the selected string with the specified engine. + +Happy searching! hunk ./XMonad/Actions/Search.hs 214 + hunk ./XMonad/Actions/Search.hs 11 - Modeled after the handy Surfraw CLI search tools + Modeled after the handy Surfraw CLI search tools at hunk ./XMonad/Actions/Search.hs 17 - -- $usage + -- $usage hunk ./XMonad/Actions/Search.hs 31 - -- * Tip + + -- * Use case: searching with a submap hunk ./XMonad/Actions/Search.hs 90 -In combination with "XMonad.Actions.Submap" you can create a powerfull -and easy way to search without adding a whole bunch of bindings: +In combination with "XMonad.Actions.Submap" you can create a powerful +and easy way to search without adding a whole bunch of bindings. hunk ./XMonad/Actions/Search.hs 95 -@ -import qualified XMonad.Prompt as P -import qualified XMonad.Actions.Submap as SM -import qualified XMonad.Actions.Search as S -@ +> import qualified XMonad.Prompt as P +> import qualified XMonad.Actions.Submap as SM +> import qualified XMonad.Actions.Search as S hunk ./XMonad/Actions/Search.hs 101 -@ - -- Search commands - , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.defaultXPConfig) - , ((modm .|. shiftMask, xK_s), SM.submap $ searchEngineMap $ S.selectSearch) -@ - -where: - -@ - searchEngineMap method = M.fromList $ - [ ((0, xK_g), method \"firefox\" S.google) - , ((0, xK_h), method \"firefox\" S.hoogle) - , ((0, xK_w), method \"firefox\" S.wikipedia) - ] -@ +> -- Search commands +> , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.defaultXPConfig) +> , ((modm .|. shiftMask, xK_s), SM.submap $ searchEngineMap $ S.selectSearch) +> +> ... +> +> searchEngineMap method = M.fromList $ +> [ ((0, xK_g), method \"firefox\" S.google) +> , ((0, xK_h), method \"firefox\" S.hoogle) +> , ((0, xK_w), method \"firefox\" S.wikipedia) +> ] hunk ./XMonad/Actions/Search.hs 113 -Make sure to set firefox to open new pages in a new window instead of in a new tab: -Firefox -> Edit -> Preferences -> Tabs -> New pages should be opened in... +Make sure to set firefox to open new pages in a new window instead of +in a new tab: @Firefox -> Edit -> Preferences -> Tabs -> New pages +should be opened in...@ hunk ./XMonad/Actions/Search.hs 117 -Now /modm-s g/ \/ /h/ \/ /w/ prompts you for a search string, then opens a new -firefox window that performs the search on Google, Hoogle or -Wikipedia respectively. +Now /mod-s/ + /g/\//h/\//w/ prompts you for a search string, then +opens a new firefox window that performs the search on Google, Hoogle +or Wikipedia respectively. hunk ./XMonad/Actions/Search.hs 121 -If you select something in whatever application and hit /modm-shift-s g/ \/ /h/ \/ /w/ -it will search the selected string with the specified engine. +If you select something in whatever application and hit /mod-shift-s/ + +/g/\//h/\//w/ it will search the selected string with the specified +engine. hunk ./XMonad/Hooks/DynamicLog.hs 271 - , ppSort = getSortByTag + , ppSort = getSortByIndex hunk ./XMonad/Hooks/DynamicLog.hs 308 - , ppTitle = shorten 65 + , ppTitle = shorten 70 hunk ./XMonad/Hooks/DynamicLog.hs 311 - where showNamedWorkspaces wsId = if (':' `elem` wsId) + where showNamedWorkspaces wsId = if any (`elem` wsId) ['a'..'z'] hunk ./XMonad/Hooks/EwmhDesktops.hs 41 --- +-- hunk ./XMonad/Hooks/EwmhDesktops.hs 46 --- | +-- | hunk ./XMonad/Hooks/EwmhDesktops.hs 51 - sort' <- getSortByTag + sort' <- getSortByIndex hunk ./XMonad/Hooks/EwmhDesktops.hs 65 - + hunk ./XMonad/Hooks/EwmhDesktops.hs 73 - forM_ (W.current s : W.visible s) $ \x -> + forM_ (W.current s : W.visible s) $ \x -> hunk ./XMonad/Hooks/EwmhDesktops.hs 77 - forM_ (W.hidden s) $ \w -> + forM_ (W.hidden s) $ \w -> hunk ./XMonad/Util/WorkspaceCompare.hs 12 -module XMonad.Util.WorkspaceCompare ( getWsIndex +module XMonad.Util.WorkspaceCompare ( WorkspaceCompare, WorkspaceSort + , getWsIndex hunk ./XMonad/Util/WorkspaceCompare.hs 15 + , getWsCompareByTag + , getXineramaWsCompare + , mkWsSort + , getSortByIndex hunk ./XMonad/Util/WorkspaceCompare.hs 29 +type WorkspaceCompare = WorkspaceId -> WorkspaceId -> Ordering +type WorkspaceSort = [WindowSpace] -> [WindowSpace] + hunk ./XMonad/Util/WorkspaceCompare.hs 39 --- | A comparison function for WorkspaceId -getWsCompare :: X (WorkspaceId -> WorkspaceId -> Ordering) +-- | A comparison function for WorkspaceId, based on the index of the +-- tags in the user's config. +getWsCompare :: X WorkspaceCompare hunk ./XMonad/Util/WorkspaceCompare.hs 51 --- | A comparison function for Xinerama based on visibility, workspace and --- screen id. It produces same ordering as pprWindowSetXinerama does. -getXineramaWsCompare :: X(WorkspaceId -> WorkspaceId -> Ordering) +-- | A simple comparison function that orders workspaces +-- lexicographically by tag. +getWsCompareByTag :: X WorkspaceCompare +getWsCompareByTag = return compare + +-- | A comparison function for Xinerama based on visibility, workspace +-- and screen id. It produces the same ordering as +-- 'XMonad.Hooks.DynamicLog.pprWindowSetXinerama'. +getXineramaWsCompare :: X WorkspaceCompare hunk ./XMonad/Util/WorkspaceCompare.hs 71 - --S.screen $ head $ filter ((== x) . S.tag . S.workspace) s hunk ./XMonad/Util/WorkspaceCompare.hs 72 --- | 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)) +-- | Create a workspace sorting function from a workspace comparison +-- function. +mkWsSort :: X WorkspaceCompare -> X WorkspaceSort +mkWsSort cmpX = do + cmp <- cmpX + return $ sortBy (\a b -> cmp (S.tag a) (S.tag b)) + +-- | Sort several workspaces according to their tags' indices in the +-- user's config. +getSortByIndex :: X WorkspaceSort +getSortByIndex = mkWsSort getWsCompare + +-- | Sort workspaces lexicographically by tag. +getSortByTag :: X WorkspaceSort +getSortByTag = mkWsSort getWsCompareByTag hunk ./XMonad/Util/WorkspaceCompare.hs 88 --- | Sort serveral workspaces for xinerama displays -getSortByXineramaRule :: X ([WindowSpace] -> [WindowSpace]) -getSortByXineramaRule = do - cmp <- getXineramaWsCompare - return $ sortBy (\a b -> cmp (S.tag a) (S.tag b)) +-- | Sort serveral workspaces for xinerama displays, in the same order +-- produced by 'XMonad.Hooks.DynamicLog.pprWindowSetXinerama': first +-- visible workspaces, sorted by screen, then hidden workspaces, +-- sorted by tag. +getSortByXineramaRule :: X WorkspaceSort +getSortByXineramaRule = mkWsSort getXineramaWsCompare hunk ./XMonad/Actions/CycleWS.hs 12 --- Provides bindings to cycle forward or backward through the list --- of workspaces, and to move windows there, and to cycle between the screens. +-- Provides bindings to cycle forward or backward through the list of +-- workspaces, to move windows between workspaces, and to cycle +-- between screens. More general combinators provide ways to cycle +-- through workspaces in various orders, to only cycle through some +-- subset of workspaces, and to cycle by more than one workspace at a +-- time. +-- +-- Note that this module now subsumes the functionality of +-- "XMonad.Actions.RotView". To wit, 'XMonad.Actions.RotView.rotView' +-- can be implemented in terms of "XMonad.Actions.CycleWS" functions as +-- +-- > rotView b = do t <- findWorkspace getSortByTag (bToDir b) NonEmptyWS 1 +-- > windows . greedyView $ t +-- > where bToDir True = Next +-- > bToDir False = Prev +-- +-- Of course, usually one would want to use +-- 'XMonad.Util.WorkspaceCompare.getSortByIndex' instead of +-- 'XMonad.Util.WorkspaceCompare.getSortByTag', to cycle through the +-- workspaces in the order in which they are listed in your config, +-- instead of alphabetical order (as is the default in +-- 'XMonad.Actions.RotView.rotView'). In this case one can simply use +-- @moveTo Next NonEmptyWS@ and @moveTo Prev NonEmptyWS@ in place of +-- @rotView True@ and @rotView False@, respectively. hunk ./XMonad/Actions/CycleWS.hs 40 - -- * Usage - -- $usage - nextWS, - prevWS, - shiftToNext, - shiftToPrev, - toggleWS, - nextScreen, - prevScreen, - shiftNextScreen, - shiftPrevScreen + -- * Usage + -- $usage + + -- * Moving between workspaces + -- $moving + + nextWS + , prevWS + , shiftToNext + , shiftToPrev + , toggleWS + + -- * Moving between screens (xinerama) + + , nextScreen + , prevScreen + , shiftNextScreen + , shiftPrevScreen + + -- * Moving between workspaces, take two! + -- $taketwo + + , WSDirection(..) + , WSType(..) + + , shiftTo + , moveTo + + -- * The mother-combinator + + , findWorkspace + hunk ./XMonad/Actions/CycleWS.hs 75 -import Data.Maybe ( fromMaybe ) +import Data.Maybe ( isNothing, isJust ) hunk ./XMonad/Actions/CycleWS.hs 85 --- +-- > +-- > -- a basic CycleWS setup +-- > hunk ./XMonad/Actions/CycleWS.hs 103 +-- You can also get fancier with 'moveTo', 'shiftTo', and 'findWorkspace'. +-- For example: +-- +-- > , ((modMask x , xK_f), moveTo Next EmptyWS) -- find a free workspace +-- > , ((modMask x .|. controlMask, xK_Right), -- a crazy keybinding! +-- > do t <- findWorkspace getXineramaWsCompare Next NonEmptyWS 2 +-- > windows . view $ t ) +-- hunk ./XMonad/Actions/CycleWS.hs 114 +{- $moving + +The following commands for moving the view and windows between +workspaces are somewhat inflexible, but are very simple and probably +Do The Right Thing for most users. + +All of the commands in this section cycle through workspaces in the +order in which they are given in your config. hunk ./XMonad/Actions/CycleWS.hs 123 --- | Switch to next workspace +-} + +-- | Switch to the next workspace. hunk ./XMonad/Actions/CycleWS.hs 129 --- | Switch to previous workspace +-- | Switch to the previous workspace. hunk ./XMonad/Actions/CycleWS.hs 133 --- | Move focused window to next workspace +-- | Move the focused window to the next workspace. hunk ./XMonad/Actions/CycleWS.hs 137 --- | Move focused window to previous workspace +-- | Move the focused window to the previous workspace. hunk ./XMonad/Actions/CycleWS.hs 141 --- | Toggle to the workspace displayed previously +-- | Toggle to the workspace displayed previously. hunk ./XMonad/Actions/CycleWS.hs 152 -wsBy d = do - ws <- gets windowset - sort' <- getSortByTag - let orderedWs = sort' (workspaces ws) - let now = fromMaybe 0 $ findWsIndex (workspace (current ws)) orderedWs - let next = orderedWs !! ((now + d) `mod` length orderedWs) +wsBy = findWorkspace getSortByIndex Next AnyWS + +{- $taketwo + +A few more general commands are also provided, which allow cycling +through subsets of workspaces. + +For example, + +> moveTo Next EmptyWS + +will move to the first available workspace with no windows, and + +> shiftTo Prev (WSIs $ return (('p' `elem`) . tag)) + +will move the focused window backwards to the first workspace containing +the letter 'p' in its name. =) + +-} + +-- | Direction to cycle through the sort order. +data WSDirection = Next | Prev + +-- | What type of workspaces should be included in the cycle? +data WSType = EmptyWS -- ^ cycle through empty workspaces + | NonEmptyWS -- ^ cycle through non-empty workspaces + | AnyWS -- ^ cycle through all workspaces + | WSIs (X (WindowSpace -> Bool)) + -- ^ cycle through workspaces satisfying + -- an arbitrary predicate + +-- | Convert a WSType value to a predicate on workspaces. +wsTypeToPred :: WSType -> X (WindowSpace -> Bool) +wsTypeToPred EmptyWS = return (isNothing . stack) +wsTypeToPred NonEmptyWS = return (isJust . stack) +wsTypeToPred AnyWS = return (const True) +wsTypeToPred (WSIs p) = p + +-- | View the next workspace in the given direction that satisfies +-- the given condition. +moveTo :: WSDirection -> WSType -> X () +moveTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . greedyView + +-- | Move the currently focused window to the next workspace in the +-- given direction that satisfies the given condition. +shiftTo :: WSDirection -> WSType -> X () +shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift + +-- | Given a function @s@ to sort workspaces, a direction @dir@, a +-- predicate @p@ on workspaces, and an integer @n@, find the tag of +-- the workspace which is @n@ away from the current workspace in +-- direction @dir@ (wrapping around if necessary), among those +-- workspaces, sorted by @s@, which satisfy @p@. +-- +-- For some useful workspace sorting functions, see +-- "XMonad.Util.WorkspaceCompare". +-- +-- For ideas of what to do with a workspace tag once obtained, note +-- that 'moveTo' and 'shiftTo' are implemented by applying @(>>= +-- windows . greedyView)@ and @(>>= windows . shift)@, respectively, +-- to the output of 'findWorkspace'. +findWorkspace :: X WorkspaceSort -> WSDirection -> WSType -> Int -> X WorkspaceId +findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n) + where + maybeNegate Next d = d + maybeNegate Prev d = (-d) + +findWorkspaceGen :: X WorkspaceSort -> X (WindowSpace -> Bool) -> Int -> X WorkspaceId +findWorkspaceGen _ _ 0 = (tag . workspace . current) `fmap` gets windowset +findWorkspaceGen sortX wsPredX d = do + wsPred <- wsPredX + sort <- sortX + ws <- gets windowset + let cur = workspace (current ws) + sorted = sort (workspaces ws) + pivoted = let (a,b) = span ((/= (tag cur)) . tag) sorted in b ++ a + ws' = filter wsPred $ pivoted + mCurIx = findWsIndex cur ws' + d' = if d > 0 then d - 1 else d + next = if null ws' + then cur + else case mCurIx of + Nothing -> ws' !! (d' `mod` length ws') + Just ix -> ws' !! ((ix + d) `mod` length ws') hunk ./XMonad/Actions/RotView.hs 29 +-- +-- NOTE: This module is deprecated; see "XMonad.Actions.CycleWS". hunk ./XMonad/Actions/RotView.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonad.Actions.RotView --- Copyright : (c) David Roundy --- License : BSD3-style (see LICENSE) --- --- Maintainer : David Roundy --- Stability : unstable --- Portability : unportable --- --- Provides bindings to cycle through non-empty workspaces. --- ------------------------------------------------------------------------------ - -module XMonad.Actions.RotView ( - -- * Usage - -- $usage - rotView - ) where - -import Data.List ( sortBy, find ) -import Data.Maybe ( isJust ) -import Data.Ord ( comparing ) - -import XMonad -import XMonad.StackSet hiding (filter) - --- $usage --- --- NOTE: This module is deprecated; see "XMonad.Actions.CycleWS". --- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Actions.RotView --- --- Then add appropriate key bindings, such as: --- --- > , ((modMask x .|. shiftMask, xK_Right), rotView True) --- > , ((modMask x .|. shiftMask, xK_Left), rotView False) --- --- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". - --- | Cycle through non-empty workspaces. True --> cycle in the forward --- direction. Note that workspaces cycle in order by tag, so if your --- workspaces are not in tag-order, the cycling might seem wonky. -rotView :: Bool -> X () -rotView forward = do - ws <- gets windowset - let currentTag = tag . workspace . current $ ws - sortWs = sortBy (comparing tag) - isNotEmpty = isJust . stack - sorted = sortWs (hidden ws) - pivoted = let (a,b) = span ((< currentTag) . tag) sorted in b ++ a - pivoted' | forward = pivoted - | otherwise = reverse pivoted - nextws = find isNotEmpty pivoted' - whenJust nextws (windows . view . tag) rmfile ./XMonad/Actions/RotView.hs hunk ./XMonad/Actions/CycleWS.hs 19 --- Note that this module now subsumes the functionality of --- "XMonad.Actions.RotView". To wit, 'XMonad.Actions.RotView.rotView' --- can be implemented in terms of "XMonad.Actions.CycleWS" functions as +-- Note that this module now subsumes the functionality of the former +-- @XMonad.Actions.RotView@. Former users of @rotView@ can simply replace +-- @rotView True@ with @moveTo Next NonEmptyWS@, and so on. +-- +-- If you want to exactly replicate the action of @rotView@ (cycling +-- through workspace in order lexicographically by tag, instead of in +-- the order specified in the config), it can be implemented as: hunk ./XMonad/Actions/CycleWS.hs 32 --- Of course, usually one would want to use --- 'XMonad.Util.WorkspaceCompare.getSortByIndex' instead of --- 'XMonad.Util.WorkspaceCompare.getSortByTag', to cycle through the --- workspaces in the order in which they are listed in your config, --- instead of alphabetical order (as is the default in --- 'XMonad.Actions.RotView.rotView'). In this case one can simply use --- @moveTo Next NonEmptyWS@ and @moveTo Prev NonEmptyWS@ in place of --- @rotView True@ and @rotView False@, respectively. --- hunk ./XMonad/Actions/CycleWS.hs 206 --- windows . greedyView)@ and @(>>= windows . shift)@, respectively, +-- (windows . greedyView))@ and @(>>= (windows . shift))@, respectively, hunk ./XMonad/Config/Droundy.hs 42 -import XMonad.Actions.RotView +import XMonad.Actions.CycleWS hunk ./XMonad/Config/Droundy.hs 86 - , ((modMask x .|. shiftMask, xK_Right), rotView True) - , ((modMask x .|. shiftMask, xK_Left), rotView False) + , ((modMask x .|. shiftMask, xK_Right), moveTo Next NonEmptyWS) + , ((modMask x .|. shiftMask, xK_Left), moveTo Prev NonEmptyWS) hunk ./XMonad/Doc/Extending.hs 152 - -* "XMonad.Actions.RotView": cycle through non-empty workspaces. hunk ./xmonad-contrib.cabal 77 - XMonad.Actions.RotView hunk ./XMonad/Actions/CycleWS.hs 91 --- > , ((modMask x, xK_t), toggleWS) +-- > , ((modMask x, xK_z), toggleWS) hunk ./XMonad/Layout/Tabbed.hs 34 +import XMonad.Layout.Simplest ( Simplest(Simplest) ) hunk ./XMonad/Layout/Tabbed.hs 61 - -> ModifiedLayout (Decoration TabbedDecoration s) Full a -tabbed s c = decoration s c Tabbed Full + -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a +tabbed s c = decoration s c Tabbed Simplest hunk ./XMonad/Layout/Decoration.hs 136 - insert_dwr ((w,r),(dw,Just dr)) xs = (dw,dr):(w, shrink ds dr r):xs - insert_dwr (x ,(_ ,Nothing)) xs = x:xs + -- We drop any windows that are *precisely* stacked underneath + -- another window: these must be intended to be tabbed! + insert_dwr otherRs (((w,r),(dw,Just dr)):zzz) + | r `elem` otherRs = (dw,dr):insert_dwr otherRs zzz + | otherwise = (dw,dr):(w, shrink ds dr r):insert_dwr (r:otherRs) zzz + insert_dwr otherRs (((w,r),(_ ,Nothing)):zzz) = (w,r):insert_dwr (r:otherRs) zzz + insert_dwr _ [] = [] hunk ./XMonad/Layout/Decoration.hs 155 - return (foldr insert_dwr [] ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh c ds)) + return (insert_dwr [] ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh c ds)) hunk ./XMonad/Layout/Decoration.hs 179 + | ButtonEvent {ev_window = w,ev_event_type = t} <- e, + t == buttonPress, + Just ((mainw,_),_) <- lookFor w dwrs = focus mainw hunk ./XMonad/Layout/Decoration.hs 184 +lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,DecoWin) +lookFor w ((x,(w',y)):zs) | w == w' = Just (x,(w',y)) + | otherwise = lookFor w zs +lookFor _ [] = Nothing + hunk ./XMonad/Config/Droundy.hs 46 +import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsLogHook ) hunk ./XMonad/Config/Droundy.hs 143 + , manageHook = manageHook defaultConfig <+> manageDocks -- add panel-handling + , logHook = ewmhDesktopsLogHook -- actually, no logging here, just other stuff addfile ./XMonad/Actions/WindowGo.hs hunk ./XMonad/Actions/WindowGo.hs 1 +{- -------------------------------------------------------------------------- +| +Module : XMonad.Actions.WindowGo +License : Public domain + +Maintainer : +Stability : unstable +Portability : unportable + +Defines a few simple operations for raising windows based on XMonad's Query +Monad, such as runOrRaise. + +----------------------------------------------------------------------------- -} + +module XMonad.Actions.WindowGo ( + -- * Usage + -- $usage + raise, + runOrRaise, + raiseMaybe, + module XMonad.ManageHook + ) where + +import XMonad (Query(), X(), withWindowSet, spawn, runQuery, focus) +import Control.Monad (filterM) +import qualified XMonad.StackSet as W (allWindows) +import XMonad.ManageHook + +-- $usage +-- +-- Import the module into your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.WindowGo +-- +-- and define appropriate key bindings: +-- +-- > , ((modMask x .|. shiftMask, xK_g ), raise (className =? "Firefox-bin")) +-- > , ((modMask x .|. shiftMask, xK_b ), runOrRaise "mozilla-firefox" (className =? "Firefox-bin")) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | 'action' is an executable to be run via 'spawn' if the Window cannot be found. +-- Presumably this executable is the same one that you were looking for. +runOrRaise :: String -> Query Bool -> X () +runOrRaise action = raiseMaybe $ spawn action + +-- | See 'raiseMaybe'. If the Window can't be found, quietly give up and do nothing. +raise :: Query Bool -> X () +raise = raiseMaybe $ return () + +{- | raiseMaybe: this queries all Windows based on a boolean provided by the + user. Currently, there are three such useful booleans defined in + XMonad.ManageHook: title, resource, className. Each one tests based pretty + much as you would think. ManageHook also defines several operators, the most + useful of which is (=?). So a useful test might be finding a Window whose + class is Firefox. Firefox declares the class "Firefox-bin", so you'd want to + pass in a boolean like '(className =? "Firefox-bin")'. + If the boolean returns True on one or more windows, then XMonad will quickly + make visible the first result. If no Window meets the criteria, then the + first argument comes into play. + + The first argument is an arbitrary IO function which will be executed if the + tests fail. This is what enables runOrRaise to use raiseMaybe: it simply runs + the desired program if it isn't found. But you don't have to do that. Maybe + you want to do nothing if the search fails (the definition of 'raise'), or + maybe you want to write to a log file, or call some prompt function, or + something crazy like that. This hook gives you that flexibility. +-} +raiseMaybe :: X () -> Query Bool -> X () +raiseMaybe f thatUserQuery = withWindowSet $ \s -> do + maybeResult <- filterM (runQuery thatUserQuery) (W.allWindows s) + case maybeResult of + [] -> f + (x:_) -> focus x hunk ./xmonad-contrib.cabal 84 + XMonad.Actions.WindowGo hunk ./XMonad/Layout/WindowNavigation.hs 125 - wrs' = filter ((/=w) . fst) wrs + wrs' = filter ((/=r) . snd) $ filter ((/=w) . fst) wrs hunk ./XMonad/Config/Droundy.hs 9 -module XMonad.Config.Droundy ( config, mytab ) where +module XMonad.Config.Droundy ( config ) where hunk ./XMonad/Config/Droundy.hs 24 +import XMonad.Layout.Simplest hunk ./XMonad/Config/Droundy.hs 36 +import XMonad.Layout.ShowWName ( showWName ) hunk ./XMonad/Config/Droundy.hs 137 - , layoutHook = workspaceDir "~" $ windowNavigation $ + , layoutHook = addTabs CustomShrink defaultTheme $ showWName $ workspaceDir "~" $ + windowNavigation $ hunk ./XMonad/Config/Droundy.hs 140 - 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) -- ||| + named "tabbed" (noBorders Simplest) ||| + named "xclock" (Simplest ****//* combineTwo Square Simplest Simplest) ||| + named "three" (Simplest **//* Simplest *//* combineTwo Square Simplest Simplest) ||| + named "widescreen" ((Simplest *||* Simplest) + ****//* combineTwo Square Simplest Simplest) -- ||| hunk ./XMonad/Config/Droundy.hs 155 -mytab = tabbed CustomShrink defaultTheme - hunk ./XMonad/Layout/Tabbed.hs 20 - tabbed + tabbed, addTabs hunk ./XMonad/Layout/Tabbed.hs 64 +addTabs :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a + -> ModifiedLayout (Decoration TabbedDecoration s) l a +addTabs s c l = decoration s c Tabbed l + hunk ./XMonad/Layout/Tabbed.hs 72 - decorateFirst _ = False - pureDecoration _ _ ht (Rectangle x y wh _) s wrs (w,_) = Just $ Rectangle nx y nwh (fi ht) - where nwh = wh `div` max 1 (fi $ length wrs) - nx = case w `elemIndex` (S.integrate s) of + decorateFirst _ = True + pureDecoration _ _ ht _ s wrs (w,r@(Rectangle x y wh _)) = + if length wrs' <= 1 then Nothing + else Just $ Rectangle nx y nwh (fi ht) + where wrs' = filter ((==r) . snd) wrs + ws = map fst wrs' + nwh = wh `div` max 1 (fi $ length wrs') + nx = case elemIndex w $ filter (`elem` ws) (S.integrate s) of hunk ./XMonad/Layout/WindowNavigation.hs 108 - redoLayout (WindowNavigation conf (I state)) rscr s wrs = + redoLayout (WindowNavigation conf (I state)) rscr s origwrs = hunk ./XMonad/Layout/WindowNavigation.hs 121 - r = case filter ((==w).fst) wrs of ((_,x):_) -> x - [] -> rscr + r = case filter ((==w).fst) origwrs of ((_,x):_) -> x + [] -> rscr hunk ./XMonad/Layout/WindowNavigation.hs 125 - wrs' = filter ((/=r) . snd) $ filter ((/=w) . fst) wrs + existing_wins = W.integrate s + wrs = filter ((`elem` existing_wins) . fst) $ filter ((/=r) . snd) $ + filter ((/=w) . fst) origwrs hunk ./XMonad/Layout/WindowNavigation.hs 129 - (\d -> truncHead $ sortby d $ filter (inr d pt . snd) wrs') [U,D,R,L] + (\d -> truncHead $ sortby d $ filter (inr d pt . snd) wrs) [U,D,R,L] hunk ./XMonad/Layout/WindowNavigation.hs 132 - truncHead $ sortby d $ filter (inr d pt . snd) wrs') [U,D,R,L] + truncHead $ sortby d $ filter (inr d pt . snd) wrs) [U,D,R,L] hunk ./XMonad/Layout/WindowNavigation.hs 137 - return (wrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable) + return (origwrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable) hunk ./XMonad/Config/Droundy.hs 9 -module XMonad.Config.Droundy ( config ) where +module XMonad.Config.Droundy ( config, mytab ) where hunk ./XMonad/Config/Droundy.hs 24 -import XMonad.Layout.Simplest hunk ./XMonad/Config/Droundy.hs 35 -import XMonad.Layout.ShowWName ( showWName ) +import XMonad.Layout.ShowWName hunk ./XMonad/Config/Droundy.hs 136 - , layoutHook = addTabs CustomShrink defaultTheme $ showWName $ workspaceDir "~" $ - windowNavigation $ + , layoutHook = showWName $ workspaceDir "~" $ windowNavigation $ hunk ./XMonad/Config/Droundy.hs 138 - named "tabbed" (noBorders Simplest) ||| - named "xclock" (Simplest ****//* combineTwo Square Simplest Simplest) ||| - named "three" (Simplest **//* Simplest *//* combineTwo Square Simplest Simplest) ||| - named "widescreen" ((Simplest *||* Simplest) - ****//* combineTwo Square Simplest Simplest) -- ||| + 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) -- ||| hunk ./XMonad/Config/Droundy.hs 153 +mytab = tabbed CustomShrink defaultTheme + hunk ./XMonad/Prompt/Workspace.hs 21 -import Data.List ( sort ) hunk ./XMonad/Prompt/Workspace.hs 24 +import XMonad.Util.WorkspaceCompare ( getSortByIndex ) hunk ./XMonad/Prompt/Workspace.hs 44 - let ts = sort $ map tag ws + sort <- getSortByIndex + let ts = map tag $ sort ws hunk ./XMonad/Prompt.hs 466 - bgcolor <- io $ initColor d (bgColor c) - border <- io $ initColor d (borderColor c) + Just bgcolor <- io $ initColor d (bgColor c) + Just border <- io $ initColor d (borderColor c) hunk ./XMonad/Prompt.hs 572 - bgcolor <- io $ initColor d (bgColor c) - border <- io $ initColor d (borderColor c) + Just bgcolor <- io $ initColor d (bgColor c) + Just border <- io $ initColor d (borderColor c) hunk ./XMonad/Util/Font.cpphs 34 +import Control.Applicative +import Data.Maybe hunk ./XMonad/Util/Font.cpphs 54 -stringToPixel :: MonadIO m => Display -> String -> m Pixel -stringToPixel d s = liftIO $ catch getIt fallBack +stringToPixel :: (Functor m, MonadIO m) => Display -> String -> m Pixel +stringToPixel d s = fromMaybe fallBack <$> liftIO getIt hunk ./XMonad/Util/Font.cpphs 57 - fallBack = const $ return $ blackPixel d (defaultScreen d) + fallBack = blackPixel d (defaultScreen d) hunk ./XMonad/Layout/SimpleFloat.hs 12 --- A very simple layout. The simplest, afaik. +-- A basic floating layout. addfile ./XMonad/Util/Themes.hs hunk ./XMonad/Util/Themes.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Themes +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A (hopefully) growing collection of themes for xmonad +-- +----------------------------------------------------------------------------- + +module XMonad.Util.Themes + ( -- * Usage + -- $usage + listOfThemes + , xmonadTheme + , smallClean + , ThemeInfo (..) + ) where + +import XMonad.Layout.Decoration + +-- $usage +-- This module stores some user contributed themes. If you have a theme +-- you would like to share, adding it to this module is very easy. +-- +-- You can use 'xmonadTheme' or 'smallClean' as a template. +-- +-- At the present time only the 'themeName' field is used. But please +-- provide all the other information, which will be used at a later +-- time. +-- +-- Please, remember to add your theme to the list of exported +-- functions, and to the 'listOfThemes'. +-- +-- Thanks for your contribution! + +data ThemeInfo = + TI { themeName :: String + , themeAuthor :: String + , themeDescription :: String + , theme :: Theme + } + +newTheme :: ThemeInfo +newTheme = TI "" "" "" defaultTheme + +listOfThemes :: [ThemeInfo] +listOfThemes = [ xmonadTheme + , smallClean + , deiflTheme + ] + +xmonadTheme :: ThemeInfo +xmonadTheme = + newTheme { themeName = "xmonadTheme" + , themeAuthor = "David Roundy" + , themeDescription = "The default xmonad theme" + , theme = defaultTheme + } + +smallClean :: ThemeInfo +smallClean = + newTheme { themeName = "smallClean" + , themeAuthor = "Andrea Rossato" + , themeDescription = "Small decorations with a Ion3 remembrance" + , theme = defaultTheme { activeColor = "#8a999e" + , inactiveColor = "#545d75" + , activeBorderColor = "white" + , inactiveBorderColor = "grey" + , activeTextColor = "white" + , inactiveTextColor = "grey" + , decoHeight = 14 + } + } + +deiflTheme :: ThemeInfo +deiflTheme = + newTheme { themeName = "deiflTheme" + , themeAuthor = "deiflTheme" + , themeDescription = "deiflTheme" + , theme = defaultTheme { inactiveBorderColor = "#708090" + , activeBorderColor = "#5f9ea0" + , activeColor = "#000000" + , inactiveColor = "#333333" + , inactiveTextColor = "#888888" + , activeTextColor = "#87cefa" + , fontName = "-xos4-terminus-*-*-*-*-12-*-*-*-*-*-*-*" + , decoHeight = 15 + } + } hunk ./xmonad-contrib.cabal 158 + XMonad.Util.Themes hunk ./xmonad-contrib.cabal 139 + XMonad.Prompt.AppendFile + XMonad.Prompt.Input + XMonad.Prompt.Email hunk ./xmonad-contrib.cabal 149 - XMonad.Prompt.AppendFile - XMonad.Prompt.Input - XMonad.Prompt.Email hunk ./XMonad/Layout/Decoration.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable hunk ./XMonad/Layout/Decoration.hs 24 + , DecorationMsg (..) hunk ./XMonad/Layout/Decoration.hs 84 +data DecorationMsg = SetTheme Theme deriving ( Typeable ) +instance Message DecorationMsg + hunk ./XMonad/Layout/Decoration.hs 118 - | decorate_first = do whenIJust st $ \s -> do - deleteWindows (getDWs $ decos s) - releaseXMF (font s) + | decorate_first = do whenIJust st releaseResources hunk ./XMonad/Layout/Decoration.hs 161 - | Just e <- fromMessage m :: Maybe Event = handleEvent sh c s e >> return Nothing - | Just Hide <- fromMessage m = hideWindows dws >> return Nothing - | Just ReleaseResources <- fromMessage m = do deleteWindows dws - releaseXMF (font s) - return $ Just $ Decoration (I Nothing) sh c ds - where dws = getDWs dwrs - + | Just e <- fromMessage m :: Maybe Event = handleEvent sh c s e >> return Nothing + | Just Hide <- fromMessage m = hideWindows (getDWs dwrs) >> return Nothing + | Just (SetTheme nc) <- fromMessage m = do releaseResources s + return $ Just $ Decoration (I Nothing) sh nc ds + | Just ReleaseResources <- fromMessage m = do releaseResources s + return $ Just $ Decoration (I Nothing) sh c ds hunk ./XMonad/Layout/Decoration.hs 200 +releaseResources :: DecorationState -> X () +releaseResources s = do + deleteWindows (getDWs $ decos s) + releaseXMF (font s) + addfile ./XMonad/Prompt/Theme.hs hunk ./XMonad/Prompt/Theme.hs 1 - +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Theme +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A prompt for chnaging the theme of the current workspace +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.Theme + ( -- * Usage + -- $usage + themePrompt, + ) where + +import Control.Arrow ( (&&&) ) +import qualified Data.Map as M +import Data.Maybe ( fromMaybe ) +import XMonad +import XMonad.Prompt +import XMonad.Layout.Decoration +import XMonad.Util.Themes + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.Theme +-- +-- in your keybindings add: +-- +-- > , ((modMask x .|. controlMask, xK_t), themePrompt defaultXPConfig) +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data ThemePrompt = ThemePrompt + +instance XPrompt ThemePrompt where + showXPrompt ThemePrompt = "Select a theme: " + +themePrompt :: XPConfig -> X () +themePrompt c = mkXPrompt ThemePrompt c (const $ return (map fst $ M.toList mapOfThemes)) changeTheme + where changeTheme t = sendMessage . SetTheme $ fromMaybe defaultTheme (M.lookup t mapOfThemes) + +mapOfThemes :: M.Map String Theme +mapOfThemes = M.fromList . uncurry zip . (map themeName &&& map theme) $ listOfThemes hunk ./xmonad-contrib.cabal 146 + XMonad.Prompt.Theme hunk ./XMonad/Layout/Decoration.hs 117 - redoLayout (Decoration st sh c ds) sc stack wrs + redoLayout (Decoration st sh t ds) sc stack wrs hunk ./XMonad/Layout/Decoration.hs 119 - return (wrs, Just $ Decoration (I Nothing) sh c ds) - | I Nothing <- st = initState c wrs >>= processState + return (wrs, Just $ Decoration (I Nothing) sh t ds) + | I Nothing <- st = initState t wrs >>= processState hunk ./XMonad/Layout/Decoration.hs 126 - ndwrs <- createDecos c toAdd + ndwrs <- createDecos t toAdd hunk ./XMonad/Layout/Decoration.hs 149 - Just i -> do dr <- decorate ds (decoWidth c) (decoHeight c) sc stack wrs (w,r) + Just i -> do dr <- decorate ds (decoWidth t) (decoHeight t) sc stack wrs (w,r) hunk ./XMonad/Layout/Decoration.hs 157 - updateDecos sh c (font s) ndwrs - return (insert_dwr [] ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh c ds)) + updateDecos sh t (font s) ndwrs + return (insert_dwr [] ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh t ds)) hunk ./XMonad/Layout/Decoration.hs 160 - handleMess (Decoration (I (Just s@(DS {decos = dwrs}))) sh c ds) m - | Just e <- fromMessage m :: Maybe Event = handleEvent sh c s e >> return Nothing + handleMess (Decoration (I (Just s@(DS {decos = dwrs}))) sh t ds) m + | Just e <- fromMessage m :: Maybe Event = handleEvent sh t s e >> return Nothing hunk ./XMonad/Layout/Decoration.hs 163 - | Just (SetTheme nc) <- fromMessage m = do releaseResources s - return $ Just $ Decoration (I Nothing) sh nc ds + | Just (SetTheme nt) <- fromMessage m = do releaseResources s + return $ Just $ Decoration (I Nothing) sh nt ds hunk ./XMonad/Layout/Decoration.hs 166 - return $ Just $ Decoration (I Nothing) sh c ds + return $ Just $ Decoration (I Nothing) sh t ds hunk ./XMonad/Layout/Decoration.hs 169 - emptyLayoutMod (Decoration (I (Just (DS dwrs f))) sh c ds) _ _ = do + emptyLayoutMod (Decoration (I (Just (DS dwrs f))) sh t ds) _ _ = do hunk ./XMonad/Layout/Decoration.hs 172 - return ([], Just $ Decoration (I Nothing) sh c ds) + return ([], Just $ Decoration (I Nothing) sh t ds) hunk ./XMonad/Layout/Decoration.hs 178 -handleEvent sh c (DS dwrs fs) e - | PropertyEvent {ev_window = w} <- e, w `elem` (map (fst . fst) dwrs) = updateDecos sh c fs dwrs - | ExposeEvent {ev_window = w} <- e, w `elem` (map (fst . snd) dwrs) = updateDecos sh c fs dwrs - | ButtonEvent {ev_window = w,ev_event_type = t} <- e, - t == buttonPress, +handleEvent sh t (DS dwrs fs) e + | PropertyEvent {ev_window = w} <- e, w `elem` (map (fst . fst) dwrs) = updateDecos sh t fs dwrs + | ExposeEvent {ev_window = w} <- e, w `elem` (map (fst . snd) dwrs) = updateDecos sh t fs dwrs + | ButtonEvent {ev_window = w,ev_event_type = ty} <- e, + ty == buttonPress, hunk ./XMonad/Layout/Decoration.hs 195 -initState conf wrs = do - fs <- initXMF (fontName conf) - dwrs <- createDecos conf wrs +initState t wrs = do + fs <- initXMF (fontName t) + dwrs <- createDecos t wrs hunk ./XMonad/Layout/Decoration.hs 207 -createDecos c (wr:wrs) = do +createDecos t (wr:wrs) = do hunk ./XMonad/Layout/Decoration.hs 210 - dw <- createNewWindow rect mask (inactiveColor c) True - dwrs <- createDecos c wrs + dw <- createNewWindow rect mask (inactiveColor t) True + dwrs <- createDecos t wrs hunk ./XMonad/Layout/Decoration.hs 215 -updateDecos s c f = mapM_ $ updateDeco s c f +updateDecos s t f = mapM_ $ updateDeco s t f hunk ./XMonad/Layout/Decoration.hs 218 -updateDeco sh c fs ((w,_),(dw,Just (Rectangle _ _ wh ht))) = do +updateDeco sh t fs ((w,_),(dw,Just (Rectangle _ _ wh ht))) = do hunk ./XMonad/Layout/Decoration.hs 228 - (inactiveColor c, inactiveBorderColor c, inactiveTextColor c) - (activeColor c, activeBorderColor c, activeTextColor c) - (urgentColor c, urgentBorderColor c, urgentTextColor c) + (inactiveColor t, inactiveBorderColor t, inactiveTextColor t) + (activeColor t, activeBorderColor t, activeTextColor t) + (urgentColor t, urgentBorderColor t, urgentTextColor t) hunk ./XMonad/Actions/CycleWS.hs 53 + , swapNextScreen + , swapPrevScreen hunk ./XMonad/Actions/CycleWS.hs 259 +-- | Swap current screen with next screen +swapNextScreen :: X () +swapNextScreen = swapScreen 1 + +-- | Swap current screen with previous screen +swapPrevScreen :: X () +swapPrevScreen = swapScreen (-1) + +swapScreen :: Int -> X () +swapScreen d = do s <- screenBy d + mws <- screenWorkspace s + case mws of + Nothing -> return () + Just ws -> windows (greedyView ws) + hunk ./XMonad/Util/Themes.hs 55 + , oxymor00nTheme hunk ./XMonad/Util/Themes.hs 95 + } + +oxymor00nTheme :: ThemeInfo +oxymor00nTheme = + newTheme { themeName = "oxymor00nTheme" + , themeAuthor = "Tom Rauchenwald" + , themeDescription = "oxymor00n's theme" + , theme = defaultTheme { inactiveBorderColor = "#000" + , activeBorderColor = "aquamarine3" + , activeColor = "aquamarine3" + , inactiveColor = "DarkSlateGray4" + , inactiveTextColor = "#222" + , activeTextColor = "#222" + -- This font can be found in the package ttf-alee + -- on debian-systems + , fontName = "-*-Bandal-*-*-*-*-12-*-*-*-*-*-*-*" + , decoHeight = 15 + , urgentColor = "#000" + , urgentTextColor = "#63b8ff" + } hunk ./XMonad/Prompt/Theme.hs 11 --- A prompt for chnaging the theme of the current workspace --- +-- A prompt for changing the theme of the current workspace hunk ./XMonad/Prompt/Theme.hs 29 --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Prompt/Theme.hs 48 -themePrompt c = mkXPrompt ThemePrompt c (const $ return (map fst $ M.toList mapOfThemes)) changeTheme - where changeTheme t = sendMessage . SetTheme $ fromMaybe defaultTheme (M.lookup t mapOfThemes) +themePrompt c = mkXPrompt ThemePrompt c (const . return . map themeName $ listOfThemes) changeTheme + where changeTheme t = sendMessage . SetTheme . fromMaybe defaultTheme $ M.lookup t mapOfThemes hunk ./XMonad/Prompt/Theme.hs 53 + hunk ./XMonad/Util/Themes.hs 21 + , deiflTheme + , oxymor00nTheme hunk ./XMonad/Util/Themes.hs 29 --- This module stores some user contributed themes. If you have a theme --- you would like to share, adding it to this module is very easy. +-- This module stores some user contributed themes. +-- +-- If you want to use one of the as your default theme in some +-- workspace, you need to substitute defaultTheme with, for instance, +-- (theme smallClean). +-- +-- This is an example: +-- +-- > import XMonad +-- > import XMonad.Util.Themes +-- > import XMonad.Layout.Tabbed +-- > +-- > myLayout = tabbed shrinkText (theme smallClean) +-- > +-- > main = xmonad defaultConfig {layoutHook = myLayout} +-- +-- If you have a theme you would like to share, adding it to this +-- module is very easy. hunk ./XMonad/Util/Themes.hs 64 - } + } hunk ./XMonad/Util/Themes.hs 76 +-- | The default xmonad theme, by David Roundy. hunk ./XMonad/Util/Themes.hs 85 +-- | Small decorations with a Ion3 remembrance, by Andrea Rossato. hunk ./XMonad/Util/Themes.hs 101 +-- | deifl\'s Theme, by deifl. hunk ./XMonad/Util/Themes.hs 105 - , themeAuthor = "deiflTheme" - , themeDescription = "deiflTheme" + , themeAuthor = "deifl" + , themeDescription = "deifl's Theme" hunk ./XMonad/Util/Themes.hs 118 +-- | oxymor00n\'s theme, by Tom Rauchenwald. hunk ./XMonad/Util/Themes.hs 125 - , activeBorderColor = "aquamarine3" + , activeBorderColor = "aquamarine3" hunk ./XMonad/Util/Themes.hs 130 - -- This font can be found in the package ttf-alee + -- This font can be found in the package ttf-alee hunk ./XMonad/Util/Themes.hs 31 --- If you want to use one of the as your default theme in some --- workspace, you need to substitute defaultTheme with, for instance, --- (theme smallClean). +-- If you want to use one of this them as your default theme for one +-- of your layouts, you need to substitute defaultTheme with, for +-- instance, (theme smallClean). hunk ./XMonad/Layout/Decoration.hs 108 + mouseEventHook :: ds a -> DecorationState -> Event -> X () + mouseEventHook _ (DS dwrs _) e + | ButtonEvent {ev_window = w,ev_event_type = ty} <- e, + ty == buttonPress, + Just ((mainw,_),_) <- lookFor w dwrs = focus mainw + mouseEventHook _ _ _ = return () + hunk ./XMonad/Layout/Decoration.hs 168 - | Just e <- fromMessage m :: Maybe Event = handleEvent sh t s e >> return Nothing - | Just Hide <- fromMessage m = hideWindows (getDWs dwrs) >> return Nothing + | Just e <- fromMessage m :: Maybe Event = do mouseEventHook ds s e + handleEvent sh t s e + return Nothing + | Just Hide <- fromMessage m = do hideWindows (getDWs dwrs) + return Nothing hunk ./XMonad/Layout/Decoration.hs 191 - | ButtonEvent {ev_window = w,ev_event_type = ty} <- e, - ty == buttonPress, - Just ((mainw,_),_) <- lookFor w dwrs = focus mainw hunk ./XMonad/Layout/WindowArranger.hs 93 + | SetGeometry Rectangle hunk ./XMonad/Layout/WindowArranger.hs 107 - pureModifier (WA True b awrs) _ (S.Stack w _ _) wrs = curry process wrs awrs + pureModifier (WA True b awrs) _ (S.Stack w _ _) wrs = curry process wrs awrs hunk ./XMonad/Layout/WindowArranger.hs 138 + pureMess (WA t b (wr:wrs)) m + | Just (SetGeometry r) <- fromMessage m, (w,_) <- fromAWR wr = Just . WA t b $ AWR (w,r):wrs + hunk ./XMonad/Layout/Decoration.hs 29 - , isDecoration, fi + , isDecoration, fi, lookFor hunk ./XMonad/Layout/Decoration.hs 109 - mouseEventHook _ (DS dwrs _) e - | ButtonEvent {ev_window = w,ev_event_type = ty} <- e, - ty == buttonPress, - Just ((mainw,_),_) <- lookFor w dwrs = focus mainw + mouseEventHook _ (DS dwrs@(((_,r),(dw,_)):_) _) e + | ButtonEvent {ev_window = ew, ev_event_type = ty} <- e + , ty == buttonPress, dw == ew = mouseDrag (\ex ey -> do + let rect = Rectangle ex ey (rect_width r) (rect_height r) + sendMessage (SetGeometry rect)) + (return ()) + | ButtonEvent {ev_window = ew, ev_event_type = ty} <- e + , ty == buttonPress + , Just ((mainw,_),_) <- lookFor ew dwrs = focus mainw + hunk ./XMonad/Config/Arossato.hs 26 -import XMonad +import XMonad hiding ( (|||) ) hunk ./XMonad/Config/Arossato.hs 33 +import XMonad.Layout.LayoutCombinators hunk ./XMonad/Config/Arossato.hs 42 +import XMonad.Prompt.Theme hunk ./XMonad/Config/Arossato.hs 59 +-- NOTE: that I'm using xmobar and, if you don't have xmobar in your +-- PATH, this configuration will produce an error and xmonad will not +-- start. If you don't want to install xmobar get rid of this line at +-- the beginning of 'arossatoConfig'. hunk ./XMonad/Config/Arossato.hs 101 - xmobar <- spawnPipe "xmobar" + xmobar <- spawnPipe "xmobar" -- remove this line if you do not have xmobar installed! hunk ./XMonad/Config/Arossato.hs 115 + , focusFollowsMouse = False hunk ./XMonad/Config/Arossato.hs 119 - mytabs = tabbed shrinkText arossatoTheme + mytabs = tabbed shrinkText arossatoTheme hunk ./XMonad/Config/Arossato.hs 122 - otherLays = windowArrange $ + otherLays = windowArrange $ hunk ./XMonad/Config/Arossato.hs 163 - , ((modMask x , xK_F5 ), windowPromptGoto defaultXPConfig ) - , ((modMask x , xK_F6 ), windowPromptBring defaultXPConfig ) + , ((modMask x , xK_F5 ), themePrompt defaultXPConfig ) + , ((modMask x , xK_F6 ), windowPromptGoto defaultXPConfig ) + , ((modMask x , xK_F7 ), windowPromptBring defaultXPConfig ) hunk ./XMonad/Config/Arossato.hs 186 - , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage (DecreaseLeft 10)) - , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage (DecreaseRight 10)) - , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage (DecreaseDown 10)) - , ((modMask x .|. controlMask .|. shiftMask, xK_Up ), sendMessage (DecreaseUp 10)) - , ((modMask x .|. controlMask , xK_Left ), sendMessage (IncreaseLeft 10)) + , ((modMask x .|. controlMask , xK_Left ), sendMessage (DecreaseLeft 10)) + , ((modMask x .|. controlMask , xK_Up ), sendMessage (DecreaseUp 10)) hunk ./XMonad/Config/Arossato.hs 190 - , ((modMask x .|. controlMask , xK_Up ), sendMessage (IncreaseUp 10)) hunk ./XMonad/Config/Arossato.hs 194 + -- gaps + , ((modMask x , xK_b ), sendMessage ToggleStruts ) hunk ./XMonad/Layout/Tabbed.hs 20 - tabbed, addTabs + simpleTabbed, tabbed, addTabs hunk ./XMonad/Layout/Tabbed.hs 43 --- > myLayouts = tabDeco shrinkText defaultTheme ||| Full ||| etc.. +-- > myLayouts = simpleTabbed ||| Full ||| etc.. +-- +-- or, if you want a specific theme for you tabbed layout: +-- +-- > myLayouts = tabbed shrinkText defaultTheme ||| Full ||| etc.. +-- +-- and then: +-- hunk ./XMonad/Layout/Tabbed.hs 66 --- | This function is deprecated and will be removed before 0.7!! +-- | A tabbed layout with the default xmonad Theme. Here's a screen +-- shot: +-- +-- +-- +-- This is a minimal working configuration: +-- +-- > import XMonad +-- > import XMonad.Layout.DecorationMadness +-- > main = xmonad defaultConfig { layoutHook = simpleTabbed } +simpleTabbed :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window +simpleTabbed = decoration shrinkText defaultTheme Tabbed Simplest + +-- | A layout decorated with tabs and the possibility to set a custom +-- shrinker and a custom theme. hunk ./XMonad/Layout/Decoration.hs 39 -import XMonad.Layout.WindowArranger -import XMonad.Util.NamedWindows +import XMonad.Layout.WindowArranger (WindowArrangerMsg (..), diff, listFromList) +import XMonad.Util.NamedWindows (getName) hunk ./XMonad/Layout/Decoration.hs 108 - mouseEventHook :: ds a -> DecorationState -> Event -> X () - mouseEventHook _ (DS dwrs@(((_,r),(dw,_)):_) _) e - | ButtonEvent {ev_window = ew, ev_event_type = ty} <- e - , ty == buttonPress, dw == ew = mouseDrag (\ex ey -> do - let rect = Rectangle ex ey (rect_width r) (rect_height r) - sendMessage (SetGeometry rect)) - (return ()) - | ButtonEvent {ev_window = ew, ev_event_type = ty} <- e - , ty == buttonPress + decoEventHook :: ds a -> DecorationState -> Event -> X () + decoEventHook _ (DS dwrs@(((_,r),(dw,_)):_) _) ButtonEvent { ev_window = ew + , ev_event_type = et + , ev_x_root = ex + , ev_y_root = ey } + | et == buttonPress + , ew == dw = mouseDrag (\x y -> do + let rect = Rectangle (x - (fi ex - rect_x r)) + (y - (fi ey - rect_y r)) + (rect_width r) + (rect_height r) + sendMessage (SetGeometry rect)) (return ()) + | et == buttonPress hunk ./XMonad/Layout/Decoration.hs 122 - - mouseEventHook _ _ _ = return () + decoEventHook _ _ _ = return () hunk ./XMonad/Layout/Decoration.hs 177 - | Just e <- fromMessage m :: Maybe Event = do mouseEventHook ds s e - handleEvent sh t s e + | Just e <- fromMessage m :: Maybe Event = do decoEventHook ds s e + handleEvent sh t s e addfile ./XMonad/Layout/DecorationMadness.hs hunk ./XMonad/Layout/DecorationMadness.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.DecorationMadness +-- Copyright : (c) 2007 Andrea Rossato +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A collection of decorated layouts: some of them may be nice, some +-- usable, others just funny. +----------------------------------------------------------------------------- + +module XMonad.Layout.DecorationMadness + ( -- * Usage + -- $usage + + -- * Decorated layouts based on Circle + -- $circle + circleSimpleDefault + , circleDefault + , circleSimpleDefaultResizable + , circleDefaultResizable + , circleSimpleDeco + , circleSimpleDecoResizable + , circleDeco + , circleDecoResizable + , circleSimpleDwmStyle + , circleDwmStyle + , circleSimpleTabbed + , circleTabbed + -- * Decorated layouts based on Accordion + -- $accordion + , accordionSimpleDefault + , accordionDefault + , accordionSimpleDefaultResizable + , accordionDefaultResizable + , accordionSimpleDeco + , accordionSimpleDecoResizable + , accordionDeco + , accordionDecoResizable + , accordionSimpleDwmStyle + , accordionDwmStyle + , accordionSimpleTabbed + , accordionTabbed + -- * Tall decorated layouts + -- $tall + , tallSimpleDefault + , tallDefault + , tallSimpleDefaultResizable + , tallDefaultResizable + , tallSimpleDeco + , tallDeco + , tallSimpleDecoResizable + , tallDecoResizable + , tallSimpleDwmStyle + , tallDwmStyle + , tallSimpleTabbed + , tallTabbed + -- * Mirror Tall decorated layouts + -- $mirror + , mirrorTallSimpleDefault + , mirrorTallDefault + , mirrorTallSimpleDefaultResizable + , mirrorTallDefaultResizable + , mirrorTallSimpleDeco + , mirrorTallDeco + , mirrorTallSimpleDecoResizable + , mirrorTallDecoResizable + , mirrorTallSimpleDwmStyle + , mirrorTallDwmStyle + , mirrorTallSimpleTabbed + , mirrorTallTabbed + , defaultTheme, shrinkText + ) where + +import Data.List +import XMonad +import qualified XMonad.StackSet as S +import XMonad.Layout.Decoration +import XMonad.Layout.DwmStyle +import XMonad.Layout.SimpleDecoration + +import XMonad.Layout.Accordion +import XMonad.Layout.Circle +import XMonad.Layout.ResizeScreen +import XMonad.Layout.WindowArranger + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.DecorationMadness +-- +-- Then edit your @layoutHook@ by adding the layout you want: +-- +-- > main = xmonad defaultConfig { layoutHook = someMadLayout } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- You can also edit the default theme: +-- +-- > myTheme = defaultTheme { inactiveBorderColor = "#FF0000" +-- > , activeTextColor = "#00FF00" } +-- +-- and +-- +-- > mylayout = tabbed shrinkText myTheme ||| Full ||| etc.. +-- +-- When a layout is resizable, this means two different things: you +-- can grab a window's decoration with the pointer and move it around, +-- and you can move and resize windows with the keyboard. For setting +-- up the key bindings, please read the documentation of +-- "XMonad.Layout.WindowArranger" +-- +-- The deafult theme can be dynamically change with the xmonad theme +-- selector. See "XMonad.Prompt.Theme". For more themse, look at +-- "XMonad.Util.Themes" +-- +-- NOTE: some of these layouts may not be working correctly with +-- WindowNavigation and with some layout combinators. I hope to fix +-- this problem shortly! + +-- The xmonad default decoration modifier! +data DefaultDecoration a = DefaultDecoration deriving ( Read, Show ) +instance DecorationStyle DefaultDecoration a + +-- There may be a regression in Tabbed, and no tab is displayed when +-- using it with other layouts. This is the reason for the following +-- instance (to be removed!) +data SimpleTabbedDecoration a = SimpleTabbed deriving (Read, Show) +instance Eq a => DecorationStyle SimpleTabbedDecoration a where + describeDeco _ = "Tabbed" + decorateFirst _ = True + shrink _ _ r = r + pureDecoration _ _ ht (Rectangle x y wh _) s wrs (w,_) = Just $ Rectangle nx y nwh (fi ht) + where nwh = wh `div` max 1 (fi $ length wrs) + nx = case w `elemIndex` (S.integrate s) of + Just i -> x + (fi nwh * fi i) + Nothing -> x + +-- $circle +-- Here you will find 'Circle' based decorated layouts. + +-- | A 'Circle' layout with the xmonad default decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Circle Window +circleSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration Circle + +-- | Similar to 'circleSimpleDefault' but with the possibility of +-- setting a custom shrinker and a custom theme. +circleDefault :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration DefaultDecoration s) Circle Window +circleDefault s t = decoration s t DefaultDecoration Circle + +-- | A 'Circle' layout with the xmonad simple decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Circle Window +circleSimpleDeco = decoration shrinkText defaultTheme (Simple True) Circle + +-- | Similar to 'circleSimpleDece' but with the possibility of +-- setting a custom shrinker and a custom theme. +circleDeco :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration SimpleDecoration s) Circle Window +circleDeco s t = decoration s t (Simple True) Circle + +-- | A 'Circle' layout with the xmonad default decoration, default +-- theme and default shrinker, but with the possibility of moving +-- windows with the mouse, and resize\/move them with the keyboard. +-- +-- Here you can find a screen shot: +-- +-- +circleSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout WindowArranger Circle) Window +circleSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (windowArrange Circle) + +-- | Similar to 'circleSimpleDefaultResizable' but with the +-- possibility of setting a custom shrinker and a custom theme. +circleDefaultResizable :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout WindowArranger Circle) Window +circleDefaultResizable s t = decoration s t DefaultDecoration (windowArrange Circle) + +-- | A 'Circle' layout with the xmonad simple decoration, default +-- theme and default shrinker, but with the possibility of moving +-- windows with the mouse, and resize\/move them with the keyboard. +-- +-- Here you can find a screen shot: +-- +-- +circleSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout WindowArranger Circle) Window +circleSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (windowArrange Circle) + +-- | Similar to 'circleSimpleDecoResizable' but with the +-- possibility of setting a custom shrinker and a custom theme. +circleDecoResizable :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout WindowArranger Circle) Window +circleDecoResizable s t = decoration s t (Simple True) (windowArrange Circle) + +-- | A 'Circle' layout with the xmonad DwmStyle decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Circle Window +circleSimpleDwmStyle = decoration shrinkText defaultTheme Dwm Circle + +-- | Similar to 'circleSimpleDwmStyle' but with the +-- possibility of setting a custom shrinker and a custom theme. +circleDwmStyle :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration DwmStyle s) Circle Window +circleDwmStyle s t = decoration s t Dwm Circle + +-- | A 'Circle' layout with the xmonad tabbed decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +circleSimpleTabbed :: ModifiedLayout (Decoration SimpleTabbedDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Circle) Window +circleSimpleTabbed = decoration shrinkText defaultTheme SimpleTabbed (resizeVertical 20 Circle) + +-- | Similar to 'circleSimpleTabbed' but with the +-- possibility of setting a custom shrinker and a custom theme. +circleTabbed :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration SimpleTabbedDecoration s) (ModifiedLayout ResizeScreen Circle) Window +circleTabbed s t = decoration s t SimpleTabbed (resizeVertical 20 Circle) + + +-- $accordion +-- Here you will find decorated layouts based on the 'Accordion' +-- layout. + +-- | An 'Accordion' layout with the xmonad default decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +accordionSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Accordion Window +accordionSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration Accordion + +-- | Similar to 'accordionSimpleDefault' but with the possibility of +-- setting a custom shrinker and a custom theme. +accordionDefault :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration DefaultDecoration s) Accordion Window +accordionDefault s t = decoration s t DefaultDecoration Accordion + +-- | An 'Accordion' layout with the xmonad simple decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +accordionSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Accordion Window +accordionSimpleDeco = decoration shrinkText defaultTheme (Simple True) Accordion + +-- | Similar to 'accordionSimpleDece' but with the possibility of +-- setting a custom shrinker and a custom theme. +accordionDeco :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration SimpleDecoration s) Accordion Window +accordionDeco s t = decoration s t (Simple True) Accordion + +-- | An 'Accordion' layout with the xmonad default decoration, default +-- theme and default shrinker, but with the possibility of moving +-- windows with the mouse, and resize\/move them with the keyboard. +accordionSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout WindowArranger Accordion) Window +accordionSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (windowArrange Accordion) + +-- | Similar to 'accordionSimpleDefaultResizable' but with the +-- possibility of setting a custom shrinker and a custom theme. +accordionDefaultResizable :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout WindowArranger Accordion) Window +accordionDefaultResizable s t = decoration s t DefaultDecoration (windowArrange Accordion) + +-- | An 'Accordion' layout with the xmonad simple decoration, default +-- theme and default shrinker, but with the possibility of moving +-- windows with the mouse, and resize\/move them with the keyboard. +accordionSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout WindowArranger Accordion) Window +accordionSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (windowArrange Accordion) + +-- | Similar to 'accordionSimpleDecoResizable' but with the +-- possibility of setting a custom shrinker and a custom theme. +accordionDecoResizable :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout WindowArranger Accordion) Window +accordionDecoResizable s t = decoration s t (Simple True) (windowArrange Accordion) + +-- | An 'Accordion' layout with the xmonad DwmStyle decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +accordionSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Accordion Window +accordionSimpleDwmStyle = decoration shrinkText defaultTheme Dwm Accordion + +-- | Similar to 'accordionSimpleDwmStyle' but with the +-- possibility of setting a custom shrinker and a custom theme. +accordionDwmStyle :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration DwmStyle s) Accordion Window +accordionDwmStyle s t = decoration s t Dwm Accordion + +-- | An 'Accordion' layout with the xmonad tabbed decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +accordionSimpleTabbed :: ModifiedLayout (Decoration SimpleTabbedDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Accordion) Window +accordionSimpleTabbed = decoration shrinkText defaultTheme SimpleTabbed (resizeVertical 20 Accordion) + +-- | Similar to 'accordionSimpleTabbed' but with the +-- possibility of setting a custom shrinker and a custom theme. +accordionTabbed :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration SimpleTabbedDecoration s) (ModifiedLayout ResizeScreen Accordion) Window +accordionTabbed s t = decoration s t SimpleTabbed (resizeVertical 20 Accordion) + + +-- $tall +-- In this section you will find decorated layouts based on the +-- 'Tall' layout. + +tall :: Tall Window +tall = Tall 1 (3/100) (1/2) + +-- | A 'Tall' layout with the xmonad default decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +tallSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Tall Window +tallSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration tall + +-- | Similar to 'tallSimpleDefault' but with the possibility of +-- setting a custom shrinker and a custom theme. +tallDefault :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration DefaultDecoration s) Tall Window +tallDefault s t = decoration s t DefaultDecoration tall + +-- | A 'Tall' layout with the xmonad simple decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +tallSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Tall Window +tallSimpleDeco = decoration shrinkText defaultTheme (Simple True) tall + +-- | Similar to 'tallSimpleDece' but with the possibility of +-- setting a custom shrinker and a custom theme. +tallDeco :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration SimpleDecoration s) Tall Window +tallDeco s t = decoration s t (Simple True) tall + +-- | A 'Tall' layout with the xmonad default decoration, default +-- theme and default shrinker, but with the possibility of moving +-- windows with the mouse, and resize\/move them with the keyboard. +-- +-- Here you can find a screen shot: +-- +-- +tallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout WindowArranger Tall) Window +tallSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (windowArrange tall) + +-- | Similar to 'tallSimpleDefaultResizable' but with the +-- possibility of setting a custom shrinker and a custom theme. +tallDefaultResizable :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout WindowArranger Tall) Window +tallDefaultResizable s t = decoration s t DefaultDecoration (windowArrange tall) + +-- | A 'Tall' layout with the xmonad simple decoration, default +-- theme and default shrinker, but with the possibility of moving +-- windows with the mouse, and resize\/move them with the keyboard. +-- +-- Here you can find a screen shot: +-- +-- +tallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout WindowArranger Tall) Window +tallSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (windowArrange tall) + +-- | Similar to 'tallSimpleDecoResizable' but with the +-- possibility of setting a custom shrinker and a custom theme. +tallDecoResizable :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout WindowArranger Tall) Window +tallDecoResizable s t = decoration s t (Simple True) (windowArrange tall) + +-- | A 'Tall' layout with the xmonad DwmStyle decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +tallSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Tall Window +tallSimpleDwmStyle = decoration shrinkText defaultTheme Dwm tall + +-- | Similar to 'tallSimpleDwmStyle' but with the +-- possibility of setting a custom shrinker and a custom theme. +tallDwmStyle :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration DwmStyle s) Tall Window +tallDwmStyle s t = decoration s t Dwm tall + +-- | A 'Tall' layout with the xmonad tabbed decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +tallSimpleTabbed :: ModifiedLayout (Decoration SimpleTabbedDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Tall) Window +tallSimpleTabbed = decoration shrinkText defaultTheme SimpleTabbed (resizeVertical 20 tall) + +-- | Similar to 'tallSimpleTabbed' but with the +-- possibility of setting a custom shrinker and a custom theme. +tallTabbed :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration SimpleTabbedDecoration s) (ModifiedLayout ResizeScreen Tall) Window +tallTabbed s t = decoration s t SimpleTabbed (resizeVertical 20 tall) + +-- $mirror +-- In this section you will find decorated layouts based on the +-- 'Mirror' layout modifier applied to 'Tall'. + +mirrorTall :: Mirror Tall Window +mirrorTall = Mirror tall + +-- | A 'Mirror Tall' layout with the xmonad default decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +mirrorTallSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (Mirror Tall) Window +mirrorTallSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration mirrorTall + +-- | Similar to 'mirrorTallSimpleDefault' but with the possibility of +-- setting a custom shrinker and a custom theme. +mirrorTallDefault :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration DefaultDecoration s) (Mirror Tall) Window +mirrorTallDefault s t = decoration s t DefaultDecoration mirrorTall + +-- | A 'Mirror Tall' layout with the xmonad simple decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +mirrorTallSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (Mirror Tall) Window +mirrorTallSimpleDeco = decoration shrinkText defaultTheme (Simple True) mirrorTall + +-- | Similar to 'mirrorTallSimpleDece' but with the possibility of +-- setting a custom shrinker and a custom theme. +mirrorTallDeco :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration SimpleDecoration s) (Mirror Tall) Window +mirrorTallDeco s t = decoration s t (Simple True) mirrorTall + +-- | A 'Mirror Tall' layout with the xmonad default decoration, default +-- theme and default shrinker, but with the possibility of moving +-- windows with the mouse, and resize\/move them with the keyboard. +-- +-- Here you can find a screen shot: +-- +-- +mirrorTallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout WindowArranger (Mirror Tall)) Window +mirrorTallSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (windowArrange mirrorTall) + +-- | Similar to 'mirrorTallSimpleDefaultResizable' but with the +-- possibility of setting a custom shrinker and a custom theme. +mirrorTallDefaultResizable :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout WindowArranger (Mirror Tall)) Window +mirrorTallDefaultResizable s t = decoration s t DefaultDecoration (windowArrange mirrorTall) + +-- | A 'Mirror Tall' layout with the xmonad simple decoration, default +-- theme and default shrinker, but with the possibility of moving +-- windows with the mouse, and resize\/move them with the keyboard. +-- +-- Here you can find a screen shot: +-- +-- +mirrorTallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout WindowArranger (Mirror Tall)) Window +mirrorTallSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (windowArrange mirrorTall) + +-- | Similar to 'mirrorTallSimpleDecoResizable' but with the +-- possibility of setting a custom shrinker and a custom theme. +mirrorTallDecoResizable :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout WindowArranger (Mirror Tall)) Window +mirrorTallDecoResizable s t = decoration s t (Simple True) (windowArrange mirrorTall) + +-- | A 'Mirror Tall' layout with the xmonad DwmStyle decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +mirrorTallSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) (Mirror Tall) Window +mirrorTallSimpleDwmStyle = decoration shrinkText defaultTheme Dwm mirrorTall + +-- | Similar to 'mirrorTallSimpleDwmStyle' but with the +-- possibility of setting a custom shrinker and a custom theme. +mirrorTallDwmStyle :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration DwmStyle s) (Mirror Tall) Window +mirrorTallDwmStyle s t = decoration s t Dwm mirrorTall + +-- | A 'Mirror Tall' layout with the xmonad tabbed decoration, default +-- theme and default shrinker. +-- +-- Here you can find a screen shot: +-- +-- +mirrorTallSimpleTabbed :: ModifiedLayout (Decoration SimpleTabbedDecoration DefaultShrinker) (ModifiedLayout ResizeScreen (Mirror Tall)) Window +mirrorTallSimpleTabbed = decoration shrinkText defaultTheme SimpleTabbed (resizeVertical 20 mirrorTall) + +-- | Similar to 'mirrorTallSimpleTabbed' but with the +-- possibility of setting a custom shrinker and a custom theme. +mirrorTallTabbed :: Shrinker s => s -> Theme + -> ModifiedLayout (Decoration SimpleTabbedDecoration s) (ModifiedLayout ResizeScreen (Mirror Tall)) Window +mirrorTallTabbed s t = decoration s t SimpleTabbed (resizeVertical 20 mirrorTall) hunk ./xmonad-contrib.cabal 102 + XMonad.Layout.DecorationMadness hunk ./XMonad/Prompt/Man.hs 61 - mkXPrompt Man c (manCompl mans) $ runInTerm . (++) "man " + mkXPrompt Man c (manCompl mans) $ runInTerm "" . (++) "man " hunk ./XMonad/Prompt/Ssh.hs 59 -ssh s = runInTerm ("ssh " ++ s) +ssh s = runInTerm "" ("ssh " ++ s) hunk ./XMonad/Util/Run.hs 59 - when (output==output) $ return () + when (output == output) $ return () hunk ./XMonad/Util/Run.hs 115 -safeRunInTerm :: String -> X () -safeRunInTerm command = asks (terminal . config) >>= \t -> safeSpawn t ("-e " ++ command) +safeRunInTerm :: String -> String -> X () +safeRunInTerm options command = asks (terminal . config) >>= \t -> safeSpawn t (options ++ " -e " ++ command) hunk ./XMonad/Util/Run.hs 118 -unsafeRunInTerm, runInTerm :: String -> X () -unsafeRunInTerm command = asks (terminal . config) >>= \t -> unsafeSpawn $ t ++ " -e " ++ command +unsafeRunInTerm, runInTerm :: String -> String -> X () +unsafeRunInTerm options command = asks (terminal . config) >>= \t -> unsafeSpawn $ t ++ " " ++ options ++ " -e " ++ command hunk ./XMonad/Actions/WindowGo.hs 68 - something crazy like that. This hook gives you that flexibility. + something crazy like that. This hook gives you that flexibility. You can do + some cute things with this hook. Suppose you want to do the same thing for + Mutt which you just did for Firefox - but Mutt runs inside a terminal window? + No problem: you search for a terminal window calling itself 'mutt', and if + there isn't you run a terminal with a command to run mutt! Here's an example, + borrowing 'runInTerm' from XMonad.Utils.Run: + + > , ((modm, xK_m ), raiseMaybe (runInTerm -title "mutt" "mutt") (title =? "mutt")) hunk ./XMonad/Actions/WindowGo.hs 75 - > , ((modm, xK_m ), raiseMaybe (runInTerm -title "mutt" "mutt") (title =? "mutt")) + > , ((modm, xK_m ), raiseMaybe (runInTerm "-title mutt" "mutt") (title =? "mutt")) hunk ./XMonad/Layout/ResizeScreen.hs 13 --- geometry +-- geometry. Mostly used with "Decoration" (the Horizontal and the +-- Vertical version will react to SetTheme and change their dimension +-- accordingly. hunk ./XMonad/Layout/ResizeScreen.hs 28 -import XMonad.Util.XUtils (fi) -import XMonad.Layout.LayoutModifier +import XMonad.Layout.Decoration hunk ./XMonad/Layout/ResizeScreen.hs 66 + pureMess (ResizeScreen d _) m + | Just (SetTheme t) <- fromMessage m = Just $ ResizeScreen d (fi $ decoHeight t) + pureMess _ _ = Nothing + hunk ./XMonad/Layout/DecorationMadness.hs 239 -circleTabbed s t = decoration s t SimpleTabbed (resizeVertical 20 Circle) +circleTabbed s t = decoration s t SimpleTabbed (resizeVertical (fi $ decoHeight t) Circle) hunk ./XMonad/Layout/DecorationMadness.hs 328 -accordionTabbed s t = decoration s t SimpleTabbed (resizeVertical 20 Accordion) +accordionTabbed s t = decoration s t SimpleTabbed (resizeVertical (fi $ decoHeight t) Accordion) hunk ./XMonad/Layout/DecorationMadness.hs 428 -tallTabbed s t = decoration s t SimpleTabbed (resizeVertical 20 tall) +tallTabbed s t = decoration s t SimpleTabbed (resizeVertical (fi $ decoHeight t) tall) hunk ./XMonad/Layout/DecorationMadness.hs 527 -mirrorTallTabbed s t = decoration s t SimpleTabbed (resizeVertical 20 mirrorTall) +mirrorTallTabbed s t = decoration s t SimpleTabbed (resizeVertical (fi $ decoHeight t) mirrorTall) hunk ./XMonad/Util/Themes.hs 21 + , robertTheme hunk ./XMonad/Util/Themes.hs 24 + , donaldTheme hunk ./XMonad/Util/Themes.hs 76 + , robertTheme + , donaldTheme hunk ./XMonad/Util/Themes.hs 103 + } + +-- | Don's prefered colors - fomr DynamicLog...;) +donaldTheme :: ThemeInfo +donaldTheme = + newTheme { themeName = "donaldTheme" + , themeAuthor = "Andrea Rossato" + , themeDescription = "Don's prefered colors - fomr DynamicLog...;)" + , theme = defaultTheme { activeColor = "#2b4f98" + , inactiveColor = "#cccccc" + , activeBorderColor = "#2b4f98" + , inactiveBorderColor = "#cccccc" + , activeTextColor = "white" + , inactiveTextColor = "black" + , decoHeight = 16 + } + } + +-- | Ffrom Robert Manea's prompt theme. +robertTheme :: ThemeInfo +robertTheme = + newTheme { themeName = "robertTheme" + , themeAuthor = "Andrea Rossato" + , themeDescription = "From Robert Manea's prompt theme" + , theme = defaultTheme { activeColor = "#aecf96" + , inactiveColor = "#111111" + , activeBorderColor = "#aecf96" + , inactiveBorderColor = "#111111" + , activeTextColor = "black" + , inactiveTextColor = "#d5d3a7" + , fontName = "-*-profont-*-*-*-*-11-*-*-*-*-*-iso8859" + , decoHeight = 16 + } hunk ./XMonad/Layout/Decoration.hs 23 + , DefaultDecoration (..) hunk ./XMonad/Layout/Decoration.hs 133 +data DefaultDecoration a = DefaultDecoration deriving ( Read, Show ) +instance DecorationStyle DefaultDecoration a + hunk ./XMonad/Layout/DecorationMadness.hs 127 - --- The xmonad default decoration modifier! -data DefaultDecoration a = DefaultDecoration deriving ( Read, Show ) -instance DecorationStyle DefaultDecoration a hunk ./XMonad/Layout/SimpleFloat.hs 21 + , SimpleFloat (..) hunk ./XMonad/Layout/SimpleFloat.hs 47 --- | FIXME +-- | A simple floating layout where every window is placed according +-- to the window's initial attributes. +-- +-- This version is decorated with the 'SimpleDecoration' style. hunk ./XMonad/Layout/SimpleFloat.hs 55 --- | FIXME -simpleFloat' :: Shrinker s => s -> Theme -> +-- | Same as 'simpleFloat', but with the possibility of setting a +-- custom shrinker and a custom theme. +simpleFloat' :: Shrinker s => s -> Theme -> hunk ./XMonad/Layout/DecorationMadness.hs 76 + -- * Floating decorated layouts + -- $float + , floatSimpleSimple + , floatSimple + , floatSimpleDefault + , floatDefault + , floatSimpleDwmStyle + , floatDwmStyle + , floatSimpleTabbed + , floatTabbed hunk ./XMonad/Layout/DecorationMadness.hs 100 +import XMonad.Layout.SimpleFloat hunk ./XMonad/Layout/DecorationMadness.hs 536 +-- $float +-- Here you will find decorated layout based on the SimpleFloating +-- layout + +-- | A simple floating layout where every window is placed according +-- to the window's initial attributes. +-- +-- Here you can find a screen shot: +-- +-- +floatSimpleSimple :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) + (ModifiedLayout WindowArranger SimpleFloat) a +floatSimpleSimple = simpleFloat + +floatSimple :: Shrinker s => s -> Theme -> + ModifiedLayout (Decoration SimpleDecoration s) + (ModifiedLayout WindowArranger SimpleFloat) a +floatSimple = simpleFloat' + +-- | This version is decorated with the 'DefaultDecoration' style. +-- +-- Here you can find a screen shot: +-- +-- +floatSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) + (ModifiedLayout WindowArranger SimpleFloat) a +floatSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration (windowArrangeAll $ SF 20) + +-- | Same as 'defaultFloat', but with the possibility of setting a +-- custom shrinker and a custom theme. +floatDefault :: Shrinker s => s -> Theme -> + ModifiedLayout (Decoration DefaultDecoration s) + (ModifiedLayout WindowArranger SimpleFloat) a +floatDefault s c = decoration s c DefaultDecoration (windowArrangeAll $ SF (decoHeight c)) + +-- | This version is decorated with the 'DwmStyle'. Note that this is +-- a keyboard only floating layout. +-- +-- Here you can find a screen shot: +-- +-- +floatSimpleDwmStyle :: Eq a => ModifiedLayout (Decoration DwmStyle DefaultShrinker) + (ModifiedLayout WindowArranger SimpleFloat) a +floatSimpleDwmStyle = decoration shrinkText defaultTheme Dwm (windowArrangeAll $ SF 20) + +-- | Same as 'dwmStyleFloat', but with the possibility of setting a +-- custom shrinker and a custom theme. +floatDwmStyle :: (Eq a, Shrinker s) => s -> Theme -> + ModifiedLayout (Decoration DwmStyle s) + (ModifiedLayout WindowArranger SimpleFloat) a +floatDwmStyle s c = decoration s c Dwm (windowArrangeAll $ SF (decoHeight c)) + +-- | This version is decorated with the 'TabbedDecoration' style. +-- | Mouse dragging is somehow weird. +-- +-- Here you can find a screen shot: +-- +-- +floatSimpleTabbed :: Eq a => ModifiedLayout (Decoration SimpleTabbedDecoration DefaultShrinker) + (ModifiedLayout WindowArranger SimpleFloat) a +floatSimpleTabbed = decoration shrinkText defaultTheme SimpleTabbed (windowArrangeAll $ SF 20) + +-- | Same as 'tabbedFloat', but with the possibility of setting a +-- custom shrinker and a custom theme. +floatTabbed :: (Eq a, Shrinker s) => s -> Theme -> + ModifiedLayout (Decoration SimpleTabbedDecoration s) + (ModifiedLayout WindowArranger SimpleFloat) a +floatTabbed s c = decoration s c SimpleTabbed (windowArrangeAll $ SF (decoHeight c)) + + hunk ./XMonad/Layout/DecorationMadness.hs 564 --- | Same as 'defaultFloat', but with the possibility of setting a +-- | Same as 'floatSimpleDefault', but with the possibility of setting a hunk ./XMonad/Layout/DecorationMadness.hs 581 --- | Same as 'dwmStyleFloat', but with the possibility of setting a +-- | Same as 'floatSimpleDwmStyle', but with the possibility of setting a hunk ./XMonad/Layout/DecorationMadness.hs 598 --- | Same as 'tabbedFloat', but with the possibility of setting a +-- | Same as 'floatSimpleTabbed', but with the possibility of setting a hunk ./XMonad/Layout/DecorationMadness.hs 605 - hunk ./XMonad/Hooks/DynamicLog.hs 27 + dynamicLogString, hunk ./XMonad/Hooks/DynamicLog.hs 76 +-- If you don't use statusbar, you can use dynamicLogString to show on-screen +-- notifications in response to some events. E.g. to show current layout when +-- it's changed create apropriate PP and add to keybindings: +-- +-- > , ((mod1Mask, xK_a ), sendMessage NextLayout >> (dynamicLogString myPP >>= \d->spawn $"xmessage "++d)) hunk ./XMonad/Hooks/DynamicLog.hs 126 --- A log function that uses the 'PP' hooks to customize output. -dynamicLogWithPP :: PP -> X () -dynamicLogWithPP pp = do +-- Returns formatted log message. +dynamicLogString :: PP -> X String +dynamicLogString pp = do hunk ./XMonad/Hooks/DynamicLog.hs 139 - io . ppOutput pp . sepBy (ppSep pp) . ppOrder pp $ + return $ sepBy (ppSep pp) . ppOrder pp $ hunk ./XMonad/Hooks/DynamicLog.hs 145 +-- | +-- A log function that uses the 'PP' hooks to customize output. +dynamicLogWithPP :: PP -> X () +dynamicLogWithPP pp = dynamicLogString pp >>= io . ppOutput pp + hunk ./XMonad/Layout/Decoration.hs 33 +import Control.Monad (when) hunk ./XMonad/Layout/Decoration.hs 110 - decoEventHook :: ds a -> DecorationState -> Event -> X () - decoEventHook _ (DS dwrs@(((_,r),(dw,_)):_) _) ButtonEvent { ev_window = ew - , ev_event_type = et - , ev_x_root = ex - , ev_y_root = ey } - | et == buttonPress - , ew == dw = mouseDrag (\x y -> do - let rect = Rectangle (x - (fi ex - rect_x r)) - (y - (fi ey - rect_y r)) - (rect_width r) - (rect_height r) - sendMessage (SetGeometry rect)) (return ()) - | et == buttonPress - , Just ((mainw,_),_) <- lookFor ew dwrs = focus mainw - decoEventHook _ _ _ = return () + decorationEventHook :: ds a -> DecorationState -> Event -> X () + decorationEventHook ds s e = do decorationMouseFocusHook ds s e + decorationMouseDragHook ds s e + decorationMouseResizeHook ds s e + + decorationMouseFocusHook :: ds a -> DecorationState -> Event -> X () + decorationMouseFocusHook _ s e = handleMouseFocusDrag False s e + + decorationMouseDragHook :: ds a -> DecorationState -> Event -> X () + decorationMouseDragHook _ s e = handleMouseFocusDrag True s e + + decorationMouseResizeHook :: ds a -> DecorationState -> Event -> X () + decorationMouseResizeHook _ s e = handleMouseResize s e hunk ./XMonad/Layout/Decoration.hs 180 - | Just e <- fromMessage m :: Maybe Event = do decoEventHook ds s e + | Just e <- fromMessage m :: Maybe Event = do decorationEventHook ds s e hunk ./XMonad/Layout/Decoration.hs 205 +handleMouseFocusDrag :: Bool -> DecorationState -> Event -> X () +handleMouseFocusDrag b (DS dwrs _) ButtonEvent { ev_window = ew + , ev_event_type = et + , ev_x_root = ex + , ev_y_root = ey } + | et == buttonPress + , Just ((mainw,r),_) <- lookFor ew dwrs = do + focus mainw + when b $ mouseDrag (\x y -> do + let rect = Rectangle (x - (fi ex - rect_x r)) + (y - (fi ey - rect_y r)) + (rect_width r) + (rect_height r) + sendMessage (SetGeometry rect)) (return ()) +handleMouseFocusDrag _ _ _ = return () + +handleMouseResize :: DecorationState -> Event -> X () +handleMouseResize _ _ = return () + hunk ./XMonad/Layout/DecorationMadness.hs 147 + decorationMouseDragHook _ _ _ = return () hunk ./XMonad/Layout/Tabbed.hs 94 + decorationMouseDragHook _ _ _ = return () hunk ./XMonad/Layout/Decoration.hs 160 - insert_dwr otherRs (((w,r),(dw,Just dr)):zzz) - | r `elem` otherRs = (dw,dr):insert_dwr otherRs zzz - | otherwise = (dw,dr):(w, shrink ds dr r):insert_dwr (r:otherRs) zzz - insert_dwr otherRs (((w,r),(_ ,Nothing)):zzz) = (w,r):insert_dwr (r:otherRs) zzz + insert_dwr otherRs (((w,r),(dw,Just dr)):dwrs) + | r `elem` otherRs = (dw,dr):insert_dwr otherRs dwrs + | otherwise = (dw,dr):(w, shrink ds dr r):insert_dwr (r:otherRs) dwrs + insert_dwr otherRs (((w,r),(_ ,Nothing)):dwrs) = (w,r):insert_dwr (r:otherRs) dwrs hunk ./XMonad/Layout/Decoration.hs 225 -lookFor w ((x,(w',y)):zs) | w == w' = Just (x,(w',y)) - | otherwise = lookFor w zs +lookFor w ((wr,(dw,dr)):dwrs) | w == dw = Just (wr,(dw,dr)) + | otherwise = lookFor w dwrs hunk ./XMonad/Layout/Decoration.hs 113 - decorationMouseResizeHook ds s e hunk ./XMonad/Layout/Decoration.hs 120 - decorationMouseResizeHook :: ds a -> DecorationState -> Event -> X () - decorationMouseResizeHook _ s e = handleMouseResize s e - hunk ./XMonad/Layout/Decoration.hs 147 - del_dwrs = listFromList get_w notElem hunk ./XMonad/Layout/Decoration.hs 149 + del_dwrs = listFromList get_w notElem hunk ./XMonad/Layout/Decoration.hs 154 - -- We drop any windows that are *precisely* stacked underneath - -- another window: these must be intended to be tabbed! - insert_dwr otherRs (((w,r),(dw,Just dr)):dwrs) - | r `elem` otherRs = (dw,dr):insert_dwr otherRs dwrs - | otherwise = (dw,dr):(w, shrink ds dr r):insert_dwr (r:otherRs) dwrs - insert_dwr otherRs (((w,r),(_ ,Nothing)):dwrs) = (w,r):insert_dwr (r:otherRs) dwrs - insert_dwr _ [] = [] + decorate_first = length wrs == 1 && (not . decorateFirst $ ds) hunk ./XMonad/Layout/Decoration.hs 163 - decorate_first = length wrs == 1 && (not . decorateFirst $ ds) + -- We drop any windows that are *precisely* stacked underneath + -- another window: these must be intended to be tabbed! + remove_stacked rs ((w,r):xs) + | r `elem` rs = remove_stacked rs xs + | otherwise = (w,r) : remove_stacked (r:rs) xs + remove_stacked _ [] = [] + + insert_dwr ((w,r),(dw,Just dr)) xs = (dw,dr):(w, shrink ds dr r):xs + insert_dwr (x ,(_ ,Nothing)) xs = x:xs + + dwrs_to_wrs = remove_stacked [] . foldr insert_dwr [] + hunk ./XMonad/Layout/Decoration.hs 178 - return (insert_dwr [] ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh t ds)) + return (dwrs_to_wrs ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh t ds)) hunk ./XMonad/Layout/Decoration.hs 222 -handleMouseResize :: DecorationState -> Event -> X () -handleMouseResize _ _ = return () - addfile ./XMonad/Actions/MouseResize.hs hunk ./XMonad/Actions/MouseResize.hs 1 +{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.MouseResize +-- Copyright : (c) 2007 Andrea Rossato +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A layout modifier to resize windows with the mouse by grabbing the +-- window's lower right corner. +-- +-- This module must be used together with "XMonad.Layout.WindowArranger". +----------------------------------------------------------------------------- + +module XMonad.Actions.MouseResize + ( -- * Usage: + -- $usage + mouseResize + , MouseResize (..) + ) where + +import Control.Monad + +import XMonad +import XMonad.Layout.Decoration +import XMonad.Layout.LayoutModifier + +import XMonad.Layout.WindowArranger +import XMonad.Util.XUtils + +-- $usage +-- Usually this module is used to create layouts, but you can also use +-- it to resize windows in any layout, together with the +-- "XMonad.Layout.WindowArranger". For usage example see +-- "XMonad.Layout.SimpleFloat" or "XMonad.Layout.DecorationMadness". +-- +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.MouseResize +-- > import XMonad.Layout.WindowArranger +-- +-- Then edit your @layoutHook@ by modifying a given layout: +-- +-- > myLayouts = mouseResize $ windowArrange $ layoutHook defaultConfig +-- +-- and then: +-- +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +mouseResize :: l a -> ModifiedLayout MouseResize l a +mouseResize = ModifiedLayout (MR []) + +data MouseResize a = MR [((a,Rectangle),a)] +instance Show (MouseResize a) where show _ = [] +instance Read (MouseResize a) where readsPrec _ _ = [] + +instance LayoutModifier MouseResize Window where + redoLayout (MR st) _ _ wrs + | [] <- st = do nst <- filterM (liftM not . isDecoration . fst) wrs >>= initState + return (wrs, Just $ MR nst) + | otherwise = do nst <- filterM (liftM not . isDecoration . fst) wrs >>= processState + return (wrs, Just $ MR nst) + where + initState ws = mapM createInputWindow ws + processState ws = deleteWindows (map snd st) >> mapM createInputWindow ws + + handleMess (MR s) m + | Just e <- fromMessage m :: Maybe Event = handleResize s e >> return Nothing + | Just Hide <- fromMessage m = releaseResources >> return (Just $ MR []) + | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ MR []) + where releaseResources = deleteWindows (map snd s) + handleMess _ _ = return Nothing + +handleResize :: [((Window,Rectangle),Window)] -> Event -> X () +handleResize st ButtonEvent { ev_window = ew, ev_event_type = et } + | et == buttonPress + , Just (w,Rectangle wx wy _ _) <- getWin ew st = do + focus w + mouseDrag (\x y -> do + let rect = Rectangle wx wy + (max 1 . fi $ x - wx) + (max 1 . fi $ y - wy) + sendMessage (SetGeometry rect)) (return ()) + + where + getWin w (((win,r),w'):xs) + | w == w' = Just (win,r) + | otherwise = getWin w xs + getWin _ [] = Nothing +handleResize _ _ = return () + +createInputWindow :: (Window,Rectangle) -> X ((Window,Rectangle),Window) +createInputWindow (w,r@(Rectangle x y wh ht)) = do + d <- asks display + let rect = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10 + tw <- mkInputWindow d rect + io $ selectInput d tw (exposureMask .|. buttonPressMask) + showWindow tw + return ((w,r),tw) + +mkInputWindow :: Display -> Rectangle -> X Window +mkInputWindow d (Rectangle x y w h) = do + rw <- asks theRoot + let screen = defaultScreenOfDisplay d + visual = defaultVisualOfScreen screen + attrmask = cWOverrideRedirect + io $ allocaSetWindowAttributes $ + \attributes -> do + set_override_redirect attributes True + createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes hunk ./xmonad-contrib.cabal 75 + XMonad.Actions.MouseResize hunk ./XMonad/Layout/SimpleFloat.hs 28 +import XMonad.Actions.MouseResize hunk ./XMonad/Layout/SimpleFloat.hs 53 - (ModifiedLayout WindowArranger SimpleFloat) a -simpleFloat = decoration shrinkText defaultTheme (Simple False) (windowArrangeAll $ SF 20) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a +simpleFloat = decoration shrinkText defaultTheme (Simple False) (mouseResize $ windowArrangeAll $ SF 20) hunk ./XMonad/Layout/SimpleFloat.hs 60 - (ModifiedLayout WindowArranger SimpleFloat) a -simpleFloat' s c = decoration s c (Simple False) (windowArrangeAll $ SF (decoHeight c)) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a +simpleFloat' s c = decoration s c (Simple False) (mouseResize $ windowArrangeAll $ SF (decoHeight c)) hunk ./XMonad/Layout/DecorationMadness.hs 92 +import XMonad.Actions.MouseResize hunk ./XMonad/Layout/DecorationMadness.hs 195 -circleSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout WindowArranger Circle) Window -circleSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (windowArrange Circle) +circleSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window +circleSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange Circle) hunk ./XMonad/Layout/DecorationMadness.hs 202 - -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout WindowArranger Circle) Window -circleDefaultResizable s t = decoration s t DefaultDecoration (windowArrange Circle) + -> ModifiedLayout (Decoration DefaultDecoration s) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window +circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange Circle) hunk ./XMonad/Layout/DecorationMadness.hs 213 -circleSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout WindowArranger Circle) Window -circleSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (windowArrange Circle) +circleSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window +circleSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange Circle) hunk ./XMonad/Layout/DecorationMadness.hs 220 - -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout WindowArranger Circle) Window -circleDecoResizable s t = decoration s t (Simple True) (windowArrange Circle) + -> ModifiedLayout (Decoration SimpleDecoration s) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window +circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange Circle) hunk ./XMonad/Layout/DecorationMadness.hs 292 -accordionSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout WindowArranger Accordion) Window -accordionSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (windowArrange Accordion) +accordionSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window +accordionSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange Accordion) hunk ./XMonad/Layout/DecorationMadness.hs 299 - -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout WindowArranger Accordion) Window -accordionDefaultResizable s t = decoration s t DefaultDecoration (windowArrange Accordion) + -> ModifiedLayout (Decoration DefaultDecoration s) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window +accordionDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange Accordion) hunk ./XMonad/Layout/DecorationMadness.hs 306 -accordionSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout WindowArranger Accordion) Window -accordionSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (windowArrange Accordion) +accordionSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window +accordionSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange Accordion) hunk ./XMonad/Layout/DecorationMadness.hs 313 - -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout WindowArranger Accordion) Window -accordionDecoResizable s t = decoration s t (Simple True) (windowArrange Accordion) + -> ModifiedLayout (Decoration SimpleDecoration s) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window +accordionDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange Accordion) hunk ./XMonad/Layout/DecorationMadness.hs 392 -tallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout WindowArranger Tall) Window -tallSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (windowArrange tall) +tallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window +tallSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange tall) hunk ./XMonad/Layout/DecorationMadness.hs 399 - -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout WindowArranger Tall) Window -tallDefaultResizable s t = decoration s t DefaultDecoration (windowArrange tall) + -> ModifiedLayout (Decoration DefaultDecoration s) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window +tallDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange tall) hunk ./XMonad/Layout/DecorationMadness.hs 410 -tallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout WindowArranger Tall) Window -tallSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (windowArrange tall) +tallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window +tallSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange tall) hunk ./XMonad/Layout/DecorationMadness.hs 417 - -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout WindowArranger Tall) Window -tallDecoResizable s t = decoration s t (Simple True) (windowArrange tall) + -> ModifiedLayout (Decoration SimpleDecoration s) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window +tallDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange tall) hunk ./XMonad/Layout/DecorationMadness.hs 495 -mirrorTallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout WindowArranger (Mirror Tall)) Window -mirrorTallSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (windowArrange mirrorTall) +mirrorTallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window +mirrorTallSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange mirrorTall) hunk ./XMonad/Layout/DecorationMadness.hs 502 - -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout WindowArranger (Mirror Tall)) Window -mirrorTallDefaultResizable s t = decoration s t DefaultDecoration (windowArrange mirrorTall) + -> ModifiedLayout (Decoration DefaultDecoration s) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window +mirrorTallDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange mirrorTall) hunk ./XMonad/Layout/DecorationMadness.hs 513 -mirrorTallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout WindowArranger (Mirror Tall)) Window -mirrorTallSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (windowArrange mirrorTall) +mirrorTallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window +mirrorTallSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange mirrorTall) hunk ./XMonad/Layout/DecorationMadness.hs 520 - -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout WindowArranger (Mirror Tall)) Window -mirrorTallDecoResizable s t = decoration s t (Simple True) (windowArrange mirrorTall) + -> ModifiedLayout (Decoration SimpleDecoration s) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window +mirrorTallDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange mirrorTall) hunk ./XMonad/Layout/DecorationMadness.hs 565 - (ModifiedLayout WindowArranger SimpleFloat) a + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a hunk ./XMonad/Layout/DecorationMadness.hs 570 - (ModifiedLayout WindowArranger SimpleFloat) a + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a hunk ./XMonad/Layout/DecorationMadness.hs 579 - (ModifiedLayout WindowArranger SimpleFloat) a -floatSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration (windowArrangeAll $ SF 20) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a +floatSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrangeAll $ SF 20) hunk ./XMonad/Layout/DecorationMadness.hs 586 - (ModifiedLayout WindowArranger SimpleFloat) a -floatDefault s c = decoration s c DefaultDecoration (windowArrangeAll $ SF (decoHeight c)) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a +floatDefault s c = decoration s c DefaultDecoration (mouseResize $ windowArrangeAll $ SF (decoHeight c)) hunk ./XMonad/Layout/DecorationMadness.hs 596 - (ModifiedLayout WindowArranger SimpleFloat) a -floatSimpleDwmStyle = decoration shrinkText defaultTheme Dwm (windowArrangeAll $ SF 20) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a +floatSimpleDwmStyle = decoration shrinkText defaultTheme Dwm (mouseResize $ windowArrangeAll $ SF 20) hunk ./XMonad/Layout/DecorationMadness.hs 603 - (ModifiedLayout WindowArranger SimpleFloat) a -floatDwmStyle s c = decoration s c Dwm (windowArrangeAll $ SF (decoHeight c)) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a +floatDwmStyle s c = decoration s c Dwm (mouseResize $ windowArrangeAll $ SF (decoHeight c)) hunk ./XMonad/Layout/DecorationMadness.hs 613 - (ModifiedLayout WindowArranger SimpleFloat) a -floatSimpleTabbed = decoration shrinkText defaultTheme SimpleTabbed (windowArrangeAll $ SF 20) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a +floatSimpleTabbed = decoration shrinkText defaultTheme SimpleTabbed (mouseResize $ windowArrangeAll $ SF 20) hunk ./XMonad/Layout/DecorationMadness.hs 620 - (ModifiedLayout WindowArranger SimpleFloat) a -floatTabbed s c = decoration s c SimpleTabbed (windowArrangeAll $ SF (decoHeight c)) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a +floatTabbed s c = decoration s c SimpleTabbed (mouseResize $ windowArrangeAll $ SF (decoHeight c)) hunk ./XMonad/Util/Themes.hs 19 + , ppThemeInfo hunk ./XMonad/Util/Themes.hs 72 +ppThemeInfo :: ThemeInfo -> String +ppThemeInfo t = themeName t <> themeDescription t <> "by" <> themeAuthor t + where "" <> x = x + x <> y = x ++ " - " ++ y + + hunk ./XMonad/Prompt.hs 108 + nextCompletion (XPT t) c l = nextCompletion t c l + commandToComplete (XPT t) c = commandToComplete t c hunk ./XMonad/Prompt.hs 124 + nextCompletion :: t -> String -> [String] -> String + nextCompletion t c l = newCommand t c l + + commandToComplete :: t -> String -> String + commandToComplete _ c = getLastWord c + hunk ./XMonad/Prompt.hs 266 - l -> do let new_command = newCommand (command st) l + l -> do let new_command = nextCompletion (xptype st) (command st) l --newCommand (command st) l hunk ./XMonad/Prompt.hs 278 --- | Given a completion and a list of possible completions, returns the --- index of the next completion in the list -newIndex :: String -> [String] -> Int -newIndex com cl = - case elemIndex (getLastWord com) cl of - Just i -> if i >= length cl - 1 then 0 else i + 1 - Nothing -> 0 - --- | Given a completion and a list of possible completions, returns the --- the next completion in the list -newCommand :: String -> [String] -> String -newCommand com cl = - skipLastWord com ++ (cl !! (newIndex com cl)) - hunk ./XMonad/Prompt.hs 500 - io $ (completionFunction s) (getLastWord $ command s) + io $ (completionFunction s) (commandToComplete (xptype s) (command s)) hunk ./XMonad/Prompt.hs 561 - let c = config st - d = dpy st + let c = config st + d = dpy st hunk ./XMonad/Prompt.hs 564 - bw = promptBorderWidth c - gc = gcon st + bw = promptBorderWidth c + gc = gcon st hunk ./XMonad/Prompt.hs 616 - if s == getLastWord (command st) + if s == commandToComplete (xptype st) (command st) hunk ./XMonad/Prompt.hs 708 +-- | Given a completion and a list of possible completions, returns the +-- the next completion in the list +newCommand :: XPrompt t => t -> String -> [String] -> String +newCommand t com cl = + skipLastWord com ++ (cl !! (newIndex t com cl)) + +-- | Given a completion and a list of possible completions, returns the +-- index of the next completion in the list +newIndex :: XPrompt t => t -> String -> [String] -> Int +newIndex t com cl = + case elemIndex (commandToComplete t com) cl of + Just i -> if i >= length cl - 1 then 0 else i + 1 + Nothing -> 0 + hunk ./XMonad/Prompt/Shell.hs 30 +import System.Posix.Files hunk ./XMonad/Prompt/Shell.hs 82 - f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file " ++ s ++ "\n") - return . map escape . uniqSort $ f ++ commandCompletionFunction cmds s + f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file " ++ s ++ "\n") + files <- case f of + [x] -> do fs <- getFileStatus x + if isDirectory fs then return [x ++ "/"] + else return [x] + _ -> return f + return . map escape . uniqSort $ files ++ commandCompletionFunction cmds s hunk ./XMonad/Prompt/Theme.hs 23 +import Data.List hunk ./XMonad/Prompt/Theme.hs 47 + commandToComplete _ c = c + nextCompletion _ c l = l !! idx + where idx = case c `elemIndex` l of + Just i -> if i >= length l - 1 then 0 else i + 1 + Nothing -> 0 hunk ./XMonad/Prompt/Theme.hs 54 -themePrompt c = mkXPrompt ThemePrompt c (const . return . map themeName $ listOfThemes) changeTheme +themePrompt c = mkXPrompt ThemePrompt c (const . return . map ppThemeInfo $ listOfThemes) changeTheme hunk ./XMonad/Prompt/Theme.hs 58 -mapOfThemes = M.fromList . uncurry zip . (map themeName &&& map theme) $ listOfThemes +mapOfThemes = M.fromList . uncurry zip . (map ppThemeInfo &&& map theme) $ listOfThemes hunk ./XMonad/Actions/TagWindows.hs 197 - -mkComplFunFromList' :: [String] -> String -> IO [String] -mkComplFunFromList' l [] = return l -mkComplFunFromList' l s = - return $ filter (\x -> take (length s) x == s) l - hunk ./XMonad/Prompt.hs 23 + , mkComplFunFromList' hunk ./XMonad/Prompt.hs 35 + , getNextCompletion + , getNextOfLastWord hunk ./XMonad/Prompt.hs 41 - , newIndex - , newCommand hunk ./XMonad/Prompt.hs 108 - showXPrompt = show - nextCompletion (XPT t) c l = nextCompletion t c l - commandToComplete (XPT t) c = commandToComplete t c + showXPrompt = show + nextCompletion (XPT t) = nextCompletion t + commandToComplete (XPT t) = commandToComplete t + completionToCommand (XPT t) = completionToCommand t hunk ./XMonad/Prompt.hs 124 + + -- | This method is used to print the string to be + -- displayed in the command line window. hunk ./XMonad/Prompt.hs 129 + -- | This method is used to generate the next completion to be + -- printed in the command line when tab is pressed, given the + -- string presently in the command line and the list of + -- completion. hunk ./XMonad/Prompt.hs 134 - nextCompletion t c l = newCommand t c l + nextCompletion t c l = getNextOfLastWord t c l hunk ./XMonad/Prompt.hs 136 + -- | If the prompt is using 'getNextOfLastWord' for implementing + -- 'nextCompletion' (the default implementation), this is used to + -- generate the string to be passed to the completion function. hunk ./XMonad/Prompt.hs 142 + -- | If the prompt is using 'getNextOfLastWord' for implementing + -- 'nextCompletion' (the default implementation), this is used to + -- generate the string to compare each completion with the + -- command presently in the command line. + completionToCommand :: t -> String -> String + completionToCommand _ c = c + hunk ./XMonad/Prompt.hs 635 - if s == commandToComplete (xptype st) (command st) + if completionToCommand (xptype st) s == commandToComplete (xptype st) (command st) hunk ./XMonad/Prompt.hs 713 +-- | This function takes a list of possible completions and returns a +-- completions function to be used with 'mkXPrompt'. If the string is +-- null it will return all completions. +mkComplFunFromList' :: [String] -> String -> IO [String] +mkComplFunFromList' l [] = return l +mkComplFunFromList' l s = + return $ filter (\x -> take (length s) x == s) l + hunk ./XMonad/Prompt.hs 735 --- | Given a completion and a list of possible completions, returns the --- the next completion in the list -newCommand :: XPrompt t => t -> String -> [String] -> String -newCommand t com cl = - skipLastWord com ++ (cl !! (newIndex t com cl)) +-- | Given a command and a completion list, get the next completion in +-- the list. +getNextCompletion :: String -> [String] -> String +getNextCompletion c l = l !! idx + where idx = case c `elemIndex` l of + Just i -> if i >= length l - 1 then 0 else i + 1 + Nothing -> 0 hunk ./XMonad/Prompt.hs 744 --- index of the next completion in the list -newIndex :: XPrompt t => t -> String -> [String] -> Int -newIndex t com cl = - case elemIndex (commandToComplete t com) cl of - Just i -> if i >= length cl - 1 then 0 else i + 1 - Nothing -> 0 +-- the next completion in the list +getNextOfLastWord :: XPrompt t => t -> String -> [String] -> String +getNextOfLastWord t c l = skipLastWord c ++ completionToCommand t (l !! ni) + where ni = case commandToComplete t c `elemIndex` map (completionToCommand t) l of + Just i -> if i >= length l - 1 then 0 else i + 1 + Nothing -> 0 hunk ./XMonad/Prompt/Shell.hs 51 - showXPrompt Shell = "Run: " + showXPrompt Shell = "Run: " + completionToCommand _ = escape hunk ./XMonad/Prompt/Shell.hs 89 - return . map escape . uniqSort $ files ++ commandCompletionFunction cmds s + return . uniqSort $ files ++ commandCompletionFunction cmds s hunk ./XMonad/Prompt/Theme.hs 48 - nextCompletion _ c l = l !! idx - where idx = case c `elemIndex` l of - Just i -> if i >= length l - 1 then 0 else i + 1 - Nothing -> 0 + nextCompletion _ = getNextCompletion hunk ./XMonad/Prompt/Window.hs 53 - showXPrompt Goto = "Go to window: " - showXPrompt Bring = "Bring me here: " + showXPrompt Goto = "Go to window: " + showXPrompt Bring = "Bring me here: " + commandToComplete _ c = c + nextCompletion _ = getNextCompletion hunk ./XMonad/Prompt/Window.hs 74 - winAction a m = flip whenJust (windows . a) . flip M.lookup m . unescape + winAction a m = flip whenJust (windows . a) . flip M.lookup m hunk ./XMonad/Prompt/Window.hs 79 - compList m s = return . filter (isPrefixOf s) . map (escape . fst) . M.toList $ m - - escape [] = [] - escape (' ':xs) = "\\ " ++ escape xs - escape (x :xs) = x : escape xs - - unescape [] = [] - unescape ('\\':' ':xs) = ' ' : unescape xs - unescape (x:xs) = x : unescape xs + compList m s = return . filter (isPrefixOf s) . map fst . M.toList $ m hunk ./XMonad/Prompt/XMonad.hs 47 - mkXPrompt XMonad c (mkComplFunFromList (map fst cmds)) runCommand' + mkXPrompt XMonad c (mkComplFunFromList' (map fst cmds)) runCommand' hunk ./XMonad/Prompt/XMonad.hs 51 -xmonadPromptC commands c = mkXPrompt XMonad c (mkComplFunFromList (map fst commands)) runCommand' +xmonadPromptC commands c = mkXPrompt XMonad c (mkComplFunFromList' (map fst commands)) runCommand' hunk ./XMonad/Prompt.hs 22 - , mkComplFunFromList - , mkComplFunFromList' hunk ./XMonad/Prompt.hs 33 - , getNextCompletion + , mkComplFunFromList + , mkComplFunFromList' + -- * @nextCompletion@ implementations hunk ./XMonad/Prompt.hs 37 + , getNextCompletion + -- * List utilities hunk ./XMonad/Prompt.hs 139 - -- 'nextCompletion' (the default implementation), this is used to - -- generate the string to be passed to the completion function. + -- 'nextCompletion' (the default implementation), this method is + -- used to generate the string to be passed to the completion + -- function. hunk ./XMonad/Prompt.hs 146 - -- 'nextCompletion' (the default implementation), this is used to - -- generate the string to compare each completion with the - -- command presently in the command line. + -- 'nextCompletion' (the default implementation), this method is + -- used to process each completion in order to generate the string + -- that will be compared with the command presently displayed in + -- the command line. hunk ./XMonad/Prompt.hs 725 + +-- | Given the prompt type, the command line and the completion list, +-- return the next completion in the list for the last word of the +-- command line. This is the default 'nextCompletion' implementation. +getNextOfLastWord :: XPrompt t => t -> String -> [String] -> String +getNextOfLastWord t c l = skipLastWord c ++ completionToCommand t (l !! ni) + where ni = case commandToComplete t c `elemIndex` map (completionToCommand t) l of + Just i -> if i >= length l - 1 then 0 else i + 1 + Nothing -> 0 + +-- | An alternative 'nextCompletion' implementation: given a command +-- and a completion list, get the next completion in the list matching +-- the whole command line. +getNextCompletion :: String -> [String] -> String +getNextCompletion c l = l !! idx + where idx = case c `elemIndex` l of + Just i -> if i >= length l - 1 then 0 else i + 1 + Nothing -> 0 + hunk ./XMonad/Prompt.hs 758 --- | Given a command and a completion list, get the next completion in --- the list. -getNextCompletion :: String -> [String] -> String -getNextCompletion c l = l !! idx - where idx = case c `elemIndex` l of - Just i -> if i >= length l - 1 then 0 else i + 1 - Nothing -> 0 - --- | Given a completion and a list of possible completions, returns the --- the next completion in the list -getNextOfLastWord :: XPrompt t => t -> String -> [String] -> String -getNextOfLastWord t c l = skipLastWord c ++ completionToCommand t (l !! ni) - where ni = case commandToComplete t c `elemIndex` map (completionToCommand t) l of - Just i -> if i >= length l - 1 then 0 else i + 1 - Nothing -> 0 - hunk ./XMonad/Prompt.hs 138 - -- | If the prompt is using 'getNextOfLastWord' for implementing - -- 'nextCompletion' (the default implementation), this method is - -- used to generate the string to be passed to the completion - -- function. + -- | This method is used to generate the string to be passed to + -- the completion function. hunk ./XMonad/Prompt.hs 143 - -- | If the prompt is using 'getNextOfLastWord' for implementing - -- 'nextCompletion' (the default implementation), this method is - -- used to process each completion in order to generate the string - -- that will be compared with the command presently displayed in - -- the command line. + -- | This method is used to process each completion in order to + -- generate the string that will be compared with the command + -- presently displayed in the command line. If the prompt is using + -- 'getNextOfLastWord' for implementing 'nextCompletion' (the + -- default implementation), this method is also used to generate, + -- from the returned completion, the string that will form the + -- next command line when tab is pressed. hunk ./XMonad/Prompt/Shell.hs 15 -module XMonad.Prompt.Shell( - -- * Usage - -- $usage - shellPrompt - , getShellCompl - , split - , prompt - , safePrompt - ) where +module XMonad.Prompt.Shell + ( -- * Usage + -- $usage + shellPrompt + , getShellCompl + , split + , prompt + , safePrompt + ) where hunk ./XMonad/Prompt.hs 289 - l -> do let new_command = nextCompletion (xptype st) (command st) l --newCommand (command st) l + l -> do let new_command = nextCompletion (xptype st) (command st) l hunk ./XMonad/Prompt/Theme.hs 51 -themePrompt c = mkXPrompt ThemePrompt c (const . return . map ppThemeInfo $ listOfThemes) changeTheme +themePrompt c = mkXPrompt ThemePrompt c (mkComplFunFromList' . map ppThemeInfo $ listOfThemes) changeTheme hunk ./XMonad/Prompt.hs 286 + let updateState l = do let new_command = nextCompletion (xptype st) (command st) l + modify $ \s -> s { command = new_command, offset = length new_command } + updateWins l = do redrawWindows l + eventLoop (completionHandle l) hunk ./XMonad/Prompt.hs 291 - [] -> do updateWindows - eventLoop handle - l -> do let new_command = nextCompletion (xptype st) (command st) l - modify $ \s -> s { command = new_command, offset = length new_command } - redrawWindows c - eventLoop (completionHandle c) + [] -> updateWindows >> eventLoop handle + [x] -> updateState [x] >> getCompletions >>= updateWins + l -> updateState l >> updateWins l hunk ./XMonad/Actions/MouseResize.hs 27 +import Data.Maybe hunk ./XMonad/Actions/MouseResize.hs 63 -data MouseResize a = MR [((a,Rectangle),a)] -instance Show (MouseResize a) where show _ = [] -instance Read (MouseResize a) where readsPrec _ _ = [] +data MouseResize a = MR [((a,Rectangle),Maybe a)] +instance Show (MouseResize a) where show _ = "" +instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)] hunk ./XMonad/Actions/MouseResize.hs 68 - redoLayout (MR st) _ _ wrs - | [] <- st = do nst <- filterM (liftM not . isDecoration . fst) wrs >>= initState - return (wrs, Just $ MR nst) - | otherwise = do nst <- filterM (liftM not . isDecoration . fst) wrs >>= processState - return (wrs, Just $ MR nst) + redoLayout (MR st) _ s wrs + | [] <- st = initState >>= \nst -> return (wrs, Just $ MR nst) + | otherwise = processState >>= \nst -> return (wrs, Just $ MR nst) hunk ./XMonad/Actions/MouseResize.hs 72 - initState ws = mapM createInputWindow ws - processState ws = deleteWindows (map snd st) >> mapM createInputWindow ws + wrs' = wrs_to_state [] . filter (isInStack s . fst) $ wrs + initState = mapM createInputWindow wrs' + processState = mapM (deleteInputWin . snd) st >> mapM createInputWindow wrs' + + inputRectangle (Rectangle x y wh ht) = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10 + + wrs_to_state rs ((w,r):xs) + | ir `isVisible` rs = ((w,r),Just ir) : wrs_to_state (r:ir:rs) xs + | otherwise = ((w,r),Nothing) : wrs_to_state (r: rs) xs + where ir = inputRectangle r + wrs_to_state _ [] = [] hunk ./XMonad/Actions/MouseResize.hs 88 - where releaseResources = deleteWindows (map snd s) + where releaseResources = mapM_ (deleteInputWin . snd) s hunk ./XMonad/Actions/MouseResize.hs 91 -handleResize :: [((Window,Rectangle),Window)] -> Event -> X () +handleResize :: [((Window,Rectangle),Maybe Window)] -> Event -> X () hunk ./XMonad/Actions/MouseResize.hs 103 - getWin w (((win,r),w'):xs) - | w == w' = Just (win,r) + getWin w (((win,r),tw):xs) + | Just w' <- tw + , w == w' = Just (win,r) hunk ./XMonad/Actions/MouseResize.hs 110 -createInputWindow :: (Window,Rectangle) -> X ((Window,Rectangle),Window) -createInputWindow (w,r@(Rectangle x y wh ht)) = do - d <- asks display - let rect = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10 - tw <- mkInputWindow d rect - io $ selectInput d tw (exposureMask .|. buttonPressMask) - showWindow tw - return ((w,r),tw) +createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window) +createInputWindow ((w,r),mr) = do + case mr of + Just tr -> withDisplay $ \d -> do + tw <- mkInputWindow d tr + io $ selectInput d tw (exposureMask .|. buttonPressMask) + showWindow tw + return ((w,r), Just tw) + Nothing -> return ((w,r), Nothing) + +deleteInputWin :: Maybe Window -> X () +deleteInputWin = maybe (return ()) deleteWindow hunk ./XMonad/Layout/Decoration.hs 30 - , isDecoration, fi, lookFor + , isInStack, isVisible, isInvisible, isWithin + , lookFor, lookFor', fi hunk ./XMonad/Layout/Decoration.hs 228 +lookFor' :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,DecoWin) +lookFor' w (((w',r),dwr):dwrs) | w == w' = Just ((w,r),dwr) + | otherwise = lookFor' w dwrs +lookFor' _ [] = Nothing + hunk ./XMonad/Layout/Decoration.hs 280 -isDecoration :: Window -> X Bool -isDecoration w = withDisplay (io . flip getWindowAttributes w) >>= return . wa_override_redirect +isInStack :: Eq a => W.Stack a -> a -> Bool +isInStack s = flip elem (W.integrate s) + +isVisible :: Rectangle -> [Rectangle] -> Bool +isVisible r = and . foldr f [] + where f x xs = if r `isWithin` x then False : xs else True : xs + +isInvisible :: Rectangle -> [Rectangle] -> Bool +isInvisible r = not . isVisible r + +isWithin :: Rectangle -> Rectangle -> Bool +isWithin (Rectangle x y w h) (Rectangle rx ry rw rh) + | x >= rx, x <= rx + fi rw + , y >= ry, y <= ry + fi rh + , x + fi w <= rx + fi rw + , y + fi h <= ry + fi rh = True + | otherwise = False hunk ./XMonad/Layout/LayoutHints.hs 16 -module XMonad.Layout.LayoutHints ( - -- * usage - -- $usage - layoutHints, - LayoutHints) where +module XMonad.Layout.LayoutHints + ( -- * usage + -- $usage + layoutHints + , LayoutHints + ) where hunk ./XMonad/Layout/LayoutHints.hs 25 -import XMonad.Layout.Decoration ( isDecoration ) +import XMonad.Layout.Decoration ( isInStack ) + hunk ./XMonad/Layout/LayoutHints.hs 54 - redoLayout _ _ _ xs = do + redoLayout _ _ s xs = do hunk ./XMonad/Layout/LayoutHints.hs 61 - isd <- isDecoration w hunk ./XMonad/Layout/LayoutHints.hs 63 - return (w, if isd then r else Rectangle a b c' d') + return (w, if isInStack s w then r else Rectangle a b c' d') hunk ./XMonad/Layout/Decoration.hs 101 -class (Read (ds a), Show (ds a)) => DecorationStyle ds a where +class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where hunk ./XMonad/Layout/Decoration.hs 123 - pureDecoration _ _ h _ _ _ (_,Rectangle x y w _) = Just $ Rectangle x y w h + pureDecoration _ _ ht _ s _ (w,Rectangle x y wh _) = if isInStack s w + then Just $ Rectangle x y wh ht + else Nothing + hunk ./XMonad/Layout/Decoration.hs 133 -instance DecorationStyle DefaultDecoration a +instance Eq a => DecorationStyle DefaultDecoration a hunk ./XMonad/Layout/DecorationMadness.hs 87 + , SimpleTabbedDecoration (..) hunk ./XMonad/Layout/DecorationMadness.hs 150 - pureDecoration _ _ ht (Rectangle x y wh _) s wrs (w,_) = Just $ Rectangle nx y nwh (fi ht) + pureDecoration _ _ ht (Rectangle x y wh _) s wrs (w,_) = + if isInStack s w then Just $ Rectangle nx y nwh (fi ht) else Nothing hunk ./XMonad/Layout/DecorationMadness.hs 566 -floatSimpleSimple :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) +floatSimpleSimple :: Eq a => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) hunk ./XMonad/Layout/DecorationMadness.hs 570 -floatSimple :: Shrinker s => s -> Theme -> +floatSimple :: (Eq a, Shrinker s) => s -> Theme -> hunk ./XMonad/Layout/DecorationMadness.hs 580 -floatSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) +floatSimpleDefault :: Eq a => ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) hunk ./XMonad/Layout/DecorationMadness.hs 586 -floatDefault :: Shrinker s => s -> Theme -> +floatDefault :: (Eq a, Shrinker s) => s -> Theme -> hunk ./XMonad/Layout/DwmStyle.hs 65 - pureDecoration _ wh ht _ (Stack fw _ _) _ (win,Rectangle x y wid _) = - if win == fw then Nothing else Just $ Rectangle (fi nx) y nwh (fi ht) + pureDecoration _ wh ht _ s@(Stack fw _ _) _ (w,Rectangle x y wid _) = + if w == fw || not (isInStack s w) then Nothing else Just $ Rectangle (fi nx) y nwh (fi ht) hunk ./XMonad/Layout/SimpleDecoration.hs 56 -simpleDeco :: Shrinker s => s -> Theme +simpleDeco :: (Eq a, Shrinker s) => s -> Theme hunk ./XMonad/Layout/SimpleDecoration.hs 62 -instance DecorationStyle SimpleDecoration a where +instance Eq a => DecorationStyle SimpleDecoration a where hunk ./XMonad/Layout/SimpleDecoration.hs 66 - pureDecoration (Simple b) wh ht _ _ _ (_,Rectangle x y wid _) = - if b then Just $ Rectangle x y nwh ht else Just $ Rectangle x (y - fi ht) nwh ht + pureDecoration (Simple b) wh ht _ s _ (w,Rectangle x y wid _) = + if isInStack s w + then if b + then Just $ Rectangle x y nwh ht + else Just $ Rectangle x (y - fi ht) nwh ht + else Nothing hunk ./XMonad/Layout/SimpleFloat.hs 52 -simpleFloat :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) +simpleFloat :: Eq a => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) hunk ./XMonad/Layout/SimpleFloat.hs 58 -simpleFloat' :: Shrinker s => s -> Theme -> +simpleFloat' :: (Eq a, Shrinker s) => s -> Theme -> hunk ./XMonad/Layout/DecorationMadness.hs 1 -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} hunk ./XMonad/Layout/DecorationMadness.hs 86 - , SimpleTabbedDecoration (..) hunk ./XMonad/Layout/DecorationMadness.hs 88 -import Data.List hunk ./XMonad/Layout/DecorationMadness.hs 89 -import qualified XMonad.StackSet as S hunk ./XMonad/Layout/DecorationMadness.hs 93 +import XMonad.Layout.TabBarDecoration hunk ./XMonad/Layout/DecorationMadness.hs 133 --- --- NOTE: some of these layouts may not be working correctly with --- WindowNavigation and with some layout combinators. I hope to fix --- this problem shortly! - --- There may be a regression in Tabbed, and no tab is displayed when --- using it with other layouts. This is the reason for the following --- instance (to be removed!) -data SimpleTabbedDecoration a = SimpleTabbed deriving (Read, Show) -instance Eq a => DecorationStyle SimpleTabbedDecoration a where - describeDeco _ = "Tabbed" - decorateFirst _ = True - shrink _ _ r = r - decorationMouseDragHook _ _ _ = return () - pureDecoration _ _ ht (Rectangle x y wh _) s wrs (w,_) = - if isInStack s w then Just $ Rectangle nx y nwh (fi ht) else Nothing - where nwh = wh `div` max 1 (fi $ length wrs) - nx = case w `elemIndex` (S.integrate s) of - Just i -> x + (fi nwh * fi i) - Nothing -> x hunk ./XMonad/Layout/DecorationMadness.hs 224 -circleSimpleTabbed :: ModifiedLayout (Decoration SimpleTabbedDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Circle) Window -circleSimpleTabbed = decoration shrinkText defaultTheme SimpleTabbed (resizeVertical 20 Circle) +circleSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Circle) Window +circleSimpleTabbed = simpleTabBar (resizeVertical 20 Circle) hunk ./XMonad/Layout/DecorationMadness.hs 230 - -> ModifiedLayout (Decoration SimpleTabbedDecoration s) (ModifiedLayout ResizeScreen Circle) Window -circleTabbed s t = decoration s t SimpleTabbed (resizeVertical (fi $ decoHeight t) Circle) + -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Circle) Window +circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Circle) hunk ./XMonad/Layout/DecorationMadness.hs 317 -accordionSimpleTabbed :: ModifiedLayout (Decoration SimpleTabbedDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Accordion) Window -accordionSimpleTabbed = decoration shrinkText defaultTheme SimpleTabbed (resizeVertical 20 Accordion) +accordionSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Accordion) Window +accordionSimpleTabbed = simpleTabBar (resizeVertical 20 Accordion) hunk ./XMonad/Layout/DecorationMadness.hs 323 - -> ModifiedLayout (Decoration SimpleTabbedDecoration s) (ModifiedLayout ResizeScreen Accordion) Window -accordionTabbed s t = decoration s t SimpleTabbed (resizeVertical (fi $ decoHeight t) Accordion) + -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Accordion) Window +accordionTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Accordion) hunk ./XMonad/Layout/DecorationMadness.hs 421 -tallSimpleTabbed :: ModifiedLayout (Decoration SimpleTabbedDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Tall) Window -tallSimpleTabbed = decoration shrinkText defaultTheme SimpleTabbed (resizeVertical 20 tall) +tallSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Tall) Window +tallSimpleTabbed = simpleTabBar (resizeVertical 20 tall) hunk ./XMonad/Layout/DecorationMadness.hs 427 - -> ModifiedLayout (Decoration SimpleTabbedDecoration s) (ModifiedLayout ResizeScreen Tall) Window -tallTabbed s t = decoration s t SimpleTabbed (resizeVertical (fi $ decoHeight t) tall) + -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Tall) Window +tallTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) tall) hunk ./XMonad/Layout/DecorationMadness.hs 524 -mirrorTallSimpleTabbed :: ModifiedLayout (Decoration SimpleTabbedDecoration DefaultShrinker) (ModifiedLayout ResizeScreen (Mirror Tall)) Window -mirrorTallSimpleTabbed = decoration shrinkText defaultTheme SimpleTabbed (resizeVertical 20 mirrorTall) +mirrorTallSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen (Mirror Tall)) Window +mirrorTallSimpleTabbed = simpleTabBar (resizeVertical 20 mirrorTall) hunk ./XMonad/Layout/DecorationMadness.hs 530 - -> ModifiedLayout (Decoration SimpleTabbedDecoration s) (ModifiedLayout ResizeScreen (Mirror Tall)) Window -mirrorTallTabbed s t = decoration s t SimpleTabbed (resizeVertical (fi $ decoHeight t) mirrorTall) + -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen (Mirror Tall)) Window +mirrorTallTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) mirrorTall) hunk ./XMonad/Layout/DecorationMadness.hs 543 -floatSimpleSimple :: Eq a => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) +floatSimpleSimple :: (Show a, Eq a) => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) hunk ./XMonad/Layout/DecorationMadness.hs 547 -floatSimple :: (Eq a, Shrinker s) => s -> Theme -> +floatSimple :: (Show a, Eq a, Shrinker s) => s -> Theme -> hunk ./XMonad/Layout/DecorationMadness.hs 557 -floatSimpleDefault :: Eq a => ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) +floatSimpleDefault :: (Show a, Eq a) => ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) hunk ./XMonad/Layout/DecorationMadness.hs 563 -floatDefault :: (Eq a, Shrinker s) => s -> Theme -> +floatDefault :: (Show a, Eq a, Shrinker s) => s -> Theme -> hunk ./XMonad/Layout/DecorationMadness.hs 566 -floatDefault s c = decoration s c DefaultDecoration (mouseResize $ windowArrangeAll $ SF (decoHeight c)) +floatDefault s t = decoration s t DefaultDecoration (mouseResize $ windowArrangeAll $ SF (decoHeight t)) hunk ./XMonad/Layout/DecorationMadness.hs 574 -floatSimpleDwmStyle :: Eq a => ModifiedLayout (Decoration DwmStyle DefaultShrinker) +floatSimpleDwmStyle :: (Show a, Eq a) => ModifiedLayout (Decoration DwmStyle DefaultShrinker) hunk ./XMonad/Layout/DecorationMadness.hs 580 -floatDwmStyle :: (Eq a, Shrinker s) => s -> Theme -> +floatDwmStyle :: (Show a, Eq a, Shrinker s) => s -> Theme -> hunk ./XMonad/Layout/DecorationMadness.hs 583 -floatDwmStyle s c = decoration s c Dwm (mouseResize $ windowArrangeAll $ SF (decoHeight c)) +floatDwmStyle s t = decoration s t Dwm (mouseResize $ windowArrangeAll $ SF (decoHeight t)) hunk ./XMonad/Layout/DecorationMadness.hs 591 -floatSimpleTabbed :: Eq a => ModifiedLayout (Decoration SimpleTabbedDecoration DefaultShrinker) +floatSimpleTabbed :: (Show a, Eq a) => ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) hunk ./XMonad/Layout/DecorationMadness.hs 593 -floatSimpleTabbed = decoration shrinkText defaultTheme SimpleTabbed (mouseResize $ windowArrangeAll $ SF 20) +floatSimpleTabbed = simpleTabBar (mouseResize $ windowArrangeAll $ SF 20) hunk ./XMonad/Layout/DecorationMadness.hs 597 -floatTabbed :: (Eq a, Shrinker s) => s -> Theme -> - ModifiedLayout (Decoration SimpleTabbedDecoration s) +floatTabbed :: (Show a, Eq a, Shrinker s) => s -> Theme -> + ModifiedLayout (Decoration TabBarDecoration s) hunk ./XMonad/Layout/DecorationMadness.hs 600 -floatTabbed s c = decoration s c SimpleTabbed (mouseResize $ windowArrangeAll $ SF (decoHeight c)) +floatTabbed s t = tabBar s t Top (mouseResize $ windowArrangeAll $ SF (decoHeight t)) addfile ./XMonad/Layout/TabBarDecoration.hs hunk ./XMonad/Layout/TabBarDecoration.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.TabBarDecoration +-- Copyright : (c) 2007 Andrea Rossato +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A layout modifier to add a bar of tabs to your layouts. +----------------------------------------------------------------------------- + +module XMonad.Layout.TabBarDecoration + ( -- * Usage + -- $usage + simpleTabBar, tabBar + , defaultTheme, shrinkText + , TabBarDecoration (..), XPPosition (..) + ) where + +import Data.List +import XMonad +import qualified XMonad.StackSet as S +import XMonad.Layout.Decoration +import XMonad.Prompt ( XPPosition (..) ) +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.TabBarDecoration +-- +-- Then edit your @layoutHook@ by adding the layout you want: +-- +-- > main = xmonad defaultConfig { layoutHook = simpleTabBar $ layoutHook defaultConfig} +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- 'tabBar' will give you the possibility of setting a custom shrinker +-- and a custom theme. +-- +-- The deafult theme can be dynamically change with the xmonad theme +-- selector. See "XMonad.Prompt.Theme". For more themse, look at +-- "XMonad.Util.Themes" + +simpleTabBar :: Eq a => l a -> ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) l a +simpleTabBar = decoration shrinkText defaultTheme (TabBar Top) + +tabBar :: (Eq a, Shrinker s) => s -> Theme -> XPPosition -> l a -> ModifiedLayout (Decoration TabBarDecoration s) l a +tabBar s t p = decoration s t (TabBar p) + +data TabBarDecoration a = TabBar XPPosition deriving (Read, Show) + +instance Eq a => DecorationStyle TabBarDecoration a where + describeDeco _ = "TabBar" + decorateFirst _ = True + shrink _ _ r = r + decorationMouseDragHook _ _ _ = return () + pureDecoration (TabBar p) _ dht (Rectangle x y wh ht) s _ (w,_) = + if isInStack s w then Just $ Rectangle nx ny nwh (fi dht) else Nothing + where nwh = wh `div` max 1 (fi $ length $ S.integrate s) + ny = case p of + Top -> y + Bottom -> y + fi ht - fi dht + nx = case w `elemIndex` (S.integrate s) of + Just i -> x + (fi nwh * fi i) + Nothing -> x hunk ./xmonad-contrib.cabal 133 + XMonad.Layout.TabBarDecoration hunk ./XMonad/Layout/ResizeScreen.hs 21 - resizeHorizontal - , resizeVertical + resizeHorizontal, resizeVertical + , resizeHorizontalRight, resizeVerticalBottom hunk ./XMonad/Layout/ResizeScreen.hs 45 -resizeHorizontal i = ModifiedLayout (ResizeScreen H i) +resizeHorizontal i = ModifiedLayout (ResizeScreen L i) hunk ./XMonad/Layout/ResizeScreen.hs 48 -resizeVertical i = ModifiedLayout (ResizeScreen V i) +resizeVertical i = ModifiedLayout (ResizeScreen T i) + +resizeHorizontalRight :: Int -> l a -> ModifiedLayout ResizeScreen l a +resizeHorizontalRight i = ModifiedLayout (ResizeScreen R i) + +resizeVerticalBottom :: Int -> l a -> ModifiedLayout ResizeScreen l a +resizeVerticalBottom i = ModifiedLayout (ResizeScreen B i) hunk ./XMonad/Layout/ResizeScreen.hs 62 -data ResizeMode = H | V deriving (Read, Show) + +data ResizeMode = T | B | L | R deriving (Read, Show) hunk ./XMonad/Layout/ResizeScreen.hs 66 - modifyLayout m l re@(Rectangle x y w h) s - | ResizeScreen H i <- m = resize (Rectangle (x + fi i) y (w - fi i) h) - | ResizeScreen V i <- m = resize (Rectangle x (y + fi i) w (h - fi i)) + modifyLayout m l rect@(Rectangle x y w h) s + | ResizeScreen L i <- m = resize $ Rectangle (x + fi i) y (w - fi i) h + | ResizeScreen R i <- m = resize $ Rectangle x y (w - fi i) h + | ResizeScreen T i <- m = resize $ Rectangle x (y + fi i) w (h - fi i) + | ResizeScreen B i <- m = resize $ Rectangle x y w (h - fi i) hunk ./XMonad/Layout/ResizeScreen.hs 72 - | otherwise = resize re + | otherwise = resize rect hunk ./XMonad/Layout/DwmStyle.hs 49 --- > , inactiveTextColor = "red"} +-- > , inactiveTextColor = "red"} hunk ./XMonad/Layout/DecorationMadness.hs 225 -circleSimpleTabbed = simpleTabBar (resizeVertical 20 Circle) +circleSimpleTabbed = simpleTabBar Circle hunk ./XMonad/Layout/DecorationMadness.hs 318 -accordionSimpleTabbed = simpleTabBar (resizeVertical 20 Accordion) +accordionSimpleTabbed = simpleTabBar Accordion hunk ./XMonad/Layout/DecorationMadness.hs 422 -tallSimpleTabbed = simpleTabBar (resizeVertical 20 tall) +tallSimpleTabbed = simpleTabBar tall hunk ./XMonad/Layout/DecorationMadness.hs 525 -mirrorTallSimpleTabbed = simpleTabBar (resizeVertical 20 mirrorTall) +mirrorTallSimpleTabbed = simpleTabBar mirrorTall hunk ./XMonad/Layout/DecorationMadness.hs 593 -floatSimpleTabbed = simpleTabBar (mouseResize $ windowArrangeAll $ SF 20) +floatSimpleTabbed = tabBar shrinkText defaultTheme Top (mouseResize $ windowArrangeAll $ SF 20) hunk ./XMonad/Layout/TabBarDecoration.hs 21 + , module XMonad.Layout.ResizeScreen hunk ./XMonad/Layout/TabBarDecoration.hs 28 +import XMonad.Layout.ResizeScreen hunk ./XMonad/Layout/TabBarDecoration.hs 30 + hunk ./XMonad/Layout/TabBarDecoration.hs 52 -simpleTabBar :: Eq a => l a -> ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) l a -simpleTabBar = decoration shrinkText defaultTheme (TabBar Top) +-- | Add, on the top of the screen, a simple bar of tabs to a given +-- | layout, with the default theme and the default shrinker. +simpleTabBar :: Eq a => l a -> ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) + (ModifiedLayout ResizeScreen l) a +simpleTabBar = decoration shrinkText defaultTheme (TabBar Top) . resizeVertical 20 hunk ./XMonad/Layout/TabBarDecoration.hs 58 +-- | Same of 'simpleTabBar', but with the possibility of setting a +-- custom shrinker, a custom theme and the position: 'Top' or +-- 'Bottom'. hunk ./XMonad/Layout/TabBarDecoration.hs 73 - where nwh = wh `div` max 1 (fi $ length $ S.integrate s) - ny = case p of + where wrs = S.integrate s + nwh = wh `div` max 1 (fi $ length wrs) + ny = case p of hunk ./XMonad/Layout/TabBarDecoration.hs 78 - nx = case w `elemIndex` (S.integrate s) of + nx = case w `elemIndex` wrs of hunk ./XMonad/Layout/TabBarDecoration.hs 68 - decorateFirst _ = True hunk ./XMonad/Layout/Tabbed.hs 93 - decorateFirst _ = True hunk ./XMonad/Layout/Tabbed.hs 64 --- > mylayout = tabDeco shrinkText myTabConfig ||| Full ||| etc.. +-- > mylayout = tabbed shrinkText myTabConfig ||| Full ||| etc.. hunk ./XMonad/Layout/Decoration.hs 3 - hunk ./XMonad/Layout/Decoration.hs 29 - , isInStack, isVisible, isInvisible, isWithin - , lookFor, lookFor', fi + , isInStack, isVisible, isInvisible, isWithin, fi hunk ./XMonad/Layout/Decoration.hs 88 -type DecoWin = (Window,Maybe Rectangle) +type DecoWin = (Maybe Window, Maybe Rectangle) hunk ./XMonad/Layout/Decoration.hs 125 - hunk ./XMonad/Layout/Decoration.hs 136 - | I Nothing <- st = initState t wrs >>= processState + | I Nothing <- st = initState t ds sc stack wrs >>= processState hunk ./XMonad/Layout/Decoration.hs 141 - deleteWindows (getDWs toDel) - ndwrs <- createDecos t toAdd - processState (s {decos = ndwrs ++ del_dwrs d dwrs }) + deleteDecos (map snd toDel) + ndwrs <- createDecos t ds sc stack wrs toAdd + ndecos <- resync (ndwrs ++ del_dwrs d dwrs) wrs + processState (s {decos = ndecos }) hunk ./XMonad/Layout/Decoration.hs 172 - insert_dwr ((w,r),(dw,Just dr)) xs = (dw,dr):(w, shrink ds dr r):xs - insert_dwr (x ,(_ ,Nothing)) xs = x:xs + insert_dwr ((w,r),(Just dw,Just dr)) xs = (dw,dr):(w, shrink ds dr r):xs + insert_dwr (x ,( _ , _ )) xs = x:xs hunk ./XMonad/Layout/Decoration.hs 177 - processState s = do ndwrs <- resync (decos s) wrs - showWindows (getDWs ndwrs) + processState s = do let ndwrs = decos s + showDecos (map snd ndwrs) hunk ./XMonad/Layout/Decoration.hs 186 - | Just Hide <- fromMessage m = do hideWindows (getDWs dwrs) + | Just Hide <- fromMessage m = do hideDecos (map snd dwrs) hunk ./XMonad/Layout/Decoration.hs 194 - emptyLayoutMod (Decoration (I (Just (DS dwrs f))) sh t ds) _ _ = do - deleteWindows (getDWs dwrs) - releaseXMF f + emptyLayoutMod (Decoration (I (Just s)) sh t ds) _ _ = do + releaseResources s hunk ./XMonad/Layout/Decoration.hs 203 - | PropertyEvent {ev_window = w} <- e, w `elem` (map (fst . fst) dwrs) = updateDecos sh t fs dwrs - | ExposeEvent {ev_window = w} <- e, w `elem` (map (fst . snd) dwrs) = updateDecos sh t fs dwrs + | PropertyEvent {ev_window = w} <- e + , w `elem` (map (fst . fst) dwrs) = updateDecos sh t fs dwrs + | ExposeEvent {ev_window = w} <- e + , w `elem` (catMaybes $ map (fst . snd) dwrs) = updateDecos sh t fs dwrs hunk ./XMonad/Layout/Decoration.hs 225 -lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,DecoWin) -lookFor w ((wr,(dw,dr)):dwrs) | w == dw = Just (wr,(dw,dr)) - | otherwise = lookFor w dwrs +lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,(Window,Maybe Rectangle)) +lookFor w ((wr,(Just dw,dr)):dwrs) | w == dw = Just (wr,(dw,dr)) + | otherwise = lookFor w dwrs +lookFor w ((_, (Nothing, _)):dwrs) = lookFor w dwrs hunk ./XMonad/Layout/Decoration.hs 231 -lookFor' :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,DecoWin) -lookFor' w (((w',r),dwr):dwrs) | w == w' = Just ((w,r),dwr) - | otherwise = lookFor' w dwrs -lookFor' _ [] = Nothing - -getDWs :: [(OrigWin,DecoWin)] -> [Window] -getDWs = map (fst . snd) - -initState :: Theme -> [(Window,Rectangle)] -> X DecorationState -initState t wrs = do +initState :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle + -> W.Stack Window -> [(Window,Rectangle)] -> X DecorationState +initState t ds sc s wrs = do hunk ./XMonad/Layout/Decoration.hs 235 - dwrs <- createDecos t wrs + dwrs <- createDecos t ds sc s wrs wrs hunk ./XMonad/Layout/Decoration.hs 240 - deleteWindows (getDWs $ decos s) - releaseXMF (font s) + deleteDecos (map snd $ decos s) + releaseXMF (font s) + +createDecos :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle -> W.Stack Window + -> [(Window,Rectangle)] -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)] +createDecos t ds sc s wrs ((w,r):xs) = do + deco <- decorate ds (decoWidth t) (decoHeight t) sc s wrs (w,r) + case deco of + Just dr -> do let mask = Just (exposureMask .|. buttonPressMask) + dw <- createNewWindow dr mask (inactiveColor t) True + dwrs <- createDecos t ds sc s wrs xs + return $ ((w,r), (Just dw, Just dr)) : dwrs + Nothing -> do dwrs <- createDecos t ds sc s wrs xs + return $ ((w,r), (Nothing, Nothing)) : dwrs +createDecos _ _ _ _ _ [] = return [] + +showDecos :: [DecoWin] -> X () +showDecos (m:mwrs) + | (Just w,_) <- m = showWindow w >> showDecos mwrs + | otherwise = showDecos mwrs +showDecos [] = return () + +hideDecos :: [DecoWin] -> X () +hideDecos (m:mwrs) + | (Just w,_) <- m = hideWindow w >> hideDecos mwrs + | otherwise = hideDecos mwrs +hideDecos [] = return () hunk ./XMonad/Layout/Decoration.hs 268 -createDecos :: Theme -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)] -createDecos _ [] = return [] -createDecos t (wr:wrs) = do - let rect = Rectangle 0 0 1 1 - mask = Just (exposureMask .|. buttonPressMask) - dw <- createNewWindow rect mask (inactiveColor t) True - dwrs <- createDecos t wrs - return ((wr,(dw,Nothing)):dwrs) +deleteDecos :: [DecoWin] -> X () +deleteDecos (m:mwrs) + | (Just w,_) <- m = deleteWindow w >> deleteDecos mwrs + | otherwise = deleteDecos mwrs +deleteDecos [] = return () hunk ./XMonad/Layout/Decoration.hs 274 -updateDecos :: Shrinker s => s -> Theme -> XMonadFont -> [(OrigWin, DecoWin)] -> X () +updateDecos :: Shrinker s => s -> Theme -> XMonadFont -> [(OrigWin,DecoWin)] -> X () hunk ./XMonad/Layout/Decoration.hs 277 -updateDeco :: Shrinker s => s -> Theme -> XMonadFont -> (OrigWin, DecoWin) -> X () -updateDeco sh t fs ((w,_),(dw,Just (Rectangle _ _ wh ht))) = do +updateDeco :: Shrinker s => s -> Theme -> XMonadFont -> (OrigWin,DecoWin) -> X () +updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do hunk ./XMonad/Layout/Decoration.hs 287 - (bc,borderc,tc) <- focusColor w - (inactiveColor t, inactiveBorderColor t, inactiveTextColor t) - (activeColor t, activeBorderColor t, activeTextColor t) - (urgentColor t, urgentBorderColor t, urgentTextColor t) - let s = shrinkIt sh - name <- shrinkWhile s (\n -> do - size <- io $ textWidthXMF dpy fs n - return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw) + (bc,borderc,tc) <- focusColor w (inactiveColor t, inactiveBorderColor t, inactiveTextColor t) + (activeColor t, activeBorderColor t, activeTextColor t) + (urgentColor t, urgentBorderColor t, urgentTextColor t) + let s = shrinkIt sh + name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n + return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw) hunk ./XMonad/Layout/Decoration.hs 294 -updateDeco _ _ _ (_,(w,Nothing)) = hideWindow w +updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w +updateDeco _ _ _ _ = return () hunk ./XMonad/Layout/Decoration.hs 21 + , Theme (..), defaultTheme hunk ./XMonad/Layout/Decoration.hs 23 - , DefaultDecoration (..) - , DecorationStyle (..) hunk ./XMonad/Layout/Decoration.hs 24 - , Theme (..), defaultTheme - , shrinkText, CustomShrink ( CustomShrink ) + , DecorationStyle (..) + , DefaultDecoration (..) hunk ./XMonad/Layout/Decoration.hs 27 - , module XMonad.Layout.LayoutModifier + , shrinkText, CustomShrink ( CustomShrink ) hunk ./XMonad/Layout/Decoration.hs 29 + , module XMonad.Layout.LayoutModifier hunk ./XMonad/Layout/Decoration.hs 47 --- For usage examples you can see "XMonad.Layout.SimpleDecoration", --- "XMonad.Layout.Tabbed", "XMonad.Layout.DwmStyle", +-- This module is intended for layout developers, who want to decorate +-- their layouts. End users will not find here very much for them. +-- +-- For examples of 'DecorationStyle' instances you can have a look at +-- "XMonad.Layout.SimpleDecoration", "XMonad.Layout.Tabbed", +-- "XMonad.Layout.DwmStyle", or "XMonad.Layout.TabBarDecoration". hunk ./XMonad/Layout/Decoration.hs 54 +-- | A layout modifier that, with a 'Shrinker', a 'Theme', a +-- 'DecorationStyle', and a layout, will decorate this layout +-- according to the decoration style provided. +-- +-- For some usage examples see "XMonad.Layout.DecorationMadness". hunk ./XMonad/Layout/Decoration.hs 63 +-- | A 'Theme' is a record of colors, font etc., to customize a +-- 'DecorationStyle'. +-- +-- For a collection of 'Theme's see "Xmonad.Util.Themes" hunk ./XMonad/Layout/Decoration.hs 68 - Theme { activeColor :: String - , inactiveColor :: String - , urgentColor :: String - , activeBorderColor :: String - , inactiveBorderColor :: String - , urgentBorderColor :: String - , activeTextColor :: String - , inactiveTextColor :: String - , urgentTextColor :: String - , fontName :: String - , decoWidth :: Dimension - , decoHeight :: Dimension + Theme { activeColor :: String -- ^ Color of the active window + , inactiveColor :: String -- ^ Color of the inactive window + , urgentColor :: String -- ^ Color of the urgent window + , activeBorderColor :: String -- ^ Color of the border of the active window + , inactiveBorderColor :: String -- ^ Color of the border of the inactive window + , urgentBorderColor :: String -- ^ Color of the border of the urgent window + , activeTextColor :: String -- ^ Color of the text of the active window + , inactiveTextColor :: String -- ^ Color of the text of the inactive window + , urgentTextColor :: String -- ^ Color of the text of the urgent window + , fontName :: String -- ^ Font name + , decoWidth :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle') + , decoHeight :: Dimension -- ^ Height of the decorations hunk ./XMonad/Layout/Decoration.hs 82 +-- | The default xmonad 'Theme'. hunk ./XMonad/Layout/Decoration.hs 99 +-- | A 'Decoration' layout modifier will handle 'SetTheme', a message +-- to dynamically change the decoration 'Theme'. hunk ./XMonad/Layout/Decoration.hs 104 -type DecoWin = (Maybe Window, Maybe Rectangle) -type OrigWin = (Window,Rectangle) +-- | The 'Decoration' state component, where the list of decorated +-- window's is zipped with a list of decoration. A list of decoration +-- is a list of tuples, a 'Maybe' 'Window' and a 'Maybe Rectangle'. +-- The 'Window' will be displayed only if the rectangle is of type +-- 'Just'. hunk ./XMonad/Layout/Decoration.hs 113 +type DecoWin = (Maybe Window, Maybe Rectangle) +type OrigWin = (Window,Rectangle) hunk ./XMonad/Layout/Decoration.hs 116 +-- | The 'Decoration' 'LayoutModifier'. This data type is an instance +-- of the 'LayoutModifier' class. This data type will be passed, +-- together with a layout, to the 'ModifiedLayout' type constructor +-- to modify the layout by adding decorations according to a +-- 'DecorationStyle'. hunk ./XMonad/Layout/Decoration.hs 125 +-- | The 'DecorationStyle' class, defines methods used in the +-- implementation of the 'Decoration' 'LayoutModifier' instance. A +-- type instance of this class is passed to the 'Decoration' type in +-- order to decorate a layout, by using these methods. hunk ./XMonad/Layout/Decoration.hs 130 + + -- | The description that the 'Decoration' modifier will display. hunk ./XMonad/Layout/Decoration.hs 135 + -- | Whether to decorate a layout if there is only one window. hunk ./XMonad/Layout/Decoration.hs 139 + -- | Shrink the window's rectangle when applying a decoration. hunk ./XMonad/Layout/Decoration.hs 143 + -- | The decoration event hook, where the + -- 'decorationMouseFocusHook' and 'decorationMouseDragHook' are + -- called. If you reimplement it those methods will not be + -- called. hunk ./XMonad/Layout/Decoration.hs 151 + -- | This method is called when the user clicks the pointer over + -- the decoration. hunk ./XMonad/Layout/Decoration.hs 156 + -- | This method is called when the user starts grabbing the + -- decoration. hunk ./XMonad/Layout/Decoration.hs 161 + -- | The pure version of the main method, 'decorate'. hunk ./XMonad/Layout/Decoration.hs 168 + -- | Given the theme's decoration width and height, the screen + -- rectangle, the windows stack, the list of windows and + -- rectangles returned by the underlying layout and window to be + -- decorated, tupled with its rectangle, produce a 'Just' + -- 'Rectangle' or 'Nothing' if the window is not to be decorated. hunk ./XMonad/Layout/Decoration.hs 175 - decorate ds w h r s ars ar = return $ pureDecoration ds w h r s ars ar + decorate ds w h r s wrs wr = return $ pureDecoration ds w h r s wrs wr hunk ./XMonad/Layout/Decoration.hs 177 +-- | The default 'DecorationStyle', with just the default methods' +-- implementations. hunk ./XMonad/Layout/Decoration.hs 182 +-- | The long 'LayoutModifier' instance for the 'Decoration' type. +-- +-- In 'redoLayout' we check if the decoration style requires +-- decorating the first window. If not and the underlying layout +-- produced just one window not we release the state. +-- +-- If there's no state we initialize it. +-- +-- The state is 'diff'ed against the list of windows produced by the +-- underlying layout: removed windows get deleted and new ones +-- decorated by 'createDecos', which will call 'decorate' to decide if +-- a window must be given a 'Rectangle', in which case a decoration +-- window will be created. +-- +-- After that we resync the updated state with the windows' list and +-- then we process the resynced stated (as we do with a new state). +-- +-- First we map the decoration windows, we update each decoration to +-- reflect any decorated window's change, and we insert, in the list +-- of windows and rectangles returned by the underlying layout, the +-- decoration for each window. This way xmonad will restack the +-- decorations and their windows accordingly. At the end we remove +-- invisible\/stacked windows. +-- +-- Message handling is quite simple: we needed we release the state +-- component of the 'Decoration' 'LayoutModifier'. Otherwise we call +-- 'handleEvent', which will call the appropriate 'DecorationStyle' +-- methods to perform its tasks. hunk ./XMonad/Layout/Decoration.hs 279 +-- | By default 'Decoration' handles 'PropertyEvent' and 'ExposeEvent' +-- only. hunk ./XMonad/Layout/Decoration.hs 289 +-- | Mouse focus and mouse drag are handled by the same function, this +-- way we can start dragging unfocused windows too. hunk ./XMonad/Layout/Decoration.hs 307 +-- | Given a window and the state, if a matching decoration is in the +-- state return it with its ('Maybe') 'Rectangle'. hunk ./XMonad/Layout/Decoration.hs 315 +-- | Initialize the 'DecorationState' by initializing the font +-- structure and by creating the needed decorations. hunk ./XMonad/Layout/Decoration.hs 324 +-- | Delete windows stored in the state and release the font structure. hunk ./XMonad/Layout/Decoration.hs 330 +-- | Create the decoration windows of a list of windows and their +-- rectangles, by calling the 'decorate' method of the +-- 'DecorationStyle' received. hunk ./XMonad/Layout/Decoration.hs 367 +-- | Update a decoration window given a shrinker, a theme, the font +-- structure and the needed 'Rectangle's hunk ./XMonad/Layout/Decoration.hs 389 +-- | True if the window is in the 'Stack'. The 'Window' comes second +-- to facilitate list processing, even though @w \`isInStack\` s@ won't +-- work...;) hunk ./XMonad/Layout/Decoration.hs 395 +-- | Given a 'Rectangle' and a list of 'Rectangle's is True if the +-- 'Rectangle' is not completely contained by any 'Rectangle' of the +-- list. hunk ./XMonad/Layout/Decoration.hs 402 +-- | The contrary of 'isVisible'. hunk ./XMonad/Layout/Decoration.hs 406 +-- | True is the first 'Rectangle' is totally within the second +-- 'Rectangle'. hunk ./XMonad/Config/Arossato.hs 20 - , arossatoTheme hunk ./XMonad/Config/Arossato.hs 45 +import XMonad.Util.Themes hunk ./XMonad/Config/Arossato.hs 74 --- > , arossatoTabbedConfig hunk ./XMonad/Config/Arossato.hs 86 --- | My configuration for the Tabbed Layout. Basically this is the --- Ion3 clean style. -arossatoTheme :: Theme -arossatoTheme = defaultTheme - { activeColor = "#8a999e" - , inactiveColor = "#545d75" - , activeBorderColor = "white" - , inactiveBorderColor = "grey" - , activeTextColor = "white" - , inactiveTextColor = "grey" - , decoHeight = 14 - } - hunk ./XMonad/Config/Arossato.hs 87 - xmobar <- spawnPipe "xmobar" -- remove this line if you do not have xmobar installed! + xmobar <- spawnPipe "xmobar" -- REMOVE this line if you do not have xmobar installed! hunk ./XMonad/Config/Arossato.hs 91 - , logHook = myDynLog xmobar + , logHook = myDynLog xmobar -- REMOVE this line if you do not have xmobar installed! hunk ./XMonad/Config/Arossato.hs 105 - mytabs = tabbed shrinkText arossatoTheme - decorated = simpleFloat' shrinkText arossatoTheme + mytabs = tabbed shrinkText (theme smallClean) + decorated = simpleFloat' shrinkText (theme smallClean) hunk ./XMonad/Config/Arossato.hs 115 - myManageHook = composeAll [ resource =? "realplay.bin" --> doFloat - , resource =? "win" --> doF (W.shift "doc") -- xpdf + myManageHook = composeAll [ resource =? "win" --> doF (W.shift "doc") -- xpdf hunk ./XMonad/Layout/LayoutHints.hs 63 - return (w, if isInStack s w then r else Rectangle a b c' d') + return (w, if isInStack s w then Rectangle a b c' d' else r) hunk ./XMonad/Hooks/DynamicLog.hs 24 - makeSimpleDzenConfig, hunk ./XMonad/Hooks/DynamicLog.hs 26 - dynamicLogString, hunk ./XMonad/Hooks/DynamicLog.hs 28 - dynamicLogWithPP, hunk ./XMonad/Hooks/DynamicLog.hs 31 + dynamicLogWithPP, + dynamicLogString, hunk ./XMonad/Hooks/DynamicLog.hs 43 + -- * To Do + -- $todo + hunk ./XMonad/Hooks/DynamicLog.hs 52 -import Data.Maybe ( isJust ) +import Data.Maybe ( isJust, catMaybes ) hunk ./XMonad/Hooks/DynamicLog.hs 68 --- Then set your logHook to an appropriate function, for example +-- If you just want a quick-and-dirty status bar with zero effort, try +-- the 'dzen' function, which sets up a dzen status bar with a default +-- format: +-- +-- > main = dzen xmonad +-- +-- or, to use this with your own custom xmonad configuration, +-- +-- > main = dzen $ \conf -> xmonad $ conf { } hunk ./XMonad/Hooks/DynamicLog.hs 78 +-- Alternatively, you can choose among several default status bar +-- formats ('dynamicLog', 'dynamicLogDzen', 'dynamicLogXmobar', or +-- 'dynamicLogXinerama') by simply setting your logHook to the +-- appropriate function, for instance: +-- +-- > main = xmonad $ defaultConfig { +-- > ... hunk ./XMonad/Hooks/DynamicLog.hs 86 +-- > ... +-- > } +-- +-- For more flexibility, you can also use 'dynamicLogWithPP' and supply +-- your own pretty-printing format (by either defining one from scratch, +-- or customizing one of the provided examples). +-- For example: hunk ./XMonad/Hooks/DynamicLog.hs 94 --- or, for more flexibility, something like +-- > -- use sjanssen's pretty-printer format, but with the sections +-- > -- in reverse +-- > logHook = dynamicLogWithPP $ sjanssenPP { ppOrder = reverse } hunk ./XMonad/Hooks/DynamicLog.hs 98 --- > logHook = dynamicLogWithPP myDynamicLogPP --- > ... --- > myDynamicLogPP = defaultPP { ... -- override pretty-printer with specific settings +-- Note that setting the @logHook@ only sets up xmonad's output; you +-- are responsible for starting your own status bar program (e.g. dzen +-- or xmobar) and making sure xmonad's output is piped into it +-- appropriately, either by putting it in your @.xsession@ or similar +-- file, or by using @spawnPipe@ in your @main@ function, for example: hunk ./XMonad/Hooks/DynamicLog.hs 104 --- If you don't use statusbar, you can use dynamicLogString to show on-screen --- notifications in response to some events. E.g. to show current layout when --- it's changed create apropriate PP and add to keybindings: +-- > main = do +-- > h <- spawnPipe "xmobar -options -foo -bar" +-- > xmonad $ defaultConfig { +-- > ... +-- > logHook = dynamicLogWithPP $ defaultPP { ppOutput = hPutStrLn h } +-- +-- If you use @spawnPipe@, be sure to redefine the 'ppOutput' field of +-- your pretty-printer as in the example above; by default the status +-- will be printed to stdout rather than the pipe you create. +-- +-- Even if you don't use a statusbar, you can still use +-- 'dynamicLogString' to show on-screen notifications in response to +-- some events. For example, to show the current layout when it +-- changes, you could make a keybinding to cycle the layout and +-- display the current status: hunk ./XMonad/Hooks/DynamicLog.hs 121 +-- hunk ./XMonad/Hooks/DynamicLog.hs 123 --- | An example xmonad config that spawns a new dzen toolbar and uses --- the default dynamic log output. -makeSimpleDzenConfig :: IO (XConfig (Choose Tall (Choose (Mirror Tall) Full))) -makeSimpleDzenConfig = do - h <- spawnPipe "dzen2" - return defaultConfig - { defaultGaps = [(18,0,0,0)] - , logHook = dynamicLogWithPP dzenPP - { ppOutput = hPutStrLn h } } - --- | +-- $todo +-- +-- * incorporate dynamicLogXinerama into the PP framework somehow hunk ./XMonad/Hooks/DynamicLog.hs 127 --- Run xmonad with a dzen status bar set to some nice defaults. Output +-- * add an xmobarEscape function + +-- | Run xmonad with a dzen status bar set to some nice defaults. Output hunk ./XMonad/Hooks/DynamicLog.hs 134 --- The intent is that the above config file should provide a nice status --- bar with minimal effort. +-- The intent is that the above config file should provide a nice +-- status bar with minimal effort. If you want to customize your xmonad +-- configuration while using this, you'll have to do something like +-- +-- > main = dzen $ \conf -> xmonad $ conf { } +-- +-- If you wish to customize the status bar format at all, you'll have to +-- use something like 'dynamicLogWithPP' instead. hunk ./XMonad/Hooks/DynamicLog.hs 155 --- | --- An example log hook, print a status bar output to stdout, in the form: +-- | An example log hook, which prints status information to stdout in +-- the default format: hunk ./XMonad/Hooks/DynamicLog.hs 163 +-- To customize the output format, see 'dynamicLogWithPP'. +-- hunk ./XMonad/Hooks/DynamicLog.hs 168 --- | --- Returns formatted log message. +-- | An example log hook that emulates dwm's status bar, using colour +-- codes printed to dzen. Requires dzen. Workspaces, xinerama, +-- layouts and the window title are handled. +dynamicLogDzen :: X () +dynamicLogDzen = dynamicLogWithPP dzenPP + +-- | These are good defaults to be used with the xmobar status bar. +dynamicLogXmobar :: X () +dynamicLogXmobar = dynamicLogWithPP xmobarPP + +-- | Format the current status using the supplied pretty-printing format, +-- and write it to stdout. +dynamicLogWithPP :: PP -> X () +dynamicLogWithPP pp = dynamicLogString pp >>= io . ppOutput pp + +-- | The same as 'dynamicLogWithPP', except it simply returns the status +-- as a formatted string without actually printing it to stdout, to +-- allow for further processing, or use in some application other than +-- a status bar. hunk ./XMonad/Hooks/DynamicLog.hs 189 + hunk ./XMonad/Hooks/DynamicLog.hs 193 + hunk ./XMonad/Hooks/DynamicLog.hs 196 + hunk ./XMonad/Hooks/DynamicLog.hs 199 + hunk ./XMonad/Hooks/DynamicLog.hs 203 + -- run extra loggers, ignoring any that generate errors. + extras <- sequence $ map (flip catchX (return Nothing)) $ ppExtras pp + hunk ./XMonad/Hooks/DynamicLog.hs 211 + ++ catMaybes extras hunk ./XMonad/Hooks/DynamicLog.hs 213 --- | --- A log function that uses the 'PP' hooks to customize output. -dynamicLogWithPP :: PP -> X () -dynamicLogWithPP pp = dynamicLogString pp >>= io . ppOutput pp - --- | An example log hook that emulates dwm's status bar, using colour --- codes printed to dzen. Requires dzen. Workspaces, xinerama, --- layouts and the window title are handled. --- -dynamicLogDzen :: X () -dynamicLogDzen = dynamicLogWithPP dzenPP - --- | Do the actual status formatting, using a pretty-printer. -pprWindowSet :: ([WindowSpace] -> [WindowSpace]) -> [Window] -> PP -> WindowSet -> String +-- | Format the workspace information, given a workspace sorting function, +-- a list of urgent windows, a pretty-printer format, and the current +-- WindowSet. +pprWindowSet :: WorkspaceSort -> [Window] -> PP -> WindowSet -> String hunk ./XMonad/Hooks/DynamicLog.hs 237 +-- Unfortunately, at the present time, the current layout and window title +-- are not shown, and there is no way to incorporate the xinerama +-- workspace format shown above with 'dynamicLogWithPP'. Hopefully this +-- will change soon. hunk ./XMonad/Hooks/DynamicLog.hs 302 --- | The 'PP' type allows the user to customize various behaviors of --- dynamicLogPP. +-- ??? add an xmobarEscape function? + +-- | The 'PP' type allows the user to customize the formatting of +-- status information. hunk ./XMonad/Hooks/DynamicLog.hs 307 - -- ^ how to print the tag of the currently focused workspace + -- ^ how to print the tag of the currently focused + -- workspace hunk ./XMonad/Hooks/DynamicLog.hs 310 - -- ^ how to print tags of visible but not focused workspaces (xinerama only) + -- ^ how to print tags of visible but not focused + -- workspaces (xinerama only) hunk ./XMonad/Hooks/DynamicLog.hs 313 - -- ^ how to print tags of hidden workspaces which contain windows + -- ^ how to print tags of hidden workspaces which + -- contain windows hunk ./XMonad/Hooks/DynamicLog.hs 319 - -- NOTE that 'ppUrgent' is applied /in addition to/ 'ppHidden'! + -- NOTE that 'ppUrgent' is applied /in addition to/ + -- 'ppHidden'! hunk ./XMonad/Hooks/DynamicLog.hs 322 - -- ^ separator to use between different log sections (window name, layout, workspaces) + -- ^ separator to use between different log sections + -- (window name, layout, workspaces) hunk ./XMonad/Hooks/DynamicLog.hs 331 - -- ^ how to order the different log sections + -- ^ how to order the different log sections. By + -- default, this function receives a list with three + -- formatted strings, representing the workspaces, + -- the layout, and the current window title, + -- respectively. If you have specified any extra + -- loggers in 'ppExtras', their output will also be + -- appended to the list. To get them in the reverse + -- order, you can just use @ppOrder = reverse@. If + -- you don't want to display the current layout, you + -- could use something like @ppOrder = \\(ws:_:t:_) -> + -- [ws,t]@, and so on. hunk ./XMonad/Hooks/DynamicLog.hs 343 - -- ^ how to sort the workspaces. See "XMonad.Util.WorkspaceCompare" for some useful sorts. + -- ^ how to sort the workspaces. See + -- "XMonad.Util.WorkspaceCompare" for some useful + -- sorts. + , ppExtras :: [X (Maybe String)] + -- ^ loggers for generating extra information such as + -- time and date, system load, battery status, and so + -- on. See "XMonad.Util.Loggers" for examples, or create + -- your own! hunk ./XMonad/Hooks/DynamicLog.hs 352 - -- ^ formatter that gets applied to the entire log string before it is output. + -- ^ applied to the entire formatted string in order to + -- output it. Can be used to specify an alternative + -- output method (e.g. write to a pipe instead of + -- stdout), and/or to perform some last-minute + -- formatting. hunk ./XMonad/Hooks/DynamicLog.hs 373 + , ppExtras = [] hunk ./XMonad/Hooks/DynamicLog.hs 395 --- | The options that sjanssen likes to use, as an example. Note the use of --- 'xmobarColor' and the record update on 'defaultPP'. +-- | Some nice xmobar defaults. +xmobarPP :: PP +xmobarPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" + , ppTitle = xmobarColor "green" "" . shorten 40 + , ppVisible = wrap "(" ")" + } + +-- | The options that sjanssen likes to use with xmobar, as an +-- example. Note the use of 'xmobarColor' and the record update on +-- 'defaultPP'. hunk ./XMonad/Hooks/DynamicLog.hs 425 --- | These are good defaults to be used with the xmobar status bar. -dynamicLogXmobar :: X () -dynamicLogXmobar = - dynamicLogWithPP defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" - , ppTitle = xmobarColor "green" "" . shorten 40 - , ppVisible = wrap "(" ")" - } addfile ./XMonad/Util/Loggers.hs hunk ./XMonad/Util/Loggers.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Loggers +-- Copyright : (c) Brent Yorgey +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- A collection of simple logger functions which can be used in the +-- 'XMonad.Hooks.DynamicLog.ppExtras' field of a pretty-printing status +-- logger format. See "XMonad.Hooks.DynamicLog" for more information. +----------------------------------------------------------------------------- + +module XMonad.Util.Loggers ( + -- * Usage + -- $usage + + Logger + + , date + , loadAvg + , battery + , logCmd + + ) where + +import XMonad.Core + +import System.Time +import System.IO +import System.Process +import System.Locale + +-- $usage +-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Util.Loggers +-- +-- Then, add one or more loggers to the +-- 'XMonad.Hooks.DynamicLog.ppExtras' field of your +-- 'XMonad.Hooks.DynamicLoc.PP' format. For example: +-- +-- > -- display load averages and a pithy quote along with xmonad status. +-- > , logHook = dynamicLogWithPP $ defaultPP { ppExtras = [ loadAvg, logCmd "fortune -n 40 -s" ] } +-- +-- Of course, there is nothing really special about these so-called +-- \'loggers\': they are just @X (Maybe String)@ actions. So you can +-- use them anywhere you would use an @X (Maybe String)@, not just +-- with DynamicLog. +-- +-- Additional loggers welcome! +-- + +-- | 'Logger' is just a convenient synonym for @X (Maybe String)@. +type Logger = X (Maybe String) + +-- | Get the current date and time, and format them via the +-- given format string. The format used is the same as that used +-- by the C library function strftime; for example, +-- @date \"%a %b %d\"@ might display something like @Tue Feb 19@. +-- For more information see something like +-- . +date :: String -> Logger +date fmt = io $ do cal <- (getClockTime >>= toCalendarTime) + return . Just $ formatCalendarTime defaultTimeLocale fmt cal + +-- | Get the load average. This assumes that you have a +-- utility called @\/usr\/bin\/uptime@ and that you have @sed@ +-- installed; these are fairly common on GNU\/Linux systems but it +-- would be nice to make this more general. +loadAvg :: Logger +loadAvg = logCmd "/usr/bin/uptime | sed 's/.*: //; s/,//g'" + +-- | Get the battery status (percent charge and charging\/discharging +-- status). This is an ugly hack and may not work for some people. +-- At some point it would be nice to make this more general\/have +-- fewer dependencies. +battery :: Logger +battery = logCmd "/usr/bin/acpi | sed -r 's/.*?: (.*%).*/\\1/; s/discharging, ([0-9]+%)/\\1-/; s/charging, ([0-9]+%)/\\1+/; s/charged, //'" + +-- | Create a 'Logger' from an arbitrary shell command. +logCmd :: String -> Logger +logCmd c = io $ do (_, out, _, proc) <- runInteractiveCommand c + output <- hGetLine out + waitForProcess proc + return $ Just output hunk ./xmonad-contrib.cabal 43 - build-depends: base >= 3, containers, directory, process, random + build-depends: base >= 3, containers, directory, process, random, old-time, old-locale hunk ./xmonad-contrib.cabal 160 + XMonad.Util.Loggers hunk ./XMonad/Hooks/DynamicLog.hs 355 - -- stdout), and/or to perform some last-minute + -- stdout), and\/or to perform some last-minute hunk ./XMonad/Layout/Decoration.hs 135 - -- | Whether to decorate a layout if there is only one window. - decorateFirst :: ds a -> Bool - decorateFirst _ = True - hunk ./XMonad/Layout/Decoration.hs 202 --- Message handling is quite simple: we needed we release the state +-- Message handling is quite simple: when needed we release the state hunk ./XMonad/Layout/Decoration.hs 208 - | decorate_first = do whenIJust st releaseResources - return (wrs, Just $ Decoration (I Nothing) sh t ds) hunk ./XMonad/Layout/Decoration.hs 214 - ndwrs <- createDecos t ds sc stack wrs toAdd + let ndwrs = zip toAdd $ repeat (Nothing,Nothing) hunk ./XMonad/Layout/Decoration.hs 228 - decorate_first = length wrs == 1 && (not . decorateFirst $ ds) + check_dwr dwr = case dwr of + (Nothing, Just dr) -> do dw <- createDecoWindow t dr + return (Just dw, Just dr) + _ -> return dwr hunk ./XMonad/Layout/Decoration.hs 236 + dwr <- check_dwr (find_dw i d, dr) hunk ./XMonad/Layout/Decoration.hs 238 - return $ ((w,r),(find_dw i d, dr)) : dwrs + return $ ((w,r),dwr) : dwrs hunk ./XMonad/Layout/Decoration.hs 336 - Just dr -> do let mask = Just (exposureMask .|. buttonPressMask) - dw <- createNewWindow dr mask (inactiveColor t) True + Just dr -> do dw <- createDecoWindow t dr hunk ./XMonad/Layout/Decoration.hs 343 +createDecoWindow :: Theme -> Rectangle -> X Window +createDecoWindow t r = let mask = Just (exposureMask .|. buttonPressMask) in + createNewWindow r mask (inactiveColor t) True + hunk ./XMonad/Layout/Decoration.hs 348 -showDecos (m:mwrs) - | (Just w,_) <- m = showWindow w >> showDecos mwrs - | otherwise = showDecos mwrs -showDecos [] = return () +showDecos = showWindows . catMaybes . map fst hunk ./XMonad/Layout/Decoration.hs 351 -hideDecos (m:mwrs) - | (Just w,_) <- m = hideWindow w >> hideDecos mwrs - | otherwise = hideDecos mwrs -hideDecos [] = return () +hideDecos = hideWindows . catMaybes . map fst hunk ./XMonad/Layout/Decoration.hs 354 -deleteDecos (m:mwrs) - | (Just w,_) <- m = deleteWindow w >> deleteDecos mwrs - | otherwise = deleteDecos mwrs -deleteDecos [] = return () +deleteDecos = deleteWindows . catMaybes . map fst hunk ./XMonad/Hooks/ManageDocks.hs 119 -r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w, fi y + fi h) +r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1) hunk ./XMonad/Hooks/ManageDocks.hs 122 -c2r (x1, y1, x2, y2) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1) (fi $ y2 - y1) +c2r (x1, y1, x2, y2) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1) + +-- TODO: Add these QuickCheck properties to the test suite, along with +-- suitable Arbitrary instances. + +-- prop_r2c_c2r :: RectC -> Bool +-- prop_r2c_c2r r = r2c (c2r r) == r + +-- prop_c2r_r2c :: Rectangle -> Bool +-- prop_c2r_r2c r = c2r (r2c r) == r hunk ./XMonad/Hooks/ManageDocks.hs 153 +-- | (Side, height\/width, initial pixel, final pixel). + hunk ./XMonad/Hooks/ManageDocks.hs 157 +-- | (Initial x pixel, initial y pixel, +-- final x pixel, final y pixel). + hunk ./XMonad/Hooks/ManageDocks.hs 172 - 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 + inRange (a, b) c = c >= a && c <= b + -- Does the strut range overlap (a, b)? + p (a, b) = inRange (a, b) l || inRange (a, b) h || inRange (l, h) a hunk ./XMonad/Hooks/ManageDocks.hs 115 -fi :: (Integral a, Num b) => a -> b -fi = fromIntegral - -r2c :: Rectangle -> RectC -r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1) - -c2r :: RectC -> Rectangle -c2r (x1, y1, x2, y2) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1) - --- TODO: Add these QuickCheck properties to the test suite, along with --- suitable Arbitrary instances. - --- prop_r2c_c2r :: RectC -> Bool --- prop_r2c_c2r r = r2c (c2r r) == r - --- prop_c2r_r2c :: Rectangle -> Bool --- prop_c2r_r2c r = c2r (r2c r) == r - hunk ./XMonad/Hooks/ManageDocks.hs 144 +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral + +-- | Invertible conversion. + +r2c :: Rectangle -> RectC +r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1) + +-- | Invertible conversion. + +c2r :: RectC -> Rectangle +c2r (x1, y1, x2, y2) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1) + +-- TODO: Add these QuickCheck properties to the test suite, along with +-- suitable Arbitrary instances. + +-- prop_r2c_c2r :: RectC -> Bool +-- prop_r2c_c2r r = r2c (c2r r) == r + +-- prop_c2r_r2c :: Rectangle -> Bool +-- prop_c2r_r2c r = c2r (r2c r) == r + hunk ./XMonad/Hooks/ManageDocks.hs 176 - inRange (a, b) c = c >= a && c <= b - -- Does the strut range overlap (a, b)? - p (a, b) = inRange (a, b) l || inRange (a, b) h || inRange (l, h) a + p r = r `overlaps` (l, h) + +-- | Do the two ranges overlap? +-- +-- Precondition for every input range @(x, y)@: @x '<=' y@. +-- +-- A range @(x, y)@ is assumed to include every pixel from @x@ to @y@. + +overlaps :: Ord a => (a, a) -> (a, a) -> Bool +(a, b) `overlaps` (x, y) = + inRange (a, b) x || inRange (a, b) y || inRange (x, y) a + where + inRange (i, j) k = i <= k && k <= j hunk ./XMonad/Layout/Decoration.hs 180 --- In 'redoLayout' we check if the decoration style requires --- decorating the first window. If not and the underlying layout --- produced just one window not we release the state. --- --- If there's no state we initialize it. +-- In 'redoLayout' we check the state: if there is no state we +-- initialize it. hunk ./XMonad/Layout/Grid.hs 20 - Grid(..) + Grid(..), arrange addfile ./XMonad/Layout/IM.hs hunk ./XMonad/Layout/IM.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.IM +-- Copyright : (c) Roman Cheplyaka +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Roman Cheplyaka +-- Stability : unstable +-- Portability : unportable +-- +-- Layout suitable for workspace with multi-windowed instant messanger (like +-- Psi or Tkabber). +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.IM ( + -- * Usage + -- $usage + + -- * Hints + -- $hints + + -- * TODO + -- $todo + Property(..), IM(..) +) where + +import XMonad +import qualified XMonad.StackSet as S +import Data.List +import XMonad.Layout (splitHorizontallyBy) +import XMonad.Layout.Grid (arrange) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.IM +-- > import Data.Ratio ((%)) +-- +-- Then edit your @layoutHook@ by adding the IM layout: +-- +-- > myLayouts = IM (1%7) (ClassName "Tkabber") ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- Here @1%7@ is the part of the screen which your roster will occupy, +-- @ClassName \"Tkabber\"@ tells xmonad which window is actually your roster. +-- +-- Screenshot: +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +-- $hints +-- +-- To launch IM layout automatically on your IM workspace use "XMonad.Layout.PerWorkspace". + +-- $todo +-- All these items are questionable. Please let me know if you find them useful. +-- +-- * shrink\/expand +-- +-- * allow roster placement on the right side or even on top\/bottom +-- +-- * use arbitrary layout instead of grid + +data IM a = IM Rational Property deriving (Read, Show) + +-- It's hard to reuse code from ManageHook because Query Bool is not in Show/Read. +data Property = Title String + | ClassName String + | Resource String + | And Property Property + | Or Property Property + | Not Property + | Const Bool + deriving (Read, Show) +infixr 9 `And` +infixr 8 `Or` + +-- | Does given window have this property? +hasProperty :: Property -> Window -> X Bool +hasProperty (Title s) w = withDisplay $ \d -> fmap (Just s ==) $ io $ fetchName d w +hasProperty (Resource s) w = withDisplay $ \d -> fmap ((==) s . resName ) $ io $ getClassHint d w +hasProperty (ClassName s) w = withDisplay $ \d -> fmap ((==) s . resClass) $ io $ getClassHint d w +hasProperty (And p1 p2) w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 && r2 } +hasProperty (Or p1 p2) w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 || r2 } +hasProperty (Not p1) w = do { r1 <- hasProperty p1 w; return $ not r1 } +hasProperty (Const b) _ = return b + +instance LayoutClass IM Window where + description _ = "IM" + doLayout (IM r prop) rect stack = do + let ws = S.integrate stack + let (masterRect, slaveRect) = splitHorizontallyBy r rect + master <- findM (hasProperty prop) ws + let positions = case master of + Just w -> (w, masterRect) : arrange slaveRect (filter (w /=) ws) + Nothing -> arrange rect ws + return (positions, Nothing) + +-- | Like find, but works with monadic computation instead of pure function. +findM :: Monad m => (a-> m Bool) -> [a] -> m (Maybe a) +findM _ [] = return Nothing +findM f (x:xs) = do { b <- f x; if b then return (Just x) else findM f xs } hunk ./xmonad-contrib.cabal 109 + XMonad.Layout.IM hunk ./XMonad/Layout/Decoration.hs 66 --- For a collection of 'Theme's see "Xmonad.Util.Themes" +-- For a collection of 'Theme's see "XMonad.Util.Themes" hunk ./XMonad/Layout/WindowArranger.hs 44 --- > main = xmonad defaultConfig { layoutHook = windowArranger myLayout } +-- > main = xmonad defaultConfig { layoutHook = windowArrange myLayout } +-- +-- or +-- +-- > main = xmonad defaultConfig { layoutHook = windowArrangeAll myLayout } hunk ./XMonad/Hooks/ManageHelpers.hs 34 - transience' + transience', + doRectFloat, + doCenterFloat hunk ./XMonad/Hooks/ManageHelpers.hs 134 + +-- | Floats the new window in the given rectangle. +doRectFloat :: W.RationalRect -- ^ The rectangle to float the window in. 0 to 1; x, y, w, h. + -> ManageHook +doRectFloat r = ask >>= \w -> doF (W.float w r) + + +-- | Floats a new window with its original size, but centered. +doCenterFloat :: ManageHook +doCenterFloat = ask >>= \w -> doF . W.float w . center . snd =<< liftX (floatLocation w) + where center (W.RationalRect _ _ w h) + = W.RationalRect ((1-w)/2) ((1-h)/2) w h + + addfile ./XMonad/Util/Scratchpad.hs hunk ./XMonad/Util/Scratchpad.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Scratchpad +-- Copyright : (c) Braden Shepherdson 2008 +-- License : BSD-style (as xmonad) +-- +-- Maintainer : Braden.Shepherdson@gmail.com +-- Stability : unstable +-- Portability : unportable +-- +-- Very handy hotkey-launched floating terminal window. +-- +-- A tool like detach () turns it +-- into a launchpad for X apps. +-- +-- By default, your xmonad terminal is used, and mod+s is the hotkey. +-- The default ManageHook uses a centered, half-screen-wide, +-- quarter-screen-tall window. +-- The key, position and size are configurable. +-- +-- The terminal application must support the @-title@ argument. +-- Known supported terminals: rxvt, rxvt-unicode, xterm. +-- Most others are likely to follow the lead set by xterm. +-- +-- Add the following to your xmonad.hs keybindings to use the default mod+s: +-- +-- > scratchpadSpawnDefault conf +-- +-- Or specify your own key binding, with the action: +-- +-- > scratchpadSpawnAction conf +-- +-- And add one of the @scratchpadManageHook*@s to your ManageHook list. +-- The default rectangle is half the screen wide and a quarter of the +-- screen tall, centered. +-- +----------------------------------------------------------------------------- + +module XMonad.Util.Scratchpad ( + scratchpadSpawnDefault + ,scratchpadSpawnAction + ,scratchpadManageHookDefault + ,scratchpadManageHook + ) where + +import XMonad +import XMonad.Core +import XMonad.Hooks.ManageHelpers (doRectFloat) +import qualified XMonad.StackSet + + + +-- | Complete key binding. Pops up the terminal on mod+s. +scratchpadSpawnDefault :: XConfig Layout -- ^ The configuration, to retrieve terminal and modMask + -> ((KeyMask, KeySym), X ()) +scratchpadSpawnDefault conf = ((modMask conf, xK_s), scratchpadSpawnAction conf) + + +-- | Action to pop up the terminal, for the user to bind to a custom key. +scratchpadSpawnAction :: XConfig Layout -- ^ The configuration, to retrieve the terminal + -> X () +scratchpadSpawnAction conf = spawn $ terminal conf ++ " -title scratchpad" + + + +-- | The ManageHook, with the default rectangle: +-- Half the screen wide, a quarter of the screen tall, centered. +scratchpadManageHookDefault :: ManageHook +scratchpadManageHookDefault = scratchpadManageHook scratchpadDefaultRect + + +-- | The ManageHook, with a user-specified StackSet.RationalRect. +scratchpadManageHook :: XMonad.StackSet.RationalRect -- ^ User-specified screen rectangle. + -> ManageHook +scratchpadManageHook rect = title =? "scratchpad" --> doRectFloat rect + + +scratchpadDefaultRect :: XMonad.StackSet.RationalRect +scratchpadDefaultRect = XMonad.StackSet.RationalRect 0.25 0.375 0.5 0.25 + + hunk ./xmonad-contrib.cabal 164 + XMonad.Util.Scratchpad hunk ./XMonad/Actions/MouseGestures.hs 88 - when (debugging > 0) $ io $ putStrLn $ show "Mouse Gesture" ++ unwords (map show (extract stx)) ++ (if debugging > 1 then "; " ++ show op ++ "-" ++ show np else "") + when (debugging > 0) + . io . hPutStrLn stderr $ show "Mouse Gesture" ++ unwords (map show (extract stx)) ++ (if debugging > 1 then "; " ++ show op ++ "-" ++ show np else "") hunk ./XMonad/Actions/MouseGestures.hs 114 + when (debugging > 1) + . io . hPutStrLn stderr $ "mouseGesture " ++ show (win, dpy) hunk ./XMonad/Actions/MouseGestures.hs 120 - when (debugging > 1) $ putStrLn $ show "queryPointer" ++ show qp - when (debugging > 1 && win' == none) $ putStrLn $ show "mouseGesture" ++ "zomg none" + when (debugging > 1) + . hPutStrLn stderr $ show "queryPointer" ++ show qp + when (debugging > 1 && win' == none) + . hPutStrLn stderr $ show "mouseGesture" ++ "zomg none" hunk ./XMonad/Actions/MouseGestures.hs 126 - when (debugging > 0) $ io $ putStrLn $ show "" + when (debugging > 0) . io . hPutStrLn stderr $ show "" hunk ./XMonad/Actions/MouseGestures.hs 18 - Direction(..), - mouseGesture + Direction(..), + mouseGesture, + mouseGestureH hunk ./XMonad/Actions/MouseGestures.hs 36 --- > import XMonad.Actions.Commands +-- > import XMonad.Actions.MouseGestures hunk ./XMonad/Actions/MouseGestures.hs 85 -collect :: IORef (Pos, [(Direction, Pos, Pos)]) -> Position -> Position -> X () -collect st nx ny = do +collect :: ([Direction] -> X ()) -> IORef (Pos, [(Direction, Pos, Pos)]) -> Position -> Position -> X () +collect hook st nx ny = do hunk ./XMonad/Actions/MouseGestures.hs 89 + let + stx' = + case ds of + [] + | insignificant np op -> stx + | otherwise -> (op, [(dir op np, np, op)]) + (d, zp, ap_) : ds' + | insignificant np zp -> stx + | otherwise -> + let + d' = dir zp np + ds'' + | d == d' = (d, np, ap_) : ds' + | otherwise = (d', np, zp) : ds + in (op, ds'') hunk ./XMonad/Actions/MouseGestures.hs 105 - . io . hPutStrLn stderr $ show "Mouse Gesture" ++ unwords (map show (extract stx)) ++ (if debugging > 1 then "; " ++ show op ++ "-" ++ show np else "") - case ds of - [] - | insignificant np op -> return () - | otherwise -> io $ writeIORef st (op, [(dir op np, np, op)]) - (d, zp, ap_) : ds' - | insignificant np zp -> return () - | otherwise -> do - let - d' = dir zp np - ds'' - | d == d' = (d, np, ap_) : ds' - | otherwise = (d', np, zp) : ds - io $ writeIORef st (op, ds'') + . io . hPutStrLn stderr $ show "Mouse Gesture" ++ unwords (map show (extract stx')) ++ (if debugging > 1 then "; " ++ show op ++ "-" ++ show np else "") + hook (extract stx') + io $ writeIORef st stx' hunk ./XMonad/Actions/MouseGestures.hs 114 --- | Given a 'Data.Map.Map' from lists of directions to actions with --- windows, figure out which one the user is performing, and return --- the corresponding action. +-- | A utility function on top of 'mouseGestureH'. It uses a 'Data.Map.Map' to +-- look up the mouse gesture, then executes the corresponding action (if any). hunk ./XMonad/Actions/MouseGestures.hs 117 -mouseGesture tbl win = withDisplay $ \dpy -> do +mouseGesture tbl = + mouseGestureH (const . const $ return ()) $ \win gest -> + case M.lookup gest tbl of + Nothing -> return () + Just f -> f win + +-- | @'mouseGestureH' moveHook endHook gestures window@ is a mouse button +-- event handler. It collects mouse movements, calling @moveHook@ for each +-- update; when the button is released, it calls @endHook@ with the resulting +-- gesture. +mouseGestureH :: (Window -> [Direction] -> X ()) -> (Window -> [Direction] -> X ()) -> Window -> X () +mouseGestureH moveHook endHook win = withDisplay $ \dpy -> do hunk ./XMonad/Actions/MouseGestures.hs 140 - mouseDrag (collect acc) $ do + mouseDrag (collect (moveHook win') acc) $ do hunk ./XMonad/Actions/MouseGestures.hs 143 - case M.lookup gest tbl of - Nothing -> return () - Just f -> f win' + endHook win' gest hunk ./XMonad/Util/EZConfig.hs 5 +-- Brent Yorgey (key parsing) hunk ./XMonad/Util/EZConfig.hs 10 --- Useful helper functions for amending the defaultConfig. +-- Useful helper functions for amending the defaultConfig, and for +-- parsing keybindings specified in a special (emacs-like) format. hunk ./XMonad/Util/EZConfig.hs 18 - additionalKeys, removeKeys, - additionalMouseBindings, removeMouseBindings + -- * Usage + -- $usage + + -- * Adding or removing keybindings + + additionalKeys, additionalKeysP, + removeKeys, removeKeysP, + additionalMouseBindings, removeMouseBindings, + + -- * Nicer keybinding specifications + + mkKeymap, checkKeymap, hunk ./XMonad/Util/EZConfig.hs 31 --- TODO: write tests hunk ./XMonad/Util/EZConfig.hs 33 +import XMonad.Actions.Submap hunk ./XMonad/Util/EZConfig.hs 36 +import Data.List (foldl', intersperse, sortBy, groupBy, nub) +import Data.Ord (comparing) +import Data.Maybe (catMaybes, isNothing, isJust, fromJust) +import Control.Arrow (first, (&&&)) + +import Text.ParserCombinators.ReadP + +-- $usage +-- To use this module, first import it into your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Util.EZConfig +-- +-- Then, use one of the provided functions to modify your +-- configuration. See the documentation provided with each exported +-- function for more information. hunk ./XMonad/Util/EZConfig.hs 67 -additionalKeys conf keysList = - conf { keys = \cnf -> M.union (M.fromList keysList) (keys conf cnf) } +additionalKeys conf keyList = + conf { keys = \cnf -> M.union (M.fromList keyList) (keys conf cnf) } + +-- | Like 'additionalKeys', except using short @String@ key +-- descriptors like @\"M-m\"@ instead of @(modMask, xK_m)@, as +-- described in the documentation for 'mkKeymap'. For example: +-- +-- > main = xmonad $ defaultConfig { terminal = "urxvt" } +-- > `additionalKeysP` +-- > [ ("M-m", spawn "echo 'Hi, mom!' | dzen2 -p 4") +-- > , ("M-", withFocused hide) -- N.B. this is an absurd thing to do +-- > ] + +additionalKeysP :: XConfig l -> [(String, X ())] -> XConfig l +additionalKeysP conf keyList = + conf { keys = \cnf -> M.union (mkKeymap cnf keyList) (keys conf cnf) } hunk ./XMonad/Util/EZConfig.hs 93 --- | Like additionalKeys, but for mouseBindings. +-- | Like 'removeKeys', except using short @String@ key descriptors +-- like @\"M-m\"@ instead of @(modMask, xK_m)@, as described in the +-- documentation for 'mkKeymap'. For example: +-- +-- > main = xmonad $ defaultConfig { terminal = "urxvt" } +-- > `removeKeysP` ["M-S-" ++ [n] | n <- ['1'..'9']] + +removeKeysP :: XConfig l -> [String] -> XConfig l +removeKeysP conf keyList = + conf { keys = \cnf -> keys conf cnf `M.difference` mkKeymap cnf (zip keyList $ repeat (return ())) } + +-- | Like 'additionalKeys', but for mouse bindings. hunk ./XMonad/Util/EZConfig.hs 109 --- | Like removeKeys, but for mouseBindings. +-- | Like 'removeKeys', but for mouse bindings. hunk ./XMonad/Util/EZConfig.hs 115 + +-------------------------------------------------------------- +-- Keybinding parsing --------------------------------------- +-------------------------------------------------------------- + +-- | Given a config (used to determine the proper modifier key to use) +-- and a list of @(String, X ())@ pairs, create a key map by parsing +-- the key sequence descriptions contained in the Strings. The key +-- sequence descriptions are \"emacs-style\": @M-@, @C-@, @S-@, and +-- @M\#-@ denote mod, control, shift, and mod1-mod5 (where @\#@ is +-- replaced by the appropriate number) respectively; some special +-- keys can be specified by enclosing their name in angle brackets. +-- +-- For example, @\"M-C-x\"@ denotes mod+ctrl+x; @\"S-\\"@ denotes +-- shift-escape. +-- +-- Sequences of keys can also be specified by separating the key +-- descriptions with spaces. For example, @\"M-x y \\"@ denotes the +-- sequence of keys mod+x, y, down. Submaps (see +-- "XMonad.Actions.Submap") will be automatically generated to +-- correctly handle these cases. +-- +-- So, for example, a complete key map might be specified as +-- +-- > keys = \c -> mkKeymap c $ +-- > [ ("M-S-", spawn $ terminal c) +-- > , ("M-x w", spawn "xmessage 'woohoo!'") -- type mod+x then w to pop up 'woohoo!' +-- > , ("M-x y", spawn "xmessage 'yay!'") -- type mod+x then y to pop up 'yay!' +-- > , ("M-S-c", kill) +-- > ] +-- +-- Alternatively, you can use 'additionalKeysP' to automatically +-- create a keymap and add it to your config. +-- +-- Here is a complete list of supported special keys. Note that a few +-- keys, such as the arrow keys, have synonyms: +-- +-- > +-- > +-- > +-- > +-- > +-- > +-- > , +-- > +-- > +-- > , +-- > , +-- > , +-- > , +-- > +-- > +-- > +-- > +-- > +-- > +-- > - + +mkKeymap :: XConfig l -> [(String, X ())] -> M.Map (KeyMask, KeySym) (X ()) +mkKeymap c = M.fromList . mkSubmaps . readKeymap c + +-- | Given a list of pairs of parsed key sequences and actions, +-- group them into submaps in the appropriate way. +mkSubmaps :: [ ([(KeyMask,KeySym)], X ()) ] -> [((KeyMask, KeySym), X ())] +mkSubmaps binds = map combine gathered + where gathered = groupBy fstKey + . sortBy (comparing fst) + $ binds + combine [([k],act)] = (k,act) + combine ks = (head . fst . head $ ks, + submap . M.fromList . mkSubmaps $ map (first tail) ks) + fstKey = (==) `on` (head . fst) + +on :: (a -> a -> b) -> (c -> a) -> c -> c -> b +op `on` f = \x y -> f x `op` f y + +-- | Given a configuration record and a list of (key sequence +-- description, action) pairs, parse the key sequences into lists of +-- @(KeyMask,KeySym)@ pairs. Key sequences which fail to parse will +-- be ignored. +readKeymap :: XConfig l -> [(String, X())] -> [([(KeyMask,KeySym)], X())] +readKeymap c = catMaybes . map (maybeKeys . first (readKeySequence c)) + where maybeKeys (Nothing,_) = Nothing + maybeKeys (Just k, act) = Just (k, act) + +-- | Parse a sequence of keys, returning Nothing if there is +-- a parse failure (no parse, or ambiguous parse). +readKeySequence :: XConfig l -> String -> Maybe [(KeyMask, KeySym)] +readKeySequence c s = case parses s of + [k] -> Just k + _ -> Nothing + where parses = map fst . filter (null.snd) . readP_to_S (parseKeySequence c) + +-- | Parse a sequence of key combinations separated by spaces, e.g. +-- @\"M-c x C-S-2\"@ (mod+c, x, ctrl+shift+2). +parseKeySequence :: XConfig l -> ReadP [(KeyMask, KeySym)] +parseKeySequence c = sepBy1 (parseKeyCombo c) (many1 $ char ' ') + +-- | Parse a modifier-key combination such as "M-C-s" (mod+ctrl+s). +parseKeyCombo :: XConfig l -> ReadP (KeyMask, KeySym) +parseKeyCombo c = do mods <- many (parseModifier c) + k <- parseKey + return (foldl' (.|.) 0 mods, k) + +-- | Parse a modifier: either M- (user-defined mod-key), +-- C- (control), S- (shift), or M#- where # is an integer +-- from 1 to 5 (mod1Mask through mod5Mask). +parseModifier :: XConfig l -> ReadP KeyMask +parseModifier c = (string "M-" >> return (modMask c)) + +++ (string "C-" >> return controlMask) + +++ (string "S-" >> return shiftMask) + +++ do char 'M' + n <- satisfy (`elem` ['1'..'5']) + char '-' + return (mod1Mask + (read [n]) - 1) + +-- | Parse an unmodified basic key, like @\"x\"@, @\"\"@, etc. +parseKey :: ReadP KeySym +parseKey = parseRegular +++ parseSpecial + +-- | Parse a regular key name (represented by itself). +parseRegular :: ReadP KeySym +parseRegular = choice [ char s >> return k + | (s,k) <- zip ['!'..'~'] [xK_exclam..xK_asciitilde] + ] + +-- | Parse a special key name (one enclosed in angle brackets). +parseSpecial :: ReadP KeySym +parseSpecial = do char '<' + key <- choice [ string name >> return k + | (name,k) <- keyNames + ] + char '>' + return key + +-- | A list of all special key names and their associated KeySyms. +keyNames :: [(String, KeySym)] +keyNames = functionKeys ++ specialKeys + +-- | A list pairing function key descriptor strings (e.g. @\"\"@) with +-- the associated KeySyms. +functionKeys :: [(String, KeySym)] +functionKeys = [ ("F" ++ show n, k) + | (n,k) <- zip ([1..12] :: [Int]) [xK_F1..] ] + +-- | A list of special key names and their corresponding KeySyms. +specialKeys :: [(String, KeySym)] +specialKeys = [ ("Backspace", xK_BackSpace) + , ("Tab" , xK_Tab ) + , ("Return" , xK_Return) + , ("Pause" , xK_Pause) + , ("Scroll_lock", xK_Scroll_Lock) + , ("Sys_Req" , xK_Sys_Req) + , ("Escape" , xK_Escape) + , ("Esc" , xK_Escape) + , ("Delete" , xK_Delete) + , ("Home" , xK_Home) + , ("Left" , xK_Left) + , ("Up" , xK_Up) + , ("Right" , xK_Right) + , ("Down" , xK_Down) + , ("L" , xK_Left) + , ("U" , xK_Up) + , ("R" , xK_Right) + , ("D" , xK_Down) + , ("Page_Up" , xK_Page_Up) + , ("Page_Down", xK_Page_Down) + , ("End" , xK_End) + , ("Insert" , xK_Insert) + , ("Break" , xK_Break) + , ("Space" , xK_space) + ] + +-- | Given a configuration record and a list of (key sequence +-- description, action) pairs, check the key sequence descriptions +-- for validity, and warn the user (via a popup xmessage window) of +-- any unparseable or duplicate key sequences. This function is +-- appropriate for adding to your @startupHook@, and you are highly +-- encouraged to do so; otherwise, duplicate or unparseable +-- keybindings will be silently ignored. +-- +-- For example, you might do something like this: +-- +-- > main = xmonad $ myConfig +-- > +-- > myKeymap = [("S-M-c", kill), ...] +-- > myConfig = defaultConfig { +-- > ... +-- > keys = \c -> mkKeymap c myKeymap +-- > startupHook = checkKeymap myConfig myKeymap +-- > ... +-- > } +-- +checkKeymap :: XConfig l -> [(String, a)] -> X () +checkKeymap conf km = warn (doKeymapCheck conf km) + where warn ([],[]) = return () + warn (bad,dup) = spawn $ "xmessage 'Warning:\n" + ++ msg "bad" bad ++ "\n" + ++ msg "duplicate" dup ++ "'" + msg _ [] = "" + msg m xs = m ++ " keybindings detected: " ++ showBindings xs + showBindings = concat . intersperse " " . map ((++"\"") . ("\""++)) + +-- | Given a config and a list of (key sequence description, action) +-- pairs, check the key sequence descriptions for validity, +-- returning a list of unparseable key sequences, and a list of +-- duplicate key sequences. +doKeymapCheck :: XConfig l -> [(String,a)] -> ([String], [String]) +doKeymapCheck conf km = (bad,dups) + where ks = map ((readKeySequence conf &&& id) . fst) km + bad = nub . map snd . filter (isNothing . fst) $ ks + dups = map (snd . head) + . filter ((>1) . length) + . groupBy ((==) `on` fst) + . sortBy (comparing fst) + . map (first fromJust) + . filter (isJust . fst) + $ ks + hunk ./XMonad/Util/Scratchpad.hs 54 -scratchpadSpawnDefault :: XConfig Layout -- ^ The configuration, to retrieve terminal and modMask +scratchpadSpawnDefault :: XConfig l -- ^ The configuration, to retrieve terminal and modMask hunk ./XMonad/Util/Scratchpad.hs 60 -scratchpadSpawnAction :: XConfig Layout -- ^ The configuration, to retrieve the terminal +scratchpadSpawnAction :: XConfig l -- ^ The configuration, to retrieve the terminal hunk ./XMonad/Util/EZConfig.hs 27 - -- * Nicer keybinding specifications + -- * Emacs-style keybinding specifications hunk ./XMonad/Util/EZConfig.hs 49 --- configuration. See the documentation provided with each exported --- function for more information. +-- configuration. You can use 'additionalKeys', 'removeKeys', +-- 'additionalMouseBindings', and 'removeMouseBindings' to easily add +-- and remove keybindings or mouse bindings. You can use 'mkKeymap' +-- to create a keymap using emacs-style keybinding specifications +-- like @\"M-x\"@ instead of @(modMask, xK_x)@, or 'additionalKeysP' +-- and 'removeKeysP' to easily add or remove emacs-style keybindings. +-- If you use emacs-style keybindings, the 'checkKeymap' function is +-- provided, suitable for adding to your 'startupHook', which can warn +-- you of any parse errors or duplicate bindings in your keymap. +-- +-- For more information and usage eamples, see the documentation +-- provided with each exported function, and check the xmonad config +-- archive () +-- for some real examples of use. hunk ./XMonad/Actions/MouseGestures.hs 19 + mouseGestureH, hunk ./XMonad/Actions/MouseGestures.hs 21 - mouseGestureH + mkCollect hunk ./XMonad/Actions/MouseGestures.hs 29 +import Data.Maybe hunk ./XMonad/Actions/MouseGestures.hs 32 -import System.IO - hunk ./XMonad/Actions/MouseGestures.hs 82 -debugging :: Int -debugging = 0 - -collect :: ([Direction] -> X ()) -> IORef (Pos, [(Direction, Pos, Pos)]) -> Position -> Position -> X () -collect hook st nx ny = do +gauge :: (Direction -> X ()) -> Pos -> IORef (Maybe (Direction, Pos)) -> Position -> Position -> X () +gauge hook op st nx ny = do hunk ./XMonad/Actions/MouseGestures.hs 85 - stx@(op, ds) <- io $ readIORef st + stx <- io $ readIORef st hunk ./XMonad/Actions/MouseGestures.hs 87 - stx' = - case ds of - [] - | insignificant np op -> stx - | otherwise -> (op, [(dir op np, np, op)]) - (d, zp, ap_) : ds' - | insignificant np zp -> stx - | otherwise -> - let - d' = dir zp np - ds'' - | d == d' = (d, np, ap_) : ds' - | otherwise = (d', np, zp) : ds - in (op, ds'') - when (debugging > 0) - . io . hPutStrLn stderr $ show "Mouse Gesture" ++ unwords (map show (extract stx')) ++ (if debugging > 1 then "; " ++ show op ++ "-" ++ show np else "") - hook (extract stx') - io $ writeIORef st stx' + (~(Just od), pivot) = case stx of + Nothing -> (Nothing, op) + Just (d, zp) -> (Just d, zp) + cont = do + guard $ significant np pivot + return $ do + let d' = dir pivot np + when (isNothing stx || od /= d') $ hook d' + io $ writeIORef st (Just (d', np)) + fromMaybe (return ()) cont hunk ./XMonad/Actions/MouseGestures.hs 98 - insignificant a b = delta a b < 10 + significant a b = delta a b >= 10 hunk ./XMonad/Actions/MouseGestures.hs 100 -extract :: (Pos, [(Direction, Pos, Pos)]) -> [Direction] -extract (_, xs) = reverse . map (\(x, _, _) -> x) $ xs +-- | @'mouseGestureH' moveHook endHook@ is a mouse button +-- event handler. It collects mouse movements, calling @moveHook@ for each +-- update; when the button is released, it calls @endHook@. +mouseGestureH :: (Direction -> X ()) -> X () -> X () +mouseGestureH moveHook endHook = do + dpy <- asks display + root <- asks theRoot + (pos, acc) <- io $ do + (_, _, _, ix, iy, _, _, _) <- queryPointer dpy root + r <- newIORef Nothing + return ((fromIntegral ix, fromIntegral iy), r) + mouseDrag (gauge moveHook pos acc) endHook hunk ./XMonad/Actions/MouseGestures.hs 116 -mouseGesture tbl = - mouseGestureH (const . const $ return ()) $ \win gest -> +mouseGesture tbl win = do + (mov, end) <- mkCollect + mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest -> hunk ./XMonad/Actions/MouseGestures.hs 123 --- | @'mouseGestureH' moveHook endHook gestures window@ is a mouse button --- event handler. It collects mouse movements, calling @moveHook@ for each --- update; when the button is released, it calls @endHook@ with the resulting --- gesture. -mouseGestureH :: (Window -> [Direction] -> X ()) -> (Window -> [Direction] -> X ()) -> Window -> X () -mouseGestureH moveHook endHook win = withDisplay $ \dpy -> do - when (debugging > 1) - . io . hPutStrLn stderr $ "mouseGesture " ++ show (win, dpy) - root <- asks theRoot - let win' = if win == none then root else win - acc <- io $ do - qp@(_, _, _, ix, iy, _, _, _) <- queryPointer dpy win' - when (debugging > 1) - . hPutStrLn stderr $ show "queryPointer" ++ show qp - when (debugging > 1 && win' == none) - . hPutStrLn stderr $ show "mouseGesture" ++ "zomg none" - newIORef ((fromIntegral ix, fromIntegral iy), []) - mouseDrag (collect (moveHook win') acc) $ do - when (debugging > 0) . io . hPutStrLn stderr $ show "" - gest <- io $ liftM extract $ readIORef acc - endHook win' gest +-- | A callback generator for 'mouseGestureH'. 'mkCollect' returns two +-- callback functions for passing to 'mouseGestureH'. The move hook will +-- collect mouse movements (and return the current gesture as a list); the end +-- hook will return a list of the completed gesture, which you can access with +-- 'Control.Monad.>>='. +mkCollect :: (MonadIO m) => m (Direction -> X [Direction], X [Direction]) +mkCollect = liftIO $ do + acc <- newIORef [] + let + mov d = io $ do + ds <- readIORef acc + let ds' = d : ds + writeIORef acc ds' + return $ reverse ds' + end = io $ do + ds <- readIORef acc + writeIORef acc [] + return $ reverse ds + return (mov, end) hunk ./XMonad/Layout/Tabbed.hs 21 + , simpleTabbedBottom, tabbedBottom, addTabsBottom hunk ./XMonad/Layout/Tabbed.hs 80 +-- | A bottom-tabbed layout with the default xmonad Theme. +simpleTabbedBottom :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window +simpleTabbedBottom = decoration shrinkText defaultTheme TabbedBottom Simplest + hunk ./XMonad/Layout/Tabbed.hs 90 +-- | A layout decorated with tabs at the bottom and the possibility to set a custom +-- shrinker and a custom theme. +tabbedBottom :: (Eq a, Shrinker s) => s -> Theme + -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a +tabbedBottom s c = decoration s c TabbedBottom Simplest + hunk ./XMonad/Layout/Tabbed.hs 100 -data TabbedDecoration a = Tabbed deriving (Read, Show) +addTabsBottom :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a + -> ModifiedLayout (Decoration TabbedDecoration s) l a +addTabsBottom s c l = decoration s c TabbedBottom l + +data TabbedDecoration a = Tabbed | TabbedBottom deriving (Read, Show) hunk ./XMonad/Layout/Tabbed.hs 107 - describeDeco _ = "Tabbed" + describeDeco Tabbed = "Tabbed" + describeDeco TabbedBottom = "Tabbed Bottom" hunk ./XMonad/Layout/Tabbed.hs 110 - pureDecoration _ _ ht _ s wrs (w,r@(Rectangle x y wh _)) = - if length wrs' <= 1 then Nothing - else Just $ Rectangle nx y nwh (fi ht) + pureDecoration ds _ ht _ s wrs (w,r@(Rectangle x y wh hh)) = + if length wrs' <= 1 + then Nothing + else Just $ case ds of + Tabbed -> Rectangle nx y nwh (fi ht) + TabbedBottom -> Rectangle nx (y+fi(hh-ht)) nwh (fi ht) + hunk ./XMonad/Layout/Tabbed.hs 124 + shrink ds (Rectangle _ _ _ dh) (Rectangle x y w h) = case ds of + Tabbed -> Rectangle x (y + fi dh) w (h - dh) + TabbedBottom -> Rectangle x y w (h - dh) + hunk ./XMonad/Actions/MouseGestures.hs 128 -mkCollect :: (MonadIO m) => m (Direction -> X [Direction], X [Direction]) +mkCollect :: (MonadIO m, MonadIO m') => m (Direction -> m' [Direction], m' [Direction]) hunk ./XMonad/Actions/MouseGestures.hs 132 - mov d = io $ do + mov d = liftIO $ do hunk ./XMonad/Actions/MouseGestures.hs 137 - end = io $ do + end = liftIO $ do hunk ./XMonad/Layout/Simplest.hs 40 -instance LayoutClass Simplest Window where +instance LayoutClass Simplest a where hunk ./XMonad/Actions/DynamicWorkspaces.hs 25 -import Data.List ( sort ) - hunk ./XMonad/Actions/DynamicWorkspaces.hs 29 +import XMonad.Util.WorkspaceCompare ( getSortByIndex ) hunk ./XMonad/Actions/DynamicWorkspaces.hs 65 - let ts = sort $ map tag ws + sort <- getSortByIndex + let ts = map tag $ sort ws hunk ./XMonad/Actions/DynamicWorkspaces.hs 79 -toNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset) +toNthWorkspace job wnum = do sort <- getSortByIndex + ws <- gets (map tag . sort . workspaces . windowset) hunk ./XMonad/Actions/DynamicWorkspaces.hs 86 -withNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset) +withNthWorkspace job wnum = do sort <- getSortByIndex + ws <- gets (map tag . sort . workspaces . windowset) hunk ./XMonad/Config/Droundy.hs 29 +import XMonad.Layout.Simplest hunk ./XMonad/Config/Droundy.hs 37 +import XMonad.Layout.ScratchWorkspace hunk ./XMonad/Config/Droundy.hs 116 + , ((modMask x .|. controlMask .|. shiftMask, xK_space), + toggleScratchWorkspace (Simplest */* Simplest) ) hunk ./XMonad/Config/Droundy.hs 139 - , XMonad.workspaces = ["1:mutt","2:iceweasel"] + , XMonad.workspaces = ["mutt","iceweasel","*scratch*"] hunk ./XMonad/Config/Droundy.hs 174 +dropFromTail "" _ = Nothing hunk ./XMonad/Config/Droundy.hs 179 +dropFromHead "" _ = Nothing addfile ./XMonad/Layout/ScratchWorkspace.hs hunk ./XMonad/Layout/ScratchWorkspace.hs 1 +{-# OPTIONS -fglasgow-exts #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.ScratchWorkspace +-- Copyright : (c) Braden Shepherdson, David Roundy 2008 +-- License : BSD-style (as xmonad) +-- +-- Maintainer : Braden.Shepherdson@gmail.com +-- Stability : unstable +-- Portability : unportable + +module XMonad.Layout.ScratchWorkspace ( toggleScratchWorkspace ) where + +import Data.Maybe ( listToMaybe, catMaybes ) +import Control.Monad ( guard, when ) + +import XMonad +import XMonad.Core +import qualified XMonad.StackSet as W + +toggleScratchWorkspace :: LayoutClass l Int => l Int -> X () +toggleScratchWorkspace l = + do s <- gets windowset + when (scratchName `W.tagMember` s) $ + case visibleScratch s of + Just oldscratch -> + do srs <- withDisplay getCleanedScreenInfo + when (length srs == length (W.visible s)) $ do + ml <- handleMessage (W.layout $ W.workspace oldscratch) (SomeMessage Hide) + let scratch = case ml of + Nothing -> oldscratch + Just l' -> oldscratch { W.workspace = + (W.workspace oldscratch) { W.layout = l' } } + mapM_ hide $ W.integrate' $ W.stack $ W.workspace scratch + let modscr scr = do guard $ scratchName /= W.tag (W.workspace scr) + Just $ scr { W.screenDetail = newDetail } + where newDetail = (W.screenDetail scr) + { screenRect = pickRect (W.screen scr) srs } + pickRect _ [z] = z + pickRect i (z:zs) | i < 1 = z + | otherwise = pickRect (i-1) zs + s' = case catMaybes $ map modscr $ W.current s : W.visible s of + newc:newv -> s { W.current = newc, W.visible = newv, + W.hidden = W.workspace scratch : W.hidden s} + modify $ \st -> st { windowset = s' } + refresh + Nothing -> + case hiddenScratch s of + Nothing -> return () + Just hs -> do r <- gets (screenRect . W.screenDetail . W.current . windowset) + (rs,_) <- doLayout l r (W.Stack 0 [1] []) + let (r0, r1) = case rs of + [(0,ra),(1,rb)] -> (ra,rb) + [(1,ra),(0,rb)] -> (rb,ra) + [(1,ra)] -> (r,ra) + [(0,ra)] -> (ra,r) + _ -> (r,r) + c' = (W.current s) { W.screenDetail = + (W.screenDetail (W.current s)) { screenRect = r1 }} + let s' = s { W.current = W.Screen hs (-1) (SD r0 (0,0,0,0)), + W.visible = c': W.visible s, + W.hidden = filter (not . isScratchW) $ W.hidden s } + modify $ \st -> st { windowset = s' } + refresh + +scratchName :: String +scratchName = "*scratch*" + +visibleScratch s = listToMaybe $ filter isScratch $ W.current s : W.visible s +hiddenScratch s = listToMaybe $ filter isScratchW $ W.hidden s + +isScratchW w = scratchName == W.tag w +isScratch scr = scratchName == W.tag (W.workspace scr) +notScratch scr = scratchName /= W.tag (W.workspace scr) + +isScratchVisible :: X Bool +isScratchVisible = gets (elem scratchName . map (W.tag . W.workspace) . W.visible . windowset) hunk ./xmonad-contrib.cabal 127 + XMonad.Layout.ScratchWorkspace hunk ./XMonad/Layout/ScratchWorkspace.hs 42 + pickRect _ [] = error "XMonad.Layout.ScratchWorkspace.toggleScratchWorkspace: internal error" hunk ./XMonad/Layout/ScratchWorkspace.hs 46 + [] -> error "XMonad.Layout.ScratchWorkspace.toggleScratchWorkspace: internal error" hunk ./XMonad/Layout/ScratchWorkspace.hs 67 + where visibleScratch s = listToMaybe $ filter isScratch $ W.current s : W.visible s + hiddenScratch s = listToMaybe $ filter isScratchW $ W.hidden s + isScratchW w = scratchName == W.tag w + isScratch scr = scratchName == W.tag (W.workspace scr) +-- notScratch scr = scratchName /= W.tag (W.workspace scr) + hunk ./XMonad/Layout/ScratchWorkspace.hs 77 -visibleScratch s = listToMaybe $ filter isScratch $ W.current s : W.visible s -hiddenScratch s = listToMaybe $ filter isScratchW $ W.hidden s - -isScratchW w = scratchName == W.tag w -isScratch scr = scratchName == W.tag (W.workspace scr) -notScratch scr = scratchName /= W.tag (W.workspace scr) - -isScratchVisible :: X Bool -isScratchVisible = gets (elem scratchName . map (W.tag . W.workspace) . W.visible . windowset) +-- isScratchVisible :: X Bool +-- isScratchVisible = gets (elem scratchName . map (W.tag . W.workspace) . W.visible . windowset) hunk ./XMonad/Layout/Simplest.hs 1 -{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-} hunk ./XMonad/Config/Droundy.hs 140 - , layoutHook = showWName $ workspaceDir "~" $ windowNavigation $ - toggleLayouts (noBorders Full) $ avoidStruts $ - named "tabbed" (noBorders mytab) ||| + , layoutHook = showWName $ workspaceDir "~" $ smartBorders $ windowNavigation $ + toggleLayouts Full $ avoidStruts $ + named "tabbed" mytab ||| hunk ./XMonad/Hooks/SetWMName.hs 26 --- WMs, see "http:\/\/bugs.sun.com\/bugdatabase\/view_bug.do?bug_id=6429775" and +-- WMs, see and hunk ./XMonad/Util/XSelection.hs 15 --- $ darcs get "http:\/\/gorgias.mine.nu\/repos\/xmonad-utils" +-- $ darcs get addfile ./XMonad/Actions/PerWorkspaceKeys.hs hunk ./XMonad/Actions/PerWorkspaceKeys.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.PerWorkspaceKeys +-- Copyright : (c) Roman Cheplyaka, 2008 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Roman Cheplyaka +-- Stability : unstable +-- Portability : unportable +-- +-- Define key-bindings on per-workspace basis. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.PerWorkspaceKeys ( + -- * Usage + -- $usage + chooseAction, + bindOn + ) where + +import XMonad +import XMonad.StackSet as S +import Data.List (find) + +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.PerWorkspaceKeys +-- +-- > ,((0, xK_F2), bindOn [("1", spawn "rxvt"), ("2", spawn "xeyes"), ("", spawn "xmessage hello")]) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Uses supplied function to decide which action to run depending on current workspace name. +chooseAction :: (String->X()) -> X() +chooseAction f = withWindowSet (f . S.tag . S.workspace . S.current) + +-- | If current workspace is listed, run appropriate action (only the first match counts!) +-- If it isn't listed, then run default action (marked with empty string, \"\"), or do nothing if default isn't supplied. +bindOn :: [(String, X())] -> X() +bindOn bindings = chooseAction chooser where + chooser ws = case find ((ws==).fst) bindings of + Just (_, action) -> action + Nothing -> case find ((""==).fst) bindings of + Just (_, action) -> action + Nothing -> return () + hunk ./xmonad-contrib.cabal 77 + XMonad.Actions.PerWorkspaceKeys hunk ./XMonad/Util/Run.hs 65 --- | Wait is in us +-- | Wait is in µs (microseconds) addfile ./XMonad/Actions/UpdatePointer.hs hunk ./XMonad/Actions/UpdatePointer.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.UpdatePointer +-- Copyright : (c) Robert Marlow +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Robert Marlow +-- Stability : stable +-- Portability : portable +-- +-- Causes the pointer to follow whichever window focus changes to. Compliments +-- the idea of switching focus as the mouse crosses window boundaries to +-- keep the mouse near the currently focussed window +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.UpdatePointer + ( + -- * Usage + -- $usage + updatePointer + ) + where + +import XMonad +import Control.Monad + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad +-- > import XMonad.Hooks.DynamicLog +-- +-- Enable it by including it in your logHook definition. Eg: +-- +-- > logHook = updatePointer (1%2) (1%2) +-- +-- which will move the pointer to the middle of a newly focused window if the +-- focus moves away from the pointer + + +-- | Update the pointer's location to the currently focused window unless it's +-- already there +updatePointer :: Rational -> Rational -> X () +updatePointer h v = withFocused $ \w -> do + dpy <- asks display + root <- asks theRoot + wa <- io $ getWindowAttributes dpy w + (sameRoot,_,w',_,_,_,_,_) <- io $ queryPointer dpy root + unless (sameRoot && w == w') $ + io $ warpPointer dpy none w 0 0 0 0 + (fraction h (wa_width wa)) (fraction v (wa_height wa)) + where fraction x y = floor (x * fromIntegral y) + hunk ./xmonad-contrib.cabal 85 + XMonad.Actions.UpdatePointer hunk ./XMonad/Actions/UpdatePointer.hs 13 --- keep the mouse near the currently focussed window +-- keep the mouse near the currently focused window hunk ./XMonad/Actions/UpdatePointer.hs 36 --- > logHook = updatePointer (1%2) (1%2) +-- > logHook = updatePointer hunk ./XMonad/Actions/UpdatePointer.hs 38 --- which will move the pointer to the middle of a newly focused window if the --- focus moves away from the pointer +-- which will move the pointer to the nearest point of a newly focused window hunk ./XMonad/Actions/UpdatePointer.hs 41 --- | Update the pointer's location to the currently focused window unless it's --- already there -updatePointer :: Rational -> Rational -> X () -updatePointer h v = withFocused $ \w -> do +-- | Update the pointer's location to the nearest point of the currently focused +-- window unless it's already there +updatePointer :: X () +updatePointer = withFocused $ \w -> do hunk ./XMonad/Actions/UpdatePointer.hs 48 - (sameRoot,_,w',_,_,_,_,_) <- io $ queryPointer dpy root - unless (sameRoot && w == w') $ - io $ warpPointer dpy none w 0 0 0 0 - (fraction h (wa_width wa)) (fraction v (wa_height wa)) - where fraction x y = floor (x * fromIntegral y) + (_sameRoot,_,w',rootx,rooty,_,_,_) <- io $ queryPointer dpy root + -- Can sameRoot ever be false in this case? I'm going to assume not + unless (w == w') $ do + let x = moveWithin rootx (wa_x wa) ((wa_x wa) + (wa_width wa)) + let y = moveWithin rooty (wa_y wa) ((wa_y wa) + (wa_height wa)) + io $ warpPointer dpy none root 0 0 0 0 (fromIntegral x) (fromIntegral y) + +moveWithin :: Integral a => a -> a -> a -> a +moveWithin current lower upper = + if current < lower + then lower + else if current > upper + then upper + else current hunk ./XMonad/Layout/Magnifier.hs 126 - let mag (w,wr) ws | focused == Just w = ws ++ [(w, shrink r $ magnify z wr)] + let mag (w,wr) ws | focused == Just w = ws ++ [(w, fit r $ magnify z wr)] hunk ./XMonad/Layout/Magnifier.hs 137 -shrink :: Rectangle -> Rectangle -> Rectangle -shrink (Rectangle sx sy sw sh) (Rectangle x y w h) = Rectangle x' y' w' h' - where x' = max sx x - y' = max sy y - w' = min w (fromIntegral sx + sw - fromIntegral x') - h' = min h (fromIntegral sy + sh - fromIntegral y') +fit :: Rectangle -> Rectangle -> Rectangle +fit (Rectangle sx sy sw sh) (Rectangle x y w h) = Rectangle x' y' w' h' + where x' = max sx (x - (max 0 (x + fi w - sx - fi sw))) + y' = max sy (y - (max 0 (y + fi h - sy - fi sh))) + w' = min sw w + h' = min sh h hunk ./XMonad/Layout/Magnifier.hs 144 +fi :: (Num b, Integral a) => a -> b +fi = fromIntegral hunk ./XMonad/Hooks/DynamicLog.hs 33 - PP(..), defaultPP, dzenPP, sjanssenPP, byorgeyPP, + PP(..), defaultPP, dzenPP, xmobarPP, sjanssenPP, byorgeyPP, addfile ./XMonad/Prompt/DirExec.hs hunk ./XMonad/Prompt/DirExec.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.DirExec +-- Copyright : (C) 2008 Juraj Hercek +-- License : BSD3 +-- +-- Maintainer : juhe_xmonad@hck.sk +-- Stability : unstable +-- Portability : unportable +-- +-- A directory file executables prompt for XMonad. This might be useful if you +-- don't want to have scripts in your PATH environment variable (same +-- executable names, different behavior) - otherwise you might want to use +-- "XMonad.Prompt.Shell" instead - but you want to have easy access to these +-- executables through the xmonad's prompt. +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.DirExec + ( -- * Usage + -- $usage + dirExecPrompt + , dirExecPromptWithName + ) where + +import System.Directory +import Control.Monad +import Data.List +import XMonad +import XMonad.Prompt + +-- $usage +-- 1. In your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Prompt.DirExec +-- +-- 2. In your keybindings add something like: +-- +-- > , ("M-C-x", dirExecPrompt defaultXPConfig "/home/joe/.scipts") +-- +-- or +-- +-- > , ("M-C-x", dirExecPromptWithName defaultXPConfig "/home/joe/.scripts" +-- > "My Scripts: ") +-- +-- The first alternative uses the last element of the directory path for +-- a name of prompt. The second alternative uses the provided string +-- for the name of the prompt. +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data DirExec = DirExec String + +instance XPrompt DirExec where + showXPrompt (DirExec name) = name + +-- | Function 'dirExecPrompt' starts the prompt with list of all executable +-- files in directory specified by 'FilePath'. The name of the prompt is taken +-- from the last element of the path. If you specify root directory - @/@ - as +-- the path, name @Root:@ will be used as the name of the prompt instead. The +-- 'XPConfig' parameter can be used to customize visuals of the prompt. +dirExecPrompt :: XPConfig -> FilePath -> X () +dirExecPrompt cfg path = do + let name = (++ ": ") . last + . (["Root"] ++) -- handling of "/" path parameter + . words + . map (\x -> if x == '/' then ' ' else x) + $ path + dirExecPromptWithName cfg path name + +-- | Function 'dirExecPromptWithName' does the same as 'dirExecPrompt' except +-- the name of the prompt is specified by 'String' parameter. +dirExecPromptWithName :: XPConfig -> FilePath -> String -> X () +dirExecPromptWithName cfg path name = do + let path' = path ++ "/" + cmds <- io $ getDirectoryExecutables path' + mkXPrompt (DirExec name) cfg (compList cmds) (spawn . (path' ++)) + where + compList cmds s = return . filter (isInfixOf s) $ cmds + +getDirectoryExecutables :: FilePath -> IO [String] +getDirectoryExecutables path = + (getDirectoryContents path >>= + filterM (\x -> let x' = path ++ x in + liftM2 (&&) + (doesFileExist x') + (liftM executable (getPermissions x')))) + `catch` (return . return . show) + hunk ./xmonad-contrib.cabal 151 + XMonad.Prompt.DirExec hunk ./XMonad/Prompt/DirExec.hs 23 - , dirExecPromptWithName + , dirExecPromptNamed hunk ./XMonad/Prompt/DirExec.hs 39 --- > , ("M-C-x", dirExecPrompt defaultXPConfig "/home/joe/.scipts") +-- > , ("M-C-x", dirExecPrompt defaultXPConfig spawn "/home/joe/.scipts") hunk ./XMonad/Prompt/DirExec.hs 43 --- > , ("M-C-x", dirExecPromptWithName defaultXPConfig "/home/joe/.scripts" --- > "My Scripts: ") +-- > , ("M-C-x", dirExecPromptNamed defaultXPConfig spawn +-- > "/home/joe/.scripts" "My Scripts: ") +-- +-- or add this after your default bindings: +-- +-- > ++ +-- > [ ("M-x " ++ key, dirExecPrompt defaultXPConfig fn "/home/joe/.scripts") +-- > | (key, fn) <- [ ("x", spawn), ("M-x", runInTerm "-hold") ] +-- > ] +-- > ++ hunk ./XMonad/Prompt/DirExec.hs 56 --- for the name of the prompt. +-- for the name of the prompt. The third alternative defines 2 key bindings, +-- first one spawns the program by shell, second one runs the program in +-- terminal hunk ./XMonad/Prompt/DirExec.hs 73 -dirExecPrompt :: XPConfig -> FilePath -> X () -dirExecPrompt cfg path = do +-- The runner parameter specifies the function used to run the program - see +-- usage for more information +dirExecPrompt :: XPConfig -> (String -> X ()) -> FilePath -> X () +dirExecPrompt cfg runner path = do hunk ./XMonad/Prompt/DirExec.hs 82 - dirExecPromptWithName cfg path name + dirExecPromptNamed cfg runner path name hunk ./XMonad/Prompt/DirExec.hs 84 --- | Function 'dirExecPromptWithName' does the same as 'dirExecPrompt' except +-- | Function 'dirExecPromptNamed' does the same as 'dirExecPrompt' except hunk ./XMonad/Prompt/DirExec.hs 86 -dirExecPromptWithName :: XPConfig -> FilePath -> String -> X () -dirExecPromptWithName cfg path name = do +dirExecPromptNamed :: XPConfig -> (String -> X ()) -> FilePath -> String -> X () +dirExecPromptNamed cfg runner path name = do hunk ./XMonad/Prompt/DirExec.hs 90 - mkXPrompt (DirExec name) cfg (compList cmds) (spawn . (path' ++)) + mkXPrompt (DirExec name) cfg (compList cmds) (runner . (path' ++)) hunk ./XMonad/Actions/WmiiActions.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonad.Actions.WmiiActions --- Copyright : (c) Juraj Hercek --- License : BSD3 --- --- Maintainer : Juraj Hercek --- Stability : unstable --- Portability : unportable --- --- Provides \"actions\" as in the Wmii window manager --- (). It also provides a slightly better --- interface for running dmenu on xinerama screens. If you want to use --- xinerama functions, you have to apply the following patch (see the --- "XMonad.Util.Dmenu" module): --- . Don't --- forget to recompile dmenu afterwards ;-). ------------------------------------------------------------------------------ - -module XMonad.Actions.WmiiActions ( - -- * Usage - -- $usage - wmiiActions - , wmiiActionsXinerama - , executables - , executablesXinerama - ) where - -import XMonad -import XMonad.Util.Dmenu (dmenu, dmenuXinerama) -import XMonad.Util.Run (runProcessWithInput) - -import Control.Monad (filterM, liftM, liftM2) -import System.Directory (getDirectoryContents, doesFileExist, getPermissions, executable) - --- $usage --- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: --- --- > import XMonad.Actions.WmiiActions --- --- and add something like the following to your key bindings: --- --- > ,((modMask x, xK_a), wmiiActions "/home/joe/.wmii-3.5/") --- --- or, if you are using xinerama, you can use --- --- > ,((modMask x, xK_a), wmiiActionsXinerama "/home/joe/.wmii-3.5/") --- --- However, make sure you also have the xinerama build of dmenu (for more --- information see the "XMonad.Util.Dmenu" extension). --- --- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". - --- | The 'wmiiActions' function takes the file path as a first argument and --- executes dmenu with all the executables found in the provided path. -wmiiActions :: FilePath -> X () -wmiiActions path = - wmiiActionsDmenu path dmenu - --- | The 'wmiiActionsXinerama' does the same as 'wmiiActions', but it shows --- dmenu only on the currently focused workspace. -wmiiActionsXinerama :: FilePath -> X () -wmiiActionsXinerama path = - wmiiActionsDmenu path dmenuXinerama - -wmiiActionsDmenu :: FilePath -> ([String] -> X String) -> X () -wmiiActionsDmenu path dmenuBrand = - let path' = path ++ "/" in - getExecutableFileList path' >>= dmenuBrand >>= spawn . (path' ++) - -getExecutableFileList :: FilePath -> X [String] -getExecutableFileList path = - io $ getDirectoryContents path >>= - filterM (\x -> let x' = path ++ x in - liftM2 (&&) - (doesFileExist x') - (liftM executable (getPermissions x'))) - -{- -getExecutableFileList :: FilePath -> X [String] -getExecutableFileList path = - io $ getDirectoryContents path >>= - filterM (doesFileExist . (path ++)) >>= - filterM (liftM executable . getPermissions . (path ++)) --} - --- | The 'executables' function runs the dmenu_path script, providing list of --- executable files accessible from the $PATH variable. -executables :: X () -executables = executablesDmenu dmenu - --- | The 'executablesXinerama' function does the same as the --- 'executables' function, but on the workspace which currently has focus. -executablesXinerama :: X () -executablesXinerama = executablesDmenu dmenuXinerama - -executablesDmenu :: ([String] -> X String) -> X () -executablesDmenu dmenuBrand = - getExecutablesList >>= dmenuBrand >>= spawn - -getExecutablesList :: X [String] -getExecutablesList = - io $ liftM lines $ runProcessWithInput "dmenu_path" [] "" - rmfile ./XMonad/Actions/WmiiActions.hs hunk ./xmonad-contrib.cabal 89 - XMonad.Actions.WmiiActions hunk ./XMonad/Layout/Magnifier.hs 109 - | Just ToggleOff <- fromMessage m = return . Just $ (Mag (z + 0.1) Off t) + | Just ToggleOff <- fromMessage m = return . Just $ (Mag (z ) Off t) hunk ./XMonad/Actions/UpdatePointer.hs 32 --- > import XMonad.Hooks.DynamicLog +-- > import XMonad.Actions.UpdatePointer hunk ./XMonad/Prompt/XMonad.hs 24 -import XMonad.Actions.Commands (defaultCommands, runCommand') +import XMonad.Actions.Commands (defaultCommands) +import Data.Maybe (fromMaybe) hunk ./XMonad/Prompt/XMonad.hs 48 - mkXPrompt XMonad c (mkComplFunFromList' (map fst cmds)) runCommand' + xmonadPromptC cmds c hunk ./XMonad/Prompt/XMonad.hs 52 -xmonadPromptC commands c = mkXPrompt XMonad c (mkComplFunFromList' (map fst commands)) runCommand' +xmonadPromptC commands c = + mkXPrompt XMonad c (mkComplFunFromList' (map fst commands)) $ + fromMaybe (return ()) . (`lookup` commands) hunk ./XMonad/Prompt/Ssh.hs 51 - showXPrompt Ssh = "SSH to: " + showXPrompt Ssh = "SSH to: " + commandToComplete _ c = c + nextCompletion _ = getNextCompletion hunk ./XMonad/Prompt/Ssh.hs 93 - return $ map (takeWhile (/= ',') . concat . take 1 . words) + return $ map (getWithPort . takeWhile (/= ',') . concat . take 1 . words) hunk ./XMonad/Prompt/Ssh.hs 109 +getWithPort :: String -> String +getWithPort ('[':str) = host ++ " -p " ++ port + where (host,p) = break (==']') str + port = case p of + ']':':':x -> x + _ -> "22" +getWithPort str = str + hunk ./XMonad/Prompt/Ssh.hs 15 -module XMonad.Prompt.Ssh( - -- * Usage - -- $usage - sshPrompt - ) where +module XMonad.Prompt.Ssh + ( -- * Usage + -- $usage + sshPrompt + ) where move ./XMonad/Util/Font.cpphs ./XMonad/Util/Font.hsc hunk ./XMonad/Layout/ShowWName.hs 94 - width <- textWidthXMF d f n - (_,as,ds,_) <- textExtentsXMF f n + width <- textWidthXMF d f n + (as,ds) <- textExtentsXMF f n hunk ./XMonad/Prompt.hs 44 + , decodeInput + , encodeOutput hunk ./XMonad/Prompt.hs 341 - | otherwise = do insertString s + | otherwise = do insertString (decodeInput s) hunk ./XMonad/Prompt.hs 509 - (_,asc,desc,_) <- io $ textExtentsXMF fs str + (asc,desc) <- io $ textExtentsXMF fs str hunk ./XMonad/Prompt.hs 576 - (_,asc,desc,_) <- io $ textExtentsXMF fs $ head compl + (asc,desc) <- io $ textExtentsXMF fs $ head compl hunk ./XMonad/Util/Font.hsc 15 -module XMonad.Util.Font ( - -- * Usage: - -- $usage - XMonadFont(..) - , initXMF - , releaseXMF - , initCoreFont - , releaseCoreFont - , Align (..) - , stringPosition - , textWidthXMF - , textExtentsXMF - , printStringXMF - , stringToPixel - ) where - +module XMonad.Util.Font + ( -- * Usage: + -- $usage + XMonadFont(..) + , initXMF + , releaseXMF + , initCoreFont + , releaseCoreFont + , initUtf8Font + , releaseUtf8Font + , Align (..) + , stringPosition + , textWidthXMF + , textExtentsXMF + , printStringXMF + , stringToPixel + , decodeInput + , encodeOutput + ) where hunk ./XMonad/Util/Font.hsc 46 +#if defined XFT || defined UTF8 +import Codec.Binary.UTF8.String (encodeString, decodeString) +import Foreign.C +#endif + hunk ./XMonad/Util/Font.hsc 53 + | Utf8 FontSet hunk ./XMonad/Util/Font.hsc 64 -stringToPixel d s = fromMaybe fallBack <$> liftIO getIt +stringToPixel d s = fromMaybe fallBack <$> io getIt hunk ./XMonad/Util/Font.hsc 83 +initUtf8Font :: String -> X FontSet +initUtf8Font s = do + d <- asks display + (_,_,fs) <- io $ catch (getIt d) (fallBack d) + return fs + where getIt d = createFontSet d s + fallBack d = const $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + +releaseUtf8Font :: FontSet -> X () +releaseUtf8Font fs = do + d <- asks display + io $ freeFontSet d fs + hunk ./XMonad/Util/Font.hsc 102 - do - dpy <- asks display - xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s) - return (Xft xftdraw) + do io setupLocale + dpy <- asks display + xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s) + return (Xft xftdraw) hunk ./XMonad/Util/Font.hsc 108 +#ifdef UTF8 + (io setupLocale >> initUtf8Font s >>= (return . Utf8)) +#else hunk ./XMonad/Util/Font.hsc 112 +#endif hunk ./XMonad/Util/Font.hsc 118 -releaseXMF (Core fs) = releaseCoreFont fs hunk ./XMonad/Util/Font.hsc 123 +releaseXMF (Utf8 fs) = releaseUtf8Font fs +releaseXMF (Core fs) = releaseCoreFont fs + hunk ./XMonad/Util/Font.hsc 128 +textWidthXMF _ (Utf8 fs) s = return $ fi $ wcTextEscapement fs s hunk ./XMonad/Util/Font.hsc 133 - return $ xglyphinfo_width gi + return $ xglyphinfo_xOff gi hunk ./XMonad/Util/Font.hsc 136 -textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (FontDirection,Int32,Int32,CharStruct) -textExtentsXMF (Core fs) s = return $ textExtents fs s +textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (Int32,Int32) +textExtentsXMF (Utf8 fs) s = do + let (_,rl) = wcTextExtents fs s + ascent = fi $ - (rect_y rl) + descent = fi $ rect_height rl + (fi $ rect_y rl) + return (ascent, descent) +textExtentsXMF (Core fs) s = do + let (_,a,d,_) = textExtents fs s + return (a,d) hunk ./XMonad/Util/Font.hsc 146 -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") +textExtentsXMF (Xft xftfont) _ = io $ do + ascent <- fi `fmap` xftfont_ascent xftfont + descent <- fi `fmap` xftfont_descent xftfont + return (ascent, descent) hunk ./XMonad/Util/Font.hsc 157 -stringPosition :: XMonadFont -> Rectangle -> Align -> String -> X (Position,Position) -stringPosition fs (Rectangle _ _ w h) al s = do - dpy <- asks display - width <- io $ textWidthXMF 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) - AlignLeft -> 1 - AlignRight -> fi (w - (fi width + 1)); +stringPosition :: (Functor m, MonadIO m) => Display -> XMonadFont -> Rectangle -> Align -> String -> m (Position,Position) +stringPosition dpy fs (Rectangle _ _ w h) al s = do + width <- textWidthXMF dpy fs s + (a,d) <- 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) + AlignLeft -> 1 + AlignRight -> fi (w - (fi width + 1)); hunk ./XMonad/Util/Font.hsc 168 - -printStringXMF :: MonadIO m => Display -> Drawable -> XMonadFont -> GC -> String -> String +printStringXMF :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String hunk ./XMonad/Util/Font.hsc 170 -printStringXMF d p (Core fs) gc fc bc x y s = liftIO $ do - setFont d gc $ fontFromFontStruct fs - [fc',bc'] <- mapM (stringToPixel d) [fc,bc] - setForeground d gc fc' - setBackground d gc bc' - drawImageString d p gc x y s - +printStringXMF d p (Core fs) gc fc bc x y s = io $ do + setFont d gc $ fontFromFontStruct fs + [fc',bc'] <- mapM (stringToPixel d) [fc,bc] + setForeground d gc fc' + setBackground d gc bc' + drawImageString d p gc x y s +printStringXMF d p (Utf8 fs) gc fc bc x y s = io $ do + [fc',bc'] <- mapM (stringToPixel d) [fc,bc] + setForeground d gc fc' + setBackground d gc bc' + io $ wcDrawImageString d p fs gc x y s hunk ./XMonad/Util/Font.hsc 182 -printStringXMF dpy drw (Xft font) _ fc _ x y s = do - let screen = defaultScreenOfDisplay dpy; - colormap = defaultColormapOfScreen screen; - visual = defaultVisualOfScreen screen; - liftIO $ withXftDraw dpy drw visual colormap $ +printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do + let screen = defaultScreenOfDisplay dpy + colormap = defaultColormapOfScreen screen + visual = defaultVisualOfScreen screen + bcolor <- stringToPixel dpy bc + (a,d) <- textExtentsXMF fs s + gi <- io $ xftTextExtents dpy font s + io $ setForeground dpy gc bcolor + io $ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi)) + (y - fi a) + (fi $ xglyphinfo_xOff gi) + (fi $ a + d) + io $ withXftDraw dpy drw visual colormap $ hunk ./XMonad/Util/Font.hsc 199 +decodeInput :: String -> String +#if defined XFT || defined UTF8 +decodeInput = decodeString +#else +decodeInput = id +#endif + +encodeOutput :: String -> String +#if defined XFT || defined UTF8 +encodeOutput = encodeString +#else +encodeOutput = id +#endif hunk ./XMonad/Util/Font.hsc 217 +#if defined XFT || defined UTF8 +#include +foreign import ccall unsafe "locale.h setlocale" + setlocale :: CInt -> CString -> IO CString + +setupLocale :: IO () +setupLocale = withCString "" $ \s -> do + setlocale (#const LC_ALL) s + return () +#endif + hunk ./XMonad/Util/XUtils.hs 120 - (x,y) <- stringPosition fs (Rectangle 0 0 wh ht) al str + d <- asks display + (x,y) <- stringPosition d fs (Rectangle 0 0 wh ht) al str hunk ./xmonad-contrib.cabal 37 +flag with_utf8 + description: Enable Utf8 support + hunk ./xmonad-contrib.cabal 51 - build-depends: X11-xft >= 0.2 + build-depends: X11-xft >= 0.2, utf8-string + extensions: ForeignFunctionInterface hunk ./xmonad-contrib.cabal 55 + if flag(with_utf8) + build-depends: utf8-string + extensions: ForeignFunctionInterface + cpp-options: -DUTF8 + hunk ./XMonad/Prompt/Shell.hs 57 - mkXPrompt Shell c (getShellCompl cmds) spawn + mkXPrompt Shell c (getShellCompl cmds) (spawn . encodeOutput) hunk ./XMonad/Prompt/Shell.hs 76 - where run = safeSpawn c + where run = safeSpawn c . encodeOutput hunk ./XMonad/Prompt/Shell.hs 78 - where run a = unsafeSpawn $ c ++ " " ++ a + where run a = unsafeSpawn $ c ++ " " ++ encodeOutput a hunk ./XMonad/Prompt/Shell.hs 83 - f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file " ++ s ++ "\n") + f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file " ++ encodeOutput s ++ "\n") hunk ./XMonad/Prompt/Shell.hs 89 - return . uniqSort $ files ++ commandCompletionFunction cmds s + return . map decodeInput . uniqSort $ files ++ commandCompletionFunction cmds s hunk ./XMonad/Layout/ThreeColumns.hs 37 --- > myLayouts = ThreeCol 1 (3/100) (1/2) False ||| etc.. +-- > myLayouts = ThreeCol 1 (3/100) (1/2) ||| etc.. hunk ./XMonad/Layout/ThreeColumns.hs 40 --- Use @True@ as the last argument to get a wide layout. --- hunk ./XMonad/Actions/CycleWS.hs 175 + | HiddenNonEmptyWS -- ^ cycle through non-empty non-visible workspaces hunk ./XMonad/Actions/CycleWS.hs 185 +wsTypeToPred HiddenNonEmptyWS = do hs <- gets (map tag . hidden . windowset) + return (\w -> isJust (stack w) && tag w `elem` hs) hunk ./XMonad/Config/Droundy.hs 90 - , ((modMask x .|. shiftMask, xK_Right), moveTo Next NonEmptyWS) - , ((modMask x .|. shiftMask, xK_Left), moveTo Prev NonEmptyWS) + , ((modMask x .|. shiftMask, xK_Right), moveTo Next HiddenNonEmptyWS) + , ((modMask x .|. shiftMask, xK_Left), moveTo Prev HiddenNonEmptyWS) hunk ./XMonad/Config/Droundy.hs 139 - , XMonad.workspaces = ["mutt","iceweasel","*scratch*"] + , XMonad.workspaces = ["mutt","iceweasel"] hunk ./XMonad/Layout/ScratchWorkspace.hs 14 -import Data.Maybe ( listToMaybe, catMaybes ) -import Control.Monad ( guard, when ) +import Data.List ( partition ) +import Control.Monad ( guard ) hunk ./XMonad/Layout/ScratchWorkspace.hs 21 -toggleScratchWorkspace :: LayoutClass l Int => l Int -> X () -toggleScratchWorkspace l = - do s <- gets windowset - when (scratchName `W.tagMember` s) $ - case visibleScratch s of - Just oldscratch -> - do srs <- withDisplay getCleanedScreenInfo - when (length srs == length (W.visible s)) $ do - ml <- handleMessage (W.layout $ W.workspace oldscratch) (SomeMessage Hide) - let scratch = case ml of - Nothing -> oldscratch - Just l' -> oldscratch { W.workspace = - (W.workspace oldscratch) { W.layout = l' } } - mapM_ hide $ W.integrate' $ W.stack $ W.workspace scratch - let modscr scr = do guard $ scratchName /= W.tag (W.workspace scr) - Just $ scr { W.screenDetail = newDetail } - where newDetail = (W.screenDetail scr) - { screenRect = pickRect (W.screen scr) srs } - pickRect _ [z] = z - pickRect i (z:zs) | i < 1 = z - | otherwise = pickRect (i-1) zs - pickRect _ [] = error "XMonad.Layout.ScratchWorkspace.toggleScratchWorkspace: internal error" - s' = case catMaybes $ map modscr $ W.current s : W.visible s of - newc:newv -> s { W.current = newc, W.visible = newv, - W.hidden = W.workspace scratch : W.hidden s} - [] -> error "XMonad.Layout.ScratchWorkspace.toggleScratchWorkspace: internal error" - modify $ \st -> st { windowset = s' } - refresh - Nothing -> - case hiddenScratch s of - Nothing -> return () - Just hs -> do r <- gets (screenRect . W.screenDetail . W.current . windowset) - (rs,_) <- doLayout l r (W.Stack 0 [1] []) - let (r0, r1) = case rs of - [(0,ra),(1,rb)] -> (ra,rb) - [(1,ra),(0,rb)] -> (rb,ra) - [(1,ra)] -> (r,ra) - [(0,ra)] -> (ra,r) - _ -> (r,r) - c' = (W.current s) { W.screenDetail = - (W.screenDetail (W.current s)) { screenRect = r1 }} - let s' = s { W.current = W.Screen hs (-1) (SD r0 (0,0,0,0)), - W.visible = c': W.visible s, - W.hidden = filter (not . isScratchW) $ W.hidden s } - modify $ \st -> st { windowset = s' } - refresh - where visibleScratch s = listToMaybe $ filter isScratch $ W.current s : W.visible s - hiddenScratch s = listToMaybe $ filter isScratchW $ W.hidden s - isScratchW w = scratchName == W.tag w - isScratch scr = scratchName == W.tag (W.workspace scr) --- notScratch scr = scratchName /= W.tag (W.workspace scr) - +hiddenRect :: Rectangle +hiddenRect = Rectangle (-1) (-1) 0 0 hunk ./XMonad/Layout/ScratchWorkspace.hs 27 --- isScratchVisible :: X Bool --- isScratchVisible = gets (elem scratchName . map (W.tag . W.workspace) . W.visible . windowset) +-- This module uses an ugly hack, which is to create a special screen for +-- the scratch workspace. This screen is then moved onto a visible area or +-- away when you ask for the scratch workspace to be shown or hidden. + +-- This is a workaround for the fact that we don't have anything like +-- proper support for hierarchical workspaces, so I use the only hierarchy +-- we've got, which is at the screen level. + +toggleScratchWorkspace :: LayoutClass l Int => l Int -> X () +toggleScratchWorkspace l = + do s <- gets windowset + defaultl <- asks (layoutHook . config) + srs <- withDisplay getCleanedScreenInfo + if length srs == 1 + length (W.visible s) + then -- we don't yet have a scratch screen! + if scratchName `W.tagMember` s + then return () -- We'll just bail out of scratchName already exists... + else do let scratchscreen = W.Screen scratch (-1) (SD hiddenRect (0,0,0,0)) + scratch = W.Workspace scratchName defaultl Nothing + s' = s { W.visible = scratchscreen: W.visible s } + modify $ \st -> st { windowset = s' } + refresh + else -- We've already got a scratch (we think) + if length srs /= length (W.visible s) + then -- Something is odd... too many screens are visible! Do nothing. + return () + else -- Yes, it does seem there's a scratch screen already + case partition ((/= -1) . W.screen) $ W.current s : W.visible s of + (others@(c:vs),[scratchscreen]) -> + if screenRect (W.screenDetail scratchscreen) == hiddenRect + then -- we're hidden now, so let's display ourselves + do let r = screenRect $ W.screenDetail c + (rs,_) <- doLayout l r (W.Stack 0 [1] []) + let (r0, r1) = case rs of + [(0,ra),(1,rb)] -> (ra,rb) + [(1,ra),(0,rb)] -> (rb,ra) + [(1,ra)] -> (r,ra) + [(0,ra)] -> (ra,r) + _ -> (r,r) + s' = s { W.current = setrect r0 scratchscreen, + W.visible = setrect r1 c : vs } + modify $ \st -> st { windowset = s' } + refresh + else -- we're visible, so now we want to hide + do ml <- handleMessage (W.layout $ W.workspace scratchscreen) (SomeMessage Hide) + let scratchscreen' = case ml of + Nothing -> scratchscreen + Just l' -> scratchscreen + { W.workspace = + (W.workspace scratchscreen) { W.layout = l' } } + mapM_ hide $ W.integrate' $ W.stack $ W.workspace scratchscreen + let modscr scr = do guard $ scratchName /= W.tag (W.workspace scr) + r' <- pickRect (W.screen scr) srs + Just $ setrect r' scr + pickRect _ [z] = Just z + pickRect i (z:zs) | i < 1 = Just z + | otherwise = pickRect (i-1) zs + pickRect _ [] = Nothing + case mapM modscr others of + Just (c':vs') -> + do let s' = s { W.current = c', + W.visible = setrect hiddenRect scratchscreen' : vs' } + modify $ \st -> st { windowset = s' } + refresh + _ -> return () -- weird error! + _ -> -- Something is odd... there doesn't seem to *really* be a scratch screen... + return () + where setrect :: Rectangle -> W.Screen i l a sid ScreenDetail -> W.Screen i l a sid ScreenDetail + setrect x scr = scr {W.screenDetail = (W.screenDetail scr) {screenRect = x}} hunk ./XMonad/Layout/NoBorders.hs 75 - ss <- gets (W.screens . windowset) + ss <- gets (filter (nonzerorect . screenRect . W.screenDetail) . W.screens . windowset) hunk ./XMonad/Layout/NoBorders.hs 88 + nonzerorect (Rectangle _ _ 0 0) = False + nonzerorect _ = True hunk ./XMonad/Hooks/ManageHelpers.hs 143 -doCenterFloat = ask >>= \w -> doF . W.float w . center . snd =<< liftX (floatLocation w) +doCenterFloat = ask >>= \w -> doF . W.float w . center =<< liftX (floatLocation w) hunk ./XMonad/Util/EZConfig.hs 316 --- > startupHook = checkKeymap myConfig myKeymap +-- > startupHook = return () >> checkKeymap myConfig myKeymap hunk ./XMonad/Util/EZConfig.hs 320 +-- NOTE: the @return ()@ in the example above is very important! +-- Otherwise, you might run into problems with infinite mutual +-- recursion: the definition of myConfig depends on the definition of +-- startupHook, which depends on the definition of myConfig, ... and +-- so on. Actually, it's likely that the above example in particular +-- would be OK without the @return ()@, but making @myKeymap@ take +-- @myConfig@ as a parameter would definitely lead to +-- problems. Believe me. It, uh, happened to my friend. In... a +-- dream. Yeah. In any event, the @return () >>@ introduces enough +-- laziness to break the deadlock. +-- hunk ./XMonad/Layout/Combo.hs 28 -import XMonad.StackSet ( integrate, Stack(..) ) +import XMonad.StackSet ( integrate, Workspace (..), Stack(..) ) hunk ./XMonad/Layout/Combo.hs 103 - (wrs1, ml1') <- runLayout l1 r1 s1 - (wrs2, ml2') <- runLayout l2 r2 s2 + (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1 + (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2 hunk ./XMonad/Hooks/ManageDocks.hs 125 - modifyLayout (AvoidStruts b) l r s = do + modifyLayout (AvoidStruts b) w r = do hunk ./XMonad/Hooks/ManageDocks.hs 127 - doLayout l nr s + runLayout w nr hunk ./XMonad/Layout/LayoutModifier.hs 24 -import XMonad.StackSet ( Stack ) +import XMonad.StackSet ( Stack, Workspace (..) ) hunk ./XMonad/Layout/LayoutModifier.hs 36 - modifyLayout :: (LayoutClass l a) => m a -> l a -> Rectangle - -> Stack a -> X ([(a, Rectangle)], Maybe (l a)) - modifyLayout _ l r s = doLayout l r s + modifyLayout :: (LayoutClass l a) => m a -> Workspace WorkspaceId (l a) a + -> Rectangle -> X ([(a, Rectangle)], Maybe (l a)) + modifyLayout _ w r = runLayout w r hunk ./XMonad/Layout/LayoutModifier.hs 70 - doLayout (ModifiedLayout m l) r s = - do (ws, ml') <- modifyLayout m l r s - (ws', mm') <- redoLayout m r s ws + runLayout (Workspace i (ModifiedLayout m l) ms) r = + do (ws, ml') <- modifyLayout m (Workspace i l ms) r + (ws', mm') <- case ms of + Just s -> redoLayout m r s ws + Nothing -> emptyLayoutMod m r ws hunk ./XMonad/Layout/LayoutModifier.hs 76 - Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml' - Nothing -> ModifiedLayout m `fmap` ml' - return (ws', ml'') - emptyLayout (ModifiedLayout m l) r = - do (ws, ml') <- emptyLayout l r - (ws',mm') <- emptyLayoutMod m r ws - let ml'' = case mm' of - Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml' - Nothing -> ModifiedLayout m `fmap` ml' + Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml' + Nothing -> ModifiedLayout m `fmap` ml' hunk ./XMonad/Layout/LayoutModifier.hs 79 + hunk ./XMonad/Layout/ResizeScreen.hs 66 - modifyLayout m l rect@(Rectangle x y w h) s + modifyLayout m ws rect@(Rectangle x y w h) hunk ./XMonad/Layout/ResizeScreen.hs 73 - where resize nr = doLayout l nr s + where resize nr = runLayout ws nr hunk ./XMonad/Layout/LayoutCombinators.hs 49 +import XMonad.StackSet (Workspace (..)) hunk ./XMonad/Layout/LayoutCombinators.hs 163 - doLayout (NewSelect True l1 l2) r s = do (wrs, ml1') <- doLayout l1 r s - return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1') - doLayout (NewSelect False l1 l2) r s = do (wrs, ml2') <- doLayout l2 r s - return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2') - emptyLayout (NewSelect True l1 l2) r = do (wrs, ml1') <- emptyLayout l1 r - return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1') - emptyLayout (NewSelect False l1 l2) r = do (wrs, ml2') <- emptyLayout l2 r - return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2') + runLayout (Workspace i (NewSelect True l1 l2) ms) r = do (wrs, ml1') <- runLayout (Workspace i l1 ms) r + return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1') + + runLayout (Workspace i (NewSelect False l1 l2) ms) r = do (wrs, ml2') <- runLayout (Workspace i l2 ms) r + return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2') hunk ./XMonad/Layout/ToggleLayouts.hs 24 +import XMonad.StackSet (Workspace (..)) hunk ./XMonad/Layout/ToggleLayouts.hs 60 - doLayout (ToggleLayouts True lt lf) r s = do (ws,mlt') <- doLayout lt r s - return (ws,fmap (\lt' -> ToggleLayouts True lt' lf) mlt') - doLayout (ToggleLayouts False lt lf) r s = do (ws,mlf') <- doLayout lf r s - return (ws,fmap (\lf' -> ToggleLayouts False lt lf') mlf') - emptyLayout (ToggleLayouts True lt lf) r = do (ws,mlt') <- emptyLayout lt r - return (ws,fmap (\lt' -> ToggleLayouts True lt' lf) mlt') - emptyLayout (ToggleLayouts False lt lf) r = do (ws,mlf') <- emptyLayout lf r - return (ws,fmap (\lf' -> ToggleLayouts False lt lf') mlf') + runLayout (Workspace i (ToggleLayouts True lt lf) ms) r = do (ws,mlt') <- runLayout (Workspace i lt ms) r + return (ws,fmap (\lt' -> ToggleLayouts True lt' lf) mlt') + + runLayout (Workspace i (ToggleLayouts False lt lf) ms) r = do (ws,mlf') <- runLayout (Workspace i lf ms) r + return (ws,fmap (\lf' -> ToggleLayouts False lt lf') mlf') hunk ./XMonad/Layout/PerWorkspace.hs 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). +-- Configure layouts on a per-workspace basis. hunk ./XMonad/Layout/PerWorkspace.hs 16 -module XMonad.Layout.PerWorkspace ( - -- * Usage - -- $usage - - onWorkspace, onWorkspaces - ) where +module XMonad.Layout.PerWorkspace + ( -- * Usage + -- $usage + onWorkspace, onWorkspaces + ) where hunk ./XMonad/Layout/PerWorkspace.hs 46 --- --- NOTE that this module does not (yet) work in conjunction with --- multiple screens. =( hunk ./XMonad/Layout/PerWorkspace.hs 55 -onWorkspace wsId l1 l2 = PerWorkspace [wsId] Nothing l1 l2 +onWorkspace wsId l1 l2 = PerWorkspace [wsId] True l1 l2 hunk ./XMonad/Layout/PerWorkspace.hs 64 -onWorkspaces wsIds l1 l2 = PerWorkspace wsIds Nothing l1 l2 +onWorkspaces wsIds l1 l2 = PerWorkspace wsIds True l1 l2 hunk ./XMonad/Layout/PerWorkspace.hs 67 --- a layout for all other workspaces. We store the tags of workspaces --- to be matched, and the two layouts. Since layouts are stored\/tracked --- per workspace, once we figure out whether we're on a matched workspace, --- we can cache that information using a (Maybe Bool). This is necessary --- to be able to correctly implement the 'description' method of --- LayoutClass, since a call to description is not able to query the --- WM state to find out which workspace it was called in. +-- a layout for all other workspaces. We store the tags of workspaces +-- to be matched, and the two layouts. We save the layout choice in +-- the Bool, to be used to implement description. hunk ./XMonad/Layout/PerWorkspace.hs 71 - (Maybe Bool) + Bool hunk ./XMonad/Layout/PerWorkspace.hs 76 -instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (PerWorkspace l1 l2) a where - - -- do layout with l1, then return a modified PerWorkspace caching - -- the fact that we're in the matched workspace. - doLayout p@(PerWorkspace _ (Just True) lt _) r s = do - (wrs, mlt') <- doLayout lt r s - return (wrs, Just $ mkNewPerWorkspaceT p mlt') - - -- do layout with l1, then return a modified PerWorkspace caching - -- the fact that we're not in the matched workspace. - doLayout p@(PerWorkspace _ (Just False) _ lf) r s = do - (wrs, mlf') <- doLayout lf r s - return (wrs, Just $ mkNewPerWorkspaceF p mlf') +instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerWorkspace l1 l2) a where + runLayout (W.Workspace i p@(PerWorkspace wsIds _ lt lf) ms) r + | i `elem` wsIds = do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r + return (wrs, Just $ mkNewPerWorkspaceT p mlt') + | otherwise = do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r + return (wrs, Just $ mkNewPerWorkspaceF p mlt') hunk ./XMonad/Layout/PerWorkspace.hs 83 - -- figure out which layout to use based on the current workspace. - doLayout (PerWorkspace wsIds Nothing l1 l2) r s = do - t <- getCurrentTag - doLayout (PerWorkspace wsIds (Just $ t `elem` wsIds) l1 l2) r s + handleMessage (PerWorkspace wsIds bool lt lf) m + | bool = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ PerWorkspace wsIds bool nt lf) + | otherwise = handleMessage lf m >>= maybe (return Nothing) (\nf -> return . Just $ PerWorkspace wsIds bool lt nf) hunk ./XMonad/Layout/PerWorkspace.hs 87 - -- handle messages; same drill as doLayout. - handleMessage p@(PerWorkspace _ (Just True) lt _) m = do - mlt' <- handleMessage lt m - return . Just $ mkNewPerWorkspaceT p mlt' - - handleMessage p@(PerWorkspace _ (Just False) _ lf) m = do - mlf' <- handleMessage lf m - return . Just $ mkNewPerWorkspaceF p mlf' - - handleMessage (PerWorkspace _ Nothing _ _) _ = return Nothing - - description (PerWorkspace _ (Just True ) l1 _) = description l1 - description (PerWorkspace _ (Just False) _ l2) = description l2 - - -- description's result is not in the X monad, so we have to wait - -- until a doLayout for the information about which workspace - -- we're in to get cached. - description _ = "PerWorkspace" + description (PerWorkspace _ True l1 _) = description l1 + description (PerWorkspace _ _ _ l2) = description l2 hunk ./XMonad/Layout/PerWorkspace.hs 93 -mkNewPerWorkspaceT (PerWorkspace wsIds b lt lf) mlt' = - (\lt' -> PerWorkspace wsIds b lt' lf) $ fromMaybe lt mlt' +mkNewPerWorkspaceT (PerWorkspace wsIds _ lt lf) mlt' = + (\lt' -> PerWorkspace wsIds True lt' lf) $ fromMaybe lt mlt' hunk ./XMonad/Layout/PerWorkspace.hs 98 -mkNewPerWorkspaceF (PerWorkspace wsIds b lt lf) mlf' = - (\lf' -> PerWorkspace wsIds b lt lf') $ fromMaybe lf mlf' - --- | Get the tag of the currently active workspace. Note that this --- is only guaranteed to be the same workspace for which doLayout --- was called if there is only one screen. -getCurrentTag :: X WorkspaceId -getCurrentTag = gets windowset >>= return . W.tag . W.workspace . W.current +mkNewPerWorkspaceF (PerWorkspace wsIds _ lt lf) mlf' = + (\lf' -> PerWorkspace wsIds False lt lf') $ fromMaybe lf mlf' hunk ./XMonad/Layout/PerWorkspace.hs 55 -onWorkspace wsId l1 l2 = PerWorkspace [wsId] True l1 l2 +onWorkspace wsId l1 l2 = PerWorkspace [wsId] False l1 l2 hunk ./XMonad/Layout/PerWorkspace.hs 64 -onWorkspaces wsIds l1 l2 = PerWorkspace wsIds True l1 l2 +onWorkspaces wsIds l1 l2 = PerWorkspace wsIds False l1 l2 hunk ./XMonad/Layout/MultiToggle.hs 32 +import XMonad.StackSet (Workspace(..)) + hunk ./XMonad/Layout/MultiToggle.hs 201 - pureLayout mt r s = currLayout mt `unEL` \l -> pureLayout l r s - - doLayout mt r s = currLayout mt `unEL` \l -> acceptChange mt (fmap . fmap) (doLayout l r s) - - emptyLayout mt r = currLayout mt `unEL` \l -> acceptChange mt (fmap . fmap) (emptyLayout l r) + runLayout (Workspace i mt s) r = currLayout mt `unEL` \l -> acceptChange mt (fmap . fmap) (runLayout (Workspace i l s) r) hunk ./XMonad/Layout/Combo.hs 9 --- +-- hunk ./XMonad/Layout/Combo.hs 20 - -- $usage + -- $usage hunk ./XMonad/Layout/Combo.hs 34 --- --- > import XMonad.Layout.Combo --- +-- +-- > import XMonad.Layout.Combo +-- hunk ./XMonad/Layout/Combo.hs 38 --- +-- hunk ./XMonad/Layout/Combo.hs 102 - ([((),r1),((),r2)], msuper') <- doLayout super rinput superstack + ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super (Just superstack)) rinput hunk ./XMonad/Layout/LayoutScreens.hs 61 - (wss, _) <- doLayout l rtrect W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] } + (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rtrect hunk ./XMonad/Layout/MagicFocus.hs 16 -module XMonad.Layout.MagicFocus +module XMonad.Layout.MagicFocus hunk ./XMonad/Layout/MagicFocus.hs 47 -magicFocus (MagicFocus l) r s = +magicFocus (MagicFocus l) r s = hunk ./XMonad/Layout/MagicFocus.hs 49 - (ws,nl) <- doLayout l r (swap s $ peek wset) + (ws,nl) <- runLayout (Workspace "" l (Just . swap s $ peek wset)) r hunk ./XMonad/Util/Scratchpad.hs 17 --- The default ManageHook uses a centered, half-screen-wide, +-- The default ManageHook uses a centered, half-screen-wide, hunk ./XMonad/Util/Scratchpad.hs 23 --- Most others are likely to follow the lead set by xterm. --- +-- Most others are likely to follow the lead set by xterm. +-- hunk ./XMonad/Util/Scratchpad.hs 32 --- +-- hunk ./XMonad/Util/Scratchpad.hs 36 --- +-- hunk ./XMonad/Layout/ScratchWorkspace.hs 59 - (rs,_) <- doLayout l r (W.Stack 0 [1] []) + (rs,_) <- runLayout (W.Workspace "" l (Just $ W.Stack 0 [1] [])) r hunk ./XMonad/Hooks/EwmhDesktops.hs 135 + ,"_NET_CLIENT_LIST_STACKING" hunk ./XMonad/Prompt/DirExec.hs 70 --- from the last element of the path. If you specify root directory - @/@ - as +-- from the last element of the path. If you specify root directory - @\/@ - as hunk ./XMonad/Layout/NoBorders.hs 32 +import qualified Data.Map as M hunk ./XMonad/Layout/NoBorders.hs 76 - ss <- gets (filter (nonzerorect . screenRect . W.screenDetail) . W.screens . windowset) - - if singleton ws && singleton ss - then do - asks (borderWidth . config) >>= setBorders (s \\ ws) - setBorders ws 0 - return (wrs, Just $ SmartBorder ws) - else do - asks (borderWidth . config) >>= setBorders s - return (wrs, Just $ SmartBorder []) + wset <- gets windowset + let + screens = filter (nonzerorect . screenRect . W.screenDetail) . W.screens $ wset + ws + | singleton screens = tiled ++ floating + | otherwise = [] + tiled = case wrs of + [(w, _)] -> [w] + _ -> [] + floating = + [ w | + (w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset, + px <= 0, py <= 0, + wx >= 1, wy >= 1 + ] + asks (borderWidth . config) >>= setBorders (s \\ ws) + setBorders ws 0 + return (wrs, Just $ SmartBorder ws) hunk ./XMonad/Layout/NoBorders.hs 95 - ws = map fst wrs hunk ./XMonad/Layout/LayoutCombinators.hs 13 --- A module for combining other layouts. +-- The "XMonad.Layout.LayoutCombinators" module provides combinators +-- for easily combining multiple layouts into one composite layout, as +-- well as a way to jump directly to any particular layout (say, with +-- a keybinding) without having to cycle through other layouts to get +-- to it. hunk ./XMonad/Layout/LayoutCombinators.hs 24 - -- * Combinators using DragPane vertical + -- * Layout combinators + -- $combine + + -- ** Combinators using DragPane vertical hunk ./XMonad/Layout/LayoutCombinators.hs 32 - -- * Combinators using DragPane horizontal + -- ** Combinators using DragPane horizontal hunk ./XMonad/Layout/LayoutCombinators.hs 37 - -- * Combinators using Tall (vertical) + -- ** Combinators using Tall (vertical) hunk ./XMonad/Layout/LayoutCombinators.hs 42 - -- * Combinators using Mirror Tall (horizontal) + -- ** Combinators using Mirror Tall (horizontal) hunk ./XMonad/Layout/LayoutCombinators.hs 47 - -- * A new combinator - -- $nc + -- * New layout choice combinator and 'JumpToLayout' + -- $jtl hunk ./XMonad/Layout/LayoutCombinators.hs 65 --- Then edit your @layoutHook@ by using the new layout combinators: +-- Then edit your @layoutHook@ to use the new layout combinators. For +-- example: hunk ./XMonad/Layout/LayoutCombinators.hs 71 --- For more detailed instructions on editing the layoutHook see: +-- For more detailed instructions on editing the @layoutHook@ see: hunk ./XMonad/Layout/LayoutCombinators.hs 74 +-- +-- To use the 'JumpToLayout' message, hide the normal @|||@ operator instead: +-- +-- > import XMonad hiding ( (|||) ) +-- > import XMonad.Layout.LayoutCombinators +-- +-- Then bind some keys to a 'JumpToLayout' message: +-- +-- > , ((modMask x .|. controlMask, xK_f), sendMessage $ JumpToLayout "Full") -- jump directly to the Full layout +-- +-- See below for more detailed documentation. + +-- $combine +-- Each of the following combinators combines two layouts into a +-- single composite layout by splitting the screen into two regions, +-- one governed by each layout. Asterisks in the combinator names +-- denote the relative amount of screen space given to the respective +-- layouts. For example, the '***||*' combinator gives three times as +-- much space to the left-hand layout as to the right-hand layout. hunk ./XMonad/Layout/LayoutCombinators.hs 102 + hunk ./XMonad/Layout/LayoutCombinators.hs 122 + hunk ./XMonad/Layout/LayoutCombinators.hs 140 --- These combinators combine two layouts vertically using Tall. +-- These combinators combine two layouts vertically using @Tall@. + hunk ./XMonad/Layout/LayoutCombinators.hs 159 --- These combinators combine two layouts horizontally using Mirror --- Tall (a wide layout). +-- These combinators combine two layouts horizontally using @Mirror +-- Tall@. + hunk ./XMonad/Layout/LayoutCombinators.hs 179 --- $nc --- A new layout combinator that allows the use of a prompt to change --- layout. For more information see "Xmonad.Prompt.Layout" +-- $jtl +-- The standard xmonad core exports a layout combinator @|||@ which +-- represents layout choice. This is a reimplementation which also +-- provides the capability to support 'JumpToLayout' messages. To use +-- it, be sure to hide the import of @|||@ from the xmonad core: +-- +-- > import XMonad hiding ( (|||) ) +-- +-- The argument given to a 'JumpToLayout' message should be the +-- @description@ of the layout to be selected. If you use +-- "XMonad.Hooks.DynamicLog", this is the name of the layout displayed +-- in your status bar. Alternatively, you can use GHCi to determine +-- the proper name to use. For example: +-- +-- > $ ghci +-- > GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help +-- > Loading package base ... linking ... done. +-- > :set prompt "> " -- don't show loaded module names +-- > > :m +XMonad.Core -- load the xmonad core +-- > > :m +XMonad.Layout.Grid -- load whatever module you want to use +-- > > description Grid -- find out what it's called +-- > "Grid" +-- +-- As yet another (possibly easier) alternative, you can use the +-- "XMonad.Layout.Named" modifier to give custom names to your +-- layouts, and use those. +-- +-- For the ability to select a layout from a prompt, see +-- "Xmonad.Prompt.Layout". + +-- | A reimplementation of the combinator of the same name from the +-- xmonad core, providing layout choice, and the ability to support +-- 'JumpToLayout' messages. hunk ./XMonad/Layout/LayoutCombinators.hs 220 +-- | A message to jump to a particular layout, specified by its +-- description string. addfile ./XMonad/Actions/Promote.hs hunk ./XMonad/Actions/Promote.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.Promote +-- Copyright : (c) Miikka Koskinen 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : xmonad@s001.ethrael.com +-- Stability : unstable +-- Portability : unportable +-- +-- Alternate promote function for xmonad. +-- +-- Moves the focused window to the master pane. All other windows +-- retain their order. If focus is in the master, swap it with the +-- next window in the stack. Focus stays in the master. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.Promote ( + -- * Usage + -- $usage + promote + ) where + +import XMonad +import XMonad.StackSet + +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.Promote +-- +-- then add a keybinding or substitute 'promote' in place of swapMaster: +-- +-- > , ((modMask x, xK_Return), promote) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Move the focused window to the master pane. All other windows +-- retain their order. If focus is in the master, swap it with the +-- next windo in the stack. Focus stays in the master. +promote :: X () +promote = windows $ modify' $ + \c -> case c of + Stack _ [] [] -> c + Stack t [] (x:rs) -> Stack x [] (t:rs) + Stack t ls rs -> Stack t [] (reverse ls ++ rs) hunk ./xmonad-contrib.cabal 87 + XMonad.Actions.Promote hunk ./XMonad/Actions/Search.hs 11 - Modeled after the handy Surfraw CLI search tools at - . + Modeled after the handy Surfraw CLI search tools at . hunk ./XMonad/Actions/Search.hs 100 -> -- Search commands -> , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.defaultXPConfig) -> , ((modm .|. shiftMask, xK_s), SM.submap $ searchEngineMap $ S.selectSearch) +> ... +> -- Search commands +> , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.defaultXPConfig) +> , ((modm .|. shiftMask, xK_s), SM.submap $ searchEngineMap $ S.selectSearch) hunk ./XMonad/Actions/Search.hs 107 -> searchEngineMap method = M.fromList $ -> [ ((0, xK_g), method \"firefox\" S.google) -> , ((0, xK_h), method \"firefox\" S.hoogle) -> , ((0, xK_w), method \"firefox\" S.wikipedia) -> ] +> searchEngineMap method = M.fromList $ +> [ ((0, xK_g), method \"firefox\" S.google) +> , ((0, xK_h), method \"firefox\" S.hoogle) +> , ((0, xK_w), method \"firefox\" S.wikipedia) +> ] hunk ./XMonad/Actions/Search.hs 197 - > , ((modm, xK_g ), promptSearch greenXPConfig "firefox" google) + > , ((modm, xK_g), promptSearch greenXPConfig "firefox" google) hunk ./XMonad/Actions/Search.hs 206 -> , ((modm .|. shiftMask, xK_g ), selectSearch "firefox" google) +> , ((modm .|. shiftMask, xK_g), selectSearch "firefox" google) hunk ./XMonad/Actions/WindowGo.hs 1 -{- -------------------------------------------------------------------------- -| +{- | hunk ./XMonad/Actions/WindowGo.hs 10 -Monad, such as runOrRaise. - ------------------------------------------------------------------------------ -} +monad, such as 'runOrRaise'. -} hunk ./XMonad/Actions/WindowGo.hs 26 --- $usage --- --- Import the module into your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Actions.WindowGo --- --- and define appropriate key bindings: --- --- > , ((modMask x .|. shiftMask, xK_g ), raise (className =? "Firefox-bin")) --- > , ((modMask x .|. shiftMask, xK_b ), runOrRaise "mozilla-firefox" (className =? "Firefox-bin")) --- --- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +{- $usage + +Import the module into your @~\/.xmonad\/xmonad.hs@: + +> import XMonad.Actions.WindowGo + +and define appropriate key bindings: + +> , ((modMask x .|. shiftMask, xK_g), raise (className =? "Firefox")) +> , ((modMask x .|. shiftMask, xK_b), runOrRaise "firefox" (className =? "Firefox")) + +(Note that Firefox v3 and up have a class-name of "Firefox" and "Navigator"; +lower versions use other classnames such as "Firefox-bin" +For detailed instructions on editing your key bindings, see +"XMonad.Doc.Extending#Editing_key_bindings". -} hunk ./XMonad/Actions/WindowGo.hs 51 -{- | raiseMaybe: this queries all Windows based on a boolean provided by the +{- | 'raiseMaybe' queries all Windows based on a boolean provided by the hunk ./XMonad/Actions/WindowGo.hs 56 - class is Firefox. Firefox declares the class "Firefox-bin", so you'd want to - pass in a boolean like '(className =? "Firefox-bin")'. + class is Firefox. Firefox declares the class "Firefox", so you'd want to + pass in a boolean like '(className =? "Firefox")'. + hunk ./XMonad/Actions/WindowGo.hs 72 - there isn't you run a terminal with a command to run mutt! Here's an example, - borrowing 'runInTerm' from XMonad.Utils.Run: + there isn't you run a terminal with a command to run Mutt! Here's an example + (borrowing "XMonad.Utils.Run"'s 'runInTerm'): hunk ./XMonad/Actions/WindowGo.hs 75 - > , ((modm, xK_m ), raiseMaybe (runInTerm "-title mutt" "mutt") (title =? "mutt")) + > , ((modm, xK_m), raiseMaybe (runInTerm "-title mutt" "mutt") (title =? "mutt")) hunk ./XMonad/Actions/WindowGo.hs 81 - [] -> f + [] -> f hunk ./XMonad/Actions/Search.hs 159 +type Query = String hunk ./XMonad/Actions/Search.hs 164 -search :: MonadIO m => Browser -> SearchEngine -> String -> m () +search :: MonadIO m => Browser -> SearchEngine -> Query -> m () hunk ./XMonad/Actions/Search.hs 178 -simpleEngine :: String -> SearchEngine +simpleEngine :: Query -> SearchEngine hunk ./XMonad/Util/XSelection.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonad.Util.XSelection --- Copyright : (C) 2007 Andrea Rossato, Matthew Sackman --- License : BSD3 --- --- Maintainer : Andrea Rossato , --- Matthew Sackman --- Stability : unstable --- Portability : unportable --- --- A module for accessing and manipulating the X Window mouse selection (used in copy and pasting). --- getSelection and putSelection are adaptations of Hxsel.hs and Hxput.hs from XMonad-utils, available: --- --- $ darcs get ------------------------------------------------------------------------------ +{- | +Module : XMonad.Util.XSelection +Copyright : (C) 2007 Andrea Rossato, Matthew Sackman +License : BSD3 hunk ./XMonad/Util/XSelection.hs 6 -module XMonad.Util.XSelection ( - -- * Usage +Maintainer : Andrea Rossato , + Matthew Sackman +Stability : unstable +Portability : unportable + +A module for accessing and manipulating X Window's mouse selection (the buffer used in copy and pasting). +'getSelection' and 'putSelection' are adaptations of Hxsel.hs and Hxput.hs from the XMonad-utils, available: + +> $ darcs get +-} + +module XMonad.Util.XSelection ( -- * Usage hunk ./XMonad/Util/XSelection.hs 35 - Add 'import XMonad.Util.XSelection' to the top of Config.hs - Then make use of getSelection or promptSelection as needed; if - one wanted to run Firefox with the selection as an argument (say, - the selection is an URL you just highlighted), then one could add - to the Config.hs a line like thus: + Add @import XMonad.Util.XSelection@ to the top of Config.hs + Then make use of getSelection or promptSelection as needed; if + one wanted to run Firefox with the selection as an argument (perhaps + the selection string is an URL you just highlighted), then one could add + to the xmonad.hs a line like thus: + + > , ((modMask .|. shiftMask, xK_b), promptSelection "firefox") hunk ./XMonad/Util/XSelection.hs 43 -> , ((modMask .|. shiftMask, xK_b ), promptSelection "firefox") + There are a number of known problems with XSelection: hunk ./XMonad/Util/XSelection.hs 45 - TODO: - * Fix Unicode handling. Currently it's still better than calling - 'chr' to translate to ASCII, though. - As near as I can tell, the mangling happens when the String is - outputted somewhere, such as via promptSelection's passing through - the shell, or GHCi printing to the terminal. utf-string has IO functions - which can fix this, though I do not know have to use them here. It's - a complex issue; see - - and . + * Unicode handling is busted. But it's still better than calling + 'chr' to translate to ASCII, at least. + As near as I can tell, the mangling happens when the String is + outputted somewhere, such as via promptSelection's passing through + the shell, or GHCi printing to the terminal. utf-string has IO functions + which can fix this, though I do not know have to use them here. It's + a complex issue; see + + and . hunk ./XMonad/Util/XSelection.hs 55 - * Possibly add some more elaborate functionality: Emacs' registers are nice. -} + * Needs more elaborate functionality: Emacs' registers are nice; if you + don't know what they are, see -} hunk ./XMonad/Util/XSelection.hs 82 --- | Set the current X Selection to a given String. +-- | Set the current X Selection to a specified string. hunk ./XMonad/Util/XSelection.hs 119 -{- | A wrapper around getSelection. Makes it convenient to run a program with the current selection as an argument. +{- | A wrapper around 'getSelection'. Makes it convenient to run a program with the current selection as an argument. hunk ./XMonad/Util/XSelection.hs 124 -promptSelection passes strings through the shell; if you do not wish your selected text to be interpreted/mangled -by the shell, use safePromptSelection which will bypass the shell using safeSpawn from Run.hs; see Run.hs for more -details on the advantages/disadvantages of this. -} +'promptSelection' passes strings through the system shell, \/bin\/sh; if you do not wish your selected text +to be interpreted or mangled by the shell, use 'safePromptSelection'. safePromptSelection will bypass the +shell using 'safeSpawn' from "XMonad.Util.Run"; see its documentation for more +details on the advantages and disadvantages of using safeSpawn. -} hunk ./XMonad/Util/XSelection.hs 134 - String; does not deal with CChar, hence you will want the counter-intuitive 'map fromIntegral'. - UTF-8 decoding for internal use in getSelection. This code is copied from Eric Mertens's utf-string library - (version 0.1), which is BSD-3 licensed, as is this module. - It'd be better to just import Codec.Binary.UTF8.String (decode), but then users of this would need to install it; Xmonad has enough + String; does not deal with CChar, hence you will want the counter-intuitive @map fromIntegral@ + UTF-8 decoding for internal use in getSelection. + + This code is copied from Eric Mertens's "utf-string" library + (as of version 0.1),\which is BSD-3 licensed like this module. + It'd be better to just @import Codec.Binary.UTF8.String (decode)@, but then users of this would need to install it; XMonad has enough hunk ./XMonad/Util/XSelection.hs 165 - hunk ./XMonad/Util/XSelection.hs 168 - hunk ./XMonad/Util/Run.hs 88 --- | safeSpawn bypasses XMonad's 'spawn' command, because 'spawn' passes --- strings to \/bin\/sh to be interpreted as shell commands. This is --- often what one wants, but in many cases the passed string will contain --- shell metacharacters which one does not want interpreted as such (URLs --- particularly often have shell metacharacters like \'&\' in them). In --- this case, it is more useful to specify a file or program to be run --- and a string to give it as an argument so as to bypass the shell and --- be certain the program will receive the string as you typed it. --- 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' bypasses "XMonad.Core"'s 'spawn' command, because spawn passes +strings to \/bin\/sh to be interpreted as shell commands. This is +often what one wants, but in many cases the passed string will contain +shell metacharacters which one does not want interpreted as such (URLs +particularly often have shell metacharacters like \'&\' in them). In +this case, it is more useful to specify a file or program to be run +and a string to give it as an argument so as to bypass the shell and +be certain the program will receive the string as you typed it. +unsafeSpawn is internally 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 $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. -} hunk ./XMonad/Util/Run.hs 113 --- | Run a given program in the preferred terminal emulator. This uses --- 'safeSpawn'. -safeRunInTerm :: String -> String -> X () -safeRunInTerm options command = asks (terminal . config) >>= \t -> safeSpawn t (options ++ " -e " ++ command) - +-- | Open a terminal emulator. The terminal emulator is specified in @defaultConfig@ as xterm by default. It is then +-- asked to pass the shell a command with certain options. This is unsafe in the sense of 'unsafeSpawn' hunk ./XMonad/Util/Run.hs 119 --- | Launch an external application and return a 'Handle' to its standard input. +-- | Run a given program in the preferred terminal emulator; see 'runInTerm'. This makes use of 'safeSpawn'. +safeRunInTerm :: String -> String -> X () +safeRunInTerm options command = asks (terminal . config) >>= \t -> safeSpawn t (options ++ " -e " ++ command) + +-- | Launch an external application through the system shell and return a @Handle@ to its standard input. hunk ./XMonad/Actions/WindowGo.hs 9 -Defines a few simple operations for raising windows based on XMonad's Query -monad, such as 'runOrRaise'. -} +Defines a few convenient operations for raising (traveling to) windows based on XMonad's Query +monad, such as 'runOrRaise'. runOrRaise will run a shell command unless it can +find a specified window; you would use this to automatically travel to your +Firefox or Emacs session, or start a new one (for example), instead of trying to +remember where you left it or whether you still have one running. +-} hunk ./XMonad/Layout/MagicFocus.hs 19 - MagicFocus(MagicFocus) + magicFocus hunk ./XMonad/Layout/MagicFocus.hs 24 +import XMonad.Layout.LayoutModifier hunk ./XMonad/Layout/MagicFocus.hs 31 --- Then edit your @layoutHook@ by adding the MagicFocus layout +-- Then edit your @layoutHook@ by adding the magicFocus layout hunk ./XMonad/Layout/MagicFocus.hs 34 --- > myLayouts = MagicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > myLayouts = magicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. hunk ./XMonad/Layout/MagicFocus.hs 41 -data MagicFocus l a = MagicFocus (l a) deriving ( Show , Read ) +-- | Create a new layout which automagically puts the focused window +-- in the master area. +magicFocus :: l a -> ModifiedLayout MagicFocus l a +magicFocus = ModifiedLayout MagicFocus hunk ./XMonad/Layout/MagicFocus.hs 46 -instance (LayoutClass l Window) => LayoutClass (MagicFocus l) Window where - doLayout = magicFocus +data MagicFocus a = MagicFocus deriving (Show, Read) hunk ./XMonad/Layout/MagicFocus.hs 48 -magicFocus :: LayoutClass l Window => MagicFocus l Window -> Rectangle - -> Stack Window -> X ([(Window, Rectangle)], Maybe (MagicFocus l Window)) -magicFocus (MagicFocus l) r s = - withWindowSet $ \wset -> do - (ws,nl) <- runLayout (Workspace "" l (Just . swap s $ peek wset)) r - case nl of - Nothing -> return (ws, Nothing) - Just l' -> return (ws, Just $ MagicFocus l') +instance LayoutModifier MagicFocus Window where + modifyLayout MagicFocus (Workspace i l s) r = + withWindowSet $ \wset -> + runLayout (Workspace i l (s >>= \st -> Just $ swap st (peek wset))) r hunk ./XMonad/Layout/NoBorders.hs 79 - ws - | singleton screens = tiled ++ floating - | otherwise = [] + ws = tiled ++ floating hunk ./XMonad/Layout/NoBorders.hs 81 - [(w, _)] -> [w] + [(w, _)] | singleton screens -> [w] hunk ./XMonad/Layout/IM.hs 35 +import XMonad.Util.WindowProperties hunk ./XMonad/Layout/IM.hs 72 --- It's hard to reuse code from ManageHook because Query Bool is not in Show/Read. -data Property = Title String - | ClassName String - | Resource String - | And Property Property - | Or Property Property - | Not Property - | Const Bool - deriving (Read, Show) -infixr 9 `And` -infixr 8 `Or` - --- | Does given window have this property? -hasProperty :: Property -> Window -> X Bool -hasProperty (Title s) w = withDisplay $ \d -> fmap (Just s ==) $ io $ fetchName d w -hasProperty (Resource s) w = withDisplay $ \d -> fmap ((==) s . resName ) $ io $ getClassHint d w -hasProperty (ClassName s) w = withDisplay $ \d -> fmap ((==) s . resClass) $ io $ getClassHint d w -hasProperty (And p1 p2) w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 && r2 } -hasProperty (Or p1 p2) w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 || r2 } -hasProperty (Not p1) w = do { r1 <- hasProperty p1 w; return $ not r1 } -hasProperty (Const b) _ = return b - addfile ./XMonad/Util/WindowProperties.hs hunk ./XMonad/Util/WindowProperties.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.WindowProperties +-- Copyright : (c) Roman Cheplyaka +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Roman Cheplyaka +-- Stability : unstable +-- Portability : unportable +-- +-- EDSL for specifying window properties, such as title, classname or resource. +-- +----------------------------------------------------------------------------- +module XMonad.Util.WindowProperties ( + -- * Usage + -- $usage + Property(..), hasProperty) +where +import XMonad + +-- $usage +-- This module allows to specify window properties, such as title, classname or +-- resource, and to check them. +-- +-- In contrast to ManageHook properties, these are instances of Show and Read, +-- so they can be used in layout definitions etc. For example usage see "XMonad.Layout.IM" + +-- | Property constructors are quite self-explaining. +data Property = Title String + | ClassName String + | Resource String + | And Property Property + | Or Property Property + | Not Property + | Const Bool + deriving (Read, Show) +infixr 9 `And` +infixr 8 `Or` + +-- | Does given window have this property? +hasProperty :: Property -> Window -> X Bool +hasProperty (Title s) w = withDisplay $ \d -> fmap (Just s ==) $ io $ fetchName d w +hasProperty (Resource s) w = withDisplay $ \d -> fmap ((==) s . resName ) $ io $ getClassHint d w +hasProperty (ClassName s) w = withDisplay $ \d -> fmap ((==) s . resClass) $ io $ getClassHint d w +hasProperty (And p1 p2) w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 && r2 } +hasProperty (Or p1 p2) w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 || r2 } +hasProperty (Not p1) w = do { r1 <- hasProperty p1 w; return $ not r1 } +hasProperty (Const b) _ = return b + hunk ./xmonad-contrib.cabal 180 + XMonad.Util.WindowProperties hunk ./XMonad/Util/WindowProperties.hs 3 --- Module : XMonad.Layout.WindowProperties +-- Module : XMonad.Util.WindowProperties hunk ./XMonad/Layout/SimpleFloat.hs 53 - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a hunk ./XMonad/Layout/SimpleFloat.hs 60 - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a addfile ./XMonad/Hooks/EventHook.hs hunk ./XMonad/Hooks/EventHook.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.EventHook +-- Copyright : (c) 2007 Andrea Rossato +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A layout modifier that implements an event hook at the layout level. +-- +-- Since it operates at the 'Workspace' level, it will install itself +-- on the first current 'Workspace' and will broadcast a 'Message' to +-- all other 'Workspace's not to handle events. +----------------------------------------------------------------------------- + +module XMonad.Hooks.EventHook + ( -- * Usage: + -- $usage + + -- * Writing a hook + -- $hook + EventHook (..) + , eventHook + ) where + +import Control.Applicative ((<$>)) +import Data.Maybe + +import XMonad +import XMonad.StackSet (StackSet (..), Screen (..), Workspace (..)) + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.EventHook +-- +-- Then edit your @layoutHook@ by adding the 'eventHook': +-- +-- > layoutHook = eventHook EventHookExample $ avoidStruts $ simpleTabbed ||| Full ||| etc.. +-- +-- and then: +-- +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +-- $hook +-- Writing a hook is very simple. +-- +-- This is a basic example to log all events: +-- +-- > data EventHookExample = EventHookExample deriving ( Show, Read ) +-- > instance EventHook EventHookExample where +-- > handleEvent _ e = io $ hPutStrLn stderr . show $ e --return () +-- +-- This is an 'EventHook' to log mouse button events: +-- +-- > data EventHookButton = EventHookButton deriving ( Show, Read ) +-- > instance EventHook EventHookButton where +-- > handleEvent _ (ButtonEvent {ev_window = w}) = do +-- > io $ hPutStrLn stderr $ "This is a button event on window " ++ (show w) +-- > handleEvent _ _ = return () +-- +-- Obviously you can compose event hooks: +-- +-- > layoutHook = eventHook EventHookButton $ eventHook EventHookExample $ avoidStruts $ simpleTabbed ||| Full ||| etc.. + +eventHook :: EventHook eh => eh -> l a -> (HandleEvent eh l) a +eventHook = HandleEvent Nothing True + +class (Read eh, Show eh) => EventHook eh where + handleEvent :: eh -> Event -> X () + handleEvent _ _ = return () + +data HandleEvent eh l a = HandleEvent (Maybe WorkspaceId) Bool eh (l a) deriving ( Show, Read ) + +data EventHandleMsg = ReceiverOff deriving ( Typeable ) +instance Message EventHandleMsg + +instance (EventHook eh, LayoutClass l a) => LayoutClass (HandleEvent eh l) a where + runLayout (Workspace i (HandleEvent Nothing _ eh l) ms) r = do + broadcastMessage ReceiverOff + iws <- (tag . workspace . current) <$> gets windowset + (wrs, ml) <- runLayout (Workspace i l ms) r + return (wrs, Just $ HandleEvent (Just iws) True eh (fromMaybe l ml)) + + runLayout (Workspace i (HandleEvent j b eh l) ms) r = do + (wrs, ml) <- runLayout (Workspace i l ms) r + return (wrs, Just $ HandleEvent j b eh (fromMaybe l ml)) + + handleMessage (HandleEvent mi True eh l) m + | Just ReceiverOff <- fromMessage m = return . Just $ HandleEvent mi False eh l + | Just e <- fromMessage m = handleEvent eh e >> + handleMessage l (SomeMessage e) >>= + maybe (return Nothing) (\l' -> return . Just $ HandleEvent mi True eh l') + handleMessage (HandleEvent mi b eh l) m = handleMessage l m >>= + maybe (return Nothing) (\l' -> return . Just $ HandleEvent mi b eh l') + + description (HandleEvent _ _ _ l) = description l hunk ./xmonad-contrib.cabal 104 + XMonad.Hooks.EventHook addfile ./XMonad/Hooks/ServerMode.hs hunk ./XMonad/Hooks/ServerMode.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.ServerMode +-- Copyright : (c) Andrea Rossato and David Roundy 2007 +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- This is an 'EventHook' that will receive commands from an external +-- client. +-- +-- This is the example of a client: +-- +-- > import Graphics.X11.Xlib +-- > import Graphics.X11.Xlib.Extras +-- > import System.Environment +-- > import Data.Char +-- > +-- > usage :: String -> String +-- > usage n = "Usage: " ++ n ++ " command number\nSend a command number to a running instance of XMonad" +-- > +-- > main :: IO () +-- > main = do +-- > args <- getArgs +-- > pn <- getProgName +-- > let com = case args of +-- > [] -> error $ usage pn +-- > w -> (w !! 0) +-- > sendCommand com +-- > +-- > sendCommand :: String -> IO () +-- > sendCommand s = do +-- > d <- openDisplay "" +-- > rw <- rootWindow d $ defaultScreen d +-- > a <- internAtom d "XMONAD_COMMAND" False +-- > allocaXEvent $ \e -> do +-- > setEventType e clientMessage +-- > setClientMessageEvent e rw a 32 (fromIntegral (read s)) currentTime +-- > sendEvent d rw False structureNotifyMask e +-- > sync d False +-- +-- compile with: @ghc --make sendCommand.hs@ +-- +-- run with +-- +-- > sendCommand command number +-- +-- For instance: +-- +-- > sendCommand 0 +-- +-- will ask to xmonad to print the list of command numbers in +-- stderr (so you can read it in @~\/.xsession-errors@). +----------------------------------------------------------------------------- + +module XMonad.Hooks.ServerMode + ( -- * Usage + -- $usage + ServerMode (..) + , eventHook + ) where + +import Control.Monad (when) +import Data.List +import System.IO + +import XMonad +import XMonad.Actions.Commands +import XMonad.Hooks.EventHook + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.ServerMode +-- +-- Then edit your @layoutHook@ by adding the 'eventHook': +-- +-- > layoutHook = eventHook ServerMode $ avoidStruts $ simpleTabbed ||| Full ||| etc.. +-- +-- and then: +-- +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +data ServerMode = ServerMode deriving ( Show, Read ) + +instance EventHook ServerMode where + handleEvent _ (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do + d <- asks display + a <- io $ internAtom d "XMONAD_COMMAND" False + when (mt == a && dt /= []) $ do + cl <- defaultCommands + let listOfCommands = map (uncurry (++)) . zip (map show ([1..] :: [Int])) . map ((++) " - " . fst) + case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of + Just (c,_) -> runCommand' c + Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl + handleEvent _ _ = return () hunk ./xmonad-contrib.cabal 109 + XMonad.Hooks.ServerMode hunk ./XMonad/Hooks/EventHook.hs 22 - ( -- * Usage: + ( -- * Usage hunk ./XMonad/Hooks/EventHook.hs 85 -data EventHandleMsg = ReceiverOff deriving ( Typeable ) +data EventHandleMsg = HandlerOff deriving ( Typeable ) hunk ./XMonad/Hooks/EventHook.hs 89 - runLayout (Workspace i (HandleEvent Nothing _ eh l) ms) r = do - broadcastMessage ReceiverOff - iws <- (tag . workspace . current) <$> gets windowset + runLayout (Workspace i (HandleEvent Nothing True eh l) ms) r = do + broadcastMessage HandlerOff + iws <- (tag . workspace . current) <$> gets windowset hunk ./XMonad/Hooks/EventHook.hs 95 - runLayout (Workspace i (HandleEvent j b eh l) ms) r = do + runLayout (Workspace i (HandleEvent mi b eh l) ms) r = do hunk ./XMonad/Hooks/EventHook.hs 97 - return (wrs, Just $ HandleEvent j b eh (fromMaybe l ml)) + return (wrs, Just $ HandleEvent mi b eh (fromMaybe l ml)) hunk ./XMonad/Hooks/EventHook.hs 99 - handleMessage (HandleEvent mi True eh l) m - | Just ReceiverOff <- fromMessage m = return . Just $ HandleEvent mi False eh l - | Just e <- fromMessage m = handleEvent eh e >> - handleMessage l (SomeMessage e) >>= - maybe (return Nothing) (\l' -> return . Just $ HandleEvent mi True eh l') - handleMessage (HandleEvent mi b eh l) m = handleMessage l m >>= - maybe (return Nothing) (\l' -> return . Just $ HandleEvent mi b eh l') + handleMessage (HandleEvent i True eh l) m + | Just HandlerOff <- fromMessage m = return . Just $ HandleEvent i False eh l + | Just e <- fromMessage m = handleMessage l (SomeMessage e) >>= \ml -> + handleEvent eh e >> + maybe (return Nothing) (\l' -> return . Just $ HandleEvent i True eh l') ml + handleMessage (HandleEvent i b eh l) m = handleMessage l m >>= + maybe (return Nothing) (\l' -> return . Just $ HandleEvent i b eh l') hunk ./XMonad/Config/Arossato.hs 31 +import XMonad.Hooks.ServerMode hunk ./XMonad/Config/Arossato.hs 94 - , layoutHook = avoidStruts $ + , layoutHook = eventHook ServerMode $ + avoidStruts $ hunk ./XMonad/Hooks/EventHook.hs 29 + , HandleEvent hunk ./XMonad/Hooks/EwmhDesktops.hs 4 --- Copyright : (c) Joachim Breitner +-- Copyright : (c) 2007, 2008 Joachim Breitner hunk ./XMonad/Hooks/EwmhDesktops.hs 12 --- workspaces and the windows therein. +-- workspaces and the windows therein. It also allows the user to interact +-- with xmonad by clicking on panels and window lists. hunk ./XMonad/Hooks/EwmhDesktops.hs 18 - ewmhDesktopsLogHook + ewmhDesktopsLogHook, + ewmhDesktopsLayout hunk ./XMonad/Hooks/EwmhDesktops.hs 31 +import XMonad.Hooks.EventHook hunk ./XMonad/Hooks/EwmhDesktops.hs 43 --- > main = xmonad defaultConfig { logHook = myLogHook } +-- > layoutHook = ewmhDesktopsLayout $ avoidStruts $ simpleTabbed ||| Full ||| etc.. +-- > +-- > main = xmonad defaultConfig { layoutHook = myLayouts, logHook = myLogHook } hunk ./XMonad/Hooks/EwmhDesktops.hs 50 +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Hooks/EwmhDesktops.hs 95 +-- | +-- Intercepts messages from pagers and similar applications and reacts on them. +-- Currently supports: +-- +-- * _NET_CURRENT_DESKTOP (switching desktops) +-- +-- * _NET_WM_DESKTOP (move windows to other desktops) +-- +-- * _NET_ACTIVE_WINDOW (activate another window) +-- +ewmhDesktopsLayout :: layout a -> HandleEvent EwmhDesktopsHook layout a +ewmhDesktopsLayout = eventHook EwmhDesktopsHook + +data EwmhDesktopsHook = EwmhDesktopsHook deriving ( Show, Read ) +instance EventHook EwmhDesktopsHook where + handleEvent _ e@ClientMessageEvent {} = do handle e + handleEvent _ _ = return () + +handle :: Event -> X () +handle ClientMessageEvent { + ev_window = w, + ev_message_type = mt, + ev_data = d + } = withWindowSet $ \s -> do + sort' <- getSortByIndex + let ws = sort' $ W.workspaces s + + a_cd <- getAtom "_NET_CURRENT_DESKTOP" + a_d <- getAtom "_NET_WM_DESKTOP" + a_aw <- getAtom "_NET_ACTIVE_WINDOW" + if mt == a_cd then do + let n = fromIntegral (head d) + if 0 <= n && n < length ws then + windows $ W.view (W.tag (ws !! n)) + else trace $ "Bad _NET_CURRENT_DESKTOP with data[0]="++show n + else if mt == a_d then do + let n = fromIntegral (head d) + if 0 <= n && n < length ws then + windows $ W.shiftWin (W.tag (ws !! n)) w + else trace $ "Bad _NET_DESKTOP with data[0]="++show n + else if mt == a_aw then do + windows $ W.focusWindow w + else trace $ "Unknown ClientMessageEvent " ++ show mt +handle _ = undefined -- does not happen, as otherwise ewmhDesktopsHook would not match + hunk ./XMonad/Layout/Mosaic.hs 16 +-- +-- Marked as broken, Mar 2008 (memory leaks) hunk ./xmonad-contrib.cabal 130 - XMonad.Layout.Mosaic + -- XMonad.Layout.Mosaic hunk ./XMonad/Layout/Magnifier.hs 48 --- > magnifiercz (12%10) +-- > magnifiercz 1.2 hunk ./XMonad/Layout/Magnifier.hs 51 --- 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. +-- window smaller for a pop in effect. hunk ./XMonad/Layout/Magnifier.hs 142 + hunk ./XMonad/Layout/Magnifier.hs 25 + magnifierOff, hunk ./XMonad/Layout/Magnifier.hs 82 +-- | Magnifier that defaults to Off +magnifierOff :: l a -> ModifiedLayout Magnifier l a +magnifierOff = ModifiedLayout (Mag 1.5 Off All) + hunk ./XMonad/Layout/Magnifier.hs 91 -data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff deriving ( Typeable ) +data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle deriving ( Typeable ) hunk ./XMonad/Layout/Magnifier.hs 111 + | Just Toggle <- fromMessage m = return . Just $ (Mag (z ) Off t) hunk ./XMonad/Layout/Magnifier.hs 114 + | Just Toggle <- fromMessage m = return . Just $ (Mag z On t) hunk ./XMonad/Layout/NoBorders.hs 61 +-- | Removes all window borders from the specified layout. hunk ./XMonad/Layout/NoBorders.hs 63 -noBorders = ModifiedLayout $ WithBorder 0 [] +noBorders = withBorder 0 hunk ./XMonad/Layout/NoBorders.hs 65 +-- | Forces a layout to use the specified border width. 'noBorders' is +-- equivalent to @'withBorder' 0@. hunk ./XMonad/Layout/NoBorders.hs 100 +-- | Removes the borders from a window under one of the following conditions: hunk ./XMonad/Layout/NoBorders.hs 102 --- | You can cleverly set no borders on a range of layouts, using a --- layoutHook like so: +-- * There is only one screen and only one window. In this case it's obvious +-- that it has the focus, so no border is needed. hunk ./XMonad/Layout/NoBorders.hs 105 --- > layoutHook = smartBorders $ tiled ||| Mirror tiled ||| ... +-- * A floating window covers the entire screen (e.g. mplayer). hunk ./XMonad/Hooks/ManageHelpers.hs 143 -doCenterFloat = ask >>= \w -> doF . W.float w . center =<< liftX (floatLocation w) +doCenterFloat = ask >>= \w -> doF . W.float w . center . snd =<< liftX (floatLocation w) hunk ./XMonad/Layout/ResizableTile.hs 24 -import XMonad hiding (splitVertically, splitHorizontallyBy) +import XMonad hiding (tile, splitVertically, splitHorizontallyBy) hunk ./XMonad/Layout/WorkspaceDir.hs 33 +import Control.Monad ( when ) hunk ./XMonad/Layout/WorkspaceDir.hs 35 -import XMonad +import XMonad hiding ( focus ) hunk ./XMonad/Layout/WorkspaceDir.hs 40 +import XMonad.StackSet ( Stack, peek, focus ) hunk ./XMonad/Layout/WorkspaceDir.hs 71 -instance LayoutModifier WorkspaceDir a where - hook (WorkspaceDir s) = scd s +instance LayoutModifier WorkspaceDir Window where + redoLayout (WorkspaceDir d) _ s wrs = do w <- gets windowset + when (Just (focus s) == peek w) $ scd d + return (wrs, Nothing) hunk ./XMonad/Config/Droundy.hs 26 -import XMonad.Layout.Mosaic hunk ./XMonad/Config/Droundy.hs 118 --- keybindings for Mosaic: - , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow)) - , ((controlMask .|. modMask x .|. shiftMask, xK_l), withFocused (sendMessage . wideWindow)) - , ((modMask x .|. shiftMask, xK_h ), withFocused (sendMessage . shrinkWindow)) - , ((modMask x .|. shiftMask, xK_l ), withFocused (sendMessage . expandWindow)) - , ((modMask x .|. shiftMask, xK_s ), withFocused (sendMessage . squareWindow)) - , ((modMask x .|. shiftMask, xK_o ), withFocused (sendMessage . myclearWindow)) - , ((controlMask .|. modMask x .|. shiftMask, xK_o ), withFocused (sendMessage . flexibleWindow)) - hunk ./XMonad/Layout/Mosaic.hs 1 -{-# OPTIONS -fglasgow-exts #-} - ------------------------------------------------------------------------------ --- | --- Module : XMonadContrib.Mosaic --- Copyright : (c) David Roundy --- License : BSD3-style (see LICENSE) --- --- Maintainer : David Roundy --- Stability : unstable --- Portability : unportable --- --- This module defines a \"mosaic\" layout, which tries to give each window a --- user-configurable relative area, while also trying to give them aspect --- ratios configurable at run-time by the user. --- --- Marked as broken, Mar 2008 (memory leaks) --- ------------------------------------------------------------------------------ -module XMonad.Layout.Mosaic ( - -- * Usage - -- $usage - mosaic, expandWindow, shrinkWindow, squareWindow, myclearWindow, - tallWindow, wideWindow, flexibleWindow, - getName ) where - -import Control.Monad.State ( State, put, get, runState ) -import System.Random ( StdGen, mkStdGen ) -import Data.Maybe ( isJust ) - -import XMonad hiding ( trace ) -import qualified XMonad.StackSet as W -import qualified Data.Map as M -import Data.List ( sort ) -import Data.Typeable ( Typeable ) -import Control.Monad ( mplus ) - -import XMonad.Util.NamedWindows -import XMonad.Util.Anneal - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Layout.Mosaic --- --- Then edit your @layoutHook@ by adding the Mosaic layout: --- --- > myLayouts = mosaic 0.25 0.5 ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } --- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" --- --- In the key-bindings, do something like: --- --- > , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow)) --- > , ((controlMask .|. modMask x .|. shiftMask, xK_l), withFocused (sendMessage . wideWindow)) --- > , ((modMask x .|. shiftMask, xK_h ), withFocused (sendMessage . shrinkWindow)) --- > , ((modMask x .|. shiftMask, xK_l ), withFocused (sendMessage . expandWindow)) --- > , ((modMask x .|. shiftMask, xK_s ), withFocused (sendMessage . squareWindow)) --- > , ((modMask x .|. shiftMask, xK_o ), withFocused (sendMessage . myclearWindow)) --- > , ((controlMask .|. modMask x .|. shiftMask, xK_o ), withFocused (sendMessage . flexibleWindow)) --- --- For detailed instruction on editing the key binding see: --- --- "XMonad.Doc.Extending#Editing_key_bindings". - -data HandleWindow = ExpandWindow Window | ShrinkWindow Window - | SquareWindow Window | ClearWindow Window - | TallWindow Window | WideWindow Window - | FlexibleWindow Window - deriving ( Typeable, Eq ) - -instance Message HandleWindow - -expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: Window -> HandleWindow -expandWindow = ExpandWindow -shrinkWindow = ShrinkWindow -squareWindow = SquareWindow -flexibleWindow = FlexibleWindow -myclearWindow = ClearWindow -tallWindow = TallWindow -wideWindow = WideWindow - -largeNumber :: Int -largeNumber = 50 - -defaultArea :: Double -defaultArea = 1 - -flexibility :: Double -flexibility = 0.1 - -mosaic :: Double -> Double -> MosaicLayout Window -mosaic d t = Mosaic d t M.empty - -data MosaicLayout a = Mosaic Double Double (M.Map Window [WindowHint]) - deriving ( Show, Read ) - -instance LayoutClass MosaicLayout Window where - doLayout (Mosaic _ t h) r st = do all_hints <- add_hints (W.integrate st) h - mosaicL t all_hints r (W.integrate st) - where add_hints [] x = return x - add_hints (w:ws) x = - do z <- withDisplay $ \d -> io $ getWMNormalHints d w - let set_asp = case map4 `fmap` sh_aspect z of - Just ((minx,miny),(maxx,maxy)) - | or [minx < 1, miny < 1, maxx < 1, maxy < 1] -> id - | minx/miny == maxx/maxy -> set_aspect_ratio (minx/miny) w - _ -> id - add_hints ws $ set_MinX z w $ set_MinY z w $ set_MaxX z w $ set_MaxY z w $ set_asp x - map4 :: Integral a => ((a,a),(a,a)) -> ((Double,Double),(Double,Double)) - map4 ((a,b),(c,d)) = ((fromIntegral a,fromIntegral b),(fromIntegral c,fromIntegral d)) - - pureMessage (Mosaic d t h) m = (m1 `fmap` fromMessage m) `mplus` (m2 `fmap` fromMessage m) - where - m1 Shrink = Mosaic d (t/(1+d)) h - m1 Expand = Mosaic d (t*(1+d)) h - m2 (ExpandWindow w) = Mosaic d t (multiply_area (1+d) w h) - m2 (ShrinkWindow w) = Mosaic d t (multiply_area (1/(1+ d)) w h) - m2 (SquareWindow w) = Mosaic d t (set_aspect_ratio 1 w h) - m2 (FlexibleWindow w) = Mosaic d t (make_flexible w h) - m2 (TallWindow w) = Mosaic d t (multiply_aspect (1/(1+d)) w h) - m2 (WideWindow w) = Mosaic d t (multiply_aspect (1+d) w h) - m2 (ClearWindow w) = Mosaic d t (M.delete w h) - - description _ = "mosaic" - -multiply_area :: Double -> Window - -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] -multiply_area a = alterlist f where f [] = [RelArea (defaultArea*a)] - f (RelArea a':xs) = RelArea (a'*a) : xs - f (x:xs) = x : f xs - -set_aspect_ratio :: Double -> Window - -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] -set_aspect_ratio r = alterlist f where f [] = [AspectRatio r] - f (FlexibleAspectRatio _:x) = AspectRatio r:x - f (AspectRatio _:x) = AspectRatio r:x - f (x:xs) = x:f xs - -make_flexible :: Window - -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] -make_flexible = alterlist (map f) where f (AspectRatio r) = FlexibleAspectRatio r - f (FlexibleAspectRatio r) = AspectRatio r - f x = x - -multiply_aspect :: Double -> Window - -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] -multiply_aspect r = alterlist f where f [] = [FlexibleAspectRatio r] - f (AspectRatio r':x) = AspectRatio (r*r'):x - f (FlexibleAspectRatio r':x) = FlexibleAspectRatio (r*r'):x - f (x:xs) = x:f xs - -set_MaxX :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] -set_MaxX h | Just (_,mx) <- sh_max_size h = replaceinmap (isJust . isMaxX) (MaxX $ fromIntegral mx) - | otherwise = const id - -set_MaxY :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] -set_MaxY h | Just (_,mx) <- sh_max_size h = replaceinmap (isJust . isMaxY) (MaxY $ fromIntegral mx) - | otherwise = const id - -isMaxX,isMaxY :: WindowHint -> Maybe Dimension -isMaxX (MaxX x) = Just x -isMaxX _ = Nothing -isMaxY (MaxY x) = Just x -isMaxY _ = Nothing - -set_MinX :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] -set_MinX h | Just (mx,_) <- sh_min_size h = replaceinmap isMinX (MinX $ fromIntegral mx) - | otherwise = const id - where isMinX (MinX _) = True - isMinX _ = False - -set_MinY :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] -set_MinY h | Just (_,mx) <- sh_min_size h = replaceinmap isMinY (MinY $ fromIntegral mx) - | otherwise = const id - where isMinY (MinY _) = True - isMinY _ = False - -replaceinmap :: Ord a => (a -> Bool) -> a -> Window -> M.Map Window [a] -> M.Map Window [a] -replaceinmap repl v = alterlist f where f [] = [v] - f (x:xs) | repl x = v:xs - | otherwise = x:f xs - -findlist :: Window -> M.Map Window [a] -> [a] -findlist = M.findWithDefault [] - -alterlist :: (Ord a) => ([a] -> [a]) -> Window -> M.Map Window [a] -> M.Map Window [a] -alterlist f k = M.alter f' k - where f' Nothing = f' (Just []) - f' (Just xs) = case f xs of - [] -> Nothing - xs' -> Just xs' - -mosaicL :: Double -> M.Map Window [WindowHint] - -> Rectangle -> [Window] -> X ([(Window, Rectangle)],Maybe (MosaicLayout Window)) -mosaicL _ _ _ [] = return ([], Nothing) -mosaicL f hints origRect origws - = do let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) origws - -- TODO: remove all this dead code - myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws - myv2 = mc_mosaic sortedws Vertical - myh2 = mc_mosaic sortedws Horizontal --- myv2 = maxL $ runCountDown largeNumber $ --- sequence $ replicate mediumNumber $ --- mosaic_splits one_split origRect Vertical sortedws - myh = runCountDown largeNumber $ mosaic_splits even_split origRect Horizontal sortedws --- myh2 = maxL $ runCountDown largeNumber $ --- sequence $ replicate mediumNumber $ --- mosaic_splits one_split origRect Horizontal sortedws - return (map (\(w,r)->(--trace ("rate1:"++ unlines [show nw, - -- show $ rate f meanarea (findlist nw hints) r, - -- show r, - -- show $ area r/meanarea, - -- show $ findlist nw hints]) $ - w,crop' (findlist w hints) r)) $ - flattenMosaic $ the_value $ maxL [myh,myv,myh2,myv2], Nothing) - where mosaic_splits _ _ _ [] = return $ Rated 0 $ M [] - mosaic_splits _ r _ [w] = return $ Rated (rate f meanarea (findlist w hints) r) $ OM (w,r) - mosaic_splits spl r d ws = maxL `fmap` mapCD (spl r d) (init $ allsplits ws) - even_split :: Rectangle -> CutDirection -> [[Window]] - -> State CountDown (Rated Double (Mosaic (Window, Rectangle))) - even_split r d [ws] = even_split r d $ map (:[]) ws - even_split r d wss = - do let areas = map sumareas wss - maxds = map (maxd d) wss - let wsr_s :: [([Window], Rectangle)] - wsr_s = zip wss (partitionR d r maxds areas) - submosaics <- mapM (\(ws',r') -> - mosaic_splits even_split r' (otherDirection d) ws') wsr_s - return $ fmap M $ catRated submosaics - {- - another_mosaic :: [Window] -> CutDirection - -> Rated Double (Mosaic (Window,Rectangle)) - another_mosaic ws d = rate_mosaic ratew $ - rect_mosaic origRect d $ - zipML (example_mosaic ws) (map findarea ws) - -} - mc_mosaic :: [Window] -> CutDirection - -> Rated Double (Mosaic (Window,Rectangle)) - mc_mosaic ws d = fmap (rect_mosaic origRect d) $ - annealMax (zipML (example_mosaic ws) (map findarea ws)) - (the_rating . rate_mosaic ratew . rect_mosaic origRect d ) - changeMosaic - - ratew :: (Window,Rectangle) -> Double - ratew (w,r) = rate f meanarea (findlist w hints) r - example_mosaic :: [Window] -> Mosaic Window - example_mosaic ws = M (map OM ws) - rect_mosaic :: Rectangle -> CutDirection -> Mosaic (a,Double) -> Mosaic (a,Rectangle) - rect_mosaic r _ (OM (w,_)) = OM (w,r) - rect_mosaic r d (M ws) = M $ zipWith (\w' r' -> rect_mosaic r' d' w') ws rs - where areas = map (sum . map snd . flattenMosaic) ws - maxds = repeat 1 - rs = partitionR d r maxds areas - d' = otherDirection d - rate_mosaic :: ((Window,Rectangle) -> Double) - -> Mosaic (Window,Rectangle) -> Rated Double (Mosaic (Window,Rectangle)) - rate_mosaic r m = catRatedM $ fmap (\x -> Rated (r x) x) m -{- - one_split :: Rectangle -> CutDirection -> [[Window]] - -> State CountDown (Rated Double (Mosaic (Window, Rectangle))) - one_split r d [ws] = one_split r d $ map (:[]) ws - one_split r d wss = - do rnd <- mapM (const (fractional resolutionNumber)) [1..length wss] - let wsr_s :: [([Window], Rectangle)] - wsr_s = zip wss (partitionR d r rnd) - submosaics <- mapM (\(ws',r') -> - mosaic_splits even_split r' (otherDirection d) ws') wsr_s - return $ fmap M $ catRated submosaics --} - partitionR :: CutDirection -> Rectangle -> [Dimension] -> [Double] -> [Rectangle] - partitionR _ _ _ [] = [] - partitionR _ _ [] _ = [] - partitionR _ r _ [_] = [r] - partitionR d r (m:ms) (a:ars) = r1 : partitionR d r2 ms ars - where totarea = sum (a:ars) - totd = fromIntegral $ dimR d r - (r1,r2) = if a/totarea > fromIntegral m / totd - then if a/totarea > 1 - fromIntegral (sum ms) / totd - then split d (1 - fromIntegral (sum ms) / totd) r - else split d (a/totarea) r - else split d (fromIntegral m / totd) r - theareas = hints2area `fmap` hints - sumareas ws = sum $ map findarea ws - maxd Vertical ws = maximum $ map (findhinted isMaxY 3) ws - maxd Horizontal ws = maximum $ map (findhinted isMaxX 3) ws - findarea :: Window -> Double - findarea w = M.findWithDefault 1 w theareas - findhinted fh d w = fh' $ M.findWithDefault [] w hints - where fh' [] = d - fh' (h:hs) | Just x <- fh h = x - | otherwise = fh' hs - meanarea = area origRect / fromIntegral (length origws) - -dimR :: CutDirection -> Rectangle -> Dimension -dimR Vertical (Rectangle _ _ _ h) = h -dimR Horizontal (Rectangle _ _ w _) = w - -maxL :: Ord a => [a] -> a -maxL [] = error "maxL on empty list" -maxL [a] = a -maxL (a:b:c) = maxL (max a b:c) - -catRated :: Floating v => [Rated v a] -> Rated v [a] -catRated xs = Rated (product $ map the_rating xs) (map the_value xs) - -catRatedM :: Floating v => Mosaic (Rated v a) -> Rated v (Mosaic a) -catRatedM (OM (Rated v x)) = Rated v (OM x) -catRatedM (M xs) = case catRated $ map catRatedM xs of Rated v xs' -> Rated v (M xs') - -data CountDown = CD !StdGen !Int - -tries_left :: State CountDown Int -tries_left = do CD _ n <- get - return (max 0 n) - -mapCD :: (a -> State CountDown b) -> [a] -> State CountDown [b] -mapCD f xs = do n <- tries_left - let len = length xs - mapM (run_with_only ((n `div` len)+1) . f) $ take (n+1) xs - -run_with_only :: Int -> State CountDown a -> State CountDown a -run_with_only limit j = - do CD g n <- get - let leftover = n - limit - if leftover < 0 then j - else do put $ CD g limit - x <- j - CD g' n' <- get - put $ CD g' (leftover + n') - return x - -data WindowHint = RelArea Double - | MaxX Dimension - | MaxY Dimension - | MinX Dimension - | MinY Dimension - | AspectRatio Double - | FlexibleAspectRatio Double - deriving ( Show, Read, Eq, Ord ) - -fixedAspect :: [WindowHint] -> Bool -fixedAspect [] = False -fixedAspect (AspectRatio _:_) = True -fixedAspect (_:x) = fixedAspect x - -rate :: Double -> Double -> [WindowHint] -> Rectangle -> Double -rate defaulta meanarea xs rr - | fixedAspect xs = (area (crop xs rr) / meanarea) ** weight - | otherwise = (area rr / meanarea)**(weight-flexibility) - * (area (crop (xs++[FlexibleAspectRatio defaulta]) rr) / meanarea)**flexibility - where weight = hints2area xs - -crop1 :: WindowHint -> Rectangle -> Rectangle -crop1 (FlexibleAspectRatio f) r = cropit f r -crop1 h r = crop1' h r - -crop1' :: WindowHint -> Rectangle -> Rectangle -crop1' (AspectRatio f) r = cropit f r -crop1' (FlexibleAspectRatio f) r = cropit f r -crop1' (MaxX xm) (Rectangle x y w h) | w > xm = Rectangle x y xm h - | otherwise = Rectangle x y w h -crop1' (MaxY xm) (Rectangle x y w h) | h > xm = Rectangle x y w xm - | otherwise = Rectangle x y w h -crop1' _ r = r - -crop :: [WindowHint] -> Rectangle -> Rectangle -crop (h:hs) = crop hs . crop1 h -crop [] = id - -crop' :: [WindowHint] -> Rectangle -> Rectangle -crop' (h:hs) = crop' hs . crop1' h -crop' [] = id - -cropit :: Double -> Rectangle -> Rectangle -cropit f (Rectangle a b w h) | w -/- h > f = Rectangle a b (ceiling $ h -* f) h - | otherwise = Rectangle a b w (ceiling $ w -/ f) - -hints2area :: [WindowHint] -> Double -hints2area [] = defaultArea -hints2area (RelArea r:_) = r -hints2area (_:x) = hints2area x - -area :: Rectangle -> Double -area (Rectangle _ _ w h) = fromIntegral w * fromIntegral h - -(-/-) :: (Integral a, Integral b) => a -> b -> Double -a -/- b = fromIntegral a / fromIntegral b - -(-/) :: (Integral a) => a -> Double -> Double -a -/ b = fromIntegral a / b - -(-*) :: (Integral a) => a -> Double -> Double -a -* b = fromIntegral a * b - -split :: CutDirection -> Double -> Rectangle -> (Rectangle, Rectangle) -split d frac r | frac <= 0 || frac >= 1 = split d 0.5 r -split Vertical frac (Rectangle sx sy sw sh) = (Rectangle sx sy sw h, - Rectangle sx (sy+fromIntegral h) sw (sh-h)) - where h = floor $ fromIntegral sh * frac -split Horizontal frac (Rectangle sx sy sw sh) = (Rectangle sx sy w sh, - Rectangle (sx+fromIntegral w) sy (sw-w) sh) - where w = floor $ fromIntegral sw * frac - -data CutDirection = Vertical | Horizontal -otherDirection :: CutDirection -> CutDirection -otherDirection Vertical = Horizontal -otherDirection Horizontal = Vertical - -data Mosaic a = M [Mosaic a] | OM a - deriving ( Show ) - -instance Functor Mosaic where - fmap f (OM x) = OM (f x) - fmap f (M xs) = M (map (fmap f) xs) - -zipMLwith :: (a -> b -> c) -> Mosaic a -> [b] -> Mosaic c -zipMLwith f (OM x) (y:_) = OM (f x y) -zipMLwith _ (OM _) [] = error "bad zipMLwith" -zipMLwith f (M xxs) yys = makeM $ foo xxs yys - where foo (x:xs) ys = zipMLwith f x (take (lengthM x) ys) : - foo xs (drop (lengthM x) ys) - foo [] _ = [] - -zipML :: Mosaic a -> [b] -> Mosaic (a,b) -zipML = zipMLwith (\a b -> (a,b)) - -lengthM :: Mosaic a -> Int -lengthM (OM _) = 1 -lengthM (M x) = sum $ map lengthM x - -changeMosaic :: Mosaic a -> [Mosaic a] -changeMosaic (OM _) = [] -changeMosaic (M xs) = map makeM (concatenations xs) ++ - map makeM (splits xs) ++ - map M (tryAll changeMosaic xs) - -tryAll :: (a -> [a]) -> [a] -> [[a]] -tryAll _ [] = [] -tryAll f (x:xs) = map (:xs) (f x) ++ map (x:) (tryAll f xs) - -splits :: [Mosaic a] -> [[Mosaic a]] -splits [] = [] -splits (OM x:y) = map (OM x:) $ splits y -splits (M (x:y):z) = (x:makeM y:z) : map (makeM (x:y) :) (splits z) -splits (M []:x) = splits x - -concatenations :: [Mosaic a] -> [[Mosaic a]] -concatenations (x:y:z) = (concatenateMosaic x y:z):(map (x:) $ concatenations (y:z)) -concatenations _ = [] - -concatenateMosaic :: Mosaic a -> Mosaic a -> Mosaic a -concatenateMosaic (OM a) (OM b) = M [OM a, OM b] -concatenateMosaic (OM a) (M b) = M (OM a:b) -concatenateMosaic (M a) (OM b) = M (a++[OM b]) -concatenateMosaic (M a) (M b) = M (a++b) - -makeM :: [Mosaic a] -> Mosaic a -makeM [m] = m -makeM [] = error "makeM []" -makeM ms = M ms - -flattenMosaic :: Mosaic a -> [a] -flattenMosaic (OM a) = [a] -flattenMosaic (M xs) = concatMap flattenMosaic xs - -allsplits :: [a] -> [[[a]]] -allsplits [] = [[[]]] -allsplits [a] = [[[a]]] -allsplits (x:xs) = (map ([x]:) splitsrest) ++ (map (maphead (x:)) splitsrest) - where splitsrest = allsplits' xs - -allsplits' :: [a] -> [[[a]]] -allsplits' [] = [[[]]] -allsplits' [a] = [[[a]]] -allsplits' (x:xs) = (map (maphead (x:)) splitsrest) ++ (map ([x]:) splitsrest) - where splitsrest = allsplits xs - -maphead :: (a->a) -> [a] -> [a] -maphead f (x:xs) = f x : xs -maphead _ [] = [] - -runCountDown :: Int -> State CountDown a -> a -runCountDown n x = fst $ runState x (CD (mkStdGen n) n) rmfile ./XMonad/Layout/Mosaic.hs hunk ./XMonad/Util/Anneal.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonad.Util.Anneal --- Copyright : (c) David Roundy --- License : BSD-style (see LICENSE) --- --- Maintainer : David Roundy --- Stability : unstable --- Portability : unportable --- --- Requires the 'random' package --- ------------------------------------------------------------------------------ - -module XMonad.Util.Anneal (-- * Usage - -- $usage - Rated(Rated), the_value, the_rating - , anneal, annealMax ) where - -import System.Random ( StdGen, Random, mkStdGen, randomR ) -import Control.Monad.State ( State, runState, put, get, gets, modify ) - --- $usage --- See "XMonad.Layout.Mosaic" for an usage example. - -data Rated a b = Rated !a !b - deriving ( Show ) -instance Functor (Rated a) where - f `fmap` (Rated v a) = Rated v (f a) - -the_value :: Rated a b -> b -the_value (Rated _ b) = b -the_rating :: Rated a b -> a -the_rating (Rated a _) = a - -instance Eq a => Eq (Rated a b) where - (Rated a _) == (Rated a' _) = a == a' -instance Ord a => Ord (Rated a b) where - compare (Rated a _) (Rated a' _) = compare a a' - -anneal :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a -anneal st r sel = runAnneal st r (do_anneal sel) - -annealMax :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a -annealMax st r sel = runAnneal st (negate . r) (do_anneal sel) - -do_anneal :: (a -> [a]) -> State (Anneal a) (Rated Double a) -do_anneal sel = do sequence_ $ replicate 100 da - gets best - where da = do select_metropolis sel - modify $ \s -> s { temperature = temperature s *0.99 } - -data Anneal a = A { g :: StdGen - , best :: Rated Double a - , current :: Rated Double a - , rate :: a -> Rated Double a - , temperature :: Double } - -runAnneal :: a -> (a -> Double) -> State (Anneal a) b -> b -runAnneal start r x = fst $ runState x (A { g = mkStdGen 137 - , best = Rated (r start) start - , current = Rated (r start) start - , rate = \xx -> Rated (r xx) xx - , temperature = 1.0 }) - -select_metropolis :: (a -> [a]) -> State (Anneal a) () -select_metropolis x = do c <- gets current - a <- select $ x $ the_value c - metropolis a - -metropolis :: a -> State (Anneal a) () -metropolis x = do r <- gets rate - c <- gets current - t <- gets temperature - let rx = r x - boltz = exp $ (the_rating c - the_rating rx) / t - if rx < c then do modify $ \s -> s { current = rx, best = rx } - else do p <- getOne (0,1) - if p < boltz - then modify $ \s -> s { current = rx } - else return () - -select :: [a] -> State (Anneal a) a -select [] = the_value `fmap` gets best -select [x] = return x -select xs = do n <- getOne (0,length xs - 1) - return (xs !! n) - -getOne :: (Random a) => (a,a) -> State (Anneal x) a -getOne bounds = do s <- get - (x,g') <- return $ randomR bounds (g s) - put $ s { g = g' } - return x rmfile ./XMonad/Util/Anneal.hs hunk ./xmonad-contrib.cabal 130 - -- XMonad.Layout.Mosaic hunk ./xmonad-contrib.cabal 168 - XMonad.Util.Anneal hunk ./XMonad/Config/Droundy.hs 48 -import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsLogHook ) +import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsLogHook, + ewmhDesktopsLayout ) hunk ./XMonad/Config/Droundy.hs 131 - , layoutHook = showWName $ workspaceDir "~" $ smartBorders $ windowNavigation $ + , layoutHook = ewmhDesktopsLayout $ showWName $ workspaceDir "~" $ + smartBorders $ windowNavigation $ hunk ./XMonad/Actions/MouseGestures.hs 25 +import XMonad.Layout.WindowNavigation (Direction(..)) hunk ./XMonad/Actions/MouseGestures.hs 60 --- | The four cardinal screen directions. A \"gesture\" is a sequence of --- directions. -data Direction = L | U | R | D - deriving (Eq, Ord, Show, Read, Enum, Bounded) - hunk ./XMonad/Layout/WindowNavigation.hs 70 -data Direction = U | D | R | L deriving ( Read, Show, Eq ) +data Direction = U | D | R | L deriving ( Read, Show, Eq, Ord, Enum, Bounded ) addfile ./XMonad/Prompt/RunOrRaise.hs hunk ./XMonad/Prompt/RunOrRaise.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.RunOrRaise +-- Copyright : (C) 2008 Justin Bogner +-- License : BSD3 +-- +-- Maintainer : mail@justinbogner.com +-- Stability : unstable +-- Portability : unportable +-- +-- A prompt for XMonad which will run a program, open a file, +-- or raise an already running program, depending on context. +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.RunOrRaise + ( -- * Usage + -- $usage + runOrRaisePrompt + ) where + +import XMonad hiding (config) +import XMonad.Prompt +import XMonad.Prompt.Shell +import XMonad.Actions.WindowGo (runOrRaise) +import XMonad.Util.Run (runProcessWithInput) + +import Control.Monad (liftM2) +import Data.Maybe +import System.Directory (doesDirectoryExist, doesFileExist, executable, getPermissions) + +-- $usage +-- 1. In your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.RunOrRaise +-- +-- 2. In your keybindings add something like: +-- +-- > , ((modMask x .|. controlMask, xK_x), runOrRaisePrompt defaultXPConfig) +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data RunOrRaisePrompt = RRP +instance XPrompt RunOrRaisePrompt where + showXPrompt RRP = "Run or Raise: " + +runOrRaisePrompt :: XPConfig -> X () +runOrRaisePrompt c = do cmds <- io $ getCommands + mkXPrompt RRP c (getShellCompl cmds) open +open :: String -> X () +open path = (io $ isNormalFile path) >>= \b -> + if b + then spawn $ "xdg-open \"" ++ path ++ "\"" + else uncurry runOrRaise . getTarget $ path + where + isNormalFile f = exists f >>= \e -> if e then (notExecutable f) else return False + exists f = fmap or $ sequence [doesFileExist f,doesDirectoryExist f] + notExecutable = fmap (not . executable) . getPermissions + getTarget x = (x,isApp x) + +isApp :: String -> Query Bool +isApp "firefox" = className =? "Firefox-bin" +isApp "thunderbird" = className =? "Thunderbird-bin" +isApp x = liftM2 (==) pid $ pidof x + +pidof :: String -> Query Int +pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `catch` (\_ -> return $ 0) + +pid :: Query Int +pid = ask >>= (\w -> liftX $ withDisplay $ \d -> getPID d w) + where getPID d w = getAtom "_NET_WM_PID" >>= \a -> io $ + getWindowProperty32 d a w >>= return . getPID' + getPID' (Just (x:_)) = fromIntegral x + getPID' (Just []) = -1 + getPID' (Nothing) = -1 hunk ./XMonad/Prompt/Shell.hs 19 + , getCommands hunk ./xmonad-contrib.cabal 162 + XMonad.Prompt.RunOrRaise hunk ./XMonad/Util/Themes.hs 26 + , wfarrTheme hunk ./XMonad/Util/Themes.hs 86 + , wfarrTheme hunk ./XMonad/Util/Themes.hs 183 + } + +wfarrTheme :: ThemeInfo +wfarrTheme = + newTheme { themeName = "wfarrTheme" + , themeAuthor = "Will Farrington" + , themeDescription = "A nice blue/black theme." + , theme = defaultTheme { activeColor = "#4c7899" + , inactiveColor = "#333333" + , activeBorderColor = "#285577" + , inactiveBorderColor = "#222222" + , activeTextColor = "#ffffff" + , inactiveTextColor = "#888888" + , fontName = "-*-fixed-medium-r-*--10-*-*-*-*-*-iso8859-1" + , decoHeight = 12 + } hunk ./XMonad/Layout/Magnifier.hs 65 +-- > , ((modMask x .|. controlMask , xK_m ), sendMessage Toggle ) +-- +-- Note that a few other extension modules, such as +-- "XMonad.Layout.MultiToggle" and "XMonad.Layout.ToggleLayouts", also +-- define a message named 'Toggle'. To avoid conflicts when using +-- these modules together, you can import Magnifier qualified, like +-- this: +-- +-- > import qualified XMonad.Layout.Magnifier as Mag +-- +-- and then prefix @Mag@ to the front of everything from this module, +-- like @Mag.Toggle@, @Mag.magnifier@, and so on. hunk ./XMonad/Actions/Search.hs 26 + maps, hunk ./XMonad/Actions/Search.hs 77 +* 'maps' -- Google maps. + hunk ./XMonad/Actions/Search.hs 185 -amazon, google, hoogle, imdb, mathworld, scholar, wayback, wikipedia :: SearchEngine +amazon, google, hoogle, imdb, maps, mathworld, scholar, wayback, wikipedia :: SearchEngine hunk ./XMonad/Actions/Search.hs 190 +maps = simpleEngine "http://maps.google.com/maps?q=" hunk ./XMonad/Doc/Extending.hs 658 -> import XMonad.Layouts hunk ./XMonad/Doc/Extending.hs 686 -> import XMonad.Layouts +> import XMonad hunk ./XMonad/Util/Themes.hs 11 --- A (hopefully) growing collection of themes for xmonad +-- A (hopefully) growing collection of themes for decorated layouts. hunk ./XMonad/Util/Themes.hs 33 --- This module stores some user contributed themes. +-- This module stores some user contributed themes which can be used +-- with decorated layouts (such as Tabbed). (Note that these themes +-- only apply to decorated layouts, such as those found in +-- "XMonad.Layout.Tabbed" and "XMonad.Layout.DecorationMadness"; they +-- do not apply to xmonad as a whole.) hunk ./XMonad/Util/Themes.hs 39 --- If you want to use one of this them as your default theme for one --- of your layouts, you need to substitute defaultTheme with, for --- instance, (theme smallClean). +-- If you want to use one of them with one of your decorated layouts, +-- you need to substitute defaultTheme with, for instance, (theme +-- smallClean). hunk ./XMonad/Util/Themes.hs 43 --- This is an example: +-- Here is an example: hunk ./XMonad/Util/Themes.hs 118 --- | Don's prefered colors - fomr DynamicLog...;) +-- | Don's prefered colors - from DynamicLog...;) hunk ./XMonad/Util/Themes.hs 123 - , themeDescription = "Don's prefered colors - fomr DynamicLog...;)" + , themeDescription = "Don's prefered colors - from DynamicLog...;)" hunk ./XMonad/Util/WindowProperties.hs 17 - Property(..), hasProperty) + Property(..), hasProperty, focusedHasProperty) hunk ./XMonad/Util/WindowProperties.hs 20 +import qualified XMonad.StackSet as W hunk ./XMonad/Util/WindowProperties.hs 51 +-- | Does the focused window have this property? +focusedHasProperty :: Property -> X Bool +focusedHasProperty p = do + ws <- gets windowset + let ms = W.stack $ W.workspace $ W.current ws + case ms of + Just s -> hasProperty p $ W.focus s + Nothing -> return False + hunk ./XMonad/Actions/Commands.hs 44 --- > , ((modMask x .|. controlMask, xK_y), runCommand commands) +-- > , ((modMask x .|. controlMask, xK_y), commands >>= runCommand) hunk ./XMonad/Actions/Commands.hs 48 --- > commands :: [(String, X ())] +-- > commands :: X [(String, X ())] hunk ./XMonad/Actions/Commands.hs 52 --- xmonad commands to appear. You can change the commands by --- changing the contents of the list 'commands'. (If you like it +-- xmonad commands to appear. You can change the commands by changing +-- the contents of the list returned by 'commands'. (If you like it hunk ./XMonad/Config/Sjanssen.hs 37 - tiled = HintedTile 1 0.03 0.5 + tiled = HintedTile 1 0.03 0.5 TopLeft hunk ./XMonad/Layout/HintedTile.hs 19 - -- * Usage - -- $usage - HintedTile(..), Orientation(..)) where + -- * Usage + -- $usage + HintedTile(..), Orientation(..), Alignment(..) +) where hunk ./XMonad/Layout/HintedTile.hs 36 --- > myLayouts = HintedTile 1 0.1 0.5 Tall ||| Full ||| etc.. +-- > myLayouts = HintedTile 1 0.1 0.5 TopLeft Tall ||| Full ||| etc.. hunk ./XMonad/Layout/HintedTile.hs 46 + , alignment :: Alignment hunk ./XMonad/Layout/HintedTile.hs 50 -data Orientation = Wide | Tall deriving ( Show, Read ) +data Orientation = Wide | Tall + deriving ( Show, Read, Eq, Ord ) + +data Alignment = TopLeft | Center | BottomRight + deriving ( Show, Read, Eq, Ord ) hunk ./XMonad/Layout/HintedTile.hs 57 - doLayout (HintedTile { orientation = o, nmaster = nm, frac = f }) r w' = do + doLayout (HintedTile { orientation = o, nmaster = nm, frac = f, alignment = al }) r w' = do hunk ./XMonad/Layout/HintedTile.hs 64 - | null masters || null slaves = divide o (masters ++ slaves) r - | otherwise = split o f r (divide o masters) (divide o slaves) + | null masters || null slaves = divide al o (masters ++ slaves) r + | otherwise = split o f r (divide al o masters) (divide al o slaves) hunk ./XMonad/Layout/HintedTile.hs 88 +align :: Alignment -> Position -> Dimension -> Dimension -> Position +align TopLeft p _ _ = p +align Center p a b = p + fromIntegral (a - b) `div` 2 +align BottomRight p a b = p + fromIntegral (a - b) + hunk ./XMonad/Layout/HintedTile.hs 94 -divide :: Orientation -> [(Dimension, SizeHints)] -> Rectangle -> [Rectangle] -divide _ [] _ = [] -divide Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : - (divide Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h))) - where (w, h) = hintsUnderBorder bh (sw, sh `div` fromIntegral (1 + (length bhs))) +divide :: Alignment -> Orientation -> [(Dimension, SizeHints)] -> Rectangle -> [Rectangle] +divide _ _ [] _ = [] +divide al _ [bh] (Rectangle sx sy sw sh) = [Rectangle (align al sx sw w) (align al sy sh h) w h] + where + (w, h) = hintsUnderBorder bh (sw, sh) + +divide al Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle (align al sx sw w) sy w h) : + (divide al Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h))) + where + (w, h) = hintsUnderBorder bh (sw, sh `div` fromIntegral (1 + (length bhs))) hunk ./XMonad/Layout/HintedTile.hs 105 -divide Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : - (divide Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) +divide al Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx (align al sy sh h) w h) : + (divide al Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) hunk ./XMonad/Layout/Reflect.hs 59 --- > layoutHook = mkToggle (REFLECTX ?? EOT) $ --- > mkToggle (REFLECTY ?? EOT) $ +-- > layoutHook = mkToggle (single REFLECTX) $ +-- > mkToggle (single REFLECTY) $ hunk ./XMonad/Layout/LayoutModifier.hs 14 --- A module for writing easy Llayouts and layout modifiers +-- A module for writing easy layout modifiers, which do not define a +-- layout in and of themselves, but modify the behavior of or add new +-- functionality to other layouts. If you ever find yourself writing +-- a layout which takes another layout as a parameter, chances are you +-- should be writing a LayoutModifier instead! +-- +-- In case it is not clear, this module is not intended to help you +-- configure xmonad, it is to help you write other extension modules. +-- So get hacking! hunk ./XMonad/Layout/LayoutModifier.hs 28 + + -- * The 'LayoutModifier' class hunk ./XMonad/Layout/LayoutModifier.hs 37 --- Use LayoutModifier to help write easy Layouts. hunk ./XMonad/Layout/LayoutModifier.hs 38 --- LayouModifier defines a class 'LayoutModifier'. Each method as a --- default implementation. +-- The 'LayoutModifier' class is provided to help extension developers +-- write easy layout modifiers. End users won't find much of interest +-- here. =) +-- +-- To write a layout modifier using the 'LayoutModifier' class, define +-- a data type to represent the layout modification (storing any +-- necessary state), define an instance of 'LayoutModifier', and +-- export an appropriate function for applying the modifier. For example: +-- +-- > data MyModifier a = MyModifier MyState +-- > deriving (Show, Read) +-- > +-- > instance LayoutModifier MyModifier a where +-- > -- override whatever methods from LayoutModifier you like +-- > +-- > modify :: l a -> ModifiedLayout MyModifier l a +-- > modify = ModifiedLayout (MyModifier initialState) +-- +-- When defining an instance of 'LayoutModifier', you are free to +-- override as many or as few of the methods as you see fit. See the +-- documentation below for specific information about the effect of +-- overriding each method. Every method has a default implementation; +-- an instance of 'LayoutModifier' which did not provide a non-default +-- implementation of any of the methods would simply act as the +-- identity on any layouts to which it is applied. +-- +-- For more specific usage examples, see +-- +-- * "XMonad.Layout.WorkspaceDir" +-- +-- * "XMonad.Layout.Magnifier" +-- +-- * "XMonad.Layout.NoBorders" +-- +-- * "XMonad.Layout.Reflect" +-- +-- * "XMonad.Layout.Named" +-- +-- * "XMonad.Layout.WindowNavigation" +-- +-- and several others. You probably want to start by looking at some +-- of the above examples; the documentation below is detailed but +-- possibly confusing, and in many cases the creation of a +-- 'LayoutModifier' is actually quite simple. hunk ./XMonad/Layout/LayoutModifier.hs 83 --- For usage examples you can see "XMonad.Layout.WorkspaceDir", --- "XMonad.Layout.Magnifier", "XMonad.Layout.NoBorder", +-- /Important note/: because of the way the 'LayoutModifier' class is +-- intended to be used, by overriding any of its methods and keeping +-- default implementations for all the others, 'LayoutModifier' +-- methods should never be called explicitly. It is likely that such +-- explicit calls will not have the intended effect. Rather, the +-- 'LayoutModifier' methods should only be called indirectly through +-- the 'LayoutClass' instance for 'ModifiedLayout', since it is this +-- instance that defines the semantics of overriding the various +-- 'LayoutModifier' methods. hunk ./XMonad/Layout/LayoutModifier.hs 94 - modifyLayout :: (LayoutClass l a) => m a -> Workspace WorkspaceId (l a) a - -> Rectangle -> X ([(a, Rectangle)], Maybe (l a)) + + -- | 'modifyLayout' allows you to intercept a call to 'runLayout' + -- /before/ it is called on the underlying layout, in order to + -- perform some effect in the X monad, and\/or modify some of + -- the parameters before passing them on to the 'runLayout' + -- method of the underlying layout. + -- + -- The default implementation of 'modifyLayout' simply calls + -- 'runLayout' on the underlying layout. + modifyLayout :: (LayoutClass l a) => + m a -- ^ the layout modifier + -> Workspace WorkspaceId (l a) a -- ^ current workspace + -> Rectangle -- ^ screen rectangle + -> X ([(a, Rectangle)], Maybe (l a)) hunk ./XMonad/Layout/LayoutModifier.hs 109 + + -- | 'handleMess' allows you to spy on messages to the underlying + -- layout, in order to have an effect in the X monad, or alter + -- the layout modifier state in some way (by returning @Just + -- nm@, where @nm@ is a new modifier). In all cases, the + -- underlying layout will also receive the message as usual, + -- after the message has been processed by 'handleMess'. + -- + -- If you wish to possibly modify a message before it reaches + -- the underlying layout, you should use + -- 'handleMessOrMaybeModifyIt' instead. If you do not need to + -- modify messages or have access to the X monad, you should use + -- 'pureMess' instead. + -- + -- The default implementation of 'handleMess' calls 'unhook' + -- when receiving a 'Hide' or 'ReleaseResources' method (after + -- which it returns @Nothing@), and otherwise passes the message + -- on to 'pureMess'. hunk ./XMonad/Layout/LayoutModifier.hs 132 + + -- | 'handleMessOrMaybeModifyIt' allows you to intercept messages + -- sent to the underlying layout, in order to have an effect in + -- the X monad, alter the layout modifier state, or produce a + -- modified message to be passed on to the underlying layout. + -- + -- The default implementation of 'handleMessOrMaybeModifyIt' + -- simply passes on the message to 'handleMess'. hunk ./XMonad/Layout/LayoutModifier.hs 143 + + -- | 'pureMess' allows you to spy on messages sent to the + -- underlying layout, in order to possibly change the layout + -- modifier state. + -- + -- The default implementation of 'pureMess' ignores messages + -- sent to it, and returns @Nothing@ (causing the layout + -- modifier to remain unchanged). hunk ./XMonad/Layout/LayoutModifier.hs 153 - redoLayout :: m a -> Rectangle -> Stack a -> [(a, Rectangle)] + + -- | 'redoLayout' allows you to intercept a call to 'runLayout' on + -- workspaces with at least one window, /after/ it is called on + -- the underlying layout, in order to perform some effect in the + -- X monad, possibly return a new layout modifier, and\/or + -- modify the results of 'runLayout' before returning them. + -- + -- If you don't need access to the X monad, use 'pureModifier' + -- instead. Also, if the behavior you need can be cleanly + -- separated into an effect in the X monad, followed by a pure + -- transformation of the results of 'runLayout', you should + -- consider implementing 'hook' and 'pureModifier' instead of + -- 'redoLayout'. + -- + -- If you also need to perform some action when 'runLayout' is + -- called on an empty workspace, see 'emptyLayoutMod'. + -- + -- The default implementation of 'redoLayout' calls 'hook' and + -- then 'pureModifier'. + redoLayout :: m a -- ^ the layout modifier + -> Rectangle -- ^ screen rectangle + -> Stack a -- ^ current window stack + -> [(a, Rectangle)] -- ^ (window,rectangle) pairs returned + -- by the underlying layout hunk ./XMonad/Layout/LayoutModifier.hs 179 - pureModifier :: m a -> Rectangle -> Stack a -> [(a, Rectangle)] + + -- | 'pureModifier' allows you to intercept a call to 'runLayout' + -- /after/ it is called on the underlying layout, in order to + -- modify the list of window\/rectangle pairings it has returned, + -- and\/or return a new layout modifier. + -- + -- The default implementation of 'pureModifier' returns the + -- window rectangles unmodified. + pureModifier :: m a -- ^ the layout modifier + -> Rectangle -- ^ screen rectangle + -> Stack a -- ^ current window stack + -> [(a, Rectangle)] -- ^ (window, rectangle) pairs returned + -- by the underlying layout hunk ./XMonad/Layout/LayoutModifier.hs 194 + + -- | 'emptyLayoutMod' allows you to intercept a call to + -- 'runLayout' on an empty workspace, /after/ it is called on + -- the underlying layout, in order to perform some effect in the + -- X monad, possibly return a new layout modifier, and\/or + -- modify the results of 'runLayout' before returning them. + -- + -- If you don't need access to the X monad, then tough luck. + -- There isn't a pure version of 'emptyLayoutMod'. + -- + -- The default implementation of 'emptyLayoutMod' ignores its + -- arguments and returns an empty list of window\/rectangle + -- pairings. + -- + -- /NOTE/: 'emptyLayoutMod' will likely be combined with + -- 'redoLayout' soon! hunk ./XMonad/Layout/LayoutModifier.hs 213 + + -- | 'hook' is called by the default implementation of + -- 'redoLayout', and as such represents an X action which is to + -- be run each time 'runLayout' is called on the underlying + -- layout, /after/ 'runLayout' has completed. Of course, if you + -- override 'redoLayout', then 'hook' will not be called unless + -- you explicitly call it. + -- + -- The default implementation of 'hook' is @return ()@ (i.e., it + -- has no effect). hunk ./XMonad/Layout/LayoutModifier.hs 225 + + -- | 'unhook' is called by the default implementation of + -- 'handleMess' upon receiving a 'Hide' or a 'ReleaseResources' + -- message. + -- + -- The default implementation, of course, does nothing. hunk ./XMonad/Layout/LayoutModifier.hs 233 + + -- | 'modifierDescription' is used to give a String description to + -- this layout modifier. It is the empty string by default; you + -- should only override this if it is important that the + -- presence of the layout modifier be displayed in text + -- representations of the layout (for example, in the status bar + -- of a "XMonad.Hooks.DynamicLog" user). hunk ./XMonad/Layout/LayoutModifier.hs 242 + + -- | 'modifyDescription' gives a String description for the entire + -- layout (modifier + underlying layout). By default, it is + -- derived from the concatenation of the 'modifierDescription' + -- with the 'description' of the underlying layout, with a + -- \"smart space\" in between (the space is not included if the + -- 'modifierDescription' is empty). hunk ./XMonad/Layout/LayoutModifier.hs 254 +-- | The 'LayoutClass' instance for a 'ModifiedLayout' defines the +-- semantics of a 'LayoutModifier' applied to an underlying layout. hunk ./XMonad/Layout/LayoutModifier.hs 277 +-- | A 'ModifiedLayout' is simply a container for a layout modifier +-- combined with an underlying layout. It is, of course, itself a +-- layout (i.e. an instance of 'LayoutClass'). hunk ./XMonad/Layout/LayoutModifier.hs 282 +-- N.B. I think there is a Haddock bug here; the Haddock output for +-- the above does not parenthesize (m a) and (l a), which is obviously +-- incorrect. + + hunk ./XMonad/Layout/Tabbed.hs 111 - if length wrs' <= 1 + if length ws <= 1 hunk ./XMonad/Layout/Tabbed.hs 114 - Tabbed -> Rectangle nx y nwh (fi ht) - TabbedBottom -> Rectangle nx (y+fi(hh-ht)) nwh (fi ht) - - where wrs' = filter ((==r) . snd) wrs - ws = map fst wrs' - nwh = wh `div` max 1 (fi $ length wrs') - nx = case elemIndex w $ filter (`elem` ws) (S.integrate s) of - Just i -> x + (fi nwh * fi i) - Nothing -> x - + Tabbed -> Rectangle nx y wid (fi ht) + TabbedBottom -> Rectangle nx (y+fi(hh-ht)) wid (fi ht) + where ws = filter (`elem` map fst (filter ((==r) . snd) wrs)) (S.integrate s) + loc i = (wh * fi i) `div` max 1 (fi $ length ws) + wid = maybe (fi x) (\i -> loc (i+1) - loc i) $ w `elemIndex` ws + nx = maybe x (fi . loc) $ w `elemIndex` ws hunk ./XMonad/Layout/TabBarDecoration.hs 71 - if isInStack s w then Just $ Rectangle nx ny nwh (fi dht) else Nothing + if isInStack s w then Just $ Rectangle nx ny wid (fi dht) else Nothing hunk ./XMonad/Layout/TabBarDecoration.hs 73 - nwh = wh `div` max 1 (fi $ length wrs) + loc i = (wh * fi i) `div` max 1 (fi $ length wrs) + wid = maybe (fi x) (\i -> loc (i+1) - loc i) $ w `elemIndex` wrs hunk ./XMonad/Layout/TabBarDecoration.hs 78 - nx = case w `elemIndex` wrs of - Just i -> x + (fi nwh * fi i) - Nothing -> x + nx = maybe x (fi . loc) $ w `elemIndex` wrs hunk ./XMonad/Config/Sjanssen.hs 16 -import XMonad.Layout.DwmStyle hunk ./XMonad/Config/Sjanssen.hs 32 - , layoutHook = dwmStyle shrinkText myTheme $ avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTheme) + , layoutHook = avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTheme) hunk ./XMonad/Config/Dons.hs 17 +import XMonad.Layout.NoBorders hunk ./XMonad/Config/Dons.hs 20 -donsMain = dzen $ \conf -> xmonad $ conf - { borderWidth = 2 - , terminal = "term" - , normalBorderColor = "#cccccc" - , focusedBorderColor = "#cd8b00" } - +donsMain = dzen $ \x -> xmonad $ x + { terminal = "term" + , normalBorderColor = "#333333" + , focusedBorderColor = "red" + , layoutHook = smartBorders (layoutHook x) + , manageHook = + manageHook x <+> + (className =? "Toplevel" --> doFloat) + } hunk ./XMonad/Layout/TabBarDecoration.hs 78 - nx = maybe x (fi . loc) $ w `elemIndex` wrs + nx = (x +) $ maybe 0 (fi . loc) $ w `elemIndex` wrs hunk ./XMonad/Layout/Tabbed.hs 119 - nx = maybe x (fi . loc) $ w `elemIndex` ws + nx = (x +) $ maybe 0 (fi . loc) $ w `elemIndex` ws hunk ./XMonad/Actions/UpdatePointer.hs 22 + , PointerPosition (..) hunk ./XMonad/Actions/UpdatePointer.hs 37 --- > logHook = updatePointer +-- > logHook = updatePointer Nearest hunk ./XMonad/Actions/UpdatePointer.hs 39 --- which will move the pointer to the nearest point of a newly focused window +-- which will move the pointer to the nearest point of a newly focused window, or +-- +-- > logHook = updatePointer (Relative 0.5 0.5) +-- +-- which will move the pointer to the center of a newly focused window. +-- +-- To use this with an existing logHook, use >> : +-- +-- > logHook = dynamicLog +-- > >> updatePointer (RelativePosition 1 1) +-- +-- which moves the pointer to the bottom-right corner of the focused window. hunk ./XMonad/Actions/UpdatePointer.hs 52 +data PointerPosition = Nearest | Relative Rational Rational hunk ./XMonad/Actions/UpdatePointer.hs 54 --- | Update the pointer's location to the nearest point of the currently focused +-- | Update the pointer's location to the currently focused hunk ./XMonad/Actions/UpdatePointer.hs 56 -updatePointer :: X () -updatePointer = withFocused $ \w -> do +updatePointer :: PointerPosition -> X () +updatePointer p = withFocused $ \w -> do hunk ./XMonad/Actions/UpdatePointer.hs 63 - unless (w == w') $ do - let x = moveWithin rootx (wa_x wa) ((wa_x wa) + (wa_width wa)) - let y = moveWithin rooty (wa_y wa) ((wa_y wa) + (wa_height wa)) - io $ warpPointer dpy none root 0 0 0 0 (fromIntegral x) (fromIntegral y) + unless (w == w') $ + case p of + Nearest -> do + let x = moveWithin rootx (wa_x wa) ((wa_x wa) + (wa_width wa)) + let y = moveWithin rooty (wa_y wa) ((wa_y wa) + (wa_height wa)) + io $ warpPointer dpy none root 0 0 0 0 (fromIntegral x) (fromIntegral y) + Relative h v -> + io $ warpPointer dpy none w 0 0 0 0 + (fraction h (wa_width wa)) (fraction v (wa_height wa)) + where fraction x y = floor (x * fromIntegral y) hunk ./XMonad/Layout/NoBorders.hs 90 - wx >= 1, wy >= 1 + wx + px >= 1, wy + py >= 1 hunk ./XMonad/Hooks/ManageHelpers.hs 47 --- | 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 +-- | 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 hunk ./XMonad/Hooks/ManageHelpers.hs 73 - where eq q' x' = Match (q' == x') q' + where + eq q' x' = Match (q' == x') q' hunk ./XMonad/Hooks/ManageHelpers.hs 79 - where neq q' x' = Match (q' /= x') q' + where + neq q' x' = Match (q' /= x') q' hunk ./XMonad/Hooks/ManageHelpers.hs 92 -p -->> f = do Match b m <- p - if b then (f m) else mempty +p -->> f = do + Match b m <- p + if b then (f m) else mempty hunk ./XMonad/Hooks/ManageHelpers.hs 98 -p -?>> f = do Match b m <- p - if b then fmap Just (f m) else return Nothing +p -?>> f = do + Match b m <- p + if b then fmap Just (f m) else return Nothing hunk ./XMonad/Hooks/ManageHelpers.hs 116 -transientTo = do w <- ask - d <- (liftX . asks) display - liftIO $ getTransientForHint d w +transientTo = do + w <- ask + d <- (liftX . asks) display + liftIO $ getTransientForHint d w hunk ./XMonad/Hooks/ManageHelpers.hs 124 -transience = transientTo > 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 = transientTo > move + where + move mw = maybe idHook (doF . move') mw + move' w s = maybe s (`W.shift` s) (W.findTag w s) hunk ./XMonad/Hooks/ManageHelpers.hs 147 - where center (W.RationalRect _ _ w h) - = W.RationalRect ((1-w)/2) ((1-h)/2) w h - + where + center (W.RationalRect _ _ w h) = W.RationalRect ((1-w)/2) ((1-h)/2) w h hunk ./XMonad/Doc/Configuring.hs 94 -@http:\/\/haskell.org\/haskellwiki\/Xmonad\/Config_archive\/Template_Config.hs@) +@http:\/\/haskell.org\/haskellwiki\/Xmonad\/Config_archive\/Template_xmonad.hs@) hunk ./XMonad/Doc/Configuring.hs 125 -previous configuration settings. +previous configuration settings. (This assumes that you have the +\'xmessage\' utility installed; you probably do.) hunk ./XMonad/Doc/Configuring.hs 133 -To get xmonad to use your new settings, type @mod-q@. xmonad will +To get xmonad to use your new settings, type @mod-q@. (Remember, the +mod key is \'alt\' by default, but you can configure it to be +something else, such as your Windows key if you have one.) xmonad will hunk ./XMonad/Doc/Developing.hs 11 --- This module documents the xmonad internals. It is intended for --- advanced users who are curious about the xmonad source code and --- want an brief overview. This document may also be helpful for the --- beginner\/intermediate Haskell programmer who is motivated to write --- an xmonad extension as a way to deepen her understanding of this --- powerful functional language; however, there is not space here to --- go into much detail. A more comprehensive document introducing --- beginner\/intermediate Haskell programmers to the xmonad source is --- planned for the xmonad users' wiki --- (). +-- This module gives a brief overview of the xmonad internals. It is +-- intended for advanced users who are curious about the xmonad source +-- code and want an brief overview. This document may also be helpful +-- for the beginner\/intermediate Haskell programmer who is motivated +-- to write an xmonad extension as a way to deepen her understanding +-- of this powerful functional language; however, there is not space +-- here to go into much detail. For a more comprehensive document +-- covering some of the same material in more depth, see the guided +-- tour of the xmonad source on the xmonad wiki: +-- . hunk ./XMonad/Doc/Developing.hs 26 --- repositories. +-- repositories. For a basic tutorial on the nuts and bolts of +-- developing a new extension for xmonad, see the tutorial on the +-- wiki: +-- . hunk ./XMonad/Doc/Developing.hs 291 +For more information on the nuts and bolts of how to develop your own +extension, see the tutorial on the wiki: +. + hunk ./XMonad/Doc/Extending.hs 128 -* "XMonad.Actions.CycleWS": move between workspaces. +* "XMonad.Actions.CycleSelectedLayouts": bind a key to cycle through a + particular subset of your layouts. + +* "XMonad.Actions.CycleWS": move between workspaces in various ways. hunk ./XMonad/Doc/Extending.hs 138 -* "XMonad.Actions.DynamicWorkspaces": add and delete workspaces. +* "XMonad.Actions.DynamicWorkspaces": add, delete, and rename workspaces. hunk ./XMonad/Doc/Extending.hs 154 +* "XMonad.Actions.MouseResize": use with + "XMonad.Layout.WindowArranger" to resize windows with the mouse when + using a floating layout. + +* "XMonad.Actions.NoBorders": forcibly remove borders from a window. + Not to be confused with "XMonad.Layout.NoBorders". + +* "XMonad.Actions.PerWorkspaceKeys": configure keybindings + per-workspace. + +* "XMonad.Actions.Promote": An action to move the focused window to + the master pane, or swap the master with the next window. + hunk ./XMonad/Doc/Extending.hs 184 +* "XMonad.Actions.UpdatePointer": mouse-follows-focus. + hunk ./XMonad/Doc/Extending.hs 191 -* "XMonad.Actions.WmiiActions": wmii-style actions. +* "XMonad.Actions.WindowGo": travel to windows based on various + criteria; conditionally start a program if a window does not exist, + or travel to that window if it does. hunk ./XMonad/Doc/Extending.hs 246 +* "XMonad.Hooks.EventHook": a hook to handle X events at the layout level. + hunk ./XMonad/Doc/Extending.hs 250 -* "XMonad.Hooks.ManageDocks": handle DOCK and STRUT windows appropriately. +* "XMonad.Hooks.ManageDocks": handle DOCK and STRUT windows (such as + status bars) appropriately, by de-managing them and creating + appropriate gaps so as not to place other windows covering them. hunk ./XMonad/Doc/Extending.hs 257 +* "XMonad.Hooks.ServerMode": example use of "XMonad.Hooks.EventHook". + hunk ./XMonad/Doc/Extending.hs 294 +* "XMonad.Layout.Decoration": decorated layouts. + +* "XMonad.Layout.DecorationMadness": some examples of decorated layouts. + hunk ./XMonad/Doc/Extending.hs 303 +* "XMonad.Layout.DwmStyle": windows decorated in a dwm-like style. + hunk ./XMonad/Doc/Extending.hs 307 +* "XMonad.Layout.HintedTile": gapless tiled layout that attempts to + obey window size hints. + +* "XMonad.Layout.IM": a layout for multi-window instant message clients. + hunk ./XMonad/Doc/Extending.hs 329 -* "XMonad.Layout.Mosaic": tries to give each window a - user-configurable relative area - hunk ./XMonad/Doc/Extending.hs 342 +* "XMonad.Layout.Reflect": reflect any layout vertically or horizontally. + hunk ./XMonad/Doc/Extending.hs 347 +* "XMonad.Layout.ResizeScreen": a layout modifier to change the screen + geometry on one side. + hunk ./XMonad/Doc/Extending.hs 353 +* "XMonad.Layout.ScratchWorkspace": implements a scratch workspace + which can be shown and hidden with keybindings. + hunk ./XMonad/Doc/Extending.hs 358 +* "XMonad.Layout.SimpleDecoration": add simple decorations to windows. + +* "XMonad.Layout.SimpleFloat": a basic floating layout. + +* "XMonad.Layout.Simplest": a basic, simple layout that just lays out + all windows with a fullscreen geometry. Used by + "XMonad.Layout.Tabbed". + hunk ./XMonad/Doc/Extending.hs 370 +* "XMonad.Layout.TabBarDecoration": add a bar of tabs to any layout. + hunk ./XMonad/Doc/Extending.hs 376 -* "XMonad.Layout.TilePrime": fill gaps created by resize hints. - hunk ./XMonad/Doc/Extending.hs 381 +* "XMonad.Layout.WindowArranger": make any layout into a + pseudo-floating layout by allowing you to move and resize windows. + hunk ./XMonad/Doc/Extending.hs 403 -* "XMonad.Prompt.Directory" +* "XMonad.Prompt.AppendFile": append lines of text to a file. + +* "XMonad.Prompt.Directory": prompt for a directory. hunk ./XMonad/Doc/Extending.hs 407 -* "XMonad.Prompt.Layout" +* "XMonad.Prompt.DirExec": put a bunch of scripts you want in a + directory, then choose from among them with this prompt. hunk ./XMonad/Doc/Extending.hs 410 -* "XMonad.Prompt.Man" +* "XMonad.Prompt.Email": an example of "XMonad.Prompt.Input", send + simple short e-mails from a prompt. hunk ./XMonad/Doc/Extending.hs 413 -* "XMonad.Prompt.Shell" +* "XMonad.Prompt.Input": useful for building general actions requiring + input from a prompt. hunk ./XMonad/Doc/Extending.hs 416 -* "XMonad.Prompt.Ssh" +* "XMonad.Prompt.Layout": choose a layout from a prompt. hunk ./XMonad/Doc/Extending.hs 418 -* "XMonad.Prompt.Window" +* "XMonad.Prompt.Man": open man pages. hunk ./XMonad/Doc/Extending.hs 420 -* "XMonad.Prompt.Workspace" +* "XMonad.Prompt.RunOrRaise": choose a program, and run it if not + already running, or raise its window if it is. hunk ./XMonad/Doc/Extending.hs 423 -* "XMonad.Prompt.XMonad" +* "XMonad.Prompt.Shell": run a shell command. + +* "XMonad.Prompt.Ssh": open an ssh connection. + +* "XMonad.Prompt.Theme": choose a decoration theme. + +* "XMonad.Prompt.Window": choose an open window. + +* "XMonad.Prompt.Workspace": choose a workspace. + +* "XMonad.Prompt.XMonad": perform various xmonad actions by choosing + one from a prompt. hunk ./XMonad/Doc/Extending.hs 453 -* "XMonad.Util.Anneal": The goal is to bring the system, from an - arbitrary initial state, to a state with the minimum possible - energy. +* "XMonad.Util.CustomKeys": configure key bindings (see + "XMonad.Doc.Extending#Editing_key_bindings"). hunk ./XMonad/Doc/Extending.hs 456 -* "XMonad.Util.CustomKeys" or "XMonad.Util.EZConfig" can be used to - configure key bindings (see "XMonad.Doc.Extending#Editing_key_bindings"); +* "XMonad.Util.Dmenu": a dmenu binding. hunk ./XMonad/Doc/Extending.hs 461 +* "XMonad.Util.EZConfig": configure key bindings easily, including a + parser for writing key bindings in "M-C-x" style. + +* "XMonad.Util.Font": A module for abstracting a font facility over + Core fonts and Xft + +* "XMonad.Util.Invisible": a wrapper data type to store layout state + which should not be persisted across restarts. + +* "XMonad.Util.Loggers": a collection of loggers that can be used in + conjunction with "XMonad.Hooks.DynamicLog". + +* "XMonad.Util.NamedWindows": associate windows with their X titles. + Used by, e.g. "XMonad.Layout.Tabbed". + +* "XMonad.Util.Run": a collection of functions for running external + processes. + +* "XMonad.Util.Scratchpad": hotkey-launched floating terminal window. + +* "XMonad.Util.Themes": a collection of themes to be used with + floating layouts. + +* "XMonad.Util.Timer": set up a timer to handle deferred events. + +* "XMonad.Util.WindowProperties": an EDSL for specifying and matching + on window properties. + +* "XMonad.Util.WorkspaceCompare": general combinators for sorting + workspaces in various ways, used by several other modules which need + to sort workspaces (e.g. "XMonad.Hooks.DynamicLog"). + hunk ./XMonad/Doc/Extending.hs 524 +> import XMonad +> hunk ./XMonad/Doc/Extending.hs 535 -This particular definition also requires importing "Graphics.X11.Xlib" -(for the symbols such as @xK_F12@), "XMonad.Prompt", +This particular definition also requires importing "XMonad.Prompt", hunk ./XMonad/Doc/Extending.hs 538 -> import Graphics.X11.Xlib +> import XMonadPrompt hunk ./XMonad/Doc/Extending.hs 541 -For a list of the names of particular keys (such as xK_F12, and so on), see +For a list of the names of particular keys (such as xK_F12, and so +on), see hunk ./XMonad/Doc/Extending.hs 612 - -There are other ways of defining @newKeys@; for instance, -you could define it like this: - -> newKeys x = foldr (uncurry M.insert) (keys defaultConfig x) (myKeys x) - -However, the simplest way to add new key bindings is to use some -utilities provided by the xmonad-contrib library. For instance, -"XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" both provide -useful functions for editing your key bindings. Look, for instance, at -'XMonad.Util.EZConfig.additionalKeys'. +There are much simpler ways to accomplish this, however, if you are +willing to use an extension module to help you configure your keys. +For instance, "XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" both +provide useful functions for editing your key bindings; "XMonad.Util.EZConfig" even lets you use emacs-style keybinding descriptions like \"M-C-\". hunk ./XMonad/Doc/Extending.hs 865 +* 'XMonad.ManageHook.stringProperty' @somestring@: the contents of the + property @somestring@. + hunk ./XMonad/Doc/Extending.hs 940 +Finally, for additional rules and actions you can use in your +manageHook, check out the contrib module "XMonad.Hooks.ManageHelpers". + hunk ./XMonad/Doc.hs 31 - -- * Developing xmonad: an brief code commentary + -- * Developing xmonad: a brief code commentary hunk ./XMonad/Doc.hs 59 -(Oct. 2007) tarball here: - +(Mar. 2008) tarball here: + hunk ./XMonad/Hooks/ManageDocks.hs 27 --- import Data.Maybe (catMaybes, fromMaybe) hunk ./XMonad/Hooks/ManageDocks.hs 52 +-- /Important note/: if you are switching from manual gaps +-- (defaultGaps in your config) to avoidStruts (recommended, since +-- manual gaps will probably be phased out soon), be sure to switch +-- off all your gaps (with mod-b) /before/ reloading your config with +-- avoidStruts! Toggling struts with a 'ToggleStruts' message will +-- not work unless your gaps are set to zero. +-- hunk ./XMonad/Layout/WorkspaceDir.hs 72 - redoLayout (WorkspaceDir d) _ s wrs = do w <- gets windowset - when (Just (focus s) == peek w) $ scd d - return (wrs, Nothing) + modifyLayout (WorkspaceDir d) w r = do tc <- gets (tag . current . windowset) + when (tc == tag w) $ scd d + runLayout w r hunk ./XMonad/Config/Droundy.hs 11 ---import Control.Monad.State ( modify ) - hunk ./XMonad/Config/Droundy.hs 15 ---import XMonad.Core ( windowset ) hunk ./XMonad/Config/Droundy.hs 17 -import System.Exit - --- % Extension-provided imports +import System.Exit ( exitWith, ExitCode(ExitSuccess) ) hunk ./XMonad/Config/Droundy.hs 19 -import XMonad.Layout.Tabbed -import XMonad.Layout.Combo -import XMonad.Layout.Named +import XMonad.Layout.Tabbed ( tabbed, defaultTheme, + shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) ) +import XMonad.Layout.Combo ( combineTwo ) +import XMonad.Layout.Named ( named ) hunk ./XMonad/Config/Droundy.hs 24 -import XMonad.Layout.Simplest -import XMonad.Layout.Square -import XMonad.Layout.LayoutScreens -import XMonad.Layout.WindowNavigation -import XMonad.Layout.NoBorders -import XMonad.Layout.WorkspaceDir -import XMonad.Layout.ToggleLayouts -import XMonad.Layout.ShowWName -import XMonad.Layout.ScratchWorkspace +import XMonad.Layout.Simplest ( Simplest(Simplest) ) +import XMonad.Layout.Square ( Square(Square) ) +import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction(U,D,R,L), + windowNavigation ) +import XMonad.Layout.NoBorders ( smartBorders ) +import XMonad.Layout.WorkspaceDir ( changeDir, workspaceDir ) +import XMonad.Layout.ToggleLayouts ( toggleLayouts, ToggleLayout(ToggleLayout) ) +import XMonad.Layout.ShowWName ( showWName ) +import XMonad.Layout.ScratchWorkspace ( toggleScratchWorkspace ) hunk ./XMonad/Config/Droundy.hs 34 -import XMonad.Prompt -import XMonad.Prompt.Layout -import XMonad.Prompt.Shell +import XMonad.Prompt ( defaultXPConfig, font, height, XPConfig ) +import XMonad.Prompt.Layout ( layoutPrompt ) +import XMonad.Prompt.Shell ( shellPrompt ) hunk ./XMonad/Config/Droundy.hs 38 -import XMonad.Actions.CopyWindow -import XMonad.Actions.DynamicWorkspaces -import XMonad.Actions.CycleWS +import XMonad.Actions.CopyWindow ( kill1, copy ) +import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace, + selectWorkspace, renameWorkspace, removeWorkspace ) +import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ), + WSDirection( Prev, Next) ) hunk ./XMonad/Config/Droundy.hs 44 -import XMonad.Hooks.ManageDocks -import XMonad.Hooks.UrgencyHook +import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks ) hunk ./XMonad/Config/Droundy.hs 83 - , ((modMask x .|. shiftMask, xK_z ), - layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768])) - , ((modMask x .|. shiftMask .|. controlMask, xK_z), - layoutScreens 1 (fixedLayout [Rectangle 0 0 1440 900])) hunk ./XMonad/Config/Droundy.hs 119 -config = -- withUrgencyHook FocusUrgencyHook $ - withUrgencyHook NoUrgencyHook $ - defaultConfig +config = defaultConfig hunk ./XMonad/Layout/WorkspaceDir.hs 72 - modifyLayout (WorkspaceDir d) w r = do tc <- gets (tag . current . windowset) - when (tc == tag w) $ scd d - runLayout w r + redoLayout (WorkspaceDir d) _ s wrs = do w <- gets windowset + when (Just (focus s) == peek w) $ scd d + return (wrs, Nothing) hunk ./XMonad/Layout/Tabbed.hs 117 - loc i = (wh * fi i) `div` max 1 (fi $ length ws) - wid = maybe (fi x) (\i -> loc (i+1) - loc i) $ w `elemIndex` ws - nx = (x +) $ maybe 0 (fi . loc) $ w `elemIndex` ws + loc i = x + fi ((wh * fi i) `div` max 1 (fi $ length ws)) + wid = fi $ maybe x (\i -> loc (i+1) - loc i) $ w `elemIndex` ws + nx = maybe x loc $ w `elemIndex` ws hunk ./XMonad/Layout/WorkspaceDir.hs 40 -import XMonad.StackSet ( Stack, peek, focus ) +import XMonad.StackSet ( tag, current, workspace ) hunk ./XMonad/Layout/WorkspaceDir.hs 72 - redoLayout (WorkspaceDir d) _ s wrs = do w <- gets windowset - when (Just (focus s) == peek w) $ scd d - return (wrs, Nothing) + modifyLayout (WorkspaceDir d) w r = do tc <- gets (tag.workspace.current.windowset) + when (tc == tag w) $ scd d + runLayout w r hunk ./XMonad/Layout/Spiral.hs 13 --- Spiral adds a spiral tiling layout +-- A spiral tiling layout. hunk ./XMonad/Layout/Spiral.hs 34 --- > import Data.Ratio hunk ./XMonad/Layout/Spiral.hs 37 --- > myLayouts = spiral (1 % 1) ||| etc.. +-- > myLayouts = spiral (6/7) ||| etc.. hunk ./XMonad/Layout/Spiral.hs 61 +-- | A spiral layout. The parameter controls the size ratio between +-- successive windows in the spiral. Sensible values range from 0 +-- up to the aspect ratio of your monitor (often 4/3). +-- +-- By default, the spiral is counterclockwise, starting to the east. +-- See also 'spiralWithDir'. hunk ./XMonad/Layout/Spiral.hs 70 +-- | Create a spiral layout, specifying the starting cardinal direction, +-- the spiral direction (clockwise or counterclockwise), and the +-- size ratio. hunk ./XMonad/Layout/MultiToggle.hs 201 - runLayout (Workspace i mt s) r = currLayout mt `unEL` \l -> acceptChange mt (fmap . fmap) (runLayout (Workspace i l s) r) + runLayout (Workspace i mt s) r + | isNothing (currIndex mt) = + acceptChange mt (fmap . fmap . \f x -> (f x){ baseLayout = x }) $ runLayout (Workspace i (baseLayout mt) s) r + | otherwise = currLayout mt `unEL` \l -> + acceptChange mt (fmap . fmap) $ runLayout (Workspace i l s) r hunk ./XMonad/Layout/Spiral.hs 63 --- up to the aspect ratio of your monitor (often 4/3). +-- up to the aspect ratio of your monitor (often 4\/3). hunk ./xmonad-contrib.cabal 2 -version: 0.6 +version: 0.7 hunk ./xmonad-contrib.cabal 60 - build-depends: mtl, unix, X11>=1.4.1, xmonad==0.6 + build-depends: mtl, unix, X11>=1.4.1, xmonad==0.7 hunk ./XMonad/Hooks/DynamicLog.hs 147 - { defaultGaps = [(15,0,0,0)] -- for fixed - , logHook = dynamicLogWithPP dzenPP + { logHook = dynamicLogWithPP dzenPP hunk ./XMonad/Layout/LayoutScreens.hs 64 - gaps = map (statusGap . W.screenDetail) $ v:vs - (s:ss, g:gg) = (map snd wss, take nscr $ gaps ++ repeat (head gaps)) - in ws { W.current = W.Screen x 0 (SD s g) - , W.visible = zipWith3 W.Screen xs [1 ..] $ zipWith SD ss gg + s:ss = map snd wss + in ws { W.current = W.Screen x 0 (SD s) + , W.visible = zipWith3 W.Screen xs [1 ..] $ map SD ss hunk ./XMonad/Layout/ScratchWorkspace.hs 44 - else do let scratchscreen = W.Screen scratch (-1) (SD hiddenRect (0,0,0,0)) + else do let scratchscreen = W.Screen scratch (-1) (SD hiddenRect) hunk ./XMonad/Hooks/ManageDocks.hs 42 --- so-called "gap" support. First, you must add it to your list of layouts: +-- so-called \"gap\" support. First, you must add it to your list of layouts: hunk ./XMonad/Layout/PerWorkspace.hs 13 --- Configure layouts on a per-workspace basis. +-- Configure layouts on a per-workspace basis: use layouts and apply +-- layout modifiers selectively, depending on the workspace. hunk ./XMonad/Layout/PerWorkspace.hs 20 - onWorkspace, onWorkspaces + onWorkspace, onWorkspaces, + modWorkspace, modWorkspaces hunk ./XMonad/Layout/PerWorkspace.hs 27 +import XMonad.Layout.LayoutModifier + hunk ./XMonad/Layout/PerWorkspace.hs 38 --- > layoutHook = onWorkspace "foo" l1 $ -- layout l1 will be used on workspace "foo". +-- > layoutHook = modWorkspace "baz" m1 $ -- apply layout modifier m1 to all layouts on workspace "baz" +-- > onWorkspace "foo" l1 $ -- layout l1 will be used on workspace "foo". hunk ./XMonad/Layout/PerWorkspace.hs 43 --- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated layouts, --- e.g. @(Full ||| smartBorders $ tabbed shrinkText defaultTConf ||| ...)@ +-- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated +-- layouts, e.g. @(Full ||| smartBorders $ tabbed shrinkText +-- defaultTConf ||| ...)@, and @m1@ can be any layout modifier, i.e. a +-- function of type @(l a -> ModifiedLayout lm l a)@. hunk ./XMonad/Layout/PerWorkspace.hs 62 -onWorkspace wsId l1 l2 = PerWorkspace [wsId] False l1 l2 +onWorkspace wsId = onWorkspaces [wsId] hunk ./XMonad/Layout/PerWorkspace.hs 73 +-- | Specify a layout modifier to apply to a particular workspace; layouts +-- on all other workspaces will remain unmodified. +modWorkspace :: (LayoutClass l a) + => WorkspaceId -- ^ tag of the workspace to match + -> (l a -> ModifiedLayout lm l a) -- ^ the modifier to apply on the matching workspace + -> l a -- ^ the base layout + -> PerWorkspace (ModifiedLayout lm l) l a +modWorkspace wsId = modWorkspaces [wsId] + +-- | Specify a layout modifier to apply to a particular set of +-- workspaces; layouts on all other workspaces will remain +-- unmodified. +modWorkspaces :: (LayoutClass l a) + => [WorkspaceId] -- ^ tags of the workspaces to match + -> (l a -> ModifiedLayout lm l a) -- ^ the modifier to apply on the matching workspaces + -> l a -- ^ the base layout + -> PerWorkspace (ModifiedLayout lm l) l a +modWorkspaces wsIds f l = PerWorkspace wsIds False (f l) l + hunk ./XMonad/Layout/PerWorkspace.hs 127 + hunk ./XMonad/Hooks/ManageDocks.hs 20 - manageDocks, AvoidStruts, avoidStruts, ToggleStruts(ToggleStruts) + manageDocks, AvoidStruts, avoidStruts, ToggleStruts(..), + Side(..) hunk ./XMonad/Hooks/ManageDocks.hs 31 +import Data.List (delete) + hunk ./XMonad/Hooks/ManageDocks.hs 55 +-- If you have multiple docks, you can toggle their gaps individually. +-- For example, to toggle only the top gap: +-- +-- > ,((modMask x .|. controlMask, xK_t), sendMessage $ ToggleStrut TT) +-- +-- Similarly, you can use 'BB', 'LL', and 'RR' to individually toggle +-- gaps on the bottom, left, or right. +-- hunk ./XMonad/Hooks/ManageDocks.hs 72 +-- hunk ./XMonad/Hooks/ManageDocks.hs 108 - [(L, l, ly1, ly2), (R, r, ry1, ry2), (T, t, tx1, tx2), (B, b, bx1, bx2)] + [(LL, l, ly1, ly2), (RR, r, ry1, ry2), (TT, t, tx1, tx2), (BB, b, bx1, bx2)] hunk ./XMonad/Hooks/ManageDocks.hs 119 -calcGap :: X (Rectangle -> Rectangle) -calcGap = withDisplay $ \dpy -> do +calcGap :: [Side] -> X (Rectangle -> Rectangle) +calcGap ss = withDisplay $ \dpy -> do hunk ./XMonad/Hooks/ManageDocks.hs 124 - struts <- concat `fmap` mapM getStrut wins + struts <- (filter careAbout . concat) `fmap` mapM getStrut wins hunk ./XMonad/Hooks/ManageDocks.hs 132 + where careAbout (s,_,_,_) = s `elem` ss hunk ./XMonad/Hooks/ManageDocks.hs 136 -avoidStruts = ModifiedLayout (AvoidStruts True) +avoidStruts = ModifiedLayout (AvoidStruts [TT,BB,LL,RR]) + +data AvoidStruts a = AvoidStruts [Side] deriving ( Read, Show ) hunk ./XMonad/Hooks/ManageDocks.hs 140 -data AvoidStruts a = AvoidStruts Bool deriving ( Read, Show ) +data ToggleStruts = ToggleStruts + | ToggleStrut Side + deriving (Read,Show,Typeable) hunk ./XMonad/Hooks/ManageDocks.hs 144 -data ToggleStruts = ToggleStruts deriving (Read,Show,Typeable) hunk ./XMonad/Hooks/ManageDocks.hs 147 - modifyLayout (AvoidStruts b) w r = do - nr <- if b then fmap ($ r) calcGap else return r + modifyLayout (AvoidStruts ss) w r = do + nr <- fmap ($ r) (calcGap ss) hunk ./XMonad/Hooks/ManageDocks.hs 151 - handleMess (AvoidStruts b ) m - | Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (not b) + handleMess (AvoidStruts ss) m + | Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (toggleAll ss) + | Just (ToggleStrut s) <- fromMessage m = return $ Just $ AvoidStruts (toggleOne s ss) hunk ./XMonad/Hooks/ManageDocks.hs 155 + where toggleAll [] = [TT,BB,LL,RR] + toggleAll _ = [] + toggleOne x xs | x `elem` xs = delete x xs + | otherwise = x : xs hunk ./XMonad/Hooks/ManageDocks.hs 160 -data Side = L | R | T | B +data Side = LL | RR | TT | BB + deriving (Read, Show, Eq) hunk ./XMonad/Hooks/ManageDocks.hs 196 - 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) + LL | p (y0, y1) -> (mx x0 sx0 , y0 , x1 , y1 ) + RR | p (y0, y1) -> (x0 , y0 , mn x1 sx1, y1 ) + TT | p (x0, x1) -> (x0 , mx y0 sy0, x1 , y1 ) + BB | p (x0, x1) -> (x0 , y0 , x1 , mn y1 sy1) hunk ./XMonad/Hooks/ManageDocks.hs 20 - manageDocks, AvoidStruts, avoidStruts, ToggleStruts(..), + manageDocks, AvoidStruts, avoidStruts, avoidStrutsOn, ToggleStruts(..), hunk ./XMonad/Hooks/ManageDocks.hs 63 +-- If you want certain docks to be avoided but others to be covered by +-- default, you can manually specify the sides of the screen on which +-- docks should be avoided, using 'avoidStrutsOn'. For example: +-- +-- > layoutHook = avoidStrutsOn [TT,LL] (tall ||| mirror tall ||| ...) +-- hunk ./XMonad/Hooks/ManageDocks.hs 142 -avoidStruts = ModifiedLayout (AvoidStruts [TT,BB,LL,RR]) +avoidStruts = avoidStrutsOn [TT,BB,LL,RR] + +-- | Adjust layout automagically: don't cover up docks, status bars, +-- etc. on the indicated sides of the screen. Valid sides are TT +-- (top), BB (bottom), RR (right), or LL (left). +avoidStrutsOn :: LayoutClass l a => + [Side] + -> l a + -> ModifiedLayout AvoidStruts l a +avoidStrutsOn ss = ModifiedLayout (AvoidStruts ss) hunk ./XMonad/Config/Arossato.hs 23 -import System.IO (hPutStrLn) hunk ./XMonad/Hooks/DynamicLog.hs 104 +-- > import XMonad.Util.Run -- for spawnPipe and hPutStrLn +-- > hunk ./XMonad/Util/Run.hs 28 - spawnPipe + spawnPipe, + + hPutStr, hPutStrLn -- re-export for convenience hunk ./XMonad/Hooks/ManageDocks.hs 38 --- The first component is a 'ManageHook' which recognizes these windows. To --- enable it: +-- The first component is a 'ManageHook' which recognizes these +-- windows and de-manages them, so that xmonad does not try to tile +-- them. To enable it: hunk ./XMonad/Hooks/ManageDocks.hs 44 --- The second component is a layout modifier that prevents windows from --- overlapping these dock windows. It is intended to replace xmonad's --- so-called \"gap\" support. First, you must add it to your list of layouts: +-- The second component is a layout modifier that prevents windows +-- from overlapping these dock windows. It is intended to replace +-- xmonad's so-called \"gap\" support. First, you must add it to your +-- list of layouts: hunk ./XMonad/Hooks/ManageDocks.hs 52 --- 'AvoidStruts' also supports toggling the dock gap, add a keybinding similar --- to: +-- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding +-- similar to: hunk ./XMonad/Hooks/ManageDocks.hs 82 --- | --- Detects if the given window is of type DOCK and if so, reveals it, but does --- not manage it. If the window has the STRUT property set, adjust the gap accordingly. +-- | Detects if the given window is of type DOCK and if so, reveals +-- it, but does not manage it. If the window has the STRUT property +-- set, adjust the gap accordingly. hunk ./XMonad/Hooks/ManageDocks.hs 88 --- | --- Checks if a window is a DOCK or DESKTOP window +-- | Checks if a window is a DOCK or DESKTOP window hunk ./XMonad/Hooks/ManageDocks.hs 99 --- | --- Gets the STRUT config, if present, in xmonad gap order +-- | Gets the STRUT config, if present, in xmonad gap order hunk ./XMonad/Hooks/ManageDocks.hs 117 --- | --- Helper to read a property +-- | Helper to read a property hunk ./XMonad/Hooks/ManageDocks.hs 121 --- | --- Goes through the list of windows and find the gap so that all STRUT --- settings are satisfied. +-- | Goes through the list of windows and find the gap so that all +-- STRUT settings are satisfied. hunk ./XMonad/Hooks/ManageDocks.hs 138 --- | Adjust layout automagically. +-- | Adjust layout automagically: don't cover up any docks, status +-- bars, etc. hunk ./XMonad/Hooks/ManageDocks.hs 154 +-- | Message type which can be sent to an 'AvoidStruts' layout +-- modifier to alter its behavior. hunk ./XMonad/Hooks/ManageDocks.hs 176 +-- | An enumeration of the sides of the screen. hunk ./XMonad/Hooks/ManageDocks.hs 217 - _ -> (x0 , y0 , x1 , y1 ) + _ -> (x0 , y0 , x1 , y1 ) hunk ./XMonad/Actions/MouseGestures.hs 25 -import XMonad.Layout.WindowNavigation (Direction(..)) +import XMonad.Hooks.ManageDocks (Direction(..)) hunk ./XMonad/Hooks/ManageDocks.hs 21 - Side(..) + Direction(..) hunk ./XMonad/Hooks/ManageDocks.hs 60 --- > ,((modMask x .|. controlMask, xK_t), sendMessage $ ToggleStrut TT) +-- > ,((modMask x .|. controlMask, xK_t), sendMessage $ ToggleStrut U) hunk ./XMonad/Hooks/ManageDocks.hs 62 --- Similarly, you can use 'BB', 'LL', and 'RR' to individually toggle +-- Similarly, you can use 'D', 'L', and 'R' to individually toggle hunk ./XMonad/Hooks/ManageDocks.hs 69 --- > layoutHook = avoidStrutsOn [TT,LL] (tall ||| mirror tall ||| ...) +-- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...) hunk ./XMonad/Hooks/ManageDocks.hs 82 +-- | An enumeration of the four cardinal directions\/sides of the +-- screen. +-- +-- Ideally this would go in its own separate module in Util, +-- but ManageDocks is angling for inclusion into the xmonad core, +-- so keep the dependencies to a minimum. +data Direction = U | D | R | L deriving ( Read, Show, Eq, Ord, Enum, Bounded ) + hunk ./XMonad/Hooks/ManageDocks.hs 122 - [(LL, l, ly1, ly2), (RR, r, ry1, ry2), (TT, t, tx1, tx2), (BB, b, bx1, bx2)] + [(L, l, ly1, ly2), (R, r, ry1, ry2), (U, t, tx1, tx2), (D, b, bx1, bx2)] hunk ./XMonad/Hooks/ManageDocks.hs 131 -calcGap :: [Side] -> X (Rectangle -> Rectangle) +calcGap :: [Direction] -> X (Rectangle -> Rectangle) hunk ./XMonad/Hooks/ManageDocks.hs 149 -avoidStruts = avoidStrutsOn [TT,BB,LL,RR] +avoidStruts = avoidStrutsOn [U,D,L,R] hunk ./XMonad/Hooks/ManageDocks.hs 152 --- etc. on the indicated sides of the screen. Valid sides are TT --- (top), BB (bottom), RR (right), or LL (left). +-- etc. on the indicated sides of the screen. Valid sides are U +-- (top), D (bottom), R (right), or L (left). hunk ./XMonad/Hooks/ManageDocks.hs 155 - [Side] + [Direction] hunk ./XMonad/Hooks/ManageDocks.hs 160 -data AvoidStruts a = AvoidStruts [Side] deriving ( Read, Show ) +data AvoidStruts a = AvoidStruts [Direction] deriving ( Read, Show ) hunk ./XMonad/Hooks/ManageDocks.hs 165 - | ToggleStrut Side + | ToggleStrut Direction hunk ./XMonad/Hooks/ManageDocks.hs 179 - where toggleAll [] = [TT,BB,LL,RR] + where toggleAll [] = [U,D,L,R] hunk ./XMonad/Hooks/ManageDocks.hs 184 --- | An enumeration of the sides of the screen. -data Side = LL | RR | TT | BB - deriving (Read, Show, Eq) hunk ./XMonad/Hooks/ManageDocks.hs 185 --- | (Side, height\/width, initial pixel, final pixel). +-- | (Direction, height\/width, initial pixel, final pixel). hunk ./XMonad/Hooks/ManageDocks.hs 187 -type Strut = (Side, CLong, CLong, CLong) +type Strut = (Direction, CLong, CLong, CLong) hunk ./XMonad/Hooks/ManageDocks.hs 218 - LL | p (y0, y1) -> (mx x0 sx0 , y0 , x1 , y1 ) - RR | p (y0, y1) -> (x0 , y0 , mn x1 sx1, y1 ) - TT | p (x0, x1) -> (x0 , mx y0 sy0, x1 , y1 ) - BB | p (x0, x1) -> (x0 , y0 , x1 , mn y1 sy1) - _ -> (x0 , y0 , x1 , y1 ) + L | p (y0, y1) -> (mx x0 sx0 , y0 , x1 , y1 ) + R | p (y0, y1) -> (x0 , y0 , mn x1 sx1, y1 ) + U | p (x0, x1) -> (x0 , mx y0 sy0, x1 , y1 ) + D | p (x0, x1) -> (x0 , y0 , x1 , mn y1 sy1) + _ -> (x0 , y0 , x1 , y1 ) hunk ./XMonad/Layout/WindowNavigation.hs 35 +import XMonad.Hooks.ManageDocks (Direction(..)) + hunk ./XMonad/Layout/WindowNavigation.hs 72 -data Direction = U | D | R | L deriving ( Read, Show, Eq, Ord, Enum, Bounded ) hunk ./XMonad/Layout/Grid.hs 20 - Grid(..), arrange + Grid(..), arrange hunk ./XMonad/Layout/Grid.hs 47 + where + nwins = length st + ncols = ceiling . (sqrt :: Double -> Double) . fromIntegral $ nwins + mincs = nwins `div` ncols + extrs = nwins - ncols * mincs + chop :: Int -> Dimension -> [(Position, Dimension)] + chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m' hunk ./XMonad/Layout/Grid.hs 55 - nwins = length st - ncols = ceiling . (sqrt :: Double -> Double) . fromIntegral $ nwins - mincs = nwins `div` ncols - extrs = nwins - ncols * mincs - chop :: Int -> Dimension -> [(Position, Dimension)] - chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m' - where - k :: Dimension - k = m `div` fromIntegral n - m' = fromIntegral m - k' :: Position - k' = fromIntegral k - xcoords = chop ncols rw - ycoords = chop mincs rh - ycoords' = chop (succ mincs) rh - (xbase, xext) = splitAt (ncols - extrs) xcoords - rectangles = combine ycoords xbase ++ combine ycoords' xext - where - combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys] + k :: Dimension + k = m `div` fromIntegral n + m' = fromIntegral m + k' :: Position + k' = fromIntegral k + xcoords = chop ncols rw + ycoords = chop mincs rh + ycoords' = chop (succ mincs) rh + (xbase, xext) = splitAt (ncols - extrs) xcoords + rectangles = combine ycoords xbase ++ combine ycoords' xext + where + combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys] hunk ./XMonad/Hooks/ManageDocks.hs 20 - manageDocks, AvoidStruts, avoidStruts, avoidStrutsOn, ToggleStruts(..), - Direction(..) + manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn, + ToggleStruts(..), Direction(..) addfile ./XMonad/Actions/CycleRecentWS.hs hunk ./XMonad/Actions/CycleRecentWS.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.CycleRecentWS +-- Copyright : (c) Michal Janeczek +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Michal Janeczek +-- Stability : unstable +-- Portability : unportable +-- +-- Provides bindings to cycle through most recently used workspaces +-- with repeated presses of a single key (as long as modifier key is +-- held down). This is similar to how many window managers handle +-- window switching. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.CycleRecentWS ( + -- * Usage + -- $usage + cycleRecentWS, + cycleWindowSets +) where + +import XMonad hiding (workspaces) +import XMonad.StackSet + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Actions.CycleRecentWS +-- > +-- > , ((modMask x, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Cycle through most recent workspaces with repeated presses of a key, while +-- a modifier key is held down. The recency of workspaces previewed while browsing +-- to the target workspace is not affected. That way a stack of most recently used +-- workspaces is maintained, similarly to how many window managers handle window +-- switching. For best effects use the same modkey+key combination as the one used +-- to invoke this action. +cycleRecentWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action. + -- As soon as one of them is released, the final switch is made. + -> KeySym -- ^ Key used to switch to next (less recent) workspace. + -> KeySym -- ^ Key used to switch to previous (more recent) workspace. + -- If it's the same as the nextWorkspace key, it is effectively ignored. + -> X () +cycleRecentWS = cycleWindowSets options + where options w = map (view `flip` w) (recentTags w) + recentTags w = map tag $ tail (workspaces w) ++ [head (workspaces w)] + + +cycref :: [a] -> Int -> a +cycref l i = l !! (i `mod` length l) + +-- | Cycle through a finite list of WindowSets with repeated presses of a key, while +-- a modifier key is held down. For best effects use the same modkey+key combination +-- as the one used to invoke this action. +cycleWindowSets :: (WindowSet -> [WindowSet]) -- ^ A function used to create a list of WindowSets to choose from + -> [KeySym] -- ^ A list of modifier keys used when invoking this action. + -- As soon as one of them is released, the final WindowSet is chosen and the action exits. + -> KeySym -- ^ Key used to preview next WindowSet from the list of generated options + -> KeySym -- ^ Key used to preview previous WindowSet from the list of generated options. + -- If it's the same as nextOption key, it is effectively ignored. + -> X () +cycleWindowSets genOptions mods keyNext keyPrev = do + options <- gets $ genOptions . windowset + XConf {theRoot = root, display = d} <- ask + let event = allocaXEvent $ \p -> do + maskEvent d (keyPressMask .|. keyReleaseMask) p + KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p + s <- keycodeToKeysym d c 0 + return (t, s) + let setOption n = do windows $ const $ options `cycref` n + (t, s) <- io event + case () of + () | t == keyPress && s == keyNext -> setOption (n+1) + | t == keyPress && s == keyPrev -> setOption (n-1) + | t == keyRelease && s `elem` mods -> return () + | otherwise -> setOption n + io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime + setOption 0 + io $ ungrabKeyboard d currentTime hunk ./xmonad-contrib.cabal 73 + XMonad.Actions.CycleRecentWS adddir ./XMonad/Layout/MultiToggle hunk ./XMonad/Layout/MultiToggle.hs 18 - hunk ./XMonad/Layout/MultiToggle.hs 26 - mkToggle + mkToggle, + mkToggle1 hunk ./XMonad/Layout/MultiToggle.hs 49 --- To use this module, you first have to define the transformers that you --- want to be handled by @MultiToggle@. For example, if the transformer is --- 'XMonad.Layout.Mirror': --- --- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable) --- > instance Transformer MIRROR Window where --- > transform _ x k = k (Mirror x) --- --- @MIRROR@ can be any identifier (it has to start with an uppercase letter, --- of course); I've chosen an all-uppercase version of the transforming --- function's name here. You need to put @{-\# OPTIONS_GHC -fglasgow-exts \#-}@ --- at the beginning of your file to be able to derive "Data.Typeable". +-- To use this module, you need some data types which represent +-- transformers; for some commonly used transformers (including +-- MIRROR, NOBORDERS, and FULL used in the examples below) you can +-- simply import "XMonad.Layout.MultiToggle.Instances". hunk ./XMonad/Layout/MultiToggle.hs 72 --- It's also possible to stack @MultiToggle@s. Let's define a few more --- transformers ('XMonad.Layout.NoBorders.noBorders' is in --- "XMonad.Layout.NoBorders"): --- --- > 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 +-- It's also possible to stack @MultiToggle@s. For example: hunk ./XMonad/Layout/MultiToggle.hs 85 +-- +-- You can also define your own transformers by creating a data type +-- which is an instance of the 'Transformer' class. For example, here +-- is the definition of @MIRROR@: +-- +-- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable) +-- > instance Transformer MIRROR Window where +-- > transform _ x k = k (Mirror x) +-- +-- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable \#-}@ at the +-- beginning of your file (ghc 6.8 only; with ghc 6.6 you can use +-- @{-\# OPTIONS_GHC -fglasgow-exts \#-}@ instead) to be able to +-- derive "Data.Typeable". +-- hunk ./XMonad/Layout/MultiToggle.hs 156 +-- | Construct a @MultiToggle@ layout from a single transformer and a base +-- layout. +mkToggle1 :: (LayoutClass l a) => t -> l a -> MultiToggle (HCons t EOT) l a +mkToggle1 t = mkToggle (single t) + addfile ./XMonad/Layout/MultiToggle/Instances.hs hunk ./XMonad/Layout/MultiToggle/Instances.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} +-- above is for compatibility with GHC 6.6. +{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.MultiToggle.Instances +-- Copyright : (c) 2008 Brent Yorgey +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Some convenient common instances of the +-- 'XMonad.Layout.MultiToggle.Transformer' class, for use with +-- "XMonad.Layout.MultiToggle". + +module XMonad.Layout.MultiToggle.Instances ( + StdTransformers(..) +) where + +import XMonad.Layout.MultiToggle + +import XMonad +import XMonad.Layout.NoBorders + +data StdTransformers = FULL -- ^ switch to Full layout + | NBFULL -- ^ switch to Full with no borders + | MIRROR -- ^ Mirror the current layout. + | NOBORDERS -- ^ Remove borders. + | SMARTBORDERS -- ^ Apply smart borders. + deriving (Read, Show, Eq, Typeable) + +instance Transformer StdTransformers Window where + transform FULL _ k = k Full + transform NBFULL _ k = k (noBorders Full) + transform MIRROR x k = k (Mirror x) + transform NOBORDERS x k = k (noBorders x) + transform SMARTBORDERS x k = k (smartBorders x) hunk ./xmonad-contrib.cabal 133 + XMonad.Layout.MultiToggle.Instances hunk ./XMonad/Layout/Tabbed.hs 67 --- | A tabbed layout with the default xmonad Theme. Here's a screen --- shot: --- --- +-- | A tabbed layout with the default xmonad Theme. hunk ./XMonad/Layout/IM.hs 60 +-- +-- By default the roster window will appear on the left side. +-- To place roster window on the right side, use @reflectHoriz@ from +-- "XMonad.Layout.Reflect" module. hunk ./XMonad/Layout/IM.hs 70 --- * allow roster placement on the right side or even on top\/bottom --- addfile ./XMonad/Layout/HintedGrid.hs hunk ./XMonad/Layout/HintedGrid.hs 1 +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.HintedGrid +-- Copyright : (c) Lukas Mai +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- A not so simple layout that attempts to put all windows in a square grid +-- while obeying their size hints. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.HintedGrid ( + -- * Usage + -- $usage + Grid(..), arrange +) where + +import Prelude hiding ((.)) + +import XMonad hiding (windows) +import XMonad.StackSet + +import Control.Monad.State + +infixr 9 . +(.) :: (Functor f) => (a -> b) -> f a -> f b +(.) = fmap + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.HintedGrid +-- +-- Then edit your @layoutHook@ by adding the 'Grid' layout: +-- +-- > myLayouts = Grid False ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see +-- "XMonad.Doc.Extending#Editing_the_layout_hook". + +-- | Automatic mirroring of hinted layouts doesn't work very well, so this +-- 'Grid' comes with built-in mirroring. @Grid False@ is the normal layout, +-- @Grid True@ is the mirrored variant (rotated by 90 degrees). +data Grid a = Grid Bool deriving (Read, Show) + +instance LayoutClass Grid Window where + doLayout (Grid m) r w = flip (,) Nothing . arrange m r (integrate w) + +adjBorders :: Dimension -> D -> D +adjBorders b (w, h) = (w + 2 * b, h + 2 * b) + +isqrt :: (Integral a) => a -> a +isqrt = ceiling . (sqrt :: Double -> Double) . fromIntegral + +replicateS :: Int -> (a -> (b, a)) -> a -> ([b], a) +replicateS n = runState . replicateM n . State + +doColumn :: Dimension -> Dimension -> Dimension -> [(D -> D)] -> [D] +doColumn width = doC + where + doC _ _ [] = [] + doC height n (f : fs) = adj : doC (height - h') (n - 1) fs + where + adj@(_, h') = f (width, height `div` n) + +doRect :: Dimension -> Dimension -> Dimension -> [[D -> D]] -> [Rectangle] +doRect height = doR + where + doR _ _ [] = [] + doR width n (c : cs) = + let + v = fromIntegral $ length c + c' = doColumn (width `div` n) height v c + (ws, hs) = unzip c' + maxw = maximum ws + height' = sum hs + hbonus = height - height' + hsingle = hbonus `div` v + hoffset = hsingle `div` 2 + width' = width - maxw + ys = map ((height -) . subtract hoffset) . scanl1 (+) . map (hsingle +) $ hs + xs = map ((width' +) . (`div` 2) . (maxw -)) $ ws + in + zipWith3 (\x y (w, h) -> Rectangle (fromIntegral x) (fromIntegral y) w h) xs ys c' ++ doR width' (n - 1) cs + +-- | The internal function for computing the grid layout. +arrange :: Bool -> Rectangle -> [Window] -> X [(Window, Rectangle)] +arrange mirror (Rectangle rx ry rw rh) windows = do + dpy <- asks display + hints <- mapM (io . getWMNormalHints dpy) windows + borders <- mapM (io . fmap (fromIntegral . wa_border_width) . getWindowAttributes dpy) windows + let + adjs = zipWith (\h b -> twist . adjBorders b . applySizeHints h . adjBorders (negate b) . twist) hints borders + rs = arrange' (twist (rw, rh)) adjs + rs' = map (\(Rectangle x y w h) -> uncurry (uncurry Rectangle (twist (x, y))) (twist (w, h))) rs + return . zip windows . map (\r -> r{ rect_x = rect_x r + rx, rect_y = rect_y r + ry }) $ rs' + where + twist + | mirror = \(a, b) -> (b, a) + | otherwise = id + +arrange' :: D -> [D -> D] -> [Rectangle] +arrange' (rw, rh) adjs = reverse $ doRect rh rw (fromIntegral ncolumns) (ecols ++ cols) + where + nwindows = length adjs + ncolumns = isqrt nwindows + nrows = nwindows `div` ncolumns + nextras = nwindows - ncolumns * nrows + (ecols, adjs') = replicateS nextras (splitAt (nrows + 1)) $ reverse adjs + (cols, _) = replicateS (ncolumns - nextras) (splitAt nrows) adjs' hunk ./xmonad-contrib.cabal 122 + XMonad.Layout.HintedGrid hunk ./XMonad/Prompt/Shell.hs 20 + , getBrowser + , getEditor hunk ./XMonad/Prompt/Shell.hs 128 +-- | Ask the shell environment for +env :: String -> String -> IO String +env variable fallthrough = getEnv variable `catch` \_ -> return fallthrough + +{- | Ask the shell what browser the user likes. If the user hasn't defined any + $BROWSER, defaults to returning \"firefox\", since that seems to be the most + common X web browser. + Note that if you don't specify a GUI browser but a textual one, that'll be a problem + as 'getBrowser' will be called by functions expecting to be able to just execute the string + or pass it to a shell; so in that case, define $BROWSER as something like \"xterm -e elinks\" + or as the name of a shell script doing much the same thing. -} +getBrowser :: IO String +getBrowser = env "BROWSER" "firefox" + +getEditor :: IO String +getEditor = env "EDITOR" "emacs" hunk ./XMonad/Actions/Search.hs 15 -module XMonad.Actions.Search ( -- * Usage - -- $usage - search, - simpleEngine, - promptSearch, - selectSearch, +module XMonad.Actions.Search ( -- * Usage + -- $usage + search, + simpleEngine, + promptSearch, + promptSearchBrowser, + selectSearch, + selectSearchBrowser, hunk ./XMonad/Actions/Search.hs 24 - amazon, - google, - hoogle, - imdb, - maps, - mathworld, - scholar, - wayback, - wikipedia + amazon, + google, + hoogle, + imdb, + maps, + mathworld, + scholar, + wayback, + wikipedia hunk ./XMonad/Actions/Search.hs 34 - -- * Use case: searching with a submap - -- $tip + -- * Use case: searching with a submap + -- $tip hunk ./XMonad/Actions/Search.hs 41 -import XMonad (X(), MonadIO) +import XMonad (X(), MonadIO, liftIO) hunk ./XMonad/Actions/Search.hs 43 -import XMonad.Prompt.Shell (getShellCompl) +import XMonad.Prompt.Shell (getBrowser, getShellCompl) hunk ./XMonad/Actions/Search.hs 89 -Feel free to add more! --} +Feel free to add more! -} hunk ./XMonad/Actions/Search.hs 112 -> [ ((0, xK_g), method \"firefox\" S.google) -> , ((0, xK_h), method \"firefox\" S.hoogle) -> , ((0, xK_w), method \"firefox\" S.wikipedia) +> [ ((0, xK_g), method S.google) +> , ((0, xK_h), method S.hoogle) +> , ((0, xK_w), method S.wikipedia) hunk ./XMonad/Actions/Search.hs 129 -Happy searching! --} +Happy searching! -} hunk ./XMonad/Actions/Search.hs 131 --- A customized prompt. +-- | A customized prompt indicating we are searching, and not anything else. hunk ./XMonad/Actions/Search.hs 138 --- but then that'd be hard enough to copy-and-paste we'd need to depend on 'network'. +-- but then that'd be hard enough to copy-and-paste we'd need to depend on @network@. hunk ./XMonad/Actions/Search.hs 165 -{- | Given a browser, a search engine, and a search term, perform the - requested search in the browser. -} -search :: MonadIO m => Browser -> SearchEngine -> Query -> m () +-- | Given a browser, a search engine, and a search term, perform the +-- requested search in the browser. +search :: Browser -> SearchEngine -> Query -> X () hunk ./XMonad/Actions/Search.hs 194 -wayback = simpleEngine "http://web.archive.org/" hunk ./XMonad/Actions/Search.hs 197 +wayback = simpleEngine "http://web.archive.org/" + +{- | Like 'search', but for use with the output from a Prompt; it grabs the + Prompt's result, passes it to a given searchEngine and opens it in a given + browser. -} +promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X () +promptSearchBrowser config browser engine = mkXPrompt Search config (getShellCompl []) $ search browser engine hunk ./XMonad/Actions/Search.hs 208 - > , ((modm, xK_g), promptSearch greenXPConfig "firefox" google) +> , ((modm, xK_g), promptSearch greenXPConfig google) hunk ./XMonad/Actions/Search.hs 210 --} -promptSearch :: XPConfig -> Browser -> SearchEngine -> X () -promptSearch config browser site = mkXPrompt Search config (getShellCompl []) $ search browser site + This specializes "promptSearchBrowser" by supplying the browser argument as + supplied by 'getBrowser' from "XMonad.Prompt.Shell". -} +promptSearch :: XPConfig -> SearchEngine -> X () +promptSearch config engine = liftIO getBrowser >>= \ browser -> promptSearchBrowser config browser engine hunk ./XMonad/Actions/Search.hs 215 -{- | 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: +-- | Like 'search', but for use with the X selection; it grabs the selection, +-- passes it to a given searchEngine and opens it in a given browser. +-- selectSearchBrowser :: Browser -> SearchEngine -> IO () +selectSearchBrowser :: Browser -> SearchEngine -> X () +selectSearchBrowser browser searchengine = search browser searchengine =<< getSelection hunk ./XMonad/Actions/Search.hs 221 -> , ((modm .|. shiftMask, xK_g), selectSearch "firefox" google) +{- | Like 'search', but for use with the X selection; it grabs the selection, + passes it to a given searchEngine and opens it in the default browser . Example: hunk ./XMonad/Actions/Search.hs 224 --} -selectSearch :: MonadIO m => Browser -> SearchEngine -> m () -selectSearch browser searchEngine = search browser searchEngine =<< getSelection +> , ((modm .|. shiftMask, xK_g), selectSearch google) hunk ./XMonad/Actions/Search.hs 226 + This specializes "selectSearchBrowser" by supplying the browser argument as + supplied by 'getBrowser' from "XMonad.Prompt.Shell". -} +selectSearch :: SearchEngine -> X () +selectSearch engine = liftIO getBrowser >>= \browser -> selectSearchBrowser browser engine hunk ./XMonad/Prompt/RunOrRaise.hs 32 --- $usage --- 1. In your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Prompt --- > import XMonad.Prompt.RunOrRaise --- --- 2. In your keybindings add something like: --- --- > , ((modMask x .|. controlMask, xK_x), runOrRaisePrompt defaultXPConfig) --- --- For detailed instruction on editing the key binding see --- "XMonad.Doc.Extending#Editing_key_bindings". +{- $usage +1. In your @~\/.xmonad\/xmonad.hs@: + +> import XMonad.Prompt +> import XMonad.Prompt.RunOrRaise + +2. In your keybindings add something like: + +> , ((modMask x .|. controlMask, xK_x), runOrRaisePrompt defaultXPConfig) + +For detailed instruction on editing the key binding see +"XMonad.Doc.Extending#Editing_key_bindings". -} hunk ./XMonad/Prompt/RunOrRaise.hs 64 -isApp "firefox" = className =? "Firefox-bin" -isApp "thunderbird" = className =? "Thunderbird-bin" +isApp "firefox" = className =? "Firefox-bin" <||> className =? "Firefox" +isApp "thunderbird" = className =? "Thunderbird-bin" <||> className =? "Thunderbird" hunk ./XMonad/Actions/WindowGo.hs 13 -remember where you left it or whether you still have one running. --} +remember where you left it or whether you still have one running. -} hunk ./XMonad/Actions/WindowGo.hs 21 + + raiseBrowser, + raiseEditor, hunk ./XMonad/Actions/WindowGo.hs 27 -import XMonad (Query(), X(), withWindowSet, spawn, runQuery, focus) hunk ./XMonad/Actions/WindowGo.hs 28 -import qualified XMonad.StackSet as W (allWindows) +import Data.Char (toLower) + +import XMonad (Query(), X(), withWindowSet, spawn, runQuery, liftIO, focus) hunk ./XMonad/Actions/WindowGo.hs 32 +import XMonad.Prompt.Shell (getBrowser, getEditor) +import qualified XMonad.StackSet as W (allWindows) hunk ./XMonad/Actions/WindowGo.hs 47 -lower versions use other classnames such as "Firefox-bin" +lower versions use other classnames such as "Firefox-bin". Either choose the +appropriate one, or cover your bases by using instead something like + @(className =? "Firefox" <||> className =? "Firefox-bin")@.) + hunk ./XMonad/Actions/WindowGo.hs 96 +-- | Given a function which gets us a String, we try to raise a window with that classname, +-- or we then interpret that String as a executable name. +raiseVar :: IO String -> X () +raiseVar getvar = liftIO getvar >>= \var -> runOrRaise var (fmap (map toLower) className =? var) + +-- | 'raiseBrowser' and 'raiseEditor' grab $BROWSER and $EDITOR respectively and they either +-- take you to the specified, or they try to run it. This is most useful if your variables are simple +-- and look like 'firefox' or 'emacs'. +raiseBrowser, raiseEditor :: X () +raiseBrowser = raiseVar getBrowser +raiseEditor = raiseVar getEditor + hunk ./XMonad/Prompt/Shell.hs 142 +-- | Like 'getBrowser', but should be of a text editor. This gets the $EDITOR variable, defaulting to \"emacs\". hunk ./XMonad/Actions/WindowGo.hs 46 -(Note that Firefox v3 and up have a class-name of "Firefox" and "Navigator"; -lower versions use other classnames such as "Firefox-bin". Either choose the +(Note that Firefox v3 and up have a class-name of \"Firefox\" and \"Navigator\"; +lower versions use other classnames such as \"Firefox-bin\". Either choose the hunk ./XMonad/Actions/WindowGo.hs 49 - @(className =? "Firefox" <||> className =? "Firefox-bin")@.) + @(className =? \"Firefox\" <||> className =? \"Firefox-bin\")@.) hunk ./XMonad/Actions/WindowGo.hs 54 --- | 'action' is an executable to be run via 'spawn' if the Window cannot be found. +-- | 'action' is an executable to be run via 'spawn' (of "XMonad.Core") if the Window cannot be found. hunk ./XMonad/Actions/WindowGo.hs 65 - XMonad.ManageHook: title, resource, className. Each one tests based pretty + "XMonad.ManageHook": title, resource, className. Each one tests based pretty hunk ./XMonad/Actions/WindowGo.hs 68 - class is Firefox. Firefox declares the class "Firefox", so you'd want to - pass in a boolean like '(className =? "Firefox")'. + class is Firefox. Firefox 3 declares the class \"Firefox\", so you'd want to + pass in a boolean like @(className =? \"Firefox\")@. hunk ./XMonad/Actions/WindowGo.hs 71 - If the boolean returns True on one or more windows, then XMonad will quickly - make visible the first result. If no Window meets the criteria, then the + If the boolean returns @True@ on one or more windows, then XMonad will quickly + make visible the first result. If no @Window@ meets the criteria, then the hunk ./XMonad/Actions/WindowGo.hs 76 - tests fail. This is what enables runOrRaise to use raiseMaybe: it simply runs + tests fail. This is what enables 'runOrRaise' to use 'raiseMaybe': it simply runs hunk ./XMonad/Actions/WindowGo.hs 83 - No problem: you search for a terminal window calling itself 'mutt', and if + No problem: you search for a terminal window calling itself \"mutt\", and if hunk ./XMonad/Actions/WindowGo.hs 85 - (borrowing "XMonad.Utils.Run"'s 'runInTerm'): + (borrowing 'runInTerm' from "XMonad.Utils.Run"): hunk ./XMonad/Actions/WindowGo.hs 101 --- | 'raiseBrowser' and 'raiseEditor' grab $BROWSER and $EDITOR respectively and they either --- take you to the specified, or they try to run it. This is most useful if your variables are simple --- and look like 'firefox' or 'emacs'. +{- | 'raiseBrowser' and 'raiseEditor' grab $BROWSER and $EDITOR respectively and they either + take you to the specified program's window, or they try to run it. This is most useful + if your variables are simple and look like 'firefox' or 'emacs'. -} hunk ./XMonad/Hooks/ManageDocks.hs 88 -data Direction = U | D | R | L deriving ( Read, Show, Eq, Ord, Enum, Bounded ) +data Direction = U -- ^ Up/top + | D -- ^ Down/bottom + | R -- ^ Right + | L -- ^ Left + deriving ( Read, Show, Eq, Ord, Enum, Bounded ) addfile ./XMonad/Layout/Gaps.hs hunk ./XMonad/Layout/Gaps.hs 1 +{-# 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.Gaps +-- Copyright : (c) 2008 Brent Yorgey +-- License : BSD3 +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Create manually-sized gaps along edges of the screen which will not +-- be used for tiling, along with support for toggling gaps on and +-- off. +-- +-- Note that "XMonad.Hooks.ManageDocks" is the preferred solution for +-- leaving space for your dock-type applications (status bars, +-- toolbars, docks, etc.), since it automatically sets up appropriate +-- gaps, allows them to be toggled, etc. However, this module may +-- still be useful in some situations where the automated approach of +-- ManageDocks does not work; for example, to work with a dock-type +-- application that does not properly set the STRUTS property, or to +-- leave part of the screen blank which is truncated by a projector, +-- and so on. +----------------------------------------------------------------------------- + +module XMonad.Layout.Gaps ( + -- * Usage + -- $usage + Direction(..), + GapSpec, gaps, GapMessage(..) + + ) where + +import XMonad.Core +import Graphics.X11 (Rectangle(..)) + +import XMonad.Hooks.ManageDocks (Direction(..)) +import XMonad.Layout.LayoutModifier + +import Data.List (delete) + +-- $usage +-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Layout.Gaps +-- +-- and applying the 'gaps' modifier to your layouts as follows (for +-- example): +-- +-- > layoutHook = gaps [(U,18), (R,23)] $ Tall 1 (3/100) (1/2) ||| Full -- leave gaps at the top and right +-- +-- You can additionally add some keybindings to toggle or modify the gaps, +-- for example: +-- +-- > , ((modMask x .|. controlMask, xK_g), sendMessage $ ToggleGaps) -- toggle all gaps +-- > , ((modMask x .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap +-- > , ((modMask x .|. controlMask, xK_w), sendMessage $ IncGap R 5) -- increment the right-hand gap +-- > , ((modMask x .|. controlMask, xK_q), sendMessage $ DecGap R 5) -- decrement the right-hand gap +-- +-- If you want complete control over all gaps, you could include +-- something like this in your keybindings, assuming in this case you +-- are using 'XMonad.Util.EZConfig.mkKeymap' or +-- 'XMonad.Util.EZConfig.additionalKeysP' from "XMonad.Util.EZConfig" +-- for string keybinding specifications: +-- +-- > ++ +-- > [ ("M-g " ++ f ++ " " ++ k, sendMessage $ m d) +-- > | (k, d) <- [("a",L), ("s",D), ("w",U), ("d",R)] +-- > , (f, m) <- [("v", ToggleGap), ("h", IncGap 10), ("f", DecGap 10)] +-- > ] +-- +-- Given the above keybinding definition, for example, you could type +-- @M-g, v, a@ to toggle the top gap. +-- +-- To configure gaps differently per-screen, use +-- "XMonad.Layout.PerScreen" (coming soon). + +-- | A manual gap configuration. Each side of the screen on which a +-- gap is enabled is paired with a size in pixels. +type GapSpec = [(Direction,Int)] + +-- | The gap state. The first component is the configuration (which +-- gaps are allowed, and their current size), the second is the gaps +-- which are currently active. +data Gaps a = Gaps GapSpec [Direction] + deriving (Show, Read) + +-- | Messages which can be sent to a gap modifier. +data GapMessage = ToggleGaps -- ^ Toggle all gaps. + | ToggleGap Direction -- ^ Toggle a single gap. + | IncGap Int Direction -- ^ Increase a gap by a certain number of pixels. + | DecGap Int Direction -- ^ Decrease a gap. + deriving (Typeable) + +instance Message GapMessage + +instance LayoutModifier Gaps a where + modifyLayout g w r = runLayout w (applyGaps g r) + + pureMess (Gaps conf cur) m + | Just ToggleGaps <- fromMessage m + = Just $ Gaps conf (toggleGaps conf cur) + | Just (ToggleGap d) <- fromMessage m + = Just $ Gaps conf (toggleGap conf cur d) + | Just (IncGap i d) <- fromMessage m + = Just $ Gaps (incGap conf d i) cur + | Just (DecGap i d) <- fromMessage m + = Just $ Gaps (incGap conf d (-i)) cur + | otherwise = Nothing + +applyGaps :: Gaps a -> Rectangle -> Rectangle +applyGaps gs r = foldr applyGap r (activeGaps gs) + where + applyGap (U,z) (Rectangle x y w h) = Rectangle x (y + fi z) w (h - fi z) + applyGap (D,z) (Rectangle x y w h) = Rectangle x y w (h - fi z) + applyGap (L,z) (Rectangle x y w h) = Rectangle (x + fi z) y (w - fi z) h + applyGap (R,z) (Rectangle x y w h) = Rectangle x y (w - fi z) h + +activeGaps :: Gaps a -> GapSpec +activeGaps (Gaps conf cur) = filter ((`elem` cur) . fst) conf + +toggleGaps :: GapSpec -> [Direction] -> [Direction] +toggleGaps conf [] = map fst conf +toggleGaps _ _ = [] + +toggleGap :: GapSpec -> [Direction] -> Direction -> [Direction] +toggleGap conf cur d | d `elem` cur = delete d cur + | d `elem` (map fst conf) = d:cur + | otherwise = cur + +incGap :: GapSpec -> Direction -> Int -> GapSpec +incGap gs d i = map (\(dir,j) -> if dir == d then (dir,max (j+i) 0) else (dir,j)) gs + +fi :: (Num b, Integral a) => a -> b +fi = fromIntegral + +-- | Add togglable manual gaps to a layout. +gaps :: GapSpec -- ^ The gaps to allow, paired with their initial sizes. + -> l a -- ^ The layout to modify. + -> ModifiedLayout Gaps l a +gaps g = ModifiedLayout (Gaps g (map fst g)) + hunk ./xmonad-contrib.cabal 121 + XMonad.Layout.Gaps hunk ./XMonad/Layout/Grid.hs 49 - ncols = ceiling . (sqrt :: Double -> Double) . fromIntegral $ nwins + ncols = max 1 . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh :: Double) hunk ./XMonad/Layout/HintedGrid.hs 59 -isqrt :: (Integral a) => a -> a -isqrt = ceiling . (sqrt :: Double -> Double) . fromIntegral - hunk ./XMonad/Layout/HintedGrid.hs 110 - ncolumns = isqrt nwindows + ncolumns = max 1 . round . sqrt $ fromIntegral nwindows * fromIntegral rw / (fromIntegral rh :: Double) hunk ./XMonad/Layout/HintedGrid.hs 63 -doColumn width = doC +doColumn width height k adjs = + let + (h1, d1) = doC height k adjs + (h2, d2) = doC height k (reverse adjs) + in + if h2 < h1 then reverse d2 else d1 hunk ./XMonad/Layout/HintedGrid.hs 70 - doC _ _ [] = [] - doC height n (f : fs) = adj : doC (height - h') (n - 1) fs + doC h _ [] = (h, []) + doC h n (f : fs) = (adj :) . doC (h - h') (n - 1) fs hunk ./XMonad/Layout/HintedGrid.hs 73 - adj@(_, h') = f (width, height `div` n) + adj@(_, h') = f (width, h `div` n) hunk ./XMonad/Layout/HintedGrid.hs 30 +import Data.List +import Data.Ord hunk ./XMonad/Layout/HintedGrid.hs 67 - (h1, d1) = doC height k adjs - (h2, d2) = doC height k (reverse adjs) + (ind, fs) = unzip . sortBy (comparing $ snd . ($ (width, height)) . snd) . zip [0 :: Int ..] $ adjs + (_, ds) = doC height k fs hunk ./XMonad/Layout/HintedGrid.hs 70 - if h2 < h1 then reverse d2 else d1 + map snd . sortBy (comparing fst) . zip ind $ ds hunk ./XMonad/Hooks/EwmhDesktops.hs 103 --- * _NET_ACTIVE_WINDOW (activate another window) +-- * _NET_ACTIVE_WINDOW (activate another window, possibly moving to the current desktop) hunk ./XMonad/Hooks/EwmhDesktops.hs 136 - windows $ W.focusWindow w + windows $ W.focusWindow w . W.shiftWin (W.tag (W.workspace (W.current s))) w hunk ./XMonad/Actions/Search.hs 25 + dictionary, hunk ./XMonad/Actions/Search.hs 74 +* 'dictionary' -- dictionary.com search. + hunk ./XMonad/Actions/Search.hs 188 -amazon, google, hoogle, imdb, maps, mathworld, scholar, 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=" -maps = simpleEngine "http://maps.google.com/maps?q=" -mathworld = simpleEngine "http://mathworld.wolfram.com/search/?query=" -scholar = simpleEngine "http://scholar.google.com/scholar?q=" -wikipedia = simpleEngine "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search=" +amazon, dictionary, google, hoogle, imdb, maps, mathworld, + scholar, wayback, wikipedia :: SearchEngine +amazon = simpleEngine "http://www.amazon.com/exec/obidos/external-search?index=all&keyword=" +dictionary = simpleEngine "http://dictionary.reference.com/browse/" +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=" +maps = simpleEngine "http://maps.google.com/maps?q=" +mathworld = simpleEngine "http://mathworld.wolfram.com/search/?query=" +scholar = simpleEngine "http://scholar.google.com/scholar?q=" +wikipedia = simpleEngine "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search=" hunk ./XMonad/Actions/Search.hs 222 --- selectSearchBrowser :: Browser -> SearchEngine -> IO () hunk ./XMonad/Hooks/DynamicLog.hs 54 +import qualified Data.Map as M hunk ./XMonad/Hooks/DynamicLog.hs 61 + +import XMonad.Layout.LayoutModifier hunk ./XMonad/Hooks/DynamicLog.hs 64 +import XMonad.Hooks.ManageDocks hunk ./XMonad/Hooks/DynamicLog.hs 135 +------------------------------------------------------------------------ + hunk ./XMonad/Hooks/DynamicLog.hs 151 -dzen :: (XConfig (Choose Tall (Choose (Mirror Tall) Full)) -> IO ()) -> IO () +-- The binding uses the XMonad.Hooks.ManageDocks module to automatically +-- handle screen placement for dzen, and enables 'mod-b' for toggling +-- the menu bar. +-- +dzen :: + (XConfig + (ModifiedLayout AvoidStruts + (Choose Tall (Choose (Mirror Tall) Full))) -> IO t) -> IO t hunk ./XMonad/Hooks/DynamicLog.hs 162 - { logHook = dynamicLogWithPP dzenPP - { ppOutput = hPutStrLn h } } + { logHook = dynamicLogWithPP dzenPP + { ppOutput = hPutStrLn h } + ,layoutHook = avoidStrutsOn [U] (layoutHook defaultConfig) + ,keys = \c -> mykeys c `M.union` keys defaultConfig c + ,manageHook = manageHook defaultConfig <+> manageDocks + } hunk ./XMonad/Hooks/DynamicLog.hs 169 + mykeys (XConfig{modMask=modm}) = M.fromList + [((modm, xK_b ), sendMessage ToggleStruts) + ] hunk ./XMonad/Hooks/DynamicLog.hs 176 +------------------------------------------------------------------------ + hunk ./XMonad/Layout/ThreeColumns.hs 44 -data ThreeCol a = ThreeCol Int Rational Rational deriving (Show,Read) +data ThreeCol a = ThreeCol !Int !Rational !Rational deriving (Show,Read) hunk ./XMonad/Hooks/DynamicLog.hs 174 - flags = "-e '' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg + flags = "-e 'onstart=lower' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg hunk ./XMonad/Hooks/EwmhDesktops.hs 136 - windows $ W.focusWindow w . W.shiftWin (W.tag (W.workspace (W.current s))) w + windows $ W.focusWindow w hunk ./XMonad/Hooks/EwmhDesktops.hs 103 --- * _NET_ACTIVE_WINDOW (activate another window, possibly moving to the current desktop) +-- * _NET_ACTIVE_WINDOW (activate another window) hunk ./XMonad/Hooks/EwmhDesktops.hs 103 --- * _NET_ACTIVE_WINDOW (activate another window) +-- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed) hunk ./XMonad/Layout/MultiToggle/Instances.hs 3 -{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable #-} +{- LANGUAGE TypeSynonymInstances, DeriveDataTypeable -} hunk ./XMonad/Hooks/ManageDocks.hs 88 -data Direction = U -- ^ Up/top - | D -- ^ Down/bottom +data Direction = U -- ^ Up\/top + | D -- ^ Down\/bottom hunk ./XMonad/Actions/ConstrainedResize.hs 56 - applySizeHints sh sz) + applySizeHintsContents sh sz) hunk ./XMonad/Actions/FlexibleManipulate.hs 95 - nwidth = applySizeHints sh $ mapP (round :: Double -> Integer) (nbr - ntl) + nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl) hunk ./XMonad/Actions/FlexibleResize.hs 56 - `uncurry` applySizeHints sh (gx $ fromIntegral ex, gy $ fromIntegral ey)) + `uncurry` applySizeHintsContents sh (gx $ fromIntegral ex, gy $ fromIntegral ey)) hunk ./XMonad/Actions/FloatKeys.hs 97 - (nw, nh) = applySizeHints sh (w + dx, h + dy) + (nw, nh) = applySizeHintsContents sh (w + dx, h + dy) hunk ./XMonad/Actions/FloatKeys.hs 106 - (nw, nh) = applySizeHints sh (w + dx, h + dy) + (nw, nh) = applySizeHintsContents sh (w + dx, h + dy) hunk ./XMonad/Layout/HintedGrid.hs 26 -import XMonad hiding (windows) +import XMonad hunk ./XMonad/Layout/HintedGrid.hs 58 -adjBorders :: Dimension -> D -> D -adjBorders b (w, h) = (w + 2 * b, h + 2 * b) - hunk ./XMonad/Layout/HintedGrid.hs 96 -arrange mirror (Rectangle rx ry rw rh) windows = do - dpy <- asks display - hints <- mapM (io . getWMNormalHints dpy) windows - borders <- mapM (io . fmap (fromIntegral . wa_border_width) . getWindowAttributes dpy) windows +arrange mirror (Rectangle rx ry rw rh) wins = do + proto <- mapM mkAdjust wins hunk ./XMonad/Layout/HintedGrid.hs 99 - adjs = zipWith (\h b -> twist . adjBorders b . applySizeHints h . adjBorders (negate b) . twist) hints borders + adjs = map (\f -> twist . f . twist) proto hunk ./XMonad/Layout/HintedGrid.hs 102 - return . zip windows . map (\r -> r{ rect_x = rect_x r + rx, rect_y = rect_y r + ry }) $ rs' + return . zip wins . map (\r -> r{ rect_x = rect_x r + rx, rect_y = rect_y r + ry }) $ rs' hunk ./XMonad/Layout/HintedTile.hs 26 -import Control.Applicative ((<$>)) hunk ./XMonad/Layout/HintedTile.hs 57 - bhs <- mapM getHints w + bhs <- mapM mkAdjust w hunk ./XMonad/Layout/HintedTile.hs 75 -adjBorder :: Dimension -> Dimension -> D -> D -adjBorder n b (w, h) = (w + n * 2 * b, h + n * 2 * b) - --- | Transform a function on dimensions into one without regard for borders -hintsUnderBorder :: (Dimension, SizeHints) -> D -> D -hintsUnderBorder (bW, h) = adjBorder bW 1 . applySizeHints h . adjBorder bW (-1) - -getHints :: Window -> X (Dimension, SizeHints) -getHints w = withDisplay $ \d -> io $ liftM2 (,) - (fromIntegral . wa_border_width <$> getWindowAttributes d w) - (getWMNormalHints d w) - hunk ./XMonad/Layout/HintedTile.hs 81 -divide :: Alignment -> Orientation -> [(Dimension, SizeHints)] -> Rectangle -> [Rectangle] +divide :: Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle] hunk ./XMonad/Layout/HintedTile.hs 85 - (w, h) = hintsUnderBorder bh (sw, sh) + (w, h) = bh (sw, sh) hunk ./XMonad/Layout/HintedTile.hs 90 - (w, h) = hintsUnderBorder bh (sw, sh `div` fromIntegral (1 + (length bhs))) + (w, h) = bh (sw, sh `div` fromIntegral (1 + (length bhs))) hunk ./XMonad/Layout/HintedTile.hs 95 - (w, h) = hintsUnderBorder bh (sw `div` fromIntegral (1 + (length bhs)), sh) + (w, h) = bh (sw `div` fromIntegral (1 + (length bhs)), sh) hunk ./XMonad/Layout/LayoutHints.hs 45 --- | Expand a size by the given multiple of the border width. The --- multiple is most commonly 1 or -1. -adjBorders :: Dimension -> Dimension -> D -> D -adjBorders bW mult (w,h) = (w+2*mult*bW, h+2*mult*bW) - hunk ./XMonad/Layout/LayoutHints.hs 50 - bW <- asks (borderWidth . config) - xs' <- mapM (applyHint bW) xs + xs' <- mapM applyHint xs hunk ./XMonad/Layout/LayoutHints.hs 53 - applyHint bW (w,r@(Rectangle a b c d)) = - withDisplay $ \disp -> do - sh <- io $ getWMNormalHints disp w - let (c',d') = adjBorders 1 bW . applySizeHints sh . adjBorders bW (-1) $ (c,d) - return (w, if isInStack s w then Rectangle a b c' d' else r) + applyHint (w,r@(Rectangle a b c d)) = do + adj <- mkAdjust w + let (c',d') = adj (c,d) + return (w, if isInStack s w then Rectangle a b c' d' else r) addfile ./XMonad/Layout/Master.hs hunk ./XMonad/Layout/Master.hs 1 +{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-} +{-# LANGUAGE PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Master +-- Copyright : (c) Lukas Mai +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- A layout that adds a distinguished master window to a base layout. +----------------------------------------------------------------------------- + +module XMonad.Layout.Master ( + -- * Usage + -- $usage + mastered, + Master +) where + +import XMonad +import XMonad.StackSet + +import Data.List +import Data.Ord + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Master +-- +-- and add something like +-- +-- > mastered (1/100) (1/2) $ Grid +-- +-- to your layouts. This will use the left half of your screen for a master +-- window and let Grid manage the right half. +-- +-- For more detailed instructions on editing the layoutHook see +-- "XMonad.Doc.Extending#Editing_the_layout_hook". +-- +-- Like 'XMonad.Layout.Tall', 'Master' supports the 'XMonad.Layout.Shrink' and +-- 'XMonad.Layout.Expand' messages. + +mastered :: (LayoutClass l a) + => Rational -- ^ @delta@, the ratio of the screen to resize by + -> Rational -- ^ @frac@, what portion of the screen to reserve for the master window + -> l a -- ^ the layout to use for the remaining windows + -> Master l a +mastered d f b = Master d f' b + where + f' = min 1 . max 0 $ f + +data Master l a = + Master{ + delta :: Rational, + frac :: Rational, + base :: l a + } deriving (Show, Read, Eq, Ord) + +extractMaster :: Stack a -> (a, Maybe (Stack a)) +extractMaster (Stack x ls rs) = case reverse ls of + [] -> (x, differentiate rs) + (m : ls') -> (m, Just $ Stack x (reverse ls') rs) + +area :: Rectangle -> Dimension +area r = rect_width r * rect_height r + +chop :: D -> Rectangle -> Rectangle +chop (w, h) (Rectangle rx ry rw rh) = + let + r' = maximumBy (comparing area) + [ Rectangle rx (ry + fromIntegral h) rw (rh - h) + , Rectangle (rx + fromIntegral w) ry (rw - w) rh] + in + r'{ rect_width = max 0 $ rect_width r', rect_height = max 0 $ rect_height r' } + +instance (LayoutClass l Window) => LayoutClass (Master l) Window where + description m = "Master " ++ description (base m) + handleMessage m msg + | Just Shrink <- fromMessage msg = + return . Just $ m{ frac = max 0 $ frac m - delta m } + | Just Expand <- fromMessage msg = + return . Just $ m{ frac = min 1 $ frac m + delta m } + | otherwise = + fmap (fmap (\x -> m{ base = x })) $ handleMessage (base m) msg + runLayout ws rect = do + (f, ws', rect') <- case fmap extractMaster $ stack ws of + Nothing -> + return (id, ws, rect) + Just (x, Nothing) -> do + f <- mkAdjust x + let + (w', h') = f (rect_width rect, rect_height rect) + xr = rect{ rect_width = w', rect_height = h' } + return (((x, xr) :), ws{ stack = Nothing }, Rectangle (rect_x xr + fromIntegral w') (rect_y xr) 0 0) + Just (x, Just st) -> do + f <- mkAdjust x + let + d@(w', h') = f (scale $ rect_width rect, rect_height rect) + xr = rect{ rect_width = w', rect_height = h' } + return (((x, xr) :), ws{ stack = Just st }, chop d rect) + (y, l) <- runLayout ws'{ layout = base m } rect' + return (f y, fmap (\x -> m{ base = x }) l) + where + m = layout ws + scale = round . (* frac m) . fromIntegral hunk ./xmonad-contrib.cabal 132 + XMonad.Layout.Master hunk ./XMonad/Actions/WindowGo.hs 19 + raiseNext, hunk ./XMonad/Actions/WindowGo.hs 21 + runOrRaiseNext, hunk ./XMonad/Actions/WindowGo.hs 23 + raiseNextMaybe, hunk ./XMonad/Actions/WindowGo.hs 36 -import qualified XMonad.StackSet as W (allWindows) +import qualified XMonad.StackSet as W (allWindows, peek) hunk ./XMonad/Actions/WindowGo.hs 99 +-- | See 'runOrRaise' and 'raiseNextMaybe'. Version that allows cycling through matches. +runOrRaiseNext :: String -> Query Bool -> X () +runOrRaiseNext action = raiseNextMaybe $ spawn action + +-- | See 'raise' and 'raiseNextMaybe'. Version that allows cycling through matches. +raiseNext :: Query Bool -> X () +raiseNext = raiseNextMaybe $ return () + +{- | See 'raiseMaybe'. + 'raiseNextMaybe' is an alternative version that allows cycling + through the matching windows. If the focused window matches the + query the next matching window is raised. If no matches are found + the function f is executed. +-} +raiseNextMaybe :: X () -> Query Bool -> X () +raiseNextMaybe f thatUserQuery = withWindowSet $ \s -> do + ws <- filterM (runQuery thatUserQuery) (W.allWindows s) + case ws of + [] -> f + (x:_) -> let go (Just w) | (w `elem` ws) = next w $ cycle ws + go _ = focus x + in go $ W.peek s + where + next w (x:y:_) | x==w = focus y + next w (_:xs) = next w xs + next _ _ = error "raiseNextMaybe: empty list" + hunk ./XMonad/Util/NamedWindows.hs 25 +import Control.Monad.Reader ( asks ) +import Control.Monad.State ( gets ) + hunk ./XMonad/Util/NamedWindows.hs 46 -getName w = asks display >>= \d -> do s <- io $ getClassHint d w - n <- maybe (resName s) id `fmap` io (fetchName d w) - return $ NW n w +getName w = withDisplay $ \d -> do + let getIt = bracket getProp (xFree . tp_value) (fmap (`NW` w) . copy) + + getProp = (internAtom d "_NET_WM_NAME" False >>= getTextProperty d w) + `catch` \_ -> getTextProperty d w wM_NAME + + copy prop = head `fmap` wcTextPropertyToTextList d prop + + io $ getIt `catch` \_ -> ((`NW` w) . resName) `fmap` getClassHint d w hunk ./XMonad/Util/NamedWindows.hs 25 -import Control.Monad.Reader ( asks ) -import Control.Monad.State ( gets ) +import Prelude hiding ( catch ) +import Control.Exception ( bracket, catch ) hunk ./XMonad/Util/Font.hsc 48 -import Foreign.C hunk ./XMonad/Util/Font.hsc 101 - do io setupLocale - dpy <- asks display + do dpy <- asks display hunk ./XMonad/Util/Font.hsc 107 - (io setupLocale >> initUtf8Font s >>= (return . Utf8)) + (initUtf8Font s >>= (return . Utf8)) hunk ./XMonad/Util/Font.hsc 215 -#if defined XFT || defined UTF8 -#include -foreign import ccall unsafe "locale.h setlocale" - setlocale :: CInt -> CString -> IO CString - -setupLocale :: IO () -setupLocale = withCString "" $ \s -> do - setlocale (#const LC_ALL) s - return () -#endif - hunk ./XMonad/Hooks/DynamicLog.hs 61 - -import XMonad.Layout.LayoutModifier hunk ./XMonad/Hooks/DynamicLog.hs 222 - wt <- maybe (return "") (fmap show . getName) . S.peek $ winset + wt <- maybe (return "") (fmap (encodeOutput . show) . getName) . S.peek $ winset hunk ./XMonad/Hooks/DynamicLog.hs 222 - wt <- maybe (return "") (fmap (encodeOutput . show) . getName) . S.peek $ winset + wt <- maybe (return "") (fmap show . getName) . S.peek $ winset hunk ./XMonad/Hooks/DynamicLog.hs 227 - return $ sepBy (ppSep pp) . ppOrder pp $ + return $ encodeOutput . sepBy (ppSep pp) . ppOrder pp $ hunk ./XMonad/Hooks/DynamicLog.hs 61 + +import XMonad.Layout.LayoutModifier +import XMonad.Util.Font hunk ./XMonad/Util/Font.hsc 107 - (initUtf8Font s >>= (return . Utf8)) + fmap Utf8 $ initUtf8Font s hunk ./XMonad/Util/Font.hsc 109 - (initCoreFont s >>= (return . Core)) + fmap Core $ initCoreFont s hunk ./XMonad/Actions/UpdatePointer.hs 48 --- > >> updatePointer (RelativePosition 1 1) +-- > >> updatePointer (Relative 1 1) hunk ./XMonad/Actions/CopyWindow.hs 5 --- Copyright : (c) David Roundy +-- Copyright : (c) David Roundy , Ivan Veselov hunk ./XMonad/Actions/CopyWindow.hs 20 - copy, copyWindow, kill1 + copy, copyToAll, copyWindow, killAllOtherCopies, kill1 hunk ./XMonad/Actions/CopyWindow.hs 23 -import Prelude hiding ( filter ) +import Prelude hiding (filter) hunk ./XMonad/Actions/CopyWindow.hs 25 -import XMonad hiding (modify) +import XMonad hiding (modify, workspaces) hunk ./XMonad/Actions/CopyWindow.hs 53 +-- Another possibility which this extension provides is 'making window +-- always visible' (i.e. always on current workspace), similar to corresponding +-- metacity functionality. This behaviour is emulated through copying given +-- window to all the workspaces and then removing it when it's unneeded on +-- all workspaces any more. +-- +-- Here is the example of keybindings which provide these actions: +-- +-- > , ((modMask x, xK_v )", windows copyToAll) -- @@ Make focused window always visible +-- > , ((modMask x .|. shiftMask, xK_v ), killAllOtherCopies) -- @@ Toggle window state back +-- hunk ./XMonad/Actions/CopyWindow.hs 72 +-- | copyToAll. Copy the focused window to all of workspaces. +copyToAll :: WindowSet -> WindowSet +copyToAll s = foldr ($) s $ map (copy . tag) (workspaces s) + hunk ./XMonad/Actions/CopyWindow.hs 102 +-- | Kill all other copies of focused window (if they're present) +-- 'All other' means here 'copies, which are not on current workspace' +-- +-- Consider calling this function after copyToAll +-- +killAllOtherCopies :: X () +killAllOtherCopies = do ss <- gets windowset + whenJust (peek ss) $ \w -> windows $ + view (tag (workspace (current ss))) . + delFromAllButCurrent w + where + delFromAllButCurrent w ss = foldr ($) ss $ + map (delWinFromWorkspace w . tag) $ + hidden ss ++ map workspace (visible ss) + delWinFromWorkspace w wid ss = modify Nothing (filter (/= w)) $ view wid ss + hunk ./XMonad/Actions/CopyWindow.hs 68 -copy :: WorkspaceId -> WindowSet -> WindowSet +copy :: (Eq s, Eq i, Eq a) => i -> StackSet i l a s sd -> StackSet i l a s sd hunk ./XMonad/Actions/CopyWindow.hs 73 -copyToAll :: WindowSet -> WindowSet -copyToAll s = foldr ($) s $ map (copy . tag) (workspaces s) +copyToAll :: (Eq s, Eq i, Eq a) => StackSet i l a s sd -> StackSet i l a s sd +copyToAll s = foldr copy s $ map tag (workspaces s) hunk ./XMonad/Actions/CopyWindow.hs 77 -copyWindow :: Window -> WorkspaceId -> WindowSet -> WindowSet +copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> StackSet i l a s sd -> StackSet i l a s sd hunk ./XMonad/Util/WindowProperties.hs 29 --- | Property constructors are quite self-explaining. +-- | Most of the property constructors are quite self-explaining. hunk ./XMonad/Util/WindowProperties.hs 33 + | Role String -- ^ WM_WINDOW_ROLE property hunk ./XMonad/Util/WindowProperties.hs 47 +hasProperty (Role s) w = withDisplay $ \d -> fmap ((==) (Just s)) $ getStringProperty d w "WM_WINDOW_ROLE" hunk ./XMonad/Actions/CopyWindow.hs 8 --- Maintainer : David Roundy +-- Maintainer : ??? hunk ./XMonad/Hooks/EwmhDesktops.hs 62 - let wins = W.allWindows s hunk ./XMonad/Hooks/EwmhDesktops.hs 76 + -- all windows, with focused windows last + let wins = nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws hunk ./XMonad/Layout/HintedTile.hs 43 - { nmaster :: Int - , delta, frac :: Rational - , alignment :: Alignment - , orientation :: Orientation + { nmaster :: !Int + , delta, frac :: !Rational + , alignment :: !Alignment + , orientation :: !Orientation hunk ./XMonad/Prompt.hs 76 - XPS { dpy :: Display - , rootw :: Window - , win :: Window - , screen :: Rectangle + XPS { dpy :: !Display + , rootw :: !Window + , win :: !Window + , screen :: !Rectangle hunk ./XMonad/Prompt.hs 83 - , gcon :: GC - , fontS :: XMonadFont - , xptype :: XPType + , gcon :: !GC + , fontS :: !XMonadFont + , xptype :: !XPType hunk ./XMonad/Prompt.hs 87 - , offset :: Int + , offset :: !Int hunk ./XMonad/Prompt.hs 99 - , promptBorderWidth :: Dimension -- ^ Border width + , promptBorderWidth :: !Dimension -- ^ Border width hunk ./XMonad/Prompt.hs 101 - , height :: Dimension -- ^ Window height - , historySize :: Int -- ^ The number of history entries to be saved + , height :: !Dimension -- ^ Window height + , historySize :: !Int -- ^ The number of history entries to be saved hunk ./XMonad/Layout/IM.hs 6 --- Copyright : (c) Roman Cheplyaka +-- Copyright : (c) Roman Cheplyaka, Ivan N. Veselov hunk ./XMonad/Layout/IM.hs 13 --- Layout suitable for workspace with multi-windowed instant messanger (like --- Psi or Tkabber). +-- Layout modfier suitable for workspace with multi-windowed instant messanger +-- (like Psi or Tkabber). hunk ./XMonad/Layout/IM.hs 27 - Property(..), IM(..) + Property(..), IM(..), withIM, gridIM, hunk ./XMonad/Layout/IM.hs 34 -import XMonad.Layout.Grid (arrange) +import XMonad.Layout.Grid +import XMonad.Layout.LayoutModifier hunk ./XMonad/Layout/IM.hs 44 --- Then edit your @layoutHook@ by adding the IM layout: +-- Then edit your @layoutHook@ by adding IM modifier to layout which you prefer +-- for managing your chat windows (Grid in this example, another useful choice +-- to consider is Tabbed layout). hunk ./XMonad/Layout/IM.hs 48 --- > myLayouts = IM (1%7) (ClassName "Tkabber") ||| Full ||| etc.. +-- > myLayouts = withIM (1%7) (ClassName "Tkabber") Grid ||| Full ||| etc.. hunk ./XMonad/Layout/IM.hs 69 --- All these items are questionable. Please let me know if you find them useful. +-- This item are questionable. Please let me know if you find them useful. hunk ./XMonad/Layout/IM.hs 73 --- * use arbitrary layout instead of grid hunk ./XMonad/Layout/IM.hs 74 -data IM a = IM Rational Property deriving (Read, Show) +-- | Data type for LayoutModifier which converts given layout to IM-layout +-- (with dedicated space for the roster and original layout for chat windows) +data AddRoster a = AddRoster Rational Property deriving (Read, Show) + +instance LayoutModifier AddRoster Window where + modifyLayout (AddRoster ratio prop) = applyIM ratio prop + modifierDescription _ = "IM" + +-- | Modifier which converts given layout to IM-layout (with dedicated +-- space for roster and original layout for chat windows) +withIM :: LayoutClass l a => Rational -> Property -> l a -> ModifiedLayout AddRoster l a +withIM ratio prop = ModifiedLayout $ AddRoster ratio prop + +-- | IM layout modifier applied to the Grid layout +gridIM :: Rational -> Property -> ModifiedLayout AddRoster Grid a +gridIM ratio prop = withIM ratio prop Grid + +-- | Internal function for adding space for the roster specified by +-- the property and running original layout for all chat windows +applyIM :: (LayoutClass l Window) => + Rational + -> Property + -> S.Workspace WorkspaceId (l Window) Window + -> Rectangle + -> X ([(Window, Rectangle)], Maybe (l Window)) +applyIM ratio prop wksp rect = do + let ws = S.integrate' $ S.stack wksp + let (masterRect, slaveRect) = splitHorizontallyBy ratio rect + master <- findM (hasProperty prop) ws + case master of + Just w -> do + let filteredStack = S.differentiate $ filter (w /=) ws + wrs <- runLayout (wksp {S.stack = filteredStack}) slaveRect + return ((w, masterRect) : fst wrs, snd wrs) + Nothing -> runLayout wksp rect + +-- | Like find, but works with monadic computation instead of pure function. +findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a) +findM _ [] = return Nothing +findM f (x:xs) = do { b <- f x; if b then return (Just x) else findM f xs } hunk ./XMonad/Layout/IM.hs 115 +-- | This is for compatibility with old configs only and will be removed in future versions! +data IM a = IM Rational Property deriving (Read, Show) hunk ./XMonad/Layout/IM.hs 128 --- | Like find, but works with monadic computation instead of pure function. -findM :: Monad m => (a-> m Bool) -> [a] -> m (Maybe a) -findM _ [] = return Nothing -findM f (x:xs) = do { b <- f x; if b then return (Just x) else findM f xs } - hunk ./XMonad/Layout/IM.hs 100 - let ws = S.integrate' $ S.stack wksp + let stack = S.stack wksp + let ws = S.integrate' $ stack hunk ./XMonad/Layout/IM.hs 106 - let filteredStack = S.differentiate $ filter (w /=) ws + let filteredStack = stack >>= S.filter (w /=) hunk ./XMonad/Prompt.hs 76 - XPS { dpy :: !Display + XPS { dpy :: Display addfile ./XMonad/Hooks/Script.hs hunk ./XMonad/Hooks/Script.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.Script +-- Copyright : (c) Trevor Elliott +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Trevor Elliott +-- Stability : unstable +-- Portability : unportable +-- +-- Provides a simple interface for running a ~/.xmonad/hooks script with the +-- name of a hook. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.Script ( + -- * Usage + -- $usage + + -- * Script Hook Interface + execScriptHook + ) where + +-- +-- Useful Imports +-- +import XMonad + +import Control.Monad.Trans +import System.Directory + +-- $usage +-- +-- This module allows you to run a centrally located script with the text +-- name of a hook. The script is assumed to be located at @~\/.xmonad\/hooks@. +-- +-- For example, if you wanted to run the hook "startup" in your script every +-- time your startup hook ran, you could modify your xmonad config as such: +-- +-- > main = xmonad $ defaultConfig { +-- > ... +-- > startupHook = execScriptHook "startup" +-- > ... +-- > } +-- +-- Now, everytime the startup hook runs, the command "~\/.xmonad/hooks startup" +-- will also. + +-- | Execute a named script hook +execScriptHook :: MonadIO m => String -> m () +execScriptHook hook = io $ do + home <- getHomeDirectory + let script = home ++ "/.xmonad/hooks " + spawn (script ++ hook) hunk ./xmonad-contrib.cabal 109 + XMonad.Hooks.Script hunk ./XMonad/Layout/SimpleFloat.hs 65 - doLayout (SF i) sc (S.Stack w l r) = do wrs <- mapM (getSize i sc) (w : reverse l ++ r) - return (wrs, Nothing) hunk ./XMonad/Layout/SimpleFloat.hs 66 + doLayout (SF i) sc (S.Stack w l r) = do + wrs <- mapM (getSize i sc) (w : reverse l ++ r) + return (wrs, Nothing) hunk ./XMonad/Layout/Tabbed.hs 21 + , simpleTabbedAlways, tabbedAlways, addTabsAlways hunk ./XMonad/Layout/Tabbed.hs 23 + , simpleTabbedBottomAlways, tabbedBottomAlways, addTabsBottomAlways hunk ./XMonad/Layout/Tabbed.hs 56 +-- The default Tabbar behaviour is to hide it when only one window is open +-- on the workspace. To have it always shown, use one of the layouts or +-- modifiers ending in "Always". +-- hunk ./XMonad/Layout/Tabbed.hs 73 +-- Layouts + hunk ./XMonad/Layout/Tabbed.hs 83 -simpleTabbed = decoration shrinkText defaultTheme Tabbed Simplest +simpleTabbed = tabbed shrinkText defaultTheme + +simpleTabbedAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window +simpleTabbedAlways = tabbedAlways shrinkText defaultTheme hunk ./XMonad/Layout/Tabbed.hs 90 -simpleTabbedBottom = decoration shrinkText defaultTheme TabbedBottom Simplest +simpleTabbedBottom = tabbedBottom shrinkText defaultTheme + +-- | A bottom-tabbed layout with the default xmonad Theme. +simpleTabbedBottomAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window +simpleTabbedBottomAlways = tabbedBottomAlways shrinkText defaultTheme hunk ./XMonad/Layout/Tabbed.hs 97 --- shrinker and a custom theme. -tabbed :: (Eq a, Shrinker s) => s -> Theme - -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a -tabbed s c = decoration s c Tabbed Simplest +-- shrinker and theme. +tabbed :: (Eq a, Shrinker s) => s -> Theme + -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a +tabbed s c = addTabs s c Simplest + +tabbedAlways :: (Eq a, Shrinker s) => s -> Theme + -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a +tabbedAlways s c = addTabsAlways s c Simplest hunk ./XMonad/Layout/Tabbed.hs 107 --- shrinker and a custom theme. -tabbedBottom :: (Eq a, Shrinker s) => s -> Theme - -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a -tabbedBottom s c = decoration s c TabbedBottom Simplest +-- shrinker and theme. +tabbedBottom :: (Eq a, Shrinker s) => s -> Theme + -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a +tabbedBottom s c = addTabsBottom s c Simplest + +tabbedBottomAlways :: (Eq a, Shrinker s) => s -> Theme + -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a +tabbedBottomAlways s c = addTabsBottomAlways s c Simplest + +-- Layout Modifiers hunk ./XMonad/Layout/Tabbed.hs 118 +-- | A layout modifier that uses the provided shrinker and theme to add tabs to any layout. hunk ./XMonad/Layout/Tabbed.hs 121 -addTabs s c l = decoration s c Tabbed l +addTabs = createTabs WhenPlural Top hunk ./XMonad/Layout/Tabbed.hs 123 +addTabsAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a + -> ModifiedLayout (Decoration TabbedDecoration s) l a +addTabsAlways = createTabs Always Top + +-- | A layout modifier that uses the provided shrinker and theme to add tabs to the bottom of any layout. hunk ./XMonad/Layout/Tabbed.hs 129 - -> ModifiedLayout (Decoration TabbedDecoration s) l a -addTabsBottom s c l = decoration s c TabbedBottom l + -> ModifiedLayout (Decoration TabbedDecoration s) l a +addTabsBottom = createTabs WhenPlural Bottom + +addTabsBottomAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a + -> ModifiedLayout (Decoration TabbedDecoration s) l a +addTabsBottomAlways = createTabs Always Bottom + + +-- Tab creation abstractions. Internal use only. + +-- Create tabbar when required at the given location with the given +-- shrinker and theme to the supplied layout. +createTabs ::(Eq a, LayoutClass l a, Shrinker s) => TabbarShown -> TabbarLocation -> s + -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a +createTabs sh loc tx th l = decoration tx th (Tabbed loc sh) l + +data TabbarLocation = Top | Bottom deriving (Read,Show) + +data TabbarShown = Always | WhenPlural deriving (Read, Show, Eq) hunk ./XMonad/Layout/Tabbed.hs 149 -data TabbedDecoration a = Tabbed | TabbedBottom deriving (Read, Show) +data TabbedDecoration a = Tabbed TabbarLocation TabbarShown deriving (Read, Show) hunk ./XMonad/Layout/Tabbed.hs 152 - describeDeco Tabbed = "Tabbed" - describeDeco TabbedBottom = "Tabbed Bottom" + describeDeco (Tabbed Top _ ) = "Tabbed" + describeDeco (Tabbed Bottom _ ) = "Tabbed Bottom" hunk ./XMonad/Layout/Tabbed.hs 155 - pureDecoration ds _ ht _ s wrs (w,r@(Rectangle x y wh hh)) = - if length ws <= 1 - then Nothing - else Just $ case ds of - Tabbed -> Rectangle nx y wid (fi ht) - TabbedBottom -> Rectangle nx (y+fi(hh-ht)) wid (fi ht) + pureDecoration (Tabbed lc sh) _ ht _ s wrs (w,r@(Rectangle x y wh hh)) + = if ((sh == Always) || length ws > 1) + then Just $ case lc of + Top -> upperTab + Bottom -> lowerTab + else Nothing hunk ./XMonad/Layout/Tabbed.hs 165 - shrink ds (Rectangle _ _ _ dh) (Rectangle x y w h) = case ds of - Tabbed -> Rectangle x (y + fi dh) w (h - dh) - TabbedBottom -> Rectangle x y w (h - dh) + upperTab = Rectangle nx y wid (fi ht) + lowerTab = Rectangle nx (y+fi(hh-ht)) wid (fi ht) + shrink (Tabbed loc _ ) (Rectangle _ _ _ dh) (Rectangle x y w h) + = case loc of + Top -> Rectangle x (y + fi dh) w (h - dh) + Bottom -> Rectangle x y w (h - dh) hunk ./XMonad/Layout/SimpleDecoration.hs 13 --- given layout. +-- given layout. The decorations are in the form of ion-like tabs +-- for window titles. +-- hunk ./XMonad/Config/Dons.hs 1 --------------------------------------------------------------------- --- | --- Module : XMonad.Config.Dons --- Copyright : (c) Galois, Inc. 2007 --- License : BSD3 --- --- Maintainer: Don Stewart --- --- An example, simple configuration file. --- --------------------------------------------------------------------- - -module XMonad.Config.Dons where - -import XMonad -import XMonad.Hooks.DynamicLog -import XMonad.Layout.NoBorders - -donsMain :: IO () -donsMain = dzen $ \x -> xmonad $ x - { terminal = "term" - , normalBorderColor = "#333333" - , focusedBorderColor = "red" - , layoutHook = smartBorders (layoutHook x) - , manageHook = - manageHook x <+> - (className =? "Toplevel" --> doFloat) - } rmfile ./XMonad/Config/Dons.hs hunk ./xmonad-contrib.cabal 101 - XMonad.Config.Dons hunk ./XMonad/Layout/Tabbed.hs 156 - = if ((sh == Always) || length ws > 1) + = if ((sh == Always && numWindows > 0) || numWindows > 1) hunk ./XMonad/Layout/Tabbed.hs 167 + numWindows = length ws hunk ./XMonad/Hooks/Script.hs 11 --- Provides a simple interface for running a ~/.xmonad/hooks script with the +-- Provides a simple interface for running a ~\/.xmonad\/hooks script with the hunk ./XMonad/Hooks/Script.hs 46 --- Now, everytime the startup hook runs, the command "~\/.xmonad/hooks startup" --- will also. +-- Now, everytime the startup hook runs, the command +-- @~\/.xmonad\/hooks startup@ will also. hunk ./XMonad/Hooks/ManageHelpers.hs 11 --- This module provides helper functions to be used in @manageHook@. Here's how you --- might use this: +-- This module provides helper functions to be used in @manageHook@. Here's +-- how you might use this: hunk ./XMonad/Hooks/ManageHelpers.hs 21 +-- > isFullscreen -?> doFullFloat, hunk ./XMonad/Hooks/ManageHelpers.hs 31 + isFullscreen, hunk ./XMonad/Hooks/ManageHelpers.hs 38 + doFullFloat, hunk ./XMonad/Hooks/ManageHelpers.hs 115 +-- | A predicate to check whether a window wants to fill the whole screen. +-- See also 'doFullFloat'. +isFullscreen :: Query Bool +isFullscreen = ask >>= \w -> liftX $ do + dpy <- asks display + state <- getAtom "_NET_WM_STATE" + full <- getAtom "_NET_WM_STATE_FULLSCREEN" + r <- io $ getWindowProperty32 dpy state w + return $ case r of + Just xs -> fromIntegral full `elem` xs + _ -> False + hunk ./XMonad/Hooks/ManageHelpers.hs 158 +-- | Floats the window and makes it use the whole screen. Equivalent to +-- @'doRectFloat' $ 'W.RationalRect' 0 0 1 1@. +doFullFloat :: ManageHook +doFullFloat = doRectFloat $ W.RationalRect 0 0 1 1 hunk ./XMonad/Layout/Gaps.hs 96 - | ToggleGap Direction -- ^ Toggle a single gap. - | IncGap Int Direction -- ^ Increase a gap by a certain number of pixels. - | DecGap Int Direction -- ^ Decrease a gap. + | ToggleGap !Direction -- ^ Toggle a single gap. + | IncGap !Int !Direction -- ^ Increase a gap by a certain number of pixels. + | DecGap !Int !Direction -- ^ Decrease a gap. addfile ./XMonad/Layout/SimplestFloat.hs hunk ./XMonad/Layout/SimplestFloat.hs 1 - +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.SimplestFloat +-- Copyright : (c) 2008 Jussi Mäki +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : joamaki@gmail.com +-- Stability : unstable +-- Portability : unportable +-- +-- A basic floating layout like SimpleFloat but without the decoration. +----------------------------------------------------------------------------- + +module XMonad.Layout.SimplestFloat + ( -- * Usage: + -- $usage + simplestFloat + , SimplestFloat + ) where + +import XMonad +import qualified XMonad.StackSet as S +import XMonad.Layout.WindowArranger +import XMonad.Layout.LayoutModifier + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.SimplestFloat +-- +-- Then edit your @layoutHook@ by adding the SimplestFloat layout: +-- +-- > myLayouts = simplestFloat ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +-- | A simple floating layout where every window is placed according +-- to the window's initial attributes. +simplestFloat :: Eq a => (ModifiedLayout WindowArranger SimplestFloat) a +simplestFloat = (windowArrangeAll $ SF) + +data SimplestFloat a = SF deriving (Show, Read) +instance LayoutClass SimplestFloat Window where + doLayout SF sc (S.Stack w l r) = do wrs <- mapM (getSize sc) (w : reverse l ++ r) + return (wrs, Nothing) + description _ = "SimplestFloat" + +getSize :: Rectangle -> Window -> X (Window,Rectangle) +getSize (Rectangle rx ry _ _) w = do + d <- asks display + bw <- asks (borderWidth . config) + wa <- io $ getWindowAttributes d w + let x = max rx $ fi $ wa_x wa + y = max ry $ fi $ wa_y wa + wh = (fi $ wa_width wa) + (bw * 2) + ht = (fi $ wa_height wa) + (bw * 2) + return (w, Rectangle x y wh ht) + where + fi x = fromIntegral x hunk ./xmonad-contrib.cabal 159 + XMonad.Layout.SimplestFloat hunk ./xmonad-contrib.cabal 100 - XMonad.Config.Sjanssen hunk ./xmonad-contrib.cabal 102 + XMonad.Config.Sjanssen addfile ./XMonad/Config/Desktop.hs hunk ./XMonad/Config/Desktop.hs 1 +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Config.Desktop +-- Copyright : (c) Spencer Janssen +-- License : BSD +-- +-- Maintainer : Spencer Janssen +-- +-- This module provides a config suitable for use with a desktop +-- environment such as KDE or GNOME. + +module XMonad.Config.Desktop ( + -- * Usage + -- -- $usage + desktopConfig, + desktopLayoutModifiers + ) where + +import XMonad +import XMonad.Config (defaultConfig) +import XMonad.Hooks.ManageDocks +import XMonad.Hooks.EwmhDesktops + +desktopConfig = defaultConfig + { logHook = ewmhDesktopsLogHook + , layoutHook = desktopLayoutModifiers $ layoutHook defaultConfig + , manageHook = manageHook defaultConfig <+> manageDocks + } + +desktopLayoutModifiers = avoidStruts . ewmhDesktopsLayout + addfile ./XMonad/Config/Gnome.hs hunk ./XMonad/Config/Gnome.hs 1 +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Config.Gnome +-- Copyright : (c) Spencer Janssen +-- License : BSD +-- +-- Maintainer : Spencer Janssen +-- +-- This module provides a config suitable for use with the GNOME desktop +-- environment. + +module XMonad.Config.Gnome ( + -- * Usage + -- -- $usage + gnomeConfig + ) where + +import XMonad +import XMonad.Config.Desktop + +-- $usage +-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad +-- > import XMonad.Config.Gnome +-- > +-- > main = xmonad gnomeConfig +-- + +gnomeConfig = desktopConfig { terminal = "gnome-terminal" } hunk ./xmonad-contrib.cabal 101 + XMonad.Config.Desktop hunk ./xmonad-contrib.cabal 103 + XMonad.Config.Gnome hunk ./XMonad/Layout/Decoration.hs 256 - | Just e <- fromMessage m :: Maybe Event = do decorationEventHook ds s e + | Just e <- fromMessage m = do decorationEventHook ds s e hunk ./XMonad/Config/Sjanssen.hs 33 - , manageHook = manageHook defaultConfig <+> manageDocks + , manageHook = composeAll [className =? x --> doF (W.shift w) + | (x, w) <- [ ("Firefox", "web"), ("Pidgin", "im") + , ("Ktorrent", "7")]] + <+> manageHook defaultConfig <+> manageDocks hunk ./XMonad/Hooks/DynamicLog.hs 431 - , ppTitle = xmobarColor "#00ee00" "" . shorten 80 + , ppTitle = xmobarColor "#00ee00" "" . shorten 120 hunk ./XMonad/Layout/Decoration.hs 279 - , w `elem` (map (fst . fst) dwrs) = updateDecos sh t fs dwrs + , Just i <- w `elemIndex` (map (fst . fst) dwrs) = updateDeco sh t fs (dwrs !! i) hunk ./XMonad/Layout/Decoration.hs 281 - , w `elem` (catMaybes $ map (fst . snd) dwrs) = updateDecos sh t fs dwrs + , Just i <- w `elemIndex` (catMaybes $ map (fst . snd) dwrs) = updateDeco sh t fs (dwrs !! i) hunk ./XMonad/Util/NamedWindows.hs 47 + -- TODO, this code is ugly and convoluted -- clean it up hunk ./XMonad/Util/NamedWindows.hs 53 - copy prop = head `fmap` wcTextPropertyToTextList d prop + copy prop = do + xs <- wcTextPropertyToTextList d prop + return $ case xs of + [] -> "" + (x:_) -> x hunk ./XMonad/Hooks/UrgencyHook.hs 124 +-- +-- Update: I'm a doofus. Thanks to arossato's EventHook I see that the "9-10 +-- times" thing was an Urgencyhook bug. If you fix it, and make UrgencyHook +-- ICCCM-compliant, you will win a prize. hunk ./XMonad/Util/NamedWindows.hs 26 +import Control.Applicative ( (<$>) ) hunk ./XMonad/Util/NamedWindows.hs 28 +import Data.Maybe ( fromMaybe, listToMaybe ) hunk ./XMonad/Util/NamedWindows.hs 55 - copy prop = do - xs <- wcTextPropertyToTextList d prop - return $ case xs of - [] -> "" - (x:_) -> x + copy prop = fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop hunk ./XMonad/Layout/DwmStyle.hs 54 +-- +-- A complete xmonad.hs file for this would therefore be: +-- +-- > import XMonad +-- > import XMonad.Layout.DwmStyle +-- > +-- > main = xmonad defaultConfig { +-- > layoutHook = +-- > dwmStyle shrinkText defaultTheme +-- > (layoutHook defaultConfig) +-- > } +-- + hunk ./XMonad/Layout/WindowArranger.hs 2 -{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE PatternGuards #-} +{-# FlexibleInstancesi #-} +{-# MultiParamTypeClasses #-} +{-# TypeSynonymInstances #-} hunk ./XMonad/Layout/WindowArranger.hs 2 -{-# LANGUAGE PatternGuards #-} -{-# FlexibleInstancesi #-} -{-# MultiParamTypeClasses #-} -{-# TypeSynonymInstances #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeSynonymInstances #-} hunk ./XMonad/Actions/UpdatePointer.hs 55 --- window unless it's already there +-- window unless it's already there, or unless the user was changing +-- focus with the mouse hunk ./XMonad/Actions/UpdatePointer.hs 61 + mouseIsMoving <- asks mouseFocused hunk ./XMonad/Actions/UpdatePointer.hs 65 - unless (w == w') $ + unless (w == w' || mouseIsMoving) $ addfile ./XMonad/Config/Kde.hs hunk ./XMonad/Config/Kde.hs 1 +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Config.Kde +-- Copyright : (c) Spencer Janssen +-- License : BSD +-- +-- Maintainer : Spencer Janssen +-- +-- This module provides a config suitable for use with the KDE desktop +-- environment. + +module XMonad.Config.Kde ( + -- * Usage + -- -- $usage + kdeConfig + ) where + +import XMonad +import XMonad.Config.Desktop + +-- $usage +-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad +-- > import XMonad.Config.Kde +-- > +-- > main = xmonad kdeConfig +-- + +kdeConfig = desktopConfig { terminal = "konsole" } hunk ./xmonad-contrib.cabal 104 + XMonad.Config.Kde hunk ./XMonad/Config/Sjanssen.hs 32 - , layoutHook = avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTheme) + , layoutHook = modifiers layouts hunk ./XMonad/Config/Sjanssen.hs 39 - tiled = HintedTile 1 0.03 0.5 TopLeft + tiled = HintedTile 1 0.03 0.5 TopLeft + layouts = (tiled Tall ||| (tiled Wide ||| Full)) ||| tabbed shrinkText myTheme + modifiers = avoidStruts . smartBorders hunk ./XMonad/Config/Desktop.hs 26 +import qualified Data.Map as M + hunk ./XMonad/Config/Desktop.hs 32 + , keys = \c -> desktopKeys c `M.union` keys defaultConfig c hunk ./XMonad/Config/Desktop.hs 35 +desktopKeys (XConfig {modMask = modm}) = M.fromList $ + [ ((modm, xK_b), sendMessage ToggleStruts) ] + hunk ./XMonad/Config/Desktop.hs 29 - { logHook = ewmhDesktopsLogHook - , layoutHook = desktopLayoutModifiers $ layoutHook defaultConfig - , manageHook = manageHook defaultConfig <+> manageDocks - , keys = \c -> desktopKeys c `M.union` keys defaultConfig c - } + { logHook = ewmhDesktopsLogHook + , layoutHook = desktopLayoutModifiers $ layoutHook defaultConfig + , manageHook = manageHook defaultConfig <+> manageDocks + , keys = \c -> desktopKeys c `M.union` keys defaultConfig c } hunk ./XMonad/Config/Kde.hs 23 +import qualified Data.Map as M + hunk ./XMonad/Config/Kde.hs 34 -kdeConfig = desktopConfig { terminal = "konsole" } +kdeConfig = desktopConfig + { terminal = "konsole" + , keys = \c -> kdeKeys c `M.union` keys desktopConfig c } + +kdeKeys (XConfig {modMask = modm}) = M.fromList $ + [ ((modm, xK_p), spawn "dcop kdesktop default popupExecuteCommand") + , ((modm .|. shiftMask, xK_q), spawn "dcop kdesktop default logout") + ] hunk ./XMonad/Config/Gnome.hs 17 - gnomeConfig + gnomeConfig, + gnomeRun hunk ./XMonad/Config/Gnome.hs 24 +import qualified Data.Map as M + hunk ./XMonad/Config/Gnome.hs 35 -gnomeConfig = desktopConfig { terminal = "gnome-terminal" } +gnomeConfig = desktopConfig + { terminal = "gnome-terminal" + , keys = \c -> gnomeKeys c `M.union` keys desktopConfig c } + +gnomeKeys (XConfig {modMask = modm}) = M.fromList $ + [ ((modm, xK_p), gnomeRun) ] + +-- | Launch the "Run Application" dialog. gnome-panel must be running for this +-- to work. +gnomeRun :: X () +gnomeRun = withDisplay $ \dpy -> do + rw <- asks theRoot + gnome_panel <- getAtom "_GNOME_PANEL_ACTION" + panel_run <- getAtom "_GNOME_PANEL_ACTION_RUN_DIALOG" + + io $ allocaXEvent $ \e -> do + setEventType e clientMessage + setClientMessageEvent e rw gnome_panel 32 panel_run 0 + sendEvent dpy rw False structureNotifyMask e + sync dpy False hunk ./XMonad/Config/Desktop.hs 39 - hunk ./XMonad/Layout/HintedTile.hs 35 --- > myLayouts = HintedTile 1 0.1 0.5 TopLeft Tall ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = hintedTile Tall ||| hintedTile Wide ||| Full ||| etc.. +-- > where +-- > tiled = HintedTile nmaster delta ratio TopLeft +-- > nmaster = 1 +-- > ratio = 1/2 +-- > delta = 3/100 +-- > main = xmonad defaultConfig { layoutHook = myLayout } +-- +-- Because both Xmonad and Xmonad.Layout.HintedTile define Tall, +-- you need to disambiguate Tall. If you are replacing the +-- built-in Tall with HintedTile, change @import Xmonad@ to +-- @import Xmonad hiding (Tall)@. hunk ./XMonad/Layout/HintedTile.hs 55 - , alignment :: !Alignment + , alignment :: !Alignment -- ^ Where to place windows that are smaller + -- than their preordained rectangles. hunk ./XMonad/Layout/HintedTile.hs 60 -data Orientation = Wide | Tall +data Orientation + = Wide -- ^ Lay out windows similarly to Mirror tiled. + | Tall -- ^ Lay out windows similarly to tiled. hunk ./XMonad/Hooks/EwmhDesktops.hs 203 - let w = fromMaybe 0 (W.peek s) + let w = fromMaybe none (W.peek s) hunk ./XMonad/Config/Gnome.hs 40 - [ ((modm, xK_p), gnomeRun) ] + [ ((modm, xK_p), gnomeRun) + , ((modm .|. shiftMask, xK_q), spawn "gnome-session-save --kill") ] hunk ./XMonad/Layout/HintedTile.hs 37 --- > tiled = HintedTile nmaster delta ratio TopLeft --- > nmaster = 1 --- > ratio = 1/2 --- > delta = 3/100 +-- > hintedTile = HintedTile nmaster delta ratio TopLeft +-- > nmaster = 1 +-- > ratio = 1/2 +-- > delta = 3/100 hunk ./XMonad/Config/Arossato.hs 28 -import XMonad.Hooks.DynamicLog +import XMonad.Hooks.DynamicLog hiding (xmobar) hunk ./XMonad/Config/Sjanssen.hs 11 -import XMonad.Hooks.DynamicLog +import XMonad.Hooks.DynamicLog hiding (xmobar) hunk ./XMonad/Hooks/DynamicLog.hs 25 + xmobar, hunk ./XMonad/Hooks/DynamicLog.hs 84 +-- Also you can use 'xmobar' function instead of 'dzen' in the examples above, +-- if you have xmobar installed. +-- hunk ./XMonad/Hooks/DynamicLog.hs 157 --- handle screen placement for dzen, and enables 'mod-b' for toggling +-- handle screen placement for dzen, and enables 'mod-b' for toggling hunk ./XMonad/Hooks/DynamicLog.hs 170 - ,keys = \c -> mykeys c `M.union` keys defaultConfig c + ,keys = \c -> toggleStrutsKey c `M.union` keys defaultConfig c hunk ./XMonad/Hooks/DynamicLog.hs 174 - mykeys (XConfig{modMask=modm}) = M.fromList - [((modm, xK_b ), sendMessage ToggleStruts) - ] hunk ./XMonad/Hooks/DynamicLog.hs 178 + +-- | Run xmonad with a xmobar status bar set to some nice defaults. Output +-- is taken from the dynamicLogWithPP hook. +-- +-- > main = xmobar xmonad +-- +-- This works pretty much the same as 'dzen' function above +-- +xmobar :: + (XConfig + (ModifiedLayout AvoidStruts + (Choose Tall (Choose (Mirror Tall) Full))) -> IO t) -> IO t +xmobar f = do + h <- spawnPipe "xmobar" + f $ defaultConfig + { logHook = dynamicLogWithPP xmobarPP { ppOutput = hPutStrLn h } + , layoutHook = avoidStruts $ layoutHook defaultConfig + , keys = \c -> toggleStrutsKey c `M.union` keys defaultConfig c + , manageHook = manageHook defaultConfig <+> manageDocks + } + +-- | +-- Helper function which provides ToggleStruts keybinding +-- +toggleStrutsKey :: XConfig t -> M.Map (KeyMask, KeySym) (X ()) +toggleStrutsKey XConfig{modMask = modm} = M.fromList + [ ((modm, xK_b ), sendMessage ToggleStruts) ] + hunk ./XMonad/Hooks/UrgencyHook.hs 35 -import XMonad.Layout.LayoutModifier hiding (hook) +import XMonad.Hooks.EventHook hunk ./XMonad/Hooks/UrgencyHook.hs 40 -import Data.Bits (testBit, clearBit) +import Data.Bits (testBit) hunk ./XMonad/Hooks/UrgencyHook.hs 70 -withUrgencyHook :: (LayoutClass l Window, UrgencyHook h Window) => - h -> XConfig l -> XConfig (ModifiedLayout (WithUrgencyHook h) l) +withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) => + h -> XConfig l -> XConfig (HandleEvent (WithUrgencyHook h) l) hunk ./XMonad/Hooks/UrgencyHook.hs 106 -data WithUrgencyHook h a = WithUrgencyHook h deriving (Read, Show) +data WithUrgencyHook h = WithUrgencyHook h deriving (Read, Show) hunk ./XMonad/Hooks/UrgencyHook.hs 111 --- 1. Several clients (e.g. Xchat2, rxvt-unicode) set the urgency flag --- 9 or 10 times in a row. This would, in turn, trigger urgencyHook repeatedly. --- so in order to prevent that, we immediately clear the urgency flag. --- 2. In normal window managers, windows may overlap, so clients wait for focus to +-- 1. In normal window managers, windows may overlap, so clients wait for focus to hunk ./XMonad/Hooks/UrgencyHook.hs 114 --- 3. The urgentOnBell setting in rxvt-unicode sets urgency even when the window +-- 2. The urgentOnBell setting in rxvt-unicode sets urgency even when the window hunk ./XMonad/Hooks/UrgencyHook.hs 116 --- In order to account for these quirks, we clear the urgency bit immediately upon --- receiving notification (thus suppressing the repeated notifications) and track --- the list of urgent windows ourselves, allowing us to clear urgency when a window --- is visible, and not to set urgency if a window is visible. --- If you have a better idea, please, let us know! --- --- Update: I'm a doofus. Thanks to arossato's EventHook I see that the "9-10 --- times" thing was an Urgencyhook bug. If you fix it, and make UrgencyHook --- ICCCM-compliant, you will win a prize. -instance UrgencyHook h Window => LayoutModifier (WithUrgencyHook h) Window where - handleMess (WithUrgencyHook hook) mess - | Just PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } <- fromMessage mess = do +-- In order to account for these quirks, we track the list of urgent windows +-- ourselves, allowing us to clear urgency when a window is visible, and not to +-- set urgency if a window is visible. If you have a better idea, please, let us +-- know! +instance UrgencyHook h => EventHook (WithUrgencyHook h) where + handleEvent (WithUrgencyHook hook) event = + case event of + PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do hunk ./XMonad/Hooks/UrgencyHook.hs 125 - wmh@WMHints { wmh_flags = flags } <- io $ getWMHints dpy w - when (testBit flags urgencyHintBit) $ do + WMHints { wmh_flags = flags } <- io $ getWMHints dpy w + if (testBit flags urgencyHintBit) then do hunk ./XMonad/Hooks/UrgencyHook.hs 129 - -- Clear the bit to prevent repeated notifications, as described above. - io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit } hunk ./XMonad/Hooks/UrgencyHook.hs 133 - return Nothing - | Just DestroyWindowEvent {ev_window = w} <- fromMessage mess = do + else do + -- Remove from list of urgents. + adjustUrgents (delete w) + -- Call logHook after IORef has been modified. + userCode =<< asks (logHook . config) + DestroyWindowEvent {ev_window = w} -> do hunk ./XMonad/Hooks/UrgencyHook.hs 140 - return Nothing - | otherwise = - return Nothing + _ -> + return () hunk ./XMonad/Hooks/UrgencyHook.hs 146 -urgencyLayoutHook :: (UrgencyHook h Window, LayoutClass l Window) => - h -> l Window -> ModifiedLayout (WithUrgencyHook h) l Window -urgencyLayoutHook hook = ModifiedLayout $ WithUrgencyHook hook +urgencyLayoutHook :: (UrgencyHook h, LayoutClass l Window) => + h -> l Window -> HandleEvent (WithUrgencyHook h) l Window +urgencyLayoutHook hook = eventHook $ WithUrgencyHook hook hunk ./XMonad/Hooks/UrgencyHook.hs 155 -class (Read h, Show h) => UrgencyHook h a where - urgencyHook :: h -> a -> X () +class (Read h, Show h) => UrgencyHook h where + urgencyHook :: h -> Window -> X () hunk ./XMonad/Hooks/UrgencyHook.hs 160 -instance UrgencyHook NoUrgencyHook Window where +instance UrgencyHook NoUrgencyHook where hunk ./XMonad/Hooks/UrgencyHook.hs 166 -instance UrgencyHook DzenUrgencyHook Window where +instance UrgencyHook DzenUrgencyHook where hunk ./XMonad/Hooks/UrgencyHook.hs 184 -instance UrgencyHook StdoutUrgencyHook Window where +instance UrgencyHook StdoutUrgencyHook where hunk ./XMonad/Hooks/UrgencyHook.hs 27 + SpawnUrgencyHook(..), hunk ./XMonad/Hooks/UrgencyHook.hs 182 +-- | Spawn a commandline thing, appending the window id to the prefix string +-- you provide. (Make sure to add a space if you need it.) Do your crazy compiz +-- thing. +newtype SpawnUrgencyHook = SpawnUrgencyHook String deriving (Read, Show) + +instance UrgencyHook SpawnUrgencyHook where + urgencyHook (SpawnUrgencyHook prefix) w = spawn $ prefix ++ show w + hunk ./XMonad/Hooks/UrgencyHook.hs 30 - seconds + whenNotVisible, seconds hunk ./XMonad/Hooks/UrgencyHook.hs 156 +-- | Convenience method for those writing UrgencyHooks. +whenNotVisible :: Window -> X () -> X () +whenNotVisible w act = do + visibles <- gets mapped + when (not $ S.member w visibles) act + hunk ./XMonad/Hooks/UrgencyHook.hs 175 - visibles <- gets mapped hunk ./XMonad/Hooks/UrgencyHook.hs 177 - whenJust (W.findTag w ws) (flash name visibles) - where flash name visibles index = - when (not $ S.member w visibles) $ + whenJust (W.findTag w ws) (flash name) + where flash name index = + whenNotVisible w $ hunk ./XMonad/Hooks/UrgencyHook.hs 188 --- you provide. (Make sure to add a space if you need it.) Do your crazy compiz --- thing. +-- you provide. (Make sure to add a space if you need it.) Do your crazy +-- xcompmgr thing. hunk ./XMonad/Layout/WindowNavigation.hs 130 - (\d -> truncHead $ sortby d $ filter (inr d pt . snd) wrs) [U,D,R,L] + (\d -> truncHead $ navigable d pt wrs) [U,D,R,L] hunk ./XMonad/Layout/WindowNavigation.hs 133 - truncHead $ sortby d $ filter (inr d pt . snd) wrs) [U,D,R,L] + truncHead $ navigable d pt wrs) [U,D,R,L] hunk ./XMonad/Layout/WindowNavigation.hs 142 - case sortby d $ filter (inr d pt . snd) wrs of + case navigable d pt wrs of hunk ./XMonad/Layout/WindowNavigation.hs 158 - case sortby d $ filter (inr d pt . snd) wrs of + case navigable d pt wrs of hunk ./XMonad/Layout/WindowNavigation.hs 174 - case sortby d $ filter (inr d pt . snd) wrs of + case navigable d pt wrs of hunk ./XMonad/Layout/WindowNavigation.hs 187 +navigable :: Direction -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] +navigable d pt = sortby d . filter (inr d pt . snd) + hunk ./XMonad/Hooks/UrgencyHook.hs 30 - whenNotVisible, seconds + whenShouldTrigger, seconds, + SuppressWhen(..) hunk ./XMonad/Hooks/UrgencyHook.hs 157 +-- TODO: factor SuppressWhen stuff into WithUrgencyHook + +data SuppressWhen = Visible | OnScreen | Focused | Never deriving (Read, Show) + +shouldSuppress :: SuppressWhen -> Window -> X Bool +shouldSuppress Visible w = gets $ S.member w . mapped +shouldSuppress OnScreen w = gets $ elem w . W.index . windowset +shouldSuppress Focused w = gets $ maybe False (w ==) . W.peek . windowset +shouldSuppress Never _ = return False + hunk ./XMonad/Hooks/UrgencyHook.hs 168 -whenNotVisible :: Window -> X () -> X () -whenNotVisible w act = do - visibles <- gets mapped - when (not $ S.member w visibles) act +whenShouldTrigger :: SuppressWhen -> Window -> X () -> X () +whenShouldTrigger sw w = whenX (not `fmap` shouldSuppress sw w) hunk ./XMonad/Hooks/UrgencyHook.hs 179 -data DzenUrgencyHook = DzenUrgencyHook { duration :: Int, args :: [String] } - deriving (Read, Show) +data DzenUrgencyHook = DzenUrgencyHook { duration :: Int, + args :: [String], + suppressWhen :: SuppressWhen } + deriving (Read, Show) hunk ./XMonad/Hooks/UrgencyHook.hs 185 - urgencyHook DzenUrgencyHook { duration = d, args = a } w = do + urgencyHook DzenUrgencyHook { duration = d, args = a, suppressWhen = sw } w = do hunk ./XMonad/Hooks/UrgencyHook.hs 190 - whenNotVisible w $ + whenShouldTrigger sw w $ hunk ./XMonad/Hooks/UrgencyHook.hs 194 --- duration and args to dzen. +-- duration and args to dzen, and when to suppress the urgency flash. hunk ./XMonad/Hooks/UrgencyHook.hs 196 -dzenUrgencyHook = DzenUrgencyHook { duration = (5 `seconds`), args = [] } +dzenUrgencyHook = DzenUrgencyHook { duration = (5 `seconds`), args = [], suppressWhen = Visible } hunk ./XMonad/Hooks/UrgencyHook.hs 30 - whenShouldTrigger, seconds, + seconds, hunk ./XMonad/Hooks/UrgencyHook.hs 130 - userCode $ urgencyHook hook w + callUrgencyHook hook w hunk ./XMonad/Hooks/UrgencyHook.hs 133 - -- Call logHook after IORef has been modified. - userCode =<< asks (logHook . config) hunk ./XMonad/Hooks/UrgencyHook.hs 136 - -- Call logHook after IORef has been modified. - userCode =<< asks (logHook . config) + -- Call logHook after IORef has been modified. + userCode =<< asks (logHook . config) hunk ./XMonad/Hooks/UrgencyHook.hs 150 --------------------------------------------------------------------------------- --- Urgency Hooks - --- | The class definition, and some pre-defined instances. - --- TODO: factor SuppressWhen stuff into WithUrgencyHook +callUrgencyHook :: UrgencyHook h => h -> Window -> X () +callUrgencyHook hook w = + whenX (not `fmap` shouldSuppress (suppressWhenSetting hook) w) + (userCode $ urgencyHook hook w) hunk ./XMonad/Hooks/UrgencyHook.hs 163 --- | Convenience method for those writing UrgencyHooks. -whenShouldTrigger :: SuppressWhen -> Window -> X () -> X () -whenShouldTrigger sw w = whenX (not `fmap` shouldSuppress sw w) +-------------------------------------------------------------------------------- +-- Urgency Hooks + +-- | The class definition, and some pre-defined instances. hunk ./XMonad/Hooks/UrgencyHook.hs 171 + suppressWhenSetting :: h -> SuppressWhen + suppressWhenSetting _ = Visible + hunk ./XMonad/Hooks/UrgencyHook.hs 185 - urgencyHook DzenUrgencyHook { duration = d, args = a, suppressWhen = sw } w = do + urgencyHook DzenUrgencyHook { duration = d, args = a } w = do hunk ./XMonad/Hooks/UrgencyHook.hs 190 - whenShouldTrigger sw w $ hunk ./XMonad/Hooks/UrgencyHook.hs 192 + suppressWhenSetting = suppressWhen + addfile ./XMonad/Actions/AppLauncher.hs hunk ./XMonad/Actions/AppLauncher.hs 1 +{- | + Module : XMonad.Actions.AppLauncher + Copyright : (C) 2008 Luis Cabellos + License : None; public domain + + Maintainer : + Stability : unstable + Portability : unportable + + A module for launch applicationes that receive parameters in the command line. + The launcher call a prompt to get the parameters. +-} +module XMonad.Actions.AppLauncher ( -- * Usage + -- $usage + launchApp + + -- * Use case: launching gimp with file + -- $tip + ) where + +import XMonad (X(),MonadIO) +import XMonad.Core (spawn) +import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig()) +import XMonad.Prompt.Shell (getShellCompl) + +{- $usage + This module is intended to allow the launch of the same application + but changing the parameters using the user response. For example, when + you want to open a image in gimp program, you can open gimp and then use + the File Menu to open the image or you can use this module to select + the image in the command line. + + We use Prompt to get the user command line. This also allow to autoexpand + the names of the files when we are writing the command line. + -} + +{- $tip + +First, you need to import necessary modules. Prompt is used to get the promp +configuration and the AppLauncher module itself. + +> import XMonad.Prompt +> import XMonad.Actions.AppLauncher as AL + +Then you can add the bindings to the applications. + +> ... +> , ((modm, xK_g), AL.launchApp defaultXPConfig "gimp" ) +> , ((modm, xK_g), AL.launchApp defaultXPConfig "evince" ) +> ... + + -} + +-- A customized prompt +data AppPrompt = AppPrompt String +instance XPrompt AppPrompt where + showXPrompt (AppPrompt n) = n ++ " " + +type Application = String +type Parameters = String + +{- | Given an application and its parameters, launch the application. -} +launch :: MonadIO m => Application -> Parameters -> m () +launch app params = spawn ( app ++ " " ++ params ) + + +{- | Get the user's response to a prompt an launch an application using the + input as command parameters of the application.-} +launchApp :: XPConfig -> Application -> X () +launchApp config app = mkXPrompt (AppPrompt app) config (getShellCompl []) $ launch app hunk ./xmonad-contrib.cabal 70 + XMonad.Actions.AppLauncher addfile ./XMonad/Actions/WindowNavigation.hs hunk ./XMonad/Actions/WindowNavigation.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.WindowNavigation +-- Copyright : (c) 2007 David Roundy , +-- Devin Mullins +-- Maintainer : Devin Mullins +-- License : BSD3-style (see LICENSE) +-- +-- This is a rewrite of "XMonad.Layout.WindowNavigation", for the purposes of +-- code cleanup and Xinerama support. It's not complete, so you'll want to +-- use that one for now. +-- +-- WindowNavigation lets you assign keys to move up/down/left/right, based on +-- actual window geometry, rather than just going j/k on the stack. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.WindowNavigation ( + -- * Usage + -- $usage + go, swap, + Direction(..) + ) where + +import XMonad +import XMonad.Hooks.ManageDocks (Direction(..)) +import qualified XMonad.StackSet as W + +import Control.Applicative ((<$>)) +import Data.IORef +import Data.List (sortBy) +import Data.Maybe (catMaybes, fromMaybe, listToMaybe) +import Graphics.X11.Xlib + +-- $usage +-- +-- Don't use it! What, are you crazy? + +-- TODO: IORef should be a map from WorkspaceId to Point +-- TODO: solve the 2+3, middle right to bottom left problem +-- logHook to update currentPosition? + +-- go: +-- 1. get current position, verifying it matches the current window +-- 2. get target windowrect +-- 3. focus window +-- 4. set new position + +-- key bindings to do the important stuff + +-- 1. Get current position, window +-- 2. Determine list of windows in dir from pos, except window +-- 3. Grab closest one + +go :: IORef (Maybe Point) -> Direction -> X () +go posRef dir = fromCurrentPoint $ \win pos -> do + targets <- filter ((/= win) . fst) <$> navigableTargets pos dir + io $ putStrLn $ "pos: " ++ show pos ++ "; tgts: " ++ show targets + whenJust (listToMaybe targets) $ \(tw, tr) -> do + windows (W.focusWindow tw) + setPosition posRef pos tr + where fromCurrentPoint f = withFocused $ \win -> do + currentPosition posRef >>= f win + +swap :: IORef (Maybe Point) -> Direction -> X () +swap _ _ = return () + +-- Gets the current position from the IORef passed in, or if nothing (say, from +-- a restart), derives the current position from the current window. Also, +-- verifies that the position is congruent with the current window (say, if you +-- used mod-j/k or mouse or something). +-- TODO: replace 0 0 0 0 with 'middle of current window' +-- TODO: correct if not in window, or add logHook +currentPosition :: IORef (Maybe Point) -> X Point +currentPosition posRef = do + mp <- io $ readIORef posRef + return $ fromMaybe (Point 0 0) mp + +navigableTargets :: Point -> Direction -> X [(Window, Rectangle)] +navigableTargets point dir = navigable dir point <$> windowRects + +setPosition :: IORef (Maybe Point) -> Point -> Rectangle -> X () +setPosition posRef _ (Rectangle x y w h) = + let position = Point (x + (fromIntegral w `div` 2)) (y + (fromIntegral h `div` 2)) in + io $ writeIORef posRef (Just position) + +-- Filters and sorts the windows in terms of what is closest from the Point in +-- the Direction. +navigable :: Direction -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] +navigable d pt = sortby d . filter (inr d (fromPoint pt) . snd) + +-- Produces a list of normal-state windows, on any screen. Rectangles are +-- adjusted based on screen position relative to the current screen, because I'm +-- bad like that. +-- TODO: only the visible windows +-- TODO: adjust rectangles based on screen position :P +windowRects :: X [(Window, Rectangle)] +windowRects = do + dpy <- asks display + wins <- gets (visibleWindows . windowset) + catMaybes <$> mapM (windowRect dpy) wins + where visibleWindows wset = concatMap (W.integrate' . W.stack . W.workspace) + (W.current wset : W.visible wset) + +windowRect :: Display -> Window -> X (Maybe (Window, Rectangle)) +windowRect dpy win = do + (_, x, y, w, h, _, _) <- io $ getGeometry dpy win + return $ Just $ (win, Rectangle x y w h) + `catchX` return Nothing + +-- manageHook to draw window decos? + +fromPoint :: Point -> FPoint +fromPoint p = P (fromIntegral $ pt_x p) (fromIntegral $ pt_y p) + +-- Stolen from droundy's implementation of WindowNavigation. I should probably take the time +-- to understand the black magic below at some point. + +data FPoint = P Double Double + +inr :: Direction -> FPoint -> Rectangle -> Bool +inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + y < fromIntegral yr + fromIntegral h +inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + y > fromIntegral yr +inr R (P a x) (Rectangle b l _ w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + a < fromIntegral b +inr L (P a x) (Rectangle b l c w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + a > fromIntegral b + fromIntegral c + +sortby :: Direction -> [(a,Rectangle)] -> [(a,Rectangle)] +sortby U = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y' y) +sortby D = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y y') +sortby R = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x x') +sortby L = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x' x) hunk ./xmonad-contrib.cabal 99 + XMonad.Actions.WindowNavigation hunk ./XMonad/Actions/WindowNavigation.hs 14 --- actual window geometry, rather than just going j/k on the stack. +-- actual cartesian window coordinates, rather than just going j/k on the stack. hunk ./XMonad/Actions/WindowNavigation.hs 96 --- TODO: adjust rectangles based on screen position :P +-- TODO: adjust rectangles based on screen position? (perhaps this is already handled) hunk ./XMonad/Actions/WindowNavigation.hs 32 +import Data.Map (Map()) +import qualified Data.Map as M hunk ./XMonad/Actions/WindowNavigation.hs 41 --- TODO: IORef should be a map from WorkspaceId to Point hunk ./XMonad/Actions/WindowNavigation.hs 52 +type WNState = Map WorkspaceId Point + hunk ./XMonad/Actions/WindowNavigation.hs 58 -go :: IORef (Maybe Point) -> Direction -> X () +go :: IORef WNState -> Direction -> X () hunk ./XMonad/Actions/WindowNavigation.hs 68 -swap :: IORef (Maybe Point) -> Direction -> X () +swap :: IORef WNState -> Direction -> X () hunk ./XMonad/Actions/WindowNavigation.hs 77 -currentPosition :: IORef (Maybe Point) -> X Point +currentPosition :: IORef WNState -> X Point hunk ./XMonad/Actions/WindowNavigation.hs 79 - mp <- io $ readIORef posRef + wsid <- gets (W.tag . W.workspace . W.current . windowset) + mp <- M.lookup wsid <$> io (readIORef posRef) hunk ./XMonad/Actions/WindowNavigation.hs 86 -setPosition :: IORef (Maybe Point) -> Point -> Rectangle -> X () -setPosition posRef _ (Rectangle x y w h) = - let position = Point (x + (fromIntegral w `div` 2)) (y + (fromIntegral h `div` 2)) in - io $ writeIORef posRef (Just position) +setPosition :: IORef WNState -> Point -> Rectangle -> X () +setPosition posRef _ (Rectangle x y w h) = do + wsid <- gets (W.tag . W.workspace . W.current . windowset) + let position = Point (x + (fromIntegral w `div` 2)) (y + (fromIntegral h `div` 2)) + io $ modifyIORef posRef $ M.insert wsid position hunk ./XMonad/Actions/WindowNavigation.hs 41 --- TODO: solve the 2+3, middle right to bottom left problem --- logHook to update currentPosition? +-- TODO: +-- - withWindowNavigation :: XConfig l -> XConfig l +-- - cleanup +-- - actually deal with multiple screens +-- - documentation :) +-- - tests? (esp. for edge cases in currentPosition) +-- - solve the 2+3, middle right to bottom left problem hunk ./XMonad/Actions/WindowNavigation.hs 91 +-- TODO: use a smarter algorithm (with memory of last position) hunk ./XMonad/Actions/WindowNavigation.hs 48 +-- - manageHook to draw window decos? + + +type WNState = Map WorkspaceId Point hunk ./XMonad/Actions/WindowNavigation.hs 58 - --- key bindings to do the important stuff - -type WNState = Map WorkspaceId Point - --- 1. Get current position, window --- 2. Determine list of windows in dir from pos, except window --- 3. Grab closest one - hunk ./XMonad/Actions/WindowNavigation.hs 61 - io $ putStrLn $ "pos: " ++ show pos ++ "; tgts: " ++ show targets hunk ./XMonad/Actions/WindowNavigation.hs 74 --- TODO: replace 0 0 0 0 with 'middle of current window' --- TODO: correct if not in window, or add logHook +-- TODO: worry about off-by-one issues with inside definition hunk ./XMonad/Actions/WindowNavigation.hs 77 + root <- asks theRoot + currentWindow <- gets (W.peek . windowset) + currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow) + hunk ./XMonad/Actions/WindowNavigation.hs 83 - return $ fromMaybe (Point 0 0) mp hunk ./XMonad/Actions/WindowNavigation.hs 84 -navigableTargets :: Point -> Direction -> X [(Window, Rectangle)] -navigableTargets point dir = navigable dir point <$> windowRects + case mp of + Just p | p `inside` currentRect -> return p + _ -> return (middleOf currentRect) + + where Point px py `inside` Rectangle rx ry rw rh = + px >= rx && px < rx + fromIntegral rw && + py >= rx && py < ry + fromIntegral rh + + middleOf (Rectangle x y w h) = + Point (x + fromIntegral w `div` 2) (y + fromIntegral h `div` 2) + -- return $ fromMaybe (Point 0 0) mp hunk ./XMonad/Actions/WindowNavigation.hs 103 +navigableTargets :: Point -> Direction -> X [(Window, Rectangle)] +navigableTargets point dir = navigable dir point <$> windowRects + hunk ./XMonad/Actions/WindowNavigation.hs 118 - dpy <- asks display hunk ./XMonad/Actions/WindowNavigation.hs 119 - catMaybes <$> mapM (windowRect dpy) wins + catMaybes <$> mapM windowRect wins hunk ./XMonad/Actions/WindowNavigation.hs 123 -windowRect :: Display -> Window -> X (Maybe (Window, Rectangle)) -windowRect dpy win = do +windowRect :: Window -> X (Maybe (Window, Rectangle)) +windowRect win = withDisplay $ \dpy -> do hunk ./XMonad/Actions/WindowNavigation.hs 129 --- manageHook to draw window decos? - hunk ./XMonad/Actions/WindowNavigation.hs 132 --- Stolen from droundy's implementation of WindowNavigation. I should probably take the time --- to understand the black magic below at some point. +-- Stolen from droundy's implementation of WindowNavigation. +-- TODO: refactor, perhaps hunk ./XMonad/Actions/WindowNavigation.hs 21 + withWindowNavigation, hunk ./XMonad/Actions/WindowNavigation.hs 43 --- - withWindowNavigation :: XConfig l -> XConfig l hunk ./XMonad/Actions/WindowNavigation.hs 50 +withWindowNavigation :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l) +withWindowNavigation (u,l,d,r) conf = do + posRef <- newIORef M.empty + return conf { keys = \cnf -> M.fromList [ + ((modMask cnf, u), go posRef U), + ((modMask cnf, l), go posRef L), + ((modMask cnf, d), go posRef D), + ((modMask cnf, r), go posRef R) + ] `M.union` (keys conf cnf) } hunk ./XMonad/Actions/WindowNavigation.hs 50 +-- TODO: more flexible api hunk ./XMonad/Actions/WindowNavigation.hs 22 + withWindowNavigationKeys, + WNAction(..), hunk ./XMonad/Actions/WindowNavigation.hs 33 +import Control.Arrow (second) hunk ./XMonad/Actions/WindowNavigation.hs 46 +-- - implement swap hunk ./XMonad/Actions/WindowNavigation.hs 48 --- - actually deal with multiple screens hunk ./XMonad/Actions/WindowNavigation.hs 55 -withWindowNavigation (u,l,d,r) conf = do +withWindowNavigation (u,l,d,r) conf = + withWindowNavigationKeys [ ((modMask conf, u), WNGo U), + ((modMask conf, l), WNGo L), + ((modMask conf, d), WNGo D), + ((modMask conf, r), WNGo R) ] + conf + +withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l) +withWindowNavigationKeys wnKeys conf = do hunk ./XMonad/Actions/WindowNavigation.hs 65 - return conf { keys = \cnf -> M.fromList [ - ((modMask cnf, u), go posRef U), - ((modMask cnf, l), go posRef L), - ((modMask cnf, d), go posRef D), - ((modMask cnf, r), go posRef R) - ] `M.union` (keys conf cnf) } + return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys) + `M.union` keys conf cnf } + where fromWNAction posRef (WNGo dir) = go posRef dir + fromWNAction posRef (WNSwap dir) = swap posRef dir + +data WNAction = WNGo Direction | WNSwap Direction hunk ./XMonad/Actions/WindowNavigation.hs 46 +-- - 1. 2x2, top right; 2. a,j,d 3. error! hunk ./XMonad/Actions/WindowNavigation.hs 57 - withWindowNavigationKeys [ ((modMask conf, u), WNGo U), - ((modMask conf, l), WNGo L), - ((modMask conf, d), WNGo D), - ((modMask conf, r), WNGo R) ] + withWindowNavigationKeys [ ((modMask conf , u), WNGo U), + ((modMask conf , l), WNGo L), + ((modMask conf , d), WNGo D), + ((modMask conf , r), WNGo R), + ((modMask conf .|. shiftMask, u), WNSwap U), + ((modMask conf .|. shiftMask, l), WNSwap L), + ((modMask conf .|. shiftMask, d), WNSwap D), + ((modMask conf .|. shiftMask, r), WNSwap R) ] hunk ./XMonad/Actions/WindowNavigation.hs 85 -go posRef dir = fromCurrentPoint $ \win pos -> do +go = withTargetWindow W.focusWindow + +swap :: IORef WNState -> Direction -> X () +swap = withTargetWindow swapWithFocused + where swapWithFocused targetWin winSet = + case W.peek winSet of + Just currentWin -> W.focusWindow currentWin $ + mapWindows (swapWin currentWin targetWin) winSet + Nothing -> winSet + mapWindows f ss = W.mapWorkspace (mapWindows' f) ss + mapWindows' f ws@(W.Workspace { W.stack = s }) = ws { W.stack = mapWindows'' f <$> s } + mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down) + swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win + +withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction -> X () +withTargetWindow adj posRef dir = fromCurrentPoint $ \win pos -> do hunk ./XMonad/Actions/WindowNavigation.hs 102 - whenJust (listToMaybe targets) $ \(tw, tr) -> do - windows (W.focusWindow tw) - setPosition posRef pos tr + whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do + windows (adj targetWin) + setPosition posRef pos targetRect hunk ./XMonad/Actions/WindowNavigation.hs 108 -swap :: IORef WNState -> Direction -> X () -swap _ _ = return () - hunk ./XMonad/Actions/WindowNavigation.hs 46 --- - 1. 2x2, top right; 2. a,j,d 3. error! --- - implement swap hunk ./XMonad/Actions/WindowNavigation.hs 126 - py >= rx && py < ry + fromIntegral rh + py >= ry && py < ry + fromIntegral rh hunk ./XMonad/Actions/WindowNavigation.hs 39 +import Data.Ord (comparing) hunk ./XMonad/Actions/WindowNavigation.hs 185 -sortby U = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y' y) -sortby D = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y y') -sortby R = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x x') -sortby L = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x' x) +sortby D = sortBy $ comparing (rect_y . snd) +sortby R = sortBy $ comparing (rect_x . snd) +sortby U = reverse . sortby D +sortby L = reverse . sortby R hunk ./XMonad/Actions/WindowNavigation.hs 146 -navigable d pt = sortby d . filter (inr d (fromPoint pt) . snd) +navigable d pt = sortby d . filter (inr d pt . snd) hunk ./XMonad/Actions/WindowNavigation.hs 166 -fromPoint :: Point -> FPoint -fromPoint p = P (fromIntegral $ pt_x p) (fromIntegral $ pt_y p) +-- Modified from droundy's implementation of WindowNavigation. hunk ./XMonad/Actions/WindowNavigation.hs 168 --- Stolen from droundy's implementation of WindowNavigation. --- TODO: refactor, perhaps - -data FPoint = P Double Double - -inr :: Direction -> FPoint -> Rectangle -> Bool -inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && - y < fromIntegral yr + fromIntegral h -inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && - y > fromIntegral yr -inr R (P a x) (Rectangle b l _ w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && - a < fromIntegral b -inr L (P a x) (Rectangle b l c w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && - a > fromIntegral b + fromIntegral c +-- TODO: simplify this +inr :: Direction -> Point -> Rectangle -> Bool +inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w && + py < ry + fromIntegral h +inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w && + py > ry +inr R (Point px py) (Rectangle rx ry _ h) = px < rx && + py >= ry && py < ry + fromIntegral h +inr L (Point px py) (Rectangle rx ry w h) = px > rx + fromIntegral w && + py >= ry && py < ry + fromIntegral h hunk ./XMonad/Actions/WindowNavigation.hs 40 +import qualified Data.Set as S hunk ./XMonad/Actions/WindowNavigation.hs 48 +-- - screen 1: 2x2, screen 2: 1 fs, move from scr 2 to scr 1 +-- - fix setPosition to use WNState hunk ./XMonad/Actions/WindowNavigation.hs 56 --- TODO: more flexible api hunk ./XMonad/Actions/WindowNavigation.hs 153 --- TODO: only the visible windows --- TODO: adjust rectangles based on screen position? (perhaps this is already handled) hunk ./XMonad/Actions/WindowNavigation.hs 154 -windowRects = do - wins <- gets (visibleWindows . windowset) - catMaybes <$> mapM windowRect wins - where visibleWindows wset = concatMap (W.integrate' . W.stack . W.workspace) - (W.current wset : W.visible wset) +windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped hunk ./XMonad/Actions/WindowNavigation.hs 48 --- - screen 1: 2x2, screen 2: 1 fs, move from scr 2 to scr 1 +-- - screen 1: 2x2, screen 2: 1 fs, move from scr 2 to scr 1: center -> border hunk ./XMonad/Actions/WindowNavigation.hs 48 --- - screen 1: 2x2, screen 2: 1 fs, move from scr 2 to scr 1: center -> border hunk ./XMonad/Actions/WindowNavigation.hs 72 + -- logHook = windowRects >>= io . print } hunk ./XMonad/Actions/WindowNavigation.hs 158 - (_, x, y, w, h, _, _) <- io $ getGeometry dpy win - return $ Just $ (win, Rectangle x y w h) + (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win + return $ Just $ (win, Rectangle x y (w + 2 * bw) (h + 2 * bw)) hunk ./XMonad/Actions/WindowNavigation.hs 48 --- - fix setPosition to use WNState --- - cleanup +-- - fix setPosition to use WNState smartly +-- - cleanup (including inr) hunk ./XMonad/Actions/WindowNavigation.hs 72 - -- logHook = windowRects >>= io . print } hunk ./XMonad/Actions/WindowNavigation.hs 112 --- TODO: worry about off-by-one issues with inside definition hunk ./XMonad/Actions/WindowNavigation.hs 131 - -- return $ fromMaybe (Point 0 0) mp hunk ./XMonad/Actions/WindowNavigation.hs 132 --- TODO: use a smarter algorithm (with memory of last position) hunk ./XMonad/Actions/WindowNavigation.hs 158 --- Modified from droundy's implementation of WindowNavigation. +-- Modified from droundy's implementation of WindowNavigation: hunk ./XMonad/Actions/WindowNavigation.hs 160 --- TODO: simplify this hunk ./XMonad/Actions/AppLauncher.hs 1 -{- | - Module : XMonad.Actions.AppLauncher - Copyright : (C) 2008 Luis Cabellos - License : None; public domain - - Maintainer : - Stability : unstable - Portability : unportable - - A module for launch applicationes that receive parameters in the command line. - The launcher call a prompt to get the parameters. --} -module XMonad.Actions.AppLauncher ( -- * Usage - -- $usage - launchApp - - -- * Use case: launching gimp with file - -- $tip - ) where - -import XMonad (X(),MonadIO) -import XMonad.Core (spawn) -import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig()) -import XMonad.Prompt.Shell (getShellCompl) - -{- $usage - This module is intended to allow the launch of the same application - but changing the parameters using the user response. For example, when - you want to open a image in gimp program, you can open gimp and then use - the File Menu to open the image or you can use this module to select - the image in the command line. - - We use Prompt to get the user command line. This also allow to autoexpand - the names of the files when we are writing the command line. - -} - -{- $tip - -First, you need to import necessary modules. Prompt is used to get the promp -configuration and the AppLauncher module itself. - -> import XMonad.Prompt -> import XMonad.Actions.AppLauncher as AL - -Then you can add the bindings to the applications. - -> ... -> , ((modm, xK_g), AL.launchApp defaultXPConfig "gimp" ) -> , ((modm, xK_g), AL.launchApp defaultXPConfig "evince" ) -> ... - - -} - --- A customized prompt -data AppPrompt = AppPrompt String -instance XPrompt AppPrompt where - showXPrompt (AppPrompt n) = n ++ " " - -type Application = String -type Parameters = String - -{- | Given an application and its parameters, launch the application. -} -launch :: MonadIO m => Application -> Parameters -> m () -launch app params = spawn ( app ++ " " ++ params ) - - -{- | Get the user's response to a prompt an launch an application using the - input as command parameters of the application.-} -launchApp :: XPConfig -> Application -> X () -launchApp config app = mkXPrompt (AppPrompt app) config (getShellCompl []) $ launch app rmfile ./XMonad/Actions/AppLauncher.hs addfile ./XMonad/Prompt/AppLauncher.hs hunk ./XMonad/Prompt/AppLauncher.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.AppLauncher +-- Copyright : (C) 2008 Luis Cabellos +-- License : BSD3 +-- +-- Maintainer : zhen.sydow@gmail.com +-- Stability : unstable +-- Portability : unportable +-- +-- A module for launch applicationes that receive parameters in the command +-- line. The launcher call a prompt to get the parameters. +-- +----------------------------------------------------------------------------- +module XMonad.Prompt.AppLauncher ( -- * Usage + -- $usage + launchApp + + -- * Use case: launching gimp with file + -- $tip + ) where + +import XMonad (X(),MonadIO) +import XMonad.Core (spawn) +import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig()) +import XMonad.Prompt.Shell (getShellCompl) + +{- $usage + This module is intended to allow the launch of the same application + but changing the parameters using the user response. For example, when + you want to open a image in gimp program, you can open gimp and then use + the File Menu to open the image or you can use this module to select + the image in the command line. + + We use Prompt to get the user command line. This also allow to autoexpand + the names of the files when we are writing the command line. + -} + +{- $tip + +First, you need to import necessary modules. Prompt is used to get the promp +configuration and the AppLauncher module itself. + +> import XMonad.Prompt +> import XMonad.Prompt.AppLauncher as AL + +Then you can add the bindings to the applications. + +> ... +> , ((modm, xK_g), AL.launchApp defaultXPConfig "gimp" ) +> , ((modm, xK_g), AL.launchApp defaultXPConfig "evince" ) +> ... + + -} + +-- A customized prompt +data AppPrompt = AppPrompt String +instance XPrompt AppPrompt where + showXPrompt (AppPrompt n) = n ++ " " + +type Application = String +type Parameters = String + +{- | Given an application and its parameters, launch the application. -} +launch :: MonadIO m => Application -> Parameters -> m () +launch app params = spawn ( app ++ " " ++ params ) + + +{- | Get the user's response to a prompt an launch an application using the + input as command parameters of the application.-} +launchApp :: XPConfig -> Application -> X () +launchApp config app = mkXPrompt (AppPrompt app) config (getShellCompl []) $ launch app hunk ./xmonad-contrib.cabal 70 - XMonad.Actions.AppLauncher hunk ./xmonad-contrib.cabal 167 + XMonad.Prompt.AppLauncher hunk ./XMonad/Hooks/UrgencyHook.hs 23 + withUrgencyHookC, suppressWhen, hunk ./XMonad/Hooks/UrgencyHook.hs 26 - urgencyLayoutHook, hunk ./XMonad/Hooks/UrgencyHook.hs 67 --- No example for you. hunk ./XMonad/Hooks/UrgencyHook.hs 68 --- | This is the preferred method of enabling an urgency hook. It will prepend --- an action to your logHook that removes visible windows from the list of urgent --- windows. If you don't like that behavior, you may use 'urgencyLayoutHook' instead. +-- TODO: provide logHook example +-- TODO: provide irssi + urxvt example + +-- | This is the method to enable an urgency hook. It suppresses urgency status +-- for windows that are currently visible. If you'd like to change that behavior, +-- use withUrgencyHookC. hunk ./XMonad/Hooks/UrgencyHook.hs 76 -withUrgencyHook hook conf = conf { layoutHook = urgencyLayoutHook hook $ layoutHook conf - , logHook = removeVisiblesFromUrgents >> logHook conf - } +withUrgencyHook hook conf = withUrgencyHookC hook id conf + +-- TODO: document this +withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) => + h -> (WithUrgencyHook h -> WithUrgencyHook h) -> XConfig l + -> XConfig (HandleEvent (WithUrgencyHook h) l) +withUrgencyHookC hook hookMod conf = conf { + layoutHook = eventHook (hookMod $ WithUrgencyHook hook Visible) $ layoutHook conf, + logHook = removeVisiblesFromUrgents >> logHook conf + } + +suppressWhen :: UrgencyHook h => SuppressWhen -> WithUrgencyHook h -> WithUrgencyHook h +suppressWhen sw (WithUrgencyHook hook _) = WithUrgencyHook hook sw hunk ./XMonad/Hooks/UrgencyHook.hs 91 +-- TODO: should be based on suppressWhen hunk ./XMonad/Hooks/UrgencyHook.hs 121 -data WithUrgencyHook h = WithUrgencyHook h deriving (Read, Show) +data WithUrgencyHook h = WithUrgencyHook h SuppressWhen deriving (Read, Show) hunk ./XMonad/Hooks/UrgencyHook.hs 136 - handleEvent (WithUrgencyHook hook) event = + handleEvent wuh event = hunk ./XMonad/Hooks/UrgencyHook.hs 143 - callUrgencyHook hook w + callUrgencyHook wuh w hunk ./XMonad/Hooks/UrgencyHook.hs 159 -urgencyLayoutHook :: (UrgencyHook h, LayoutClass l Window) => - h -> l Window -> HandleEvent (WithUrgencyHook h) l Window -urgencyLayoutHook hook = eventHook $ WithUrgencyHook hook - -callUrgencyHook :: UrgencyHook h => h -> Window -> X () -callUrgencyHook hook w = - whenX (not `fmap` shouldSuppress (suppressWhenSetting hook) w) +callUrgencyHook :: UrgencyHook h => WithUrgencyHook h -> Window -> X () +callUrgencyHook (WithUrgencyHook hook sw) w = + whenX (not `fmap` shouldSuppress sw w) hunk ./XMonad/Hooks/UrgencyHook.hs 180 - suppressWhenSetting :: h -> SuppressWhen - suppressWhenSetting _ = Visible - hunk ./XMonad/Hooks/UrgencyHook.hs 185 -data DzenUrgencyHook = DzenUrgencyHook { duration :: Int, - args :: [String], - suppressWhen :: SuppressWhen } - deriving (Read, Show) +data DzenUrgencyHook = DzenUrgencyHook { duration :: Int, args :: [String] } + deriving (Read, Show) hunk ./XMonad/Hooks/UrgencyHook.hs 196 - suppressWhenSetting = suppressWhen - hunk ./XMonad/Hooks/UrgencyHook.hs 199 -dzenUrgencyHook = DzenUrgencyHook { duration = (5 `seconds`), args = [], suppressWhen = Visible } +dzenUrgencyHook = DzenUrgencyHook { duration = (5 `seconds`), args = [] } hunk ./XMonad/Hooks/UrgencyHook.hs 65 --- If you want to modify your logHook to print out information about urgent windows, --- the functions 'readUrgents' and 'withUrgents' are there to help you with that. +-- If you would like your dzen instance (configured with "XMonad.Hooks.DynamicLog") +-- to hilight urgent windows, make sure you're using dzen, dzenPP, or ppUrgents. +-- +-- If you'd like your dzen to update, but don't care about triggering any other +-- action, then wire in NoUrgencyHook as so: +-- +-- > main = xmonad $ withUrgencyHook NoUrgencyHook +-- > $ defaultConfig +-- hunk ./XMonad/Hooks/UrgencyHook.hs 75 --- TODO: provide logHook example --- TODO: provide irssi + urxvt example +-- * Setting up Irssi + rxvt-unicode +-- +-- This is one common example. YMMV. To make messages to you trigger a dzen flash, +-- four things need to happen: +-- 1. irssi needs to send a bell +-- 2. screen needs *not* to convert that into a stupid visual bell +-- 3. urxvt needs to convert bell into urgency flag +-- 4. xmonad needs to trigger some action based on the bell + +-- TODO: provide irssi + urxvt example detail +-- TODO: examine haddock formatting hunk ./XMonad/Hooks/UrgencyHook.hs 94 --- TODO: document this +-- | If you'd like to configure *when* to trigger the urgency hook, call this +-- function with an extra mutator function. Or, by example: +-- +-- > withUrgencyHookC dzenUrgencyHook { ... } (suppressWhen Focused) +-- +-- (Don't type ..., you dolt.) See documentation on your options at SuppressWhen. hunk ./XMonad/Hooks/UrgencyHook.hs 185 +-- TODO: document hunk ./XMonad/Config/Droundy.hs 28 +import XMonad.Layout.BoringWindows ( boringWindows, markBoring, clearBoring, + focusUp, focusDown ) hunk ./XMonad/Config/Droundy.hs 71 - , ((modMask x, xK_Tab ), windows W.focusDown) -- %! Move focus to the next window - , ((modMask x, xK_j ), windows W.focusDown) -- %! Move focus to the next window - , ((modMask x, xK_k ), windows W.focusUp ) -- %! Move focus to the previous window + , ((modMask x, xK_Tab ), focusDown) -- %! Move focus to the next window + , ((modMask x, xK_j ), focusDown) -- %! Move focus to the next window + , ((modMask x, xK_k ), focusUp ) -- %! Move focus to the previous window hunk ./XMonad/Config/Droundy.hs 103 + , ((modMask x .|. shiftMask, xK_b ), markBoring) + , ((controlMask .|. modMask x .|. shiftMask, xK_b ), clearBoring) hunk ./XMonad/Config/Droundy.hs 127 - smartBorders $ windowNavigation $ + boringWindows $ smartBorders $ windowNavigation $ addfile ./XMonad/Layout/BoringWindows.hs hunk ./XMonad/Layout/BoringWindows.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.BoringWindows +-- Copyright : (c) 2008 David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- BoringWindows is an extension to allow windows to be marked boring +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.BoringWindows ( + -- * Usage + -- $usage + boringWindows, + markBoring, clearBoring, + focusUp, focusDown + ) where + +import XMonad hiding (Point) +import qualified XMonad.StackSet as W +import XMonad.Layout.LayoutModifier +import XMonad.Util.Invisible + +data BoringMessage = FocusUp | FocusDown | IsBoring Window | ClearBoring + deriving ( Read, Show, Typeable ) +instance Message BoringMessage + +markBoring = withFocused (sendMessage . IsBoring) +clearBoring = sendMessage ClearBoring +focusUp = sendMessage FocusUp +focusDown = sendMessage FocusDown + +data BoringWindows a = BoringWindows (Invisible [] a) deriving ( Show, Read, Typeable ) + +boringWindows :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a +boringWindows = ModifiedLayout (BoringWindows (I [])) + +instance LayoutModifier BoringWindows Window where + handleMessOrMaybeModifyIt (BoringWindows (I bs)) m + | Just (IsBoring b) <- fromMessage m = return $ Just $ Left $ BoringWindows (I (b:bs)) + | Just ClearBoring <- fromMessage m = return $ Just $ Left $ BoringWindows (I []) + | Just FocusUp <- fromMessage m = do windows $ W.modify' $ focusUp' + return Nothing + | Just FocusDown <- fromMessage m = + do windows $ W.modify' (reverseStack . focusUp' . reverseStack) + return Nothing + where focusUp' (W.Stack t ls rs) + | (a,l:ls') <- skipBoring ls = W.Stack l ls' (a++t:rs) + | otherwise = case skipBoring (reverse (t:rs)++ls) of + (a,x:xs) -> W.Stack x xs a + _ -> W.Stack t ls rs + skipBoring [] = ([],[]) + skipBoring (x:xs) | x `elem` bs = case skipBoring xs of + (a,b) -> (x:a,b) + | otherwise = ([],x:xs) + handleMessOrMaybeModifyIt _ _ = return Nothing + +-- | reverse a stack: up becomes down and down becomes up. +reverseStack :: W.Stack a -> W.Stack a +reverseStack (W.Stack t ls rs) = W.Stack t rs ls hunk ./xmonad-contrib.cabal 118 + XMonad.Layout.BoringWindows hunk ./XMonad/Layout/BoringWindows.hs 34 +markBoring, clearBoring, focusUp, focusDown :: X () hunk ./XMonad/Actions/WindowNavigation.hs 112 +-- TODO: factor x + fromIntegral w `div` 2 duplication out hunk ./XMonad/Actions/WindowNavigation.hs 117 - currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow) + currentRect@(Rectangle rx ry rw rh) <- maybe (Rectangle 0 0 0 0) snd <$> + windowRect (fromMaybe root currentWindow) hunk ./XMonad/Actions/WindowNavigation.hs 124 - Just p | p `inside` currentRect -> return p - _ -> return (middleOf currentRect) + Just (Point x y) -> return $ Point (x `inside` (rx, rw)) (y `inside` (ry, rh)) + _ -> return (middleOf currentRect) hunk ./XMonad/Actions/WindowNavigation.hs 127 - where Point px py `inside` Rectangle rx ry rw rh = - px >= rx && px < rx + fromIntegral rw && - py >= ry && py < ry + fromIntegral rh + where pos `inside` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim + then pos + else lower + fromIntegral dim `div` 2 hunk ./XMonad/Hooks/UrgencyHook.hs 74 + +-- TODO: note mod-shift-space hunk ./XMonad/Actions/WindowNavigation.hs 48 --- - fix setPosition to use WNState smartly +-- - logHook? hunk ./XMonad/Actions/WindowNavigation.hs 112 --- TODO: factor x + fromIntegral w `div` 2 duplication out hunk ./XMonad/Actions/WindowNavigation.hs 116 - currentRect@(Rectangle rx ry rw rh) <- maybe (Rectangle 0 0 0 0) snd <$> - windowRect (fromMaybe root currentWindow) + currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow) hunk ./XMonad/Actions/WindowNavigation.hs 121 - case mp of - Just (Point x y) -> return $ Point (x `inside` (rx, rw)) (y `inside` (ry, rh)) - _ -> return (middleOf currentRect) + return $ maybe (middleOf currentRect) (`inside` currentRect) mp hunk ./XMonad/Actions/WindowNavigation.hs 123 - where pos `inside` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim - then pos - else lower + fromIntegral dim `div` 2 - - middleOf (Rectangle x y w h) = - Point (x + fromIntegral w `div` 2) (y + fromIntegral h `div` 2) + where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h) hunk ./XMonad/Actions/WindowNavigation.hs 126 -setPosition posRef _ (Rectangle x y w h) = do +setPosition posRef oldPos newRect = do hunk ./XMonad/Actions/WindowNavigation.hs 128 - let position = Point (x + (fromIntegral w `div` 2)) (y + (fromIntegral h `div` 2)) - io $ modifyIORef posRef $ M.insert wsid position + io $ modifyIORef posRef $ M.insert wsid (oldPos `inside` newRect) + +inside :: Point -> Rectangle -> Point +Point x y `inside` Rectangle rx ry rw rh = + Point (x `within` (rx, rw)) (y `within` (ry, rh)) + where pos `within` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim + then pos + else midPoint lower dim + +midPoint :: Position -> Dimension -> Position +midPoint pos dim = pos + fromIntegral dim `div` 2 hunk ./XMonad/Hooks/UrgencyHook.hs 22 - withUrgencyHook, - withUrgencyHookC, suppressWhen, + + -- ** Pop up a temporary dzen + -- $temporary + + -- ** Highlight in existing dzen + -- $existing + + -- ** Useful keybinding + -- $keybinding + + -- ** Note + -- $note + + -- * Example: Setting up irssi + rxvt-unicode + -- $example + + -- ** Configuring irssi + -- $irssi + + -- ** Configuring screen + -- $screen + + -- ** Configuring rxvt-unicode + -- $urxvt + + -- ** Configuring xmonad + -- $xmonad + + -- * Stuff for your config file: + withUrgencyHook, withUrgencyHookC, + suppressWhen, SuppressWhen(..), hunk ./XMonad/Hooks/UrgencyHook.hs 54 + dzenUrgencyHook, + DzenUrgencyHook(..), seconds, + NoUrgencyHook(..), + + -- * Stuff for developers: hunk ./XMonad/Hooks/UrgencyHook.hs 60 - NoUrgencyHook(..), StdoutUrgencyHook(..), + StdoutUrgencyHook(..), hunk ./XMonad/Hooks/UrgencyHook.hs 62 - dzenUrgencyHook, DzenUrgencyHook(..), - UrgencyHook(urgencyHook), - seconds, - SuppressWhen(..) + UrgencyHook(urgencyHook) hunk ./XMonad/Hooks/UrgencyHook.hs 81 +-- hunk ./XMonad/Hooks/UrgencyHook.hs 86 --- to your import list in your config file. Now, choose an urgency hook. If --- you're just interested in displaying the urgency state in your custom --- logHook, then choose NoUrgencyHook. Otherwise, you may use the provided --- 'dzenUrgencyHook', or write your own. +-- to your import list in your config file. Now, you have a decision to make: +-- When a window deems itself urgent, do you want to pop up a temporary dzen +-- bar telling you so, or do you have an existing dzen wherein you would like to +-- highlight urgent workspaces? + +-- $temporary hunk ./XMonad/Hooks/UrgencyHook.hs 99 --- If you would like your dzen instance (configured with "XMonad.Hooks.DynamicLog") --- to hilight urgent windows, make sure you're using dzen, dzenPP, or ppUrgents. +-- This will pop up a dzen bar for five seconds telling you you've got an +-- urgent window. + +-- $existing hunk ./XMonad/Hooks/UrgencyHook.hs 104 --- If you'd like your dzen to update, but don't care about triggering any other --- action, then wire in NoUrgencyHook as so: +-- In order for xmonad to track urgent windows, you must install an urgency hook. +-- You can use the above 'dzenUrgencyHook', or if you're not interested in the +-- extra popup, install NoUrgencyHook, as so: hunk ./XMonad/Hooks/UrgencyHook.hs 111 +-- Now, your "XMonad.Hooks.DynamicLog" must be set up to display the urgent +-- windows. If you're using the 'dzen' or 'dzenPP' functions from that module, +-- then you should be good. Otherwise, you want to figure out how to set +-- 'ppUrgents'. hunk ./XMonad/Hooks/UrgencyHook.hs 116 --- TODO: note mod-shift-space +-- $keybinding +-- +-- You can set up a keybinding to jump to the window that was recently marked +-- urgent. See an example at 'focusUrgent'. + +-- $note +-- Note: UrgencyHook installs itself as a LayoutModifier, so if you modify your +-- urgency hook and restart xmonad, you may need to rejigger your layout by +-- hitting mod-shift-space. hunk ./XMonad/Hooks/UrgencyHook.hs 126 --- * Setting up Irssi + rxvt-unicode +-- $example hunk ./XMonad/Hooks/UrgencyHook.hs 128 --- This is one common example. YMMV. To make messages to you trigger a dzen flash, --- four things need to happen: --- 1. irssi needs to send a bell --- 2. screen needs *not* to convert that into a stupid visual bell --- 3. urxvt needs to convert bell into urgency flag --- 4. xmonad needs to trigger some action based on the bell +-- This is a commonly asked example. By default, the window doesn't get flagged +-- urgent when somebody messages you in irssi. You will have to configure some +-- things. If you're using different tools than this, your mileage will almost +-- certainly vary. (For example, in Xchat2, it's just a simple checkbox.) hunk ./XMonad/Hooks/UrgencyHook.hs 133 --- TODO: provide irssi + urxvt example detail --- TODO: examine haddock formatting +-- $irssi +-- @Irssi@ is not an X11 app, so it can't set the @UrgencyHint@ flag on @XWMHints@. +-- However, on all console applications is bestown the greatest of all notification +-- systems: the bell. That's right, Ctrl+G, ASCII code 7, @echo -e '\a'@, your +-- friend, the bell. To configure @irssi@ to send a bell when you receive a message: +-- +-- > /set beep_msg_level MSGS NOTICES INVITES DCC DCCMSGS HILIGHT +-- +-- Consult your local @irssi@ documentation for more detail. + +-- $screen +-- A common way to run @irssi@ is within the lovable giant, @screen@. Some distros +-- (e.g. Ubuntu) like to configure @screen@ to trample on your poor console +-- applications -- in particular, to turn bell characters into evil, smelly +-- \"visual bells.\" To turn this off, add: +-- +-- > vbell off # or remove the existing 'vbell on' line +-- +-- to your .screenrc, or hit @C-a C-g@ within a running @screen@ session for a +-- temporary fix. + +-- $urxvt +-- Rubber, meet road. Urxvt is the gateway between console apps and X11. To tell +-- urxvt to set an @UrgencyHint@ when it receives a bell character, first, have +-- an urxvt version 8.3 or newer, and second, set the following in your +-- @.Xdefaults@: +-- +-- > urxvt.urgentOnBell: true +-- +-- Depending on your setup, you may need to @xrdb@ that. + +-- $xmonad +-- Hopefully you already read the section on how to configure xmonad. If not, +-- hopefully you know where to find it. hunk ./XMonad/Hooks/UrgencyHook.hs 180 --- (Don't type ..., you dolt.) See documentation on your options at SuppressWhen. +-- (Don't type the @...@, you dolt.) See documentation on your options at 'SuppressWhen'. hunk ./XMonad/Hooks/UrgencyHook.hs 192 +-- | A set of choices as to /when/ you should (or rather, shouldn't) be notified of an urgent window. +-- The default is 'Visible'. Prefix each of the following with \"don't bug me when\": +data SuppressWhen = Visible -- ^ the window is currently visible + | OnScreen -- ^ the window is on the currently focused physical screen + | Focused -- ^ the window is currently focused + | Never -- ^ ... aww, heck, go ahead and bug me, just in case. + deriving (Read, Show) + hunk ./XMonad/Hooks/UrgencyHook.hs 201 --- TODO: should be based on suppressWhen hunk ./XMonad/Hooks/UrgencyHook.hs 205 +-- TODO: ^ should be based on suppressWhen hunk ./XMonad/Hooks/UrgencyHook.hs 214 --- | Stores the global set of all urgent windows, across workspaces. Not exported -- use +-- Stores the global set of all urgent windows, across workspaces. Not exported -- use hunk ./XMonad/Hooks/UrgencyHook.hs 274 --- TODO: document -data SuppressWhen = Visible | OnScreen | Focused | Never deriving (Read, Show) - hunk ./XMonad/Hooks/UrgencyHook.hs 293 -data DzenUrgencyHook = DzenUrgencyHook { duration :: Int, args :: [String] } +-- | Your set of options for configuring a dzenUrgencyHook. +data DzenUrgencyHook = DzenUrgencyHook { + duration :: Int, -- ^ number of microseconds to display the dzen + -- (hence, you'll probably want to use 'seconds') + args :: [String] -- ^ list of extra args (as 'String's) to pass to dzen + } hunk ./XMonad/Hooks/UrgencyHook.hs 309 --- | Flashes when a window requests your attention and you can't see it. Configurable --- duration and args to dzen, and when to suppress the urgency flash. +-- | Flashes when a window requests your attention and you can't see it. +-- Defaults to a duration of five seconds, and no extra args to dzen. +-- See 'DzenUrgencyHook'. hunk ./XMonad/Util/Run.hs 81 --- | Multiplies by ONE MILLION, for use with --- 'runProcessWithInputAndWait'. +-- | Multiplies by ONE MILLION, for functions that take microseconds. hunk ./XMonad/Layout/NoBorders.hs 78 - redoLayout (SmartBorder s) _ _ wrs = do + redoLayout (SmartBorder s) _ st wrs = do hunk ./XMonad/Layout/NoBorders.hs 80 - let + let managedwindows = W.integrate st hunk ./XMonad/Layout/NoBorders.hs 83 - tiled = case wrs of - [(w, _)] | singleton screens -> [w] + tiled = case filter (`elem` managedwindows) $ map fst wrs of + [w] | singleton screens -> [w] hunk ./XMonad/Config/Droundy.hs 24 -import XMonad.Layout.Simplest ( Simplest(Simplest) ) hunk ./XMonad/Config/Droundy.hs 33 -import XMonad.Layout.ScratchWorkspace ( toggleScratchWorkspace ) hunk ./XMonad/Config/Droundy.hs 111 - , ((modMask x .|. controlMask .|. shiftMask, xK_space), - toggleScratchWorkspace (Simplest */* Simplest) ) hunk ./XMonad/Hooks/SetWMName.hs 17 --- Remember that you need to call the setWMName action yourself (at least until --- we have startup hooks). E.g., you can bind it in your Config.hs: +-- To your @~\/.xmonad\/xmonad.hs@ file, add the following line: hunk ./XMonad/Hooks/SetWMName.hs 19 --- > ((modMask x .|. controlMask .|. shiftMask, xK_z), setWMName "LG3D") -- @@ Java hack +-- > import XMonad.Hooks.SetWMName hunk ./XMonad/Hooks/SetWMName.hs 21 --- and press the key combination before running the Java programs (you only --- need to do it once per XMonad execution) +-- Then edit your @startupHook@: +-- +-- > startupHook = setWMName "LG3D" hunk ./XMonad/Hooks/SetWMName.hs 34 --- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". +-- For detailed instructions on editing your hooks, see +-- "XMonad.Doc.Extending#4". addfile ./XMonad/Config/PlainConfig.hs hunk ./XMonad/Config/PlainConfig.hs 1 +{-# LANGUAGE + FlexibleInstances, + FlexibleContexts, + MultiParamTypeClasses, + ExistentialQuantification + #-} + +------------------------------------------------------------------------- +-- | +-- Module : XMonad.Config.PlainConfig +-- Copyright : Braden Shepherdson +-- License : BSD3 +-- +-- Maintainer : Braden Shepherdson +-- +-- Proof-of-concept (but usable) plain-text configuration file +-- parser, for use instead of xmonad.hs. Does not require recompilation, +-- allowing xmonad to be free of the GHC dependency. +-- +------------------------------------------------------------------------- + + +module XMonad.Config.PlainConfig + ( + -- * Introduction + -- $usage + + -- * Supported Layouts + -- $layouts + + -- * Support Key Bindings + -- $keys + + -- * Other Notes + -- $notes + + -- * Example Config File + -- $example + + plainConfig ,readConfig, checkConfig + ) +where + + +import XMonad +import System.Exit + +import qualified XMonad.StackSet as W +import qualified Data.Map as M +import Data.List +import Data.Maybe (isJust,fromJust) +import Data.Char (isSpace) + + +--import Control.Monad +import Control.Monad.Error +import Control.Monad.Identity + +import Control.Arrow ((&&&)) + +import Text.ParserCombinators.ReadP + +import System.IO +import Control.Exception (bracket) + +import XMonad.Util.EZConfig (mkKeymap) + + + +-- $usage +-- The @xmonad.hs@ file is very minimal when used with PlainConfig. +-- It typically contains only the following: +-- +-- > module Main where +-- > import XMonad +-- > import XMonad.Config.PlainConfig (plainConfig) +-- > main = plainConfig +-- +-- The 'plainConfig' function parses @~\/.xmonad\/xmonad.conf@, +-- the format of which is described below. + + +-- $layouts +-- Only 'Tall', 'Wide' and 'Full' are supported at present. + + + +-- $keys +-- +-- Key bindings are specified as a pair of an arbitrary EZConfig and +-- one of the following: +-- +-- @ Name Haskell equivalent Default binding(s)@ +-- +-- * @spawn \ spawn \"\\" none@ +-- +-- * @kill kill M-S-c@ +-- +-- * @nextLayout sendMessage NextLayout M-\@ +-- +-- * @refresh refresh M-S-\@ +-- +-- * @focusDown windows W.focusDown M-\, M-j@ +-- +-- * @focusUp windows W.focusUp M-k@ +-- +-- * @focusMaster windows W.focusMaster M-m@ +-- +-- * @swapDown windows W.swapDown M-S-j@ +-- +-- * @swapUp windows W.swapUp M-S-k@ +-- +-- * @swapMaster windows W.swapMaster M-\@ +-- +-- * @shrink sendMessage Shrink M-h@ +-- +-- * @expand sendMessage Expand M-l@ +-- +-- * @sink withFocused $ windows . W.sink M-t@ +-- +-- * @incMaster sendMessage (IncMasterN 1) M-,@ +-- +-- * @decMaster sendMessage (IncMasterN (-1)) M-.@ +-- +-- * @quit io $ exitWith ExitSuccess M-S-q@ +-- +-- * @restart broadcastMessageReleaseResources >> restart \"xmonad\" True M-q@ +-- + + +-- $notes +-- Submaps are allowed. +-- These settings override the defaults. Changes made here will be used over +-- the default bindings for those keys. + + +-- $example +-- An example @~\/.xmonad\/xmonad.conf@ file follows: +-- +-- @modMask = 3@ +-- +-- @numlockMask = 2@ +-- +-- @borderWidth = 1@ +-- +-- @normalBorderColor = #dddddd@ +-- +-- @focusedBorderColor = #00ff00@ +-- +-- @terminal=urxvt@ +-- +-- @workspaces=[\"1: IRC\",\"2: Web\", \"3\", \"4\", \"5\", \"6\", \"7\", \"8\", \"9\"]@ +-- +-- @focusFollowsMouse=True@ +-- +-- @layouts=[\"Tall\",\"Full\",\"Wide\"]@ +-- +-- @key=(\"M-x t\", \"spawn xmessage Test\")@ +-- +-- @manageHook=(ClassName \"MPlayer\" , \"float\" )@ +-- +-- @manageHook=(ClassName \"Gimp\" , \"float\" )@ +-- +-- @manageHook=(Resource \"desktop_window\", \"ignore\" )@ +-- +-- @manageHook=(Resource \"kdesktop\" , \"ignore\" )@ +-- +-- @manageHook=(Resource \"gnome-panel\" , \"ignore\" )@ +-- + + + + + + +---------------------------------------------------------------- +------ Several functions for parsing the key-value file. ------- +---------------------------------------------------------------- + +parseKVBy :: Char -> ReadP (String,String) +parseKVBy sep = do + skipSpaces + k <- munch1 (\x -> x /= ' ' && x /= sep) + skipSpaces + char kvSep + skipSpaces + v <- munch1 (\x -> x /= ' ') --or EOS + return (k,v) + +parseKVVBy :: Char -> ReadP (String,String) +parseKVVBy sep = do + skipSpaces + k <- munch1 (\x -> x /= ' ' && x /= sep) + skipSpaces + char kvSep + skipSpaces + v <- munch1 (const True) -- until EOS + return (k,v) + + +kvSep :: Char +kvSep = '=' + +parseKV, parseKVV :: ReadP (String,String) +parseKV = parseKVBy kvSep +parseKVV = parseKVVBy kvSep + + + +readKV :: String -> Integer -> RC (String,String) +readKV s ln = case readP_to_S parseKV s of + [((k,v),"")] -> return (k,v) --single, correct parse + [] -> throwError [(ln,"No parse")] + _ -> do + case readP_to_S parseKVV s of + [((k,v),"")] -> return (k,v) --single, correct parse + [] -> throwError [(ln,"No parse")] + xs -> throwError [(ln,"Ambiguous parse: " + ++ show xs)] + + + +isComment :: String -> Bool +isComment = not . null . readP_to_S parseComment + where parseComment = skipSpaces >> char '#' >> return () + -- null means failed parse, so _not_ a comment. + + +isBlank :: String -> Bool +isBlank = null . filter (not . isSpace) + + +type RC = ErrorT [(Integer,String)] Identity + +instance Error [(Integer,String)] where + noMsg = [(-1, "Unknown error.")] + strMsg s = [(-1, s)] + + +parseFile :: [String] -> RC (XConfig Layout) +parseFile ss = parseLines baseConfig theLines + where theLines = filter (not . liftM2 (||) isComment isBlank . snd) + $ zip [1..] ss + + + +parseLines :: XConfig Layout -> [(Integer,String)] -> RC (XConfig Layout) +parseLines = foldM parse + + +parse :: XConfig Layout -> (Integer, String) -> RC (XConfig Layout) +parse xc (ln,s) = do + (k,v) <- readKV s ln + case M.lookup k commands of + Nothing -> throwError [(ln,"Unknown command: "++k)] + Just f -> f v ln xc + + + + +---------------------------------------------------------------- +-- Now the semantic parts, that convert from the relevant -- +-- key-value entries to values in an XConfig -- +---------------------------------------------------------------- + + + +type Command = String -> Integer -> XConfig Layout -> RC (XConfig Layout) + +commands :: M.Map String Command +commands = M.fromList $ + [("modMask" , cmd_modMask ) + ,("numlockMask" , cmd_numlockMask ) + ,("normalBorderColor" , cmd_normalBorderColor ) + ,("focusedBorderColor" , cmd_focusedBorderColor) + ,("terminal" , cmd_terminal ) + ,("workspaces" , cmd_workspaces ) + ,("focusFollowsMouse" , cmd_focusFollowsMouse ) + ,("layouts" , cmd_layouts ) + ,("key" , cmd_key ) + ,("manageHook" , cmd_manageHook ) + ,("borderWidth" , cmd_borderWidth ) + ] + + +-- | Behind-the-scenes helper for both 'cmd_modMask' and 'cmd_numlockMask'. +genericModKey :: (KeyMask -> XConfig Layout) -> Command +genericModKey f s ln _ = do + x <- rcRead s ln :: RC Integer + case lookup x (zip [1..] [mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask]) of + Just y -> return $ f y + Nothing -> throwError [(ln,"Invalid mod key number: "++ show x)] + + +-- | Reads the mod key modifier number. +cmd_modMask :: Command +cmd_modMask s ln xc = genericModKey (\k -> xc{modMask = k}) s ln xc + +-- | Reads the numlock key modifier number. +cmd_numlockMask :: Command +cmd_numlockMask s ln xc = genericModKey (\k -> xc{numlockMask = k}) s ln xc + + +-- | Reads the border width. +cmd_borderWidth :: Command +cmd_borderWidth s ln xc = do + w <- rcRead s ln + return $ xc { borderWidth = w } + + +-- | Reads the colors but just keeps them as RRGGBB Strings. +cmd_normalBorderColor, cmd_focusedBorderColor :: Command +cmd_normalBorderColor s _ xc = return $ xc{ normalBorderColor = s } +cmd_focusedBorderColor s _ xc = return $ xc{ focusedBorderColor = s } + + +-- | Reads the terminal. It is just a String, no parsing. +cmd_terminal :: Command +cmd_terminal s _ xc = return $ xc{ terminal = s } + + +-- | Reads the workspace tag list. This is given as a Haskell [String]. +cmd_workspaces :: Command +cmd_workspaces s ln xc = rcRead s ln >>= \x -> return xc{ workspaces = x } + + +-- | Reads the focusFollowsMouse, as a Haskell Bool. +cmd_focusFollowsMouse :: Command +cmd_focusFollowsMouse s ln xc = rcRead s ln >>= + \x -> return xc{focusFollowsMouse = x} + + +-- | The list known layouts, mapped by name. +-- An easy location for improvement is to add more contrib layouts here. +layouts :: M.Map String (Layout Window) +layouts = M.fromList + [("Tall", Layout (Tall 1 (3/100) (1/2))) + ,("Wide", Layout (Mirror (Tall 1 (3/100) (1/2)))) + ,("Full", Layout Full) + ] + + +-- | Expects a [String], the strings being layout names. Quotes required. +-- Draws from the `layouts' list above. +cmd_layouts :: Command +cmd_layouts s ln xc = do + xs <- rcRead s ln -- read the list of strings + let ls = map (id &&& (flip M.lookup) layouts) xs + when (null ls) $ throwError [(ln,"Empty layout list")] + case filter (not . isJust . snd) ls of + [] -> return $ xc{ layoutHook = foldr1 + (\(Layout l) (Layout r) -> + Layout (l ||| r)) (map (fromJust . snd) ls) + } + ys -> throwError $ map (\(x,_) -> (ln, "Unknown layout: "++ x)) ys + + + +-- | A Map from names to key binding actions. +key_actions :: M.Map String (X ()) +key_actions = M.fromList + [("kill" , kill ) + ,("nextLayout" , sendMessage NextLayout ) + --,("prevLayout" , sendMessage PrevLayout ) + --,("resetLayout" , setLayout $ XMonad.layoutHook conf) + ,("refresh" , refresh ) + ,("focusDown" , windows W.focusDown ) + ,("focusUp" , windows W.focusUp ) + ,("focusMaster" , windows W.focusMaster ) + ,("swapMaster" , windows W.swapMaster ) + ,("swapDown" , windows W.swapDown ) + ,("swapUp" , windows W.swapUp ) + ,("shrink" , sendMessage Shrink ) + ,("expand" , sendMessage Expand ) + ,("sink" , withFocused $ windows . W.sink) + ,("incMaster" , sendMessage (IncMasterN 1)) + ,("decMaster" , sendMessage (IncMasterN (-1))) + ,("quit" , io $ exitWith ExitSuccess) + ,("restart" , broadcastMessage ReleaseResources + >> restart "xmonad" True) + ] + + +-- | Expects keys as described in the preamble, as +-- (\"EZConfig key name\", \"action name\"), +-- eg. (\"M-S-t\", \"spawn thunderbird\") +-- One key per "key=" line. +cmd_key :: Command +cmd_key s ln xc = do + (k,v) <- rcRead s ln + if "spawn " `isPrefixOf` v + then return $ xc { + keys = \c -> M.union (mkKeymap c + [(k, spawn (drop 6 v))] + ) ((keys xc) c) + } + else do + case M.lookup v key_actions of + Nothing -> throwError [(ln, "Unknown key action \"" ++ v ++ "\"")] + Just ac -> return $ + xc { keys = \c -> M.union (mkKeymap c [(k, ac)]) + ((keys xc) c) + } + + + +-- | Map of names to actions for 'ManageHook's. +manageHook_actions :: M.Map String ManageHook +manageHook_actions = M.fromList + [("float" , doFloat ) + ,("ignore" , doIgnore ) + ] + + +-- | Parses 'ManageHook's in the form given in the preamble. +-- eg. (ClassName \"MPlayer\", \"float\") +cmd_manageHook :: Command +cmd_manageHook s ln xc = do + (k,v) <- rcRead s ln + let q = parseQuery k + if "toWorkspace " `isPrefixOf` v + then return $ xc { manageHook = manageHook xc <+> + (q --> doShift (drop 12 v)) + } + else case M.lookup v manageHook_actions of + Nothing -> throwError [(ln, "Unknown ManageHook action \"" + ++ v ++ "\"")] + Just ac -> return $ xc { manageHook = manageHook xc <+> (q --> ac) } + + + +-- | Core of the ManageHook expression parser. +-- Taken from Roman Cheplyaka's WindowProperties +parseQuery :: Property -> Query Bool +parseQuery (Title s) = title =? s +parseQuery (ClassName s) = className =? s +parseQuery (Resource s) = resource =? s +parseQuery (And p q) = parseQuery p <&&> parseQuery q +parseQuery (Or p q) = parseQuery p <&&> parseQuery q +parseQuery (Not p) = not `fmap` parseQuery p +parseQuery (Const b) = return b + + +-- | Property constructors are quite self-explaining. +-- Taken from Roman Cheplyaka's WindowProperties +data Property = Title String + | ClassName String + | Resource String + | And Property Property + | Or Property Property + | Not Property + | Const Bool + deriving (Read, Show) + + + +-- | A wrapping of the read function into the RC monad. +rcRead :: (Read a) => String -> Integer -> RC a +rcRead s ln = case reads s of + [(x,"")] -> return x + _ -> throwError [(ln, "Failed to parse value")] + + + +-- | The standard Config.hs 'defaultConfig', with the layout wrapped. +baseConfig :: XConfig Layout +baseConfig = defaultConfig{ layoutHook = Layout (layoutHook defaultConfig) } + + + +-- | Core function that attempts to parse @~\/.xmonad\/xmonad.conf@ +readConfig :: IO (Maybe (XConfig Layout)) +readConfig = do + cs <- bracket (openFile "/home/braden/.xmonad/xmonad.conf" ReadMode) + (\h -> hClose h) -- vv force the lazy IO + (\h -> (lines `fmap` hGetContents h) >>= \ss -> + length ss `seq` return ss) + let xce = runIdentity $ runErrorT $ parseFile cs + case xce of + Left es -> mapM_ (\(ln,e) -> + putStrLn $ "readConfig error: line "++show ln++ + ": "++ e) es + >> return Nothing + Right xc -> return $ Just xc + + +-- | Attempts to run readConfig, and checks if it failed. +checkConfig :: IO Bool +checkConfig = isJust `fmap` readConfig + + + +{- REMOVED: It was for debugging, and causes an 'orphaned instances' + warning to boot. + + + +-- | Reads in the config, and then prints the resulting XConfig +dumpConfig :: IO () +dumpConfig = readConfig >>= print + + +instance Show (XConfig Layout) where + show x = "XConfig { " + ++ "normalBorderColor = "++ normalBorderColor x ++", " + ++ "focusedBorderColor = "++ focusedBorderColor x++", " + ++ "terminal = "++ terminal x ++", " + ++ "workspaces = "++ show (workspaces x) ++", " + ++ "numlockMask = "++ show (numlockMask x) ++", " + ++ "modMask = "++ show (modMask x) ++", " + ++ "borderWidth = "++ show (borderWidth x) ++", " + ++ "focusFollowsMouse = "++ show (focusFollowsMouse x) ++", " + ++ "layouts = "++ show (layoutHook x) ++" }" + +-} + +-- | Handles the unwrapping of the Layout. Intended for use as +-- @main = plainConfig@ +plainConfig :: IO () +plainConfig = do + conf <- readConfig + case conf of + (Just xc@XConfig{layoutHook= (Layout l)}) -> + xmonad (xc{ layoutHook = l }) + Nothing -> + spawn $ "xmessage Failed to read xmonad.conf. See xmonad.errors." + hunk ./xmonad-contrib.cabal 106 + XMonad.Config.PlainConfig hunk ./XMonad/Hooks/UrgencyHook.hs 72 +import Control.Applicative ((<$>)) hunk ./XMonad/Hooks/UrgencyHook.hs 77 -import Data.Maybe (listToMaybe) +import Data.Maybe (listToMaybe, maybeToList) hunk ./XMonad/Hooks/UrgencyHook.hs 186 - layoutHook = eventHook (hookMod $ WithUrgencyHook hook Visible) $ layoutHook conf, - logHook = removeVisiblesFromUrgents >> logHook conf + layoutHook = eventHook withUrgency $ layoutHook conf, + logHook = cleanupUrgents sw >> logHook conf hunk ./XMonad/Hooks/UrgencyHook.hs 189 + where withUrgency@(WithUrgencyHook _ sw) = hookMod $ WithUrgencyHook hook Visible hunk ./XMonad/Hooks/UrgencyHook.hs 191 +-- | See 'withUrgencyHookC' for an example use. 'suppressWhen' is a global configuration +-- option, applicable to all urgency hooks, whereas the stuff inside the @{ ... }@ is +-- type-specific. hunk ./XMonad/Hooks/UrgencyHook.hs 205 --- | The logHook action used by 'withUrgencyHook'. -removeVisiblesFromUrgents :: X () -removeVisiblesFromUrgents = do - visibles <- gets mapped - adjustUrgents (\\ (S.toList visibles)) --- TODO: ^ should be based on suppressWhen - hunk ./XMonad/Hooks/UrgencyHook.hs 212 --- Stores the global set of all urgent windows, across workspaces. Not exported -- use +-- | Stores the global set of all urgent windows, across workspaces. Not exported -- use hunk ./XMonad/Hooks/UrgencyHook.hs 269 - whenX (not `fmap` shouldSuppress sw w) + whenX (not <$> shouldSuppress sw w) hunk ./XMonad/Hooks/UrgencyHook.hs 273 -shouldSuppress Visible w = gets $ S.member w . mapped -shouldSuppress OnScreen w = gets $ elem w . W.index . windowset -shouldSuppress Focused w = gets $ maybe False (w ==) . W.peek . windowset -shouldSuppress Never _ = return False +shouldSuppress sw w = elem w <$> suppressibleWindows sw + +cleanupUrgents :: SuppressWhen -> X () +cleanupUrgents sw = do + suppressibles <- suppressibleWindows sw + adjustUrgents (\\ suppressibles) + +suppressibleWindows :: SuppressWhen -> X [Window] +suppressibleWindows Visible = gets $ S.toList . mapped +suppressibleWindows OnScreen = gets $ W.index . windowset +suppressibleWindows Focused = gets $ maybeToList . W.peek . windowset +suppressibleWindows Never = return [] hunk ./XMonad/Actions/SwapWorkspaces.hs 20 - swapWorkspaces + swapTo, + swapWorkspaces, + WSDirection(..) hunk ./XMonad/Actions/SwapWorkspaces.hs 25 +import XMonad (windows, X()) hunk ./XMonad/Actions/SwapWorkspaces.hs 27 +import XMonad.Actions.CycleWS +import XMonad.Util.WorkspaceCompare hunk ./XMonad/Actions/SwapWorkspaces.hs 53 +-- | Say @swapTo Next@ or @swapTo Prev@ to move your current workspace. +-- This is an @X ()@ so can be hooked up to your keybindings directly. +swapTo :: WSDirection -> X () +swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurrent + hunk ./XMonad/Actions/Search.hs 33 - wikipedia + wikipedia, + youtube hunk ./XMonad/Actions/Search.hs 93 +* 'youtube' -- Youtube video search. + hunk ./XMonad/Actions/Search.hs 192 - scholar, wayback, wikipedia :: SearchEngine + scholar, wayback, wikipedia, youtube :: SearchEngine hunk ./XMonad/Actions/Search.hs 202 +youtube = simpleEngine "http://www.youtube.com/results?search_type=search_videos&search_query=" hunk ./XMonad/Actions/Search.hs 18 - simpleEngine, + SearchEngine, hunk ./XMonad/Actions/Search.hs 137 --- | A customized prompt indicating we are searching, and not anything else. -data Search = Search +-- | A customized prompt indicating we are searching, and the name of the site. +data Search = Search Name hunk ./XMonad/Actions/Search.hs 140 - showXPrompt Search = "Search: " + showXPrompt (Search name)= "Search [" ++ name ++ "]: " hunk ./XMonad/Actions/Search.hs 169 -type SearchEngine = String -> String +type Site = String +type Name = String +data SearchEngine = SearchEngine Name Site hunk ./XMonad/Actions/Search.hs 175 -search :: Browser -> SearchEngine -> Query -> X () -search browser site query = safeSpawn browser $ site query +search :: Browser -> Site -> Query -> X () +search browser site query = safeSpawn browser (site ++ (escape query)) hunk ./XMonad/Actions/Search.hs 179 - appends it to the base. You can easily define a new engine locally using simpleEngine + appends it to the base. You can easily define a new engine locally using SearchEngine hunk ./XMonad/Actions/Search.hs 182 - > newEngine = simpleEngine "http://site.com/search=" + > newEngine = SearchEngine "site" "http://site.com/search=" hunk ./XMonad/Actions/Search.hs 189 -simpleEngine :: Query -> SearchEngine -simpleEngine site query = site ++ escape query +--simpleEngine :: Name -> Query -> SearchEngine +--simpleEngine site query = site ++ escape query hunk ./XMonad/Actions/Search.hs 195 -amazon = simpleEngine "http://www.amazon.com/exec/obidos/external-search?index=all&keyword=" -dictionary = simpleEngine "http://dictionary.reference.com/browse/" -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=" -maps = simpleEngine "http://maps.google.com/maps?q=" -mathworld = simpleEngine "http://mathworld.wolfram.com/search/?query=" -scholar = simpleEngine "http://scholar.google.com/scholar?q=" -wikipedia = simpleEngine "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search=" -youtube = simpleEngine "http://www.youtube.com/results?search_type=search_videos&search_query=" +amazon = SearchEngine "amazon" "http://www.amazon.com/exec/obidos/external-search?index=all&keyword=" +dictionary = SearchEngine "dictionary" "http://dictionary.reference.com/browse/" +google = SearchEngine "google" "http://www.google.com/search?num=100&q=" +hoogle = SearchEngine "hoogle" "http://www.haskell.org/hoogle/?q=" +imdb = SearchEngine "imdb" "http://www.imdb.com/Find?select=all&for=" +maps = SearchEngine "maps" "http://maps.google.com/maps?q=" +mathworld = SearchEngine "mathworld" "http://mathworld.wolfram.com/search/?query=" +scholar = SearchEngine "scholar" "http://scholar.google.com/scholar?q=" +wikipedia = SearchEngine "wikipedia" "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search=" +youtube = SearchEngine "youtube" "http://www.youtube.com/results?search_type=search_videos&search_query=" hunk ./XMonad/Actions/Search.hs 208 -wayback = simpleEngine "http://web.archive.org/" +wayback = SearchEngine "wayback" "http://web.archive.org/" hunk ./XMonad/Actions/Search.hs 214 -promptSearchBrowser config browser engine = mkXPrompt Search config (getShellCompl []) $ search browser engine +promptSearchBrowser config browser (SearchEngine name site) = mkXPrompt (Search name) config (getShellCompl []) $ search browser site hunk ./XMonad/Actions/Search.hs 229 -selectSearchBrowser browser searchengine = search browser searchengine =<< getSelection +selectSearchBrowser browser (SearchEngine _ site) = search browser site =<< getSelection hunk ./XMonad/Config/PlainConfig.hs 474 - cs <- bracket (openFile "/home/braden/.xmonad/xmonad.conf" ReadMode) + dir <- getXMonadDir + cs <- bracket (openFile (dir++"/xmonad.conf") ReadMode) hunk ./XMonad/Layout/ScratchWorkspace.hs 1 -{-# OPTIONS -fglasgow-exts #-} ------------------------------------------------------------------------------ --- | --- Module : XMonad.Layout.ScratchWorkspace --- Copyright : (c) Braden Shepherdson, David Roundy 2008 --- License : BSD-style (as xmonad) --- --- Maintainer : Braden.Shepherdson@gmail.com --- Stability : unstable --- Portability : unportable - -module XMonad.Layout.ScratchWorkspace ( toggleScratchWorkspace ) where - -import Data.List ( partition ) -import Control.Monad ( guard ) - -import XMonad -import XMonad.Core -import qualified XMonad.StackSet as W - -hiddenRect :: Rectangle -hiddenRect = Rectangle (-1) (-1) 0 0 - -scratchName :: String -scratchName = "*scratch*" - --- This module uses an ugly hack, which is to create a special screen for --- the scratch workspace. This screen is then moved onto a visible area or --- away when you ask for the scratch workspace to be shown or hidden. - --- This is a workaround for the fact that we don't have anything like --- proper support for hierarchical workspaces, so I use the only hierarchy --- we've got, which is at the screen level. - -toggleScratchWorkspace :: LayoutClass l Int => l Int -> X () -toggleScratchWorkspace l = - do s <- gets windowset - defaultl <- asks (layoutHook . config) - srs <- withDisplay getCleanedScreenInfo - if length srs == 1 + length (W.visible s) - then -- we don't yet have a scratch screen! - if scratchName `W.tagMember` s - then return () -- We'll just bail out of scratchName already exists... - else do let scratchscreen = W.Screen scratch (-1) (SD hiddenRect) - scratch = W.Workspace scratchName defaultl Nothing - s' = s { W.visible = scratchscreen: W.visible s } - modify $ \st -> st { windowset = s' } - refresh - else -- We've already got a scratch (we think) - if length srs /= length (W.visible s) - then -- Something is odd... too many screens are visible! Do nothing. - return () - else -- Yes, it does seem there's a scratch screen already - case partition ((/= -1) . W.screen) $ W.current s : W.visible s of - (others@(c:vs),[scratchscreen]) -> - if screenRect (W.screenDetail scratchscreen) == hiddenRect - then -- we're hidden now, so let's display ourselves - do let r = screenRect $ W.screenDetail c - (rs,_) <- runLayout (W.Workspace "" l (Just $ W.Stack 0 [1] [])) r - let (r0, r1) = case rs of - [(0,ra),(1,rb)] -> (ra,rb) - [(1,ra),(0,rb)] -> (rb,ra) - [(1,ra)] -> (r,ra) - [(0,ra)] -> (ra,r) - _ -> (r,r) - s' = s { W.current = setrect r0 scratchscreen, - W.visible = setrect r1 c : vs } - modify $ \st -> st { windowset = s' } - refresh - else -- we're visible, so now we want to hide - do ml <- handleMessage (W.layout $ W.workspace scratchscreen) (SomeMessage Hide) - let scratchscreen' = case ml of - Nothing -> scratchscreen - Just l' -> scratchscreen - { W.workspace = - (W.workspace scratchscreen) { W.layout = l' } } - mapM_ hide $ W.integrate' $ W.stack $ W.workspace scratchscreen - let modscr scr = do guard $ scratchName /= W.tag (W.workspace scr) - r' <- pickRect (W.screen scr) srs - Just $ setrect r' scr - pickRect _ [z] = Just z - pickRect i (z:zs) | i < 1 = Just z - | otherwise = pickRect (i-1) zs - pickRect _ [] = Nothing - case mapM modscr others of - Just (c':vs') -> - do let s' = s { W.current = c', - W.visible = setrect hiddenRect scratchscreen' : vs' } - modify $ \st -> st { windowset = s' } - refresh - _ -> return () -- weird error! - _ -> -- Something is odd... there doesn't seem to *really* be a scratch screen... - return () - where setrect :: Rectangle -> W.Screen i l a sid ScreenDetail -> W.Screen i l a sid ScreenDetail - setrect x scr = scr {W.screenDetail = (W.screenDetail scr) {screenRect = x}} rmfile ./XMonad/Layout/ScratchWorkspace.hs hunk ./xmonad-contrib.cabal 150 - XMonad.Layout.ScratchWorkspace hunk ./XMonad/Layout/ShowWName.hs 57 - , swn_bgcolor :: String -- ^ Backgorund color + , swn_bgcolor :: String -- ^ Background color hunk ./XMonad/Actions/Search.hs 1 -{- | - Module : XMonad.Actions.Search - Copyright : (C) 2007 Gwern Branwen - License : None; public domain +{- | Module : XMonad.Actions.Search + Copyright : (C) 2007 Gwern Branwen + License : None; public domain hunk ./XMonad/Actions/Search.hs 5 - Maintainer : - Stability : unstable - Portability : unportable + Maintainer : + Stability : unstable + Portability : unportable; depends on XSelection, XPrompt hunk ./XMonad/Actions/Search.hs 9 - A module for easily running Internet searches on web sites through xmonad. - Modeled after the handy Surfraw CLI search tools at . + A module for easily running Internet searches on web sites through xmonad. + Modeled after the handy Surfraw CLI search tools at . hunk ./XMonad/Actions/Search.hs 12 - Additional sites welcomed. --} + Additional sites welcomed. -} hunk ./XMonad/Actions/Search.hs 17 + searchEngine, hunk ./XMonad/Actions/Search.hs 68 - is easily extended to new sites by using 'simpleEngine'. + is easily extended to new sites by using 'searchEngine'. hunk ./XMonad/Actions/Search.hs 177 -{- | 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 SearchEngine - without needing to modify Search.hs: +{- | 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 + exported functions without needing to modify "XMonad.Actions.Search": hunk ./XMonad/Actions/Search.hs 181 - > newEngine = SearchEngine "site" "http://site.com/search=" +> myNewEngine = searchEngine "site" "http://site.com/search=" hunk ./XMonad/Actions/Search.hs 183 - 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 :: Name -> Query -> SearchEngine ---simpleEngine site query = site ++ escape query + The important thing is that the site has a interface which accepts the escaped query + string as part of the URL. Alas, the exact URL to feed searchEngine varies + from site to site, often considerably, so there's no general way to cover this. + + 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. -} +searchEngine :: Name -> Site -> SearchEngine +searchEngine name site = SearchEngine name site hunk ./XMonad/Actions/Search.hs 195 -amazon = SearchEngine "amazon" "http://www.amazon.com/exec/obidos/external-search?index=all&keyword=" -dictionary = SearchEngine "dictionary" "http://dictionary.reference.com/browse/" -google = SearchEngine "google" "http://www.google.com/search?num=100&q=" -hoogle = SearchEngine "hoogle" "http://www.haskell.org/hoogle/?q=" -imdb = SearchEngine "imdb" "http://www.imdb.com/Find?select=all&for=" -maps = SearchEngine "maps" "http://maps.google.com/maps?q=" -mathworld = SearchEngine "mathworld" "http://mathworld.wolfram.com/search/?query=" -scholar = SearchEngine "scholar" "http://scholar.google.com/scholar?q=" -wikipedia = SearchEngine "wikipedia" "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search=" -youtube = SearchEngine "youtube" "http://www.youtube.com/results?search_type=search_videos&search_query=" +amazon = searchEngine "amazon" "http://www.amazon.com/exec/obidos/external-search?index=all&keyword=" +dictionary = searchEngine "dictionary" "http://dictionary.reference.com/browse/" +google = searchEngine "google" "http://www.google.com/search?num=100&q=" +hoogle = searchEngine "hoogle" "http://www.haskell.org/hoogle/?q=" +imdb = searchEngine "imdb" "http://www.imdb.com/Find?select=all&for=" +maps = searchEngine "maps" "http://maps.google.com/maps?q=" +mathworld = searchEngine "mathworld" "http://mathworld.wolfram.com/search/?query=" +scholar = searchEngine "scholar" "http://scholar.google.com/scholar?q=" +wikipedia = searchEngine "wikipedia" "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search=" +youtube = searchEngine "youtube" "http://www.youtube.com/results?search_type=search_videos&search_query=" hunk ./XMonad/Actions/Search.hs 208 -wayback = SearchEngine "wayback" "http://web.archive.org/" +wayback = searchEngine "wayback" "http://web.archive.org/" hunk ./XMonad/Actions/Search.hs 240 + addfile ./XMonad/Layout/StackTile.hs hunk ./XMonad/Layout/StackTile.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.StackTile +-- Copyright : (c) Rickard Gustafsson +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Rickard Gustafsson +-- Stability : unstable +-- Portability : unportable +-- +-- A stacking layout, like dishes but with the ability to resize master pane. +-- Moastly usefull on small screens. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.StackTile ( + -- * Usage + -- $usage + StackTile(..) + ) where + +import XMonad hiding (tile) +import qualified XMonad.StackSet as W +import Control.Monad + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.StackTile +-- +-- Then edit your @layoutHook@ by adding the ResizableTile layout: +-- +-- > myLayouts = StackTile 1 (3/100) (1/2) [] ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +data StackTile a = StackTile !Int !Rational !Rational deriving (Show, Read) + +instance LayoutClass StackTile a where + pureLayout (StackTile nmaster _ frac) r s = zip ws rs + where ws = W.integrate s + rs = tile frac r nmaster (length ws) + + pureMessage (StackTile nmaster delta frac) m = + msum [fmap resize (fromMessage m) + ,fmap incmastern (fromMessage m)] + + where resize Shrink = StackTile nmaster delta (max 0 $ frac-delta) + resize Expand = StackTile nmaster delta (min 1 $ frac+delta) + incmastern (IncMasterN d) = StackTile (max 0 (nmaster+d)) delta frac + + description _ = "StackTile" + +tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle] +tile f r nmaster n = if n <= nmaster || nmaster == 0 + then splitHorizontally n r + else splitHorizontally nmaster r1 ++ splitVertically (n-nmaster) r2 -- two columns + where (r1,r2) = splitVerticallyBy f r hunk ./xmonad-contrib.cabal 156 + XMonad.Layout.StackTile hunk ./XMonad/Layout/StackTile.hs 36 --- > myLayouts = StackTile 1 (3/100) (1/2) [] ||| etc.. +-- > myLayouts = StackTile 1 (3/100) (1/2) ||| etc.. addfile ./XMonad/Config/Xfce.hs hunk ./XMonad/Config/Xfce.hs 1 +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Config.Xfce +-- Copyright : (c) Ivan Miljenovic +-- License : BSD +-- +-- Maintainer : Ivan Miljenovic +-- +-- This module provides a config suitable for use with the Xfce desktop +-- environment. + +module XMonad.Config.Xfce ( + -- * Usage + -- -- $usage + xfceConfig + ) where + +import XMonad +import XMonad.Config.Desktop + +import qualified Data.Map as M + +-- $usage +-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad +-- > import XMonad.Config.Xfce +-- > +-- > main = xmonad xfceConfig +-- + +xfceConfig = desktopConfig + { terminal = "Terminal" + , keys = \c -> xfceKeys c `M.union` keys desktopConfig c } + +xfceKeys (XConfig {modMask = modm}) = M.fromList $ + [ ((modm, xK_p), spawn "xfrun4") + , ((modm .|. shiftMask, xK_p), spawn "xfce4-appfinder") + , ((modm .|. shiftMask, xK_q), spawn "xfce4-session-logout") + ] addfile ./XMonad/Actions/Plane.hs hunk ./XMonad/Actions/Plane.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.Plane +-- Copyright : (c) Malebria , +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Malebria +-- Stability : unstable +-- Portability : unportable +-- +-- This module has functions to navigate through workspaces in a bidimensional +-- manner. It allows the organization of workspaces in columns, and provides +-- functions to move and shift windows in all four directions (left, up, right +-- and down) possible in a surface. +-- +-- This functionality was inspired by GNOME (finite) and KDE (infinite) +-- keybindings for workspace navigation, and by "XMonad.Actions.CycleWS" for +-- the idea of applying this approach to XMonad. +----------------------------------------------------------------------------- + +module XMonad.Actions.Plane + ( + -- * Usage + -- $usage + + -- * Data types + Direction (..) + , Limits (..) + + -- * Navigating through workspaces + -- $navigating + , planeShift + , planeMove + ) + where + +import Control.Monad +import Data.List hiding (union) +import Data.Maybe + +import XMonad +import XMonad.StackSet hiding (workspaces) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Actions.Plane +-- > +-- > main = xmonad defaultConfig {keys = myKeys} +-- > +-- > myKeys conf = union (keys defaultConfig conf) $ myNewKeys conf +-- > +-- > myNewkeys (XConfig {modMask = m}) = +-- > fromList +-- > [ ((keyMask .|. m, keySym), function 3 Finite direction) +-- > | (keySym, direction) <- zip [xK_Left .. xK_Down] $ enumFrom ToLeft +-- > , (keyMask, function) <- [(0, planeMove), (shiftMask, planeShift)] +-- > ] +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Direction to go in the plane. +data Direction = ToLeft | ToUp | ToRight | ToDown deriving Enum + +-- | Defines whether it's a finite or a circular organization of workspaces. +data Limits + = Finite -- ^ When you're at a edge of the plane, there's no way to move + -- to the next region. + | Circular -- ^ If you try to move, you'll get to the other edge, on the + -- other side. + deriving Eq + +-- $navigating +-- +-- There're two parameters that must be provided to navigate, and it's a good +-- idea to use them with the same values in each keybinding. +-- +-- The first is the number of columns in which the workspaces are going to be +-- organized. It's possible to use a number of columns that is not a divisor +-- of the number of workspaces, but the results are better when using a +-- divisor. If it's not a divisor, the last line will have the remaining +-- workspaces. +-- +-- The other one is 'Limits'. + +-- | Shift a window to the next workspace in 'Direction'. Note that this will +-- also move to the next workspace. +planeShift + :: Int -- ^ Number of columns. + -> Limits + -> Direction + -> X () +planeShift = plane shift' + +shift' :: + (Eq s, Eq i, Ord a) => i -> StackSet i l a s sd -> StackSet i l a s sd +shift' area = greedyView area . shift area + +-- | Move to the next workspace in 'Direction'. +planeMove + :: Int -- ^ Number of columns. + -> Limits + -> Direction + -> X () +planeMove = plane greedyView + +plane :: + (WorkspaceId -> WindowSet -> WindowSet) -> Int -> Limits -> Direction -> + X () +plane function columns limits direction = do + state <- get + xconf <- ask + let vertical f = + if mod currentWS columns >= mod areas columns + then mod (f currentWS columns) $ div areas columns * columns + else mod (f currentWS columns) $ ((div areas columns + 1) * columns) + horizontal f = mod (f currentWS) columns + line * columns + line = div currentWS columns + column = mod currentWS columns + currentWS = fromJust mCurrentWS + mCurrentWS = elemIndex (currentTag $ windowset state) areaNames + run condition position = + when (limits == Circular || condition) $ + windows $ function $ areaNames !! position + areas = length areaNames + areaNames = workspaces $ config $ xconf + + when (isJust mCurrentWS) $ + case direction of + ToUp -> run (line /= 0 ) $ vertical (-) + ToDown -> run (currentWS + columns < areas) $ vertical (+) + ToLeft -> run (column /= 0 ) $ horizontal pred + ToRight -> run (column /= columns - 1 ) $ horizontal succ hunk ./xmonad-contrib.cabal 88 + XMonad.Actions.Plane hunk ./XMonad/Hooks/EwmhDesktops.hs 126 + a_cw <- getAtom "_NET_CLOSE_WINDOW" hunk ./XMonad/Hooks/EwmhDesktops.hs 139 + else if mt == a_cw then do + windows $ W.focusWindow w + kill addfile ./XMonad/Hooks/FadeInactive.hs hunk ./XMonad/Hooks/FadeInactive.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.FadeInactive +-- Copyright : (c) 2008 Justin Bogner +-- License : BSD +-- +-- Maintainer : Justin Bogner +-- Stability : unstable +-- Portability : unportable +-- +-- Makes XMonad set the _NET_WM_WINDOW_OPACITY atom for inactive windows, +-- which causes those windows to become slightly translucent if something +-- like xcompmgr is running +----------------------------------------------------------------------------- +module XMonad.Hooks.FadeInactive ( + -- * Usage + -- $usage + fadeInactiveLogHook + ) where + +import XMonad +import qualified XMonad.StackSet as W +import Control.Monad (forM_) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad +-- > import XMonad.Hooks.FadeInactive +-- > +-- > myLogHook :: X () +-- > myLogHook = fadeInactiveLogHook +-- > +-- > main = xmonad defaultConfig { logHook = myLogHook } +-- +-- you will need to have xcompmgr +-- or something similar for this to do anything +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +-- | +-- sets the opacity of a window +setOpacity :: Window -> Integer -> X () +setOpacity w t = withDisplay $ \dpy -> do + a <- getAtom "_NET_WM_WINDOW_OPACITY" + c <- getAtom "CARDINAL" + io $ changeProperty32 dpy w a c propModeReplace [fromIntegral t] + +-- | +-- fades a window out by setting the opacity to an arbitrary amount +fadeOut :: Window -> X () +fadeOut = flip setOpacity 0xdddddddd + +-- | +-- makes a window completely opaque +fadeIn :: Window -> X () +fadeIn = flip setOpacity 0xffffffff + +-- | +-- lowers the opacity of inactive windows +fadeInactiveLogHook :: X () +fadeInactiveLogHook = withWindowSet $ \s -> + forM_ (concatMap visibleWins $ W.current s : W.visible s) fadeOut >> + withFocused fadeIn + where + visibleWins = maybe [] unfocused . W.stack . W.workspace + unfocused (W.Stack _ l r) = l ++ r hunk ./xmonad-contrib.cabal 112 + XMonad.Hooks.FadeInactive hunk ./XMonad/Hooks/FadeInactive.hs 32 --- > myLogHook = fadeInactiveLogHook +-- > myLogHook = fadeInactiveLogHook fadeAmount +-- > where fadeAmount = 0xdddddddd hunk ./XMonad/Hooks/FadeInactive.hs 37 +-- fadeAmount can be any integer hunk ./XMonad/Hooks/FadeInactive.hs 58 --- fades a window out by setting the opacity to an arbitrary amount -fadeOut :: Window -> X () -fadeOut = flip setOpacity 0xdddddddd +-- fades a window out by setting the opacity +fadeOut :: Integer -> Window -> X () +fadeOut amt = flip setOpacity amt hunk ./XMonad/Hooks/FadeInactive.hs 68 --- lowers the opacity of inactive windows -fadeInactiveLogHook :: X () -fadeInactiveLogHook = withWindowSet $ \s -> - forM_ (concatMap visibleWins $ W.current s : W.visible s) fadeOut >> +-- lowers the opacity of inactive windows to the specified amount +fadeInactiveLogHook :: Integer -> X () +fadeInactiveLogHook amt = withWindowSet $ \s -> + forM_ (concatMap visibleWins $ W.current s : W.visible s) (fadeOut amt) >> hunk ./XMonad/Actions/WindowNavigation.hs 48 --- - logHook? +-- - logHook? (2+1, start at master, j,j,a) hunk ./XMonad/Hooks/UrgencyHook.hs 152 --- to your .screenrc, or hit @C-a C-g@ within a running @screen@ session for a --- temporary fix. +-- to your .screenrc, or hit @C-a C-g@ within a running @screen@ session for an +-- immediate but temporary fix. hunk ./XMonad/Actions/WindowNavigation.hs 48 --- - logHook? (2+1, start at master, j,j,a) --- - cleanup (including inr) hunk ./XMonad/Actions/WindowNavigation.hs 49 +-- - monad for WNState? +-- - cleanup (including inr) hunk ./XMonad/Actions/WindowNavigation.hs 71 - `M.union` keys conf cnf } + `M.union` keys conf cnf, + logHook = logHook conf >> trackMovement posRef } hunk ./XMonad/Actions/WindowNavigation.hs 101 -withTargetWindow adj posRef dir = fromCurrentPoint $ \win pos -> do +withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do hunk ./XMonad/Actions/WindowNavigation.hs 106 - where fromCurrentPoint f = withFocused $ \win -> do - currentPosition posRef >>= f win + +trackMovement :: IORef WNState -> X () +trackMovement posRef = fromCurrentPoint posRef $ \win pos -> do + windowRect win >>= flip whenJust (setPosition posRef pos . snd) + +fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X () +fromCurrentPoint posRef f = withFocused $ \win -> do + currentPosition posRef >>= f win hunk ./XMonad/Actions/WindowNavigation.hs 3 --- Module : XMonad.Layout.WindowNavigation +-- Module : XMonad.Actions.WindowNavigation hunk ./XMonad/Actions/WindowNavigation.hs 9 --- This is a rewrite of "XMonad.Layout.WindowNavigation", for the purposes of --- code cleanup and Xinerama support. It's not complete, so you'll want to --- use that one for now. +-- This is a rewrite of "XMonad.Layout.WindowNavigation". WindowNavigation +-- lets you assign keys to move up\/down\/left\/right, based on actual cartesian +-- window coordinates, rather than just going j\/k on the stack. hunk ./XMonad/Actions/WindowNavigation.hs 13 --- WindowNavigation lets you assign keys to move up/down/left/right, based on --- actual cartesian window coordinates, rather than just going j/k on the stack. +-- This module differs from the other in a few ways: +-- +-- (1) You can go up\/down\/left\/right across multiple screens. +-- +-- (2) It doesn't provide little border colors for your neighboring windows. +-- +-- (3) It doesn't provide the \'Move\' action, which seems to be related to +-- the XMonad.Layout.Combo extension. +-- +-- (4) It tries to be slightly smarter about tracking your current position. +-- +-- (5) Configuration is different. hunk ./XMonad/Actions/WindowNavigation.hs 55 --- Don't use it! What, are you crazy? +-- To use it, you're going to apply the 'withWindowNavigation' function. +-- 'withWindowNavigation' performs some IO operations, so the syntax you'll use +-- is the same as the spawnPipe example in "XMonad.Hooks.DynamicLog". +-- In particular: +-- +-- > main = do +-- > config <- withWindowNavigation (xK_w, xK_a, xK_s, xK_d) +-- > $ defaultConfig { ... } +-- > xmonad config +-- +-- Here, we pass in the keys for navigation in counter-clockwise order from up. +-- It creates keybindings for @modMask@ to move to window, and @modMask .|. shiftMask@ +-- to swap windows. +-- +-- If you want more flexibility over your keybindings, you can use +-- 'withWindowNavigationKeys', which takes a list of @keys@-esque entries rather +-- than a tuple of the four directional keys. See the source code of +-- 'withWindowNavigation' for an example. hunk ./XMonad/Actions/WindowNavigation.hs 75 --- - documentation :) hunk ./XMonad/Actions/WindowNavigation.hs 77 +-- - more documentation hunk ./XMonad/Hooks/UrgencyHook.hs 35 + -- * Troubleshooting + -- $troubleshooting + hunk ./XMonad/Hooks/UrgencyHook.hs 130 +-- $troubleshooting +-- +-- There are three steps to get right: +-- +-- 1. The X client must set the UrgencyHint flag. How to configure this +-- depends on the application. If you're using a terminal app, this is in +-- two parts: +-- +-- * The console app must send a ^G (bell). In bash, a helpful trick is +-- @sleep 1; echo -e \'\a\'@. +-- +-- * The terminal must convert the bell into UrgencyHint. +-- +-- 2. XMonad must be configured to notice UrgencyHints. If you've added +-- withUrgencyHook, you may need to hit mod-shift-space to reset the layout. +-- +-- 3. The dzen must run when told. Run @dzen2 -help@ and make sure that it +-- supports all of the arguments you told DzenUrgencyHook to pass it. Also, +-- set up a keybinding to the 'dzen' action in "XMonad.Util.Dzen" to test +-- if that works. +-- +-- As best you can, try to isolate which one(s) of those is failing. + hunk ./XMonad/Actions/Plane.hs 115 - if mod currentWS columns >= mod areas columns - then mod (f currentWS columns) $ div areas columns * columns - else mod (f currentWS columns) $ ((div areas columns + 1) * columns) - horizontal f = mod (f currentWS) columns + line * columns + if column >= areasColumn + then mod (f currentWS columns) $ areasLine * columns + else mod (f currentWS columns) $ (areasLine + 1) * columns + + horizontal f = + if line < areasLine + then mod (f column) columns + lineNumber + else mod (f column) areasColumn + lineNumber + + areasLine = div areas columns + areasColumn = mod areas columns + lineNumber = line * columns hunk ./XMonad/Actions/Plane.hs 12 --- manner. It allows the organization of workspaces in columns, and provides +-- manner. It allows the organization of workspaces in lines, and provides hunk ./XMonad/Actions/Plane.hs 79 --- The first is the number of columns in which the workspaces are going to be --- organized. It's possible to use a number of columns that is not a divisor +-- The first is the number of lines in which the workspaces are going to be +-- organized. It's possible to use a number of lines that is not a divisor hunk ./XMonad/Actions/Plane.hs 90 - :: Int -- ^ Number of columns. + :: Int -- ^ Number of lines. hunk ./XMonad/Actions/Plane.hs 111 -plane function columns limits direction = do +plane function numberLines limits direction = do hunk ./XMonad/Actions/Plane.hs 114 - let vertical f = - if column >= areasColumn - then mod (f currentWS columns) $ areasLine * columns - else mod (f currentWS columns) $ (areasLine + 1) * columns hunk ./XMonad/Actions/Plane.hs 115 + let hunk ./XMonad/Actions/Plane.hs 121 + vertical f = + if column >= areasColumn + then mod (f currentWS columns) $ areasLine * columns + else mod (f currentWS columns) $ (areasLine + 1) * columns + + lineNumber = line * columns hunk ./XMonad/Actions/Plane.hs 129 - lineNumber = line * columns hunk ./XMonad/Actions/Plane.hs 131 + + columns = + if mod areas numberLines == 0 then preColumns else preColumns + 1 + hunk ./XMonad/Actions/Plane.hs 136 + preColumns = div areas numberLines hunk ./XMonad/Actions/Plane.hs 138 + areas = length areaNames + hunk ./XMonad/Actions/Plane.hs 143 - areas = length areaNames + hunk ./xmonad-contrib.cabal 109 + XMonad.Config.Xfce hunk ./XMonad/Prompt.hs 323 + | ks == xK_w -> killWord Prev >> go hunk ./XMonad/Prompt.hs 46 + , historyCompletion hunk ./XMonad/Prompt.hs 784 +-- | 'historyCompletion' provides a canned completion function much like +-- getShellCompl; you pass it to mkXPrompt, and it will make completions work +-- from the query history stored in ~/.xmonad/history. +historyCompletion :: ComplFunction +historyCompletion = \x -> liftM (filter $ isInfixOf x) readHistoryIO + +-- We need to define this locally because there is no function with the type "XP a -> IO a", and +-- 'getHistory' is uselessly of the type "XP [String]". +readHistoryIO :: IO [String] +readHistoryIO = do (hist,_) <- readHistory + return $ map command_history hist hunk ./XMonad/Actions/Search.hs 43 -import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig()) -import XMonad.Prompt.Shell (getBrowser, getShellCompl) +import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig(), historyCompletion) +import XMonad.Prompt.Shell (getBrowser) hunk ./XMonad/Actions/Search.hs 214 -promptSearchBrowser config browser (SearchEngine name site) = mkXPrompt (Search name) config (getShellCompl []) $ search browser site +promptSearchBrowser config browser (SearchEngine name site) = mkXPrompt (Search name) config (historyCompletion) $ search browser site hunk ./XMonad/Util/Scratchpad.hs 16 --- By default, your xmonad terminal is used, and mod+s is the hotkey. +-- By default, your xmonad terminal is used. hunk ./XMonad/Util/Scratchpad.hs 25 --- Add the following to your xmonad.hs keybindings to use the default mod+s: --- --- > scratchpadSpawnDefault conf --- --- Or specify your own key binding, with the action: +-- Bind the following to a key in your xmonad.hs keybindings: hunk ./XMonad/Util/Scratchpad.hs 29 +-- Where @conf@ is the configuration. +-- hunk ./XMonad/Util/Scratchpad.hs 38 - scratchpadSpawnDefault - ,scratchpadSpawnAction + scratchpadSpawnAction hunk ./XMonad/Util/Scratchpad.hs 50 --- | Complete key binding. Pops up the terminal on mod+s. -scratchpadSpawnDefault :: XConfig l -- ^ The configuration, to retrieve terminal and modMask - -> ((KeyMask, KeySym), X ()) -scratchpadSpawnDefault conf = ((modMask conf, xK_s), scratchpadSpawnAction conf) - - hunk ./XMonad/Util/Scratchpad.hs 64 +-- eg. +-- +-- > scratchpadManageHook (W.RationalRect 0.25 0.375 0.5 0.25) +-- hunk ./XMonad/Util/Scratchpad.hs 39 + ,scratchpadSpawnActionTerminal hunk ./XMonad/Util/Scratchpad.hs 57 +-- | Action to pop up the terminal, with a directly specified terminal. +scratchpadSpawnActionTerminal :: String -- ^ Name of the terminal program + -> X () +scratchpadSpawnActionTerminal term = spawn $ term ++ " -title scratchpad" + hunk ./XMonad/Actions/DynamicWorkspaces.hs 20 + addHiddenWorkspace, hunk ./XMonad/Actions/DynamicWorkspaces.hs 104 + +-- | Add a new hidden workspace with the given name. hunk ./XMonad/Util/Scratchpad.hs 13 +----------------------------------------------------------------------------- + +module XMonad.Util.Scratchpad ( + -- * Usage + -- $usage + scratchpadSpawnAction + ,scratchpadSpawnActionTerminal + ,scratchpadManageHookDefault + ,scratchpadManageHook + ) where + +import XMonad +import XMonad.Core +import XMonad.Hooks.ManageHelpers (doRectFloat) +import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace) + +import Control.Monad (filterM) + +import qualified XMonad.StackSet as W + + +-- $usage +-- Bind a key to 'scratchpadSpawnAction' +-- Pressing it will spawn the terminal, or bring it to the current +-- workspace if it already exists. +-- Pressing the key with the terminal on the current workspace will +-- send it to a hidden workspace called @SP@. +-- +-- If you already have a workspace called @SP@, it will use that. +-- @SP@ will also appear in xmobar and dzen status bars. You can tweak your +-- @dynamicLog@ settings to filter it out if you like. +-- hunk ./XMonad/Util/Scratchpad.hs 67 ------------------------------------------------------------------------------ - -module XMonad.Util.Scratchpad ( - scratchpadSpawnAction - ,scratchpadSpawnActionTerminal - ,scratchpadManageHookDefault - ,scratchpadManageHook - ) where - -import XMonad -import XMonad.Core -import XMonad.Hooks.ManageHelpers (doRectFloat) -import qualified XMonad.StackSet hunk ./XMonad/Util/Scratchpad.hs 73 -scratchpadSpawnAction conf = spawn $ terminal conf ++ " -title scratchpad" +scratchpadSpawnAction conf = + scratchpadAction $ spawn $ terminal conf ++ " -title scratchpad" hunk ./XMonad/Util/Scratchpad.hs 80 -scratchpadSpawnActionTerminal term = spawn $ term ++ " -title scratchpad" +scratchpadSpawnActionTerminal term = + scratchpadAction $ spawn $ term ++ " -title scratchpad" + + + + +-- The heart of the new summon/banish terminal. +-- The logic is thus: +-- 1. if the scratchpad is on the current workspace, send it to the hidden one. +-- - if the scratchpad workspace doesn't exist yet, create it first. +-- 2. if the scratchpad is elsewhere, bring it here. +scratchpadAction :: X () -> X () +scratchpadAction action = withWindowSet $ \s -> do + filterCurrent <- filterM (runQuery scratchpadQuery) + ( (maybe [] W.integrate + . W.stack + . W.workspace + . W.current) s) + case filterCurrent of + (x:_) -> do + if null (filter ( (== scratchpadWorkspaceTag) . W.tag) (W.workspaces s)) + then addHiddenWorkspace scratchpadWorkspaceTag + else return () + windows (W.shiftWin scratchpadWorkspaceTag x) + [] -> do + filterAll <- filterM (runQuery scratchpadQuery) (W.allWindows s) + case filterAll of + (x:_) -> windows (W.shiftWin (W.currentTag s) x) + [] -> action -- run the provided action to spawn it. + + +-- factored out since it appears in several places +scratchpadWorkspaceTag :: String +scratchpadWorkspaceTag = "SP" + +-- factored out since this is common to both the ManageHook and the action +scratchpadQuery :: Query Bool +scratchpadQuery = title =? "scratchpad" hunk ./XMonad/Util/Scratchpad.hs 126 --- | The ManageHook, with a user-specified StackSet.RationalRect. +-- | The ManageHook, with a user-specified StackSet.RationalRect, hunk ./XMonad/Util/Scratchpad.hs 130 --- -scratchpadManageHook :: XMonad.StackSet.RationalRect -- ^ User-specified screen rectangle. +scratchpadManageHook :: W.RationalRect -- ^ User-specified screen rectangle. hunk ./XMonad/Util/Scratchpad.hs 132 -scratchpadManageHook rect = title =? "scratchpad" --> doRectFloat rect +scratchpadManageHook rect = scratchpadQuery --> doRectFloat rect hunk ./XMonad/Util/Scratchpad.hs 135 -scratchpadDefaultRect :: XMonad.StackSet.RationalRect -scratchpadDefaultRect = XMonad.StackSet.RationalRect 0.25 0.375 0.5 0.25 +scratchpadDefaultRect :: W.RationalRect +scratchpadDefaultRect = W.RationalRect 0.25 0.375 0.5 0.25 hunk ./XMonad/Prompt.hs 59 +import Data.Bits ((.&.)) hunk ./XMonad/Prompt.hs 313 - | mask == controlMask = + | (mask .&. controlMask) > 0 = hunk ./XMonad/Config/Desktop.hs 37 -desktopLayoutModifiers = avoidStruts . ewmhDesktopsLayout +desktopLayoutModifiers layout = avoidStruts $ ewmhDesktopsLayout layout hunk ./XMonad/Hooks/EwmhDesktops.hs 18 + EwmhDesktopsHook, hunk ./XMonad/Config/Droundy.hs 33 +import XMonad.Layout.Magnifier ( maximizeVertical, MagnifyMsg(Toggle) ) hunk ./XMonad/Config/Droundy.hs 66 - , ((modMask x, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms - , ((modMask x .|. shiftMask, xK_space ), setLayout $ layoutHook x) -- %! Reset the layouts on the current workspace to default + , ((modMask x .|. shiftMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms + , ((modMask x .|. controlMask .|. shiftMask, xK_L ), setLayout $ layoutHook x) -- %! Reset the layouts on the current workspace to default hunk ./XMonad/Config/Droundy.hs 112 + , ((modMask x, xK_space), sendMessage Toggle) hunk ./XMonad/Config/Droundy.hs 126 - toggleLayouts Full $ avoidStruts $ + maximizeVertical $ toggleLayouts Full $ avoidStruts $ hunk ./XMonad/Config/Droundy.hs 136 - , normalBorderColor = "#dddddd" -- Border color for unfocused windows. + , normalBorderColor = "#222222" -- Border color for unfocused windows. hunk ./XMonad/Layout/Magnifier.hs 28 + maximizeVertical, hunk ./XMonad/Layout/Magnifier.hs 84 -magnifier = ModifiedLayout (Mag 1.5 On All) +magnifier = ModifiedLayout (Mag (1.5,1.5) On All) hunk ./XMonad/Layout/Magnifier.hs 88 -magnifiercz cz = ModifiedLayout (Mag ((fromRational cz)*1.0::Double) On All) +magnifiercz cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On All) hunk ./XMonad/Layout/Magnifier.hs 93 -magnifier' = ModifiedLayout (Mag 1.5 On NoMaster) +magnifier' = ModifiedLayout (Mag (1.5,1.5) On NoMaster) hunk ./XMonad/Layout/Magnifier.hs 97 -magnifierOff = ModifiedLayout (Mag 1.5 Off All) +magnifierOff = ModifiedLayout (Mag (1.5,1.5) Off All) hunk ./XMonad/Layout/Magnifier.hs 102 -magnifiercz' cz = ModifiedLayout (Mag ((fromRational cz)*1.0::Double) On NoMaster) +magnifiercz' cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On NoMaster) + +-- | A magnifier that greatly magnifies just the vertical direction +maximizeVertical :: l a -> ModifiedLayout Magnifier l a +maximizeVertical = ModifiedLayout (Mag (1,1000) Off All) hunk ./XMonad/Layout/Magnifier.hs 111 -data Magnifier a = Mag Zoom Toggle MagnifyMaster deriving (Read, Show) - -type Zoom = Double +data Magnifier a = Mag (Double,Double) Toggle MagnifyMaster deriving (Read, Show) hunk ./XMonad/Layout/Magnifier.hs 123 - | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z + 0.1) On t) - | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z - 0.1) On t) + | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z `addto` 0.1) On t) + | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z `addto` 0.1) On t) hunk ./XMonad/Layout/Magnifier.hs 127 + where addto (x,y) i = (x+i,y+i) hunk ./XMonad/Layout/Magnifier.hs 143 -applyMagnifier :: Double -> Rectangle -> t -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe a) +applyMagnifier :: (Double,Double) -> Rectangle -> t -> [(Window, Rectangle)] + -> X ([(Window, Rectangle)], Maybe a) hunk ./XMonad/Layout/Magnifier.hs 150 -magnify :: Double -> Rectangle -> Rectangle -magnify zoom (Rectangle x y w h) = Rectangle x' y' w' h' +magnify :: (Double, Double) -> Rectangle -> Rectangle +magnify (zoomx,zoomy) (Rectangle x y w h) = Rectangle x' y' w' h' hunk ./XMonad/Layout/Magnifier.hs 154 - w' = round $ fromIntegral w * zoom - h' = round $ fromIntegral h * zoom + w' = round $ fromIntegral w * zoomx + h' = round $ fromIntegral h * zoomy hunk ./XMonad/Layout/DragPane.hs 136 + d <- asks display + liftIO $ lowerWindow d w hunk ./XMonad/Layout/WindowNavigation.hs 96 -defaultWNConfig = WNC (Just 0.5) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF" +defaultWNConfig = WNC (Just 0.4) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF" hunk ./XMonad/Util/EZConfig.hs 38 -import Data.Maybe (catMaybes, isNothing, isJust, fromJust) +import Data.Maybe hunk ./XMonad/Util/EZConfig.hs 208 -readKeymap c = catMaybes . map (maybeKeys . first (readKeySequence c)) +readKeymap c = mapMaybe (maybeKeys . first (readKeySequence c)) hunk ./XMonad/Util/EZConfig.hs 215 -readKeySequence c s = case parses s of - [k] -> Just k - _ -> Nothing +readKeySequence c = listToMaybe . parses hunk ./XMonad/Util/EZConfig.hs 272 -specialKeys = [ ("Backspace", xK_BackSpace) - , ("Tab" , xK_Tab ) - , ("Return" , xK_Return) - , ("Pause" , xK_Pause) +specialKeys = [ ("Backspace" , xK_BackSpace) + , ("Tab" , xK_Tab) + , ("Return" , xK_Return) + , ("Pause" , xK_Pause) hunk ./XMonad/Util/EZConfig.hs 277 - , ("Sys_Req" , xK_Sys_Req) - , ("Escape" , xK_Escape) - , ("Esc" , xK_Escape) - , ("Delete" , xK_Delete) - , ("Home" , xK_Home) - , ("Left" , xK_Left) - , ("Up" , xK_Up) - , ("Right" , xK_Right) - , ("Down" , xK_Down) - , ("L" , xK_Left) - , ("U" , xK_Up) - , ("R" , xK_Right) - , ("D" , xK_Down) - , ("Page_Up" , xK_Page_Up) - , ("Page_Down", xK_Page_Down) - , ("End" , xK_End) - , ("Insert" , xK_Insert) - , ("Break" , xK_Break) - , ("Space" , xK_space) + , ("Sys_Req" , xK_Sys_Req) + , ("Escape" , xK_Escape) + , ("Esc" , xK_Escape) + , ("Delete" , xK_Delete) + , ("Home" , xK_Home) + , ("Left" , xK_Left) + , ("Up" , xK_Up) + , ("Right" , xK_Right) + , ("Down" , xK_Down) + , ("L" , xK_Left) + , ("U" , xK_Up) + , ("R" , xK_Right) + , ("D" , xK_Down) + , ("Page_Up" , xK_Page_Up) + , ("Page_Down" , xK_Page_Down) + , ("End" , xK_End) + , ("Insert" , xK_Insert) + , ("Break" , xK_Break) + , ("Space" , xK_space) hunk ./XMonad/Util/EZConfig.hs 184 +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > hunk ./XMonad/Util/EZConfig.hs 333 + , ("KP_Space" , xK_KP_Space) + , ("KP_Tab" , xK_KP_Tab) + , ("KP_Enter" , xK_KP_Enter) + , ("KP_F1" , xK_KP_F1) + , ("KP_F2" , xK_KP_F2) + , ("KP_F3" , xK_KP_F3) + , ("KP_F4" , xK_KP_F4) + , ("KP_Home" , xK_KP_Home) + , ("KP_Left" , xK_KP_Left) + , ("KP_Up" , xK_KP_Up) + , ("KP_Right" , xK_KP_Right) + , ("KP_Down" , xK_KP_Down) + , ("KP_Prior" , xK_KP_Prior) + , ("KP_Page_Up" , xK_KP_Page_Up) + , ("KP_Next" , xK_KP_Next) + , ("KP_Page_Down", xK_KP_Page_Down) + , ("KP_End" , xK_KP_End) + , ("KP_Begin" , xK_KP_Begin) + , ("KP_Insert" , xK_KP_Insert) + , ("KP_Delete" , xK_KP_Delete) + , ("KP_Equal" , xK_KP_Equal) + , ("KP_Multiply", xK_KP_Multiply) + , ("KP_Add" , xK_KP_Add) + , ("KP_Separator", xK_KP_Separator) + , ("KP_Subtract", xK_KP_Subtract) + , ("KP_Decimal" , xK_KP_Decimal) + , ("KP_Divide" , xK_KP_Divide) + , ("KP_0" , xK_KP_0) + , ("KP_1" , xK_KP_1) + , ("KP_2" , xK_KP_2) + , ("KP_3" , xK_KP_3) + , ("KP_4" , xK_KP_4) + , ("KP_5" , xK_KP_5) + , ("KP_6" , xK_KP_6) + , ("KP_7" , xK_KP_7) + , ("KP_8" , xK_KP_8) + , ("KP_9" , xK_KP_9) hunk ./XMonad/Layout/PerWorkspace.hs 20 + PerWorkspace, hunk ./XMonad/Actions/Search.hs 16 - SearchEngine, + SearchEngine(..), hunk ./XMonad/Util/Scratchpad.hs 53 --- The terminal application must support the @-title@ argument. +-- The terminal application must support the @-name@ argument. hunk ./XMonad/Util/Scratchpad.hs 74 - scratchpadAction $ spawn $ terminal conf ++ " -title scratchpad" + scratchpadAction $ spawn $ terminal conf ++ " -name scratchpad" hunk ./XMonad/Util/Scratchpad.hs 81 - scratchpadAction $ spawn $ term ++ " -title scratchpad" + scratchpadAction $ spawn $ term ++ " -name scratchpad" hunk ./XMonad/Util/Scratchpad.hs 117 -scratchpadQuery = title =? "scratchpad" +scratchpadQuery = resource =? "scratchpad" hunk ./XMonad/Util/EZConfig.hs 183 --- > - +-- > - hunk ./XMonad/Util/EZConfig.hs 305 - | (n,k) <- zip ([1..12] :: [Int]) [xK_F1..] ] + | (n,k) <- zip ([1..24] :: [Int]) [xK_F1..] ] hunk ./XMonad/Actions/Warp.hs 48 -> banish = warpToWindow 1 1 -- lower left +> banish = warpToWindow 1 1 -- lower right hunk ./XMonad/Actions/Warp.hs 18 + banish, + Corner(..), hunk ./XMonad/Actions/Warp.hs 44 - -'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 right - hunk ./XMonad/Actions/Warp.hs 49 + +data Corner = UpperLeft | UpperRight | LowerLeft | LowerRight + +{- | Move the mouse cursor to a corner of the screen. Useful for + uncluttering things. + + Internally, this uses numerical parameters. We parametrize on the 'Corner' + type so the user need not see the violence inherent in + the system. + + '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? warpToWindow can do that! -} +banish :: Corner -> X () +banish direction = case direction of + LowerRight -> warpToWindow 1 1 + LowerLeft -> warpToWindow 0 1 + UpperLeft -> warpToWindow 0 0 + UpperRight -> warpToWindow 1 0 + hunk ./XMonad/Actions/Search.hs 24 + codesearch, hunk ./XMonad/Actions/Search.hs 32 + thesaurus, hunk ./XMonad/Actions/Search.hs 76 -* 'dictionary' -- dictionary.com search. +* 'codesearch' -- Google Labs Code Search search. + +* 'dictionary' -- dictionary.reference.com search. hunk ./XMonad/Actions/Search.hs 92 +* 'thesaurus' -- thesaurus.reference.com search. + hunk ./XMonad/Actions/Search.hs 199 -amazon, dictionary, google, hoogle, imdb, maps, mathworld, - scholar, wayback, wikipedia, youtube :: SearchEngine +amazon, codesearch, dictionary, google, hoogle, imdb, maps, mathworld, + scholar, thesaurus, wayback, wikipedia, youtube :: SearchEngine hunk ./XMonad/Actions/Search.hs 202 +codesearch = searchEngine "codesearch" "http://www.google.com/codesearch?q=" hunk ./XMonad/Actions/Search.hs 210 +thesaurus = searchEngine "thesaurus" "http://thesaurus.reference.com/search?q=" hunk ./XMonad/Hooks/EwmhDesktops.hs 20 + ewmhDesktopsLogHookCustom, hunk ./XMonad/Hooks/EwmhDesktops.hs 57 + + + hunk ./XMonad/Hooks/EwmhDesktops.hs 64 -ewmhDesktopsLogHook = withWindowSet $ \s -> do +ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id + + +-- | +-- Generalized version of ewmhDesktopsLogHook that allows an arbitrary +-- user-specified function to transform the workspace list (post-sorting) +ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X () +ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do hunk ./XMonad/Hooks/EwmhDesktops.hs 73 - let ws = sort' $ W.workspaces s + let ws = f $ sort' $ W.workspaces s hunk ./XMonad/Util/Scratchpad.hs 22 + ,scratchpadFilterOutWorkspace hunk ./XMonad/Util/Scratchpad.hs 135 + +-- | Transforms a workspace list containing the SP workspace into one that +-- doesn't contain it. Intended for use with logHooks. +scratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace] +scratchpadFilterOutWorkspace = filter (\(W.Workspace tag _ _) -> tag /= scratchpadWorkspaceTag) + hunk ./XMonad/Actions/Plane.hs 31 - -- $navigating hunk ./XMonad/Actions/Plane.hs 4 --- Copyright : (c) Malebria , +-- Copyright : (c) Marco Túlio Gontijo e Silva , +-- Leonardo Serra hunk ./XMonad/Actions/Plane.hs 8 --- Maintainer : Malebria +-- Maintainer : Marco Túlio Gontijo e Silva hunk ./XMonad/Prompt.hs 55 +import Control.Concurrent (threadDelay) hunk ./XMonad/Prompt.hs 102 - , promptBorderWidth :: !Dimension -- ^ Border width + , promptBorderWidth :: !Dimension -- ^ Border width hunk ./XMonad/Prompt.hs 104 - , height :: !Dimension -- ^ Window height - , historySize :: !Int -- ^ The number of history entries to be saved + , height :: !Dimension -- ^ Window height + , historySize :: !Int -- ^ The number of history entries to be saved hunk ./XMonad/Prompt.hs 107 + , autoComplete :: Maybe Int -- ^ Just x: if only one completion remains, auto-select it, + -- and delay by x microseconds hunk ./XMonad/Prompt.hs 177 + , autoComplete = Nothing hunk ./XMonad/Prompt.hs 310 +tryAutoComplete :: XP Bool +tryAutoComplete = do + ac <- gets (autoComplete . config) + case ac of + Just d -> do cs <- getCompletions + case cs of + [c] -> runCompleted c d >> return True + _ -> return False + Nothing -> return False + where runCompleted cmd delay = do + st <- get + let new_command = nextCompletion (xptype st) (command st) [cmd] + modify $ \s -> s { command = "autocompleting..." } + updateWindows + io $ threadDelay delay + modify $ \s -> s { command = new_command } + historyPush + return True + hunk ./XMonad/Prompt.hs 369 - eventLoop handle + completed <- tryAutoComplete + unless completed $ eventLoop handle hunk ./XMonad/Prompt/Window.hs 47 +-- +-- The autoComplete option is a handy complement here: +-- +-- > , ((modMask x .|. shiftMask, xK_g ), windowPromptGoto +-- > defaultXPConfig { autoComplete = Just 500000 } ) +-- +-- The \'500000\' is the number of microseconds to pause before sending you to +-- your new window. This is useful so that you don't accidentally send some +-- keystrokes to the selected client. hunk ./XMonad/Actions/WindowNavigation.hs 13 +-- This module is experimental. You'll have better luck with the original. +-- hunk ./XMonad/Actions/WindowNavigation.hs 81 +-- - screen 1, 1+2/w 3, M-d, M-w, M-2 (1+2/w 2), M-e, M-a - goes to w 3, should be w 2 hunk ./XMonad/Actions/WindowNavigation.hs 83 +-- - command to iteratively swapUp/swapDown instead of directly swapping with target hunk ./XMonad/Actions/Plane.hs 30 + , Lines (..) hunk ./XMonad/Actions/Plane.hs 44 +import XMonad.Util.Run hunk ./XMonad/Actions/Plane.hs 57 --- > [ ((keyMask .|. m, keySym), function 3 Finite direction) +-- > [ ((keyMask .|. m, keySym), function (Lines 3) Finite direction) hunk ./XMonad/Actions/Plane.hs 76 +-- | The number of lines in which the workspaces will be arranged. It's +-- possible to use a number of lines that is not a divisor of the number of +-- workspaces, but the results are better when using a divisor. If it's not a +-- divisor, the last line will have the remaining workspaces. +data Lines + = GConf -- ^ Use @gconftool-2@ to find out the number of lines. + | Lines Int -- ^ Specify the number of lines explicity. + hunk ./XMonad/Actions/Plane.hs 100 - :: Int -- ^ Number of lines. + :: Lines hunk ./XMonad/Actions/Plane.hs 111 -planeMove - :: Int -- ^ Number of columns. - -> Limits - -> Direction - -> X () +planeMove :: Lines -> Limits -> Direction -> X () hunk ./XMonad/Actions/Plane.hs 115 - (WorkspaceId -> WindowSet -> WindowSet) -> Int -> Limits -> Direction -> + (WorkspaceId -> WindowSet -> WindowSet) -> Lines -> Limits -> Direction -> hunk ./XMonad/Actions/Plane.hs 117 -plane function numberLines limits direction = do +plane function numberLines_ limits direction = do hunk ./XMonad/Actions/Plane.hs 121 + numberLines <- + liftIO $ + case numberLines_ of + Lines numberLines__ -> + return numberLines__ + GConf -> + do + numberLines__ <- + runProcessWithInput "gconftool-2" + ["--get", "/apps/panel/applets/workspace_switcher_screen0/prefs/num_rows"] "" + return $ read numberLines__ + hunk ./XMonad/Actions/Plane.hs 129 - runProcessWithInput "gconftool-2" - ["--get", "/apps/panel/applets/workspace_switcher_screen0/prefs/num_rows"] "" - return $ read numberLines__ + runProcessWithInput gconftool parameters "" + case reads numberLines__ of + [(numberRead, _)] -> return numberRead + _ -> + do + trace $ + "XMonad.Actions.Plane: Could not parse the output of " ++ gconftool ++ + unwords parameters ++ ": " ++ numberLines__ ++ "; assuming 1." + return 1 hunk ./XMonad/Actions/Plane.hs 177 +gconftool :: String +gconftool = "gconftool-2" + +parameters :: [String] +parameters = ["--get", "/apps/panel/applets/workspace_switcher_screen0/prefs/num_rows"] hunk ./XMonad/Actions/Plane.hs 140 - horizontal f = - if line < areasLine - then mod (f column) columns + lineNumber - else mod (f column) areasColumn + lineNumber + circular_ :: Int + circular_ = circular currentWS hunk ./XMonad/Actions/Plane.hs 143 - vertical f = - if column >= areasColumn - then mod (f currentWS columns) $ areasLine * columns - else mod (f currentWS columns) $ (areasLine + 1) * columns + circular :: Int -> Int + circular = + [ onLine pred + , onColumn pred + , onLine succ + , onColumn succ + ] + !! fromEnum direction hunk ./XMonad/Actions/Plane.hs 152 - lineNumber = line * columns + onLine :: (Int -> Int) -> Int -> Int + onLine f currentWS_ + | line < areasLine = mod_ columns + | otherwise = mod_ areasColumn + where + line, column :: Int + (line, column) = split currentWS_ + + mod_ :: Int -> Int + mod_ columns_ = compose line $ mod (f column) columns_ + + onColumn :: (Int -> Int) -> Int -> Int + onColumn f currentWS_ + | column < areasColumn || areasColumn == 0 = mod_ numberLines + | otherwise = mod_ $ pred numberLines + where + line, column :: Int + (line, column) = split currentWS_ + + mod_ :: Int -> Int + mod_ lines_ = compose (mod (f line) lines_) column + + compose :: Int -> Int -> Int + compose line column = line * columns + column + + split :: Int -> (Int, Int) + split currentWS_ = + (operation div, operation mod) + where + operation :: (Int -> Int -> Int) -> Int + operation f = f currentWS_ columns + + areasLine :: Int hunk ./XMonad/Actions/Plane.hs 186 + + areasColumn :: Int hunk ./XMonad/Actions/Plane.hs 189 - line = div currentWS columns - column = mod currentWS columns hunk ./XMonad/Actions/Plane.hs 190 + columns :: Int hunk ./XMonad/Actions/Plane.hs 194 + currentWS :: Int hunk ./XMonad/Actions/Plane.hs 196 + + preColumns :: Int hunk ./XMonad/Actions/Plane.hs 199 + + mCurrentWS :: Maybe Int hunk ./XMonad/Actions/Plane.hs 202 + + areas :: Int hunk ./XMonad/Actions/Plane.hs 206 - run condition position = - when (limits == Circular || condition) $ - windows $ function $ areaNames !! position + run :: (Int -> Int) -> X () + run f = windows $ function $ areaNames !! f currentWS hunk ./XMonad/Actions/Plane.hs 209 - areaNames = workspaces $ config $ xconf + areaNames :: [String] + areaNames = workspaces $ config xconf hunk ./XMonad/Actions/Plane.hs 213 - case direction of - ToUp -> run (line /= 0 ) $ vertical (-) - ToDown -> run (currentWS + columns < areas) $ vertical (+) - ToLeft -> run (column /= 0 ) $ horizontal pred - ToRight -> run (column /= columns - 1 ) $ horizontal succ + case limits of + Finite -> + when ((replicate 2 (circular_ < currentWS) ++ replicate 2 (circular_ > currentWS)) !! fromEnum direction) + $ run circular + + Circular -> + run circular hunk ./XMonad/Actions/Plane.hs 74 + | Linear -- ^ The plan comes as a row. hunk ./XMonad/Actions/Plane.hs 141 + notBorder :: Bool + notBorder = (replicate 2 (circular_ < currentWS) ++ replicate 2 (circular_ > currentWS)) !! fromEnum direction + hunk ./XMonad/Actions/Plane.hs 156 + linear :: Int -> Int + linear = + [ onLine pred . onColumn pred + , onColumn pred . onLine pred + , onLine succ . onColumn succ + , onColumn succ . onLine succ + ] + !! fromEnum direction + hunk ./XMonad/Actions/Plane.hs 227 - Finite -> - when ((replicate 2 (circular_ < currentWS) ++ replicate 2 (circular_ > currentWS)) !! fromEnum direction) - $ run circular - - Circular -> - run circular + Finite -> when notBorder $ run circular + Circular -> run circular + Linear -> if notBorder then run circular else run linear hunk ./XMonad/Doc.hs 59 -(Mar. 2008) tarball here: - +tarball here: + hunk ./XMonad/Doc/Developing.hs 214 -automatically derived by ghc). 'XMonad.Core.Message's are wrapped +automatically derived by GHC). 'XMonad.Core.Message's are wrapped hunk ./XMonad/Doc/Developing.hs 256 -* Code should be compilable with -Wall -Werror. There should be no warnings. +* Code should be compilable with "ghc-options: -Wall -Werror" set in the +xmonad-contrib.cabal file. There should be no warnings. hunk ./XMonad/Doc/Developing.hs 260 - crash, so do not call 'error' or 'undefined'. + crash, so never call 'error' or 'undefined'. hunk ./XMonad/Doc/Developing.hs 264 -* Any pure function added to the core should have QuickCheck properties - precisely defining its behaviour. +* Any pure function added to the core must have QuickCheck properties + precisely defining its behaviour. Tests for everything else are encouraged. hunk ./XMonad/Doc/Developing.hs 271 - a Haddock comment explaining what it does. + a Haddock comment explaining what it does, and providing examples. hunk ./XMonad/Doc/Developing.hs 290 -. +. hunk ./XMonad/Hooks/UrgencyHook.hs 276 - -- Call the urgencyHook. - callUrgencyHook wuh w hunk ./XMonad/Hooks/UrgencyHook.hs 278 + -- Call the urgencyHook. + callUrgencyHook wuh w replace ./XMonad/Actions/DeManage.hs [sjanssen@cse.unl.eduspencerjanssen@gmail.com] sjanssen@cse.unl.edu spencerjanssen@gmail.com replace ./XMonad/Config/Desktop.hs [sjanssen@cse.unl.eduspencerjanssen@gmail.com] sjanssen@cse.unl.edu spencerjanssen@gmail.com replace ./XMonad/Config/Gnome.hs [sjanssen@cse.unl.eduspencerjanssen@gmail.com] sjanssen@cse.unl.edu spencerjanssen@gmail.com replace ./XMonad/Config/Kde.hs [sjanssen@cse.unl.eduspencerjanssen@gmail.com] sjanssen@cse.unl.edu spencerjanssen@gmail.com replace ./XMonad/Config/Sjanssen.hs [sjanssen@cse.unl.eduspencerjanssen@gmail.com] sjanssen@cse.unl.edu spencerjanssen@gmail.com replace ./XMonad/Hooks/DynamicLog.hs [sjanssen@cse.unl.eduspencerjanssen@gmail.com] sjanssen@cse.unl.edu spencerjanssen@gmail.com replace ./XMonad/Layout/DragPane.hs [sjanssen@cse.unl.eduspencerjanssen@gmail.com] sjanssen@cse.unl.edu spencerjanssen@gmail.com replace ./XMonad/Layout/TwoPane.hs [sjanssen@cse.unl.eduspencerjanssen@gmail.com] sjanssen@cse.unl.edu spencerjanssen@gmail.com replace ./XMonad/Util/Dmenu.hs [sjanssen@cse.unl.eduspencerjanssen@gmail.com] sjanssen@cse.unl.edu spencerjanssen@gmail.com replace ./XMonad/Util/WorkspaceCompare.hs [sjanssen@cse.unl.eduspencerjanssen@gmail.com] sjanssen@cse.unl.edu spencerjanssen@gmail.com replace ./xmonad-contrib.cabal [sjanssen@cse.unl.eduspencerjanssen@gmail.com] sjanssen@cse.unl.edu spencerjanssen@gmail.com hunk ./XMonad/Layout/Grid.hs 49 - ncols = max 1 . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh :: Double) + ncols = max 1 . round . sqrt $ fromIntegral nwins * 9 * fromIntegral rw / (16 * fromIntegral rh :: Double) hunk ./XMonad/Layout/HintedGrid.hs 112 - ncolumns = max 1 . round . sqrt $ fromIntegral nwindows * fromIntegral rw / (fromIntegral rh :: Double) + ncolumns = max 1 . round . sqrt $ fromIntegral nwindows * 9 * fromIntegral rw / (16 * fromIntegral rh :: Double) hunk ./XMonad/Hooks/UrgencyHook.hs 60 - + FocusHook(..), hunk ./XMonad/Hooks/UrgencyHook.hs 341 +{- | A hook which will automatically send you to anything which sets the urgent + flag (as opposed to printing some sort of message. You would use this as + usual, eg. + + > withUrgencyHook FocusHook $ myconfig { ... +-} +data FocusHook = FocusHook deriving (Read, Show) + +instance UrgencyHook FocusHook where + urgencyHook _ _ = focusUrgent + addfile ./XMonad/Hooks/DynamicHooks.hs hunk ./XMonad/Hooks/DynamicHooks.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.DynamicHooks +-- Copyright : (c) Braden Shepherdson 2008 +-- License : BSD-style (as xmonad) +-- +-- Maintainer : Braden.Shepherdson@gmail.com +-- Stability : unstable +-- Portability : unportable +-- +-- One-shot and permanent ManageHooks that can be updated at runtime. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.DynamicHooks ( + -- * Usage + -- $usage + initDynamicHooks + ,dynamicMasterHook + ,addDynamicHook + ,updateDynamicHook + ,oneShotHook + ) where + +import XMonad +import System.IO + +import Data.List +import Data.Maybe (listToMaybe) +import Data.Monoid +import Data.IORef + +-- $usage +-- Provides two new kinds of 'ManageHooks' that can be defined at runtime. +-- +-- * One-shot 'ManageHooks' that are deleted after they execute. +-- +-- * Permanent 'ManageHooks' (unless you want to destroy them) +-- +-- Note that you will lose all dynamically defined 'ManageHook's when you @mod+q@! +-- If you want them to last, you should create them as normal in your @xmonad.hs@. +-- +-- First, you must execute 'initDynamicHooks' from 'main' in your @xmonad.hs@: +-- +-- > dynHooksRef <- initDynamicHooks +-- +-- and then pass this value to the other functions in this module. +-- +-- You also need to add the base 'ManageHook': +-- +-- > xmonad { manageHook = myManageHook <+> dynamicMasterHook dynHooksRef } +-- +-- You must include this @dynHooksRef@ value when using the functions in this +-- module: +-- +-- > xmonad { keys = myKeys `Data.Map.union` Data.Map.fromList +-- > [((modMask conf, xK_i), oneShotHook dynHooksRef +-- > "FFlaunchHook" (className =? "firefox") (doShift "3") +-- > >> spawn "firefox") +-- > ,((modMask conf, xK_u), addDynamicHook dynHooksRef +-- > (className =? "example" --> doFloat)) +-- > ,((modMask conf, xK_y), updatePermanentHook dynHooksRef +-- > (const idHook))) ] -- resets the permanent hook. +-- + +data DynamicHooks = DynamicHooks + { transients :: [(Query Bool, ManageHook)] + , permanent :: ManageHook } + + +-- | Creates the 'IORef' that stores the dynamically created 'ManageHook's. +initDynamicHooks :: IO (IORef DynamicHooks) +initDynamicHooks = newIORef (DynamicHooks { transients = [], + permanent = idHook }) + + +-- this hook is always executed, and the IORef's contents checked. +-- note that transient hooks are run second, therefore taking precedence +-- over permanent ones on matters such as which workspace to shift to. +-- doFloat and doIgnore are idempotent. +-- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'. +dynamicMasterHook :: IORef DynamicHooks -> ManageHook +dynamicMasterHook ref = return True --> + (ask >>= \w -> liftX (do + dh <- io $ readIORef ref + (Endo f) <- runQuery (permanent dh) w + ts <- mapM (\(q,a) -> runQuery q w >>= \x -> return (x,(q, a))) (transients dh) + let (ts',nts) = partition fst ts + gs <- mapM (flip runQuery w . snd . snd) ts' + let (Endo g) = maybe (Endo id) id $ listToMaybe gs + io $ writeIORef ref $ dh { transients = map snd nts } + return $ Endo $ f . g + )) + +-- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'. +addDynamicHook :: IORef DynamicHooks -> ManageHook -> X () +addDynamicHook ref m = updateDynamicHook ref (<+> m) + + +-- | Modifies the permanent 'ManageHook' with an arbitrary function. +updateDynamicHook :: IORef DynamicHooks -> (ManageHook -> ManageHook) -> X () +updateDynamicHook ref f = + io $ modifyIORef ref $ \dh -> dh { permanent = f (permanent dh) } + + +-- | Creates a one-shot 'ManageHook'. Note that you have to specify the two +-- parts of the 'ManageHook' separately. Where you would usually write: +-- +-- > className =? "example" --> doFloat +-- +-- you must call 'oneShotHook' as +-- +-- > oneShotHook dynHooksRef (className =? "example) doFloat +-- +oneShotHook :: IORef DynamicHooks -> Query Bool -> ManageHook -> X () +oneShotHook ref q a = + io $ modifyIORef ref + $ \dh -> dh { transients = (q,a):(transients dh) } + + + + hunk ./xmonad-contrib.cabal 110 + XMonad.Hooks.DynamicHooks hunk ./XMonad/Config/Sjanssen.hs 24 - , workspaces = ["irc", "web"] ++ map show [3 .. 7 :: Int] ++ ["mail", "im"] + , workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int] hunk ./XMonad/Config/Sjanssen.hs 26 - , modMask = mod4Mask hunk ./XMonad/Config/Sjanssen.hs 33 - | (x, w) <- [ ("Firefox", "web"), ("Pidgin", "im") + | (x, w) <- [ ("Firefox", "web") hunk ./XMonad/Hooks/DynamicLog.hs 459 -sjanssenPP = defaultPP { ppCurrent = xmobarColor "white" "#ff000000" +sjanssenPP = defaultPP { ppCurrent = xmobarColor "white" "black" hunk ./XMonad/Actions/WindowBringer.hs 20 - gotoMenu, bringMenu, windowMapWith + gotoMenu, bringMenu, windowMap, + bringWindow hunk ./XMonad/Actions/WindowBringer.hs 51 -gotoMenu = workspaceMap >>= actionMenu (windows . W.greedyView) - where workspaceMap = windowMapWith (W.tag . fst) +gotoMenu = actionMenu W.focusWindow hunk ./XMonad/Actions/WindowBringer.hs 56 -bringMenu = windowMap >>= actionMenu (windows . bringWindow) - where windowMap = windowMapWith snd - bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws +bringMenu = actionMenu bringWindow hunk ./XMonad/Actions/WindowBringer.hs 58 --- | Calls dmenuMap to grab the appropriate element from the Map, and hands it --- off to action if found. -actionMenu :: (a -> X ()) -> M.Map String a -> X () -actionMenu action windowMap = dmenuMap windowMap >>= flip X.whenJust action +-- | Brings the specified window into the current workspace. +bringWindow :: Window -> X.WindowSet -> X.WindowSet +bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws hunk ./XMonad/Actions/WindowBringer.hs 62 --- | Generates a Map from window name to \. For --- use with dmenuMap. -windowMapWith :: ((X.WindowSpace, Window) -> a) -> X (M.Map String a) -windowMapWith value = do -- TODO: extract the pure, creamy center. +-- | Calls dmenuMap to grab the appropriate Window, and hands it off to action +-- if found. +actionMenu :: (Window -> X.WindowSet -> X.WindowSet) -> X() +actionMenu action = windowMap >>= dmenuMap >>= flip X.whenJust (windows . action) + +-- | A map from window names to Windows. +windowMap :: X (M.Map String Window) +windowMap = do hunk ./XMonad/Actions/WindowBringer.hs 73 - keyValuePair ws w = flip (,) (value (ws, w)) `fmap` decorateName ws w + keyValuePair ws w = flip (,) w `fmap` decorateName ws w hunk ./XMonad/Prompt/Window.hs 76 - Goto -> return . gotoAction =<< windowMapWith (W.tag . fst) - Bring -> return . bringAction =<< windowMapWith snd - wm <- windowMapWith id + Goto -> fmap gotoAction windowMap + Bring -> fmap bringAction windowMap + wm <- windowMap hunk ./XMonad/Prompt/Window.hs 82 - hunk ./XMonad/Prompt/Window.hs 83 - gotoAction = winAction W.greedyView + gotoAction = winAction W.focusWindow hunk ./XMonad/Prompt/Window.hs 85 - bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws hunk ./XMonad/Hooks/EwmhDesktops.hs 42 --- > myLogHook = do ewmhDesktopsLogHook --- > return () +-- > myLogHook = ewmhDesktopsLogHook hunk ./XMonad/Hooks/EwmhDesktops.hs 44 --- > layoutHook = ewmhDesktopsLayout $ avoidStruts $ simpleTabbed ||| Full ||| etc.. +-- > myLayoutHook = ewmhDesktopsLayout $ avoidStruts $ layoutHook defaultConfig hunk ./XMonad/Hooks/EwmhDesktops.hs 48 +-- 'avoidStruts' is used to automatically leave space for dock programs, and +-- can be found in 'XMonad.Hooks.ManageDocks'. +-- hunk ./XMonad/Hooks/UrgencyHook.hs 118 --- 'ppUrgents'. +-- 'ppUrgent'. hunk ./XMonad/Hooks/UrgencyHook.hs 366 --- For debugging purposes, really. +-- | For debugging purposes, really. hunk ./XMonad/Layout/StackTile.hs 34 --- Then edit your @layoutHook@ by adding the ResizableTile layout: +-- Then edit your @layoutHook@ by adding the StackTile layout: hunk ./xmonad-contrib.cabal 60 - build-depends: mtl, unix, X11>=1.4.1, xmonad==0.7 + build-depends: mtl, unix, X11>=1.4.1, xmonad>=0.7, xmonad<0.8 hunk ./XMonad/Hooks/UrgencyHook.hs 55 - suppressWhen, SuppressWhen(..), + UrgencyConfig(..), urgencyConfig, + SuppressWhen(..), hunk ./XMonad/Hooks/UrgencyHook.hs 198 --- use withUrgencyHookC. +-- use 'withUrgencyHookC'. hunk ./XMonad/Hooks/UrgencyHook.hs 201 -withUrgencyHook hook conf = withUrgencyHookC hook id conf +withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf hunk ./XMonad/Hooks/UrgencyHook.hs 204 --- function with an extra mutator function. Or, by example: +-- function with a custom 'UrgencyConfig'. Or, by example: hunk ./XMonad/Hooks/UrgencyHook.hs 206 --- > withUrgencyHookC dzenUrgencyHook { ... } (suppressWhen Focused) +-- > withUrgencyHookC dzenUrgencyHook { ... } urgencyConfig { suppressWhen = Focused } hunk ./XMonad/Hooks/UrgencyHook.hs 210 - h -> (WithUrgencyHook h -> WithUrgencyHook h) -> XConfig l - -> XConfig (HandleEvent (WithUrgencyHook h) l) -withUrgencyHookC hook hookMod conf = conf { - layoutHook = eventHook withUrgency $ layoutHook conf, - logHook = cleanupUrgents sw >> logHook conf + h -> UrgencyConfig -> XConfig l -> XConfig (HandleEvent (WithUrgencyHook h) l) +withUrgencyHookC hook urgConf conf = conf { + layoutHook = eventHook (WithUrgencyHook hook urgConf) $ layoutHook conf, + logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf hunk ./XMonad/Hooks/UrgencyHook.hs 215 - where withUrgency@(WithUrgencyHook _ sw) = hookMod $ WithUrgencyHook hook Visible hunk ./XMonad/Hooks/UrgencyHook.hs 216 --- | See 'withUrgencyHookC' for an example use. 'suppressWhen' is a global configuration --- option, applicable to all urgency hooks, whereas the stuff inside the @{ ... }@ is --- type-specific. -suppressWhen :: UrgencyHook h => SuppressWhen -> WithUrgencyHook h -> WithUrgencyHook h -suppressWhen sw (WithUrgencyHook hook _) = WithUrgencyHook hook sw +-- | Global configuration, applicable to all types of 'UrgencyHook'. +data UrgencyConfig = UrgencyConfig + { suppressWhen :: SuppressWhen -- ^ see 'SuppressWhen' for options + } deriving (Read, Show) + +-- | The default 'UrgencyConfig'. Use a variation of this in your config just +-- as you use a variation of defaultConfig for your xmonad definition. +urgencyConfig :: UrgencyConfig +urgencyConfig = UrgencyConfig { suppressWhen = Visible } hunk ./XMonad/Hooks/UrgencyHook.hs 258 -data WithUrgencyHook h = WithUrgencyHook h SuppressWhen deriving (Read, Show) +data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig deriving (Read, Show) hunk ./XMonad/Hooks/UrgencyHook.hs 297 -callUrgencyHook (WithUrgencyHook hook sw) w = +callUrgencyHook (WithUrgencyHook hook UrgencyConfig { suppressWhen = sw }) w = hunk ./XMonad/Actions/DynamicWorkspaces.hs 7 --- Maintainer : David Roundy +-- Maintainer : none hunk ./XMonad/Layout/BoringWindows.hs 9 --- Maintainer : David Roundy +-- Maintainer : none hunk ./XMonad/Layout/Combo.hs 10 --- Maintainer : David Roundy +-- Maintainer : none hunk ./XMonad/Layout/DragPane.hs 12 --- Maintainer : David Roundy --- Andrea Rossato +-- Maintainer : Andrea Rossato hunk ./XMonad/Layout/LayoutCombinators.hs 9 --- Maintainer : David Roundy +-- Maintainer : none hunk ./XMonad/Layout/LayoutHints.hs 9 --- Maintainer : David Roundy +-- Maintainer : none hunk ./XMonad/Layout/LayoutModifier.hs 10 --- Maintainer : David Roundy +-- Maintainer : none hunk ./XMonad/Layout/LayoutScreens.hs 9 --- Maintainer : David Roundy +-- Maintainer : none hunk ./XMonad/Layout/Named.hs 9 --- Maintainer : David Roundy +-- Maintainer : none hunk ./XMonad/Layout/NoBorders.hs 9 --- Maintainer : David Roundy +-- Maintainer : none hunk ./XMonad/Layout/Square.hs 9 --- Maintainer : David Roundy +-- Maintainer : none hunk ./XMonad/Layout/ToggleLayouts.hs 10 --- Maintainer : David Roundy +-- Maintainer : none hunk ./XMonad/Layout/WindowNavigation.hs 10 --- Maintainer : David Roundy +-- Maintainer : none hunk ./XMonad/Layout/WorkspaceDir.hs 10 --- Maintainer : David Roundy +-- Maintainer : none hunk ./XMonad/Util/NamedWindows.hs 7 --- Maintainer : David Roundy +-- Maintainer : none hunk ./XMonad/Actions/UpdatePointer.hs 63 - (_sameRoot,_,w',rootx,rooty,_,_,_) <- io $ queryPointer dpy root - -- Can sameRoot ever be false in this case? I'm going to assume not - unless (w == w' || mouseIsMoving) $ + (_sameRoot,_,_,rootx,rooty,_,_,_) <- io $ queryPointer dpy root + unless (pointWithinRegion rootx rooty (wa_x wa) (wa_y wa) (wa_width wa) (wa_height wa) + || mouseIsMoving) $ hunk ./XMonad/Actions/UpdatePointer.hs 84 +-- Test that a point resides within a region. +-- This belongs somewhere more generally accessible than this module. +pointWithinRegion :: Integral a => a -> a -> a -> a -> a -> a -> Bool +pointWithinRegion px py rx ry rw rh = + within px rx (rx + rw) && within py ry (ry + rh) + where within x left right = x >= left && x <= right hunk ./XMonad/Actions/UpdatePointer.hs 28 +import XMonad.StackSet (member) hunk ./XMonad/Actions/UpdatePointer.hs 60 + ws <- gets windowset hunk ./XMonad/Actions/UpdatePointer.hs 65 - (_sameRoot,_,_,rootx,rooty,_,_,_) <- io $ queryPointer dpy root + (_sameRoot,_,currentWindow,rootx,rooty,_,_,_) <- io $ queryPointer dpy root hunk ./XMonad/Actions/UpdatePointer.hs 67 - || mouseIsMoving) $ + || mouseIsMoving + || not (currentWindow `member` ws)) $ hunk ./XMonad/Layout/NoBorders.hs 9 --- Maintainer : none +-- Maintainer : Spencer Janssen hunk ./XMonad/Layout/WindowNavigation.hs 10 --- Maintainer : none +-- Maintainer : Devin Mullins hunk ./xmonad-contrib.cabal 2 -version: 0.7 +version: 0.8 hunk ./xmonad-contrib.cabal 60 - build-depends: mtl, unix, X11>=1.4.1, xmonad>=0.7, xmonad<0.8 + build-depends: mtl, unix, X11>=1.4.1, xmonad>=0.8, xmonad<0.9 hunk ./XMonad/Hooks/UrgencyHook.hs 56 - SuppressWhen(..), + SuppressWhen(..), RemindWhen(..), + minutes, hunk ./XMonad/Hooks/UrgencyHook.hs 76 +import XMonad.Util.Timer (TimerId, startTimer, handleTimer) hunk ./XMonad/Hooks/UrgencyHook.hs 198 --- | This is the method to enable an urgency hook. It suppresses urgency status --- for windows that are currently visible. If you'd like to change that behavior, --- use 'withUrgencyHookC'. +-- | This is the method to enable an urgency hook. It uses the default +-- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHook' +-- instead. hunk ./XMonad/Hooks/UrgencyHook.hs 205 --- | If you'd like to configure *when* to trigger the urgency hook, call this --- function with a custom 'UrgencyConfig'. Or, by example: +-- | This lets you modify the defaults set in 'urgencyConfig'. An example: hunk ./XMonad/Hooks/UrgencyHook.hs 209 --- (Don't type the @...@, you dolt.) See documentation on your options at 'SuppressWhen'. +-- (Don't type the @...@, you dolt.) See 'UrgencyConfig' for details on configuration. hunk ./XMonad/Hooks/UrgencyHook.hs 217 --- | Global configuration, applicable to all types of 'UrgencyHook'. +-- | Global configuration, applied to all types of 'UrgencyHook'. See +-- 'urgencyConfig' for the defaults. hunk ./XMonad/Hooks/UrgencyHook.hs 220 - { suppressWhen :: SuppressWhen -- ^ see 'SuppressWhen' for options + { suppressWhen :: SuppressWhen -- ^ when to trigger the urgency hook + , remindWhen :: RemindWhen -- ^ when to re-trigger the urgency hook hunk ./XMonad/Hooks/UrgencyHook.hs 224 --- | The default 'UrgencyConfig'. Use a variation of this in your config just --- as you use a variation of defaultConfig for your xmonad definition. -urgencyConfig :: UrgencyConfig -urgencyConfig = UrgencyConfig { suppressWhen = Visible } - hunk ./XMonad/Hooks/UrgencyHook.hs 232 +-- | A set of choices as to when you want to be re-notified of an urgent +-- window. Perhaps you focused on something and you miss the dzen popup bar. Or +-- you're AFK. Or you feel the need to be more distracted. I don't care. +-- +-- The interval arguments are in seconds. See the 'minutes' helper. +data RemindWhen = Dont -- ^ triggering once is enough + | Repeatedly Int Interval -- ^ repeat times every seconds + | Every Interval -- ^ repeat every until the urgency hint is cleared + deriving (Read, Show) + +-- | A prettified way of multiplying by 60. Use like: @(5 `minutes`)@. +minutes :: Rational -> Rational +minutes secs = secs * 60 + +-- | The default 'UrgencyConfig'. suppressWhen = Visible, remindWhen = Dont. +-- Use a variation of this in your config just as you use a variation of +-- defaultConfig for your xmonad definition. +urgencyConfig :: UrgencyConfig +urgencyConfig = UrgencyConfig { suppressWhen = Visible, remindWhen = Dont } + hunk ./XMonad/Hooks/UrgencyHook.hs 276 -data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig deriving (Read, Show) +adjustUrgents :: ([Window] -> [Window]) -> X () +adjustUrgents f = io $ modifyIORef urgents f + +type Interval = Rational + +-- | An urgency reminder, as reified for 'RemindWhen'. +-- The last value is the countdown number, for 'Repeatedly'. +data Reminder = Reminder { timer :: TimerId + , window :: Window + , interval :: Interval + , remaining :: Maybe Int + } deriving Eq + +-- | Stores the list of urgency reminders. +{-# NOINLINE reminders #-} +reminders :: IORef [Reminder] +reminders = unsafePerformIO (newIORef []) + +readReminders :: X [Reminder] +readReminders = io $ readIORef reminders + +adjustReminders :: ([Reminder] -> [Reminder]) -> X () +adjustReminders f = io $ modifyIORef reminders f + +data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig + deriving (Read, Show) hunk ./XMonad/Hooks/UrgencyHook.hs 316 - handleEvent wuh event = - case event of + handleEvent wuh event = case event of hunk ./XMonad/Hooks/UrgencyHook.hs 321 - -- Add to list of urgents. hunk ./XMonad/Hooks/UrgencyHook.hs 322 - -- Call the urgencyHook. hunk ./XMonad/Hooks/UrgencyHook.hs 323 - else do - -- Remove from list of urgents. - adjustUrgents (delete w) - -- Call logHook after IORef has been modified. - userCode =<< asks (logHook . config) - DestroyWindowEvent {ev_window = w} -> do - adjustUrgents (delete w) + else + clearUrgency w + userCode =<< asks (logHook . config) -- call *after* IORef has been modified + DestroyWindowEvent {ev_window = w} -> + clearUrgency w hunk ./XMonad/Hooks/UrgencyHook.hs 329 - return () - -adjustUrgents :: ([Window] -> [Window]) -> X () -adjustUrgents f = io $ modifyIORef urgents f + mapM_ handleReminder =<< readReminders + where clearUrgency w = adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window) + handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder hunk ./XMonad/Hooks/UrgencyHook.hs 334 -callUrgencyHook (WithUrgencyHook hook UrgencyConfig { suppressWhen = sw }) w = - whenX (not <$> shouldSuppress sw w) - (userCode $ urgencyHook hook w) +callUrgencyHook (WithUrgencyHook hook UrgencyConfig { suppressWhen = sw, remindWhen = rw }) w = + whenX (not <$> shouldSuppress sw w) $ do + userCode $ urgencyHook hook w + case rw of + Repeatedly times int -> addReminder w int $ Just times + Every int -> addReminder w int Nothing + Dont -> return () + +addReminder :: Window -> Rational -> Maybe Int -> X () +addReminder w int times = do + timerId <- startTimer int + let reminder = Reminder timerId w int times + adjustReminders (\rs -> if w `elem` map window rs then rs else reminder : rs) + +reminderHook :: UrgencyHook h => WithUrgencyHook h -> Reminder -> X (Maybe a) +reminderHook (WithUrgencyHook hook _) reminder = do + case remaining reminder of + Just x | x > 0 -> remind $ Just (x - 1) + Just _ -> adjustReminders $ delete reminder + Nothing -> remind Nothing + return Nothing + where remind remaining' = do userCode $ urgencyHook hook (window reminder) + adjustReminders $ delete reminder + addReminder (window reminder) (interval reminder) remaining' hunk ./XMonad/Hooks/UrgencyHook.hs 57 - minutes, - focusUrgent, + focusUrgent, clearUrgents, hunk ./XMonad/Hooks/UrgencyHook.hs 59 - DzenUrgencyHook(..), seconds, + DzenUrgencyHook(..), hunk ./XMonad/Hooks/UrgencyHook.hs 62 + minutes, seconds, hunk ./XMonad/Hooks/UrgencyHook.hs 259 +-- | Just makes the urgents go away. +-- Example keybinding: +-- +-- > , ((modMask .|. shiftMask, xK_BackSpace), clearUrgents) +clearUrgents :: X () +clearUrgents = adjustUrgents (const []) >> adjustReminders (const []) + hunk ./XMonad/Config/Desktop.hs 15 - -- * Usage - -- -- $usage hunk ./XMonad/Config/Gnome.hs 16 - -- -- $usage + -- $usage hunk ./XMonad/Config/Kde.hs 16 - -- -- $usage + -- $usage hunk ./XMonad/Config/Xfce.hs 16 - -- -- $usage + -- $usage hunk ./XMonad/Actions/Plane.hs 68 --- | Defines whether it's a finite or a circular organization of workspaces. +-- | Defines the behaviour when you're trying to move out of the limits. hunk ./XMonad/Actions/Plane.hs 70 - = Finite -- ^ When you're at a edge of the plane, there's no way to move - -- to the next region. - | Circular -- ^ If you try to move, you'll get to the other edge, on the - -- other side. - | Linear -- ^ The plan comes as a row. + = Finite -- ^ Ignore the function call, and keep in the same workspace. + | Circular -- ^ Get on the other side, like in the Snake game. + | Linear -- ^ The plan comes as a row, so it goes to the next or prev if + -- the workspaces were numbered. hunk ./XMonad/Actions/Plane.hs 84 --- $navigating --- --- There're two parameters that must be provided to navigate, and it's a good --- idea to use them with the same values in each keybinding. --- --- The first is the number of lines in which the workspaces are going to be --- organized. It's possible to use a number of lines that is not a divisor --- of the number of workspaces, but the results are better when using a --- divisor. If it's not a divisor, the last line will have the remaining --- workspaces. --- --- The other one is 'Limits'. - hunk ./XMonad/Actions/Plane.hs 85 --- also move to the next workspace. -planeShift - :: Lines - -> Limits - -> Direction - -> X () +-- also move to the next workspace. It's a good idea to use the same 'Lines' +-- and 'Limits' for all the bindings. +planeShift :: Lines -> Limits -> Direction -> X () hunk ./XMonad/Actions/Plane.hs 39 -import Data.List hiding (union) +import Data.List hunk ./XMonad/Actions/Plane.hs 32 + -- * Key bindings + , planeKeys + hunk ./XMonad/Actions/Plane.hs 43 +import Data.Map hiding (split) hunk ./XMonad/Actions/Plane.hs 59 --- > myNewkeys (XConfig {modMask = m}) = --- > fromList --- > [ ((keyMask .|. m, keySym), function (Lines 3) Finite direction) --- > | (keySym, direction) <- zip [xK_Left .. xK_Down] $ enumFrom ToLeft --- > , (keyMask, function) <- [(0, planeMove), (shiftMask, planeShift)] --- > ] +-- > myNewkeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite hunk ./XMonad/Actions/Plane.hs 83 +-- | This is the way most people would like to use this module. It ataches the +-- 'KeyMask' passed as a parameter with 'xK_Left', 'xK_Up', 'xK_Right' and +-- 'xK_Down', associating it with 'planeMove' to the corresponding 'Direction'. +-- It also associates these bindings with 'shiftMask' to 'planeShift'. +planeKeys :: KeyMask -> Lines -> Limits -> Map (KeyMask, KeySym) (X ()) +planeKeys modm ln limits = + fromList $ + [ ((keyMask, keySym), function ln limits direction) + | (keySym, direction) <- zip [xK_Left .. xK_Down] $ enumFrom ToLeft + , (keyMask, function) <- [(modm, planeMove), (shiftMask .|. modm, planeShift)] + ] + hunk ./XMonad/Prompt.hs 86 + , showComplWin :: Bool hunk ./XMonad/Prompt.hs 109 + , showCompletionOnTab :: Bool -- ^ Only show list of completions when Tab was pressed hunk ./XMonad/Prompt.hs 180 + , showCompletionOnTab = False hunk ./XMonad/Prompt.hs 195 + , showComplWin = not (showCompletionOnTab c) hunk ./XMonad/Prompt.hs 283 + modify $ \s -> s { showComplWin = True } hunk ./XMonad/Prompt.hs 644 - if (compl /= [] ) + if (compl /= [] && showComplWin st) hunk ./XMonad/Prompt.hs 825 + hunk ./XMonad/Prompt.hs 283 - modify $ \s -> s { showComplWin = True } hunk ./XMonad/Prompt.hs 284 + if length c > 1 then modify $ \s -> s { showComplWin = True } else return () hunk ./XMonad/Config/Sjanssen.hs 55 + , showCompletionOnTab = True hunk ./XMonad/Prompt.hs 49 +import Prelude hiding (catch) + hunk ./XMonad/Prompt.hs 66 -import System.Environment (getEnv) +import System.Directory hunk ./XMonad/Prompt.hs 68 -import System.Posix.Files +import Control.Exception hiding (handle) + +import qualified Data.Map as Map +import Data.Map (Map) hunk ./XMonad/Prompt.hs 95 - , command :: String + , commandHistory :: W.Stack String hunk ./XMonad/Prompt.hs 97 - , history :: [History] hunk ./XMonad/Prompt.hs 98 + , successful :: Bool hunk ./XMonad/Prompt.hs 191 - -> GC -> XMonadFont -> p -> [History] -> XPConfig -> XPState + -> GC -> XMonadFont -> p -> [String] -> XPConfig -> XPState hunk ./XMonad/Prompt.hs 204 - , command = defaultText c + , commandHistory = W.Stack { W.focus = defaultText c + , W.up = [] + , W.down = h } hunk ./XMonad/Prompt.hs 208 - , history = h hunk ./XMonad/Prompt.hs 209 + , successful = False hunk ./XMonad/Prompt.hs 212 +-- this would be much easier with functional references +command :: XPState -> String +command = W.focus . commandHistory + +setCommand :: String -> XPState -> XPState +setCommand xs s = s { commandHistory = (commandHistory s) { W.focus = xs }} + hunk ./XMonad/Prompt.hs 231 + hist <- liftIO $ readHistory hunk ./XMonad/Prompt.hs 236 - (hist,h) <- liftIO $ readHistory hunk ./XMonad/Prompt.hs 237 - let st = initState d rw w s compl gc fs (XPT t) hist conf + let hs = fromMaybe [] $ Map.lookup (showXPrompt t) hist + st = initState d rw w s compl gc fs (XPT t) hs conf hunk ./XMonad/Prompt.hs 243 - liftIO $ hClose h - if (command st' /= "") + if successful st' hunk ./XMonad/Prompt.hs 245 - let htw = take (historySize conf) (history st') - liftIO $ writeHistory htw + liftIO $ writeHistory $ Map.insertWith + (\xs ys -> take (historySize conf) $ xs ++ ys) + (showXPrompt t) [command st'] hist hunk ./XMonad/Prompt.hs 249 - else - return Nothing + else return Nothing hunk ./XMonad/Prompt.hs 314 - modify $ \s -> s { command = new_command, offset = length new_command } + modify $ \s -> setCommand new_command $ s { offset = length new_command } hunk ./XMonad/Prompt.hs 341 - modify $ \s -> s { command = "autocompleting..." } + modify $ setCommand "autocompleting..." hunk ./XMonad/Prompt.hs 344 - modify $ \s -> s { command = new_command } - historyPush + modify $ setCommand new_command hunk ./XMonad/Prompt.hs 369 - | ks == xK_Return = historyPush >> return () + | ks == xK_Return = setSuccess True hunk ./XMonad/Prompt.hs 374 - | ks == xK_Up = moveHistory Prev >> go - | ks == xK_Down = moveHistory Next >> go + | ks == xK_Up = moveHistory W.focusUp' >> go + | ks == xK_Down = moveHistory W.focusDown' >> go hunk ./XMonad/Prompt.hs 381 - quit = flushString >> return () -- quit and discard everything + quit = flushString >> setSuccess False -- quit and discard everything + setSuccess b = modify $ \s -> s { successful = b } hunk ./XMonad/Prompt.hs 396 - modify $ \s -> s { command = drop (offset s) (command s) - , offset = 0 } + modify $ \s -> setCommand (drop (offset s) (command s)) $ s { offset = 0 } hunk ./XMonad/Prompt.hs 401 - modify $ \s -> s { command = take (offset s) (command s) } + modify $ \s -> setCommand (take (offset s) (command s)) s hunk ./XMonad/Prompt.hs 406 - XPS { command = c, offset = o } <- get + o <- gets offset + c <- gets command hunk ./XMonad/Prompt.hs 418 - modify $ \s -> s { command = ncom, offset = noff} + modify $ \s -> setCommand ncom $ s { offset = noff} hunk ./XMonad/Prompt.hs 433 - modify $ \s -> s { command = "", offset = 0} + modify $ \s -> setCommand "" $ s { offset = 0} hunk ./XMonad/Prompt.hs 438 - modify $ \s -> s { command = c (command s) (offset s), offset = o (offset s)} + modify $ \s -> setCommand (c (command s) (offset s)) $ s { offset = o (offset s)} hunk ./XMonad/Prompt.hs 451 - modify $ \s -> s { command = c (command s) (offset s), offset = o (offset s)} + modify $ \s -> setCommand (c (command s) (offset s)) $ s { offset = o (offset s)} hunk ./XMonad/Prompt.hs 481 -moveHistory :: Direction -> XP () -moveHistory d = do - h <- getHistory - c <- gets command - let str = if h /= [] then head h else c - let nc = case elemIndex c h of - Just i -> case d of - Prev -> h !! (if (i + 1) > (length h - 1) then 0 else i + 1) - Next -> h !! (max (i - 1) 0) - Nothing -> str - modify $ \s -> s { command = nc, offset = length nc} +moveHistory :: (W.Stack String -> W.Stack String) -> XP () +moveHistory f = modify $ \s -> let ch = f $ commandHistory s + in s { commandHistory = ch + , offset = length $ W.focus ch } hunk ./XMonad/Prompt.hs 688 -data History = - H { prompt :: String - , command_history :: String - } deriving (Show, Read, Eq) +type History = Map String [String] hunk ./XMonad/Prompt.hs 690 -historyPush :: XP () -historyPush = do - c <- gets command - when (c /= []) $ modify (\s -> s { history = nub $ H (showXPrompt (xptype s)) c : history s }) +emptyHistory :: History +emptyHistory = Map.empty hunk ./XMonad/Prompt.hs 693 -getHistory :: XP [String] -getHistory = do - hist <- gets history - pt <- gets xptype - return $ map command_history . filter (\h -> prompt h == showXPrompt pt) $ hist +getHistoryFile :: IO FilePath +getHistoryFile = fmap (++ "/history") $ getAppUserDataDirectory "xmonad" hunk ./XMonad/Prompt.hs 696 -readHistory :: IO ([History],Handle) -readHistory = do - home <- getEnv "HOME" - let path = home ++ "/.xmonad/history" - f <- fileExist path - if f then do h <- openFile path ReadMode - str <- hGetContents h - case (reads str) of - [(hist,_)] -> return (hist,h) - [] -> return ([],h) - _ -> return ([],h) - else do h <- openFile path WriteMode - return ([],h) +readHistory :: IO History +readHistory = catch readHist (const (return emptyHistory)) + where + readHist = do + path <- getHistoryFile + xs <- bracket (openFile path ReadMode) hClose hGetLine + readIO xs hunk ./XMonad/Prompt.hs 704 -writeHistory :: [History] -> IO () +writeHistory :: History -> IO () hunk ./XMonad/Prompt.hs 706 - home <- getEnv "HOME" - let path = home ++ "/.xmonad/history" - catch (writeFile path (show hist)) (\_ -> do putStrLn "error in writing"; return ()) + path <- getHistoryFile + catch (writeFile path (show hist)) $ const $ hPutStrLn stderr "error in writing" hunk ./XMonad/Prompt.hs 810 -historyCompletion = \x -> liftM (filter $ isInfixOf x) readHistoryIO - --- We need to define this locally because there is no function with the type "XP a -> IO a", and --- 'getHistory' is uselessly of the type "XP [String]". -readHistoryIO :: IO [String] -readHistoryIO = do (hist,_) <- readHistory - return $ map command_history hist +historyCompletion x = fmap (filter (isInfixOf x) . Map.fold (++) []) readHistory hunk ./XMonad/Prompt.hs 8 --- Maintainer : andrea.rossato@unibz.it +-- Maintainer : Spencer Janssen hunk ./XMonad/Hooks/DynamicLog.hs 1 +{-# LANGUAGE FlexibleContexts #-} + hunk ./XMonad/Hooks/DynamicLog.hs 28 + statusBar, hunk ./XMonad/Hooks/DynamicLog.hs 30 - dynamicLogDzen, - dynamicLogXmobar, hunk ./XMonad/Hooks/DynamicLog.hs 35 - PP(..), defaultPP, dzenPP, xmobarPP, sjanssenPP, byorgeyPP, + PP(..), defaultPP, + + -- * Example formatters + dzenPP, xmobarPP, sjanssenPP, byorgeyPP, hunk ./XMonad/Hooks/DynamicLog.hs 57 +import Control.Monad hunk ./XMonad/Hooks/DynamicLog.hs 80 --- the 'dzen' function, which sets up a dzen status bar with a default --- format: --- --- > main = dzen xmonad --- --- or, to use this with your own custom xmonad configuration, +-- the 'xmobar' or 'dzen' functions: hunk ./XMonad/Hooks/DynamicLog.hs 82 --- > main = dzen $ \conf -> xmonad $ conf { } +-- > main = xmonad =<< xmobar conf hunk ./XMonad/Hooks/DynamicLog.hs 84 --- Also you can use 'xmobar' function instead of 'dzen' in the examples above, --- if you have xmobar installed. +-- There is also 'statusBar' if you'd like to use another status bar, or would +-- like to use different formatting options. The 'xmobar', 'dzen', and +-- 'statusBar' functions are preferred over the other options listed below, as +-- they take care of all the necessary plumbing -- no shell scripting required! hunk ./XMonad/Hooks/DynamicLog.hs 89 --- Alternatively, you can choose among several default status bar --- formats ('dynamicLog', 'dynamicLogDzen', 'dynamicLogXmobar', or --- 'dynamicLogXinerama') by simply setting your logHook to the +-- Alternatively, you can choose among several default status bar formats +-- ('dynamicLog' or 'dynamicLogXinerama') by simply setting your logHook to the hunk ./XMonad/Hooks/DynamicLog.hs 143 --- | Run xmonad with a dzen status bar set to some nice defaults. Output --- is taken from the dynamicLogWithPP hook. +-- | Run xmonad with a dzen status bar set to some nice defaults. hunk ./XMonad/Hooks/DynamicLog.hs 145 --- > main = dzen xmonad +-- > main = xmonad =<< xmonad conf hunk ./XMonad/Hooks/DynamicLog.hs 148 --- status bar with minimal effort. If you want to customize your xmonad --- configuration while using this, you'll have to do something like --- --- > main = dzen $ \conf -> xmonad $ conf { } +-- status bar with minimal effort. hunk ./XMonad/Hooks/DynamicLog.hs 151 --- use something like 'dynamicLogWithPP' instead. +-- use the 'statusBar' function instead. hunk ./XMonad/Hooks/DynamicLog.hs 157 -dzen :: - (XConfig - (ModifiedLayout AvoidStruts - (Choose Tall (Choose (Mirror Tall) Full))) -> IO t) -> IO t -dzen f = do - h <- spawnPipe ("dzen2" ++ " " ++ flags) - f $ defaultConfig - { logHook = dynamicLogWithPP dzenPP - { ppOutput = hPutStrLn h } - ,layoutHook = avoidStrutsOn [U] (layoutHook defaultConfig) - ,keys = \c -> toggleStrutsKey c `M.union` keys defaultConfig c - ,manageHook = manageHook defaultConfig <+> manageDocks - } +dzen :: LayoutClass l Window + => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l)) +dzen conf = statusBar ("dzen2" ++ flags) dzenPP toggleStrutsKey conf hunk ./XMonad/Hooks/DynamicLog.hs 166 --- | Run xmonad with a xmobar status bar set to some nice defaults. Output --- is taken from the dynamicLogWithPP hook. +-- | Run xmonad with a xmobar status bar set to some nice defaults. hunk ./XMonad/Hooks/DynamicLog.hs 168 --- > main = xmobar xmonad +-- > main = xmonad =<< xmobar config hunk ./XMonad/Hooks/DynamicLog.hs 170 --- This works pretty much the same as 'dzen' function above +-- This works pretty much the same as 'dzen' function above. hunk ./XMonad/Hooks/DynamicLog.hs 172 -xmobar :: - (XConfig - (ModifiedLayout AvoidStruts - (Choose Tall (Choose (Mirror Tall) Full))) -> IO t) -> IO t -xmobar f = do - h <- spawnPipe "xmobar" - f $ defaultConfig - { logHook = dynamicLogWithPP xmobarPP { ppOutput = hPutStrLn h } - , layoutHook = avoidStruts $ layoutHook defaultConfig - , keys = \c -> toggleStrutsKey c `M.union` keys defaultConfig c - , manageHook = manageHook defaultConfig <+> manageDocks - } +xmobar :: LayoutClass l Window + => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l)) +xmobar conf = statusBar "xmobar" xmobarPP toggleStrutsKey conf + +-- | Modifies the given base configuration to launch the given status bar, +-- send status information to that bar, and allocate space on the screen edges +-- for the bar. +statusBar :: LayoutClass l Window + => String -- ^ the command line to launch the status bar + -> PP -- ^ the pretty printing options + -> (XConfig Layout -> ((KeyMask, KeySym), X ())) + -- ^ the desired key binding to toggle bar visibility + -> XConfig l -- ^ the base config + -> IO (XConfig (ModifiedLayout AvoidStruts l)) +statusBar cmd pp k conf = do + h <- spawnPipe cmd + return $ conf + { layoutHook = avoidStruts (layoutHook conf) + , logHook = do + logHook conf + dynamicLogWithPP pp { ppOutput = hPutStrLn h } + , manageHook = manageHook conf <+> manageDocks + , keys = liftM2 M.union (uncurry M.singleton . k) (keys conf) + } hunk ./XMonad/Hooks/DynamicLog.hs 200 -toggleStrutsKey :: XConfig t -> M.Map (KeyMask, KeySym) (X ()) -toggleStrutsKey XConfig{modMask = modm} = M.fromList - [ ((modm, xK_b ), sendMessage ToggleStruts) ] +toggleStrutsKey :: XConfig t -> ((KeyMask, KeySym), X ()) +toggleStrutsKey XConfig{modMask = modm} = ((modm, xK_b ), sendMessage ToggleStruts) hunk ./XMonad/Hooks/DynamicLog.hs 218 --- | An example log hook that emulates dwm's status bar, using colour --- codes printed to dzen. Requires dzen. Workspaces, xinerama, --- layouts and the window title are handled. -dynamicLogDzen :: X () -dynamicLogDzen = dynamicLogWithPP dzenPP - --- | These are good defaults to be used with the xmobar status bar. -dynamicLogXmobar :: X () -dynamicLogXmobar = dynamicLogWithPP xmobarPP - hunk ./XMonad/Hooks/DynamicLog.hs 159 -dzen conf = statusBar ("dzen2" ++ flags) dzenPP toggleStrutsKey conf +dzen conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf hunk ./XMonad/Actions/WindowGo.hs 27 + runOrRaiseAndDo, + runOrRaiseMaster, + raiseAndDo, + raiseMaster, hunk ./XMonad/Actions/WindowGo.hs 40 -import qualified XMonad.StackSet as W (allWindows, peek) - +import qualified XMonad.StackSet as W (allWindows, peek, swapMaster) +import XMonad.Operations (windows) +import Graphics.X11 (Window) hunk ./XMonad/Actions/WindowGo.hs 142 + +{- | if the window is found the window is focused and the third argument is called + otherwise, the first argument is called + See 'raiseMaster' for an example -} +raiseAndDo :: X () -> Query Bool -> (Window -> X ())-> X () +raiseAndDo raisef thatUserQuery afterRaise = withWindowSet $ \s -> do + maybeResult <- filterM (runQuery thatUserQuery) (W.allWindows s) + case maybeResult of + [] -> raisef + (x:_) -> do + XMonad.focus x + afterRaise x + +{- | if the window is found the window is focused and the third argument is called + otherwise, raisef is called -} +runOrRaiseAndDo :: String -> Query Bool -> (Window -> X ()) -> X () +runOrRaiseAndDo run query afterRaise = raiseAndDo (spawn run) query afterRaise + + +{- | if the window is found the window is focused and set to master + otherwise, the first argument is called + + raiseMaster (runInTerm \"-title ghci\" \"zsh -c \'ghci\'\") (title =? \"ghci\") -} +raiseMaster :: X () -> Query Bool -> X () +raiseMaster raisef thatUserQuery = raiseAndDo raisef thatUserQuery (\_ -> windows W.swapMaster) + +{- | if the window is found the window is focused and set to master + otherwise, action is run + + runOrRaiseMaster \"firefox\" (className =? \"Firefox\")) + -} +runOrRaiseMaster :: String -> Query Bool -> X () +runOrRaiseMaster run query = runOrRaiseAndDo run query (\_ -> windows W.swapMaster) + + addfile ./XMonad/Config/Monad.hs hunk ./XMonad/Config/Monad.hs 1 +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- experimental, not expected to work + +{- our goal: +config = do + add layout Full + set terminal "urxvt" + add keys [blah blah blah] +-} + +{- +ideas: + composability! + "only once" features like avoidStruts, ewmhDesktops +-} + +module XMonad.Config.Monad where + +import XMonad hiding (terminal, keys) +import qualified XMonad as X +import Control.Monad.Writer +import Data.Monoid +import Data.Accessor +import Data.Accessor.Basic hiding (set) + +-- Ugly! To fix this we'll need to change the kind of XConfig. +newtype LayoutList a = LL [Layout a] deriving Monoid + +type W = Dual (Endo (XConfig LayoutList)) +mkW = Dual . Endo + +newtype Config a = C (WriterT W IO a) + deriving (Functor, Monad, MonadWriter W) + +-- references: +layout = fromSetGet (\x c -> c { layoutHook = x }) layoutHook +terminal = fromSetGet (\x c -> c { X.terminal = x }) X.terminal +keys = fromSetGet (\x c -> c { X.keys = x }) X.keys + +set :: Accessor (XConfig LayoutList) a -> a -> Config () +set r x = tell (mkW $ r ^= x) +add r x = tell (mkW (r ^: mappend x)) + +-- +example :: Config () +example = do + add layout $ LL [Layout $ Full] -- make this better + set terminal "urxvt" hunk ./XMonad/Hooks/UrgencyHook.hs 82 -import Data.List ((\\), delete) +import Data.List (delete) hunk ./XMonad/Hooks/UrgencyHook.hs 307 +clearUrgency :: Window -> X () +clearUrgency w = adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window) + hunk ./XMonad/Hooks/UrgencyHook.hs 340 - where clearUrgency w = adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window) - handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder + where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder hunk ./XMonad/Hooks/UrgencyHook.hs 372 -cleanupUrgents sw = do - suppressibles <- suppressibleWindows sw - adjustUrgents (\\ suppressibles) +cleanupUrgents sw = mapM_ clearUrgency =<< suppressibleWindows sw hunk ./XMonad/Doc/Extending.hs 493 +* "XMonad.Util.XPaste" provides utilities for pasting or sending keys and + strings to windows; + addfile ./XMonad/Util/XPaste.hs hunk ./XMonad/Util/XPaste.hs 1 - +{- | +Module : XMonad.Util.XPaste +Copyright : (C) 2008 +License : BSD3 + +Maintainer : import XMonad.Util.XPaste + +And use the functions. They all return "X ()", and so are appropriate for use as keybindings. +Example: + +> , ((m, xK_d), pasteString "foo bar") ] + +Don't expect too much of the functions; they probably don't work on complex +texts. +-} + +-- | Paste the current X mouse selection. Note that this uses 'getSelection' from "XMonad.Util.XSelection" and so is heir to its flaws. +pasteSelection :: X () +pasteSelection = getSelection >>= pasteString + +-- | Send a string to the window with current focus. This function correctly handles capitalization. +pasteString :: String -> X () +pasteString = mapM_ (\x -> if isUpper x then pasteChar shiftMask x else pasteChar 0 x) + +{- | Send a character to the current window. This is more low-level. + Remember that you must handle the case of capitalization appropriately. That is, from the window's perspective: + + > pasteChar mod2Mask 'F' ~> "f" + + You would want to do something like: + + > pasteChar shiftMask 'F' +-} +pasteChar :: KeyMask -> Char -> X () +pasteChar m c = pasteKey m $ stringToKeysym [c] + +pasteKey :: KeyMask -> KeySym -> X () +pasteKey = (withFocused .) . pasteKeyWindow + +pasteKeyWindow :: KeyMask -> KeySym -> Window -> X () +pasteKeyWindow mods key w = withDisplay $ \d -> do + rootw <- asks theRoot + keycode <- io $ keysymToKeycode d key + io $ allocaXEvent $ \ev -> do + setEventType ev keyPress + setKeyEvent ev w rootw none mods keycode True + sendEvent d w True keyPressMask ev + setEventType ev keyRelease + sendEvent d w True keyReleaseMask ev hunk ./xmonad-contrib.cabal 200 + XMonad.Util.XPaste hunk ./XMonad/Util/XPaste.hs 3 +Author : Jérémy Bobbio hunk ./XMonad/Util/XPaste.hs 7 -Maintainer : hunk ./XMonad/Util/XPaste.hs 13 - hunk ./XMonad/Actions/CopyWindow.hs 80 - then view (tag (workspace (current s))) $ insertUp' w $ view n s + then view (currentTag s) $ insertUp' w $ view n s hunk ./XMonad/Actions/CopyWindow.hs 110 - view (tag (workspace (current ss))) . + view (currentTag ss) . hunk ./XMonad/Actions/CycleWS.hs 220 -findWorkspaceGen _ _ 0 = (tag . workspace . current) `fmap` gets windowset +findWorkspaceGen _ _ 0 = gets (currentTag . windowset) hunk ./XMonad/Actions/PerWorkspaceKeys.hs 39 -chooseAction f = withWindowSet (f . S.tag . S.workspace . S.current) +chooseAction f = withWindowSet (f . S.currentTag) hunk ./XMonad/Actions/SwapWorkspaces.hs 51 -swapWithCurrent t s = swapWorkspaces t (tag $ workspace $ current s) s +swapWithCurrent t s = swapWorkspaces t (currentTag s) s hunk ./XMonad/Actions/TagWindows.hs 123 - curtag = tag . workspace . current $ ws + curtag = currentTag ws hunk ./XMonad/Actions/TagWindows.hs 152 -withTagged' t m = gets windowset >>= - filterM (hasTag t) . integrate' . stack . workspace . current >>= m +withTagged' t m = gets windowset >>= filterM (hasTag t) . index >>= m hunk ./XMonad/Actions/TagWindows.hs 162 -shiftHere w s = shiftWin (tag . workspace . current $ s) w s +shiftHere w s = shiftWin (currentTag s) w s hunk ./XMonad/Actions/WindowBringer.hs 60 -bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws +bringWindow w ws = W.shiftWin (W.currentTag ws) w ws hunk ./XMonad/Actions/WindowNavigation.hs 156 - wsid <- gets (W.tag . W.workspace . W.current . windowset) + wsid <- gets (W.currentTag . windowset) hunk ./XMonad/Actions/WindowNavigation.hs 165 - wsid <- gets (W.tag . W.workspace . W.current . windowset) + wsid <- gets (W.currentTag . windowset) hunk ./XMonad/Config/Droundy.hs 179 - let t = W.tag $ W.workspace $ W.current $ windowset s + let t = W.currentTag $ windowset s hunk ./XMonad/Hooks/DynamicLog.hs 259 - where this = S.tag (S.workspace (S.current s)) + where this = S.currentTag s hunk ./XMonad/Hooks/EventHook.hs 32 -import Control.Applicative ((<$>)) hunk ./XMonad/Hooks/EventHook.hs 35 -import XMonad.StackSet (StackSet (..), Screen (..), Workspace (..)) +import XMonad.StackSet (Workspace (..), currentTag) hunk ./XMonad/Hooks/EventHook.hs 91 - iws <- (tag . workspace . current) <$> gets windowset + iws <- gets (currentTag . windowset) hunk ./XMonad/Hooks/EwmhDesktops.hs 86 - let curr = fromJust $ elemIndex (W.tag (W.workspace (W.current s))) $ map W.tag ws + let curr = fromJust $ elemIndex (W.currentTag s) $ map W.tag ws hunk ./XMonad/Layout/ShowWName.hs 92 - n <- withWindowSet (return . S.tag . S.workspace . S.current) + n <- withWindowSet (return . S.currentTag) hunk ./XMonad/Layout/WorkspaceDir.hs 40 -import XMonad.StackSet ( tag, current, workspace ) +import XMonad.StackSet ( tag, currentTag ) hunk ./XMonad/Layout/WorkspaceDir.hs 72 - modifyLayout (WorkspaceDir d) w r = do tc <- gets (tag.workspace.current.windowset) + modifyLayout (WorkspaceDir d) w r = do tc <- gets (currentTag.windowset) hunk ./XMonad/Hooks/DynamicLog.hs 182 - -> (XConfig Layout -> ((KeyMask, KeySym), X ())) + -> (XConfig Layout -> (KeyMask, KeySym)) hunk ./XMonad/Hooks/DynamicLog.hs 194 - , keys = liftM2 M.union (uncurry M.singleton . k) (keys conf) + , keys = liftM2 M.union keys' (keys conf) hunk ./XMonad/Hooks/DynamicLog.hs 196 + where + keys' = (`M.singleton` sendMessage ToggleStruts) . k hunk ./XMonad/Hooks/DynamicLog.hs 202 -toggleStrutsKey :: XConfig t -> ((KeyMask, KeySym), X ()) -toggleStrutsKey XConfig{modMask = modm} = ((modm, xK_b ), sendMessage ToggleStruts) +toggleStrutsKey :: XConfig t -> (KeyMask, KeySym) +toggleStrutsKey XConfig{modMask = modm} = (modm, xK_b ) hunk ./xmonad-contrib.cabal 60 - build-depends: mtl, unix, X11>=1.4.1, xmonad>=0.8, xmonad<0.9 + build-depends: mtl, unix, X11>=1.4.3, xmonad>=0.8, xmonad<0.9 move ./XMonad/Util/XPaste.hs ./XMonad/Util/Paste.hs hunk ./XMonad/Doc/Extending.hs 493 -* "XMonad.Util.XPaste" provides utilities for pasting or sending keys and +* "XMonad.Util.Paste" provides utilities for pasting or sending keys and hunk ./XMonad/Util/Paste.hs 2 -Module : XMonad.Util.XPaste +Module : XMonad.Util.Paste hunk ./XMonad/Util/Paste.hs 15 -module XMonad.Util.XPaste where +module XMonad.Util.Paste where hunk ./XMonad/Util/Paste.hs 75 + hunk ./xmonad-contrib.cabal 200 - XMonad.Util.XPaste + XMonad.Util.Paste hunk ./XMonad/Hooks/DynamicLog.hs 145 --- > main = xmonad =<< xmonad conf +-- > main = xmonad =<< dzen conf hunk ./XMonad/Hooks/DynamicLog.hs 168 --- > main = xmonad =<< xmobar config +-- > main = xmonad =<< xmobar conf hunk ./XMonad/Util/Paste.hs 60 -pasteChar m c = pasteKey m $ stringToKeysym [c] +pasteChar m c = sendKey m $ stringToKeysym [c] hunk ./XMonad/Util/Paste.hs 62 -pasteKey :: KeyMask -> KeySym -> X () -pasteKey = (withFocused .) . pasteKeyWindow +sendKey :: KeyMask -> KeySym -> X () +sendKey = (withFocused .) . sendKeyWindow hunk ./XMonad/Util/Paste.hs 65 -pasteKeyWindow :: KeyMask -> KeySym -> Window -> X () -pasteKeyWindow mods key w = withDisplay $ \d -> do +sendKeyWindow :: KeyMask -> KeySym -> Window -> X () +sendKeyWindow mods key w = withDisplay $ \d -> do hunk ./XMonad/Config/Sjanssen.hs 2 -module XMonad.Config.Sjanssen (sjanssenConfig) where +module XMonad.Config.Sjanssen (sjanssenConfig, sjanssenConfigXmobar) where hunk ./XMonad/Config/Sjanssen.hs 15 -import XMonad.Util.Run (spawnPipe) hunk ./XMonad/Config/Sjanssen.hs 17 -import System.IO (hPutStrLn) hunk ./XMonad/Config/Sjanssen.hs 18 -sjanssenConfig = do - xmobar <- spawnPipe "xmobar" - return $ defaultConfig +sjanssenConfigXmobar = statusBar "xmobar" sjanssenPP strutkey sjanssenConfig + where + strutkey (XConfig {modMask = modm}) = (modm, xK_b) + +sjanssenConfig = + defaultConfig hunk ./XMonad/Config/Sjanssen.hs 26 - , logHook = dynamicLogWithPP $ sjanssenPP { ppOutput = hPutStrLn xmobar } hunk ./XMonad/Config/Sjanssen.hs 40 - modifiers = avoidStruts . smartBorders + modifiers = smartBorders hunk ./XMonad/Config/Sjanssen.hs 47 - ,((modm, xK_b ), sendMessage ToggleStruts) hunk ./XMonad/Prompt.hs 47 + -- * History filters + , deleteAllDuplicates + , deleteConsecutiveDuplicates hunk ./XMonad/Prompt.hs 115 + , historyFilter :: [String] -> [String] + -- ^ a filter to determine which + -- history entries to remember hunk ./XMonad/Prompt.hs 122 - } deriving (Show, Read) + } hunk ./XMonad/Prompt.hs 189 + , historyFilter = id hunk ./XMonad/Prompt.hs 818 + +-- | Functions to be used with the 'historyFilter' setting. +-- 'deleteAllDuplicates' will remove all duplicate entries. +-- 'deleteConsecutiveDuplicates' will remove duplicate elements which are +-- immediately next to each other. +deleteAllDuplicates, deleteConsecutiveDuplicates :: [String] -> [String] +deleteAllDuplicates = nub +deleteConsecutiveDuplicates = map head . group hunk ./XMonad/Prompt.hs 253 - (\xs ys -> take (historySize conf) $ xs ++ ys) + (\xs ys -> take (historySize conf) + . historyFilter conf $ xs ++ ys) hunk ./XMonad/Util/Paste.hs 33 -And use the functions. They all return "X ()", and so are appropriate for use as keybindings. -Example: +And use the functions. They all return "X ()", and so are appropriate +for use as keybindings. Example: hunk ./XMonad/Util/Paste.hs 42 --- | Paste the current X mouse selection. Note that this uses 'getSelection' from "XMonad.Util.XSelection" and so is heir to its flaws. +-- | Paste the current X mouse selection. Note that this uses 'getSelection' from +-- "XMonad.Util.XSelection" and so is heir to its flaws. hunk ./XMonad/Util/Paste.hs 47 --- | Send a string to the window with current focus. This function correctly handles capitalization. +-- | Send a string to the window with current focus. This function correctly +-- handles capitalization. hunk ./XMonad/Util/Paste.hs 53 - Remember that you must handle the case of capitalization appropriately. That is, from the window's perspective: + Remember that you must handle the case of capitalization appropriately. + That is, from the window's perspective: hunk ./XMonad/Util/Paste.hs 61 + + Note that this function makes use of 'stringToKeysym', and so will probably + have trouble with any Char outside ASCII. hunk ./XMonad/Layout/Grid.hs 20 - Grid(..), arrange + Grid(..), arrange, defaultRatio hunk ./XMonad/Layout/Grid.hs 36 +-- You can also specify an aspect ratio for Grid to strive for with the +-- GridRatio constructor: +-- +-- > myLayouts = GridRatio (3/4) ||| etc. +-- hunk ./XMonad/Layout/Grid.hs 45 -data Grid a = Grid deriving (Read, Show) +data Grid a = Grid | GridRatio Double deriving (Read, Show) + +defaultRatio :: Double +defaultRatio = 9/16 hunk ./XMonad/Layout/Grid.hs 51 - pureLayout Grid r s = arrange r (integrate s) + pureLayout Grid r = pureLayout (GridRatio defaultRatio) r + pureLayout (GridRatio d) r = arrange d r . integrate hunk ./XMonad/Layout/Grid.hs 54 -arrange :: Rectangle -> [a] -> [(a, Rectangle)] -arrange (Rectangle rx ry rw rh) st = zip st rectangles +arrange :: Double -> Rectangle -> [a] -> [(a, Rectangle)] +arrange aspectRatio (Rectangle rx ry rw rh) st = zip st rectangles hunk ./XMonad/Layout/Grid.hs 58 - ncols = max 1 . round . sqrt $ fromIntegral nwins * 9 * fromIntegral rw / (16 * fromIntegral rh :: Double) + ncols = max 1 . round . sqrt $ aspectRatio * fromIntegral nwins * fromIntegral rw / fromIntegral rh hunk ./XMonad/Layout/IM.hs 125 - Just w -> (w, masterRect) : arrange slaveRect (filter (w /=) ws) - Nothing -> arrange rect ws + Just w -> (w, masterRect) : arrange defaultRatio slaveRect (filter (w /=) ws) + Nothing -> arrange defaultRatio rect ws hunk ./XMonad/Layout/Grid.hs 39 --- > myLayouts = GridRatio (3/4) ||| etc. +-- > myLayouts = GridRatio (4/3) ||| etc. hunk ./XMonad/Layout/Grid.hs 48 -defaultRatio = 9/16 +defaultRatio = 16/9 hunk ./XMonad/Layout/Grid.hs 58 - ncols = max 1 . round . sqrt $ aspectRatio * fromIntegral nwins * fromIntegral rw / fromIntegral rh + ncols = max 1 . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh * aspectRatio) addfile ./XMonad/Config/Azerty.hs hunk ./XMonad/Config/Azerty.hs 1 +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Config.Azerty +-- Copyright : (c) Devin Mullins +-- License : BSD +-- +-- Maintainer : Devin Mullins +-- +-- This module fixes some of the keybindings for the francophone among you who +-- use an AZERTY keyboard layout. Config stolen from TeXitoi's config on the +-- wiki. + +module XMonad.Config.Azerty ( + -- * Usage + -- $usage + azertyConfig, azertyKeys + ) where + +import XMonad +import qualified XMonad.StackSet as W + +import qualified Data.Map as M + +-- $usage +-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad +-- > import XMonad.Config.Azerty +-- > +-- > main = xmonad azertyConfig +-- +-- If you prefer, an azertyKeys function is provided which you can use as so: +-- +-- > import qualified Data.Map as M +-- > main = xmonad someConfig { keys = \c -> azertyKeys c `M.union` keys someConfig c } + +azertyConfig = defaultConfig { keys = \c -> azertyKeys c `M.union` keys defaultConfig c } + +azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $ + [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))] + ++ + [((m .|. modm, k), windows $ f i) + | (i, k) <- zip (workspaces conf) [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0], + (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] hunk ./xmonad-contrib.cabal 103 + XMonad.Config.Azerty hunk ./XMonad/Util/XSelection.hs 1 +{-# LANGUAGE CPP #-} hunk ./XMonad/Util/XSelection.hs 28 -import Data.Bits (shiftL, (.&.), (.|.)) -import Data.Char (chr, ord) +import Data.Char (ord) hunk ./XMonad/Util/XSelection.hs 30 -import Data.Word (Word8) hunk ./XMonad/Util/XSelection.hs 33 +#ifdef UTF8 +import Codec.Binary.UTF8.String (decode) +#else +import Data.Bits (shiftL, (.&.), (.|.)) +import Data.Char (chr) +import Data.Word (Word8) +{- | Decode a UTF8 string packed into a list of Word8 values, directly to + String; does not deal with CChar, hence you will want the counter-intuitive @map fromIntegral@ + UTF-8 decoding for internal use in getSelection. + + This code is copied from Eric Mertens's "utf-string" library + (as of version 0.1),\which is BSD-3 licensed like this module. + It'd be better to just @import Codec.Binary.UTF8.String (decode)@, but then users of this would need to install it; XMonad has enough + dependencies already. -} +decode :: [Word8] -> String +decode [] = "" +decode (c:cs) + | c < 0x80 = chr (fromEnum c) : decode cs + | c < 0xc0 = replacement_character : decode cs + | c < 0xe0 = multi_byte 1 0x1f 0x80 + | c < 0xf0 = multi_byte 2 0xf 0x800 + | c < 0xf8 = multi_byte 3 0x7 0x10000 + | c < 0xfc = multi_byte 4 0x3 0x200000 + | c < 0xfe = multi_byte 5 0x1 0x4000000 + | otherwise = replacement_character : decode cs + where + + replacement_character :: Char + replacement_character = '\xfffd' + + multi_byte :: Int -> Word8 -> Int -> [Char] + multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask)) + where + aux 0 rs acc + | overlong <= acc && acc <= 0x10ffff && + (acc < 0xd800 || 0xdfff < acc) && + (acc < 0xfffe || 0xffff < acc) = chr acc : decode rs + | otherwise = replacement_character : decode rs + aux n (r:rs) acc + | r .&. 0xc0 == 0x80 = aux (n-1) rs + $ shiftL acc 6 .|. fromEnum (r .&. 0x3f) + aux _ rs _ = replacement_character : decode rs +#endif + hunk ./XMonad/Util/XSelection.hs 175 - -{- | Decode a UTF8 string packed into a list of Word8 values, directly to - String; does not deal with CChar, hence you will want the counter-intuitive @map fromIntegral@ - UTF-8 decoding for internal use in getSelection. - - This code is copied from Eric Mertens's "utf-string" library - (as of version 0.1),\which is BSD-3 licensed like this module. - It'd be better to just @import Codec.Binary.UTF8.String (decode)@, but then users of this would need to install it; XMonad has enough - dependencies already. -} -decode :: [Word8] -> String -decode [ ] = "" -decode (c:cs) - | c < 0x80 = chr (fromEnum c) : decode cs - | c < 0xc0 = replacement_character : decode cs - | c < 0xe0 = multi_byte 1 0x1f 0x80 - | c < 0xf0 = multi_byte 2 0xf 0x800 - | c < 0xf8 = multi_byte 3 0x7 0x10000 - | c < 0xfc = multi_byte 4 0x3 0x200000 - | c < 0xfe = multi_byte 5 0x1 0x4000000 - | otherwise = replacement_character : decode cs - where - - replacement_character :: Char - replacement_character = '\xfffd' - - multi_byte :: Int -> Word8 -> Int -> [Char] - multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask)) - where - aux 0 rs acc - | overlong <= acc && acc <= 0x10ffff && - (acc < 0xd800 || 0xdfff < acc) && - (acc < 0xfffe || 0xffff < acc) = chr acc : decode rs - | otherwise = replacement_character : decode rs - aux n (r:rs) acc - | r .&. 0xc0 == 0x80 = aux (n-1) rs - $ shiftL acc 6 .|. fromEnum (r .&. 0x3f) - aux _ rs _ = replacement_character : decode rs hunk ./XMonad/Util/Font.hsc 46 -#if defined XFT || defined UTF8 +#if defined XFT || defined USE_UTF8 hunk ./XMonad/Util/Font.hsc 106 -#ifdef UTF8 +#ifdef USE_UTF8 hunk ./XMonad/Util/Paste.hs 81 - hunk ./XMonad/Util/XSelection.hs 33 -#ifdef UTF8 +#ifdef USE_UTF8 hunk ./xmonad-contrib.cabal 58 - cpp-options: -DUTF8 + cpp-options: -DUSE_UTF8 hunk ./XMonad/Layout/Grid.hs 59 - mincs = nwins `div` ncols + mincs = max 1 $ nwins `div` ncols hunk ./XMonad/Util/Paste.hs 26 - hunk ./XMonad/Util/Paste.hs 49 -pasteString = mapM_ (\x -> if isUpper x then pasteChar shiftMask x else pasteChar 0 x) +pasteString = mapM_ (\x -> if isUpper x then pasteChar shiftMask x else pasteChar noModMask x) hunk ./XMonad/Util/Paste.hs 80 + +-- | A null 'KeyMask'. Used when you don't want a character or string shifted, control'd, or what. +-- TODO: This really should be a function in the X11 binding. When noModMask shows up there, remove. +noModMask :: KeyMask +noModMask = 0 + hunk ./XMonad/Util/Font.hsc 198 -#if defined XFT || defined UTF8 +#if defined XFT || defined USE_UTF8 hunk ./XMonad/Util/Font.hsc 205 -#if defined XFT || defined UTF8 +#if defined XFT || defined USE_UTF8 hunk ./XMonad/Layout/HintedGrid.hs 21 - Grid(..), arrange + Grid(..), arrange, defaultRatio hunk ./XMonad/Layout/HintedGrid.hs 47 +-- You can also specify an aspect ratio for Grid to strive for with the +-- GridRatio constructor: +-- +-- > myLayouts = GridRatio (4/3) False ||| etc. +-- hunk ./XMonad/Layout/HintedGrid.hs 58 -data Grid a = Grid Bool deriving (Read, Show) +data Grid a = Grid Bool | GridRatio Double Bool deriving (Read, Show) + +defaultRatio :: Double +defaultRatio = 16/9 hunk ./XMonad/Layout/HintedGrid.hs 64 - doLayout (Grid m) r w = flip (,) Nothing . arrange m r (integrate w) + doLayout (Grid m) r w = doLayout (GridRatio defaultRatio m) r w + doLayout (GridRatio d m) r w = flip (,) Nothing . arrange d m r (integrate w) hunk ./XMonad/Layout/HintedGrid.hs 104 -arrange :: Bool -> Rectangle -> [Window] -> X [(Window, Rectangle)] -arrange mirror (Rectangle rx ry rw rh) wins = do +arrange :: Double -> Bool -> Rectangle -> [Window] -> X [(Window, Rectangle)] +arrange aspectRatio mirror (Rectangle rx ry rw rh) wins = do hunk ./XMonad/Layout/HintedGrid.hs 109 - rs = arrange' (twist (rw, rh)) adjs + rs = arrange' aspectRatio (twist (rw, rh)) adjs hunk ./XMonad/Layout/HintedGrid.hs 117 -arrange' :: D -> [D -> D] -> [Rectangle] -arrange' (rw, rh) adjs = reverse $ doRect rh rw (fromIntegral ncolumns) (ecols ++ cols) +arrange' :: Double -> D -> [D -> D] -> [Rectangle] +arrange' aspectRatio (rw, rh) adjs = reverse $ doRect rh rw (fromIntegral ncolumns) (ecols ++ cols) hunk ./XMonad/Layout/HintedGrid.hs 121 - ncolumns = max 1 . round . sqrt $ fromIntegral nwindows * 9 * fromIntegral rw / (16 * fromIntegral rh :: Double) + ncolumns = max 1 . round . sqrt $ fromIntegral nwindows * fromIntegral rw / (fromIntegral rh * aspectRatio) hunk ./XMonad/Layout/Grid.hs 37 --- GridRatio constructor: +-- GridRatio constructor. For example, if you want Grid to try to make a grid +-- four windows wide and three windows tall, you could use hunk ./XMonad/Util/Paste.hs 15 -module XMonad.Util.Paste where +module XMonad.Util.Paste ( -- * Usage + -- $usage + pasteSelection, + pasteString, + pasteChar, + sendKey, + sendKeyWindow, + noModMask + ) + where hunk ./XMonad/Util/Paste.hs 3 -Author : Jérémy Bobbio -Copyright : (C) 2008 +Copyright : (C) 2008 Jérémy Bobbio, gwern hunk ./XMonad/Util/Paste.hs 6 -Maintainer : +Maintainer : gwern hunk ./XMonad/Util/Paste.hs 38 -> import XMonad.Util.XPaste +> import XMonad.Util.Paste hunk ./XMonad/Util/Paste.hs 40 -And use the functions. They all return "X ()", and so are appropriate +And use the functions. They all return 'X' (), and so are appropriate hunk ./XMonad/Util/Paste.hs 54 --- | Send a string to the window with current focus. This function correctly +-- | Send a string to the window which is currently focused. This function correctly hunk ./XMonad/Util/Paste.hs 70 - have trouble with any Char outside ASCII. + have trouble with any 'Char' outside ASCII. hunk ./XMonad/Util/Paste.hs 78 +-- | The primitive. Allows you to send any combination of 'KeyMask' and 'KeySym' to any 'Window' you specify. hunk ./XMonad/Util/Paste.hs 91 +-- hunk ./XMonad/Layout/NoBorders.hs 78 - redoLayout (SmartBorder s) _ st wrs = do + redoLayout sb _ st wrs = genericLayoutMod sb (W.integrate st) wrs + + emptyLayoutMod sb _ wrs = genericLayoutMod sb [] wrs + +genericLayoutMod :: (SmartBorder Window) -> [Window] -> [(Window, b)] -> + X ([(Window, b)], Maybe (SmartBorder Window)) +genericLayoutMod (SmartBorder s) managedwindows wrs = do hunk ./XMonad/Layout/NoBorders.hs 86 - let managedwindows = W.integrate st - screens = filter (nonzerorect . screenRect . W.screenDetail) . W.screens $ wset + let screens = filter (nonzerorect . screenRect . W.screenDetail) . W.screens $ wset hunk ./XMonad/Actions/MouseResize.hs 68 - redoLayout (MR st) _ s wrs + redoLayout _ _ Nothing wrs = return (wrs, Nothing) + redoLayout (MR st) _ (Just s) wrs hunk ./XMonad/Layout/Decoration.hs 204 - redoLayout (Decoration st sh t ds) sc stack wrs + redoLayout (Decoration (I (Just s)) sh t ds) _ Nothing _ = do + releaseResources s + return ([], Just $ Decoration (I Nothing) sh t ds) + redoLayout _ _ Nothing _ = return ([], Nothing) + + redoLayout (Decoration st sh t ds) sc (Just stack) wrs hunk ./XMonad/Layout/Decoration.hs 272 - emptyLayoutMod (Decoration (I (Just s)) sh t ds) _ _ = do - releaseResources s - return ([], Just $ Decoration (I Nothing) sh t ds) - emptyLayoutMod _ _ _ = return ([], Nothing) - hunk ./XMonad/Layout/LayoutHints.hs 49 - redoLayout _ _ s xs = do + redoLayout _ _ Nothing xs = return (xs, Nothing) + redoLayout _ _ (Just s) xs = do hunk ./XMonad/Layout/LayoutModifier.hs 167 - -- If you also need to perform some action when 'runLayout' is - -- called on an empty workspace, see 'emptyLayoutMod'. + -- On empty workspaces, the Stack is Nothing. hunk ./XMonad/Layout/LayoutModifier.hs 171 - redoLayout :: m a -- ^ the layout modifier - -> Rectangle -- ^ screen rectangle - -> Stack a -- ^ current window stack + redoLayout :: m a -- ^ the layout modifier + -> Rectangle -- ^ screen rectangle + -> Maybe (Stack a) -- ^ current window stack hunk ./XMonad/Layout/LayoutModifier.hs 177 - redoLayout m r s wrs = do hook m; return $ pureModifier m r s wrs + redoLayout m r ms wrs = do hook m; return $ pureModifier m r ms wrs hunk ./XMonad/Layout/LayoutModifier.hs 186 - pureModifier :: m a -- ^ the layout modifier - -> Rectangle -- ^ screen rectangle - -> Stack a -- ^ current window stack + pureModifier :: m a -- ^ the layout modifier + -> Rectangle -- ^ screen rectangle + -> Maybe (Stack a) -- ^ current window stack hunk ./XMonad/Layout/LayoutModifier.hs 194 - -- | 'emptyLayoutMod' allows you to intercept a call to - -- 'runLayout' on an empty workspace, /after/ it is called on - -- the underlying layout, in order to perform some effect in the - -- X monad, possibly return a new layout modifier, and\/or - -- modify the results of 'runLayout' before returning them. - -- - -- If you don't need access to the X monad, then tough luck. - -- There isn't a pure version of 'emptyLayoutMod'. - -- - -- The default implementation of 'emptyLayoutMod' ignores its - -- arguments and returns an empty list of window\/rectangle - -- pairings. - -- - -- /NOTE/: 'emptyLayoutMod' will likely be combined with - -- 'redoLayout' soon! - emptyLayoutMod :: m a -> Rectangle -> [(a, Rectangle)] - -> X ([(a, Rectangle)], Maybe (m a)) - emptyLayoutMod _ _ _ = return ([], Nothing) - hunk ./XMonad/Layout/LayoutModifier.hs 239 - (ws', mm') <- case ms of - Just s -> redoLayout m r s ws - Nothing -> emptyLayoutMod m r ws + (ws', mm') <- redoLayout m r ms ws hunk ./XMonad/Layout/Magnifier.hs 117 - redoLayout (Mag z On All ) = applyMagnifier z - redoLayout (Mag z On NoMaster) = unlessMaster $ applyMagnifier z - redoLayout _ = nothing - where nothing _ _ wrs = return (wrs, Nothing) + redoLayout (Mag z On All ) r (Just s) wrs = applyMagnifier z r s wrs + redoLayout (Mag z On NoMaster) r (Just s) wrs = unlessMaster (applyMagnifier z) r s wrs + redoLayout _ _ _ wrs = return (wrs, Nothing) hunk ./XMonad/Layout/NoBorders.hs 78 - redoLayout sb _ st wrs = genericLayoutMod sb (W.integrate st) wrs - - emptyLayoutMod sb _ wrs = genericLayoutMod sb [] wrs - -genericLayoutMod :: (SmartBorder Window) -> [Window] -> [(Window, b)] -> - X ([(Window, b)], Maybe (SmartBorder Window)) -genericLayoutMod (SmartBorder s) managedwindows wrs = do + redoLayout (SmartBorder s) _ mst wrs = do hunk ./XMonad/Layout/NoBorders.hs 80 - let screens = filter (nonzerorect . screenRect . W.screenDetail) . W.screens $ wset + let managedwindows = W.integrate' mst + screens = filter (nonzerorect . screenRect . W.screenDetail) . W.screens $ wset hunk ./XMonad/Layout/ShowWName.hs 73 - emptyLayoutMod sn r wrs = doShow sn r wrs - hunk ./XMonad/Layout/WindowArranger.hs 112 - pureModifier (WA True b []) _ _ wrs = arrangeWindows b wrs + pureModifier (WA True b []) _ (Just _) wrs = arrangeWindows b wrs hunk ./XMonad/Layout/WindowArranger.hs 114 - pureModifier (WA True b awrs) _ (S.Stack w _ _) wrs = curry process wrs awrs + pureModifier (WA True b awrs) _ (Just (S.Stack w _ _)) wrs = curry process wrs awrs hunk ./XMonad/Layout/WindowNavigation.hs 109 - redoLayout (WindowNavigation conf (I state)) rscr s origwrs = + redoLayout (WindowNavigation conf (I state)) rscr (Just s) origwrs = hunk ./XMonad/Layout/WindowNavigation.hs 139 + redoLayout _ _ _ origwrs = return (origwrs, Nothing) hunk ./XMonad/Actions/CycleWS.hs 175 + | HiddenWS -- ^ cycle through non-visible workspaces hunk ./XMonad/Actions/CycleWS.hs 186 +wsTypeToPred HiddenWS = do hs <- gets (map tag . hidden . windowset) + return (\w -> tag w `elem` hs) hunk ./XMonad/Actions/CycleWS.hs 188 -wsTypeToPred HiddenNonEmptyWS = do hs <- gets (map tag . hidden . windowset) - return (\w -> isJust (stack w) && tag w `elem` hs) +wsTypeToPred HiddenNonEmptyWS = do ne <- wsTypeToPred NonEmptyWS + hi <- wsTypeToPred HiddenWS + return (\w -> hi w && ne w) hunk ./XMonad/Actions/Search.hs 25 + deb, + debbts, + debpts, hunk ./XMonad/Actions/Search.hs 31 + images, hunk ./XMonad/Actions/Search.hs 33 + isohunt, hunk ./XMonad/Actions/Search.hs 83 +* 'deb' -- Debian package search. + +* 'debbts' -- Debian Bug Tracking System. + +* 'debpts -- Debian Package Tracking System. + hunk ./XMonad/Actions/Search.hs 95 +* 'images' -- Google images. + hunk ./XMonad/Actions/Search.hs 99 +* 'isohunt' -- isoHunt search. + hunk ./XMonad/Actions/Search.hs 214 -amazon, codesearch, dictionary, google, hoogle, imdb, maps, mathworld, - scholar, thesaurus, wayback, wikipedia, youtube :: SearchEngine +amazon, codesearch, deb, debbts, debpts, dictionary, google, hoogle, images, + imdb, isohunt, maps, mathworld, scholar, thesaurus, wayback, wikipedia, + youtube :: SearchEngine hunk ./XMonad/Actions/Search.hs 219 +deb = searchEngine "deb" "http://packages.debian.org/" +debbts = searchEngine "debbts" "http://bugs.debian.org/" +debpts = searchEngine "debpts" "http://packages.qa.debian.org/" hunk ./XMonad/Actions/Search.hs 225 +images = searchEngine "images" "http://images.google.fr/images?q=" hunk ./XMonad/Actions/Search.hs 227 +isohunt = searchEngine "isohunt" "http://isohunt.com/torrents/?ihq=" hunk ./XMonad/Layout/Magnifier.hs 122 - | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z `addto` 0.1) On t) - | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z `addto` 0.1) On t) + | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z `addto` 0.1 ) On t) + | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z `addto` (-0.1)) On t) hunk ./XMonad/Hooks/EwmhDesktops.hs 154 - windows $ W.focusWindow w - kill + killWindow w hunk ./XMonad/Hooks/EwmhDesktops.hs 141 + a_ignore <- mapM getAtom ["XMONAD_TIMER"] hunk ./XMonad/Hooks/EwmhDesktops.hs 156 + else if mt `elem` a_ignore then do + return () hunk ./XMonad/Prompt.hs 810 --- | Sort a list and remove duplicates. -uniqSort :: Ord a => [a] -> [a] -uniqSort = toList . fromList - hunk ./XMonad/Prompt.hs 816 +-- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off +-- laziness and stability for efficiency. +uniqSort :: Ord a => [a] -> [a] +uniqSort = toList . fromList + hunk ./XMonad/Prompt.hs 94 - , showComplWin :: Bool + , showComplWin :: Bool hunk ./XMonad/Prompt.hs 120 - , showCompletionOnTab :: Bool -- ^ Only show list of completions when Tab was pressed + , showCompletionOnTab :: Bool -- ^ Only show list of completions when Tab was pressed hunk ./XMonad/Prompt.hs 192 - , showCompletionOnTab = False + , showCompletionOnTab = False hunk ./XMonad/Prompt.hs 207 - , showComplWin = not (showCompletionOnTab c) + , showComplWin = not (showCompletionOnTab c) hunk ./XMonad/Prompt.hs 811 --- getShellCompl; you pass it to mkXPrompt, and it will make completions work --- from the query history stored in ~/.xmonad/history. +-- 'getShellCompl'; you pass it to mkXPrompt, and it will make completions work +-- from the query history stored in ~\/.xmonad\/history. hunk ./XMonad/Prompt.hs 823 --- 'deleteConsecutiveDuplicates' will remove duplicate elements which are +-- 'deleteConsecutiveDuplicates' will only remove duplicate elements hunk ./XMonad/Prompt.hs 814 -historyCompletion x = fmap (filter (isInfixOf x) . Map.fold (++) []) readHistory +historyCompletion x = fmap (deleteConsecutiveDuplicates . filter (isInfixOf x) . Map.fold (++) []) readHistory replace ./XMonad/Prompt.hs [A-Za-z_0-9] deleteConsecutiveDuplicates deleteConsecutive hunk ./XMonad/Actions/Search.hs 30 + hackage, hunk ./XMonad/Actions/Search.hs 94 -* 'hoogle' -- Hoogle, the Haskell libraries search engine. +* 'hackage' -- Hackage, the Haskell package database. + +* 'hoogle' -- Hoogle, the Haskell libraries API search engine. hunk ./XMonad/Actions/Search.hs 217 -amazon, codesearch, deb, debbts, debpts, dictionary, google, hoogle, images, +amazon, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, hunk ./XMonad/Actions/Search.hs 227 +hackage = searchEngine "hackage" "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/" hunk ./XMonad/Actions/WindowBringer.hs 18 - -- * Usage - -- $usage - gotoMenu, bringMenu, windowMap, - bringWindow - ) where + -- * Usage + -- $usage + gotoMenu, gotoMenu', bringMenu, windowMap, + bringWindow + ) where hunk ./XMonad/Actions/WindowBringer.hs 30 -import XMonad.Util.Dmenu (dmenuMap) +import XMonad.Util.Dmenu (menuMap) hunk ./XMonad/Actions/WindowBringer.hs 53 +gotoMenu' :: String -> X () +gotoMenu' menuCmd = actionMenu' menuCmd W.focusWindow + hunk ./XMonad/Actions/WindowBringer.hs 68 -actionMenu action = windowMap >>= dmenuMap >>= flip X.whenJust (windows . action) +actionMenu action = actionMenu' "dmenu" action + +actionMenu' :: String -> (Window -> X.WindowSet -> X.WindowSet) -> X() +actionMenu' menuCmd action = windowMap >>= menuMapFunction >>= flip X.whenJust (windows . action) + where + menuMapFunction :: M.Map String a -> X (Maybe a) + menuMapFunction selectionMap = menuMap menuCmd selectionMap hunk ./XMonad/Util/Dmenu.hs 18 - -- * Usage - -- $usage - dmenu, dmenuXinerama, dmenuMap - ) where + -- * Usage + -- $usage + dmenu, dmenuXinerama, dmenuMap, menu, menuMap + ) where hunk ./XMonad/Util/Dmenu.hs 43 -dmenu opts = io $ runProcessWithInput "dmenu" [] (unlines opts) +dmenu opts = menu "dmenu" opts hunk ./XMonad/Util/Dmenu.hs 45 -dmenuMap :: M.Map String a -> X (Maybe a) -dmenuMap selectionMap = do - selection <- dmenu (M.keys selectionMap) +menu :: String -> [String] -> X String +menu menuCmd opts = io $ runProcessWithInput menuCmd [] (unlines opts) + +menuMap :: String -> M.Map String a -> X (Maybe a) +menuMap menuCmd selectionMap = do + selection <- menuFunction (M.keys selectionMap) hunk ./XMonad/Util/Dmenu.hs 52 + where + menuFunction = menu menuCmd hunk ./XMonad/Util/Dmenu.hs 55 +dmenuMap :: M.Map String a -> X (Maybe a) +dmenuMap selectionMap = menuMap "dmenu" selectionMap hunk ./XMonad/Prompt/Window.hs 22 - windowPromptBring + windowPromptBring, + windowPromptBringCopy hunk ./XMonad/Prompt/Window.hs 32 +import XMonad.Actions.CopyWindow hunk ./XMonad/Prompt/Window.hs 62 -data WindowPrompt = Goto | Bring +data WindowPrompt = Goto | Bring | BringCopy hunk ./XMonad/Prompt/Window.hs 65 - showXPrompt Bring = "Bring me here: " + showXPrompt Bring = "Bring window: " + showXPrompt BringCopy = "Bring a copy: " hunk ./XMonad/Prompt/Window.hs 70 -windowPromptGoto, windowPromptBring :: XPConfig -> X () +windowPromptGoto, windowPromptBring, windowPromptBringCopy :: XPConfig -> X () hunk ./XMonad/Prompt/Window.hs 73 +windowPromptBringCopy c = doPrompt BringCopy c hunk ./XMonad/Prompt/Window.hs 82 + BringCopy -> fmap bringCopyAction windowMap hunk ./XMonad/Prompt/Window.hs 90 + bringCopyAction = winAction bringCopyWindow hunk ./XMonad/Prompt/Window.hs 94 + +-- | Brings a copy of the specified window into the current workspace. +bringCopyWindow :: Window -> WindowSet -> WindowSet +bringCopyWindow w ws = copyWindow w (W.currentTag $ ws) ws + hunk ./XMonad/Hooks/UrgencyHook.hs 424 -dzenUrgencyHook = DzenUrgencyHook { duration = (5 `seconds`), args = [] } +dzenUrgencyHook = DzenUrgencyHook { duration = seconds 5, args = [] } hunk ./XMonad/Util/Loggers.hs 33 -import System.Process +import System.Process (runInteractiveCommand, waitForProcess) hunk ./xmonad-contrib.cabal 46 - build-depends: base >= 3, containers, directory, process, random, old-time, old-locale + build-depends: base >= 3 && < 4, containers, directory, process, random, old-time, old-locale hunk ./xmonad-contrib.cabal 48 - build-depends: base < 3 + build-depends: base < 3 && < 4 hunk ./xmonad-contrib.cabal 48 - build-depends: base < 3 && < 4 + build-depends: base < 3 hunk ./XMonad/Actions/Search.hs 146 +Or in combination with XMonad.Util.EZConfig: + +> ... +> ] -- end of regular keybindings +> -- Search commands +> ++ [("M-s " ++ k, S.promptSearch P.defaultXPConfig f) | (k,f) <- searchList ] +> ++ [("M-S-s " ++ k, S.selectSearch f) | (k,f) <- searchList ] +> +> ... +> +> searchList :: [([Char], S.SearchEngine)] +> searchList = [ ("g", S.google) +> , ("h", S.hoohle) +> , ("w", S.wikipedia) +> ] + addfile ./XMonad/Actions/GridSelect.hs hunk ./XMonad/Actions/GridSelect.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.GridSelect +-- Copyright : Clemens Fruhwirth +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Clemens Fruhwirth +-- Stability : unstable +-- Portability : unportable +-- +-- GridSelect displays a 2D grid of windows to navigate with cursor +-- keys and to select with return. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.GridSelect where +import Data.Maybe +import Data.Bits +import Control.Monad.State +import Control.Arrow +import Data.List as L +import XMonad +import XMonad.Util.Font +import XMonad.Prompt (mkUnmanagedWindow) +import XMonad.StackSet as W +import XMonad.Layout.Decoration +import XMonad.Util.NamedWindows +import Text.Printf + +data GSConfig = GSConfig { + gs_cellheight :: Integer, + gs_cellwidth :: Integer, + gs_cellpadding :: Integer, + gs_colorizer :: Window -> Bool -> X (String, String), + gs_font :: String +} + +type TwoDPosition = (Integer, Integer) + +data TwoDState = TwoDState { td_curpos :: TwoDPosition, + td_windowmap :: [(TwoDPosition,(String,Window))], + td_gsconfig :: GSConfig, + td_font :: XMonadFont, + td_paneX :: Integer, + td_paneY :: Integer } + + +type TwoD a = StateT TwoDState X a + +diamondLayer :: (Enum b', Num b') => b' -> [(b', b')] +-- FIXME remove nub +diamondLayer n = let ul = [ (x,n-x) | x <- [0..n] ] + in nub $ ul ++ (map (negate *** id) ul) ++ + (map (negate *** negate) ul) ++ + (map (id *** negate) ul) + +diamond :: (Enum a, Num a) => [(a, a)] +diamond = concatMap diamondLayer [0..] + + +-- FIXME this function returns a list an infinite list with finite +-- elements, so going beyond the last proper element causes a never +-- ending computation. + +diamondRestrict :: (Enum t, Num t, Ord t) => t -> t -> [(t, t)] +diamondRestrict x y = L.filter f diamond + where f (x',y') = (x' <= x) && + (x' >= -x) && + (y' <= y) && + (y' >= -y) + +tupadd :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1) +tupadd (a,b) (c,d) = (a+c,b+d) +tupmul :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1) +tupmul (a,b) (c,d) = (a*c,b*d) + +-- shrinkWhile should be exported from Decoration.hs +shrinkWhile :: Monad m => (String -> [String]) -> (String -> m Bool) -> String -> m String +shrinkWhile sh p x = sw $ sh x + where sw [n] = return n + sw [] = return "" + sw (n:ns) = do + cond <- p n + if cond + then sw ns + else return n + +drawWinBox :: Display -> Window -> XMonadFont -> (String, String) -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X () +drawWinBox dpy win font (fg,bg) ch cw text x y cp = do + gc <- liftIO $ createGC dpy win + bordergc <- liftIO $ createGC dpy win + liftIO $ do + Just fgcolor <- initColor dpy fg + Just bgcolor <- initColor dpy bg + Just bordercolor <- initColor dpy borderColor + setForeground dpy gc fgcolor + setBackground dpy gc bgcolor + setForeground dpy bordergc bordercolor + fillRectangle dpy win gc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch) + drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch) + stext <- shrinkWhile (shrinkIt shrinkText) + (\n -> do size <- liftIO $ textWidthXMF dpy font n + return $ size > (fromInteger (cw-(2*cp)))) + text + printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+(div ch 2))) stext + liftIO $ freeGC dpy gc + liftIO $ freeGC dpy bordergc + +updateWindows :: Display -> Window -> TwoD () +updateWindows dpy win = do + (TwoDState curpos windowList gsconfig font paneX paneY) <- get + let cellwidth = gs_cellwidth gsconfig + cellheight = gs_cellheight gsconfig + paneX' = div (paneX-cellwidth) 2 + paneY' = div (paneY-cellheight) 2 + updateWindow (pos@(x,y),(text, clientwindow)) = lift $ do + colors <- (gs_colorizer gsconfig) clientwindow (pos == curpos) + drawWinBox dpy win font + colors + (gs_cellheight gsconfig) + (gs_cellwidth gsconfig) text + (paneX'+x*cellwidth) + (paneY'+y*cellheight) + (gs_cellpadding gsconfig) + mapM updateWindow windowList + return () + +eventLoop :: Display -> Window -> TwoD (Maybe Window) +eventLoop d win = do + (keysym,string,event) <- liftIO $ allocaXEvent $ \e -> do + nextEvent d e + ev <- getEvent e + (ks,s) <- if ev_event_type ev == keyPress + then lookupString $ asKeyEvent e + else return (Nothing, "") + return (ks,s,ev) + handle d win (fromMaybe xK_VoidSymbol keysym,string) event + +handle :: Display + -> Window + -> (KeySym, String) + -> Event + -> StateT TwoDState X (Maybe Window) +handle d win (ks,_) (KeyEvent {ev_event_type = t}) + | t == keyPress && ks == xK_Escape = return Nothing + | t == keyPress && ks == xK_Left = diffAndRefresh (-1,0) + | t == keyPress && ks == xK_Right = diffAndRefresh (1,0) + | t == keyPress && ks == xK_Down = diffAndRefresh (0,1) + | t == keyPress && ks == xK_Up = diffAndRefresh (0,-1) + | t == keyPress && ks == xK_Return = do + (TwoDState pos win' _ _ _ _) <- get + return $ fmap (snd . snd) $ find ((== pos) . fst) win' + where diffAndRefresh diff = do + (TwoDState pos windowlist gsconfig font paneX paneY) <- get + put $ TwoDState (pos `tupadd` diff) windowlist gsconfig font paneX paneY + updateWindows d win + eventLoop d win + +handle d win _ _ = do + updateWindows d win + eventLoop d win + +-- FIXME probably move that into Utils? +-- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space +hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a) +hsv2rgb (h,s,v) = + let hi = (div h 60) `mod` 6 :: Integer + f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a + q = v * (1-f) + p = v * (1-s) + t = v * (1-(1-f)*s) + in case hi of + 0 -> (v,t,p) + 1 -> (q,v,p) + 2 -> (p,v,t) + 3 -> (p,q,v) + 4 -> (t,p,v) + 5 -> (v,p,q) + _ -> error "The world is ending. x mod a >= a." + +default_colorizer :: Window -> Bool -> X (String, String) +default_colorizer w active = do + classname <- runQuery className w + let seed x = toInteger (sum $ map ((*x).fromEnum) classname) :: Integer + (r,g,b) = hsv2rgb ((seed 83) `mod` 360, + (fromInteger ((seed 191) `mod` 1000))/2500+0.4, + (fromInteger ((seed 121) `mod` 1000))/2500+0.4) + if active + then return ("#faff69", "black") + else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Integer).(*256)) [r, g, b] ), "white") + where + twodigitHex :: Integer -> String + twodigitHex a = printf "%02x" a + +gridselect :: GSConfig -> X (Maybe Window) +gridselect gsconfig = + withDisplay $ \dpy -> do + rootw <- liftIO $ rootWindow dpy (defaultScreen dpy) + s <- gets $ screenRect . W.screenDetail . W.current . windowset + windowList <- windowMap + win <- liftIO $ mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw + (rect_x s) (rect_y s) (rect_width s) (rect_height s) + liftIO $ mapWindow dpy win + liftIO $ selectInput dpy win (exposureMask .|. keyPressMask) + status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime + font <- initXMF (gs_font gsconfig) + let screenWidth = toInteger $ rect_width s; + screenHeight = toInteger $ rect_height s; + selectedWindow <- if (status == grabSuccess) then + do + let restrictX = floor $ ((fromInteger screenWidth)/(fromInteger $ gs_cellwidth gsconfig)-1)/2 ; + restrictY = floor $ ((fromInteger screenHeight)/(fromInteger $ gs_cellheight gsconfig)-1)/2 ; + selectedWindow <- evalStateT (do updateWindows dpy win; eventLoop dpy win) + (TwoDState (0,0) + (zipWith (,) (diamondRestrict restrictX restrictY) windowList) + gsconfig + font + screenWidth + screenHeight) + return selectedWindow + else + return Nothing + liftIO $ do + unmapWindow dpy win + destroyWindow dpy win + sync dpy False + releaseXMF font + return selectedWindow + + +windowMap :: X [(String,Window)] +windowMap = do + ws <- gets windowset + wins <- mapM keyValuePair (W.allWindows ws) + return wins + where keyValuePair w = flip (,) w `fmap` decorateName' w + +decorateName' :: Window -> X String +decorateName' w = do + fmap show $ getName w + +defaultGSConfig :: GSConfig +defaultGSConfig = GSConfig 50 130 10 default_colorizer "xft:Sans-8" + +borderColor :: [Char] +borderColor = "white" hunk ./xmonad-contrib.cabal 84 + XMonad.Actions.GridSelect hunk ./XMonad/Actions/GridSelect.hs 16 -module XMonad.Actions.GridSelect where +module XMonad.Actions.GridSelect ( + -- * Usage + -- $usage + GSConfig(..), + defaultGSConfig, + gridselect, + withSelectedWindow, + bringSelected, + goToSelected + ) where hunk ./XMonad/Actions/GridSelect.hs 37 +import XMonad.Actions.WindowBringer (bringWindow) hunk ./XMonad/Actions/GridSelect.hs 40 +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.GridSelect +-- +-- Then add a keybinding, e.g. +-- +-- > , ((modMask x, xK_g), goToSelected defaultGSConfig) +-- + hunk ./XMonad/Actions/GridSelect.hs 216 +-- | Brings up a 2D grid of windows in the center of the screen, and one can +-- select a window with cursors keys. The selected window is returned. hunk ./XMonad/Actions/GridSelect.hs 253 +-- | Brings up a 2D grid of windows in the center of the screen, and one can +-- select a window with cursors keys. The selected window is then passed to +-- a callback function. +withSelectedWindow :: (Window -> X ()) -> GSConfig -> X () +withSelectedWindow callback conf = do + mbWindow <- gridselect conf + case mbWindow of + Just w -> callback w + Nothing -> return () + hunk ./XMonad/Actions/GridSelect.hs 278 -borderColor :: [Char] +borderColor :: String hunk ./XMonad/Actions/GridSelect.hs 280 + +-- | Brings selected window to the current workspace. +bringSelected :: GSConfig -> X () +bringSelected = withSelectedWindow $ \w -> do + windows (bringWindow w) + XMonad.focus w + windows W.shiftMaster + +-- | Switches to selected window's workspace and focuses that window. +goToSelected :: GSConfig -> X () +goToSelected = withSelectedWindow $ windows . W.focusWindow + hunk ./XMonad/Actions/GridSelect.hs 50 +-- Screenshot: hunk ./XMonad/Actions/GridSelect.hs 99 --- shrinkWhile should be exported from Decoration.hs -shrinkWhile :: Monad m => (String -> [String]) -> (String -> m Bool) -> String -> m String -shrinkWhile sh p x = sw $ sh x - where sw [n] = return n - sw [] = return "" - sw (n:ns) = do - cond <- p n - if cond - then sw ns - else return n - hunk ./XMonad/Layout/Decoration.hs 27 - , shrinkText, CustomShrink ( CustomShrink ) + , shrinkText, CustomShrink ( CustomShrink ), shrinkWhile hunk ./XMonad/Actions/GridSelect.hs 63 - td_windowmap :: [(TwoDPosition,(String,Window))], - td_gsconfig :: GSConfig, - td_font :: XMonadFont, - td_paneX :: Integer, - td_paneY :: Integer } + td_windowmap :: [(TwoDPosition,(String,Window))], + td_gsconfig :: GSConfig, + td_font :: XMonadFont, + td_paneX :: Integer, + td_paneY :: Integer } hunk ./XMonad/Actions/GridSelect.hs 75 - in nub $ ul ++ (map (negate *** id) ul) ++ - (map (negate *** negate) ul) ++ + in nub $ ul ++ (map (negate *** id) ul) ++ + (map (negate *** negate) ul) ++ hunk ./XMonad/Actions/GridSelect.hs 90 - (x' >= -x) && - (y' <= y) && - (y' >= -y) + (x' >= -x) && + (y' <= y) && + (y' >= -y) hunk ./XMonad/Actions/GridSelect.hs 113 - (\n -> do size <- liftIO $ textWidthXMF dpy font n - return $ size > (fromInteger (cw-(2*cp)))) - text + (\n -> do size <- liftIO $ textWidthXMF dpy font n + return $ size > (fromInteger (cw-(2*cp)))) + text hunk ./XMonad/Actions/GridSelect.hs 124 - cellheight = gs_cellheight gsconfig - paneX' = div (paneX-cellwidth) 2 + cellheight = gs_cellheight gsconfig + paneX' = div (paneX-cellwidth) 2 hunk ./XMonad/Actions/GridSelect.hs 127 - updateWindow (pos@(x,y),(text, clientwindow)) = lift $ do - colors <- (gs_colorizer gsconfig) clientwindow (pos == curpos) - drawWinBox dpy win font - colors - (gs_cellheight gsconfig) - (gs_cellwidth gsconfig) text - (paneX'+x*cellwidth) - (paneY'+y*cellheight) - (gs_cellpadding gsconfig) + updateWindow (pos@(x,y),(text, clientwindow)) = lift $ do + colors <- (gs_colorizer gsconfig) clientwindow (pos == curpos) + drawWinBox dpy win font + colors + (gs_cellheight gsconfig) + (gs_cellwidth gsconfig) text + (paneX'+x*cellwidth) + (paneY'+y*cellheight) + (gs_cellpadding gsconfig) hunk ./XMonad/Actions/GridSelect.hs 142 - nextEvent d e - ev <- getEvent e - (ks,s) <- if ev_event_type ev == keyPress - then lookupString $ asKeyEvent e - else return (Nothing, "") - return (ks,s,ev) + nextEvent d e + ev <- getEvent e + (ks,s) <- if ev_event_type ev == keyPress + then lookupString $ asKeyEvent e + else return (Nothing, "") + return (ks,s,ev) hunk ./XMonad/Actions/GridSelect.hs 165 - (TwoDState pos windowlist gsconfig font paneX paneY) <- get - put $ TwoDState (pos `tupadd` diff) windowlist gsconfig font paneX paneY - updateWindows d win - eventLoop d win + (TwoDState pos windowlist gsconfig font paneX paneY) <- get + put $ TwoDState (pos `tupadd` diff) windowlist gsconfig font paneX paneY + updateWindows d win + eventLoop d win hunk ./XMonad/Actions/GridSelect.hs 179 - f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a - q = v * (1-f) - p = v * (1-s) - t = v * (1-(1-f)*s) + f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a + q = v * (1-f) + p = v * (1-s) + t = v * (1-(1-f)*s) hunk ./XMonad/Actions/GridSelect.hs 184 - 0 -> (v,t,p) - 1 -> (q,v,p) - 2 -> (p,v,t) - 3 -> (p,q,v) - 4 -> (t,p,v) - 5 -> (v,p,q) - _ -> error "The world is ending. x mod a >= a." + 0 -> (v,t,p) + 1 -> (q,v,p) + 2 -> (p,v,t) + 3 -> (p,q,v) + 4 -> (t,p,v) + 5 -> (v,p,q) + _ -> error "The world is ending. x mod a >= a." hunk ./XMonad/Actions/GridSelect.hs 197 - (fromInteger ((seed 191) `mod` 1000))/2500+0.4, - (fromInteger ((seed 121) `mod` 1000))/2500+0.4) + (fromInteger ((seed 191) `mod` 1000))/2500+0.4, + (fromInteger ((seed 121) `mod` 1000))/2500+0.4) hunk ./XMonad/Actions/GridSelect.hs 221 - screenHeight = toInteger $ rect_height s; + screenHeight = toInteger $ rect_height s; hunk ./XMonad/Actions/GridSelect.hs 223 - do - let restrictX = floor $ ((fromInteger screenWidth)/(fromInteger $ gs_cellwidth gsconfig)-1)/2 ; - restrictY = floor $ ((fromInteger screenHeight)/(fromInteger $ gs_cellheight gsconfig)-1)/2 ; - selectedWindow <- evalStateT (do updateWindows dpy win; eventLoop dpy win) - (TwoDState (0,0) - (zipWith (,) (diamondRestrict restrictX restrictY) windowList) - gsconfig - font - screenWidth - screenHeight) - return selectedWindow - else - return Nothing + do + let restrictX = floor $ ((fromInteger screenWidth)/(fromInteger $ gs_cellwidth gsconfig)-1)/2 ; + restrictY = floor $ ((fromInteger screenHeight)/(fromInteger $ gs_cellheight gsconfig)-1)/2 ; + selectedWindow <- evalStateT (do updateWindows dpy win; eventLoop dpy win) + (TwoDState (0,0) + (zipWith (,) (diamondRestrict restrictX restrictY) windowList) + gsconfig + font + screenWidth + screenHeight) + return selectedWindow + else + return Nothing hunk ./XMonad/Actions/GridSelect.hs 82 - --- FIXME this function returns a list an infinite list with finite --- elements, so going beyond the last proper element causes a never --- ending computation. - hunk ./XMonad/Actions/GridSelect.hs 83 -diamondRestrict x y = L.filter f diamond - where f (x',y') = (x' <= x) && - (x' >= -x) && - (y' <= y) && - (y' >= -y) +diamondRestrict x y = L.filter (\(x',y') -> abs x' <= x && abs y' <= y) . + L.takeWhile (\(x',y') -> abs x' + abs y' <= x+y) $ diamond hunk ./XMonad/Actions/GridSelect.hs 157 - (TwoDState pos windowlist gsconfig font paneX paneY) <- get - put $ TwoDState (pos `tupadd` diff) windowlist gsconfig font paneX paneY - updateWindows d win + (TwoDState pos windowmap gsconfig font paneX paneY) <- get + let newpos = pos `tupadd` diff + when (isJust $ find ((newpos ==).fst) windowmap) $ do + put $ TwoDState newpos windowmap gsconfig font paneX paneY + updateWindows d win hunk ./XMonad/Actions/GridSelect.hs 62 +type TwoDWindowMap = [(TwoDPosition,(String,Window))] + hunk ./XMonad/Actions/GridSelect.hs 69 - td_paneY :: Integer } + td_paneY :: Integer, + td_drawingWin :: Window + } hunk ./XMonad/Actions/GridSelect.hs 92 -tupmul :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1) -tupmul (a,b) (c,d) = (a*c,b*d) hunk ./XMonad/Actions/GridSelect.hs 93 -drawWinBox :: Display -> Window -> XMonadFont -> (String, String) -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X () -drawWinBox dpy win font (fg,bg) ch cw text x y cp = do +findInWindowMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b) +findInWindowMap pos = find ((== pos) . fst) + +drawWinBox :: Window -> XMonadFont -> (String, String) -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X () +drawWinBox win font (fg,bg) ch cw text x y cp = + withDisplay $ \dpy -> do hunk ./XMonad/Actions/GridSelect.hs 118 -updateWindows :: Display -> Window -> TwoD () -updateWindows dpy win = do - (TwoDState curpos windowList gsconfig font paneX paneY) <- get +updateAllWindows :: TwoD () +updateAllWindows = + do + TwoDState { td_windowmap = wins } <- get + updateWindows wins + +updateWindows :: TwoDWindowMap -> TwoD () +updateWindows windowmap = do + TwoDState { td_curpos = curpos, + td_drawingWin = win, + td_gsconfig = gsconfig, + td_font = font, + td_paneX = paneX, + td_paneY = paneY} <- get hunk ./XMonad/Actions/GridSelect.hs 138 - drawWinBox dpy win font + drawWinBox win font hunk ./XMonad/Actions/GridSelect.hs 140 - (gs_cellheight gsconfig) - (gs_cellwidth gsconfig) text - (paneX'+x*cellwidth) - (paneY'+y*cellheight) - (gs_cellpadding gsconfig) - mapM updateWindow windowList + cellheight + cellwidth + text + (paneX'+x*cellwidth) + (paneY'+y*cellheight) + (gs_cellpadding gsconfig) + mapM updateWindow windowmap hunk ./XMonad/Actions/GridSelect.hs 149 -eventLoop :: Display -> Window -> TwoD (Maybe Window) -eventLoop d win = do - (keysym,string,event) <- liftIO $ allocaXEvent $ \e -> do +eventLoop :: TwoD (Maybe Window) +eventLoop = do + (keysym,string,event) <- lift $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do hunk ./XMonad/Actions/GridSelect.hs 158 - handle d win (fromMaybe xK_VoidSymbol keysym,string) event + handle (fromMaybe xK_VoidSymbol keysym,string) event hunk ./XMonad/Actions/GridSelect.hs 160 -handle :: Display - -> Window - -> (KeySym, String) +handle :: (KeySym, String) hunk ./XMonad/Actions/GridSelect.hs 163 -handle d win (ks,_) (KeyEvent {ev_event_type = t}) +handle (ks,_) (KeyEvent {ev_event_type = t}) hunk ./XMonad/Actions/GridSelect.hs 170 - (TwoDState pos win' _ _ _ _) <- get - return $ fmap (snd . snd) $ find ((== pos) . fst) win' + (TwoDState { td_curpos = pos, td_windowmap = winmap }) <- get + return $ fmap (snd . snd) $ findInWindowMap pos winmap hunk ./XMonad/Actions/GridSelect.hs 173 - (TwoDState pos windowmap gsconfig font paneX paneY) <- get - let newpos = pos `tupadd` diff - when (isJust $ find ((newpos ==).fst) windowmap) $ do - put $ TwoDState newpos windowmap gsconfig font paneX paneY - updateWindows d win - eventLoop d win + state <- get + let windowmap = td_windowmap state + oldPos = td_curpos state + newPos = oldPos `tupadd` diff + newSelectedWin = findInWindowMap newPos windowmap + when (isJust newSelectedWin) $ do + put state { td_curpos = newPos } + updateWindows (catMaybes [(findInWindowMap oldPos windowmap), newSelectedWin]) + eventLoop hunk ./XMonad/Actions/GridSelect.hs 183 -handle d win _ _ = do - updateWindows d win - eventLoop d win +handle _ (ExposeEvent { }) = do + updateAllWindows + eventLoop + +handle _ _ = do + eventLoop hunk ./XMonad/Actions/GridSelect.hs 242 - selectedWindow <- evalStateT (do updateWindows dpy win; eventLoop dpy win) + winmap = zipWith (,) (diamondRestrict restrictX restrictY) windowList + selectedWindow <- evalStateT (do updateAllWindows; eventLoop) hunk ./XMonad/Actions/GridSelect.hs 245 - (zipWith (,) (diamondRestrict restrictX restrictY) windowList) + winmap hunk ./XMonad/Actions/GridSelect.hs 249 - screenHeight) + screenHeight + win) hunk ./XMonad/Actions/GridSelect.hs 270 - + hunk ./XMonad/Actions/GridSelect.hs 240 - let restrictX = floor $ ((fromInteger screenWidth)/(fromInteger $ gs_cellwidth gsconfig)-1)/2 ; - restrictY = floor $ ((fromInteger screenHeight)/(fromInteger $ gs_cellheight gsconfig)-1)/2 ; + let restriction :: Integer -> (GSConfig -> Integer) -> Double + restriction ss cs = ((fromInteger ss)/(fromInteger $ cs gsconfig)-1)/2 + restrictX = floor $ restriction screenWidth gs_cellwidth + restrictY = floor $ restriction screenHeight gs_cellheight hunk ./XMonad/Actions/GridSelect.hs 24 - goToSelected + goToSelected, + default_colorizer hunk ./XMonad/Hooks/ManageHelpers.hs 28 + Side(..), hunk ./XMonad/Hooks/ManageHelpers.hs 40 - doCenterFloat + doCenterFloat, + doSideFloat hunk ./XMonad/Hooks/ManageHelpers.hs 50 +-- | Denotes a side of a screen. @S@ stands for South, @NE@ for Northwest +-- etc. @C@ stands for Center. +data Side = SC | NC | CE | CW | SE | SW | NE | NW | C + deriving (Read, Show, Eq) + hunk ./XMonad/Hooks/ManageHelpers.hs 170 +-- | Floats a new window with its original size on the specified side of a +-- screen +doSideFloat :: Side -> ManageHook +doSideFloat side = ask >>= \w -> doF . W.float w . move . snd =<< liftX (floatLocation w) + where + move (W.RationalRect _ _ w h) = W.RationalRect cx cy w h + where + cx = if side `elem` [SC,C ,NC] then (1-w)/2 + else if side `elem` [SW,CW,NW] then 0 + else {- side `elem` [SE,CE,NE] -} 1-w + cy = if side `elem` [CE,C ,CW] then (1-h)/2 + else if side `elem` [NE,NC,NW] then 0 + else {- side `elem` [SE,SC,SW] -} 1-h + hunk ./XMonad/Hooks/ManageHelpers.hs 186 -doCenterFloat = ask >>= \w -> doF . W.float w . center . snd =<< liftX (floatLocation w) - where - center (W.RationalRect _ _ w h) = W.RationalRect ((1-w)/2) ((1-h)/2) w h +doCenterFloat = doSideFloat C hunk ./XMonad/Util/WindowProperties.hs 17 - Property(..), hasProperty, focusedHasProperty) + Property(..), hasProperty, focusedHasProperty, allWithProperty) hunk ./XMonad/Util/WindowProperties.hs 21 +import Control.Monad hunk ./XMonad/Util/WindowProperties.hs 63 +allWithProperty :: Property -> X [Window] +allWithProperty prop = withDisplay $ \dpy -> do + rootw <- asks theRoot + (_,_,wins) <- io $ queryTree dpy rootw + hasProperty prop `filterM` wins addfile ./XMonad/Layout/Monitor.hs hunk ./XMonad/Layout/Monitor.hs 1 +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Monitor +-- Copyright : (c) Roman Cheplyaka +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Roman Cheplyaka +-- Stability : unstable +-- Portability : unportable +-- +-- Layout modfier for displaying some window (monitor) above other windows +-- +----------------------------------------------------------------------------- +module XMonad.Layout.Monitor ( + -- * Usage + -- $usage + + -- * Hints + -- $hints + + -- * TODO + -- $todo + Property(..), + MonitorMessage(..), + addMonitor, + addPersistentMonitor, + addNamedMonitor, + addNamedPersistentMonitor + ) where + +import XMonad +import XMonad.Layout.LayoutModifier +import XMonad.Util.WindowProperties +import Control.Monad + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Monitor +-- +-- Then add monitor to desired layouts: +-- +-- > myLayouts = addMonitor (ClassName "Cairo-clock" `And` Title "MacSlow's Cairo-Clock") (Rectangle (1280-150) (800-150) 150 150) $ tall ||| Full ||| ... +-- +-- After that, if there exists a window with specified properties, it will be +-- displayed on top of all /tiled/ (not floated) windows on specified +-- position. +-- +-- It's also useful to add some keybinding to toggle monitor visibility: +-- +-- > , ((mod1Mask, xK_u ), sendMessage ToggleMonitor) +-- +-- Screenshot: + +data Monitor a = Monitor { + prop :: Property, -- a window which satisfies that property is chosen as monitor + rect :: Rectangle, -- where to put monitor + visible :: Bool, -- is it visible? + mbName :: (Maybe String), -- name of monitor (useful when we have many of them) + persistent :: Bool -- on all layouts? + } deriving (Read, Show) + +data MonitorMessage = ToggleMonitor | ShowMonitor | HideMonitor + | ToggleMonitorNamed String + | ShowMonitorNamed String + | HideMonitorNamed String + deriving (Read,Show,Eq,Typeable) +instance Message MonitorMessage + +withMonitor :: Property -> a -> (Window -> X a) -> X a +withMonitor p a fn = do + monitorWindows <- allWithProperty p + case monitorWindows of + [] -> return a + w:_ -> fn w + +instance LayoutModifier Monitor Window where + redoLayout mon _ _ rects = withMonitor (prop mon) (rects, Nothing) $ \w -> + if visible mon + then do tileWindow w (rect mon) + reveal w + return ((w,rect mon):rects, Nothing) + else do hide w + return (rects, Nothing) + handleMess mon mess + | Just ToggleMonitor <- fromMessage mess = return $ Just $ mon { visible = not $ visible mon } + | Just (ToggleMonitorNamed n) <- fromMessage mess = return $ + if mbName mon `elem` [Just n, Nothing] then Just $ mon { visible = not $ visible mon } else Nothing + | Just ShowMonitor <- fromMessage mess = return $ Just $ mon { visible = True } + | Just (ShowMonitorNamed n) <- fromMessage mess = return $ + if mbName mon `elem` [Just n, Nothing] then Just $ mon { visible = True } else Nothing + | Just HideMonitor <- fromMessage mess = return $ Just $ mon { visible = False } + | Just (HideMonitorNamed n) <- fromMessage mess = return $ + if mbName mon `elem` [Just n, Nothing] then Just $ mon { visible = False } else Nothing + | Just Hide <- fromMessage mess = do unless (persistent mon) $ withMonitor (prop mon) () hide; return Nothing + | otherwise = return Nothing + +addMonitor :: Property -> Rectangle -> l a -> ModifiedLayout Monitor l a +addMonitor p r = ModifiedLayout (Monitor p r True Nothing False) +addPersistentMonitor :: Property -> Rectangle -> l a -> ModifiedLayout Monitor l a +addPersistentMonitor p r = ModifiedLayout (Monitor p r True Nothing True) +addNamedMonitor :: String -> Property -> Rectangle -> l a -> ModifiedLayout Monitor l a +addNamedMonitor name p r = ModifiedLayout (Monitor p r True (Just name) False) +addNamedPersistentMonitor :: String -> Property -> Rectangle -> l a -> ModifiedLayout Monitor l a +addNamedPersistentMonitor name p r = ModifiedLayout (Monitor p r True (Just name) True) + +-- $hints +-- - This module assumes that there is only one window satisfying property exists. Also it's good idea to make it unmanaged and (optionally) hide it using ManageHook: +-- +-- > className =? "Cairo-clock"--> (ask >>= \w -> liftX (hide w) >> doF (W.delete w)) +-- +-- - If you want monitor to be available on /all/ layouts, there's no point in +-- hiding it. Also use 'addPersistentMonitor' instead of +-- 'addMonitor' to avoid unnecessary flickering. You can still toggle +-- monitor with a keybinding. +-- +-- - You can use several monitors with nested modifiers. Give them a name using +-- 'addNamedMonitor' or 'addNamedPersistentMonitor' to be able to toggle +-- them independently. +-- +-- - You can display monitor only on specific workspaces with +-- "XMonad.Layout.PerWorkspace". + +-- $todo +-- - make Monitor remember the window it manages +-- +-- - automatically unmanage the window? +-- +-- - specify position relative to the screen hunk ./xmonad-contrib.cabal 146 + XMonad.Layout.Monitor hunk ./XMonad/Layout/Monitor.hs 47 +-- And make the desired window unmanaged with ManageHook: +-- +-- > , className =? "Cairo-clock"--> doIgnore +-- hunk ./XMonad/Layout/Monitor.hs 114 --- - This module assumes that there is only one window satisfying property exists. Also it's good idea to make it unmanaged and (optionally) hide it using ManageHook: +-- - This module assumes that there is only one window satisfying property exists. hunk ./XMonad/Layout/Monitor.hs 116 --- > className =? "Cairo-clock"--> (ask >>= \w -> liftX (hide w) >> doF (W.delete w)) +-- - If you want the monitor to be available on /all/ layouts, use +-- 'addPersistentMonitor' instead of 'addMonitor' to avoid unnecessary +-- flickering. You can still toggle monitor with a keybinding. hunk ./XMonad/Layout/Monitor.hs 120 --- - If you want monitor to be available on /all/ layouts, there's no point in --- hiding it. Also use 'addPersistentMonitor' instead of --- 'addMonitor' to avoid unnecessary flickering. You can still toggle --- monitor with a keybinding. +-- - On the other hand, if you use the monitor only with some of the layouts, you +-- might want to hide it on the startup. Then change ManageHook to the following: +-- +-- > className =? "Cairo-clock"--> (ask >>= \w -> liftX (hide w) >> doF (W.delete w)) hunk ./XMonad/Layout/Monitor.hs 138 +-- +-- - toggle monitor on all workspaces (how?) hunk ./XMonad/Layout/Monitor.hs 20 - -- * Hints + -- * Hints and issues hunk ./XMonad/Layout/Monitor.hs 116 +-- - On multihead setup, since two layouts are shown at the same time, to hide +-- monitor you need to hide it on both layouts. +-- hunk ./XMonad/Hooks/FadeInactive.hs 71 - forM_ (concatMap visibleWins $ W.current s : W.visible s) (fadeOut amt) >> + forM_ (visibleWins s) (fadeOut amt) >> hunk ./XMonad/Hooks/FadeInactive.hs 74 - visibleWins = maybe [] unfocused . W.stack . W.workspace + visibleWins s = (maybe [] unfocused . W.stack . W.workspace) (W.current s) ++ + concatMap (W.integrate' . W.stack . W.workspace) (W.visible s) hunk ./XMonad/Layout/Monitor.hs 57 --- > , ((mod1Mask, xK_u ), sendMessage ToggleMonitor) +-- > , ((mod1Mask, xK_u ), broadcastMessage ToggleMonitor >> refresh) hunk ./XMonad/Layout/Monitor.hs 116 --- - On multihead setup, since two layouts are shown at the same time, to hide --- monitor you need to hide it on both layouts. --- hunk ./XMonad/Layout/Monitor.hs 138 --- --- - toggle monitor on all workspaces (how?) hunk ./XMonad/Hooks/FadeInactive.hs 18 + setOpacity, hunk ./XMonad/Layout/Monitor.hs 129 +-- - To make monitor transparent, import "XMonad.Hooks.FadeInactive" and change +-- ManageHook to (@0xAAAAAAAA@ is the level of opacity): +-- +-- > className =? "Cairo-clock"--> (ask >>= liftX . flip setOpacity 0xAAAAAAAA >> doIgnore) +-- hunk ./XMonad/Actions/GridSelect.hs 166 - | t == keyPress && ks == xK_Left = diffAndRefresh (-1,0) - | t == keyPress && ks == xK_Right = diffAndRefresh (1,0) - | t == keyPress && ks == xK_Down = diffAndRefresh (0,1) - | t == keyPress && ks == xK_Up = diffAndRefresh (0,-1) + | t == keyPress && ks == xK_Left || ks == xK_h = diffAndRefresh (-1,0) + | t == keyPress && ks == xK_Right || ks == xK_l = diffAndRefresh (1,0) + | t == keyPress && ks == xK_Down || ks == xK_j = diffAndRefresh (0,1) + | t == keyPress && ks == xK_Up || ks == xK_k = diffAndRefresh (0,-1) hunk ./XMonad/Actions/GridSelect.hs 166 - | t == keyPress && ks == xK_Left || ks == xK_h = diffAndRefresh (-1,0) - | t == keyPress && ks == xK_Right || ks == xK_l = diffAndRefresh (1,0) - | t == keyPress && ks == xK_Down || ks == xK_j = diffAndRefresh (0,1) - | t == keyPress && ks == xK_Up || ks == xK_k = diffAndRefresh (0,-1) + | t == keyPress && (ks == xK_Left || ks == xK_h) = diffAndRefresh (-1,0) + | t == keyPress && (ks == xK_Right || ks == xK_l) = diffAndRefresh (1,0) + | t == keyPress && (ks == xK_Down || ks == xK_j) = diffAndRefresh (0,1) + | t == keyPress && (ks == xK_Up || ks == xK_k) = diffAndRefresh (0,-1) hunk ./XMonad/Prompt.hs 382 - | ks == xK_Up = moveHistory W.focusUp' >> go - | ks == xK_Down = moveHistory W.focusDown' >> go hunk ./XMonad/Prompt.hs 384 + | ks == xK_Down = moveHistory W.focusUp' >> go + | ks == xK_Up = moveHistory W.focusDown' >> go hunk ./XMonad/Config/PlainConfig.hs 1 -{-# LANGUAGE - FlexibleInstances, - FlexibleContexts, - MultiParamTypeClasses, - ExistentialQuantification - #-} - -------------------------------------------------------------------------- --- | --- Module : XMonad.Config.PlainConfig --- Copyright : Braden Shepherdson --- License : BSD3 --- --- Maintainer : Braden Shepherdson --- --- Proof-of-concept (but usable) plain-text configuration file --- parser, for use instead of xmonad.hs. Does not require recompilation, --- allowing xmonad to be free of the GHC dependency. --- -------------------------------------------------------------------------- - - -module XMonad.Config.PlainConfig - ( - -- * Introduction - -- $usage - - -- * Supported Layouts - -- $layouts - - -- * Support Key Bindings - -- $keys - - -- * Other Notes - -- $notes - - -- * Example Config File - -- $example - - plainConfig ,readConfig, checkConfig - ) -where - - -import XMonad -import System.Exit - -import qualified XMonad.StackSet as W -import qualified Data.Map as M -import Data.List -import Data.Maybe (isJust,fromJust) -import Data.Char (isSpace) - - ---import Control.Monad -import Control.Monad.Error -import Control.Monad.Identity - -import Control.Arrow ((&&&)) - -import Text.ParserCombinators.ReadP - -import System.IO -import Control.Exception (bracket) - -import XMonad.Util.EZConfig (mkKeymap) - - - --- $usage --- The @xmonad.hs@ file is very minimal when used with PlainConfig. --- It typically contains only the following: --- --- > module Main where --- > import XMonad --- > import XMonad.Config.PlainConfig (plainConfig) --- > main = plainConfig --- --- The 'plainConfig' function parses @~\/.xmonad\/xmonad.conf@, --- the format of which is described below. - - --- $layouts --- Only 'Tall', 'Wide' and 'Full' are supported at present. - - - --- $keys --- --- Key bindings are specified as a pair of an arbitrary EZConfig and --- one of the following: --- --- @ Name Haskell equivalent Default binding(s)@ --- --- * @spawn \ spawn \"\\" none@ --- --- * @kill kill M-S-c@ --- --- * @nextLayout sendMessage NextLayout M-\@ --- --- * @refresh refresh M-S-\@ --- --- * @focusDown windows W.focusDown M-\, M-j@ --- --- * @focusUp windows W.focusUp M-k@ --- --- * @focusMaster windows W.focusMaster M-m@ --- --- * @swapDown windows W.swapDown M-S-j@ --- --- * @swapUp windows W.swapUp M-S-k@ --- --- * @swapMaster windows W.swapMaster M-\@ --- --- * @shrink sendMessage Shrink M-h@ --- --- * @expand sendMessage Expand M-l@ --- --- * @sink withFocused $ windows . W.sink M-t@ --- --- * @incMaster sendMessage (IncMasterN 1) M-,@ --- --- * @decMaster sendMessage (IncMasterN (-1)) M-.@ --- --- * @quit io $ exitWith ExitSuccess M-S-q@ --- --- * @restart broadcastMessageReleaseResources >> restart \"xmonad\" True M-q@ --- - - --- $notes --- Submaps are allowed. --- These settings override the defaults. Changes made here will be used over --- the default bindings for those keys. - - --- $example --- An example @~\/.xmonad\/xmonad.conf@ file follows: --- --- @modMask = 3@ --- --- @numlockMask = 2@ --- --- @borderWidth = 1@ --- --- @normalBorderColor = #dddddd@ --- --- @focusedBorderColor = #00ff00@ --- --- @terminal=urxvt@ --- --- @workspaces=[\"1: IRC\",\"2: Web\", \"3\", \"4\", \"5\", \"6\", \"7\", \"8\", \"9\"]@ --- --- @focusFollowsMouse=True@ --- --- @layouts=[\"Tall\",\"Full\",\"Wide\"]@ --- --- @key=(\"M-x t\", \"spawn xmessage Test\")@ --- --- @manageHook=(ClassName \"MPlayer\" , \"float\" )@ --- --- @manageHook=(ClassName \"Gimp\" , \"float\" )@ --- --- @manageHook=(Resource \"desktop_window\", \"ignore\" )@ --- --- @manageHook=(Resource \"kdesktop\" , \"ignore\" )@ --- --- @manageHook=(Resource \"gnome-panel\" , \"ignore\" )@ --- - - - - - - ----------------------------------------------------------------- ------- Several functions for parsing the key-value file. ------- ----------------------------------------------------------------- - -parseKVBy :: Char -> ReadP (String,String) -parseKVBy sep = do - skipSpaces - k <- munch1 (\x -> x /= ' ' && x /= sep) - skipSpaces - char kvSep - skipSpaces - v <- munch1 (\x -> x /= ' ') --or EOS - return (k,v) - -parseKVVBy :: Char -> ReadP (String,String) -parseKVVBy sep = do - skipSpaces - k <- munch1 (\x -> x /= ' ' && x /= sep) - skipSpaces - char kvSep - skipSpaces - v <- munch1 (const True) -- until EOS - return (k,v) - - -kvSep :: Char -kvSep = '=' - -parseKV, parseKVV :: ReadP (String,String) -parseKV = parseKVBy kvSep -parseKVV = parseKVVBy kvSep - - - -readKV :: String -> Integer -> RC (String,String) -readKV s ln = case readP_to_S parseKV s of - [((k,v),"")] -> return (k,v) --single, correct parse - [] -> throwError [(ln,"No parse")] - _ -> do - case readP_to_S parseKVV s of - [((k,v),"")] -> return (k,v) --single, correct parse - [] -> throwError [(ln,"No parse")] - xs -> throwError [(ln,"Ambiguous parse: " - ++ show xs)] - - - -isComment :: String -> Bool -isComment = not . null . readP_to_S parseComment - where parseComment = skipSpaces >> char '#' >> return () - -- null means failed parse, so _not_ a comment. - - -isBlank :: String -> Bool -isBlank = null . filter (not . isSpace) - - -type RC = ErrorT [(Integer,String)] Identity - -instance Error [(Integer,String)] where - noMsg = [(-1, "Unknown error.")] - strMsg s = [(-1, s)] - - -parseFile :: [String] -> RC (XConfig Layout) -parseFile ss = parseLines baseConfig theLines - where theLines = filter (not . liftM2 (||) isComment isBlank . snd) - $ zip [1..] ss - - - -parseLines :: XConfig Layout -> [(Integer,String)] -> RC (XConfig Layout) -parseLines = foldM parse - - -parse :: XConfig Layout -> (Integer, String) -> RC (XConfig Layout) -parse xc (ln,s) = do - (k,v) <- readKV s ln - case M.lookup k commands of - Nothing -> throwError [(ln,"Unknown command: "++k)] - Just f -> f v ln xc - - - - ----------------------------------------------------------------- --- Now the semantic parts, that convert from the relevant -- --- key-value entries to values in an XConfig -- ----------------------------------------------------------------- - - - -type Command = String -> Integer -> XConfig Layout -> RC (XConfig Layout) - -commands :: M.Map String Command -commands = M.fromList $ - [("modMask" , cmd_modMask ) - ,("numlockMask" , cmd_numlockMask ) - ,("normalBorderColor" , cmd_normalBorderColor ) - ,("focusedBorderColor" , cmd_focusedBorderColor) - ,("terminal" , cmd_terminal ) - ,("workspaces" , cmd_workspaces ) - ,("focusFollowsMouse" , cmd_focusFollowsMouse ) - ,("layouts" , cmd_layouts ) - ,("key" , cmd_key ) - ,("manageHook" , cmd_manageHook ) - ,("borderWidth" , cmd_borderWidth ) - ] - - --- | Behind-the-scenes helper for both 'cmd_modMask' and 'cmd_numlockMask'. -genericModKey :: (KeyMask -> XConfig Layout) -> Command -genericModKey f s ln _ = do - x <- rcRead s ln :: RC Integer - case lookup x (zip [1..] [mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask]) of - Just y -> return $ f y - Nothing -> throwError [(ln,"Invalid mod key number: "++ show x)] - - --- | Reads the mod key modifier number. -cmd_modMask :: Command -cmd_modMask s ln xc = genericModKey (\k -> xc{modMask = k}) s ln xc - --- | Reads the numlock key modifier number. -cmd_numlockMask :: Command -cmd_numlockMask s ln xc = genericModKey (\k -> xc{numlockMask = k}) s ln xc - - --- | Reads the border width. -cmd_borderWidth :: Command -cmd_borderWidth s ln xc = do - w <- rcRead s ln - return $ xc { borderWidth = w } - - --- | Reads the colors but just keeps them as RRGGBB Strings. -cmd_normalBorderColor, cmd_focusedBorderColor :: Command -cmd_normalBorderColor s _ xc = return $ xc{ normalBorderColor = s } -cmd_focusedBorderColor s _ xc = return $ xc{ focusedBorderColor = s } - - --- | Reads the terminal. It is just a String, no parsing. -cmd_terminal :: Command -cmd_terminal s _ xc = return $ xc{ terminal = s } - - --- | Reads the workspace tag list. This is given as a Haskell [String]. -cmd_workspaces :: Command -cmd_workspaces s ln xc = rcRead s ln >>= \x -> return xc{ workspaces = x } - - --- | Reads the focusFollowsMouse, as a Haskell Bool. -cmd_focusFollowsMouse :: Command -cmd_focusFollowsMouse s ln xc = rcRead s ln >>= - \x -> return xc{focusFollowsMouse = x} - - --- | The list known layouts, mapped by name. --- An easy location for improvement is to add more contrib layouts here. -layouts :: M.Map String (Layout Window) -layouts = M.fromList - [("Tall", Layout (Tall 1 (3/100) (1/2))) - ,("Wide", Layout (Mirror (Tall 1 (3/100) (1/2)))) - ,("Full", Layout Full) - ] - - --- | Expects a [String], the strings being layout names. Quotes required. --- Draws from the `layouts' list above. -cmd_layouts :: Command -cmd_layouts s ln xc = do - xs <- rcRead s ln -- read the list of strings - let ls = map (id &&& (flip M.lookup) layouts) xs - when (null ls) $ throwError [(ln,"Empty layout list")] - case filter (not . isJust . snd) ls of - [] -> return $ xc{ layoutHook = foldr1 - (\(Layout l) (Layout r) -> - Layout (l ||| r)) (map (fromJust . snd) ls) - } - ys -> throwError $ map (\(x,_) -> (ln, "Unknown layout: "++ x)) ys - - - --- | A Map from names to key binding actions. -key_actions :: M.Map String (X ()) -key_actions = M.fromList - [("kill" , kill ) - ,("nextLayout" , sendMessage NextLayout ) - --,("prevLayout" , sendMessage PrevLayout ) - --,("resetLayout" , setLayout $ XMonad.layoutHook conf) - ,("refresh" , refresh ) - ,("focusDown" , windows W.focusDown ) - ,("focusUp" , windows W.focusUp ) - ,("focusMaster" , windows W.focusMaster ) - ,("swapMaster" , windows W.swapMaster ) - ,("swapDown" , windows W.swapDown ) - ,("swapUp" , windows W.swapUp ) - ,("shrink" , sendMessage Shrink ) - ,("expand" , sendMessage Expand ) - ,("sink" , withFocused $ windows . W.sink) - ,("incMaster" , sendMessage (IncMasterN 1)) - ,("decMaster" , sendMessage (IncMasterN (-1))) - ,("quit" , io $ exitWith ExitSuccess) - ,("restart" , broadcastMessage ReleaseResources - >> restart "xmonad" True) - ] - - --- | Expects keys as described in the preamble, as --- (\"EZConfig key name\", \"action name\"), --- eg. (\"M-S-t\", \"spawn thunderbird\") --- One key per "key=" line. -cmd_key :: Command -cmd_key s ln xc = do - (k,v) <- rcRead s ln - if "spawn " `isPrefixOf` v - then return $ xc { - keys = \c -> M.union (mkKeymap c - [(k, spawn (drop 6 v))] - ) ((keys xc) c) - } - else do - case M.lookup v key_actions of - Nothing -> throwError [(ln, "Unknown key action \"" ++ v ++ "\"")] - Just ac -> return $ - xc { keys = \c -> M.union (mkKeymap c [(k, ac)]) - ((keys xc) c) - } - - - --- | Map of names to actions for 'ManageHook's. -manageHook_actions :: M.Map String ManageHook -manageHook_actions = M.fromList - [("float" , doFloat ) - ,("ignore" , doIgnore ) - ] - - --- | Parses 'ManageHook's in the form given in the preamble. --- eg. (ClassName \"MPlayer\", \"float\") -cmd_manageHook :: Command -cmd_manageHook s ln xc = do - (k,v) <- rcRead s ln - let q = parseQuery k - if "toWorkspace " `isPrefixOf` v - then return $ xc { manageHook = manageHook xc <+> - (q --> doShift (drop 12 v)) - } - else case M.lookup v manageHook_actions of - Nothing -> throwError [(ln, "Unknown ManageHook action \"" - ++ v ++ "\"")] - Just ac -> return $ xc { manageHook = manageHook xc <+> (q --> ac) } - - - --- | Core of the ManageHook expression parser. --- Taken from Roman Cheplyaka's WindowProperties -parseQuery :: Property -> Query Bool -parseQuery (Title s) = title =? s -parseQuery (ClassName s) = className =? s -parseQuery (Resource s) = resource =? s -parseQuery (And p q) = parseQuery p <&&> parseQuery q -parseQuery (Or p q) = parseQuery p <&&> parseQuery q -parseQuery (Not p) = not `fmap` parseQuery p -parseQuery (Const b) = return b - - --- | Property constructors are quite self-explaining. --- Taken from Roman Cheplyaka's WindowProperties -data Property = Title String - | ClassName String - | Resource String - | And Property Property - | Or Property Property - | Not Property - | Const Bool - deriving (Read, Show) - - - --- | A wrapping of the read function into the RC monad. -rcRead :: (Read a) => String -> Integer -> RC a -rcRead s ln = case reads s of - [(x,"")] -> return x - _ -> throwError [(ln, "Failed to parse value")] - - - --- | The standard Config.hs 'defaultConfig', with the layout wrapped. -baseConfig :: XConfig Layout -baseConfig = defaultConfig{ layoutHook = Layout (layoutHook defaultConfig) } - - - --- | Core function that attempts to parse @~\/.xmonad\/xmonad.conf@ -readConfig :: IO (Maybe (XConfig Layout)) -readConfig = do - dir <- getXMonadDir - cs <- bracket (openFile (dir++"/xmonad.conf") ReadMode) - (\h -> hClose h) -- vv force the lazy IO - (\h -> (lines `fmap` hGetContents h) >>= \ss -> - length ss `seq` return ss) - let xce = runIdentity $ runErrorT $ parseFile cs - case xce of - Left es -> mapM_ (\(ln,e) -> - putStrLn $ "readConfig error: line "++show ln++ - ": "++ e) es - >> return Nothing - Right xc -> return $ Just xc - - --- | Attempts to run readConfig, and checks if it failed. -checkConfig :: IO Bool -checkConfig = isJust `fmap` readConfig - - - -{- REMOVED: It was for debugging, and causes an 'orphaned instances' - warning to boot. - - - --- | Reads in the config, and then prints the resulting XConfig -dumpConfig :: IO () -dumpConfig = readConfig >>= print - - -instance Show (XConfig Layout) where - show x = "XConfig { " - ++ "normalBorderColor = "++ normalBorderColor x ++", " - ++ "focusedBorderColor = "++ focusedBorderColor x++", " - ++ "terminal = "++ terminal x ++", " - ++ "workspaces = "++ show (workspaces x) ++", " - ++ "numlockMask = "++ show (numlockMask x) ++", " - ++ "modMask = "++ show (modMask x) ++", " - ++ "borderWidth = "++ show (borderWidth x) ++", " - ++ "focusFollowsMouse = "++ show (focusFollowsMouse x) ++", " - ++ "layouts = "++ show (layoutHook x) ++" }" - --} - --- | Handles the unwrapping of the Layout. Intended for use as --- @main = plainConfig@ -plainConfig :: IO () -plainConfig = do - conf <- readConfig - case conf of - (Just xc@XConfig{layoutHook= (Layout l)}) -> - xmonad (xc{ layoutHook = l }) - Nothing -> - spawn $ "xmessage Failed to read xmonad.conf. See xmonad.errors." - rmfile ./XMonad/Config/PlainConfig.hs hunk ./xmonad-contrib.cabal 109 - XMonad.Config.PlainConfig hunk ./XMonad/Config/Sjanssen.hs 55 + , historyFilter = deleteConsecutive hunk ./XMonad/Config/Kde.hs 17 - kdeConfig + kdeConfig, + kde4Config hunk ./XMonad/Config/Kde.hs 33 +-- +-- For KDE 4, replace 'kdeConfig' with 'kde4Config' hunk ./XMonad/Config/Kde.hs 41 +kde4Config = desktopConfig + { terminal = "konsole" + , keys = \c -> kde4Keys c `M.union` keys desktopConfig c } + hunk ./XMonad/Config/Kde.hs 49 + +kde4Keys (XConfig {modMask = modm}) = M.fromList $ + [ ((modm, xK_p), spawn "krunner") + , ((modm .|. shiftMask, xK_q), spawn "dbus-send --print-reply --dest=org.kde.ksmserver /KSMServer org.kde.KSMServerInterface.logout int32:1 int32:0 int32:1") + ] hunk ./XMonad/Hooks/ManageHelpers.hs 41 - doSideFloat + doSideFloat, + doHideIgnore hunk ./XMonad/Hooks/ManageHelpers.hs 188 + +-- | Hides window and ignores it. +doHideIgnore :: ManageHook +doHideIgnore = ask >>= \w -> liftX (hide w) >> doF (W.delete w) hunk ./XMonad/Layout/Monitor.hs 30 - addNamedPersistentMonitor + addNamedPersistentMonitor, + doHideIgnore hunk ./XMonad/Layout/Monitor.hs 37 +import XMonad.Hooks.ManageHelpers (doHideIgnore) hunk ./XMonad/Layout/Monitor.hs 25 + Monitor(..), hunk ./XMonad/Layout/Monitor.hs 65 - prop :: Property, -- a window which satisfies that property is chosen as monitor - rect :: Rectangle, -- where to put monitor - visible :: Bool, -- is it visible? - mbName :: (Maybe String), -- name of monitor (useful when we have many of them) - persistent :: Bool -- on all layouts? + prop :: Property, -- ^ a window which satisfies this property is chosen as monitor + rect :: Rectangle, -- ^ where to put monitor + visible :: Bool, -- ^ is it visible by default? + mbName :: (Maybe String), -- ^ name of monitor (useful when we have many of them) + persistent :: Bool -- ^ is it shown on all layouts? hunk ./XMonad/Layout/Monitor.hs 126 --- > className =? "Cairo-clock"--> (ask >>= \w -> liftX (hide w) >> doF (W.delete w)) +-- > className =? "Cairo-clock"--> doHideIgnore hunk ./XMonad/Prompt.hs 180 - , bgColor = "#333333" - , fgColor = "#FFFFFF" - , fgHLight = "#000000" - , bgHLight = "#BBBBBB" - , borderColor = "#FFFFFF" + , bgColor = "grey22" + , fgColor = "grey80" + , fgHLight = "black" + , bgHLight = "grey" + , borderColor = "white" hunk ./XMonad/Prompt.hs 179 - XPC { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + XPC { font = "-misc-fixed-*-*-*-*-12-*-*-*-*-*-*-*" hunk ./XMonad/Prompt.hs 21 + , amberXPConfig hunk ./XMonad/Prompt.hs 23 + , greenXPConfig hunk ./XMonad/Prompt.hs 179 -defaultXPConfig :: XPConfig +amberXPConfig, defaultXPConfig, greenXPConfig :: XPConfig hunk ./XMonad/Prompt.hs 194 - , showCompletionOnTab = False - } + , showCompletionOnTab = False } +greenXPConfig = defaultXPConfig { fgColor = "green", bgColor = "black" } +amberXPConfig = defaultXPConfig { fgColor = "#ca8f2d", bgColor = "black", fgHLight = "#eaaf4c" } hunk ./XMonad/Actions/WindowGo.hs 37 -import XMonad (Query(), X(), withWindowSet, spawn, runQuery, liftIO, focus) +import XMonad (Query(), X(), withWindowSet, spawn, runQuery, liftIO) +import Graphics.X11 (Window) hunk ./XMonad/Actions/WindowGo.hs 40 -import XMonad.Prompt.Shell (getBrowser, getEditor) -import qualified XMonad.StackSet as W (allWindows, peek, swapMaster) hunk ./XMonad/Actions/WindowGo.hs 41 -import Graphics.X11 (Window) +import XMonad.Prompt.Shell (getBrowser, getEditor) +import qualified XMonad.StackSet as W (allWindows, peek, swapMaster, focusWindow) hunk ./XMonad/Actions/WindowGo.hs 102 - (x:_) -> focus x + (x:_) -> windows $ W.focusWindow x hunk ./XMonad/Actions/WindowGo.hs 124 - go _ = focus x + go _ = windows $ W.focusWindow x hunk ./XMonad/Actions/WindowGo.hs 127 - next w (x:y:_) | x==w = focus y + next w (x:y:_) | x==w = windows $ W.focusWindow y hunk ./XMonad/Actions/WindowGo.hs 151 - (x:_) -> do - XMonad.focus x - afterRaise x + (x:_) -> do windows $ W.focusWindow x + afterRaise x hunk ./XMonad/Actions/WindowGo.hs 159 - hunk ./XMonad/Actions/WindowGo.hs 173 - - addfile ./XMonad/Layout/FixedColumn.hs hunk ./XMonad/Layout/FixedColumn.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.FixedColumn +-- Copyright : (c) 2008 Justin Bogner +-- License : BSD3-style (as xmonad) +-- +-- Maintainer : Justin Bogner +-- Stability : unstable +-- Portability : unportable +-- +-- A layout much like Tall, but using a multiple of a window's minimum +-- resize amount instead of a percentage of screen to decide where to +-- split. This is useful when you usually leave a text editor or +-- terminal in the master pane and like it to be 80 columns wide. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.FixedColumn ( + -- * Usage + -- $usage + FixedColumn(..) +) where + +import Control.Monad (msum) +import Data.Maybe (fromMaybe) +import Graphics.X11.Xlib (Window, rect_width) +import Graphics.X11.Xlib.Extras ( getWMNormalHints + , getWindowAttributes + , sh_base_size + , sh_resize_inc + , wa_border_width) + +import XMonad.Core (X, LayoutClass(..), fromMessage, io, withDisplay) +import XMonad.Layout (Resize(..), IncMasterN(..), tile) +import XMonad.StackSet as W + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.FixedColumn +-- +-- Then edit your @layoutHook@ by adding the FixedColumn layout: +-- +-- > myLayouts = FixedColumn 20 80 10 ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +-- | A tiling mode based on preserving a nice fixed width +-- window. Supports 'Shrink', 'Expand' and 'IncMasterN'. +data FixedColumn a = FixedColumn !Int -- Number of windows in the master pane + !Int -- Number to increment by when resizing + !Int -- Default width of master pane + !Int -- Column width for normal windows + deriving (Read, Show) + +instance LayoutClass FixedColumn Window where + doLayout (FixedColumn nmaster _ ncol fallback) r s = do + fws <- mapM (widthCols fallback ncol) ws + let frac = maximum (take nmaster fws) // rect_width r + rs = tile frac r nmaster (length ws) + return $ (zip ws rs, Nothing) + where ws = W.integrate s + x // y = fromIntegral x / fromIntegral y + + pureMessage (FixedColumn nmaster delta ncol fallback) m = + msum [fmap resize (fromMessage m) + ,fmap incmastern (fromMessage m)] + where resize Shrink + = FixedColumn nmaster delta (max 0 $ ncol - delta) fallback + resize Expand + = FixedColumn nmaster delta (ncol + delta) fallback + incmastern (IncMasterN d) + = FixedColumn (max 0 (nmaster+d)) delta ncol fallback + + description _ = "FixedColumn" + +-- | Determine the width of @w@ given that we would like it to be @n@ +-- columns wide, using @inc@ as a resize increment for windows that +-- don't have one +widthCols :: Int -> Int -> Window -> X Int +widthCols inc n w = withDisplay $ \d -> io $ do + sh <- getWMNormalHints d w + bw <- fmap (fromIntegral . wa_border_width) $ getWindowAttributes d w + let widthHint f = f sh >>= return . fromIntegral . fst + oneCol = fromMaybe inc $ widthHint sh_resize_inc + base = fromMaybe 0 $ widthHint sh_base_size + return $ 2 * bw + base + n * oneCol hunk ./xmonad-contrib.cabal 132 + XMonad.Layout.FixedColumn addfile ./XMonad/Layout/GridVariants.hs hunk ./XMonad/Layout/GridVariants.hs 1 +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} + +---------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.GridVariants +-- Copyright : (c) Norbert Zeh +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : nzeh@cs.dal.ca +-- Stability : unstable +-- Portability : unportable +-- +-- Two layouts: one is a variant of the Grid layout that allows the +-- desired aspect ratio of windows to be specified. The other is like +-- Tall but places a grid with fixed number of rows and columns in the +-- master area and uses an aspect-ratio-specified layout for the +-- slaves. +---------------------------------------------------------------------- + +module XMonad.Layout.GridVariants ( -- * Usage + -- $usage + ChangeMasterGeom(..) + , Grid(..) + , TallGrid(..) + ) where + +import Control.Monad +import XMonad +import qualified XMonad.StackSet as W + +-- $usage +-- This module can be used as follows: +-- +-- > import XMonad.Layout.Master +-- +-- Then add something like this to your layouts: +-- +-- > Grid (16/10) +-- +-- for a 16:10 aspect ratio grid, or +-- +-- > TallGrid 2 3 (2/3) (16/10) (5/100) +-- +-- for a layout with a 2x3 master grid that uses 2/3 of the screen, +-- and a 16:10 aspect ratio slave grid. The last parameter is again +-- the percentage by which the split between master and slave area +-- changes in response to Expand/Shrink messages. +-- +-- To be able to change the geometry of the master grid, add something +-- like this to your keybindings: +-- +-- > ((modMask .|. shiftMask, xK_equal), sendMessage $ IncMasterCols 1), +-- > ((modMask .|. shiftMask, xK_minus), sendMessage $ IncMasterCols (-1)), +-- > ((modMask .|. ctrlMask, xK_equal), sendMessage $ IncMasterRows 1), +-- > ((modMask .|. ctrlMask, xK_minus), sendMessage $ IncMasterRows (-1)) + +-- | Grid layout. The parameter is the desired x:y aspect ratio of windows +data Grid a = Grid !Rational + deriving (Read, Show) + +instance LayoutClass Grid a where + + pureLayout (Grid aspect) rect st = zip wins rects + where + wins = W.integrate st + nwins = length wins + rects = arrangeAspectGrid rect nwins aspect + + description _ = "Grid" + +-- | TallGrid layout. Parameters are +-- +-- - number of master rows +-- - number of master columns +-- - portion of screen used for master grid +-- - x:y aspect ratio of slave windows +-- - increment for resize messages +data TallGrid a = TallGrid !Int !Int !Rational !Rational !Rational + deriving (Read, Show) + +instance LayoutClass TallGrid a where + + pureLayout (TallGrid mrows mcols mfrac saspect _) rect st = zip wins rects + where + wins = W.integrate st + nwins = length wins + rects = arrangeTallGrid rect nwins mrows mcols mfrac saspect + + pureMessage layout msg = + msum [ fmap (resizeMaster layout) (fromMessage msg) + , fmap (changeMasterGrid layout) (fromMessage msg) ] + + description _ = "TallGrid" + +-- |The geometry change message understood by the master grid +data ChangeMasterGeom + = IncMasterRows !Int -- ^Change the number of master rows + | IncMasterCols !Int -- ^Change the number of master columns + deriving Typeable + +instance Message ChangeMasterGeom + +arrangeTallGrid :: Rectangle -> Int -> Int -> Int -> Rational -> Rational -> [Rectangle] +arrangeTallGrid rect@(Rectangle rx ry rw rh) nwins mrows mcols mfrac saspect + | nwins <= mwins = arrangeMasterGrid rect nwins mcols + | mwins == 0 = arrangeAspectGrid rect nwins saspect + | otherwise = (arrangeMasterGrid mrect mwins mcols) ++ + (arrangeAspectGrid srect swins saspect) + where + mwins = mrows * mcols + swins = nwins - mwins + mrect = Rectangle rx ry rw mh + srect = Rectangle rx (fromIntegral ry + fromIntegral mh) rw sh + mh = ceiling (fromIntegral rh * mfrac) + sh = rh - mh + +arrangeMasterGrid :: Rectangle -> Int -> Int -> [Rectangle] +arrangeMasterGrid rect nwins mcols = arrangeGrid rect nwins (min nwins mcols) + +arrangeAspectGrid :: Rectangle -> Int -> Rational -> [Rectangle] +arrangeAspectGrid rect@(Rectangle _ _ rw rh) nwins aspect = + arrangeGrid rect nwins (min nwins ncols) + where + ncols = ceiling $ sqrt $ ( fromRational + ( (fromIntegral rw * fromIntegral nwins) / (fromIntegral rh * aspect) ) :: Double) + +arrangeGrid :: Rectangle -> Int -> Int -> [Rectangle] +arrangeGrid (Rectangle rx ry rw rh) nwins ncols = + [Rectangle (fromIntegral x + rx) (fromIntegral y + ry) (fromIntegral w) (fromIntegral h) + | (x, y, w, h) <- rects] + where + nrows_in_cols = listDifference $ splitEvenly nwins ncols + x_slabs = splitIntoSlabs (fromIntegral rw) ncols + y_slabs = [splitIntoSlabs (fromIntegral rh) nrows | nrows <- nrows_in_cols] + rects_in_cols = [[(x, y, w, h) | (y, h) <- lst] + | ((x, w), lst) <- zip x_slabs y_slabs] + rects = foldr (++) [] rects_in_cols + +splitIntoSlabs :: Int -> Int -> [(Int, Int)] +splitIntoSlabs width nslabs = zip (0:xs) widths + where + xs = splitEvenly width nslabs + widths = listDifference xs + +listDifference :: [Int] -> [Int] +listDifference lst = [cur-pre | (cur,pre) <- zip lst (0:lst)] + +splitEvenly :: Int -> Int -> [Int] +splitEvenly n parts = [ sz-off | (sz,off) <- zip sizes offsets] + where + size = ceiling ( (fromIntegral n / fromIntegral parts) :: Double ) + extra = size*parts - n + sizes = [i*size | i <- [1..parts]] + offsets = (take (fromIntegral extra) [1..]) ++ [extra,extra..] + +resizeMaster :: TallGrid a -> Resize -> TallGrid a +resizeMaster (TallGrid mrows mcols mfrac saspect delta) Shrink = + TallGrid mrows mcols (max 0 (mfrac - delta)) saspect delta +resizeMaster (TallGrid mrows mcols mfrac saspect delta) Expand = + TallGrid mrows mcols (min 1 (mfrac + delta)) saspect delta + +changeMasterGrid :: TallGrid a -> ChangeMasterGeom -> TallGrid a +changeMasterGrid (TallGrid mrows mcols mfrac saspect delta) (IncMasterRows d) = + TallGrid (max 0 (mrows + d)) mcols mfrac saspect delta +changeMasterGrid (TallGrid mrows mcols mfrac saspect delta) (IncMasterCols d) = + TallGrid mrows (max 0 (mcols + d)) mfrac saspect delta hunk ./xmonad-contrib.cabal 135 + XMonad.Layout.GridVariants hunk ./XMonad/Actions/Warp.hs 52 -{- | Move the mouse cursor to a corner of the screen. Useful for +{- | Move the mouse cursor to a corner of the focused window. Useful for hunk ./XMonad/Actions/Warp.hs 19 + banishScreen, hunk ./XMonad/Actions/Warp.hs 68 - UpperRight -> warpToWindow 1 0 + UpperRight -> warpToWindow 1 0 + +{- | Same as 'banish' but moves the mouse to the corner of the + currently focused screen -} +banishScreen :: Corner -> X () +banishScreen direction = case direction of + LowerRight -> warpToCurrentScreen 1 1 + LowerLeft -> warpToCurrentScreen 0 1 + UpperLeft -> warpToCurrentScreen 0 0 + UpperRight -> warpToCurrentScreen 1 0 + where + warpToCurrentScreen h v = + do (StackSet { current = x }) <- gets windowset + warpToScreen (W.screen x) h v hunk ./XMonad/Actions/Warp.hs 80 - do (StackSet { current = x }) <- gets windowset - warpToScreen (W.screen x) h v + do ws <- gets windowset + warpToScreen (W.screen $ current ws) h v + windows (const ws) + hunk ./XMonad/Actions/Search.hs 191 - escapeURIString p s = concatMap (escapeURIChar p) s + escapeURIString = concatMap . escapeURIChar hunk ./XMonad/Actions/Search.hs 198 - myShowHex n r = case showIntAtBase 16 (toChrHex) n r of + myShowHex n r = case showIntAtBase 16 toChrHex n r of hunk ./XMonad/Actions/Search.hs 215 -search browser site query = safeSpawn browser (site ++ (escape query)) +search browser site query = safeSpawn browser $ site ++ escape query hunk ./XMonad/Actions/Search.hs 230 -searchEngine name site = SearchEngine name site +searchEngine = SearchEngine hunk ./XMonad/Actions/Search.hs 263 -promptSearchBrowser config browser (SearchEngine name site) = mkXPrompt (Search name) config (historyCompletion) $ search browser site +promptSearchBrowser config browser (SearchEngine name site) = mkXPrompt (Search name) config historyCompletion $ search browser site hunk ./XMonad/Actions/WindowGo.hs 65 -runOrRaise action = raiseMaybe $ spawn action +runOrRaise = raiseMaybe . spawn hunk ./XMonad/Actions/WindowGo.hs 106 -runOrRaiseNext action = raiseNextMaybe $ spawn action +runOrRaiseNext = raiseNextMaybe . spawn hunk ./XMonad/Actions/WindowGo.hs 157 -runOrRaiseAndDo run query afterRaise = raiseAndDo (spawn run) query afterRaise +runOrRaiseAndDo = raiseAndDo . spawn hunk ./XMonad/Util/XSelection.hs 173 -safePromptSelection app = join $ io $ liftM (safeSpawn app) (getSelection) +safePromptSelection app = join $ io $ liftM (safeSpawn app) getSelection hunk ./XMonad/Util/XUtils.hs 140 - io $ fillRectangle d p gc (fi bw) (fi bw) ((wh - (bw * 2))) (ht - (bw * 2)) + io $ fillRectangle d p gc (fi bw) (fi bw) (wh - (bw * 2)) (ht - (bw * 2)) hunk ./XMonad/Layout/Monitor.hs 50 --- And make the desired window unmanaged with ManageHook: +-- The first argument to addMonitor is property which uniquely identifies +-- the monitor, the second is rectangle in which the monitor will be placed. +-- +-- Then make the desired window unmanaged with ManageHook: hunk ./XMonad/Util/WindowProperties.hs 17 - Property(..), hasProperty, focusedHasProperty, allWithProperty) + Property(..), hasProperty, focusedHasProperty, allWithProperty, + propertyToQuery) hunk ./XMonad/Util/WindowProperties.hs 64 +-- | Find all existing windows with specified property hunk ./XMonad/Util/WindowProperties.hs 70 + +-- | Convert property to 'Query' 'Bool' (see "XMonad.ManageHook") +propertyToQuery :: Property -> Query Bool +propertyToQuery (Title s) = title =? s +propertyToQuery (Resource s) = resource =? s +propertyToQuery (ClassName s) = className =? s +propertyToQuery (Role s) = stringProperty "WM_WINDOW_ROLE" =? s +propertyToQuery (And p1 p2) = propertyToQuery p1 <&&> propertyToQuery p2 +propertyToQuery (Or p1 p2) = propertyToQuery p1 <||> propertyToQuery p2 +propertyToQuery (Not p) = not `fmap` propertyToQuery p +propertyToQuery (Const b) = return b hunk ./XMonad/Layout/Monitor.hs 23 - -- * TODO - -- $todo hunk ./XMonad/Layout/Monitor.hs 24 + monitor, hunk ./XMonad/Layout/Monitor.hs 27 - addMonitor, - addPersistentMonitor, - addNamedMonitor, - addNamedPersistentMonitor, - doHideIgnore + doHideIgnore, + manageMonitor + + -- * TODO + -- $todo hunk ./XMonad/Layout/Monitor.hs 38 +import XMonad.Hooks.FadeInactive (setOpacity) hunk ./XMonad/Layout/Monitor.hs 46 --- Then add monitor to desired layouts: +-- Define 'Monitor' record. 'monitor' can be used as a template. At least 'prop' +-- and 'rect' should be set here. Also consider setting 'persistent' to True. hunk ./XMonad/Layout/Monitor.hs 49 --- > myLayouts = addMonitor (ClassName "Cairo-clock" `And` Title "MacSlow's Cairo-Clock") (Rectangle (1280-150) (800-150) 150 150) $ tall ||| Full ||| ... --- --- The first argument to addMonitor is property which uniquely identifies --- the monitor, the second is rectangle in which the monitor will be placed. --- --- Then make the desired window unmanaged with ManageHook: +-- Minimal example: +-- +-- > myMonitor = monitor +-- > { prop = ClassName "SomeClass" +-- > , rect = Rectangle 0 0 40 20 -- rectangle 40x20 in upper left corner +-- > } hunk ./XMonad/Layout/Monitor.hs 56 --- > , className =? "Cairo-clock"--> doIgnore +-- More interesting example: +-- +-- > clock = monitor { +-- > -- Cairo-clock creates 2 windows with the same classname, thus also using title +-- > prop = ClassName "Cairo-clock" `And` Title "MacSlow's Cairo-Clock" +-- > -- rectangle 150x150 in lower right corner, assuming 1280x800 resolution +-- > , rect = (Rectangle (1280-150) (800-150) 150 150) +-- > -- avoid flickering +-- > , persistent = True +-- > -- make the window transparent +-- > , opacity = 0xAAAAAAAA +-- > -- hide on start +-- > , visible = False +-- > -- assign it a name to be able to toggle it independently of others +-- > , mbName = Just "clock" +-- > } hunk ./XMonad/Layout/Monitor.hs 73 +-- Add ManageHook to de-manage monitor windows and apply opacity settings. +-- +-- > manageHook = myManageHook <+> manageMonitor clock +-- +-- Apply layout modifier. +-- +-- > myLayouts = ModifiedLayout clock $ tall ||| Full ||| ... +-- hunk ./XMonad/Layout/Monitor.hs 91 -data Monitor a = Monitor { - prop :: Property, -- ^ a window which satisfies this property is chosen as monitor - rect :: Rectangle, -- ^ where to put monitor - visible :: Bool, -- ^ is it visible by default? - mbName :: (Maybe String), -- ^ name of monitor (useful when we have many of them) - persistent :: Bool -- ^ is it shown on all layouts? +data Monitor a = Monitor + { prop :: Property -- ^ property which uniquely identifies monitor window + , rect :: Rectangle -- ^ specifies where to put monitor + , visible :: Bool -- ^ is it visible by default? + , mbName :: (Maybe String) -- ^ name of monitor (useful when we have many of them) + , persistent :: Bool -- ^ is it shown on all layouts? + , opacity :: Integer -- ^ opacity level hunk ./XMonad/Layout/Monitor.hs 100 +-- | Template for 'Monitor' record. At least 'prop' and 'rect' should be +-- redefined. Default settings: 'visible' is 'True', 'persistent' is 'False'. +monitor :: Monitor a +monitor = Monitor + { prop = Const False + , rect = Rectangle 0 0 0 0 + , visible = True + , mbName = Nothing + , persistent = False + , opacity = 0xFFFFFFFF + } + hunk ./XMonad/Layout/Monitor.hs 147 -addMonitor :: Property -> Rectangle -> l a -> ModifiedLayout Monitor l a -addMonitor p r = ModifiedLayout (Monitor p r True Nothing False) -addPersistentMonitor :: Property -> Rectangle -> l a -> ModifiedLayout Monitor l a -addPersistentMonitor p r = ModifiedLayout (Monitor p r True Nothing True) -addNamedMonitor :: String -> Property -> Rectangle -> l a -> ModifiedLayout Monitor l a -addNamedMonitor name p r = ModifiedLayout (Monitor p r True (Just name) False) -addNamedPersistentMonitor :: String -> Property -> Rectangle -> l a -> ModifiedLayout Monitor l a -addNamedPersistentMonitor name p r = ModifiedLayout (Monitor p r True (Just name) True) +-- | ManageHook which demanages monitor window and applies opacity settings. +manageMonitor :: Monitor a -> ManageHook +manageMonitor mon = propertyToQuery (prop mon) --> do + w <- ask + liftX $ setOpacity w $ opacity mon + if persistent mon then doIgnore else doHideIgnore hunk ./XMonad/Layout/Monitor.hs 157 --- - If you want the monitor to be available on /all/ layouts, use --- 'addPersistentMonitor' instead of 'addMonitor' to avoid unnecessary +-- - If your monitor is available on /all/ layouts, set +-- 'persistent' to 'True' to avoid unnecessary hunk ./XMonad/Layout/Monitor.hs 161 --- - On the other hand, if you use the monitor only with some of the layouts, you --- might want to hide it on the startup. Then change ManageHook to the following: --- --- > className =? "Cairo-clock"--> doHideIgnore --- --- - You can use several monitors with nested modifiers. Give them a name using --- 'addNamedMonitor' or 'addNamedPersistentMonitor' to be able to toggle --- them independently. --- --- - To make monitor transparent, import "XMonad.Hooks.FadeInactive" and change --- ManageHook to (@0xAAAAAAAA@ is the level of opacity): --- --- > className =? "Cairo-clock"--> (ask >>= liftX . flip setOpacity 0xAAAAAAAA >> doIgnore) +-- - You can use several monitors with nested modifiers. Give them names +--- to be able to toggle them independently. hunk ./XMonad/Layout/Monitor.hs 170 --- - automatically unmanage the window? --- hunk ./XMonad/Layout/Monitor.hs 62 --- > , rect = (Rectangle (1280-150) (800-150) 150 150) +-- > , rect = Rectangle (1280-150) (800-150) 150 150 hunk ./XMonad/Layout/Monitor.hs 70 --- > , mbName = Just "clock" +-- > , name = "clock" hunk ./XMonad/Layout/Monitor.hs 92 - { prop :: Property -- ^ property which uniquely identifies monitor window - , rect :: Rectangle -- ^ specifies where to put monitor - , visible :: Bool -- ^ is it visible by default? - , mbName :: (Maybe String) -- ^ name of monitor (useful when we have many of them) - , persistent :: Bool -- ^ is it shown on all layouts? - , opacity :: Integer -- ^ opacity level + { prop :: Property -- ^ property which uniquely identifies monitor window + , rect :: Rectangle -- ^ specifies where to put monitor + , visible :: Bool -- ^ is it visible by default? + , name :: String -- ^ name of monitor (useful when we have many of them) + , persistent :: Bool -- ^ is it shown on all layouts? + , opacity :: Integer -- ^ opacity level hunk ./XMonad/Layout/Monitor.hs 107 - , mbName = Nothing + , name = "" hunk ./XMonad/Layout/Monitor.hs 112 +-- | Messages without names affect all monitors. Messages with names affect only +-- monitors whose names match. hunk ./XMonad/Layout/Monitor.hs 139 - if mbName mon `elem` [Just n, Nothing] then Just $ mon { visible = not $ visible mon } else Nothing + if name mon == n then Just $ mon { visible = not $ visible mon } else Nothing hunk ./XMonad/Layout/Monitor.hs 142 - if mbName mon `elem` [Just n, Nothing] then Just $ mon { visible = True } else Nothing + if name mon == n then Just $ mon { visible = True } else Nothing hunk ./XMonad/Layout/Monitor.hs 145 - if mbName mon `elem` [Just n, Nothing] then Just $ mon { visible = False } else Nothing + if name mon == n then Just $ mon { visible = False } else Nothing hunk ./XMonad/Prompt.hs 73 +import System.Posix.Files hunk ./XMonad/Prompt.hs 720 + setFileMode path mode + where mode = ownerReadMode .|. ownerWriteMode hunk ./XMonad/Hooks/EwmhDesktops.hs 85 - -- Current desktop - let curr = fromJust $ elemIndex (W.currentTag s) $ map W.tag ws - - setCurrentDesktop curr - hunk ./XMonad/Hooks/EwmhDesktops.hs 89 - -- Per window Desktop - -- 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 + -- Current desktop + case (elemIndex (W.currentTag s) $ map W.tag ws) of + Nothing -> return () + Just curr -> do + setCurrentDesktop curr + + -- Per window Desktop + -- 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 hunk ./XMonad/Hooks/EwmhDesktops.hs 103 - let wn = fromJust $ elemIndex (W.tag w) (map W.tag ws) in - forM_ (W.integrate' (W.stack w)) $ \win -> do - setWindowDesktop win wn + case elemIndex (W.tag w) (map W.tag ws) of + Nothing -> return () + Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do + setWindowDesktop win wn addfile ./XMonad/Layout/ThreeColumnsMiddle.hs hunk ./XMonad/Layout/ThreeColumnsMiddle.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.ThreeColumnsMiddle +-- Copyright : (c) Carsten Otto , +-- based on ThreeColumns (c) Kai Grossjohann +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : ? +-- Stability : unstable +-- Portability : unportable +-- +-- A layout similar to tall but with three columns, where the main window is +-- in the middle. With 2560x1600 pixels this layout can be used for a huge +-- main window and up to six reasonable sized slave windows. +-- +-- > Screenshot: http://server.c-otto.de/xmonad/ThreeColumnsMiddle.png +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.ThreeColumnsMiddle ( + -- * Usage + -- $usage + ThreeColMid(..) + ) where + +import XMonad +import qualified XMonad.StackSet as W + +import Data.Ratio + +import Control.Monad + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.ThreeColumnsMiddle +-- +-- Then edit your @layoutHook@ by adding the ThreeColMid layout: +-- +-- > myLayouts = ThreeColMid 1 (3/100) (1/2) ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- The first argument specifies how many windows appear in the main window. +-- The second argument specifies how much the main window size changes when resizing. +-- The third argument specifies the initial size of the main window as a fraction of +-- total screen size. +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +data ThreeColMid a = ThreeColMid !Int !Rational !Rational deriving (Show,Read) + +instance LayoutClass ThreeColMid a where + doLayout (ThreeColMid nmaster _ frac) r = + return . (\x->(x,Nothing)) . + ap zip (tile3 frac r nmaster . length) . W.integrate + handleMessage (ThreeColMid nmaster delta frac) m = + return $ msum [fmap resize (fromMessage m) + ,fmap incmastern (fromMessage m)] + where resize Shrink = ThreeColMid nmaster delta (max 0 $ frac-delta) + resize Expand = ThreeColMid nmaster delta (min 1 $ frac+delta) + incmastern (IncMasterN d) = ThreeColMid (max 0 (nmaster+d)) delta frac + description _ = "ThreeColMid" + +-- | tile3. Compute window positions using 3 panes +tile3 :: Rational -> Rectangle -> Int -> Int -> [Rectangle] +tile3 f r nmaster n +-- split horizontally, if there are very few windows (only the main screen is used) + | n <= nmaster || nmaster == 0 = splitHorizontally n r + +-- one window more than the master window can hold (the additional window is shown right of the main screen) + | n == nmaster+1 = splitVertically nmaster s1 ++ splitVertically (n-nmaster) s2 + +-- many windows (the main windows are shown in the center, all other windows are shown left and right of it) + | otherwise = splitVertically nmaster r1 ++ splitVertically nleft r2 ++ splitVertically nright r3 + where (r1, r2, r3) = split3HorizontallyBy f r + (s1, s2) = splitHorizontallyBy f r + nslave = (n - nmaster) + nleft = ceiling (nslave % 2) + nright = (n - nmaster - nleft) + +split3HorizontallyBy :: Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle) +split3HorizontallyBy f (Rectangle sx sy sw sh) = + ( Rectangle (sx + fromIntegral leftw) sy midw sh + , Rectangle sx sy leftw sh + , Rectangle (sx + fromIntegral leftw + fromIntegral midw) sy rightw sh ) + where midw = ceiling $ fromIntegral sw * f + leftw = ceiling ( (sw - midw) % 2 ) + rightw = sw - leftw - midw hunk ./xmonad-contrib.cabal 168 + XMonad.Layout.ThreeColumnsMiddle hunk ./XMonad/Util/XSelection.hs 23 + modifySelectionAndSafePromptSelection, + modifySelectionAndUnsafePromptSelection, hunk ./XMonad/Util/XSelection.hs 178 +modifySelectionAndSafePromptSelection, modifySelectionAndUnsafePromptSelection :: (String -> String) -> String -> X () +modifySelectionAndSafePromptSelection f app = join $ io $ liftM (safeSpawn app) (fmap f getSelection) +modifySelectionAndUnsafePromptSelection f app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) (fmap f getSelection) hunk ./XMonad/Util/XSelection.hs 23 - modifySelectionAndSafePromptSelection, - modifySelectionAndUnsafePromptSelection, + transformPromptSelection, + transformSafePromptSelection, hunk ./XMonad/Util/XSelection.hs 178 -modifySelectionAndSafePromptSelection, modifySelectionAndUnsafePromptSelection :: (String -> String) -> String -> X () -modifySelectionAndSafePromptSelection f app = join $ io $ liftM (safeSpawn app) (fmap f getSelection) -modifySelectionAndUnsafePromptSelection f app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) (fmap f getSelection) +{- | A wrapper around promptSelection and its safe variant. They take two parameters, the first is a function that transforms strings, and the second is the application to run. The transformer essentially transforms the selection in X. +One example is to wrap code, such as a command line action copied out of the browser to be run as '"sudo" ++ cmd' or '"su - -c \"" ++ cmd ++ "\"". +-} +transformPromptSelection, transformSafePromptSelection :: (String -> String) -> String -> X () +transformPromptSelection f app = join $ io $ liftM (safeSpawn app) (fmap f getSelection) +transformSafePromptSelection f app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) (fmap f getSelection) hunk ./XMonad/Util/XSelection.hs 178 -{- | A wrapper around promptSelection and its safe variant. They take two parameters, the first is a function that transforms strings, and the second is the application to run. The transformer essentially transforms the selection in X. +{- | A wrapper around 'promptSelection' and its safe variant. They take two parameters, the first is a function that transforms strings, and the second is the application to run. The transformer essentially transforms the selection in X. hunk ./XMonad/Util/XSelection.hs 184 + hunk ./XMonad/Util/XSelection.hs 7 -Maintainer : Andrea Rossato , - Matthew Sackman +Maintainer : Gwern Branwen addfile ./XMonad/Layout/CenteredMaster.hs hunk ./XMonad/Layout/CenteredMaster.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.CenteredMaster +-- Copyright : (c) 2009 Ilya Portnov +-- License : GNU GPL v3 or any later +-- +-- Maintainer : Ilya Portnov +-- Stability : unstable +-- Portability : unportable +-- +-- Two layout modifiers. centerMaster places master window at center, +-- on top of all other windows, which are managed by base layout. +-- topRightMaster is similar, but places master window in top right corner +-- instead of center. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.CenteredMaster ( + -- * Usage + -- $usage + + centerMaster, + topRightMaster + ) where + +import XMonad +import XMonad.Layout.LayoutModifier +import qualified XMonad.StackSet as W + +-- $usage +-- This module defines two new layout modifiers: centerMaster and topRightMaster. +-- centerMaster places master window at center of screen, on top of others. +-- All other windows in background are managed by base layout. +-- topRightMaster is like centerMaster, but places master window in top right corner instead of center. +-- +-- Yo can use this module by adding folowing in your @xmonad.hs@: +-- +-- > import XMonad.Layout.CenteredMaster +-- +-- Then add layouts to your layoutHook: +-- +-- > myLayoutHook = centerMaster Grid ||| ... + +-- | Function that decides where master window should be placed +type Positioner = Rectangle -> Rectangle + +-- | Data type for LayoutModifier +data CenteredMaster a = CenteredMaster deriving (Read,Show) + +instance LayoutModifier CenteredMaster Window where + modifyLayout CenteredMaster = applyPosition (center (5/7) (5/7)) + +data TopRightMaster a = TopRightMaster deriving (Read,Show) + +instance LayoutModifier TopRightMaster Window where + modifyLayout TopRightMaster = applyPosition (topRight (3/7) (1/2)) + +-- | Modifier that puts master window in center, other windows in background +-- are managed by given layout +centerMaster :: LayoutClass l a => l a -> ModifiedLayout CenteredMaster l a +centerMaster = ModifiedLayout CenteredMaster + +-- | Modifier that puts master window in top right corner, other windows in background +-- are managed by given layout +topRightMaster :: LayoutClass l a => l a -> ModifiedLayout TopRightMaster l a +topRightMaster = ModifiedLayout TopRightMaster + +-- | Internal function, doing main job +applyPosition :: (LayoutClass l a, Eq a) => + Positioner + -> W.Workspace WorkspaceId (l a) a + -> Rectangle + -> X ([(a, Rectangle)], Maybe (l a)) + +applyPosition pos wksp rect = do + let stack = W.stack wksp + let ws = W.integrate' $ stack + if null ws then + runLayout wksp rect + else do + let first = head ws + let other = tail ws + let filtStack = stack >>= W.filter (first /=) + wrs <- runLayout (wksp {W.stack = filtStack}) rect + return ((first, place pos other rect) : fst wrs, snd wrs) + +-- | Place master window (it's Rectangle is given), using the given Positioner. +-- If second argument is empty (that is, there is only one window on workspace), +-- place that window fullscreen. +place :: Positioner -> [a] -> Rectangle -> Rectangle +place _ [] rect = rect +place pos _ rect = pos rect + +-- | Function that calculates Rectangle at top right corner of given Rectangle +topRight :: Float -> Float -> Rectangle -> Rectangle +topRight rx ry (Rectangle sx sy sw sh) = Rectangle x sy w h + where w = round (fromIntegral sw * rx) + h = round (fromIntegral sh * ry) + x = sx + fromIntegral (sw-w) + +-- | Function that calculates Rectangle at center of given Rectangle. +center :: Float -> Float -> Rectangle -> Rectangle +center rx ry (Rectangle sx sy sw sh) = Rectangle x y w h + where w = round (fromIntegral sw * rx) + h = round (fromIntegral sh * ry) + x = sx + fromIntegral (sw-w) `div` 2 + y = sy + fromIntegral (sh-h) `div` 2 + + hunk ./xmonad-contrib.cabal 125 + XMonad.Layout.CenteredMaster hunk ./XMonad/Hooks/ManageHelpers.hs 33 + isDialog, hunk ./XMonad/Hooks/ManageHelpers.hs 136 +-- | A predicate to check whether a window is a dialog. +isDialog :: Query Bool +isDialog = ask >>= \w -> liftX $ do + dpy <- asks display + w_type <- getAtom "_NET_WM_WINDOW_TYPE" + w_dialog <- getAtom "_NET_WM_WINDOW_TYPE_DIALOG" + r <- io $ getWindowProperty32 dpy w_type w + return $ case r of + Just xs -> fromIntegral w_dialog `elem` xs + _ -> False + hunk ./XMonad/Layout/HintedTile.hs 53 - { nmaster :: !Int - , delta, frac :: !Rational + { nmaster :: !Int -- ^ number of windows in the master pane + , delta :: !Rational -- ^ how much to change when resizing + , frac :: !Rational -- ^ ratio between master/nonmaster panes hunk ./XMonad/Layout/HintedTile.hs 58 - , orientation :: !Orientation + , orientation :: !Orientation -- ^ Tall or Wide (mirrored) layout? hunk ./XMonad/Util/EZConfig.hs 137 --- replaced by the appropriate number) respectively; some special --- keys can be specified by enclosing their name in angle brackets. +-- replaced by the appropriate number) respectively. Note that if +-- you want to make a keybinding using \'alt\' even though you use a +-- different key (like the \'windows\' key) for \'mod\', you can use +-- something like @\"M1-x\"@ for alt+x (check the output of @xmodmap@ +-- to see which mod key \'alt\' is bound to). Some special keys can +-- also be specified by enclosing their name in angle brackets. hunk ./XMonad/Util/EZConfig.hs 144 --- For example, @\"M-C-x\"@ denotes mod+ctrl+x; @\"S-\\"@ denotes --- shift-escape. +-- For example, @\"M-C-x\"@ denotes mod+ctrl+x; @\"S-\\"@ +-- denotes shift-escape; @\"M1-C-\\"@ denotes alt+ctrl+delete +-- (assuming alt is bound to mod1, which is common). hunk ./XMonad/Util/EZConfig.hs 167 --- keys, such as the arrow keys, have synonyms: +-- keys, such as the arrow keys, have synonyms. If there are other +-- special keys you would like to see supported, feel free to submit a +-- patch, or ask on the xmonad mailing list; adding special keys is +-- quite simple. hunk ./XMonad/Hooks/UrgencyHook.hs 335 - userCode =<< asks (logHook . config) -- call *after* IORef has been modified + userCodeDef () =<< asks (logHook . config) -- call *after* IORef has been modified hunk ./XMonad/Hooks/UrgencyHook.hs 345 - userCode $ urgencyHook hook w + userCodeDef () $ urgencyHook hook w hunk ./XMonad/Config/Sjanssen.hs 13 +import XMonad.Hooks.EwmhDesktops hunk ./XMonad/Config/Sjanssen.hs 17 +import XMonad.Layout.LayoutScreens +import XMonad.Layout.TwoPane + hunk ./XMonad/Config/Sjanssen.hs 36 + , logHook = ewmhDesktopsLogHook hunk ./XMonad/Config/Sjanssen.hs 39 - , ("Ktorrent", "7")]] + , ("Ktorrent", "7") + , ("Amarokapp", "7")]] hunk ./XMonad/Config/Sjanssen.hs 53 + ,((modm, xK_z ), layoutScreens 2 $ TwoPane 0.5 0.5) + ,((modm .|. shiftMask, xK_z ), rescreen) hunk ./XMonad/Prompt/Man.hs 91 - (pin, pout, perr, ph) <- runInteractiveCommand s + -- we can ignore the process handle because we ignor SIGCHLD + (pin, pout, perr, _) <- runInteractiveCommand s hunk ./XMonad/Prompt/Man.hs 97 - waitForProcess ph hunk ./XMonad/Util/Loggers.hs 33 -import System.Process (runInteractiveCommand, waitForProcess) +import System.Process (runInteractiveCommand) hunk ./XMonad/Util/Loggers.hs 85 -logCmd c = io $ do (_, out, _, proc) <- runInteractiveCommand c +logCmd c = io $ do (_, out, _, _) <- runInteractiveCommand c hunk ./XMonad/Util/Loggers.hs 87 - waitForProcess proc + -- no need to waitForProcess, we ignore SIGCHLD hunk ./XMonad/Util/Run.hs 34 -import System.Posix.Process (executeFile) +import System.Posix.Process (executeFile, forkProcess) hunk ./XMonad/Util/Run.hs 57 - (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing + (pin, pout, perr, _) <- runInteractiveProcess cmd args Nothing Nothing hunk ./XMonad/Util/Run.hs 64 - waitForProcess ph + -- no need to waitForProcess, we ignore SIGCHLD hunk ./XMonad/Util/Run.hs 70 - doubleFork $ do + forkProcess $ do hunk ./XMonad/Util/Run.hs 80 + return () hunk ./XMonad/Util/Run.hs 110 -safeSpawn prog arg = liftIO (try (doubleFork $ executeFile prog True [arg] Nothing) >> return ()) +safeSpawn prog arg = liftIO (try (forkProcess $ executeFile prog True [arg] Nothing) >> return ()) hunk ./XMonad/Util/Run.hs 132 - doubleFork $ do + forkProcess $ do hunk ./XMonad/Util/Timer.hs 26 +import System.Posix.Process (forkProcess) hunk ./XMonad/Util/Timer.hs 39 - doubleFork $ do + forkProcess $ do hunk ./xmonad-contrib.cabal 66 + if impl (ghc >= 6.10.1) && arch (x86_64) + ghc-options: -O0 + hunk ./xmonad-contrib.cabal 2 -version: 0.8 +version: 0.8.1 addfile ./XMonad/Actions/SpawnOn.hs hunk ./XMonad/Actions/SpawnOn.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.SpawnOn +-- Copyright : (c) Spencer Janssen +-- License : BSD +-- +-- Maintainer : Spencer Janssen +-- 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 = do +-- > sp <- mkSpawner +-- > xmonad defaultConfig { +-- > ... +-- > manageHook = spawnHook sp <+> manageHook defaultConfig +-- > ... +-- > } + +module XMonad.Actions.SpawnOn ( + Spawner, + mkSpawner, + manageSpawn, + spawnHere, + spawnOn, + shellPromptHere, + shellPromptOn +) where + +import Data.IORef +import System.Posix.Types (ProcessID) + +import XMonad +import qualified XMonad.StackSet as W + +import XMonad.Hooks.ManageHelpers +import XMonad.Prompt +import XMonad.Prompt.Shell + +newtype Spawner = Spawner {pidsRef :: IORef [(ProcessID, WorkspaceId)]} + +maxPids :: Int +maxPids = 5 + +mkSpawner :: (Functor m, MonadIO m) => m Spawner +mkSpawner = io . fmap Spawner $ newIORef [] + +manageSpawn :: Spawner -> ManageHook +manageSpawn sp = do + pids <- io . readIORef $ pidsRef sp + mp <- pid + case flip lookup pids =<< mp of + Just w -> doF (W.shift w) + Nothing -> doF id + +mkPrompt :: (String -> X ()) -> XPConfig -> X () +mkPrompt cb c = do + cmds <- io $ getCommands + mkXPrompt Shell c (getShellCompl cmds) cb + +shellPromptHere :: Spawner -> XPConfig -> X () +shellPromptHere sp = mkPrompt (spawnHere sp) + +shellPromptOn :: Spawner -> WorkspaceId -> XPConfig -> X () +shellPromptOn sp ws = mkPrompt (spawnOn sp ws) + +spawnHere :: Spawner -> String -> X () +spawnHere sp cmd = withWindowSet $ \ws -> spawnOn sp (currTag ws) cmd + where currTag = W.tag . W.workspace . W.current + +spawnOn :: Spawner -> WorkspaceId -> String -> X () +spawnOn sp ws cmd = do + p <- spawnPID cmd + io $ modifyIORef (pidsRef sp) (take maxPids . ((p, ws) :)) hunk ./XMonad/Hooks/ManageHelpers.hs 34 + pid, hunk ./XMonad/Hooks/ManageHelpers.hs 53 +import System.Posix (ProcessID) + hunk ./XMonad/Hooks/ManageHelpers.hs 150 +pid :: Query (Maybe ProcessID) +pid = ask >>= \w -> liftX $ do + dpy <- asks display + a <- getAtom "_NET_WM_PID" + p <- io $ getWindowProperty32 dpy a w + return $ case p of + Just [x] -> Just (fromIntegral x) + _ -> Nothing + hunk ./XMonad/Prompt/Shell.hs 18 - shellPrompt + Shell (..) + , shellPrompt hunk ./XMonad/Prompt/Shell.hs 146 + hunk ./xmonad-contrib.cabal 98 + XMonad.Actions.SpawnOn hunk ./XMonad/Config/Sjanssen.hs 15 -import XMonad.Prompt.Shell +import XMonad.Actions.SpawnOn hunk ./XMonad/Config/Sjanssen.hs 22 -sjanssenConfigXmobar = statusBar "xmobar" sjanssenPP strutkey sjanssenConfig +sjanssenConfigXmobar = statusBar "xmobar" sjanssenPP strutkey =<< sjanssenConfig hunk ./XMonad/Config/Sjanssen.hs 26 -sjanssenConfig = - defaultConfig +sjanssenConfig = do + sp <- mkSpawner + return $ defaultConfig hunk ./XMonad/Config/Sjanssen.hs 35 - , keys = \c -> mykeys c `M.union` keys defaultConfig c + , keys = \c -> mykeys sp c `M.union` keys defaultConfig c hunk ./XMonad/Config/Sjanssen.hs 42 - <+> manageHook defaultConfig <+> manageDocks + <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn sp hunk ./XMonad/Config/Sjanssen.hs 49 - mykeys (XConfig {modMask = modm, workspaces = ws}) = M.fromList $ - [((modm, xK_p ), shellPrompt myPromptConfig) + mykeys sp (XConfig {modMask = modm, workspaces = ws}) = M.fromList $ + [((modm, xK_p ), shellPromptHere sp myPromptConfig) hunk ./XMonad/Util/Run.hs 34 -import System.Posix.Process (executeFile, forkProcess) +import System.Posix.Process (executeFile, forkProcess, createSession) hunk ./XMonad/Util/Run.hs 133 + createSession hunk ./XMonad/Util/Run.hs 134 + uninstallSignalHandlers addfile ./XMonad/Layout/Mosaic.hs hunk ./XMonad/Layout/Mosaic.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Mosaic +-- Copyright : (c) 2009 Adam Vogt, 2007 James Webb +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : vogt.adamgmail.com +-- Stability : unstable +-- Portability : unportable +-- +-- Based on MosaicAlt, but aspect ratio messages allways change the aspect +-- ratios, and rearranging the window stack changes the window sizes. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.Mosaic ( + Mosaic(..) + ,Aspect(..) + ) + where + +import Prelude hiding (sum) + +import XMonad(Typeable, + LayoutClass(pureLayout, pureMessage, description), Message, + fromMessage, splitHorizontallyBy, splitVerticallyBy, Rectangle) +import XMonad.StackSet(integrate) +import Data.Foldable(Foldable(foldMap), sum) +import Data.Monoid(Monoid(mappend, mempty)) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Mosaic +-- +-- Then edit your @layoutHook@ by adding the Mosaic layout: +-- +-- > myLayouts = Mosaic 0 [1..10] ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- The numbers are directly proportional to the area given, with the +-- master window getting the most if you have an ascending list. +-- +-- Unfortunately, infinite lists break serialization, so +-- don't use them +-- +-- The position of a window in the stack determines its size. +-- +-- To change the choice in aspect ratio, add to your keybindings: +-- +-- , ((modMask, xK_a), sendMessage Taller) +-- , ((modMask, xK_z), sendMessage Wider) +-- , ((modMask, xK_s), sendMessage (SlopeMod (zipWith (*) [1..]))) +-- , ((modMask, xK_d), sendMessage (SlopeMod (zipWith (flip (/)) [1..]))) +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +data Aspect + = Taller + | Wider + | Reset + | SlopeMod ([Rational] -> [Rational]) + deriving (Typeable) + +instance Message Aspect + +data Mosaic a + = Mosaic Int [Rational] + deriving (Read, Show) + +instance LayoutClass Mosaic a where + description = const "Mosaic" + + pureMessage (Mosaic i ss) msg = ixMod $ fromMessage msg + where ixMod (Just Wider) = Just $ Mosaic (succ i) ss + ixMod (Just Taller) = if i <= 1 then Nothing else Just $ Mosaic (pred i) ss + ixMod (Just Reset) = Just $ Mosaic 0 ss + ixMod (Just (SlopeMod f)) = Just $ Mosaic i (f ss) + ixMod _ = Nothing + + pureLayout (Mosaic i ss) r st = zip (integrate st) (rect i) + where rects = splits (length $ integrate st) r ss + rect 0 = rects !! (length rects `div` 2) + rect n = if length rects < n then last rects else rects !! pred n + +splits :: Int -> Rectangle -> [Rational] -> [[Rectangle]] +splits num rect sz = splitsL rect $ makeTree $ normalize $ take num sz +-- where --fas = normalize $ map (fromIntegral (sum fas')/) $ map fromIntegral fas' + +normalize :: Fractional a => [a] -> [a] +normalize x = let s = sum x + in map (/s) x + +-- recursively enumerate splits +splitsL :: Rectangle -> Tree Rational -> [[Rectangle]] +splitsL _rect Empty = [] +splitsL rect (Leaf _) = [[rect]] +splitsL rect (Branch l r) = do + let mkSplit f = f (sum l / (sum l + sum r)) rect + (rl,rr) <- map mkSplit [splitHorizontallyBy,splitVerticallyBy] + splitsL rl l `interleave` splitsL rr r + +interleave :: [[a]] -> [[a]] -> [[a]] +interleave xs ys | lx > ly = zc xs (extend lx ys) + | otherwise = zc (extend ly xs) ys + where lx = length xs + ly = length ys + zc = zipWith (++) + +extend :: Int -> [a] -> [a] +extend n pat = do + (p,e') <- zip pat $ take m (repeat True) ++ repeat False + let e = if e' then [p] else [] + (e++) $ take d $ repeat p + where (d,m) = n `divMod` length pat + +data Tree a = Branch (Tree a) (Tree a) | Leaf a | Empty + deriving (Show) + +instance Foldable Tree where + foldMap _f Empty = mempty + foldMap f (Leaf x) = f x + foldMap f (Branch l r) = foldMap f l `mappend` foldMap f r + +instance Monoid (Tree a) where + mempty = Empty + mappend Empty x = x + mappend x Empty = x + mappend x y = Branch x y + +makeTree :: [Rational] -> Tree Rational +makeTree [] = Empty +makeTree [x] = Leaf x +makeTree xs = Branch (makeTree a) (makeTree b) + where ((a,b),_) = foldr w (([],[]),(0,0)) xs + w n ((ls,rs),(l,r)) = if l > r then ((ls,n:rs),(l,n+r)) + else ((n:ls,rs),(n+l,r)) + hunk ./xmonad-contrib.cabal 153 + XMonad.Layout.Mosaic hunk ./XMonad/Layout/Mosaic.hs 18 + -- $usage hunk ./XMonad/Layout/Mosaic.hs 53 --- , ((modMask, xK_a), sendMessage Taller) --- , ((modMask, xK_z), sendMessage Wider) --- , ((modMask, xK_s), sendMessage (SlopeMod (zipWith (*) [1..]))) --- , ((modMask, xK_d), sendMessage (SlopeMod (zipWith (flip (/)) [1..]))) +-- > , ((modMask, xK_a), sendMessage Taller) +-- > , ((modMask, xK_z), sendMessage Wider) +-- > , ((modMask, xK_s), sendMessage (SlopeMod (zipWith (*) [1..]))) +-- > , ((modMask, xK_d), sendMessage (SlopeMod (zipWith (flip (/)) [1..]))) addfile ./XMonad/Util/SpawnOnWorkspace.hs hunk ./XMonad/Util/SpawnOnWorkspace.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.SpawnOnWorkspace +-- Copyright : (c) 2009 Daniel Schoepe +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Daniel Schoepe +-- Stability : unstable +-- Portability : unportable +-- +-- Provides a way to spawn an application on a specific workspace by using +-- the _NET_WM_PID property that most windows set on creation. Hence this module +-- won't work on applications that don't set this property. +-- +----------------------------------------------------------------------------- +module XMonad.Util.SpawnOnWorkspace ( + -- * Usage + -- $usage + + -- * Documentation + -- $documentation + + spawnOnWorkspace, + spawnOnWorkspaceHook, + mkSpawnHelper, + SpawnHelper + ) where +import XMonad +import XMonad.Hooks.ManageHelpers +import Data.IORef +import Data.Maybe +import qualified Data.Map as M +import System.Posix.Types + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad +-- > import XMonad.Util.SpawnOnWorkspace +-- +-- > main = do +-- > sh <- mkSpawnHelper +-- > .. +-- +-- Then you need to add 'spawnOnWorkspaceHook' to your manage hook: +-- +-- > manageHook = spawnOnWorkspaceHook sh <+> manageHook defaultConfig +-- +-- To spawn an application on a specific workspace, add a keybinding: +-- +-- > ((mod1Mask,xK_o), spawnOnWorkspace sh "urxvt" "3") +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". +-- + +------------------------------------------------------------------- + +-- $documentation + +-- | This structure holds the process ids and corresponding +-- workspaces for processes created with 'spawnOnWorkspace' +type SpawnHelper = IORef (M.Map ProcessID WorkspaceId) + +-- | Creates a new spawn helper. +mkSpawnHelper :: IO SpawnHelper +mkSpawnHelper = newIORef M.empty + +-- | Provides a manage hook to react on process spawned with +-- 'spawnOnWorkspace'. +spawnOnWorkspaceHook :: SpawnHelper -> ManageHook +spawnOnWorkspaceHook sh = do + pd <- fromMaybe (-1) `fmap` pid + table <- io $ readIORef sh + case M.lookup pd table of + Just ws -> io (modifyIORef sh (M.delete pd)) >> doShift ws + Nothing -> doF id + +-- | Spawns a process on the specified workspace. +spawnOnWorkspace :: SpawnHelper -> String -> WorkspaceId -> X () +spawnOnWorkspace sh cmd ws = spawnPID cmd >>= io . modifyIORef sh . flip M.insert ws hunk ./xmonad-contrib.cabal 207 + XMonad.Util.SpawnOnWorkspace hunk ./XMonad/Actions/SpawnOn.hs 71 -spawnHere sp cmd = withWindowSet $ \ws -> spawnOn sp (currTag ws) cmd - where currTag = W.tag . W.workspace . W.current +spawnHere sp cmd = withWindowSet $ \ws -> spawnOn sp (W.currentTag ws) cmd hunk ./XMonad/Layout/Mosaic.hs 12 --- Based on MosaicAlt, but aspect ratio messages allways change the aspect +-- Based on MosaicAlt, but aspect ratio messages always change the aspect hunk ./XMonad/Layout/Mosaic.hs 18 + -- * Usage hunk ./XMonad/Layout/Mosaic.hs 20 - Mosaic(..) + Mosaic(Mosaic) hunk ./XMonad/Layout/Mosaic.hs 22 + ,shallower + ,steeper hunk ./XMonad/Layout/Mosaic.hs 30 - LayoutClass(pureLayout, pureMessage, description), Message, + LayoutClass(doLayout , pureMessage, description), Message, hunk ./XMonad/Layout/Mosaic.hs 43 --- > myLayouts = Mosaic 0 [1..10] ||| Full ||| etc.. +-- > myLayouts = Mosaic [4..12] ||| Full ||| etc.. hunk ./XMonad/Layout/Mosaic.hs 46 --- The numbers are directly proportional to the area given, with the --- master window getting the most if you have an ascending list. +-- Adding windows tends to result in an excessively tall ratio, but +-- approximately square ratios can be quickly had by sending a reset to the +-- layout (alt-shift space), or sending the Reset message. hunk ./XMonad/Layout/Mosaic.hs 50 --- Unfortunately, infinite lists break serialization, so --- don't use them +-- Unfortunately, infinite lists break serialization, so don't use them. hunk ./XMonad/Layout/Mosaic.hs 52 --- The position of a window in the stack determines its size. --- --- To change the choice in aspect ratio, add to your keybindings: +-- To change the choice in aspect ratio and the relative sizes of windows, add +-- to your keybindings: hunk ./XMonad/Layout/Mosaic.hs 57 --- > , ((modMask, xK_s), sendMessage (SlopeMod (zipWith (*) [1..]))) --- > , ((modMask, xK_d), sendMessage (SlopeMod (zipWith (flip (/)) [1..]))) +-- > , ((modMask, xK_h), sendMessage Shrink >> sendMessage (SlopeMod shallower)) +-- > , ((modMask, xK_l), sendMessage Expand >> sendMessage (SlopeMod steeper)) +-- +-- > , ((modMask, xK_r), sendMessage Reset) hunk ./XMonad/Layout/Mosaic.hs 76 - = Mosaic Int [Rational] + {- | The relative magnitudes of the positive rational numbers provided + determine the relative sizes of the windows. If the numbers are all + the same, then the layout looks like Grid. An increasing list results + in the master window being the largest. Only as many windows are + displayed as there are elements in that list + -} + = Mosaic [Rational] + -- the current index, and the maximum index are carried along + | MosaicSt Rational Int [Rational] hunk ./XMonad/Layout/Mosaic.hs 90 - pureMessage (Mosaic i ss) msg = ixMod $ fromMessage msg - where ixMod (Just Wider) = Just $ Mosaic (succ i) ss - ixMod (Just Taller) = if i <= 1 then Nothing else Just $ Mosaic (pred i) ss - ixMod (Just Reset) = Just $ Mosaic 0 ss - ixMod (Just (SlopeMod f)) = Just $ Mosaic i (f ss) - ixMod _ = Nothing + pureMessage (Mosaic _ss) _ms = Nothing + pureMessage (MosaicSt ix mix ss) ms = fromMessage ms >>= ixMod + where ixMod Taller | rix >= mix = Nothing + | otherwise = Just $ MosaicSt (succ ix) mix ss + ixMod Wider | rix <= 0 = Nothing + | otherwise = Just $ MosaicSt (pred ix) mix ss + ixMod Reset = Just $ Mosaic ss + ixMod (SlopeMod f) = Just $ MosaicSt ix mix (f ss) + rix = round ix + + doLayout (Mosaic ss) r st = return (zip (integrate st) rect, newLayout) + where rects = splits (length $ integrate st) r ss + lrects = length rects + rect = rects !! (lrects `div` 2) + newLayout = Just $ MosaicSt (fromIntegral lrects / 2) (pred lrects) ss hunk ./XMonad/Layout/Mosaic.hs 106 - pureLayout (Mosaic i ss) r st = zip (integrate st) (rect i) + doLayout (MosaicSt ix mix ss) r st + = return (zip (integrate st) rect, newLayout) hunk ./XMonad/Layout/Mosaic.hs 109 - rect 0 = rects !! (length rects `div` 2) - rect n = if length rects < n then last rects else rects !! pred n + lrects = length rects + nix = if mix == 0 || ix `elem` [0,1] then fromIntegral $ lrects `div` 2 + else max 0 $ min (fromIntegral $ pred lrects) $ fromIntegral (pred lrects) * ix / fromIntegral mix + rect = rects !! round nix + newLayout = Just $ MosaicSt nix (pred lrects) ss + +-- | These sample functions scale the ratios of successive windows, other +-- variations could also be useful. +-- +-- The windows in each position of the stack should correspond to a specific +-- element of the list, so it should be possible to resize individual windows, +-- though it is not yet provided. +steeper :: [Rational] -> [Rational] +steeper [] = [] +steeper (x:xs) = map (subtract (x*0.8)) (x:xs) + +shallower :: [Rational] -> [Rational] +shallower [] = [] +shallower (x:xs) = map (+(x/0.8)) (x:xs) hunk ./XMonad/Layout/Mosaic.hs 131 --- where --fas = normalize $ map (fromIntegral (sum fas')/) $ map fromIntegral fas' hunk ./XMonad/Layout/Mosaic.hs 142 - (rl,rr) <- map mkSplit [splitHorizontallyBy,splitVerticallyBy] + (rl,rr) <- map mkSplit [splitVerticallyBy,splitHorizontallyBy] hunk ./XMonad/Layout/Mosaic.hs 110 - nix = if mix == 0 || ix `elem` [0,1] then fromIntegral $ lrects `div` 2 + nix = if mix == 0 then fromIntegral $ lrects `div` 2 hunk ./XMonad/Layout/Mosaic.hs 46 --- Adding windows tends to result in an excessively tall ratio, but --- approximately square ratios can be quickly had by sending a reset to the --- layout (alt-shift space), or sending the Reset message. --- hunk ./XMonad/Layout/Mosaic.hs 79 - -- the current index, and the maximum index are carried along - | MosaicSt Rational Int [Rational] + -- override the aspect? current index, maximum index + | MosaicSt Bool Rational Int [Rational] hunk ./XMonad/Layout/Mosaic.hs 87 - pureMessage (MosaicSt ix mix ss) ms = fromMessage ms >>= ixMod + pureMessage (MosaicSt _ ix mix ss) ms = fromMessage ms >>= ixMod hunk ./XMonad/Layout/Mosaic.hs 89 - | otherwise = Just $ MosaicSt (succ ix) mix ss + | otherwise = Just $ MosaicSt False (succ ix) mix ss hunk ./XMonad/Layout/Mosaic.hs 91 - | otherwise = Just $ MosaicSt (pred ix) mix ss + | otherwise = Just $ MosaicSt False (pred ix) mix ss hunk ./XMonad/Layout/Mosaic.hs 93 - ixMod (SlopeMod f) = Just $ MosaicSt ix mix (f ss) + ixMod (SlopeMod f) = Just $ MosaicSt False ix mix (f ss) hunk ./XMonad/Layout/Mosaic.hs 100 - newLayout = Just $ MosaicSt (fromIntegral lrects / 2) (pred lrects) ss + newLayout = Just $ MosaicSt True (fromIntegral lrects / 2) (pred lrects) ss hunk ./XMonad/Layout/Mosaic.hs 102 - doLayout (MosaicSt ix mix ss) r st + doLayout (MosaicSt override ix mix ss) r st hunk ./XMonad/Layout/Mosaic.hs 106 - nix = if mix == 0 then fromIntegral $ lrects `div` 2 - else max 0 $ min (fromIntegral $ pred lrects) $ fromIntegral (pred lrects) * ix / fromIntegral mix + nix = if mix == 0 || override then fromIntegral $ lrects `div` 2 + else max 0 $ min (fromIntegral $ pred lrects) + $ fromIntegral (pred lrects) * ix / fromIntegral mix hunk ./XMonad/Layout/Mosaic.hs 110 - newLayout = Just $ MosaicSt nix (pred lrects) ss + newLayout = Just $ MosaicSt override nix (pred lrects) ss hunk ./XMonad/Actions/CycleWS.hs 175 - | HiddenWS -- ^ cycle through non-visible workspaces + | HiddenWS -- ^ cycle through non-visible workspaces hunk ./XMonad/Actions/CycleWS.hs 189 - hi <- wsTypeToPred HiddenWS + hi <- wsTypeToPred HiddenWS hunk ./XMonad/Actions/Submap.hs 18 - submap + submap, + submapDefault hunk ./XMonad/Actions/Submap.hs 61 -submap keys = do +submap keys = submapDefault (return ()) keys + +-- | Like 'submap', but executes a default action if the key did not match. +submapDefault :: X () -> M.Map (KeyMask, KeySym) (X ()) -> X () +submapDefault def keys = do hunk ./XMonad/Actions/Submap.hs 81 - whenJust (M.lookup (m', s) keys) id + maybe def id (M.lookup (m', s) keys) addfile ./XMonad/Actions/MessageFeedback.hs hunk ./XMonad/Actions/MessageFeedback.hs 1 - +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.MessageFeedback +-- Copyright : (c) Quentin Moser +-- License : BSD3 +-- +-- Maintainer : None +-- Stability : unstable +-- Portability : unportable +-- +-- Alternative to 'XMonad.Operations.sendMessage' that provides knowledge +-- of whether the message was handled, and utility functions based on +-- this facility. +----------------------------------------------------------------------------- + +module XMonad.Actions.MessageFeedback ( + -- * Usage + -- $usage + + send + , tryMessage + , tryMessage_ + , tryInOrder + , tryInOrder_ + , sm + , sendSM + , sendSM_ + ) where + +import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX ) +import XMonad.StackSet ( current, workspace, layout, tag ) +import XMonad.Operations ( updateLayout ) + +import Control.Monad.State ( gets ) +import Data.Maybe ( isJust ) +import Control.Applicative ((<$>)) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.MessageFeedback +-- +-- You can then use this module's functions wherever an action is expected. +-- +-- Note that most functions in this module have a return type of @X Bool@ +-- whereas configuration options will expect a @X ()@ action. +-- For example, the key binding +-- +-- > -- Shrink the master area of a tiled layout, or move the focused window +-- > -- to the left in a WindowArranger-based layout +-- > ((modKey, xK_Left), tryMessage Shrink (MoveLeft 50)) +-- +-- is mis-typed. For this reason, this module provides alternatives (ending with +-- an underscore, e.g. tryMessage_) that discard their result and return an @X ()@. +-- For example, to correct the previous example: +-- +-- > ((modKey, xK_Left), tryMessage_ Shrink (MoveLeft 50)) +-- + + +-- | Behaves like 'XMonad.Operations.sendMessage', but returns True of the +-- message was handled by the layout, False otherwise. +send :: Message a => a -> X Bool +send = sendSM . sm + +-- | Sends the first message, and if it was not handled, sends the second. +-- Returns True if either message was handled, False otherwise. +tryMessage :: (Message a, Message b) => a -> b -> X Bool +tryMessage m1 m2 = do b <- send m1 + if b then return True else send m2 + +tryMessage_ :: (Message a, Message b) => a -> b -> X () +tryMessage_ m1 m2 = tryMessage m1 m2 >> return () + +-- | Tries sending every message of the list in order until one of them +-- is handled. Returns True if one of the messages was handled, False otherwise. +tryInOrder :: [SomeMessage] -> X Bool +tryInOrder [] = return False +tryInOrder (m:ms) = do b <- sendSM m + if b then return True else tryInOrder ms + +tryInOrder_ :: [SomeMessage] -> X () +tryInOrder_ ms = tryInOrder ms >> return () + + +-- | Convenience shorthand for 'XMonad.Core.SomeMessage'. +sm :: Message a => a -> SomeMessage +sm = SomeMessage + + +sendSM :: SomeMessage -> X Bool +sendSM m = do w <- workspace . current <$> gets windowset + ml' <- handleMessage (layout w) m `catchX` return Nothing + updateLayout (tag w) ml' + return $ isJust ml' + + +sendSM_ :: SomeMessage -> X () +sendSM_ m = sendSM m >> return () hunk ./xmonad-contrib.cabal 88 + XMonad.Actions.MessageFeedback hunk ./XMonad/Layout/LayoutHints.hs 20 + , layoutHintsWithPlacement hunk ./XMonad/Layout/LayoutHints.hs 22 + , placeRectangle hunk ./XMonad/Layout/LayoutHints.hs 29 +import Control.Applicative ( (<$>) ) +import Control.Arrow ( second ) + hunk ./XMonad/Layout/LayoutHints.hs 37 --- Then edit your @layoutHook@ by adding the LayoutHints layout modifier +-- Then edit your @layoutHook@ by adding the 'layoutHints' layout modifier hunk ./XMonad/Layout/LayoutHints.hs 43 +-- Or, to center the adapted window in its available area: +-- +-- > myLayouts = layoutHintsWithPlacement (0.5, 0.5) (Tall 1 (3/100) (1/2)) +-- > ||| Full ||| etc.. +-- hunk ./XMonad/Layout/LayoutHints.hs 53 -layoutHints = ModifiedLayout LayoutHints +layoutHints = ModifiedLayout (LayoutHints (0, 0)) + +-- | @layoutHintsWithPlacement (rx, ry) layout@ will adapt the sizes of a layout's +-- windows according to their size hints, and position them inside their +-- originally assigned area according to the @rx@ and @ry@ parameters. +-- (0, 0) places the window at the top left, (1, 0) at the top right, (0.5, 0.5) +-- at the center, etc. +layoutHintsWithPlacement :: (LayoutClass l a) => (Double, Double) + -> l a -> ModifiedLayout LayoutHints l a +layoutHintsWithPlacement rs = ModifiedLayout (LayoutHints rs) hunk ./XMonad/Layout/LayoutHints.hs 64 -data LayoutHints a = LayoutHints deriving (Read, Show) +data LayoutHints a = LayoutHints (Double, Double) + deriving (Read, Show) hunk ./XMonad/Layout/LayoutHints.hs 70 - redoLayout _ _ (Just s) xs = do - xs' <- mapM applyHint xs - return (xs', Nothing) + redoLayout (LayoutHints al) _ (Just s) xs + = do xs' <- mapM (\x@(_, r) -> second (placeRectangle al r) <$> applyHint x) xs + return (xs', Nothing) hunk ./XMonad/Layout/LayoutHints.hs 79 +-- | @placeRectangle (rx, ry) r0 r@ will return a new rectangle with the same dimensions +-- as @r@, but positioned inside of @r0@ as specified by the (rx, ry) parameters (see +-- 'layoutHintsWithPlacement'). +placeRectangle :: RealFrac r => (r, r) -> Rectangle -> Rectangle -> Rectangle +placeRectangle (rx, ry) (Rectangle x0 y0 w h) (Rectangle _ _ dx dy) + = Rectangle (align x0 dx w rx) (align y0 dy h ry) dx dy + where align :: RealFrac r => Position -> Dimension -> Dimension -> r -> Position + align z0 dz d r = z0 + truncate (fromIntegral (d - dz) * r) hunk ./XMonad/Actions/SinkAll.hs 15 - sinkAll) where + sinkAll, withAll, + withAll', killAll) where + +import Data.Foldable hiding (foldr) hunk ./XMonad/Actions/SinkAll.hs 21 +import XMonad.Core +import XMonad.Operations hunk ./XMonad/Actions/SinkAll.hs 40 -sinkAll = withAll sink +sinkAll = withAll' sink hunk ./XMonad/Actions/SinkAll.hs 43 -withAll :: (Window -> WindowSet -> WindowSet) -> X () -withAll f = windows $ \ws -> let all' = integrate' . stack . workspace . current $ ws - in foldr f ws all' +withAll' :: (Window -> WindowSet -> WindowSet) -> X () +withAll' f = windows $ \ws -> let all' = integrate' . stack . workspace . current $ ws + in foldr f ws all' + +withAll :: (Window -> X ()) -> X() +withAll f = withWindowSet $ \ws -> let all' = integrate' . stack . workspace . current $ ws + in forM_ all' f hunk ./XMonad/Actions/SinkAll.hs 51 +killAll :: X() +killAll = withAll killWindow addfile ./XMonad/Actions/WithAll.hs hunk ./XMonad/Actions/SinkAll.hs 8 --- Provides a simple binding that pushes all floating windows on the current --- workspace back into tiling. +-- Provides a simple binding that pushes all floating windows on the +-- current workspace back into tiling. Note that the functionality of +-- this module has been folded into the more general +-- "XMonad.Actions.WithAll"; this module simply re-exports the +-- 'sinkAll' function for backwards compatibility. hunk ./XMonad/Actions/SinkAll.hs 18 - sinkAll, withAll, - withAll', killAll) where hunk ./XMonad/Actions/SinkAll.hs 19 -import Data.Foldable hiding (foldr) + sinkAll) where hunk ./XMonad/Actions/SinkAll.hs 21 -import XMonad -import XMonad.Core -import XMonad.Operations -import XMonad.StackSet +import XMonad.Actions.WithAll (sinkAll) hunk ./XMonad/Actions/SinkAll.hs 23 --- $usage --- --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Actions.SinkAll --- --- then add a keybinding; for example: --- --- , ((modMask x .|. shiftMask, xK_t), sinkAll) --- --- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". - --- | Un-float all floating windows on the current workspace. -sinkAll :: X () -sinkAll = withAll' sink - --- | Apply a function to all windows on current workspace. -withAll' :: (Window -> WindowSet -> WindowSet) -> X () -withAll' f = windows $ \ws -> let all' = integrate' . stack . workspace . current $ ws - in foldr f ws all' - -withAll :: (Window -> X ()) -> X() -withAll f = withWindowSet $ \ws -> let all' = integrate' . stack . workspace . current $ ws - in forM_ all' f - -killAll :: X() -killAll = withAll killWindow hunk ./XMonad/Actions/WithAll.hs 1 - +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.WithAll +-- License : BSD3-style (see LICENSE) +-- Stability : unstable +-- Portability : unportable +-- +-- Provides functions for performing a given action on all windows of +-- the current workspace. +----------------------------------------------------------------------------- + +module XMonad.Actions.WithAll ( + -- * Usage + -- $usage + sinkAll, withAll, + withAll', killAll) where + +import Data.Foldable hiding (foldr) + +import XMonad +import XMonad.Core +import XMonad.Operations +import XMonad.StackSet + +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.WithAll +-- +-- then add a keybinding; for example: +-- +-- , ((modMask x .|. shiftMask, xK_t), sinkAll) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Un-float all floating windows on the current workspace. +sinkAll :: X () +sinkAll = withAll' sink + +-- | Apply a function to all windows on the current workspace. +withAll' :: (Window -> WindowSet -> WindowSet) -> X () +withAll' f = windows $ \ws -> let all' = integrate' . stack . workspace . current $ ws + in foldr f ws all' + +-- | Execute an 'X' action for each window on the current workspace. +withAll :: (Window -> X ()) -> X() +withAll f = withWindowSet $ \ws -> let all' = integrate' . stack . workspace . current $ ws + in forM_ all' f + +-- | Kill all the windows on the current workspace. +killAll :: X() +killAll = withAll killWindow hunk ./xmonad-contrib.cabal 108 + XMonad.Actions.WithAll hunk ./XMonad/Actions/SinkAll.hs 23 +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.SinkAll +-- +-- then add a keybinding; for example: +-- +-- , ((modMask x .|. shiftMask, xK_t), sinkAll) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + hunk ./XMonad/Prompt.hs 394 - setSuccess b = modify $ \s -> s { successful = b } hunk ./XMonad/Prompt.hs 400 - unless completed $ eventLoop handle + if completed then setSuccess True else eventLoop handle + +setSuccess :: Bool -> XP () +setSuccess b = modify $ \s -> s { successful = b } hunk ./XMonad/Actions/Search.hs 13 -module XMonad.Actions.Search ( -- * Usage +module XMonad.Actions.Search ( -- * Usage hunk ./XMonad/Actions/Search.hs 18 + searchEngineF, hunk ./XMonad/Actions/Search.hs 24 + hasPrefix, + escape, + use, + intelligent, + (!>), + prefixAware, + namedEngine, + hunk ./XMonad/Actions/Search.hs 50 - youtube + youtube, + multi hunk ./XMonad/Actions/Search.hs 98 -* 'debpts -- Debian Package Tracking System. +* 'debpts' -- Debian Package Tracking System. hunk ./XMonad/Actions/Search.hs 128 +* 'multi' -- Search based on the prefix. \"amazon:Potter\" will use amazon, etc. With no prefix searches google. + hunk ./XMonad/Actions/Search.hs 168 -> searchList :: [([Char], S.SearchEngine)] +> searchList :: [(String, S.SearchEngine)] hunk ./XMonad/Actions/Search.hs 220 -type Site = String +type Site = String -> String hunk ./XMonad/Actions/Search.hs 224 --- | Given a browser, a search engine, and a search term, perform the +-- | Given an already defined search engine, extracts its transformation +-- function, making it easy to create compound search engines. +-- For an instance you can use @use google@ to get a function which +-- makes the same transformation as the google search engine would. +use :: SearchEngine -> Site +use (SearchEngine _ engine) = engine + +-- | Given a browser, a search engine's transformation function, and a search term, perform the hunk ./XMonad/Actions/Search.hs 234 -search browser site query = safeSpawn browser $ site ++ escape query +search browser site query = safeSpawn browser $ site query hunk ./XMonad/Actions/Search.hs 244 - from site to site, often considerably, so there's no general way to cover this. + from site to site, often considerably, so there\'s no general way to cover this. hunk ./XMonad/Actions/Search.hs 248 -searchEngine :: Name -> Site -> SearchEngine -searchEngine = SearchEngine +searchEngine :: Name -> String -> SearchEngine +searchEngine name site = searchEngineF name (\s -> site ++ (escape s)) + +{- | If your search engine is more complex than this (you may want to identify + the kind of input and make the search URL dependent on the input or put the query + inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function. + +> searchFunc :: String -> String +> searchFunc s | s `hasPrefix` "wiki:" = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s) +> | s `hasPrefix` "http://" = s +> | otherwise = (use google) s +> myNewEngine = searchEngineF "mymulti" searchFunc + + @searchFunc@ here searches for a word in wikipedia if it has a prefix + of \"wiki:\" (you can use the 'escape' function to escape any forbidden characters), opens an address + directly if it starts with \"http:\/\/\" and otherwise uses the provided google search engine. + You can use other engines inside of your own through the 'use' function as shown above to make + complex searches. + + The user input will be automatically escaped in search engines created with 'searchEngine', + 'searchEngineF', however, completely depends on the transformation function passed to it. -} +searchEngineF :: Name -> Site -> SearchEngine +searchEngineF = SearchEngine + hunk ./XMonad/Actions/Search.hs 282 -dictionary = searchEngine "dictionary" "http://dictionary.reference.com/browse/" +dictionary = searchEngine "dict" "http://dictionary.reference.com/browse/" hunk ./XMonad/Actions/Search.hs 284 -hackage = searchEngine "hackage" "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/" +hackage = searchEngine "hackage" "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/" hunk ./XMonad/Actions/Search.hs 293 -wikipedia = searchEngine "wikipedia" "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search=" +wikipedia = searchEngine "wiki" "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search=" hunk ./XMonad/Actions/Search.hs 300 +multi :: SearchEngine +multi = namedEngine "multi" $ foldr1 (!>) [amazon, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, maps, mathworld, scholar, thesaurus, wayback, wikipedia, (prefixAware google)] + +{- | This function wraps up a search engine and creates a new one, which works + like the argument, but goes directly to a URL if one is given rather than + searching. + +> myIntelligentGoogleEngine = intelligent google + + Now if you search for http:\/\/xmonad.org it will directly open in your browser-} +intelligent :: SearchEngine -> SearchEngine +intelligent (SearchEngine name site) = searchEngineF name (\s -> if (fst $ break (==':') s) `elem` ["http", "https", "ftp"] then s else (site s)) + +{- | Checks if a string starts with a given prefix -} +hasPrefix :: String -> String -> Bool +hasPrefix _ [] = True +hasPrefix [] (_:_) = False +hasPrefix (t:ts) (p:ps) = if t == p then hasPrefix ts ps else False + +removeColonPrefix :: String -> String +removeColonPrefix str = tail $ snd $ break (==':') str + +{- | Connects a few search engines into one. If the search engines\' names are + \"s1\", \"s2\" and \"s3\", then the resulting engine will use s1 if the query + is @s1:word@, s2 if you type @s2:word@ and s3 in all other cases. + + Example: + +> multiEngine = intelligent (wikipedia !> mathworld !> (prefixAware google)) + + Now if you type \"wiki:Haskell\" it will search for \"Haskell\" in Wikipedia, + \"mathworld:integral\" will search mathworld, and everything else will fall back to + google. The use of intelligent will make sure that URLs are opened directly. -} +(!>) :: SearchEngine -> SearchEngine -> SearchEngine +(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if s `hasPrefix` (name1++":") then site1 (removeColonPrefix s) else site2 s) + +{- | Makes a search engine prefix-aware. Especially useful together with '!>'. + It will automatically remove the prefix from a query so that you don\'t end + up searching for google:xmonad if google is your fallback engine and you + explicitly add the prefix. -} +prefixAware :: SearchEngine -> SearchEngine +prefixAware (SearchEngine name site) = SearchEngine name (\s -> if s `hasPrefix` (name++":") then site $ removeColonPrefix s else site s) + +{- | Changes search engine's name -} +namedEngine :: Name -> SearchEngine -> SearchEngine +namedEngine name (SearchEngine _ site) = searchEngineF name site + hunk ./XMonad/Actions/Search.hs 14 - -- $usage - search, - SearchEngine(..), - searchEngine, - searchEngineF, - promptSearch, - promptSearchBrowser, - selectSearch, - selectSearchBrowser, - - hasPrefix, - escape, - use, - intelligent, - (!>), - prefixAware, - namedEngine, - - amazon, - codesearch, - deb, - debbts, - debpts, - dictionary, - google, - hackage, - hoogle, - images, - imdb, - isohunt, - maps, - mathworld, - scholar, - thesaurus, - wayback, - wikipedia, - youtube, - multi + -- $usage + search, + SearchEngine(..), + searchEngine, + searchEngineF, + promptSearch, + promptSearchBrowser, + selectSearch, + selectSearchBrowser, + hasPrefix, + escape, + use, + intelligent, + (!>), + prefixAware, + namedEngine, hunk ./XMonad/Actions/Search.hs 31 + amazon, + codesearch, + deb, + debbts, + debpts, + dictionary, + google, + hackage, + hoogle, + images, + imdb, + isohunt, + maps, + mathworld, + scholar, + thesaurus, + wayback, + wikipedia, + youtube, + multi hunk ./XMonad/Actions/Search.hs 53 - hunk ./XMonad/Actions/Search.hs 304 -> myIntelligentGoogleEngine = intelligent google - +> myIntelligentGoogleEngine = intelligent google + hunk ./XMonad/Actions/Search.hs 321 - is @s1:word@, s2 if you type @s2:word@ and s3 in all other cases. - + is @s1:word@, s2 if you type @s2:word@ and s3 in all other cases. + hunk ./XMonad/Actions/Search.hs 324 - -> multiEngine = intelligent (wikipedia !> mathworld !> (prefixAware google)) + +> multiEngine = intelligent (wikipedia !> mathworld !> (prefixAware google)) hunk ./XMonad/Layout/FixedColumn.hs 45 --- > myLayouts = FixedColumn 20 80 10 ||| Full ||| etc.. +-- > myLayouts = FixedColumn 1 20 80 10 ||| Full ||| etc.. hunk ./XMonad/Layout/GridVariants.hs 25 + , SplitGrid(..) + , Orientation(..) hunk ./XMonad/Layout/GridVariants.hs 36 --- > import XMonad.Layout.Master +-- > import XMonad.Layout.GridVariants hunk ./XMonad/Layout/GridVariants.hs 44 --- > TallGrid 2 3 (2/3) (16/10) (5/100) +-- > SplitGrid L 2 3 (2/3) (16/10) (5/100) hunk ./XMonad/Layout/GridVariants.hs 47 --- and a 16:10 aspect ratio slave grid. The last parameter is again --- the percentage by which the split between master and slave area --- changes in response to Expand/Shrink messages. +-- and a 16:10 aspect ratio slave grid to its right. The last +-- parameter is again the percentage by which the split between master +-- and slave area changes in response to Expand/Shrink messages. hunk ./XMonad/Layout/GridVariants.hs 73 --- | TallGrid layout. Parameters are +-- | SplitGrid layout. Parameters are hunk ./XMonad/Layout/GridVariants.hs 75 +-- - side where the master is hunk ./XMonad/Layout/GridVariants.hs 81 -data TallGrid a = TallGrid !Int !Int !Rational !Rational !Rational - deriving (Read, Show) +data SplitGrid a = SplitGrid Orientation !Int !Int !Rational !Rational !Rational + deriving (Read, Show) hunk ./XMonad/Layout/GridVariants.hs 84 -instance LayoutClass TallGrid a where +-- | Type to specify the side of the screen that holds +-- the master area of a SplitGrid. +data Orientation = T | B | L | R + deriving (Eq, Read, Show) hunk ./XMonad/Layout/GridVariants.hs 89 - pureLayout (TallGrid mrows mcols mfrac saspect _) rect st = zip wins rects +instance LayoutClass SplitGrid a where + + pureLayout (SplitGrid o mrows mcols mfrac saspect _) rect st = zip wins rects hunk ./XMonad/Layout/GridVariants.hs 95 - rects = arrangeTallGrid rect nwins mrows mcols mfrac saspect + rects = arrangeSplitGrid rect o nwins mrows mcols mfrac saspect hunk ./XMonad/Layout/GridVariants.hs 101 - description _ = "TallGrid" + description _ = "SplitGrid" hunk ./XMonad/Layout/GridVariants.hs 111 -arrangeTallGrid :: Rectangle -> Int -> Int -> Int -> Rational -> Rational -> [Rectangle] -arrangeTallGrid rect@(Rectangle rx ry rw rh) nwins mrows mcols mfrac saspect +arrangeSplitGrid :: Rectangle -> Orientation -> Int -> Int -> Int -> Rational -> Rational -> [Rectangle] +arrangeSplitGrid rect@(Rectangle rx ry rw rh) o nwins mrows mcols mfrac saspect hunk ./XMonad/Layout/GridVariants.hs 118 - mwins = mrows * mcols - swins = nwins - mwins - mrect = Rectangle rx ry rw mh - srect = Rectangle rx (fromIntegral ry + fromIntegral mh) rw sh - mh = ceiling (fromIntegral rh * mfrac) - sh = rh - mh + mwins = mrows * mcols + swins = nwins - mwins + mrect = Rectangle mx my mw mh + srect = Rectangle sx sy sw sh + (mh, sh, mw, sw) = if o `elem` [T, B] then + (ceiling (fromIntegral rh * mfrac), rh - mh, rw, rw) + else + (rh, rh, ceiling (fromIntegral rw * mfrac), rw - mw) + mx = fromIntegral rx + if o == R then fromIntegral sw else 0 + my = fromIntegral ry + if o == B then fromIntegral sh else 0 + sx = fromIntegral rx + if o == L then fromIntegral mw else 0 + sy = fromIntegral ry + if o == T then fromIntegral mh else 0 hunk ./XMonad/Layout/GridVariants.hs 170 -resizeMaster :: TallGrid a -> Resize -> TallGrid a -resizeMaster (TallGrid mrows mcols mfrac saspect delta) Shrink = - TallGrid mrows mcols (max 0 (mfrac - delta)) saspect delta -resizeMaster (TallGrid mrows mcols mfrac saspect delta) Expand = - TallGrid mrows mcols (min 1 (mfrac + delta)) saspect delta +resizeMaster :: SplitGrid a -> Resize -> SplitGrid a +resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Shrink = + SplitGrid o mrows mcols (max 0 (mfrac - delta)) saspect delta +resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Expand = + SplitGrid o mrows mcols (min 1 (mfrac + delta)) saspect delta + +changeMasterGrid :: SplitGrid a -> ChangeMasterGeom -> SplitGrid a +changeMasterGrid (SplitGrid o mrows mcols mfrac saspect delta) (IncMasterRows d) = + SplitGrid o (max 0 (mrows + d)) mcols mfrac saspect delta +changeMasterGrid (SplitGrid o mrows mcols mfrac saspect delta) (IncMasterCols d) = + SplitGrid o mrows (max 0 (mcols + d)) mfrac saspect delta hunk ./XMonad/Layout/GridVariants.hs 182 -changeMasterGrid :: TallGrid a -> ChangeMasterGeom -> TallGrid a -changeMasterGrid (TallGrid mrows mcols mfrac saspect delta) (IncMasterRows d) = - TallGrid (max 0 (mrows + d)) mcols mfrac saspect delta -changeMasterGrid (TallGrid mrows mcols mfrac saspect delta) (IncMasterCols d) = - TallGrid mrows (max 0 (mcols + d)) mfrac saspect delta +-- | TallGrid layout. Parameters are +-- +-- - number of master rows +-- - number of master columns +-- - portion of screen used for master grid +-- - x:y aspect ratio of slave windows +-- - increment for resize messages +-- +-- This exists mostly because it was introduced in an earlier version. +-- It's a fairly thin wrapper around "SplitGrid L". +data TallGrid a = TallGrid !Int !Int !Rational !Rational !Rational + deriving (Read, Show) + +instance LayoutClass TallGrid a where + + pureLayout (TallGrid mrows mcols mfrac saspect _) rect st = zip wins rects + where + wins = W.integrate st + nwins = length wins + rects = arrangeSplitGrid rect L nwins mrows mcols mfrac saspect + + pureMessage layout msg = + msum [ fmap ((tallGridAdapter resizeMaster) layout) (fromMessage msg) + , fmap ((tallGridAdapter changeMasterGrid) layout) (fromMessage msg) ] + + description _ = "TallGrid" + +tallGridAdapter :: (SplitGrid a -> b -> SplitGrid a) -> TallGrid a -> b -> TallGrid a +tallGridAdapter f (TallGrid mrows mcols mfrac saspect delta) msg = + TallGrid mrows' mcols' mfrac' saspect' delta' + where + SplitGrid _ mrows' mcols' mfrac' saspect' delta' = + f (SplitGrid L mrows mcols mfrac saspect delta) msg hunk ./XMonad/Actions/SpawnOn.hs 19 --- > manageHook = spawnHook sp <+> manageHook defaultConfig +-- > manageHook = manageSpawn sp <+> manageHook defaultConfig hunk ./XMonad/Actions/GridSelect.hs 25 - default_colorizer + fromClassName, + colorRangeFromClassName hunk ./XMonad/Actions/GridSelect.hs 41 +import System.Random (mkStdGen, genRange, next) +import Data.Word (Word8) hunk ./XMonad/Actions/GridSelect.hs 212 -default_colorizer :: Window -> Bool -> X (String, String) -default_colorizer w active = do + +fromClassName :: Window -> Bool -> X (String, String) +fromClassName w active = do hunk ./XMonad/Actions/GridSelect.hs 222 - else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Integer).(*256)) [r, g, b] ), "white") - where - twodigitHex :: Integer -> String - twodigitHex a = printf "%02x" a + else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b] ), "white") + + +twodigitHex :: Word8 -> String +twodigitHex a = printf "%02x" a + + +-- | A colorizer that picks a color inside a range, +-- and depending on the window's class. +colorRangeFromClassName :: (Word8, Word8, Word8) -- ^ Beginning of the color range + -> (Word8, Word8, Word8) -- ^ End of the color range + -> (Word8, Word8, Word8) -- ^ Background of the active window + -> (Word8, Word8, Word8) -- ^ Inactive text color + -> (Word8, Word8, Word8) -- ^ Active text color + -> Window -> Bool -> X (String, String) +colorRangeFromClassName startC endC activeC inactiveT activeT w active = + do classname <- runQuery className w + if active + then return (rgbToHex activeC, rgbToHex activeT) + else return (rgbToHex $ mix startC endC + $ stringToRatio classname, rgbToHex inactiveT) + where rgbToHex :: (Word8, Word8, Word8) -> String + rgbToHex (r, g, b) = '#':twodigitHex r + ++twodigitHex g++twodigitHex b + +-- | Creates a mix of two colors according to a ratio +-- (1 -> first color, 0 -> second color). +mix :: (Word8, Word8, Word8) -> (Word8, Word8, Word8) + -> Double -> (Word8, Word8, Word8) +mix (r1, g1, b1) (r2, g2, b2) r = (mix' r1 r2, mix' g1 g2, mix' b1 b2) + where mix' a b = truncate $ (fi a * r) + (fi b * (1 - r)) + +-- | Generates a Double from a string, trying to +-- achieve a random distribution. +-- We create a random seed from the sum of all characters +-- in the string, and use it to generate a ratio between 0 and 1 +stringToRatio :: String -> Double +stringToRatio "" = 0 +stringToRatio s = let gen = mkStdGen $ sum $ map fromEnum s + range = (\(a, b) -> b - a) $ genRange gen + randomInt = foldr1 combine $ replicate 20 next + combine f1 f2 g = let (_, g') = f1 g in f2 g' + in fi (fst $ randomInt gen) / fi range + + + hunk ./XMonad/Actions/GridSelect.hs 333 -defaultGSConfig = GSConfig 50 130 10 default_colorizer "xft:Sans-8" +defaultGSConfig = GSConfig 50 130 10 fromClassName "xft:Sans-8" hunk ./XMonad/Config/Arossato.hs 93 - , layoutHook = eventHook ServerMode $ - avoidStruts $ + , layoutHook = avoidStruts $ hunk ./XMonad/Config/Arossato.hs 101 + , handleEventHook = serverModeEventHook hunk ./XMonad/Config/Desktop.hs 30 + , handleEventHook = ewmhDesktopsEventHook hunk ./XMonad/Config/Desktop.hs 36 -desktopLayoutModifiers layout = avoidStruts $ ewmhDesktopsLayout layout +desktopLayoutModifiers layout = avoidStruts layout hunk ./XMonad/Config/Droundy.hs 47 - ewmhDesktopsLayout ) + ewmhDesktopsEventHook ) hunk ./XMonad/Config/Droundy.hs 124 - , layoutHook = ewmhDesktopsLayout $ showWName $ workspaceDir "~" $ + , layoutHook = showWName $ workspaceDir "~" $ hunk ./XMonad/Config/Droundy.hs 138 + , handleEventHook = ewmhDesktopsEventHook hunk ./XMonad/Hooks/EwmhDesktops.hs 18 - EwmhDesktopsHook, hunk ./XMonad/Hooks/EwmhDesktops.hs 20 - ewmhDesktopsLayout + ewmhDesktopsEventHook hunk ./XMonad/Hooks/EwmhDesktops.hs 25 +import Data.Monoid hunk ./XMonad/Hooks/EwmhDesktops.hs 33 -import XMonad.Hooks.EventHook hunk ./XMonad/Hooks/EwmhDesktops.hs 43 --- > myLayoutHook = ewmhDesktopsLayout $ avoidStruts $ layoutHook defaultConfig +-- > myHandleEventHook = ewmhDesktopsEventHook hunk ./XMonad/Hooks/EwmhDesktops.hs 45 --- > main = xmonad defaultConfig { layoutHook = myLayouts, logHook = myLogHook } +-- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook, logHook = myLogHook } hunk ./XMonad/Hooks/EwmhDesktops.hs 121 -ewmhDesktopsLayout :: layout a -> HandleEvent EwmhDesktopsHook layout a -ewmhDesktopsLayout = eventHook EwmhDesktopsHook - -data EwmhDesktopsHook = EwmhDesktopsHook deriving ( Show, Read ) -instance EventHook EwmhDesktopsHook where - handleEvent _ e@ClientMessageEvent {} = do handle e - handleEvent _ _ = return () +ewmhDesktopsEventHook :: Event -> X All +ewmhDesktopsEventHook e = handle e >> return (All True) hunk ./XMonad/Hooks/ServerMode.hs 62 - , eventHook + , serverModeEventHook hunk ./XMonad/Hooks/ServerMode.hs 67 +import Data.Monoid hunk ./XMonad/Hooks/ServerMode.hs 72 -import XMonad.Hooks.EventHook hunk ./XMonad/Hooks/ServerMode.hs 79 --- Then edit your @layoutHook@ by adding the 'eventHook': +-- Then edit your @handleEventHook@ by adding the 'serverModeEventHook': hunk ./XMonad/Hooks/ServerMode.hs 81 --- > layoutHook = eventHook ServerMode $ avoidStruts $ simpleTabbed ||| Full ||| etc.. +-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook } hunk ./XMonad/Hooks/ServerMode.hs 83 --- and then: --- --- > main = xmonad defaultConfig { layoutHook = myLayouts } --- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" hunk ./XMonad/Hooks/ServerMode.hs 86 -instance EventHook ServerMode where - handleEvent _ (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do +serverModeEventHook :: Event -> X All +serverModeEventHook (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do hunk ./XMonad/Hooks/ServerMode.hs 96 - handleEvent _ _ = return () + return (All True) +serverModeEventHook _ = return (All True) hunk ./XMonad/Hooks/UrgencyHook.hs 73 -import XMonad.Hooks.EventHook hunk ./XMonad/Hooks/UrgencyHook.hs 201 - h -> XConfig l -> XConfig (HandleEvent (WithUrgencyHook h) l) + h -> XConfig l -> XConfig l hunk ./XMonad/Hooks/UrgencyHook.hs 210 - h -> UrgencyConfig -> XConfig l -> XConfig (HandleEvent (WithUrgencyHook h) l) + h -> UrgencyConfig -> XConfig l -> XConfig l hunk ./XMonad/Hooks/UrgencyHook.hs 212 - layoutHook = eventHook (WithUrgencyHook hook urgConf) $ layoutHook conf, + handleEventHook = \e -> handleEvent (WithUrgencyHook hook urgConf) e >> handleEventHook conf e, hunk ./XMonad/Hooks/UrgencyHook.hs 324 -instance UrgencyHook h => EventHook (WithUrgencyHook h) where - handleEvent wuh event = case event of - PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do +handleEvent :: UrgencyHook h => WithUrgencyHook h -> Event -> X () +handleEvent wuh event = + case event of + PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do hunk ./XMonad/Hooks/UrgencyHook.hs 336 - DestroyWindowEvent {ev_window = w} -> + DestroyWindowEvent {ev_window = w} -> hunk ./XMonad/Hooks/UrgencyHook.hs 338 - _ -> + _ -> hunk ./XMonad/Doc/Configuring.hs 109 -is syntactically and type correct. You can do this easily by loading -your configuration file in the Haskell interpreter: +is syntactically and type correct. You can do this easily by using an xmonad +flag: hunk ./XMonad/Doc/Configuring.hs 112 -> $ ghci ~/.xmonad/xmonad.hs -> GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help -> Loading package base ... linking ... done. -> Ok, modules loaded: Main. -> -> Prelude Main> :t main -> main :: IO () +> $ xmonad --recompile +> $ hunk ./XMonad/Doc/Configuring.hs 115 -Ok, looks good. +If there is no output, your xmonad.hs has no errors. If there are errors, they +will be printed to the console. Patch them up and try again. hunk ./XMonad/Doc/Configuring.hs 138 -GHC and xmonad are in your @$PATH@. If GHC isn't in your path, you can -still compile @xmonad.hs@ yourself: - -> $ cd ~/.xmonad -> $ /path/to/ghc --make xmonad.hs -> $ ls -> xmonad xmonad.hi xmonad.hs xmonad.o - -When you hit @mod-q@, this newly compiled xmonad will be used. +GHC and xmonad are in your @$PATH@. hunk ./XMonad/Actions/SpawnOn.hs 11 --- This module provides helper functions to be used in @manageHook@. Here's --- how you might use this: +-- Provides a way to spawn an application on a specific workspace by using +-- the _NET_WM_PID property that most windows set on creation. Hence this module +-- won't work on applications that don't set this property. hunk ./XMonad/Actions/SpawnOn.hs 15 --- > import XMonad.Hooks.ManageHelpers --- > main = do --- > sp <- mkSpawner --- > xmonad defaultConfig { --- > ... --- > manageHook = manageSpawn sp <+> manageHook defaultConfig --- > ... --- > } +----------------------------------------------------------------------------- hunk ./XMonad/Actions/SpawnOn.hs 18 + -- * Usage + -- $usage hunk ./XMonad/Actions/SpawnOn.hs 39 +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.SpawnOn +-- +-- > main = do +-- > sp <- mkSpawner +-- > xmonad defaultConfig { +-- > ... +-- > manageHook = manageSpawn sp <+> manageHook defaultConfig +-- > ... +-- > } +-- +-- To ensure that application appears on a workspace it was launched at, add keybindings like: +-- +-- > , ((mod1Mask,xK_o), spawnHere sp "urxvt") +-- > , ((mod1Mask,xK_s), shellPromptHere sp defaultXPConfig) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + hunk ./XMonad/Actions/SpawnOn.hs 65 +-- | Create 'Spawner' which then has to be passed to other functions. hunk ./XMonad/Actions/SpawnOn.hs 69 +-- | Provides a manage hook to react on process spawned with +-- 'spawnOn', 'spawnHere' etc. hunk ./XMonad/Actions/SpawnOn.hs 84 +-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches +-- application on current workspace. hunk ./XMonad/Actions/SpawnOn.hs 89 +-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches +-- application on given workspace. hunk ./XMonad/Actions/SpawnOn.hs 94 +-- | Replacement for 'spawn' which launches +-- application on current workspace. hunk ./XMonad/Actions/SpawnOn.hs 99 +-- | Replacement for 'spawn' which launches +-- application on given workspace. hunk ./xmonad-contrib.cabal 209 - XMonad.Util.SpawnOnWorkspace hunk ./XMonad/Util/SpawnOnWorkspace.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonad.Util.SpawnOnWorkspace --- Copyright : (c) 2009 Daniel Schoepe --- License : BSD3-style (see LICENSE) --- --- Maintainer : Daniel Schoepe --- Stability : unstable --- Portability : unportable --- --- Provides a way to spawn an application on a specific workspace by using --- the _NET_WM_PID property that most windows set on creation. Hence this module --- won't work on applications that don't set this property. --- ------------------------------------------------------------------------------ -module XMonad.Util.SpawnOnWorkspace ( - -- * Usage - -- $usage - - -- * Documentation - -- $documentation - - spawnOnWorkspace, - spawnOnWorkspaceHook, - mkSpawnHelper, - SpawnHelper - ) where -import XMonad -import XMonad.Hooks.ManageHelpers -import Data.IORef -import Data.Maybe -import qualified Data.Map as M -import System.Posix.Types - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad --- > import XMonad.Util.SpawnOnWorkspace --- --- > main = do --- > sh <- mkSpawnHelper --- > .. --- --- Then you need to add 'spawnOnWorkspaceHook' to your manage hook: --- --- > manageHook = spawnOnWorkspaceHook sh <+> manageHook defaultConfig --- --- To spawn an application on a specific workspace, add a keybinding: --- --- > ((mod1Mask,xK_o), spawnOnWorkspace sh "urxvt" "3") --- --- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". --- - -------------------------------------------------------------------- - --- $documentation - --- | This structure holds the process ids and corresponding --- workspaces for processes created with 'spawnOnWorkspace' -type SpawnHelper = IORef (M.Map ProcessID WorkspaceId) - --- | Creates a new spawn helper. -mkSpawnHelper :: IO SpawnHelper -mkSpawnHelper = newIORef M.empty - --- | Provides a manage hook to react on process spawned with --- 'spawnOnWorkspace'. -spawnOnWorkspaceHook :: SpawnHelper -> ManageHook -spawnOnWorkspaceHook sh = do - pd <- fromMaybe (-1) `fmap` pid - table <- io $ readIORef sh - case M.lookup pd table of - Just ws -> io (modifyIORef sh (M.delete pd)) >> doShift ws - Nothing -> doF id - --- | Spawns a process on the specified workspace. -spawnOnWorkspace :: SpawnHelper -> String -> WorkspaceId -> X () -spawnOnWorkspace sh cmd ws = spawnPID cmd >>= io . modifyIORef sh . flip M.insert ws rmfile ./XMonad/Util/SpawnOnWorkspace.hs hunk ./XMonad/Hooks/ManageHelpers.hs 127 --- | A predicate to check whether a window wants to fill the whole screen. --- See also 'doFullFloat'. -isFullscreen :: Query Bool -isFullscreen = ask >>= \w -> liftX $ do +-- | Helper to check if a window property contains certain value. +isInProperty :: String -> String -> Query Bool +isInProperty p v = ask >>= \w -> liftX $ do hunk ./XMonad/Hooks/ManageHelpers.hs 131 - state <- getAtom "_NET_WM_STATE" - full <- getAtom "_NET_WM_STATE_FULLSCREEN" - r <- io $ getWindowProperty32 dpy state w + pa <- getAtom p + va <- getAtom v + r <- io $ getWindowProperty32 dpy pa w hunk ./XMonad/Hooks/ManageHelpers.hs 135 - Just xs -> fromIntegral full `elem` xs + Just xs -> fromIntegral va `elem` xs hunk ./XMonad/Hooks/ManageHelpers.hs 138 +-- | A predicate to check whether a window wants to fill the whole screen. +-- See also 'doFullFloat'. +isFullscreen :: Query Bool +isFullscreen = isInProperty "_NET_WM_STATE" "_NET_WM_STATE_FULLSCREEN" + hunk ./XMonad/Hooks/ManageHelpers.hs 145 -isDialog = ask >>= \w -> liftX $ do - dpy <- asks display - w_type <- getAtom "_NET_WM_WINDOW_TYPE" - w_dialog <- getAtom "_NET_WM_WINDOW_TYPE_DIALOG" - r <- io $ getWindowProperty32 dpy w_type w - return $ case r of - Just xs -> fromIntegral w_dialog `elem` xs - _ -> False +isDialog = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG" hunk ./XMonad/Actions/CopyWindow.hs 5 --- Copyright : (c) David Roundy , Ivan Veselov +-- Copyright : (c) David Roundy , Ivan Veselov , Lanny Ripple hunk ./XMonad/Actions/CopyWindow.hs 20 - copy, copyToAll, copyWindow, killAllOtherCopies, kill1 + copy, copyToAll, copyWindow, runOrCopy + , killAllOtherCopies, kill1 hunk ./XMonad/Actions/CopyWindow.hs 25 +import Control.Monad (filterM) hunk ./XMonad/Actions/CopyWindow.hs 55 +-- Instead of copying a window from a workset to a workset maybe you don't +-- want to have to remember where you placed it. For that consider: +-- +-- > , ((modMask x, xK_b ), runOrCopy "firefox" (className =? "Firefox")) -- @@ run or copy firefox +-- hunk ./XMonad/Actions/CopyWindow.hs 68 --- > , ((modMask x, xK_v )", windows copyToAll) -- @@ Make focused window always visible +-- > , ((modMask x, xK_v ), windows copyToAll) -- @@ Make focused window always visible hunk ./XMonad/Actions/CopyWindow.hs 74 --- | copy. Copy the focussed window to a new workspace. +-- | copy. Copy the focused window to a new workspace. hunk ./XMonad/Actions/CopyWindow.hs 94 + +-- | runOrCopy . runOrCopy will run the provided shell command unless it can +-- find a specified window in which case it will copy the window to +-- the current workspace. Similar to (i.e., stolen from) "XMonad.Actions.WindowGo". +runOrCopy :: String -> Query Bool -> X () +runOrCopy action = copyMaybe $ spawn action + +-- | copyMaybe. Flatters "XMonad.Actions.WindowGo" ('raiseMaybe') +copyMaybe :: X () -> Query Bool -> X () +copyMaybe f thatUserQuery = withWindowSet $ \s -> do + maybeResult <- filterM (runQuery thatUserQuery) (allWindows s) + case maybeResult of + [] -> f + (x:_) -> windows $ copyWindow x (currentTag s) + hunk ./XMonad/Actions/CopyWindow.hs 28 -import XMonad.StackSet +import qualified XMonad.StackSet as W hunk ./XMonad/Actions/CopyWindow.hs 75 -copy :: (Eq s, Eq i, Eq a) => i -> StackSet i l a s sd -> StackSet i l a s sd -copy n s | Just w <- peek s = copyWindow w n s +copy :: (Eq s, Eq i, Eq a) => i -> W.StackSet i l a s sd -> W.StackSet i l a s sd +copy n s | Just w <- W.peek s = copyWindow w n s hunk ./XMonad/Actions/CopyWindow.hs 80 -copyToAll :: (Eq s, Eq i, Eq a) => StackSet i l a s sd -> StackSet i l a s sd -copyToAll s = foldr copy s $ map tag (workspaces s) +copyToAll :: (Eq s, Eq i, Eq a) => W.StackSet i l a s sd -> W.StackSet i l a s sd +copyToAll s = foldr copy s $ map W.tag (W.workspaces s) hunk ./XMonad/Actions/CopyWindow.hs 84 -copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> StackSet i l a s sd -> StackSet i l a s sd +copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> W.StackSet i l a s sd -> W.StackSet i l a s sd hunk ./XMonad/Actions/CopyWindow.hs 86 - where copy' s = if n `tagMember` s - then view (currentTag s) $ insertUp' w $ view n s + where copy' s = if n `W.tagMember` s + then W.view (W.currentTag s) $ insertUp' w $ W.view n s hunk ./XMonad/Actions/CopyWindow.hs 89 - insertUp' a s = modify (Just $ Stack a [] []) - (\(Stack t l r) -> if a `elem` t:l++r - then Just $ Stack t l r - else Just $ Stack a (L.delete a l) (L.delete a (t:r))) s + insertUp' a s = W.modify (Just $ W.Stack a [] []) + (\(W.Stack t l r) -> if a `elem` t:l++r + then Just $ W.Stack t l r + else Just $ W.Stack a (L.delete a l) (L.delete a (t:r))) s hunk ./XMonad/Actions/CopyWindow.hs 99 -runOrCopy action = copyMaybe $ spawn action +runOrCopy = copyMaybe . spawn hunk ./XMonad/Actions/CopyWindow.hs 101 --- | copyMaybe. Flatters "XMonad.Actions.WindowGo" ('raiseMaybe') +-- | copyMaybe. Copies "XMonad.Actions.WindowGo" ('raiseMaybe') +-- TODO: Factor out and improve with regard to WindowGo. hunk ./XMonad/Actions/CopyWindow.hs 105 - maybeResult <- filterM (runQuery thatUserQuery) (allWindows s) + maybeResult <- filterM (runQuery thatUserQuery) (W.allWindows s) hunk ./XMonad/Actions/CopyWindow.hs 108 - (x:_) -> windows $ copyWindow x (currentTag s) + (x:_) -> windows $ copyWindow x (W.currentTag s) hunk ./XMonad/Actions/CopyWindow.hs 117 --- hunk ./XMonad/Actions/CopyWindow.hs 119 - whenJust (peek ss) $ \w -> if member w $ delete'' w ss + whenJust (W.peek ss) $ \w -> if W.member w $ delete'' w ss hunk ./XMonad/Actions/CopyWindow.hs 122 - where delete'' w = modify Nothing (filter (/= w)) + where delete'' w = W.modify Nothing (W.filter (/= w)) hunk ./XMonad/Actions/CopyWindow.hs 127 --- Consider calling this function after copyToAll --- +-- TODO: Call this function after 'copyToAll'? hunk ./XMonad/Actions/CopyWindow.hs 130 - whenJust (peek ss) $ \w -> windows $ - view (currentTag ss) . + whenJust (W.peek ss) $ \w -> windows $ + W.view (W.currentTag ss) . hunk ./XMonad/Actions/CopyWindow.hs 135 - map (delWinFromWorkspace w . tag) $ - hidden ss ++ map workspace (visible ss) - delWinFromWorkspace w wid ss = modify Nothing (filter (/= w)) $ view wid ss + map (delWinFromWorkspace w . W.tag) $ + W.hidden ss ++ map W.workspace (W.visible ss) + delWinFromWorkspace w wid = W.modify Nothing (W.filter (/= w)) . W.view wid addfile ./XMonad/Actions/CycleWindows.hs hunk ./XMonad/Actions/CycleWindows.hs 1 +-------------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.CycleWindows +-- Copyright : (c) Wirt Wolff +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Wirt Wolff +-- Stability : unstable +-- Portability : unportable +-- +-- Provides bindings to cycle windows up or down on the current workspace +-- stack while maintaining focus in place. Bindings are available to: +-- +-- * Cycle nearby or nth windows into the focused frame +-- +-- * Cycle a window halfway around the stack +-- +-- * Cycle windows through the focused position. +-- +-- * Cycle unfocused windows. +-- +-- These bindings are especially useful with layouts that hide some of +-- the windows in the stack, such as Full, "XMonad.Layout.TwoPane" or +-- "XMonad.Layout.Mosaic" with three or four panes. See also +-- "XMonad.Actions.RotSlaves" for related actions. +----------------------------------------------------------------------------- +module XMonad.Actions.CycleWindows ( + -- * Usage + -- $usage + + -- * Cycling nearby or nth window into current frame + -- $cycle + cycleRecentWindows, + cycleStacks', + -- * Cycling half the stack to get rid of a boring window + -- $opposite + rotOpposite', rotOpposite, + -- * Cycling windows through the current frame + -- $focused + rotFocused', rotFocusedUp, rotFocusedDown, shiftToFocus', + -- * Cycling windows through other frames + -- $unfocused + rotUnfocused', rotUnfocusedUp, rotUnfocusedDown, + -- * Updating the mouse pointer + -- $pointer + + -- * Generic list rotations + -- $generic + rotUp, rotDown +) where + +import XMonad +import qualified XMonad.StackSet as W +import XMonad.Actions.RotSlaves + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Actions.CycleWindows +-- > -- config +-- > -- other key bindings with x here your config +-- > +-- > -- make sure mod matches keysym +-- > , ((mod4Mask, xK_s), cycleRecentWindows [xK_Super_L] xK_s xK_w) +-- > , ((modMask x, xK_z), rotOpposite) +-- > , ((modMask x , xK_i), rotUnfocusedUp) +-- > , ((modMask x , xK_u), rotUnfocusedDown) +-- > , ((modMask x .|. controlMask, xK_i), rotFocusedUp) +-- > , ((modMask x .|. controlMask, xK_u), rotFocusedDown) +-- +-- Also, if you use focus follows mouse, you will want to read the section +-- on updating the mouse pointer below. For detailed instructions on +-- editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". +{- $pointer +With FocusFollowsMouse == True, the focus is updated after binding +actions, possibly focusing a window you didn't intend to focus. Most +people using TwoPane probably already have a logHook causing the mouse +to follow focus. (See "XMonad.Actions.UpdatePointer", or "XMonad.Actions.Warp") + +If you want this built into the key binding instead, use the appropriate +action from one of those modules to also have your bindings move the pointer +to the point of your choice on the current window: + +> import XMonad.Actions.UpdatePointer -- or Actions.Warp + +and either + +> -- modify the window rotation bindings +> , ((modMask x .|. controlMask, xK_i ), rotFocusedUp +> >> updatePointer (Relative 1 1)) +> , ((modMask x .|. controlMask, xK_u ), rotFocusedDown +> >> updatePointer (Relative 1 1)) +> +> -- or add to xmonad's logHook +> , logHook = dynamicLogWithPP xmobarPP +> >> updatePointer Nearest -- or your preference + +-} + +-- $cycle +-- Cycle windows into focus from below or above the focused pane by pressing +-- a key while one or more modifier keys is held down. The window order isn't +-- changed until a modifier is released, leaving the previously focused window +-- just below the new one, (or above if the window just above is chosen.) For +-- best results use the same modifier + key combination as the one used to invoke +-- the \"bring from below\" action. Also, once cycling, pressing a number key n +-- will focus the nth window, with 0 being the one originally focused. +cycleRecentWindows :: [KeySym] -- ^ A list of modifier keys used when invoking this action. + -- As soon as one of them is released, the final switch is made. + -> KeySym -- ^ Key used to shift windows from below the current choice into the current frame. + -> KeySym -- ^ Key used to shift windows from above the current choice into the current frame. + -- If it's the same as the first key, it is effectively ignored. + -> X () +cycleRecentWindows = cycleStacks' stacks where + stacks s = map (shiftToFocus' `flip` s) (wins s) + wins (W.Stack t l r) = t : r ++ reverse l + + +-- | Cycle through a /finite/ list of window stacks with repeated presses +-- of a key while a modifier key is held down. For best results use the same +-- mod key + key combination as the one used to invoke the \"bring from below\" +-- action. You could use cycleStacks' with a different stack permutations +-- function to, for example, cycle from one below to one above to two below, +-- etc. instead of in order. You are responsible for having it generate a +-- finite list, though, or xmonad may hang seeking its length. +cycleStacks' :: (W.Stack Window -> [W.Stack Window]) -- ^ A function to a finite list of permutations of a given stack. + -> [KeySym] -- ^ A list of modifier keys used to invoke 'cycleStacks''. + -- As soon as any is released, we're no longer cycling on the [Stack Window] + -> KeySym -- ^ Key used to select a \"next\" stack. + -> KeySym -- ^ Key used to select a \"previous\" stack. + -> X () +cycleStacks' filteredPerms mods keyNext keyPrev = do + XConf {theRoot = root, display = d} <- ask + stacks <- gets $ maybe [] filteredPerms . W.stack . W.workspace . W.current . windowset + + let evt = allocaXEvent $ + \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p + KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p + s <- keycodeToKeysym d c 0 + return (t, s) + choose n (t, s) + | t == keyPress && s == keyNext = io evt >>= choose (n+1) + | t == keyPress && s == keyPrev = io evt >>= choose (n-1) + | t == keyPress && s `elem` [xK_0..xK_9] = io evt >>= choose (numKeyToN s) + | t == keyRelease && s `elem` mods = return () + | otherwise = doStack n >> io evt >>= choose n + doStack n = windows . W.modify' . const $ stacks `cycref` n + + io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime + io evt >>= choose 1 + io $ ungrabKeyboard d currentTime + where cycref l i = l !! (i `mod` length l) -- modify' ensures l is never [], but must also be finite + numKeyToN = subtract 48 . read . show + +-- | Given a stack element and a stack, shift or insert the element (window) +-- at the currently focused position. +shiftToFocus' :: (Eq a, Show a, Read a) => a -> W.Stack a -> W.Stack a +shiftToFocus' w s@(W.Stack _ ls _) = W.Stack w (reverse revls') rs' + where (revls', rs') = splitAt (length ls) . filter (/= w) $ W.integrate s + + +-- $opposite +-- Shifts the focused window as far as possible from the current focus, +-- i.e. halfway around the stack. Windows above the focus up to the \"opposite\" +-- position remain in place, while those above the insertion shift toward +-- the current focus. This is useful for people who use lots of windows in Full, +-- TwoPane, etc., to get rid of boring windows while cycling and swapping +-- near the focus. +rotOpposite :: X() +rotOpposite = windows $ W.modify' rotOpposite' + +-- | The opposite rotation on a Stack. +rotOpposite' :: W.Stack a -> W.Stack a +rotOpposite' (W.Stack t l r) = W.Stack t' l' r' + where rrvl = r ++ reverse l + part = (length rrvl + 1) `div` 2 + (l',t':r') = (\(f,s) -> (f, reverse s)) . splitAt (length l) $ + reverse (take part rrvl ++ t : drop part rrvl) + + +-- $focused +-- Rotate windows through the focused frame, excluding the \"next\" window. +-- With, e.g. TwoPane, this allows cycling windows through either the +-- master or slave pane, without changing the other frame. When the master +-- is focused, the window below is skipped, when a non-master window is +-- focused, the master is skipped. +rotFocusedUp :: X () +rotFocusedUp = windows . W.modify' $ rotFocused' rotUp +rotFocusedDown :: X () +rotFocusedDown = windows . W.modify' $ rotFocused' rotDown + +-- | The focused rotation on a stack. +rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a +rotFocused' _ s@(W.Stack _ [] []) = s +rotFocused' f (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus + where (t':rs') = f (t:rs) +rotFocused' f s@(W.Stack _ _ _) = rotSlaves' f s -- otherwise + + +-- $unfocused +-- Rotate windows through the unfocused frames. This is similar to +-- rotSlaves, from "XMonad.Actions.RotSlaves", but excludes the current +-- frame rather than master. +rotUnfocusedUp :: X () +rotUnfocusedUp = windows . W.modify' $ rotUnfocused' rotUp +rotUnfocusedDown :: X () +rotUnfocusedDown = windows . W.modify' $ rotUnfocused' rotDown + +-- | The unfocused rotation on a stack. +rotUnfocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a +rotUnfocused' _ s@(W.Stack _ [] []) = s +rotUnfocused' f s@(W.Stack _ [] _ ) = rotSlaves' f s -- Master has focus +rotUnfocused' f (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwise + where (master:revls) = reverse ls + (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs) + +-- $generic +-- Generic list rotations +rotUp :: [a] -> [a] +rotUp l = tail l ++ [head l] +rotDown :: [a] -> [a] +rotDown l = last l : init l hunk ./xmonad-contrib.cabal 78 + XMonad.Actions.CycleWindows hunk ./XMonad/Util/EZConfig.hs 219 --- > --- > --- > --- > --- > --- > --- > --- > --- > --- > +-- > - +-- +-- Long list of multimedia keys. Please note that not all keys may be +-- present in your particular setup althrough most likely they will do. +-- +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > -, - +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > +-- > - +-- > +-- > +-- > +-- > hunk ./XMonad/Util/EZConfig.hs 425 -keyNames = functionKeys ++ specialKeys +keyNames = functionKeys ++ specialKeys ++ multimediaKeys hunk ./XMonad/Util/EZConfig.hs 498 +-- | List of multimedai keys. If X server does not know about some +-- | keysym it's omitted from list. (stringToKeysym returns noSymbol in this case) +multimediaKeys :: [(String, KeySym)] +multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $ + [ "XF86ModeLock" + , "XF86MonBrightnessUp" + , "XF86MonBrightnessDown" + , "XF86KbdLightOnOff" + , "XF86KbdBrightnessUp" + , "XF86KbdBrightnessDown" + , "XF86Standby" + , "XF86AudioLowerVolume" + , "XF86AudioMute" + , "XF86AudioRaiseVolume" + , "XF86AudioPlay" + , "XF86AudioStop" + , "XF86AudioPrev" + , "XF86AudioNext" + , "XF86HomePage" + , "XF86Mail" + , "XF86Start" + , "XF86Search" + , "XF86AudioRecord" + , "XF86Calculator" + , "XF86Memo" + , "XF86ToDoList" + , "XF86Calendar" + , "XF86PowerDown" + , "XF86ContrastAdjust" + , "XF86RockerUp" + , "XF86RockerDown" + , "XF86RockerEnter" + , "XF86Back" + , "XF86Forward" + , "XF86Stop" + , "XF86Refresh" + , "XF86PowerOff" + , "XF86WakeUp" + , "XF86Eject" + , "XF86ScreenSaver" + , "XF86WWW" + , "XF86Sleep" + , "XF86Favorites" + , "XF86AudioPause" + , "XF86AudioMedia" + , "XF86MyComputer" + , "XF86VendorHome" + , "XF86LightBulb" + , "XF86Shop" + , "XF86History" + , "XF86OpenURL" + , "XF86AddFavorite" + , "XF86HotLinks" + , "XF86BrightnessAdjust" + , "XF86Finance" + , "XF86Community" + , "XF86AudioRewind" + , "XF86BackForward" + , "XF86Launch0" + , "XF86Launch1" + , "XF86Launch2" + , "XF86Launch3" + , "XF86Launch4" + , "XF86Launch5" + , "XF86Launch6" + , "XF86Launch7" + , "XF86Launch8" + , "XF86Launch9" + , "XF86LaunchA" + , "XF86LaunchB" + , "XF86LaunchC" + , "XF86LaunchD" + , "XF86LaunchE" + , "XF86LaunchF" + , "XF86ApplicationLeft" + , "XF86ApplicationRight" + , "XF86Book" + , "XF86CD" + , "XF86Calculater" + , "XF86Clear" + , "XF86Close" + , "XF86Copy" + , "XF86Cut" + , "XF86Display" + , "XF86DOS" + , "XF86Documents" + , "XF86Excel" + , "XF86Explorer" + , "XF86Game" + , "XF86Go" + , "XF86iTouch" + , "XF86LogOff" + , "XF86Market" + , "XF86Meeting" + , "XF86MenuKB" + , "XF86MenuPB" + , "XF86MySites" + , "XF86New" + , "XF86News" + , "XF86OfficeHome" + , "XF86Open" + , "XF86Option" + , "XF86Paste" + , "XF86Phone" + , "XF86Q" + , "XF86Reply" + , "XF86Reload" + , "XF86RotateWindows" + , "XF86RotationPB" + , "XF86RotationKB" + , "XF86Save" + , "XF86ScrollUp" + , "XF86ScrollDown" + , "XF86ScrollClick" + , "XF86Send" + , "XF86Spell" + , "XF86SplitScreen" + , "XF86Support" + , "XF86TaskPane" + , "XF86Terminal" + , "XF86Tools" + , "XF86Travel" + , "XF86UserPB" + , "XF86User1KB" + , "XF86User2KB" + , "XF86Video" + , "XF86WheelButton" + , "XF86Word" + , "XF86Xfer" + , "XF86ZoomIn" + , "XF86ZoomOut" + , "XF86Away" + , "XF86Messenger" + , "XF86WebCam" + , "XF86MailForward" + , "XF86Pictures" + , "XF86Music" + , "XF86_Switch_VT_1" + , "XF86_Switch_VT_2" + , "XF86_Switch_VT_3" + , "XF86_Switch_VT_4" + , "XF86_Switch_VT_5" + , "XF86_Switch_VT_6" + , "XF86_Switch_VT_7" + , "XF86_Switch_VT_8" + , "XF86_Switch_VT_9" + , "XF86_Switch_VT_10" + , "XF86_Switch_VT_11" + , "XF86_Switch_VT_12" + , "XF86_Ungrab" + , "XF86_ClearGrab" + , "XF86_Next_VMode" + , "XF86_Prev_VMode" ] + hunk ./XMonad/Util/EZConfig.hs 498 --- | List of multimedai keys. If X server does not know about some +-- | List of multimedia keys. If X server does not know about some hunk ./XMonad/Layout/Mosaic.hs 24 + ,growMaster + ,shrinkMaster hunk ./XMonad/Layout/Mosaic.hs 45 --- > myLayouts = Mosaic [4..12] ||| Full ||| etc.. +-- > myLayouts = Mosaic (take 5 $ iterate (*0.7) 1 ||| Mosaic [3,1,1,1,1,1] ||| Full ||| etc.. hunk ./XMonad/Layout/Mosaic.hs 75 - determine the relative sizes of the windows. If the numbers are all - the same, then the layout looks like Grid. An increasing list results - in the master window being the largest. Only as many windows are - displayed as there are elements in that list + determine the relative areas that the windows receive. The first + number represents the size of the master window, the second is for the + next window in the stack, and so on. hunk ./XMonad/Layout/Mosaic.hs 113 --- | These sample functions scale the ratios of successive windows, other --- variations could also be useful. +-- | These sample functions are meant to be applied to the list of window sizes +-- through the 'SlopeMod' message. hunk ./XMonad/Layout/Mosaic.hs 116 --- The windows in each position of the stack should correspond to a specific --- element of the list, so it should be possible to resize individual windows, --- though it is not yet provided. +-- Steeper and shallower scale the ratios of successive windows. +-- +-- growMaster and shrinkMaster just increase and decrease the size of the first +-- element, and thus they change the layout very similarily to the standard +-- 'Expand' or 'Shrink' for the 'Tall' layout. +-- +-- It may be possible to resize the specific focused window; however the same +-- result could probably be achieved by promoting it, or moving it to a higher +-- place in the list of windows; when you have a decreasing list of window +-- sizes, the change in position will also result in a change in size. + hunk ./XMonad/Layout/Mosaic.hs 129 -steeper (x:xs) = map (subtract (x*0.8)) (x:xs) +steeper xs = map (subtract (minimum xs*0.8)) xs hunk ./XMonad/Layout/Mosaic.hs 133 -shallower (x:xs) = map (+(x/0.8)) (x:xs) +shallower xs = map (+(minimum xs*2)) xs hunk ./XMonad/Layout/Mosaic.hs 135 -splits :: Int -> Rectangle -> [Rational] -> [[Rectangle]] -splits num rect sz = splitsL rect $ makeTree $ normalize $ take num sz +growMaster :: [Rational] -> [Rational] +growMaster [] = [] +growMaster (x:xs) = 2*x:xs hunk ./XMonad/Layout/Mosaic.hs 139 -normalize :: Fractional a => [a] -> [a] -normalize x = let s = sum x - in map (/s) x +shrinkMaster :: [Rational] -> [Rational] +shrinkMaster [] = [] +shrinkMaster (x:xs) = x/2:xs + +splits :: Int -> Rectangle -> [Rational] -> [[Rectangle]] +splits num rect sz = splitsL rect $ makeTree $ normalize $ reverse $ take num sz hunk ./XMonad/Layout/Mosaic.hs 155 +-- like zipWith (++), but when one list is shorter, its elements are duplicated +-- so that they match hunk ./XMonad/Layout/Mosaic.hs 171 +normalize :: Fractional a => [a] -> [a] +normalize x = let s = sum x + in map (/s) x + hunk ./XMonad/Layout/Mosaic.hs 196 - hunk ./XMonad/Hooks/ManageDocks.hs 30 +import XMonad.Util.WindowProperties (getProp32s) hunk ./XMonad/Hooks/ManageDocks.hs 104 - a <- getAtom "_NET_WM_WINDOW_TYPE" hunk ./XMonad/Hooks/ManageDocks.hs 106 - mbr <- getProp a w + mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w hunk ./XMonad/Hooks/ManageDocks.hs 114 - spa <- getAtom "_NET_WM_STRUT_PARTIAL" - sa <- getAtom "_NET_WM_STRUT" - msp <- getProp spa w + msp <- getProp32s "_NET_WM_STRUT_PARTIAL" w hunk ./XMonad/Hooks/ManageDocks.hs 117 - Nothing -> fmap (maybe [] parseStrut) $ getProp sa w + Nothing -> fmap (maybe [] parseStrut) $ getProp32s "_NET_WM_STRUT" w hunk ./XMonad/Hooks/ManageDocks.hs 127 --- | Helper to read a property -getProp :: Atom -> Window -> X (Maybe [CLong]) -getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w - hunk ./XMonad/Hooks/ManageHelpers.hs 49 +import XMonad.Util.WindowProperties (getProp32s) hunk ./XMonad/Hooks/ManageHelpers.hs 121 - dpy <- asks display - kde_tray <- getAtom "_KDE_NET_WM_SYSTEM_TRAY_WINDOW_FOR" - r <- io $ getWindowProperty32 dpy kde_tray w + r <- getProp32s "_KDE_NET_WM_SYSTEM_TRAY_WINDOW_FOR" w hunk ./XMonad/Hooks/ManageHelpers.hs 129 - dpy <- asks display - pa <- getAtom p hunk ./XMonad/Hooks/ManageHelpers.hs 130 - r <- io $ getWindowProperty32 dpy pa w + r <- getProp32s p w hunk ./XMonad/Hooks/ManageHelpers.hs 146 - dpy <- asks display - a <- getAtom "_NET_WM_PID" - p <- io $ getWindowProperty32 dpy a w + p <- getProp32s "_NET_WM_PID" w hunk ./XMonad/Util/WindowProperties.hs 18 + getProp32, getProp32s, hunk ./XMonad/Util/WindowProperties.hs 23 +import Foreign.C.Types (CLong) hunk ./XMonad/Util/WindowProperties.hs 83 + +-- | Get a window property from atom +getProp32 :: Atom -> Window -> X (Maybe [CLong]) +getProp32 a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w + +-- | Get a window property from string +getProp32s :: String -> Window -> X (Maybe [CLong]) +getProp32s str w = do { a <- getAtom str; getProp32 a w } hunk ./XMonad/Util/WindowProperties.hs 11 --- EDSL for specifying window properties, such as title, classname or resource. +-- EDSL for specifying window properties; various utilities related to window +-- properties. hunk ./XMonad/Util/WindowProperties.hs 16 - -- * Usage - -- $usage + -- * EDSL for window properties + -- $edsl hunk ./XMonad/Util/WindowProperties.hs 19 - getProp32, getProp32s, - propertyToQuery) + propertyToQuery, + -- * Helper functions + -- $helpers + getProp32, getProp32s) hunk ./XMonad/Util/WindowProperties.hs 29 --- $usage --- This module allows to specify window properties, such as title, classname or +-- $edsl +-- Allows to specify window properties, such as title, classname or hunk ./XMonad/Util/WindowProperties.hs 87 +-- $helpers + hunk ./XMonad/Hooks/EwmhDesktops.hs 155 -handle _ = undefined -- does not happen, as otherwise ewmhDesktopsHook would not match +handle _ = return () addfile ./XMonad/Layout/Cross.hs hunk ./XMonad/Layout/Cross.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +-- | +-- Module : XMonad.Layout.Cross +-- Copyright : (c) Luis Cabellos +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Luis Cabellos +-- Stability : stable +-- Portability : portable +-- +-- A Cross Layout with a main window in the center. +-- +module XMonad.Layout.Cross( + -- * Usage + -- $usage + simpleCross + , Cross(..) ) where + +import XMonad( Dimension, Rectangle(..), LayoutClass(..), Resize(..), fromMessage ) +import XMonad.StackSet( focus, up, down ) +import Control.Monad( msum ) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Cross +-- +-- Then edit your @layoutHook@ by adding the Spiral layout: +-- +-- > myLayouts = simpleCross ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- + +-- apply a factor to a Rectangle Dimension +(<%>) :: Dimension -> Rational -> Dimension +d <%> f = floor $ f * (fromIntegral d) + +-- | The Cross Layout draw the focused window on the center of the screen +-- and part of the other windows on the sides. The 'Shrink' and 'Expand' +-- messages increment the size of the main window. +-- +-- With the focus keys you change the window on the center and the other +-- windows put itself on the sides in a cycle way. +-- +-- e.g: focus down put down[0] on focus, focus up put up[0] on +-- focus. +-- +-- Only five windows are shown in the Cross Layout, focus two ups and two +-- downs. Everything else is hide. +data Cross a = Cross + !Rational -- ^ Proportion of screen occupies for main window. + !Rational -- ^ Percent of main window to increment by when resizing. + deriving( Show, Read ) + +-- | A simple Cross Layout. It has a main window with focused windos on the center. +-- The proportion of screen of main window is 3\/4. +simpleCross :: Cross a +simpleCross = Cross (4/5) (1/100) + +instance LayoutClass Cross a where + pureLayout (Cross f _) r s = [(focus s, mainRect r f)] ++ + (zip winCycle (upRects r f)) ++ + (zip (reverse winCycle) (downRects r f)) + where winCycle = (up s) ++ (reverse (down s)) + + pureMessage (Cross f d) m = msum [fmap resize (fromMessage m)] + where resize Shrink = Cross (max (1/100) $ f - d) d + resize Expand = Cross (min 1 $ f + d) d + + description _ = "Cross" + +-- get the Rectangle for the focused window +mainRect :: Rectangle -> Rational -> Rectangle +mainRect (Rectangle rx ry rw rh) f = Rectangle + (rx + (fromIntegral (rw <%> invf))) + (ry + (fromIntegral (rh <%> invf))) + (rw <%> f) (rh <%> f) + where invf = (1/2) * (1-f) + +-- get the rectangles for the up windows +upRects :: Rectangle -> Rational -> [Rectangle] +upRects r f = [topRectangle r nf, rigthRectangle r nf] + where nf = f * (8/10) + +-- get the rectangles for the down windows +downRects :: Rectangle -> Rational -> [Rectangle] +downRects r f = [bottomRectangle r nf, leftRectangle r nf] + where nf = f * (8/10) + +topRectangle :: Rectangle -> Rational -> Rectangle +topRectangle (Rectangle rx ry rw rh) f = Rectangle + (rx + (fromIntegral (rw <%> ((1-f)*(1/2))))) + ry + (rw <%> f) (rh <%> ((1-f)*(1/2))) + +rigthRectangle :: Rectangle -> Rational -> Rectangle +rigthRectangle (Rectangle rx ry rw rh) f = Rectangle + (rx + (fromIntegral (rw - (rw <%> (1/2))))) + (ry + (fromIntegral (rh <%> ((1-f)*(1/2))))) + (rw <%> (1/2)) (rh <%> f) + +bottomRectangle :: Rectangle -> Rational -> Rectangle +bottomRectangle (Rectangle rx ry rw rh) f = Rectangle + (rx + (fromIntegral (rw <%> ((1-f)*(1/2))))) + (ry + (fromIntegral (rh - (rh <%> ((1-f)*(1/2)))))) + (rw <%> f) (rh <%> ((1-f)*(1/2))) + +leftRectangle :: Rectangle -> Rational -> Rectangle +leftRectangle (Rectangle rx ry rw rh) f = Rectangle + rx + (ry + (fromIntegral (rh <%> ((1-f)*(1/2))))) + (rw <%> (1/2)) (rh <%> f) + hunk ./xmonad-contrib.cabal 134 + XMonad.Layout.Cross hunk ./XMonad/Actions/SpawnOn.hs 29 +import Data.List (isInfixOf) hunk ./XMonad/Actions/SpawnOn.hs 104 - p <- spawnPID cmd + p <- spawnPID $ mangle cmd hunk ./XMonad/Actions/SpawnOn.hs 106 + where + -- TODO this is silly, search for a better solution + mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs + | otherwise = "exec " ++ xs + metaChars = "&|;" + hunk ./XMonad/Util/Scratchpad.hs 20 + ,scratchpadSpawnActionCustom hunk ./XMonad/Util/Scratchpad.hs 40 --- Pressing the key with the terminal on the current workspace will +-- Pressing the key with the terminal on the current workspace will hunk ./XMonad/Util/Scratchpad.hs 64 --- +-- hunk ./XMonad/Util/Scratchpad.hs 75 -scratchpadSpawnAction conf = +scratchpadSpawnAction conf = hunk ./XMonad/Util/Scratchpad.hs 82 -scratchpadSpawnActionTerminal term = +scratchpadSpawnActionTerminal term = hunk ./XMonad/Util/Scratchpad.hs 86 +-- | Action to pop up any program with the user specifiying how to set +-- its resource to \"scratchpad\". For example, with gnome-terminal +-- bind the following to a key: +-- +-- > scratchpadSpawnActionCustom "gnome-terminal --name scratchpad" +scratchpadSpawnActionCustom :: String -- ^ Command to spawn a program with resource \"scratchpad\" + -> X () +scratchpadSpawnActionCustom = scratchpadAction . spawn hunk ./XMonad/Util/Scratchpad.hs 95 - --- The heart of the new summon/banish terminal. +-- The heart of the new summon/banish terminal. hunk ./XMonad/Util/Scratchpad.hs 99 --- 2. if the scratchpad is elsewhere, bring it here. +-- 2. if the scratchpad is elsewhere, bring it here. hunk ./XMonad/Util/Scratchpad.hs 102 - filterCurrent <- filterM (runQuery scratchpadQuery) - ( (maybe [] W.integrate - . W.stack - . W.workspace + filterCurrent <- filterM (runQuery scratchpadQuery) + ( (maybe [] W.integrate + . W.stack + . W.workspace hunk ./XMonad/Util/Scratchpad.hs 136 --- eg. +-- e.g., for a terminal 4/10 of the screen width from the left, half +-- the screen height from the top, and 6/10 of the screen width by +-- 3/10 the screen height, use: hunk ./XMonad/Util/Scratchpad.hs 140 --- > scratchpadManageHook (W.RationalRect 0.25 0.375 0.5 0.25) +-- > scratchpadManageHook (W.RationalRect 0.4 0.5 0.6 0.3) hunk ./XMonad/Util/Loggers.hs 86 - output <- hGetLine out + fmap Just (hGetLine out) `catch` (const $ return Nothing) hunk ./XMonad/Util/Loggers.hs 88 - return $ Just output hunk ./XMonad/Actions/SpawnOn.hs 77 - Just w -> doF (W.shift w) hunk ./XMonad/Actions/SpawnOn.hs 78 + Just w -> do + whenJust mp $ \p -> + io . modifyIORef (pidsRef sp) $ filter ((/= p) . fst) + doF (W.shift w) hunk ./XMonad/Actions/SpawnOn.hs 81 - doF (W.shift w) + doShift w hunk ./XMonad/Config/Sjanssen.hs 38 - , manageHook = composeAll [className =? x --> doF (W.shift w) + , manageHook = composeAll [className =? x --> doShift w hunk ./XMonad/Layout/Master.hs 1 -{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-} -{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards #-} hunk ./XMonad/Layout/Master.hs 6 --- Copyright : (c) Lukas Mai +-- Copyright : (c) Ismael Carnales, Lukas Mai hunk ./XMonad/Layout/Master.hs 9 --- Maintainer : +-- Maintainer : Ismael Carnales hunk ./XMonad/Layout/Master.hs 13 --- A layout that adds a distinguished master window to a base layout. +-- Layout modfier that adds a master window to another layout. hunk ./XMonad/Layout/Master.hs 19 - mastered, - Master + + mastered hunk ./XMonad/Layout/Master.hs 24 -import XMonad.StackSet - -import Data.List -import Data.Ord +import qualified XMonad.StackSet as S +import XMonad.Layout.LayoutModifier hunk ./XMonad/Layout/Master.hs 32 --- and add something like +-- Then edit your @layoutHook@ and add the Master modifier to the layout that +-- you prefer. hunk ./XMonad/Layout/Master.hs 37 --- to your layouts. This will use the left half of your screen for a master --- window and let Grid manage the right half. +-- This will use the left half of your screen for a master window and let +-- Grid manage the right half. hunk ./XMonad/Layout/Master.hs 43 --- Like 'XMonad.Layout.Tall', 'Master' supports the 'XMonad.Layout.Shrink' and --- 'XMonad.Layout.Expand' messages. +-- Like 'XMonad.Layout.Tall', 'withMaster' supports the +-- 'XMonad.Layout.Shrink' and XMonad.Layout.Expand' messages. + +-- | Data type for LayoutModifier which converts given layout to a mastered +-- layout +data AddMaster a = AddMaster Rational Rational deriving (Show, Read) hunk ./XMonad/Layout/Master.hs 50 -mastered :: (LayoutClass l a) - => Rational -- ^ @delta@, the ratio of the screen to resize by - -> Rational -- ^ @frac@, what portion of the screen to reserve for the master window - -> l a -- ^ the layout to use for the remaining windows - -> Master l a -mastered d f b = Master d f' b - where - f' = min 1 . max 0 $ f +-- | Modifier wich converts given layout to a mastered one +mastered :: (LayoutClass l a) => + Rational -- ^ @delta@, the ratio of the screen to resize by + -> Rational -- ^ @frac@, what portion of the screen to use for the master window + -> l a -- ^ the layout to be modified + -> ModifiedLayout AddMaster l a +mastered delta frac = ModifiedLayout $ AddMaster delta frac hunk ./XMonad/Layout/Master.hs 58 -data Master l a = - Master{ - delta :: Rational, - frac :: Rational, - base :: l a - } deriving (Show, Read, Eq, Ord) +instance LayoutModifier AddMaster Window where + modifyLayout (AddMaster delta frac) = applyMaster delta frac + modifierDescription _ = "Mastered" hunk ./XMonad/Layout/Master.hs 62 -extractMaster :: Stack a -> (a, Maybe (Stack a)) -extractMaster (Stack x ls rs) = case reverse ls of - [] -> (x, differentiate rs) - (m : ls') -> (m, Just $ Stack x (reverse ls') rs) + pureMess (AddMaster delta frac) m + | Just Shrink <- fromMessage m = Just $ AddMaster delta (frac-delta) + | Just Expand <- fromMessage m = Just $ AddMaster delta (frac+delta) hunk ./XMonad/Layout/Master.hs 66 -area :: Rectangle -> Dimension -area r = rect_width r * rect_height r + pureMess _ _ = Nothing hunk ./XMonad/Layout/Master.hs 68 -chop :: D -> Rectangle -> Rectangle -chop (w, h) (Rectangle rx ry rw rh) = - let - r' = maximumBy (comparing area) - [ Rectangle rx (ry + fromIntegral h) rw (rh - h) - , Rectangle (rx + fromIntegral w) ry (rw - w) rh] - in - r'{ rect_width = max 0 $ rect_width r', rect_height = max 0 $ rect_height r' } +-- | Internal function for adding a master window and let the modified +-- layout handle the rest of the windows +applyMaster :: (LayoutClass l Window) => + Rational + -> Rational + -> S.Workspace WorkspaceId (l Window) Window + -> Rectangle + -> X ([(Window, Rectangle)], Maybe (l Window)) +applyMaster _ frac wksp rect = do + let st= S.stack wksp + let ws = S.integrate' $ st + if length ws > 2 then do + let m = head ws + let (mr, sr) = splitHorizontallyBy frac rect + let nst = st>>= S.filter (m/=) + wrs <- runLayout (wksp {S.stack = nst}) sr + return ((m, mr) : fst wrs, snd wrs) hunk ./XMonad/Layout/Master.hs 86 -instance (LayoutClass l Window) => LayoutClass (Master l) Window where - description m = "Master " ++ description (base m) - handleMessage m msg - | Just Shrink <- fromMessage msg = - return . Just $ m{ frac = max 0 $ frac m - delta m } - | Just Expand <- fromMessage msg = - return . Just $ m{ frac = min 1 $ frac m + delta m } - | otherwise = - fmap (fmap (\x -> m{ base = x })) $ handleMessage (base m) msg - runLayout ws rect = do - (f, ws', rect') <- case fmap extractMaster $ stack ws of - Nothing -> - return (id, ws, rect) - Just (x, Nothing) -> do - f <- mkAdjust x - let - (w', h') = f (rect_width rect, rect_height rect) - xr = rect{ rect_width = w', rect_height = h' } - return (((x, xr) :), ws{ stack = Nothing }, Rectangle (rect_x xr + fromIntegral w') (rect_y xr) 0 0) - Just (x, Just st) -> do - f <- mkAdjust x - let - d@(w', h') = f (scale $ rect_width rect, rect_height rect) - xr = rect{ rect_width = w', rect_height = h' } - return (((x, xr) :), ws{ stack = Just st }, chop d rect) - (y, l) <- runLayout ws'{ layout = base m } rect' - return (f y, fmap (\x -> m{ base = x }) l) - where - m = layout ws - scale = round . (* frac m) . fromIntegral + else runLayout wksp rect hunk ./XMonad/Layout/Cross.hs 42 --- +-- hunk ./XMonad/Layout/Cross.hs 51 -data Cross a = Cross - !Rational -- ^ Proportion of screen occupies for main window. - !Rational -- ^ Percent of main window to increment by when resizing. +data Cross a = Cross { + crossProp :: !Rational, -- ^ Proportion of screen occupies for main window. + crossInc :: !Rational -- ^ Percent of main window to increment by when resizing. + } hunk ./XMonad/Util/Run.hs 36 -import Control.Exception (try) +import Control.Exception (try) -- use OldException with base 4 hunk ./XMonad/Util/Run.hs 38 -import System.Process (runInteractiveProcess, waitForProcess) +import System.Process (runInteractiveProcess) hunk ./XMonad/Util/Run.hs 71 - (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing + (pin, pout, perr, _) <- runInteractiveProcess cmd args Nothing Nothing hunk ./XMonad/Util/Run.hs 78 - waitForProcess ph + -- no need to waitForProcess, we ignore SIGCHLD addfile ./XMonad/Layout/IndependentScreens.hs hunk ./XMonad/Layout/IndependentScreens.hs 1 +module IndependentScreens where + +marshall (S sc) ws = show sc ++ '_':ws +unmarshall = ((S . read) *** drop 1) . break (=='_') +workspaces' = nub . map (snd . unmarshall) . workspaces +withScreens n workspaces = [marshall sc ws | ws <- workspaces, sc <- [0..n-1]] +onScreen f workspace = screen . current >>= f . flip marshall workspace +countScreens = fmap genericLength $ openDisplay "" >>= getScreenInfo hunk ./XMonad/Layout/IndependentScreens.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.IndependentScreens +-- Copyright : (c) 2009 Daniel Wagner +-- License : BSD3 +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Utility functions for simulating independent sets of workspaces on +-- each screen (like dwm's workspace model), using internal tags to +-- distinguish workspaces associated with each screen. +----------------------------------------------------------------------------- + hunk ./XMonad/Layout/IndependentScreens.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonad.Layout.IndependentScreens --- Copyright : (c) 2009 Daniel Wagner --- License : BSD3 --- --- Maintainer : --- Stability : unstable --- Portability : unportable --- --- Utility functions for simulating independent sets of workspaces on --- each screen (like dwm's workspace model), using internal tags to --- distinguish workspaces associated with each screen. ------------------------------------------------------------------------------ - hunk ./XMonad/Layout/IndependentScreens.hs 3 -marshall (S sc) ws = show sc ++ '_':ws -unmarshall = ((S . read) *** drop 1) . break (=='_') -workspaces' = nub . map (snd . unmarshall) . workspaces -withScreens n workspaces = [marshall sc ws | ws <- workspaces, sc <- [0..n-1]] -onScreen f workspace = screen . current >>= f . flip marshall workspace -countScreens = fmap genericLength $ openDisplay "" >>= getScreenInfo +-- for the screen stuff +import Control.Arrow hiding ((|||)) +import Control.Monad +import Control.Monad.Instances +import Data.List +import Graphics.X11.Xinerama +import XMonad +import XMonad.StackSet hiding (workspaces) + +type VirtualWorkspace = String +type PhysicalWorkspace = String + +marshall :: ScreenId -> VirtualWorkspace -> PhysicalWorkspace +marshall (S sc) vws = show sc ++ '_':vws + +unmarshall :: PhysicalWorkspace -> (ScreenId, VirtualWorkspace) +unmarshall = ((S . read) *** drop 1) . break (=='_') + +workspaces' :: XConfig l -> [VirtualWorkspace] +workspaces' = nub . map (snd . unmarshall) . workspaces + +withScreens :: ScreenId -> [VirtualWorkspace] -> [PhysicalWorkspace] +withScreens n vws = [marshall sc pws | pws <- vws, sc <- [0..n-1]] + +onScreen :: (VirtualWorkspace -> WindowSet -> a) -> (PhysicalWorkspace -> WindowSet -> a) +onScreen f vws = screen . current >>= f . flip marshall vws + +countScreens :: (MonadIO m, Integral i) => m i +countScreens = liftM genericLength . liftIO $ openDisplay "" >>= getScreenInfo hunk ./xmonad-contrib.cabal 148 + XMonad.Layout.IndependentScreens hunk ./XMonad/Layout/IndependentScreens.hs 1 -module IndependentScreens where +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.IndependentScreens +-- Copyright : (c) 2009 Daniel Wagner +-- License : BSD3 +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Utility functions for simulating independent sets of workspaces on +-- each screen (like dwm's workspace model), using internal tags to +-- distinguish workspaces associated with each screen. +----------------------------------------------------------------------------- + +module XMonad.Layout.IndependentScreens where hunk ./XMonad/Layout/BoringWindows.hs 18 - -- * Usage - -- $usage hunk ./XMonad/Layout/IndependentScreens.hs 16 -module XMonad.Layout.IndependentScreens where +module XMonad.Layout.IndependentScreens ( + -- * Usage + -- $usage + VirtualWorkspace, PhysicalWorkspace, + workspaces', + withScreens, onCurrentScreen, + countScreens, + marshall, unmarshall +) where hunk ./XMonad/Layout/IndependentScreens.hs 35 -type VirtualWorkspace = String -type PhysicalWorkspace = String +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.IndependentScreens +-- +-- You can define your workspaces by calling @withScreens@: +-- +-- > myConfig = defaultConfig { workspaces = withScreens 2 ["web", "email", "irc"] } +-- +-- This will create \"physical\" workspaces with distinct internal names for +-- each (screen, virtual workspace) pair. +-- +-- Then edit any keybindings that use the list of workspaces or refer +-- to specific workspace names. In the default configuration, only +-- the keybindings for changing workspace do this: +-- +-- > [((m .|. modMask, k), windows $ f i) +-- > | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9] +-- > , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] +-- +-- This should change to +-- +-- > [((m .|. modMask, k), windows $ onCurrentScreen f i) +-- > | (i, k) <- zip (workspaces' conf) [xK_1 .. xK_9] +-- > , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] +-- +-- In particular, the analogue of @XMonad.workspaces@ is +-- @workspaces'@, and you can use @onCurrentScreen@ to convert functions +-- of virtual workspaces to functions of physical workspaces, which work +-- by marshalling the virtual workspace name and the currently focused +-- screen into a physical workspace name. + +type VirtualWorkspace = WorkspaceId +type PhysicalWorkspace = WorkspaceId hunk ./XMonad/Layout/IndependentScreens.hs 76 +-- ^ You shouldn't need to use @marshall@ and @unmarshall@ very much. +-- They simply convert between the physical and virtual worlds. For +-- example, you might want to use them as part of a status bar +-- configuration. The function @snd . unmarshall@ would discard the +-- screen information from an otherwise unsightly workspace name. + hunk ./XMonad/Layout/IndependentScreens.hs 85 -withScreens :: ScreenId -> [VirtualWorkspace] -> [PhysicalWorkspace] +withScreens :: ScreenId -- ^ The number of screens to make workspaces for + -> [VirtualWorkspace] -- ^ The desired virtual workspace names + -> [PhysicalWorkspace] -- ^ A list of all internal physical workspace names hunk ./XMonad/Layout/IndependentScreens.hs 90 -onScreen :: (VirtualWorkspace -> WindowSet -> a) -> (PhysicalWorkspace -> WindowSet -> a) -onScreen f vws = screen . current >>= f . flip marshall vws +onCurrentScreen :: (VirtualWorkspace -> WindowSet -> a) -> (PhysicalWorkspace -> WindowSet -> a) +onCurrentScreen f vws = screen . current >>= f . flip marshall vws hunk ./XMonad/Layout/IndependentScreens.hs 93 +-- | In case you don't know statically how many screens there will be, you can call this in main before starting xmonad. For example, part of my config reads +-- +-- > main = do +-- > nScreens <- countScreens +-- > xmonad $ defaultConfig { +-- > ... +-- > workspaces = withScreens nScreens (workspaces defaultConfig), +-- > ... +-- > } +-- hunk ./XMonad/Layout/Cross.hs 12 --- A Cross Layout with a main window in the center. +-- A Cross Layout with the main window in the center. hunk ./XMonad/Layout/Cross.hs 29 --- Then edit your @layoutHook@ by adding the Spiral layout: +-- Then edit your @layoutHook@ by adding one of the Cross layouts: hunk ./XMonad/Layout/Cross.hs 39 --- | The Cross Layout draw the focused window on the center of the screen +-- | The Cross Layout draws the focused window in the center of the screen hunk ./XMonad/Layout/Cross.hs 42 --- --- With the focus keys you change the window on the center and the other --- windows put itself on the sides in a cycle way. hunk ./XMonad/Layout/Cross.hs 43 --- e.g: focus down put down[0] on focus, focus up put up[0] on --- focus. --- --- Only five windows are shown in the Cross Layout, focus two ups and two --- downs. Everything else is hide. +-- The focus keybindings change the center window, while other windows +-- cycle through the side positions. With the Cross layout only four +-- windows are shown around the focused window, two ups and two downs, +-- no matter how many are in the current stack. I.e. focus down cycles the +-- window below focused into the center; focus up cycles the window above. hunk ./XMonad/Layout/Cross.hs 49 - crossProp :: !Rational, -- ^ Proportion of screen occupies for main window. + crossProp :: !Rational, -- ^ Proportion of screen occupied by the main window. hunk ./XMonad/Layout/Cross.hs 54 --- | A simple Cross Layout. It has a main window with focused windos on the center. --- The proportion of screen of main window is 3\/4. +-- | A simple Cross Layout. It places the focused window in the center. +-- The proportion of the screen used by the main window is 4\/5. hunk ./XMonad/Layout/Cross.hs 60 - pureLayout (Cross f _) r s = [(focus s, mainRect r f)] ++ + pureLayout (Cross f _) r s = [(focus s, mainRect r f)] ++ hunk ./XMonad/Layout/Cross.hs 74 - (rx + (fromIntegral (rw <%> invf))) + (rx + (fromIntegral (rw <%> invf))) hunk ./XMonad/Layout/Cross.hs 81 -upRects r f = [topRectangle r nf, rigthRectangle r nf] +upRects r f = [topRectangle r nf, rightRectangle r nf] hunk ./XMonad/Layout/Cross.hs 90 -topRectangle (Rectangle rx ry rw rh) f = Rectangle +topRectangle (Rectangle rx ry rw rh) f = Rectangle hunk ./XMonad/Layout/Cross.hs 92 - ry + ry hunk ./XMonad/Layout/Cross.hs 95 -rigthRectangle :: Rectangle -> Rational -> Rectangle -rigthRectangle (Rectangle rx ry rw rh) f = Rectangle +rightRectangle :: Rectangle -> Rational -> Rectangle +rightRectangle (Rectangle rx ry rw rh) f = Rectangle hunk ./XMonad/Layout/Cross.hs 102 -bottomRectangle (Rectangle rx ry rw rh) f = Rectangle +bottomRectangle (Rectangle rx ry rw rh) f = Rectangle hunk ./XMonad/Hooks/ManageHelpers.hs 31 + isInProperty, hunk ./XMonad/Hooks/DynamicLog.hs 42 - xmobarColor, dzenColor, dzenEscape, + xmobarColor, dzenColor, dzenEscape, dzenStrip, hunk ./XMonad/Hooks/DynamicLog.hs 335 +-- | Strip dzen formatting (used in ppUrgent) +dzenStrip :: String -> String +dzenStrip = strip [] where + strip keep [] = keep + strip keep ('^':'^':x) = strip (keep ++ "^") x + strip keep ('^':x) = strip keep (drop 1 . dropWhile (')' /=) $ x) + strip keep x = let (good,x') = span ('^' /=) x + in strip (keep ++ good) x' + + + hunk ./XMonad/Hooks/DynamicLog.hs 435 - , ppUrgent = dzenColor "red" "yellow" + , ppUrgent = dzenColor "red" "yellow" . dzenStrip hunk ./XMonad/Hooks/DynamicLog.hs 42 - xmobarColor, dzenColor, dzenEscape, dzenStrip, + xmobarColor, xmobarStrip, + dzenColor, dzenEscape, dzenStrip, hunk ./XMonad/Hooks/DynamicLog.hs 336 --- | Strip dzen formatting (used in ppUrgent) +-- | Strip dzen formatting or commands. Useful to remove ppHidden +-- formatting in ppUrgent field. For example: +-- +-- > , ppHidden = dzenColor "gray20" "" . wrap "(" ")" +-- > , ppUrgent = dzenColor "dark orange" "" . dzenStrip hunk ./XMonad/Hooks/DynamicLog.hs 343 - strip keep [] = keep - strip keep ('^':'^':x) = strip (keep ++ "^") x - strip keep ('^':x) = strip keep (drop 1 . dropWhile (')' /=) $ x) - strip keep x = let (good,x') = span ('^' /=) x - in strip (keep ++ good) x' - - + strip keep x + | null x = keep + | "^^" `isPrefixOf` x = strip (keep ++ "^") (drop 2 x) + | '^' == head x = strip keep (drop 1 . dropWhile (/= ')') $ x) + | otherwise = let (good,x') = span (/= '^') x + in strip (keep ++ good) x' hunk ./XMonad/Hooks/DynamicLog.hs 361 +-- | Strip xmobar markup. Useful to remove ppHidden color from ppUrgent +-- field. For example: +-- +-- > , ppHidden = xmobarColor "gray20" "" . wrap "<" ">" +-- > , ppUrgent = xmobarColor "dark orange" "" . xmobarStrip +xmobarStrip :: String -> String +xmobarStrip = strip [] where + strip keep x + | null x = keep + | "') $ x) + | "" `isPrefixOf` x = strip keep (drop 5 x) + | '<' == head x = strip (keep ++ "<") (tail x) + | otherwise = let (good,x') = span (/= '<') x + in strip (keep ++ good) x' + hunk ./XMonad/Hooks/DynamicLog.hs 448 --- | Settings to emulate dwm's statusbar, dzen only. +-- | Settings to emulate dwm's statusbar, dzen only. Uses dzenStrip in +-- ppUrgent. hunk ./XMonad/Layout/NoBorders.hs 31 +import Data.Maybe(isJust) hunk ./XMonad/Layout/NoBorders.hs 82 - screens = filter (nonzerorect . screenRect . W.screenDetail) . W.screens $ wset + screens = [ scr | scr <- W.screens wset, + isJust . W.stack $ W.workspace scr, + nonzerorect . screenRect $ W.screenDetail scr] hunk ./XMonad/Layout/Mosaic.hs 74 - {- | The relative magnitudes of the positive rational numbers provided - determine the relative areas that the windows receive. The first - number represents the size of the master window, the second is for the - next window in the stack, and so on. + {- | The relative magnitudes (the sign is ignored) of the rational numbers + - provided determine the relative areas that the windows receive. The + - first number represents the size of the master window, the second is for + - the next window in the stack, and so on. Windows without a list element + - are hidden. hunk ./XMonad/Layout/Mosaic.hs 145 -splits num rect sz = splitsL rect $ makeTree $ normalize $ reverse $ take num sz +splits num rect sz = splitsL rect $ makeTree $ normalize + $ map abs $ reverse $ take num sz hunk ./XMonad/Layout/Mosaic.hs 145 -splits num rect sz = splitsL rect $ makeTree $ normalize - $ map abs $ reverse $ take num sz +splits num rect = splitsL rect . makeTree . normalize + . map abs . reverse . take num hunk ./XMonad/Layout/Mosaic.hs 168 - (p,e') <- zip pat $ take m (repeat True) ++ repeat False - let e = if e' then [p] else [] - (e++) $ take d $ repeat p + (p,e) <- zip pat $ replicate m True ++ repeat False + [p | e] ++ replicate d p hunk ./XMonad/Prompt/Shell.hs 121 -escape (' ':xs) = "\\ " ++ escape xs hunk ./XMonad/Prompt/Shell.hs 126 -isSpecialChar = flip elem "\\@\"'#?$*()[]{};" +isSpecialChar = flip elem " &\\@\"'#?$*()[]{};" hunk ./XMonad/Hooks/FadeInactive.hs 19 - fadeInactiveLogHook + isUnfocused, + fadeIn, + fadeOut, + fadeInactiveLogHook, + fadeOutLogHook hunk ./XMonad/Hooks/FadeInactive.hs 28 -import Control.Monad (forM_) +import Control.Monad hunk ./XMonad/Hooks/FadeInactive.hs 75 -fadeInactiveLogHook amt = withWindowSet $ \s -> - forM_ (visibleWins s) (fadeOut amt) >> - withFocused fadeIn - where - visibleWins s = (maybe [] unfocused . W.stack . W.workspace) (W.current s) ++ - concatMap (W.integrate' . W.stack . W.workspace) (W.visible s) - unfocused (W.Stack _ l r) = l ++ r +fadeInactiveLogHook amt = fadeOutLogHook isUnfocused amt + +-- | returns True if the window doesn't have the focus. +isUnfocused :: Window -> X Bool +isUnfocused w = withWindowSet $ \s -> return $ + case W.stack . W.workspace . W.current $ s of + Nothing -> False + Just stack -> W.focus stack /= w + +-- | fades out every window that satisfies a given property. +fadeOutLogHook :: (Window -> X Bool) -> Integer -> X () +fadeOutLogHook p amt = withWindowSet $ \s -> do + let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++ + concatMap (W.integrate' . W.stack . W.workspace) (W.visible s) + mapM_ fadeIn =<< filterM (fmap not . p) visibleWins + mapM_ (fadeOut amt) =<< filterM p visibleWins hunk ./XMonad/Util/EZConfig.hs 178 +-- > hunk ./XMonad/Util/EZConfig.hs 442 + , ("Print" , xK_Print) hunk ./XMonad/Layout/Master.hs 79 - if length ws > 2 then do + if length ws > 1 then do hunk ./XMonad/Layout/GridVariants.hs 138 - ncols = ceiling $ sqrt $ ( fromRational - ( (fromIntegral rw * fromIntegral nwins) / (fromIntegral rh * aspect) ) :: Double) + scr_a = fromIntegral rw / fromIntegral rh + fcols = sqrt ( fromRational $ scr_a * fromIntegral nwins / aspect ) :: Double + cols1 = floor fcols :: Int + cols2 = ceiling fcols :: Int + rows1 = ceiling ( fromIntegral nwins / fromIntegral cols1 :: Rational ) :: Int + rows2 = floor ( fromIntegral nwins / fromIntegral cols2 :: Rational ) :: Int + a1 = scr_a * fromIntegral rows1 / fromIntegral cols1 + a2 = scr_a * fromIntegral rows2 / fromIntegral cols2 + ncols | cols1 == 0 = cols2 + | rows2 == 0 = cols1 + | a1 / aspect < aspect / a2 = cols1 + | otherwise = cols2 hunk ./XMonad/Actions/UpdatePointer.hs 28 -import XMonad.StackSet (member) +import XMonad.StackSet (member, peek, screenDetail, current) hunk ./XMonad/Actions/UpdatePointer.hs 56 --- window unless it's already there, or unless the user was changing +-- window or empty screen unless it's already there, or unless the user was changing hunk ./XMonad/Actions/UpdatePointer.hs 59 -updatePointer p = withFocused $ \w -> do +updatePointer p = do hunk ./XMonad/Actions/UpdatePointer.hs 62 + rect <- case peek ws of + Nothing -> return $ (screenRect . screenDetail .current) ws + Just w -> windowAttributesToRectangle `fmap` io (getWindowAttributes dpy w) hunk ./XMonad/Actions/UpdatePointer.hs 67 - wa <- io $ getWindowAttributes dpy w hunk ./XMonad/Actions/UpdatePointer.hs 68 - unless (pointWithinRegion rootx rooty (wa_x wa) (wa_y wa) (wa_width wa) (wa_height wa) + unless (pointWithin (fi rootx) (fi rooty) rect hunk ./XMonad/Actions/UpdatePointer.hs 70 - || not (currentWindow `member` ws)) $ + || not (currentWindow `member` ws || currentWindow == none)) $ hunk ./XMonad/Actions/UpdatePointer.hs 73 - let x = moveWithin rootx (wa_x wa) ((wa_x wa) + (wa_width wa)) - let y = moveWithin rooty (wa_y wa) ((wa_y wa) + (wa_height wa)) - io $ warpPointer dpy none root 0 0 0 0 (fromIntegral x) (fromIntegral y) + let x = moveWithin (fi rootx) (rect_x rect) (fi (rect_x rect) + fi (rect_width rect)) + y = moveWithin (fi rooty) (rect_y rect) (fi (rect_y rect) + fi (rect_height rect)) + io $ warpPointer dpy none root 0 0 0 0 x y hunk ./XMonad/Actions/UpdatePointer.hs 77 - io $ warpPointer dpy none w 0 0 0 0 - (fraction h (wa_width wa)) (fraction v (wa_height wa)) + io $ warpPointer dpy none root 0 0 0 0 + (rect_x rect + fraction h (rect_width rect)) + (rect_y rect + fraction v (rect_height rect)) hunk ./XMonad/Actions/UpdatePointer.hs 82 -moveWithin :: Integral a => a -> a -> a -> a -moveWithin current lower upper = - if current < lower +windowAttributesToRectangle :: WindowAttributes -> Rectangle +windowAttributesToRectangle wa = Rectangle (fi (wa_x wa)) (fi (wa_y wa)) + (fi (wa_width wa)) (fi (wa_height wa)) +moveWithin :: Ord a => a -> a -> a -> a +moveWithin now lower upper = + if now < lower hunk ./XMonad/Actions/UpdatePointer.hs 89 - else if current > upper + else if now > upper hunk ./XMonad/Actions/UpdatePointer.hs 91 - else current + else now + +pointWithin :: Position -> Position -> Rectangle -> Bool +pointWithin x y r = x >= rect_x r && + x < rect_x r + fi (rect_width r) && + y >= rect_y r && + y < rect_y r + fi (rect_height r) + +fi :: (Num b, Integral a) => a -> b +fi = fromIntegral hunk ./XMonad/Actions/UpdatePointer.hs 102 --- Test that a point resides within a region. --- This belongs somewhere more generally accessible than this module. -pointWithinRegion :: Integral a => a -> a -> a -> a -> a -> a -> Bool -pointWithinRegion px py rx ry rw rh = - within px rx (rx + rw) && within py ry (ry + rh) - where within x left right = x >= left && x <= right hunk ./XMonad/Actions/UpdatePointer.hs 93 -pointWithin :: Position -> Position -> Rectangle -> Bool -pointWithin x y r = x >= rect_x r && - x < rect_x r + fi (rect_width r) && - y >= rect_y r && - y < rect_y r + fi (rect_height r) - addfile ./XMonad/Actions/PhysicalScreens.hs hunk ./XMonad/Actions/PhysicalScreens.hs 1 +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.PhysicalScreens +-- Copyright : (c) Nelson Elhage +-- License : BSD +-- +-- Maintainer : Nelson Elhage +-- Stability : unstable +-- Portability : unportable +-- +-- Manipulate screens ordered by physical location instead of ID +----------------------------------------------------------------------------- + +module XMonad.Actions.PhysicalScreens ( + -- * Usage + -- $usage + PhysicalScreen(..) + , getScreen + , viewScreen + , sendToScreen + ) where + +import XMonad +import qualified XMonad.StackSet as W + +import qualified Graphics.X11.Xlib as X +import Graphics.X11.Xinerama + +import Data.List (sortBy) +import Data.Function (on) + +{- $usage + +This module allows you name Xinerama screens from XMonad using their +physical location reletive to each other (as reported by Xinerama), +rather than their @ScreenID@ s, which are arbitrarily determined by +your X server and graphics hardware. + +Screens are ordered by the upper-left-most corner, from top-to-bottom +and then left-to-right. + +Example usage in your @~\/.xmonad\/xmonad.hs@ file: + +> import XMonad.Actions.PhysicalSCreens + +> -- +> -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3 +> -- mod-shift-{w,e,r}, Move client to screen 1, 2, or 3 +> -- +> [((modMask .|. mask, key), f sc) +> | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..] +> , (f, mask) <- [(viewScreen, 0), (sendToScreen, shiftMask)]] + +For detailed instructions on editing your key bindings, see +"XMonad.Doc.Extending#Editing_key_bindings". + -} + +-- | The type of the index of a screen by location +newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real) + +-- | Translate a physical screen index to a "ScreenId" +getScreen :: PhysicalScreen -> X (Maybe ScreenId) +getScreen (P i) = withDisplay $ \dpy -> do + screens <- io $ getScreenInfo dpy + if i >= length screens + then return Nothing + else let ss = sortBy (cmpScreen `on` fst) $ zip screens [0..] + in return $ Just $ snd $ ss !! i + +-- | Switch to a given physical screen +viewScreen :: PhysicalScreen -> X () +viewScreen p = do i <- getScreen p + whenJust i $ \s -> do + w <- screenWorkspace s + whenJust w $ windows . W.view + +-- | Send the active window to a given physical screen +sendToScreen :: PhysicalScreen -> X () +sendToScreen p = do i <- getScreen p + whenJust i $ \s -> do + w <- screenWorkspace s + whenJust w $ windows . W.shift + +-- | Compare two screens by their top-left corners, ordering +-- | top-to-bottom and then left-to-right. +cmpScreen :: Rectangle -> Rectangle -> Ordering +cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2) hunk ./xmonad-contrib.cabal 94 + XMonad.Actions.PhysicalScreens hunk ./XMonad/Layout/NoBorders.hs 2 +{-# LANGUAGE PatternGuards #-} hunk ./XMonad/Layout/NoBorders.hs 26 - withBorder + withBorder, + lessBorders, + SetsAmbiguous(..), + Ambiguity(..), + With(..) hunk ./XMonad/Layout/NoBorders.hs 36 -import Data.Maybe(isJust) -import Data.List ((\\)) +import Control.Monad +import Data.List hunk ./XMonad/Layout/NoBorders.hs 39 +import Data.Function (on) hunk ./XMonad/Layout/NoBorders.hs 80 -data SmartBorder a = SmartBorder [a] deriving (Read, Show) +singleton :: [a] -> Bool +singleton = null . drop 1 hunk ./XMonad/Layout/NoBorders.hs 83 -instance LayoutModifier SmartBorder Window where - unhook (SmartBorder s) = asks (borderWidth . config) >>= setBorders s - - redoLayout (SmartBorder s) _ mst wrs = do - wset <- gets windowset - let managedwindows = W.integrate' mst - screens = [ scr | scr <- W.screens wset, - isJust . W.stack $ W.workspace scr, - nonzerorect . screenRect $ W.screenDetail scr] - ws = tiled ++ floating - tiled = case filter (`elem` managedwindows) $ map fst wrs of - [w] | singleton screens -> [w] - _ -> [] - floating = - [ w | - (w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset, - px <= 0, py <= 0, - wx + px >= 1, wy + py >= 1 - ] - asks (borderWidth . config) >>= setBorders (s \\ ws) - setBorders ws 0 - return (wrs, Just $ SmartBorder ws) - where - singleton = null . drop 1 - nonzerorect (Rectangle _ _ 0 0) = False - nonzerorect _ = True +type SmartBorder = ConfigurableBorder Ambiguity hunk ./XMonad/Layout/NoBorders.hs 93 -smartBorders = ModifiedLayout (SmartBorder []) +smartBorders = lessBorders Never + +-- | Apply a datatype that has a SetsAmbiguous instance to provide a list of +-- windows that should not have borders. +-- +-- This gives flexibility over when borders should be drawn, in particular with +-- xinerama setups: 'Ambiguity' has a number of useful 'SetsAmbiguous' +-- instances +lessBorders :: (SetsAmbiguous p, Read p, Show p, LayoutClass l a) => + p -> l a -> ModifiedLayout (ConfigurableBorder p) l a +lessBorders amb = ModifiedLayout (ConfigurableBorder amb []) + +data ConfigurableBorder p w = ConfigurableBorder p [w] deriving (Read, Show) + +instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where + unhook (ConfigurableBorder _p s) = asks (borderWidth . config) >>= setBorders s + + redoLayout (ConfigurableBorder p s) _ mst wrs = do + ws <- withWindowSet (\wset -> return (hiddens p wset mst wrs)) + asks (borderWidth . config) >>= setBorders (s \\ ws) + setBorders ws 0 + return (wrs, Just $ ConfigurableBorder p ws) + +-- | SetsAmbiguous allows custom actions to generate lists of windows that +-- should not have borders drawn through 'ConfigurableBorder' +-- +-- To add your own (though perhaps those options would better belong as an +-- aditional constructor to 'Ambiguity'), you can add the function as such: +-- +-- > data MyAmbiguity = MyAmbiguity deriving (Read, Show) +-- +-- > instance SetsAmbiguous MyAmbiguity where +-- > hiddens _ wset mst wrs = otherHiddens Screen \\ otherHiddens OnlyFloat +-- > where otherHiddens p = hiddens p wset mst wrs +-- +-- The above example is redundant, because you can have the same result with: +-- +-- > layoutHook = lessBorders (Combine Difference Screen OnlyFloat) (Tall 1 0.5 0.03 ||| ... ) +-- +-- To get the same result as smartBorders: +-- +-- > layoutHook = lessBorders (Combine Never) (Tall 1 0.5 0.03 ||| ...) +-- +-- This indirect method is required to keep the Read and Show for +-- ConfigurableBorder so that xmonad can serialize state. +class SetsAmbiguous p where + hiddens :: p -> WindowSet -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window] + +instance SetsAmbiguous Ambiguity where + hiddens amb wset mst wrs + | Combine Union a b <- amb = on union next a b + | Combine Difference a b <- amb = on (\\) next a b + | Combine Intersection a b <- amb = on intersect next a b + | otherwise = tiled ms ++ floating + where next p = hiddens p wset mst wrs + nonzerorect (Rectangle _ _ 0 0) = False + nonzerorect _ = True + + screens = + [ scr | scr <- W.screens wset, + case amb of + Never -> True + _ -> not $ null $ integrate scr, + nonzerorect . screenRect $ W.screenDetail scr] + floating = [ w | + (w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset, + px <= 0, py <= 0, + wx + px >= 1, wy + py >= 1] + ms = filter (`elem` W.integrate' mst) $ map fst wrs + tiled [w] + | Screen <- amb = [w] + | OnlyFloat <- amb = [] + | OtherIndicated <- amb + , let nonF = map integrate $ W.current wset : W.visible wset + , length (concat nonF) > length wrs + , singleton $ filter (1==) $ map length nonF = [w] + | singleton screens = [w] + tiled _ = [] + integrate y = W.integrate' . W.stack $ W.workspace y + +-- | In order of increasing ambiguity (less borders more frequently), where +-- subsequent constructors add additional cases where borders are not drawn +-- than their predecessors. These behaviors make most sense with with multiple +-- screens: for single screens, Never or 'smartBorders' makes more sense. +data Ambiguity = Combine With Ambiguity Ambiguity + -- ^ This constructor is used to combine the + -- borderless windows provided by the + -- SetsAmbiguous instances from two other + -- 'Ambiguity' data types. + | OnlyFloat -- ^ Only remove borders on floating windows that + -- cover the whole screen + | Never -- ^ Never remove borders when ambiguous: + -- this is the same as smartBorders + | EmptyScreen -- ^ Focus in an empty screens does not count as + -- ambiguous. + | OtherIndicated + -- ^ No borders on full when all other screens + -- have borders. + | Screen -- ^ Borders are never drawn on singleton screens. + -- With this one you really need another way such + -- as a statusbar to detect focus. + deriving (Read, Show) + +-- | Used to indicate to the 'SetsAmbiguous' instance for 'Ambiguity' how two +-- lists should be combined. +data With = Union -- ^ Combine with Data.List.union + | Difference -- ^ Combine with Data.List.\\ + | Intersection -- ^ Combine with Data.List.intersect + deriving (Read, Show) addfile ./XMonad/Util/NamedScratchpad.hs hunk ./XMonad/Util/NamedScratchpad.hs 1 +{-# LANGUAGE PatternGuards #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.NamedScratchpad +-- Copyright : (c) Konstantin Sobolev +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Konstantin Sobolev +-- Stability : unstable +-- Portability : unportable +-- +-- Named scratchpads that support several arbitrary applications at the same time. +-- +----------------------------------------------------------------------------- + +module XMonad.Util.NamedScratchpad ( + -- * Usage + -- $usage + NamedScratchpad(..), + NamedScratchpads, + namedScratchpadAction, + namedScratchpadManageHook, + namedScratchpadFilterOutWorkspace + ) where + +import XMonad +import XMonad.Core +import XMonad.ManageHook (composeAll,doFloat) +import XMonad.Hooks.ManageHelpers (doRectFloat) +import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace) + +import Control.Monad (filterM) +import Data.Maybe (maybe,listToMaybe) + +import qualified XMonad.StackSet as W + + +-- $usage +-- Allows to have several floating scratchpads running different applications. +-- Bind a key to 'namedScratchpadSpawnAction'. +-- Pressing it will spawn configured application, or bring it to the current +-- workspace if it already exists. +-- Pressing the key with the application on the current workspace will +-- send it to a hidden workspace called @NSP@. +-- +-- If you already have a workspace called @NSP@, it will use that. +-- @NSP@ will also appear in xmobar and dzen status bars. You can tweak your +-- @dynamicLog@ settings to filter it out if you like. +-- +-- Create named scratchpads configuration in your xmonad.hs like this: +-- +-- > import XMonad.StackSet as W +-- > import XMonad.ManageHook +-- > import XMonad.Util.NamedScratchpad +-- > +-- > scratchpads = [ +-- > -- run htop in xterm, find it by title, use default geometry +-- > NS "htop" "xterm -e htop" (title =? "htop") Nothing , +-- > -- run stardict, find it by class name, place the window +-- > -- 1/6 of screen width from the left, 1/6 of screen height +-- > -- from the top, 2/3 of screen width by 2/3 of screen height +-- > NS "stardict" "stardict" (className =? "Stardict") +-- > (Just $ W.RationalRect (1/6) (1/6) (2/3) (2/3)) +-- > ] +-- +-- Add keybindings: +-- +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_t), namedScratchpadAction scratchpads "htop") +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_s), namedScratchpadAction scratchpads "stardict") +-- +-- ... and a manage hook: +-- +-- > , manageHook = namedScratchpadManageHook scratchpads +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings" +-- + +-- | Single named scratchpad configuration +data NamedScratchpad = NS { name :: String -- ^ Scratchpad name + , cmd :: String -- ^ Command used to run application + , query :: Query Bool -- ^ Query to find already running application + , rect :: Maybe W.RationalRect -- ^ Floating window geometry + } + +-- | Named scratchpads configuration +type NamedScratchpads = [NamedScratchpad] + +-- | Finds named scratchpad configuration by name +findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad +findByName c s = listToMaybe $ filter ((s==).name) c + +-- | Runs application which should appear in specified scratchpad +runApplication :: NamedScratchpad -> X () +runApplication = spawn . cmd + +-- | Action to pop up specified named scratchpad +namedScratchpadAction :: NamedScratchpads -- ^ Named scratchpads configuration + -> String -- ^ Scratchpad name + -> X () +namedScratchpadAction confs n + | Just conf <- findByName confs n = withWindowSet $ \s -> do + -- try to find it on the current workspace + filterCurrent <- filterM (runQuery (query conf)) + ( (maybe [] W.integrate . W.stack . + W.workspace . W.current) s) + case filterCurrent of + (x:_) -> do + -- create hidden workspace if it doesn't exist + if null (filter ((== scratchpadWorkspaceTag) . W.tag) (W.workspaces s)) + then addHiddenWorkspace scratchpadWorkspaceTag + else return () + -- push window there + windows $ W.shiftWin scratchpadWorkspaceTag x + [] -> do + -- try to find it on all workspaces + filterAll <- filterM (runQuery (query conf)) (W.allWindows s) + case filterAll of + (x:_) -> windows $ W.shiftWin (W.currentTag s) x + [] -> runApplication conf + + | otherwise = return () + +-- tag of the scratchpad workspace +scratchpadWorkspaceTag :: String +scratchpadWorkspaceTag = "NSP" + +-- | Manage hook to use with named scratchpads +namedScratchpadManageHook :: NamedScratchpads -- ^ Named scratchpads configuration + -> ManageHook +namedScratchpadManageHook = composeAll . fmap (\c -> query c --> maybe doFloat doRectFloat (rect c)) + +-- | Transforms a workspace list containing the NSP workspace into one that +-- doesn't contain it. Intended for use with logHooks. +namedScratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace] +namedScratchpadFilterOutWorkspace = filter (\(W.Workspace tag _ _) -> tag /= scratchpadWorkspaceTag) + +-- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20: hunk ./xmonad-contrib.cabal 210 + XMonad.Util.NamedScratchpad addfile ./XMonad/Actions/TopicSpace.hs hunk ./XMonad/Actions/TopicSpace.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.TopicSpace +-- Copyright : (c) Nicolas Pouillard +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Nicolas Pouillard +-- Stability : unstable +-- Portability : unportable +-- +-- Turns your workspaces into a more topic oriented system. +-- +-- This module allow to organize your workspaces on a precise topic basis. So +-- instead of having a workspace called `work' you can setup one workspace per +-- task. Here we will call these workspaces, topics. The great thing with +-- topics is that one can attach a directory that makes sense to each +-- particular topic. One can also attach an action that will be triggered +-- when switching to a topic that does not have any windows in it. So one can +-- attach our mail client to the mail topic, some terminals in the right +-- directory for the xmonad topic... This package also provides a nice way to +-- display your topics in a historical way using a custom `pprWindowSet' +-- function. You can also easily switch to recents topics using this history +-- of last focused topics. +-- +-- Here is an example of configuration using TopicSpace: +-- +-- @ +-- myTopicConfig :: TopicConfig +-- myTopicConfig = TopicConfig +-- { allTopics = +-- [ \"dashboard\" -- the first one +-- , \"admin\", \"build\", \"cleaning\", \"conf\", \"darcs\", \"haskell\", \"irc\" +-- , \"mail\", \"movie\", \"music\", \"talk\", \"text\", \"tools\", \"web\", \"xmonad\" +-- , \"yi\", \"documents\", \"twitter\", \"pdf\" +-- ] +-- , topicDirs = M.fromList $ +-- [ (\"conf\", \"w\/conf\") +-- , (\"dashboard\", \"Desktop\") +-- , (\"yi\", \"w\/dev-haskell\/yi\") +-- , (\"darcs\", \"w\/dev-haskell\/darcs\") +-- , (\"haskell\", \"w\/dev-haskell\") +-- , (\"xmonad\", \"w\/dev-haskell\/xmonad\") +-- , (\"tools\", \"w\/tools\") +-- , (\"movie\", \"Movies\") +-- , (\"talk\", \"w\/talks\") +-- , (\"music\", \"Music\") +-- , (\"documents\", \"w\/documents\") +-- , (\"pdf\", \"w\/documents\") +-- ] +-- , defaultTopicAction = const $ spawnShell >*> 3 +-- , defaultTopic = \"dashboard\" +-- , maxTopicHistory = 10 +-- , topicActions = M.fromList $ +-- [ (\"conf\", spawnShell >> spawnShellIn \"wd\/ertai\/private\") +-- , (\"darcs\", spawnShell >*> 3) +-- , (\"yi\", spawnShell >*> 3) +-- , (\"haskell\", spawnShell >*> 2 >> +-- spawnShellIn \"wd\/dev-haskell\/ghc\") +-- , (\"xmonad\", spawnShellIn \"wd\/x11-wm\/xmonad\" >> +-- spawnShellIn \"wd\/x11-wm\/xmonad\/contrib\" >> +-- spawnShellIn \"wd\/x11-wm\/xmonad\/utils\" >> +-- spawnShellIn \".xmonad\" >> +-- spawnShellIn \".xmonad\") +-- , (\"mail\", mailAction) +-- , (\"irc\", ssh somewhere) +-- , (\"admin\", ssh somewhere >> +-- ssh nowhere) +-- , (\"dashboard\", spawnShell) +-- , (\"twitter\", spawnShell) +-- , (\"web\", spawn browserCmd) +-- , (\"movie\", spawnShell) +-- , (\"documents\", spawnShell >*> 2 >> +-- spawnShellIn \"Documents\" >*> 2) +-- , (\"pdf\", spawn pdfViewerCmd) +-- ] +-- } +-- @ +-- +-- @ +-- -- extend your keybindings +-- myKeys = +-- [ ((modMask , xK_n ), spawnShell) -- %! Launch terminal +-- , ((modMask , xK_a ), currentTopicAction myTopicConfig) +-- , ((modMask , xK_g ), promptedGoto) +-- , ((modMask .|. shiftMask, xK_g ), promptedShift) +-- ... +-- ] +-- ++ +-- [ ((modMask, k), switchNthLastFocused defaultTopic i) +-- | (i, k) <- zip [1..] workspaceKeys] +-- @ +-- +-- @ +-- spawnShell :: X () +-- spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn +-- @ +-- +-- @ +-- spawnShellIn :: Dir -> X () +-- spawnShellIn dir = spawn $ \"urxvt '(cd ''\" ++ dir ++ \"'' && \" ++ myShell ++ \" )'\" +-- @ +-- +-- @ +-- goto :: Topic -> X () +-- goto = switchTopic myTopicConfig +-- @ +-- +-- @ +-- promptedGoto :: X () +-- promptedGoto = workspacePrompt myXPConfig goto +-- @ +-- +-- @ +-- promptedShift :: X () +-- promptedShift = workspacePrompt myXPConfig $ windows . W.shift +-- @ +-- +-- @ +-- myConfig = do +-- checkTopicConfig myTopicConfig +-- myLogHook <- makeMyLogHook +-- return $ defaultConfig +-- { borderWidth = 1 -- Width of the window border in pixels. +-- , workspaces = allTopics myTopicConfig +-- , layoutHook = myModifiers myLayouts +-- , manageHook = myManageHook +-- , logHook = myLogHook +-- , handleEventHook = myHandleEventHook +-- , terminal = myTerminal -- The preferred terminal program. +-- , normalBorderColor = \"#3f3c6d\" +-- , focusedBorderColor = \"#4f66ff\" +-- , XMonad.modMask = mod1Mask +-- , keys = myKeys +-- , mouseBindings = myMouseBindings +-- } +-- @ +-- +-- @ +-- main :: IO () +-- main = xmonad =<< myConfig +-- @ +module XMonad.Actions.TopicSpace + ( Topic + , Dir + , TopicConfig(..) + , getLastFocusedTopics + , setLastFocusedTopic + , pprWindowSet + , topicActionWithPrompt + , topicAction + , currentTopicAction + , switchTopic + , switchNthLastFocused + , currentTopicDir + , checkTopicConfig + , (>*>) + ) +where + +import XMonad + +import Data.List +import Data.Maybe (fromMaybe, isNothing) +import Data.Ord +import qualified Data.Map as M +import Graphics.X11.Xlib +import Control.Monad ((=<<),liftM2,when,unless,replicateM_) +import System.IO +import Foreign.C.String (castCCharToChar,castCharToCChar) + +import XMonad.Operations +import Control.Applicative ((<$>)) +import qualified XMonad.StackSet as W + +import XMonad.Prompt +import XMonad.Prompt.Workspace + +import XMonad.Hooks.UrgencyHook +import XMonad.Hooks.DynamicLog (PP(..)) +import qualified XMonad.Hooks.DynamicLog as DL + +import XMonad.Util.Run (spawnPipe) + +-- | An alias for @flip replicateM_@ +(>*>) :: Monad m => m a -> Int -> m () +(>*>) = flip replicateM_ +infix >*> + +-- | 'Topic' is just an alias for 'WorkspaceId' +type Topic = WorkspaceId + +-- | 'Dir' is just an alias for 'FilePath' but should points to a directory. +type Dir = FilePath + +-- | Here is the topic space configuration area. +data TopicConfig = TopicConfig { allTopics :: [Topic] + -- ^ You have to give a list of topics, + -- this must the be same list than the workspaces field of + -- your xmonad configuration. + -- The order is important, new topics must be inserted + -- at the end of the list if you want hot-restarting + -- to work. + , topicDirs :: M.Map Topic Dir + -- ^ This mapping associate a directory to each topic. + , topicActions :: M.Map Topic (X ()) + -- ^ This mapping associate an action to trigger when + -- switching to a given topic which workspace is empty. + , defaultTopicAction :: Topic -> X () + -- ^ This is the default topic action. + , defaultTopic :: Topic + -- ^ This is the default topic. + , maxTopicHistory :: Int + -- ^ This setups the maximum depth of topic history, usually + -- 10 is a good default since we can bind all of them using + -- numeric keypad. + } + +-- | Returns the list of last focused workspaces the empty list otherwise. +-- This function rely on a reserved property namely _XMONAD_LAST_FOCUSED_WORKSPACES. +getLastFocusedTopics :: X [String] +getLastFocusedTopics = getStringListProp "_XMONAD_LAST_FOCUSED_WORKSPACES" + +-- | Given a 'TopicConfig', the last focused topic, and a predicate that will +-- select topics that one want to keep, this function will set the property +-- of last focused topics. +setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X () +setLastFocusedTopic tg w predicate = + getLastFocusedTopics >>= + setStringListProp "_XMONAD_LAST_FOCUSED_WORKSPACES" + . take (maxTopicHistory tg) . nub . (w:) . filter predicate + +-- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration +-- and a pretty-printing record 'PP'. It will show the list of topics sorted historically +-- and highlighting topics with urgent windows. +pprWindowSet :: TopicConfig -> PP -> X String +pprWindowSet tg pp = do + winset <- gets windowset + urgents <- readUrgents + let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset + maxDepth = maxTopicHistory tg + setLastFocusedTopic tg (W.tag . W.workspace . W.current $ winset) + (`notElem` empty_workspaces) + lastWs <- getLastFocusedTopics + let depth topic = elemIndex topic lastWs + add_depth proj topic = proj pp $ maybe topic (((topic++":")++) . show) $ depth topic + pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible } + sortWindows = take (maxDepth - 1) . sortBy (comparing $ fromMaybe maxDepth . depth . W.tag) + return $ DL.pprWindowSet sortWindows urgents pp' winset + +-- | Given a prompt configuration and a topic configuration, triggers the action associated with +-- the topic given in prompt. +topicActionWithPrompt :: XPConfig -> TopicConfig -> X () +topicActionWithPrompt xp tg = workspacePrompt xp (liftM2 (>>) (switchTopic tg) (topicAction tg)) + +-- | Given a configuration and a topic, triggers the action associated with the given topic. +topicAction :: TopicConfig -> Topic -> X () +topicAction tg topic = fromMaybe (defaultTopicAction tg topic) $ M.lookup topic $ topicActions tg + +-- | Trigger the action associated with the current topic. +currentTopicAction :: TopicConfig -> X () +currentTopicAction tg = topicAction tg =<< gets (W.tag . W.workspace . W.current . windowset) + +-- | Switch to the given topic. +switchTopic :: TopicConfig -> Topic -> X () +switchTopic tg topic = do + windows $ W.greedyView topic + wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset) + when (null wins) $ topicAction tg topic + +-- | Switch to the Nth last focused topic or failback to the 'defaultTopic'. +switchNthLastFocused ::TopicConfig -> Int -> X () +switchNthLastFocused tg depth = do + lastWs <- getLastFocusedTopics + switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth + +-- | Returns the directory associated with current topic returns the empty string otherwise. +currentTopicDir :: TopicConfig -> X String +currentTopicDir tg = do + topic <- gets (W.tag . W.workspace . W.current . windowset) + return . fromMaybe "" . M.lookup topic $ topicDirs tg + +-- | Check the given topic configuration for duplicates topics or undefined topics. +checkTopicConfig :: TopicConfig -> IO () +checkTopicConfig tg = do + unless (null diffTopic) $ xmessage $ "Seen but missing workspaces (tags): " ++ show diffTopic + unless (null dups) $ xmessage $ "Duplicate workspaces (tags): " ++ show dups + where + seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg) + dups = tags \\ nub tags + diffTopic = seenTopics \\ sort tags + tags = allTopics tg + +type StringProp = String + +withStringProp :: StringProp -> (Display -> Window -> Atom -> X a) -> X a +withStringProp prop f = + withDisplay $ \dpy -> do + rootw <- asks theRoot + a <- io $ internAtom dpy prop False + f dpy rootw a + +-- | Get the name of a string property and returns it as a 'Maybe'. +getStringProp :: StringProp -> X (Maybe String) +getStringProp prop = + withStringProp prop $ \dpy rootw a -> do + p <- io $ getWindowProperty8 dpy a rootw + return $ map castCCharToChar <$> p + +-- | Set the value of a string property. +setStringProp :: StringProp -> String -> X () +setStringProp prop string = + withStringProp prop $ \dpy rootw a -> + io $ changeProperty8 dpy rootw a a propModeReplace $ map castCharToCChar string + +-- | Given a property name, returns its contents as a list. It uses the empty +-- list as default value. +getStringListProp :: StringProp -> X [String] +getStringListProp prop = return . maybe [] words =<< getStringProp prop + +-- | Given a property name and a list, sets the value of this property with +-- the list given as argument. +setStringListProp :: StringProp -> [String] -> X () +setStringListProp prop = setStringProp prop . unwords + +-- | Display the given message using the @xmessage@ program. +xmessage :: String -> IO () +xmessage s = do + h <- spawnPipe "xmessage -file -" + hPutStr h s + hClose h + hunk ./xmonad-contrib.cabal 105 + XMonad.Actions.TopicSpace addfile ./XMonad/Layout/ComboP.hs hunk ./XMonad/Layout/ComboP.hs 1 +{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.ComboP +-- Copyright : (c) Konstantin Sobolev +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Konstantin Sobolev +-- Stability : unstable +-- Portability : unportable +-- +-- A layout that combines multiple layouts and allows to specify where to put +-- new windows. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.ComboP ( + -- * Usage + -- $usage + combineTwoP, + CombineTwoP, + SwapWindow(..), + Property(..) + ) where + +import Data.List ( delete, intersect, (\\) ) +import Data.Maybe ( isJust ) +import Control.Monad +import XMonad hiding (focus) +import XMonad.StackSet ( integrate, Workspace (..), Stack(..) ) +import XMonad.Layout.WindowNavigation +import XMonad.Util.WindowProperties +import qualified XMonad.StackSet as W + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.ComboP +-- +-- and add something like +-- +-- > combineTwoP (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) (ClassName "Firefox") +-- +-- to your layouts. This way all windows with class = \"Firefox\" will always go +-- to the left pane, all others - to the right. +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- 'combineTwoP' is a simple layout combinator based on 'combineTwo' from Combo, with +-- addition of a 'Property' which tells where to put new windows. Windows mathing +-- the property will go into the first part, all others will go into the second +-- part. It supports @Move@ messages as 'combineTwo' does, but it also introduces +-- 'SwapWindow' message which sends focused window to the other part. It is +-- required becase @Move@ commands don't work when one of the parts is empty. +-- To use it, import \"XMonad.Layout.WindowNavigation\", and add the following key +-- bindings (or something similar): +-- +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Up ), sendMessage $ Move U) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_s ), sendMessage $ SwapWindow) +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data SwapWindow = SwapWindow -- ^ Swap window between panes + | SwapWindowN Int -- ^ Swap window between panes in the N-th nested ComboP. @SwapWindowN 0@ equals to SwapWindow + deriving (Read, Show, Typeable) +instance Message SwapWindow + +data CombineTwoP l l1 l2 a = C2P [a] [a] [a] l (l1 a) (l2 a) Property + deriving (Read, Show) + +combineTwoP :: (LayoutClass super(), LayoutClass l1 Window, LayoutClass l2 Window) => + super () -> l1 Window -> l2 Window -> Property -> CombineTwoP (super ()) l1 l2 Window +combineTwoP = C2P [] [] [] + +instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) => + LayoutClass (CombineTwoP (l ()) l1 l2) Window where + doLayout (C2P f w1 w2 super l1 l2 prop) rinput s = + let origws = W.integrate s -- passed in windows + w1c = origws `intersect` w1 -- current windows in the first pane + w2c = origws `intersect` w2 -- current windows in the second pane + new = origws \\ (w1c ++ w2c) -- new windows + superstack = Just Stack { focus=(), up=[], down=[()] } + f' = focus s:delete (focus s) f -- list of focused windows, contains 2 elements at most + in do + matching <- (hasProperty prop) `filterM` new -- new windows matching predecate + let w1' = w1c ++ matching -- updated first pane windows + w2' = w2c ++ (new \\ matching) -- updated second pane windows + s1 = differentiate f' w1' -- first pane stack + s2 = differentiate f' w2' -- second pane stack + ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super superstack) rinput + (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1 + (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2 + return (wrs1++wrs2, Just $ C2P f' w1' w2' (maybe super id msuper') + (maybe l1 id ml1') (maybe l2 id ml2') prop) + + handleMessage us@(C2P f ws1 ws2 super l1 l2 prop) m + | Just SwapWindow <- fromMessage m = swap us + | Just (SwapWindowN 0) <- fromMessage m = swap us + | Just (SwapWindowN n) <- fromMessage m = forwardToFocused us $ SomeMessage $ SwapWindowN $ n-1 + + | Just (MoveWindowToWindow w1 w2) <- fromMessage m, + w1 `elem` ws1, + w2 `elem` ws2 = return $ Just $ C2P f (delete w1 ws1) (w1:ws2) super l1 l2 prop + + | Just (MoveWindowToWindow w1 w2) <- fromMessage m, + w1 `elem` ws2, + w2 `elem` ws1 = return $ Just $ C2P f (w1:ws1) (delete w1 ws2) super l1 l2 prop + + | otherwise = do ml1' <- handleMessage l1 m + ml2' <- handleMessage l2 m + msuper' <- handleMessage super m + if isJust msuper' || isJust ml1' || isJust ml2' + then return $ Just $ C2P f ws1 ws2 + (maybe super id msuper') + (maybe l1 id ml1') + (maybe l2 id ml2') prop + else return Nothing + + description (C2P _ _ _ super l1 l2 prop) = "combining " ++ description l1 ++ " and "++ + description l2 ++ " with " ++ description super ++ " using "++ (show prop) + +-- send focused window to the other pane. Does nothing if we don't +-- own the focused window +swap :: (LayoutClass s a, LayoutClass l1 Window, LayoutClass l2 Window) => + CombineTwoP (s a) l1 l2 Window -> X (Maybe (CombineTwoP (s a) l1 l2 Window)) +swap (C2P f ws1 ws2 super l1 l2 prop) = do + mst <- gets (W.stack . W.workspace . W.current . windowset) + let (ws1', ws2') = case mst of + Nothing -> (ws1, ws2) + Just st -> if foc `elem` ws1 + then (foc `delete` ws1, foc:ws2) + else if foc `elem` ws2 + then (foc:ws1, foc `delete` ws2) + else (ws1, ws2) + where foc = W.focus st + if (ws1,ws2) == (ws1',ws2') + then return Nothing + else return $ Just $ C2P f ws1' ws2' super l1 l2 prop + + +-- forwards the message to the sublayout which contains the focused window +forwardToFocused :: (LayoutClass l1 Window, LayoutClass l2 Window, LayoutClass s a) => + CombineTwoP (s a) l1 l2 Window -> SomeMessage -> X (Maybe (CombineTwoP (s a) l1 l2 Window)) +forwardToFocused (C2P f ws1 ws2 super l1 l2 prop) m = do + ml1 <- forwardIfFocused l1 ws1 m + ml2 <- forwardIfFocused l2 ws2 m + ms <- if isJust ml1 || isJust ml2 + then return Nothing + else handleMessage super m + if isJust ml1 || isJust ml2 || isJust ms + then return $ Just $ C2P f ws1 ws2 (maybe super id ms) (maybe l1 id ml1) (maybe l2 id ml2) prop + else return Nothing + +-- forwards message m to layout l if focused window is among w +forwardIfFocused :: (LayoutClass l Window) => l Window -> [Window] -> SomeMessage -> X (Maybe (l Window)) +forwardIfFocused l w m = do + mst <- gets (W.stack . W.workspace . W.current . windowset) + maybe (return Nothing) send mst where + send st = if (W.focus st) `elem` w + then handleMessage l m + else return Nothing + +-- code from CombineTwo +-- given two sets of zs and xs takes the first z from zs that also belongs to xs +-- and turns xs into a stack with z being current element. Acts as +-- StackSet.differentiate if zs and xs don't intersect +differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q) +differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z + , up = reverse $ takeWhile (/=z) xs + , down = tail $ dropWhile (/=z) xs } + | otherwise = differentiate zs xs +differentiate [] xs = W.differentiate xs + +-- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20: hunk ./xmonad-contrib.cabal 138 + XMonad.Layout.ComboP addfile ./XMonad/Hooks/FloatNext.hs hunk ./XMonad/Hooks/FloatNext.hs 1 - +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.FloatNext +-- Copyright : Quentin Moser +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Quentin Moser +-- Stability : unstable +-- Portability : unportable +-- +-- Hook and keybindings for automatically sending the next +-- spawned window(s) to the floating layer. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.FloatNext ( -- * Usage + -- $usage + + -- * The hook + floatNextHook + + -- * Actions + , floatNext + , toggleFloatNext + , floatAllNew + , toggleFloatAllNew + + -- * Queries + , willFloatNext + , willFloatAllNew + + -- * 'DynamicLog' utilities + -- $pp + , willFloatNextPP + , willFloatAllNewPP + , runLogHook ) where + +import Prelude hiding (all) + +import XMonad + +import Control.Monad (join) +import Control.Applicative ((<$>)) +import Control.Arrow (first, second) +import Control.Concurrent.MVar +import System.IO.Unsafe (unsafePerformIO) + + +{- Helper functions -} + +modifyMVar2 :: MVar a -> (a -> a) -> IO () +modifyMVar2 v f = modifyMVar_ v (return . f) + +_set :: ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X () +_set f b = io $ modifyMVar2 floatModeMVar (f $ const b) + +_toggle :: ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X () +_toggle f = io $ modifyMVar2 floatModeMVar (f not) + +_get :: ((Bool, Bool) -> a) -> X a +_get f = io $ f <$> readMVar floatModeMVar + +_pp :: ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String) +_pp f s st = _get f >>= \b -> if b then return $ Just $ st s else return Nothing + + +{- The current state is kept here -} + +floatModeMVar :: MVar (Bool, Bool) +floatModeMVar = unsafePerformIO $ newMVar (False, False) + + +-- $usage +-- This module provides actions (that can be set as keybindings) +-- to automatically send the next spawned window(s) to the floating +-- layer. +-- +-- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.FloatNext +-- +-- and adding 'floatNextHook' to your 'ManageHook': +-- +-- > myManageHook = floatNextHook <+> manageHook defaultConfig +-- +-- The 'floatNext' and 'toggleFloatNext' functions can be used in key +-- bindings to float the next spawned window: +-- +-- > , ((modMask, xK_e), toggleFloatNext) +-- +-- 'floatAllNew' and 'toggleFloatAllNew' are similar but float all +-- spawned windows until disabled again. +-- +-- > , ((modMask, xK_r), toggleFloatAllNew) + + +-- | This 'ManageHook' will selectively float windows as set +-- by 'floatNext' and 'floatAllNew'. +floatNextHook :: ManageHook +floatNextHook = do (next, all) <- io $ takeMVar floatModeMVar + io $ putMVar floatModeMVar (False, all) + if next || all then doFloat else idHook + + +-- | @floatNext True@ arranges for the next spawned window to be +-- sent to the floating layer, @floatNext False@ cancels it. +floatNext :: Bool -> X () +floatNext = _set first + +toggleFloatNext :: X () +toggleFloatNext = _toggle first + +-- | @floatAllNew True@ arranges for new windows to be +-- sent to the floating layer, @floatAllNew False@ cancels it +floatAllNew :: Bool -> X () +floatAllNew = _set second + +toggleFloatAllNew :: X () +toggleFloatAllNew = _toggle second + + +-- | Whether the next window will be set floating +willFloatNext :: X Bool +willFloatNext = _get fst + +-- | Whether new windows will be set floating +willFloatAllNew :: X Bool +willFloatAllNew = _get snd + + +-- $pp +-- The following functions are used to display the current +-- state of 'floatNext' and 'floatAllNew' in your +-- 'XMonad.Hooks.DynamicLog.dynamicLogWithPP'. +-- 'willFloatNextPP' and 'willFloatAllNewPP' should be added +-- to the 'XMonad.Hooks.DynamicLog.ppExtras' field of your +-- 'XMonad.Hooks.DynamicLog.PP'. +-- +-- Use 'runLogHook' to refresh the output of your 'logHook', so +-- that the effects of a 'floatNext'/... will be visible +-- immediately: +-- +-- > , ((modMask, xK_e), toggleFloatNext >> runLogHook) +-- +-- The @String -> String@ parameters to 'willFloatNextPP' and +-- 'willFloatAllNewPP' will be applied to their output, you +-- can use them to set the text color, etc., or you can just +-- pass them 'id'. + +willFloatNextPP :: (String -> String) -> X (Maybe String) +willFloatNextPP = _pp fst "Next" + +willFloatAllNewPP :: (String -> String) -> X (Maybe String) +willFloatAllNewPP = _pp snd "All" + +runLogHook :: X () +runLogHook = join $ asks $ logHook . config hunk ./xmonad-contrib.cabal 125 + XMonad.Hooks.FloatNext addfile ./XMonad/Hooks/Place.hs hunk ./XMonad/Hooks/Place.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.Place +-- Copyright : Quentin Moser +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Quentin Moser +-- Stability : unstable +-- Portability : unportable +-- +-- Automatic placement of floating and "WindowArranger" windows. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.Place ( -- * Usage + -- $usage + + -- * Placement actions + placeFocused + , placeHook + + -- * Placement policies + -- $placements + , Placement + , smart + , simpleSmart + , fixed + , underMouse + , inBounds + , withGaps + + -- * Others + , purePlaceWindow ) where + + +import XMonad +import qualified XMonad.StackSet as S + +import XMonad.Layout.WindowArranger +import XMonad.Actions.FloatKeys + +import qualified Data.Map as M +import Data.List (sortBy, maximumBy) +import Data.Maybe (maybe) +import Data.Monoid (Endo(..)) +import Control.Monad.Trans (lift, liftIO) + +-- $usage +-- This module provides a ManageHook that automatically places +-- floating windows at appropriate positions on the screen, as well +-- as an X action to manually trigger repositioning. +-- +-- You can use this module by including the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.Place +-- +-- and adding 'placeHook' to your 'manageHook', for example: +-- +-- > main = xmonad $ defaultConfig { manageHook = placeHook simpleSmart +-- > <+> manageHook defaultConfig } +-- +-- You can also define a key to manually trigger repositioning with 'placeFocused' by +-- adding the following to your keys definition: +-- +-- > , ((modMask, xK_w), placeFocused simpleSmart) +-- +-- Both 'placeHook' and 'placeFocused' take a 'Placement' parameter, which specifies +-- the placement policy to use (smart, under the mouse, fixed position, etc.). See +-- 'Placement' for a list of available policies. + + + +{- Placement policies -} + +-- $placements +-- #Placement policies# +-- +-- Placement policies determine how windows will be placed by 'placeFocused' and 'placeHook'. +-- +-- A few examples: +-- +-- * Basic smart placement +-- +-- > myPlacement = simpleSmart +-- +-- * Under the mouse (pointer at the top-left corner), but constrained +-- inside of the screen area +-- +-- > myPlacement = inBounds (underMouse (0, 0)) +-- +-- * Smart placement with a preference for putting windows near +-- the center of the screen, and with 16px gaps at the top and bottom +-- of the screen where no window will be placed +-- +-- > myPlacement = withGaps (16,0,16,0) (smart (0.5,0.5)) + + +-- | The type of placement policies +data Placement = Smart (Rational, Rational) + | Fixed (Rational, Rational) + | UnderMouse (Rational, Rational) + | Bounds (Dimension, Dimension, Dimension, Dimension) Placement + deriving (Show, Read, Eq) + + +-- | Try to place windows with as little overlap as possible +smart :: (Rational, Rational) -- ^ Where the window should be placed inside + -- the available area. See 'fixed'. + -> Placement +smart = Smart + +simpleSmart :: Placement +simpleSmart = inBounds $ smart (0,0) + + +-- | Place windows at a fixed position +fixed :: (Rational, Rational) -- ^ Where windows should go. + -- + -- * (0,0) -> top left of the screen + -- + -- * (1,0) -> top right of the screen + -- + -- * etc + -> Placement +fixed = Fixed + + +-- | Place windows under the mouse +underMouse :: (Rational, Rational) -- ^ Where the pointer should be relative to + -- the window's frame; see 'fixed'. + -> Placement +underMouse = UnderMouse + + +-- | Apply the given placement policy, constraining the +-- placed windows inside the screen boundaries. +inBounds :: Placement -> Placement +inBounds = Bounds (0,0,0,0) + + +-- | Same as 'inBounds', but allows specifying gaps along the screen's edges +withGaps :: (Dimension, Dimension, Dimension, Dimension) + -- ^ top, right, bottom and left gaps + -> Placement -> Placement +withGaps = Bounds + + + + + +{- Placement functions -} + + +-- | Repositions the focused window according to a placement policy. +placeFocused :: Placement -> X () +placeFocused p = withFocused $ \window -> do + (s,r,rs,pointer) <- getNecessaryData window + + let r'@(Rectangle x' y' _ _) = purePlaceWindow p s rs pointer r + + fs <- getFloats + case elem window fs of + True -> keysMoveWindowTo (x', y') (0, 0) window + False -> sendMessage $ SetGeometry r' + + +-- | Hook to automatically place windows when they are created. +placeHook :: Placement -> ManageHook +placeHook p = do window <- ask + (s,r,rs,pointer) <- Query $ lift (getNecessaryData window) + + let (Rectangle x' y' _ _) = purePlaceWindow p s rs pointer r + + d <- Query $ lift $ asks display + liftIO $ moveWindow d window x' y' + -- Move window at the X level, and + -- hope both the standard floating + -- system and WindowArranger layouts + -- will pick it up correctly. + -- I'm not really satisfied with this though. + + return $ Endo id + + +-- | Compute the new position of a window according to a placement policy. +purePlaceWindow :: Placement -- ^ The placement strategy + -> Rectangle -- ^ The screen + -> [Rectangle] -- ^ The other visible windows + -> (Position, Position) -- ^ The pointer's position. + -> Rectangle -- ^ The window to be placed + -> Rectangle +purePlaceWindow (Bounds (t,r,b,l) p') (Rectangle sx sy sw sh) rs p w + = let s' = (Rectangle (sx + fi l) (sy + fi t) (sw - l - r) (sh - t - b)) + in checkBounds s' $ purePlaceWindow p' s' rs p w + +purePlaceWindow (Fixed ratios) s _ _ w = placeRatio ratios s w + +purePlaceWindow (UnderMouse (rx, ry)) _ _ (px, py) (Rectangle _ _ w h) + = Rectangle (px - truncate (rx * fi w)) (py - truncate (ry * fi h)) w h + +purePlaceWindow (Smart ratios) s rs _ w + = placeSmart ratios s rs (rect_width w) (rect_height w) + + +-- | Helper: Places a Rectangle at a fixed position indicated by two Rationals +-- inside another, +placeRatio :: (Rational, Rational) -> Rectangle -> Rectangle -> Rectangle +placeRatio (rx, ry) (Rectangle x1 y1 w1 h1) (Rectangle _ _ w2 h2) + = Rectangle (scale rx x1 (x1 + fi w1 - fi w2)) + (scale ry y1 (y1 + fi h1 - fi h2)) + w2 h2 + + +-- | Helper: Ensures its second parameter is contained inside the first +-- by possibly moving it. +checkBounds :: Rectangle -> Rectangle -> Rectangle +checkBounds (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2) + = Rectangle (max x1 (min (x1 + fi w1 - fi w2) x2)) + (max y1 (min (y1 + fi h1 - fi h2) y2)) + w2 h2 + + + + + +{- Utilities -} + +scale :: (RealFrac a, Integral b) => a -> b -> b -> b +scale r n1 n2 = truncate $ r * fi n2 + (1 - r) * fi n1 + +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral + + + + + +{- Querying stuff -} + +getScreenRect :: X Rectangle +getScreenRect = gets $ screenRect . S.screenDetail + . S.current . windowset + +getLayoutWindows :: X [Window] +getLayoutWindows = gets $ maybe [] S.integrate . S.stack + . S.workspace . S.current . windowset + +getWindowRectangle :: Window -> X Rectangle +getWindowRectangle window + = do d <- asks display + (_, x, y, w, h, _, _) <- io $ getGeometry d window + + -- We can't use the border width returned by + -- getGeometry because it will be 0 if the + -- window isn't mapped yet. + b <- asks $ borderWidth . config + + return $ Rectangle x y (w + 2*b) (h + 2*b) + +getFloats :: X [Window] +getFloats = gets $ M.keys . S.floating . windowset + +getPointer :: Window -> X (Position, Position) +getPointer window = do d <- asks display + (_,_,_,x,y,_,_,_) <- io $ queryPointer d window + return (fi x,fi y) + +-- | Return values are, in order: screen's rectangle, window's rectangle, +-- other windows' rectangles and pointer's coordinates. +getNecessaryData :: Window -> X (Rectangle, Rectangle, [Rectangle], (Position, Position)) +getNecessaryData window + = do s <- getScreenRect + r <- getWindowRectangle window + -- The window to be place may or may not + -- have a border depending on whether it + -- is already mapped. + + layoutRects <- fmap (filter (/= window)) getLayoutWindows + >>= mapM getWindowRectangle + floatRects <- fmap (filter (/= window)) getFloats + >>= mapM getWindowRectangle + let rs = reverse $ floatRects ++ layoutRects + -- Clients inside of the layout + -- will be ignored first when + -- using smart placement. + -- We also reverse the list because it seems + -- the clients most recently added are at the front. + pointer <- getPointer window + + return (s, r, rs, pointer) + + + + + +{- Smart placement algorithm -} + +-- | Alternate representation for rectangles. +data SmartRectangle a = SR + { sr_x0, sr_y0 :: a -- ^ Top left coordinates, inclusive + , sr_x1, sr_y1 :: a -- ^ Bottom right coorsinates, exclusive + } deriving (Show, Eq) + +r2sr :: Rectangle -> SmartRectangle Position +r2sr (Rectangle x y w h) = SR x y (x + fi w) (y + fi h) + +sr2r :: SmartRectangle Position -> Rectangle +sr2r (SR x0 y0 x1 y1) = Rectangle x0 y0 (fi $ x1 - x0) (fi $ y1 - y0) + +width :: Num a => SmartRectangle a -> a +width r = sr_x1 r - sr_x0 r + +height :: Num a => SmartRectangle a -> a +height r = sr_y1 r - sr_y0 r + +isEmpty :: Real a => SmartRectangle a -> Bool +isEmpty r = (width r <= 0) || (height r <= 0) + +contains :: Real a => SmartRectangle a -> SmartRectangle a -> Bool +contains r1 r2 = sr_x0 r1 <= sr_x0 r2 + && sr_y0 r1 <= sr_y0 r2 + && sr_x1 r1 >= sr_x1 r2 + && sr_y1 r1 >= sr_y1 r2 + + +-- | Main placement function +placeSmart :: (Rational, Rational) -- ^ point of the screen where windows + -- should be placed first, if possible. + -> Rectangle -- ^ screen + -> [Rectangle] -- ^ other clients + -> Dimension -- ^ width + -> Dimension -- ^ height + -> Rectangle +placeSmart (rx, ry) s@(Rectangle sx sy sw sh) rs w h + = let free = map sr2r $ findSpace (r2sr s) (map r2sr rs) (fi w) (fi h) + in position free (scale rx sx (sx + fi sw - fi w)) + (scale ry sy (sy + fi sh - fi h)) + w h + +-- | Second part of the algorithm: +-- Chooses the best position in which to place a window, +-- according to a list of free areas and an ideal position for +-- the top-left corner. +-- We can't use semi-open surfaces for this, so we go back to +-- X11 Rectangles/Positions/etc instead. +position :: [Rectangle] -- ^ Free areas + -> Position -> Position -- ^ Ideal coordinates + -> Dimension -> Dimension -- ^ Width and height of the window + -> Rectangle +position rs x y w h = maximumBy distanceOrder $ map closest rs + where distanceOrder r1 r2 + = compare (distance (rect_x r1,rect_y r1) (x,y) :: Dimension) + (distance (rect_x r2,rect_y r2) (x,y) :: Dimension) + distance (x1,y1) (x2,y2) = truncate $ (sqrt :: Double -> Double) + $ fi $ (x1 - x2)^(2::Int) + + (y1 - y2)^(2::Int) + closest r = checkBounds r (Rectangle x y w h) + + +-- | First part of the algorithm: +-- Tries to find an area in which to place a new +-- rectangle so that it overlaps as little as possible with +-- other rectangles aready present. The first rectangles in +-- the list will be overlapped first. +findSpace :: Real a => + SmartRectangle a -- ^ The total available area + -> [SmartRectangle a] -- ^ The parts aready in use + -> a -- ^ Width of the rectangle to place + -> a -- ^ Height of the rectangle to place + -> [SmartRectangle a] +findSpace total [] _ _ = [total] +findSpace total rs@(_:rs') w h + = case filter largeEnough $ cleanup $ substractRects total rs of + [] -> findSpace total rs' w h + as -> as + where largeEnough r = width r >= w && height r >= h + + +-- | Substracts smaller rectangles from a total rectangle +-- , returning a list of remaining rectangular areas. +substractRects :: Real a => SmartRectangle a + -> [SmartRectangle a] -> [SmartRectangle a] +substractRects total [] = [total] +substractRects total (r:rs) + = do total' <- substractRects total rs + filter (not . isEmpty) + [ total' {sr_y1 = min (sr_y1 total') (sr_y0 r)} -- Above + , total' {sr_x0 = max (sr_x0 total') (sr_x1 r)} -- Right + , total' {sr_y0 = max (sr_y0 total') (sr_y1 r)} -- Below + , total' {sr_x1 = min (sr_x1 total') (sr_x0 r)} -- Left + ] + + +-- | "Nubs" a list of rectangles, dropping all those that are +-- already contained in another rectangle of the list. +cleanup :: Real a => [SmartRectangle a] -> [SmartRectangle a] +cleanup rs = foldr dropIfContained [] $ sortBy sizeOrder rs + +sizeOrder :: Real a => SmartRectangle a -> SmartRectangle a -> Ordering +sizeOrder r1 r2 | w1 < w2 = LT + | w1 == w2 && h1 < h2 = LT + | w1 == w2 && h1 == h2 = EQ + | otherwise = GT + where w1 = width r1 + w2 = width r2 + h1 = height r1 + h2 = height r2 + +dropIfContained :: Real a => SmartRectangle a + -> [SmartRectangle a] -> [SmartRectangle a] +dropIfContained r rs = if any (`contains` r) rs + then rs + else r:rs hunk ./xmonad-contrib.cabal 128 + XMonad.Hooks.Place hunk ./XMonad/Hooks/Place.hs 43 -import Data.List (sortBy, maximumBy) +import Data.List (sortBy, minimumBy) hunk ./XMonad/Hooks/Place.hs 350 -position rs x y w h = maximumBy distanceOrder $ map closest rs +position rs x y w h = minimumBy distanceOrder $ map closest rs hunk ./XMonad/Hooks/Place.hs 11 --- Automatic placement of floating and "WindowArranger" windows. +-- Automatic placement of floating windows. hunk ./XMonad/Hooks/Place.hs 43 -import Data.List (sortBy, minimumBy) -import Data.Maybe (maybe) +import Data.Ratio ((%)) +import Data.List (sortBy, minimumBy, partition) +import Data.Maybe (maybe, fromMaybe, catMaybes) hunk ./XMonad/Hooks/Place.hs 47 -import Control.Monad.Trans (lift, liftIO) +import Control.Monad (guard, join) +import Control.Monad.Trans (lift) hunk ./XMonad/Hooks/Place.hs 51 --- This module provides a ManageHook that automatically places +-- This module provides a 'ManageHook' that automatically places hunk ./XMonad/Hooks/Place.hs 53 --- as an X action to manually trigger repositioning. +-- as an 'X' action to manually trigger repositioning. hunk ./XMonad/Hooks/Place.hs 64 +-- Note that 'placeHook' should be applied after most other hooks, especially hooks +-- such as 'doFloat' and 'doShift'. Since hooks combined with '<+>' are applied from +-- right to left, this means that 'placeHook' should be the /first/ hook in your chain. +-- hunk ./XMonad/Hooks/Place.hs 82 --- #Placement policies# --- hunk ./XMonad/Hooks/Place.hs 153 - - hunk ./XMonad/Hooks/Place.hs 156 --- | Repositions the focused window according to a placement policy. +-- | Repositions the focused window according to a placement policy. Works for +-- both \"real\" floating windows and windows in a 'WindowArranger'-based +-- layout. hunk ./XMonad/Hooks/Place.hs 161 - (s,r,rs,pointer) <- getNecessaryData window - - let r'@(Rectangle x' y' _ _) = purePlaceWindow p s rs pointer r + info <- gets $ screenInfo . S.current . windowset + floats <- gets $ M.keys . S.floating . windowset + + r'@(Rectangle x' y' _ _) <- placeWindow p window info floats hunk ./XMonad/Hooks/Place.hs 166 - fs <- getFloats - case elem window fs of + -- use X.A.FloatKeys if the window is floating, send + -- a WindowArranger message otherwise. + case elem window floats of hunk ./XMonad/Hooks/Place.hs 176 - (s,r,rs,pointer) <- Query $ lift (getNecessaryData window) + r <- Query $ lift $ getWindowRectangle window + allRs <- Query $ lift $ getAllRectangles + pointer <- Query $ lift $ getPointer window + + return $ Endo $ \theWS -> fromMaybe theWS $ + do let currentRect = screenRect $ S.screenDetail $ S.current theWS + floats = M.keys $ S.floating theWS hunk ./XMonad/Hooks/Place.hs 184 - let (Rectangle x' y' _ _) = purePlaceWindow p s rs pointer r + guard(window `elem` floats ) + + -- Look for the workspace(s) on which the window is to be + -- spawned. Each of them also needs an associated screen + -- rectangle; for hidden workspaces, we use the current + -- workspace's screen. + let infos = filter ((window `elem`) . stackContents . S.stack . fst) + $ [screenInfo $ S.current theWS] + ++ (map screenInfo $ S.visible theWS) + ++ zip (S.hidden theWS) (repeat currentRect) + + guard(not $ null infos) hunk ./XMonad/Hooks/Place.hs 197 - d <- Query $ lift $ asks display - liftIO $ moveWindow d window x' y' - -- Move window at the X level, and - -- hope both the standard floating - -- system and WindowArranger layouts - -- will pick it up correctly. - -- I'm not really satisfied with this though. + let (workspace, screen) = head infos + rs = catMaybes $ map (flip M.lookup allRs) + $ organizeClients workspace window floats + r' = purePlaceWindow p screen rs pointer r + newRect = r2rr screen r' + newFloats = M.insert window newRect (S.floating theWS) hunk ./XMonad/Hooks/Place.hs 204 - return $ Endo id + return $ theWS { S.floating = newFloats } + + +placeWindow :: Placement -> Window + -> (S.Workspace WorkspaceId (Layout Window) Window, Rectangle) + -- ^ The workspace with reference to which the window should be placed, + -- and the screen's geometry. + -> [Window] + -- ^ The list of floating windows. + -> X Rectangle +placeWindow p window (ws, s) floats + = do (r, rs, pointer) <- getNecessaryData window ws floats + return $ purePlaceWindow p s rs pointer r hunk ./XMonad/Hooks/Place.hs 239 --- | Helper: Places a Rectangle at a fixed position indicated by two Rationals +-- | Helper: Places a Rectangle at a fixed position indicated by two Rationals hunk ./XMonad/Hooks/Place.hs 268 - +r2rr :: Rectangle -> Rectangle -> S.RationalRect +r2rr (Rectangle x0 y0 w0 h0) (Rectangle x y w h) + = S.RationalRect ((fi x-fi x0) % fi w0) + ((fi y-fi y0) % fi h0) + (fi w % fi w0) + (fi h % fi h0) hunk ./XMonad/Hooks/Place.hs 279 -getScreenRect :: X Rectangle -getScreenRect = gets $ screenRect . S.screenDetail - . S.current . windowset +stackContents :: Maybe (S.Stack w) -> [w] +stackContents = maybe [] S.integrate hunk ./XMonad/Hooks/Place.hs 282 -getLayoutWindows :: X [Window] -getLayoutWindows = gets $ maybe [] S.integrate . S.stack - . S.workspace . S.current . windowset +screenInfo :: S.Screen i l a sid ScreenDetail -> (S.Workspace i l a, Rectangle) +screenInfo (S.Screen { S.workspace = ws, S.screenDetail = (SD s)}) = (ws, s) hunk ./XMonad/Hooks/Place.hs 297 -getFloats :: X [Window] -getFloats = gets $ M.keys . S.floating . windowset +getAllRectangles :: X (M.Map Window Rectangle) +getAllRectangles = do ws <- gets windowset + let allWindows = join $ map (stackContents . S.stack) + $ (S.workspace . S.current) ws + : (map S.workspace . S.visible) ws + ++ S.hidden ws + allRects <- mapM getWindowRectangle allWindows + + return $ M.fromList $ zip allWindows allRects + +organizeClients :: S.Workspace a b Window -> Window -> [Window] -> [Window] +organizeClients ws w floats + = let (floatCs, layoutCs) = partition (`elem` floats) $ filter (/= w) + $ stackContents $ S.stack ws + in reverse layoutCs ++ reverse floatCs + -- About the ordering: the smart algorithm will overlap windows + -- starting ith the head of the list. So: + -- - we put the non-floating windows first since they'll + -- probably be below the floating ones, + -- - we reverse the lists, since the newer/more important + -- windows are usually near the head. hunk ./XMonad/Hooks/Place.hs 324 --- | Return values are, in order: screen's rectangle, window's rectangle, +-- | Return values are, in order: window's rectangle, hunk ./XMonad/Hooks/Place.hs 326 -getNecessaryData :: Window -> X (Rectangle, Rectangle, [Rectangle], (Position, Position)) -getNecessaryData window - = do s <- getScreenRect - r <- getWindowRectangle window - -- The window to be place may or may not - -- have a border depending on whether it - -- is already mapped. +getNecessaryData :: Window + -> S.Workspace WorkspaceId (Layout Window) Window + -> [Window] + -> X (Rectangle, [Rectangle], (Position, Position)) +getNecessaryData window ws floats + = do r <- getWindowRectangle window hunk ./XMonad/Hooks/Place.hs 333 - layoutRects <- fmap (filter (/= window)) getLayoutWindows - >>= mapM getWindowRectangle - floatRects <- fmap (filter (/= window)) getFloats - >>= mapM getWindowRectangle - let rs = reverse $ floatRects ++ layoutRects - -- Clients inside of the layout - -- will be ignored first when - -- using smart placement. - -- We also reverse the list because it seems - -- the clients most recently added are at the front. + rs <- return (organizeClients ws window floats) + >>= mapM getWindowRectangle + hunk ./XMonad/Hooks/Place.hs 338 - return (s, r, rs, pointer) - + return (r, rs, pointer) hunk ./XMonad/Actions/GridSelect.hs 1 +{-# LANGUAGE ScopedTypeVariables #-} hunk ./XMonad/Actions/GridSelect.hs 22 + defaultGSSpawnConfig, + buildDefaultGSConfig, hunk ./XMonad/Actions/GridSelect.hs 25 + gridselectWindow, hunk ./XMonad/Actions/GridSelect.hs 29 + spawnSelected, hunk ./XMonad/Actions/GridSelect.hs 31 + defaultColorizer, hunk ./XMonad/Actions/GridSelect.hs 61 +-- +-- This module also supports displaying arbitrary information in a grid and letting +-- the user select from it. E.g. to spawn an application from a given list, you +-- can use the following: +-- +-- > , ((modMask x, xK_s), spawnSelected defaultGSSpawnConfig ["xterm","gmplayer","gvim"]) hunk ./XMonad/Actions/GridSelect.hs 68 -data GSConfig = GSConfig { +data GSConfig a = GSConfig { hunk ./XMonad/Actions/GridSelect.hs 72 - gs_colorizer :: Window -> Bool -> X (String, String), + gs_colorizer :: a -> Bool -> X (String, String), hunk ./XMonad/Actions/GridSelect.hs 78 -type TwoDWindowMap = [(TwoDPosition,(String,Window))] - -data TwoDState = TwoDState { td_curpos :: TwoDPosition, - td_windowmap :: [(TwoDPosition,(String,Window))], - td_gsconfig :: GSConfig, - td_font :: XMonadFont, - td_paneX :: Integer, - td_paneY :: Integer, - td_drawingWin :: Window - } +type TwoDElementMap a = [(TwoDPosition,(String,a))] hunk ./XMonad/Actions/GridSelect.hs 80 +data TwoDState a = TwoDState { td_curpos :: TwoDPosition + , td_elementmap :: TwoDElementMap a + , td_gsconfig :: GSConfig a + , td_font :: XMonadFont + , td_paneX :: Integer + , td_paneY :: Integer + , td_drawingWin :: Window + } hunk ./XMonad/Actions/GridSelect.hs 89 -type TwoD a = StateT TwoDState X a +type TwoD a b = StateT (TwoDState a) X b hunk ./XMonad/Actions/GridSelect.hs 108 -findInWindowMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b) -findInWindowMap pos = find ((== pos) . fst) +findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b) +findInElementMap pos = find ((== pos) . fst) hunk ./XMonad/Actions/GridSelect.hs 133 -updateAllWindows :: TwoD () -updateAllWindows = +updateAllElements :: TwoD a () +updateAllElements = hunk ./XMonad/Actions/GridSelect.hs 136 - TwoDState { td_windowmap = wins } <- get - updateWindows wins + TwoDState { td_elementmap = els } <- get + updateElements els hunk ./XMonad/Actions/GridSelect.hs 139 -updateWindows :: TwoDWindowMap -> TwoD () -updateWindows windowmap = do +updateElements :: TwoDElementMap a -> TwoD a () +updateElements elementmap = do hunk ./XMonad/Actions/GridSelect.hs 151 - updateWindow (pos@(x,y),(text, clientwindow)) = lift $ do - colors <- (gs_colorizer gsconfig) clientwindow (pos == curpos) + updateElement (pos@(x,y),(text, element)) = lift $ do + colors <- (gs_colorizer gsconfig) element (pos == curpos) hunk ./XMonad/Actions/GridSelect.hs 161 - mapM updateWindow windowmap + mapM updateElement elementmap hunk ./XMonad/Actions/GridSelect.hs 164 -eventLoop :: TwoD (Maybe Window) +eventLoop :: TwoD a (Maybe a) hunk ./XMonad/Actions/GridSelect.hs 177 - -> StateT TwoDState X (Maybe Window) + -> StateT (TwoDState a) X (Maybe a) hunk ./XMonad/Actions/GridSelect.hs 185 - (TwoDState { td_curpos = pos, td_windowmap = winmap }) <- get - return $ fmap (snd . snd) $ findInWindowMap pos winmap + (TwoDState { td_curpos = pos, td_elementmap = elmap }) <- get + return $ fmap (snd . snd) $ findInElementMap pos elmap hunk ./XMonad/Actions/GridSelect.hs 189 - let windowmap = td_windowmap state + let elmap = td_elementmap state hunk ./XMonad/Actions/GridSelect.hs 192 - newSelectedWin = findInWindowMap newPos windowmap - when (isJust newSelectedWin) $ do + newSelectedEl = findInElementMap newPos elmap + when (isJust newSelectedEl) $ do hunk ./XMonad/Actions/GridSelect.hs 195 - updateWindows (catMaybes [(findInWindowMap oldPos windowmap), newSelectedWin]) + updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl]) hunk ./XMonad/Actions/GridSelect.hs 198 -handle _ (ExposeEvent { }) = do - updateAllWindows - eventLoop +handle _ (ExposeEvent { }) = updateAllElements >> eventLoop hunk ./XMonad/Actions/GridSelect.hs 200 -handle _ _ = do - eventLoop +handle _ _ = eventLoop hunk ./XMonad/Actions/GridSelect.hs 220 - -fromClassName :: Window -> Bool -> X (String, String) -fromClassName w active = do - classname <- runQuery className w - let seed x = toInteger (sum $ map ((*x).fromEnum) classname) :: Integer +-- | Default colorizer for Strings +defaultColorizer :: String -> Bool -> X (String, String) +defaultColorizer s active = + let seed x = toInteger (sum $ map ((*x).fromEnum) s) :: Integer hunk ./XMonad/Actions/GridSelect.hs 227 - if active - then return ("#faff69", "black") - else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b] ), "white") - - + in if active + then return ("#faff69", "black") + else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b] ), "white") + +-- | Colorize a window depending on it's className. +fromClassName :: Window -> Bool -> X (String, String) +fromClassName w active = runQuery className w >>= flip defaultColorizer active + hunk ./XMonad/Actions/GridSelect.hs 238 - --- | A colorizer that picks a color inside a range, +-- | A colorizer that picks a color inside a range, hunk ./XMonad/Actions/GridSelect.hs 240 -colorRangeFromClassName :: (Word8, Word8, Word8) -- ^ Beginning of the color range +colorRangeFromClassName :: (Word8, Word8, Word8) -- ^ Beginning of the color range hunk ./XMonad/Actions/GridSelect.hs 244 - -> (Word8, Word8, Word8) -- ^ Active text color + -> (Word8, Word8, Word8) -- ^ Active text color hunk ./XMonad/Actions/GridSelect.hs 275 - - - --- | Brings up a 2D grid of windows in the center of the screen, and one can --- select a window with cursors keys. The selected window is returned. -gridselect :: GSConfig -> X (Maybe Window) -gridselect gsconfig = +-- | Brings up a 2D grid of elements in the center of the screen, and one can +-- select an element with cursors keys. The selected element is returned. +gridselect :: forall a . GSConfig a -> [(String,a)] -> X (Maybe a) +gridselect gsconfig elmap = hunk ./XMonad/Actions/GridSelect.hs 280 - rootw <- liftIO $ rootWindow dpy (defaultScreen dpy) + rootw <- asks theRoot hunk ./XMonad/Actions/GridSelect.hs 282 - windowList <- windowMap hunk ./XMonad/Actions/GridSelect.hs 290 - selectedWindow <- if (status == grabSuccess) then + selectedElement <- if (status == grabSuccess) then hunk ./XMonad/Actions/GridSelect.hs 292 - let restriction :: Integer -> (GSConfig -> Integer) -> Double + let restriction :: Integer -> (GSConfig a -> Integer) -> Double hunk ./XMonad/Actions/GridSelect.hs 296 - winmap = zipWith (,) (diamondRestrict restrictX restrictY) windowList - selectedWindow <- evalStateT (do updateAllWindows; eventLoop) - (TwoDState (0,0) - winmap - gsconfig - font - screenWidth - screenHeight - win) - return selectedWindow + elmap' = zip (diamondRestrict restrictX restrictY) elmap + selectedElement <- evalStateT (updateAllElements >> eventLoop) + (TwoDState (0,0) + elmap' + gsconfig + font + screenWidth + screenHeight + win) + return selectedElement hunk ./XMonad/Actions/GridSelect.hs 313 - return selectedWindow + return selectedElement + +-- | Like `gridSelect' but with the current windows and their titles as elements +gridselectWindow :: GSConfig Window -> X (Maybe Window) +gridselectWindow gsconf = windowMap >>= gridselect gsconf hunk ./XMonad/Actions/GridSelect.hs 322 -withSelectedWindow :: (Window -> X ()) -> GSConfig -> X () +withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X () hunk ./XMonad/Actions/GridSelect.hs 324 - mbWindow <- gridselect conf + mbWindow <- gridselectWindow conf hunk ./XMonad/Actions/GridSelect.hs 329 - hunk ./XMonad/Actions/GridSelect.hs 340 -defaultGSConfig :: GSConfig -defaultGSConfig = GSConfig 50 130 10 fromClassName "xft:Sans-8" +defaultGSConfig :: GSConfig Window +defaultGSConfig = buildDefaultGSConfig fromClassName + +-- | Builds a default gs config from a colorizer function. +buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a +buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" hunk ./XMonad/Actions/GridSelect.hs 351 -bringSelected :: GSConfig -> X () +bringSelected :: GSConfig Window -> X () hunk ./XMonad/Actions/GridSelect.hs 358 -goToSelected :: GSConfig -> X () +goToSelected :: GSConfig Window -> X () hunk ./XMonad/Actions/GridSelect.hs 361 +defaultGSSpawnConfig :: GSConfig String +defaultGSSpawnConfig = buildDefaultGSConfig defaultColorizer + +-- | Select an application to spawn from a given list +spawnSelected :: GSConfig String -> [String] -> X () +spawnSelected conf lst = gridselect conf (zip lst lst) >>= flip whenJust spawn + hunk ./XMonad/Actions/GridSelect.hs 198 +handle _ (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) + | t == buttonRelease = do + (TwoDState { td_elementmap = elmap, td_paneX = px, td_paneY = py, + td_gsconfig = (GSConfig ch cw _ _ _) }) <- get + let gridX = (fi x - (px - cw) `div` 2) `div` cw + gridY = (fi y - (py - ch) `div` 2) `div` ch + case lookup (gridX,gridY) elmap of + Just (_,el) -> return (Just el) + Nothing -> eventLoop + | otherwise = eventLoop + hunk ./XMonad/Actions/GridSelect.hs 296 - liftIO $ selectInput dpy win (exposureMask .|. keyPressMask) + liftIO $ selectInput dpy win (exposureMask .|. keyPressMask .|. buttonReleaseMask) hunk ./XMonad/Actions/GridSelect.hs 298 + io $ grabButton dpy button1 anyModifier win True buttonReleaseMask grabModeAsync grabModeAsync none none hunk ./XMonad/Hooks/DynamicLog.hs 41 - wrap, pad, shorten, + wrap, pad, trim, shorten, hunk ./XMonad/Hooks/DynamicLog.hs 59 +import Data.Char ( isSpace ) hunk ./XMonad/Hooks/DynamicLog.hs 307 +-- | Trim leading and trailing whitespace from a string. +trim :: String -> String +trim = f . f + where f = reverse . dropWhile isSpace + hunk ./XMonad/Actions/GridSelect.hs 12 --- GridSelect displays a 2D grid of windows to navigate with cursor --- keys and to select with return. +-- GridSelect displays items(e.g. the opened windows) in a 2D grid and lets +-- the user select from it with the cursor/hjkl keys or the mouse. hunk ./xmonad-contrib.cabal 37 -flag with_utf8 - description: Enable Utf8 support - hunk ./xmonad-contrib.cabal 52 - if flag(with_utf8) - build-depends: utf8-string - extensions: ForeignFunctionInterface - cpp-options: -DUSE_UTF8 - - build-depends: mtl, unix, X11>=1.4.3, xmonad>=0.8, xmonad<0.9 + build-depends: mtl, unix, X11>=1.4.3, xmonad>=0.8, xmonad<0.9, utf8-string hunk ./xmonad-contrib.cabal 54 + extensions: ForeignFunctionInterface + cpp-options: -DUSE_UTF8 hunk ./XMonad/Hooks/EwmhDesktops.hs 23 +import Codec.Binary.UTF8.String (encode) hunk ./XMonad/Hooks/EwmhDesktops.hs 179 - let names' = map (fromIntegral.fromEnum) $ - concatMap (++['\0']) names + let names' = map fromIntegral $ concatMap ((++[0]) . encode) names addfile ./XMonad/Layout/OneBig.hs hunk ./XMonad/Layout/OneBig.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.OneBig +-- Copyright : (c) 2009 Ilya Portnov +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Ilya Portnov +-- Stability : unstable +-- Portability : unportable +-- +-- Provides layout named OneBig. It places one (master) window at top left corner of screen, and other (slave) windows at top +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.OneBig ( + -- * Usage + -- $usage + OneBig (..) + ) where +import XMonad +import qualified XMonad.StackSet as W + +-- $usage +-- This module defines layout named OneBig. It places one (master) +-- window at top left, and other (slave) windows at right and at +-- bottom of master. It tries to give equal space for each slave +-- window. +-- +-- You can use this module by adding folowing in your @xmonad.hs@: +-- +-- > import XMonad.Layout.OneBig +-- +-- Then add layouts to your layoutHook: +-- +-- > myLayoutHook = OneBig (3/4) (3/4) ||| ... +-- +-- In this example, master window will occupy 3/4 of screen width and +-- 3/4 of screen height. + +-- | Data type for layout +data OneBig a = OneBig Float Float deriving (Read,Show) + +instance LayoutClass OneBig a where + pureLayout = oneBigLayout + +-- | Main layout function +oneBigLayout :: OneBig a -> Rectangle -> W.Stack a -> [(a, Rectangle)] +oneBigLayout (OneBig cx cy) rect stack = [(master,masterRect)] + ++ (divideBottom bottomRect bottomWs) + ++ (divideRight rightRect rightWs) + where ws = W.integrate stack + n = length ws + ht (Rectangle _ _ _ hh) = hh + wd (Rectangle _ _ ww _) = ww + h' = round (fromIntegral (ht rect)*cy) + w = wd rect + m = calcBottomWs n w h' + master = head ws + other = tail ws + bottomWs = take m other + rightWs = drop m other + masterRect = cmaster n m cx cy rect + bottomRect = cbottom cy rect + rightRect = cright cx cy rect + +-- | Calculate how many windows must be placed at bottom +calcBottomWs :: Int -> Dimension -> Dimension -> Int +calcBottomWs n w h' = case n of + 1 -> 0 + 2 -> 1 + 3 -> 2 + 4 -> 2 + _ -> (fromIntegral w)*(n-1) `div` fromIntegral (h'+(fromIntegral w)) + +-- | Calculate rectangle for master window +cmaster:: Int -> Int -> Float -> Float -> Rectangle -> Rectangle +cmaster n m cx cy (Rectangle x y sw sh) = Rectangle x y w h + where w = if (n > m+1) then + round (fromIntegral sw*cx) + else + sw + h = if (n > 1) then + round (fromIntegral sh*cy) + else + sh + +-- | Calculate rectangle for bottom windows +cbottom:: Float -> Rectangle -> Rectangle +cbottom cy (Rectangle sx sy sw sh) = Rectangle sx y sw h + where h = round (fromIntegral sh*(1-cy)) + y = round (fromIntegral sh*cy+(fromIntegral sy)) + +-- | Calculate rectangle for right windows +cright:: Float -> Float -> Rectangle -> Rectangle +cright cx cy (Rectangle sx sy sw sh) = Rectangle x sy w h + where w = round (fromIntegral sw*(1-cx)) + x = round (fromIntegral sw*cx+(fromIntegral sx)) + h = round (fromIntegral sh*cy) + +-- | Divide bottom rectangle between windows +divideBottom :: Rectangle -> [a] -> [(a, Rectangle)] +divideBottom (Rectangle x y w h) ws = zip ws rects + where n = length ws + oneW = fromIntegral w `div` n + oneRect = Rectangle x y (fromIntegral oneW) h + rects = take n $ iterate (shiftR (fromIntegral oneW)) oneRect + +-- | Divide right rectangle between windows +divideRight :: Rectangle -> [a] -> [(a, Rectangle)] +divideRight (Rectangle x y w h) ws = if (n==0) then [] else zip ws rects + where n = length ws + oneH = fromIntegral h `div` n + oneRect = Rectangle x y w (fromIntegral oneH) + rects = take n $ iterate (shiftB (fromIntegral oneH)) oneRect + +-- | Shift rectangle right +shiftR :: Position -> Rectangle -> Rectangle +shiftR s (Rectangle x y w h) = Rectangle (x+s) y w h + +-- | Shift rectangle bottom +shiftB :: Position -> Rectangle -> Rectangle +shiftB s (Rectangle x y w h) = Rectangle x (y+s) w h + + hunk ./xmonad-contrib.cabal 163 + XMonad.Layout.OneBig hunk ./XMonad/Layout/OneBig.hs 46 + pureMessage = oneBigMessage + +-- | Processes Shrink/Expand messages +oneBigMessage :: OneBig a -> SomeMessage -> Maybe (OneBig a) +oneBigMessage (OneBig cx cy) m = fmap resize (fromMessage m) + where resize Shrink = OneBig (cx-delta) (cy-delta) + resize Expand = OneBig (cx+delta) (cy+delta) + delta = 3/100 hunk ./XMonad/Layout/Combo.hs 28 -import XMonad.StackSet ( integrate, Workspace (..), Stack(..) ) +import XMonad.StackSet ( integrate', Workspace (..), Stack(..) ) hunk ./XMonad/Layout/Combo.hs 79 - doLayout (C2 f w2 super l1 l2) rinput s = arrange (integrate s) + runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = arrange (integrate' s) hunk ./XMonad/Layout/Combo.hs 96 - superstack = if focus s `elem` w2' - then Stack { focus=(), up=[], down=[()] } - else Stack { focus=(), up=[], down=[()] } + superstack = Stack { focus=(), up=[], down=[()] } hunk ./XMonad/Layout/Combo.hs 99 - f' = focus s:delete (focus s) f + f' = case s of (Just s') -> focus s':delete (focus s') f + Nothing -> f hunk ./XMonad/Actions/UpdatePointer.hs 6 --- +-- hunk ./XMonad/Actions/UpdatePointer.hs 17 -module XMonad.Actions.UpdatePointer +module XMonad.Actions.UpdatePointer hunk ./XMonad/Actions/UpdatePointer.hs 37 --- +-- hunk ./XMonad/Actions/UpdatePointer.hs 39 --- +-- hunk ./XMonad/Actions/UpdatePointer.hs 94 -fi = fromIntegral - +fi = fromIntegral hunk ./XMonad/Actions/UpdatePointer.hs 53 -data PointerPosition = Nearest | Relative Rational Rational +data PointerPosition = Nearest | Relative Rational Rational | TowardsCentre Rational Rational + deriving (Read,Show) hunk ./XMonad/Actions/UpdatePointer.hs 64 - Nothing -> return $ (screenRect . screenDetail .current) ws - Just w -> windowAttributesToRectangle `fmap` io (getWindowAttributes dpy w) + Nothing -> return $ (screenRect . screenDetail .current) ws + Just w -> windowAttributesToRectangle `fmap` io (getWindowAttributes dpy w) hunk ./XMonad/Actions/UpdatePointer.hs 77 + TowardsCentre xfrc yfrc -> do + let cx = fi (rect_width rect) / 2 + fi (rect_x rect) + cy = fi (rect_height rect) / 2 + fi (rect_y rect) + x,y,cx,cy :: Rational + x = moveWithin (fi rootx) (fi $ rect_x rect) (fi (rect_x rect) + fi (rect_width rect)) + y = moveWithin (fi rooty) (fi $ rect_y rect) (fi (rect_y rect) + fi (rect_height rect)) + io $ warpPointer dpy none root 0 0 0 0 (round $ x + xfrc*(cx-x)) (round $ y + yfrc*(cy-y)) hunk ./XMonad/Layout/MagicFocus.hs 19 - magicFocus + magicFocus, + promoteWarp, + promoteWarp' hunk ./XMonad/Layout/MagicFocus.hs 25 -import XMonad.StackSet +import qualified XMonad.StackSet as W hunk ./XMonad/Layout/MagicFocus.hs 28 +import XMonad.Actions.UpdatePointer(updatePointer, PointerPosition(TowardsCentre)) +import Data.Monoid(All(..)) +import qualified Data.Map as M + hunk ./XMonad/Layout/MagicFocus.hs 41 --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > main = xmonad defaultConfig { layoutHook = myLayouts, +-- > handleEventHook = promoteWarp } hunk ./XMonad/Layout/MagicFocus.hs 56 - modifyLayout MagicFocus (Workspace i l s) r = + modifyLayout MagicFocus (W.Workspace i l s) r = hunk ./XMonad/Layout/MagicFocus.hs 58 - runLayout (Workspace i l (s >>= \st -> Just $ swap st (peek wset))) r + runLayout (W.Workspace i l (s >>= \st -> Just $ swap st (W.peek wset))) r + +swap :: (Eq a) => W.Stack a -> Maybe a -> W.Stack a +swap (W.Stack f u d) focused + | Just f == focused = W.Stack f [] (reverse u ++ d) + | otherwise = W.Stack f u d + +-- | An eventHook that overrides the normal focusFollowsMouse. When the mouse +-- it moved to another window, that window is replaced as the master, and the +-- mouse is warped to inside the new master. +-- +-- It prevents infinite loops when focusFollowsMouse is true (the default), and +-- MagicFocus is in use when changing focus with the mouse. +-- +-- This eventHook does nothing when there are floating windows on the current +-- workspace. +promoteWarp :: Event -> X All +promoteWarp = promoteWarp' (TowardsCentre 0.15 0.15) hunk ./XMonad/Layout/MagicFocus.hs 77 -swap :: (Eq a) => Stack a -> Maybe a -> Stack a -swap (Stack f u d) focused | Just f == focused = Stack f [] (reverse u ++ d) - | otherwise = Stack f u d +-- | promoteWarp' allows you to specify an arbitrary PointerPosition to apply +-- when the mouse enters another window. +promoteWarp' :: PointerPosition -> Event -> X All +promoteWarp' pos e@(CrossingEvent {ev_window = w, ev_event_type = t}) + | t == enterNotify && ev_mode e == notifyNormal = do + ws <- gets windowset + let foc = W.peek ws + st = W.integrate' . W.stack . W.workspace $ W.current ws + wsFloats = M.filterWithKey (\k _ -> k `elem` st) $ W.floating ws + if Just w /= foc && M.null wsFloats then do + windows (W.swapMaster . W.focusWindow w) + updatePointer pos + return $ All False + else return $ All True +promoteWarp' _ _ = return $ All True addfile ./XMonad/Actions/UpdateFocus.hs hunk ./XMonad/Actions/UpdateFocus.hs 1 - +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.UpdateFocus +-- Copyright : (c) Daniel Schoepe +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Daniel Schoepe +-- Stability : unstable +-- Portability : unportable +-- +-- Updates the focus on mouse move in unfocused windows. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.UpdateFocus ( + -- * Usage + -- $usage + focusOnMouseMove, + adjustEventInput +) where + +import XMonad +import qualified XMonad.StackSet as W +import Graphics.X11.Xlib.Extras +import Control.Monad (when) +import Data.Monoid + +-- $usage +-- To make the focus update on mouse movement within an unfocused window, add the +-- following to your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.UpdateFocus +-- > xmonad $ defaultConfig { +-- > .. +-- > startupHook = adjustEventInput +-- > handleEventHook = focusOnMouseMove +-- > .. +-- > } +-- +-- This module is probably only useful when focusFollowsMouse is set to True(default). + +-- | Changes the focus if the mouse is moved within an unfocused window. +focusOnMouseMove :: Event -> X All +focusOnMouseMove (MotionEvent { ev_x = x, ev_y = y, ev_window = root }) = do + -- check only every 15 px to avoid excessive calls to translateCoordinates + when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do + dpy <- asks display + Just foc <- withWindowSet $ return . W.peek + -- get the window under the pointer: + (_,_,_,w) <- io $ translateCoordinates dpy root root (fromIntegral x) (fromIntegral y) + when (foc /= w) $ focus w + return (All True) +focusOnMouseMove _ = return (All True) + +-- | Adjusts the event mask to pick up pointer movements. +adjustEventInput :: X () +adjustEventInput = withDisplay $ \dpy -> do + rootw <- asks theRoot + io $ selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask + .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask + .|. buttonPressMask .|. pointerMotionMask hunk ./xmonad-contrib.cabal 101 + XMonad.Actions.UpdateFocus hunk ./XMonad/Prompt.hs 381 - | ks == xK_Return = setSuccess True + | ks == xK_Return || ks == xK_KP_Enter = setSuccess True hunk ./XMonad/Util/Themes.hs 27 + , kavonForestTheme + , kavonLakeTheme + , kavonPeacockTheme + , kavonVioGreenTheme + , kavonBluesTheme + , kavonAutumnTheme + , kavonFireTheme + , kavonChristmasTheme hunk ./XMonad/Util/Themes.hs 99 + , kavonForestTheme + , kavonLakeTheme + , kavonPeacockTheme + , kavonVioGreenTheme + , kavonBluesTheme + , kavonAutumnTheme + , kavonFireTheme + , kavonChristmasTheme hunk ./XMonad/Util/Themes.hs 220 + +-- | Forest colours, by Kathryn Andersen +kavonForestTheme :: ThemeInfo +kavonForestTheme = + newTheme { themeName = "kavonForestTheme" + , themeAuthor = "Kathryn Andersen" + , themeDescription = "Forest colours" + , theme = defaultTheme { activeColor = "#115422" + , activeBorderColor = "#1a8033" + , activeTextColor = "white" + , inactiveColor = "#543211" + , inactiveBorderColor = "#804c19" + , inactiveTextColor = "#ffcc33" + } + } + +-- | Lake (blue/green) colours, by Kathryn Andersen +kavonLakeTheme :: ThemeInfo +kavonLakeTheme = + newTheme { themeName = "kavonLakeTheme" + , themeAuthor = "Kathryn Andersen" + , themeDescription = "Lake (blue/green) colours" + , theme = defaultTheme { activeColor = "#001166" + , activeBorderColor = "#1f3999" + , activeTextColor = "white" + , inactiveColor = "#09592a" + , inactiveBorderColor = "#198044" + , inactiveTextColor = "#73e6a3" + } + } + +-- | Peacock colours, by Kathryn Andersen +kavonPeacockTheme :: ThemeInfo +kavonPeacockTheme = + newTheme { themeName = "kavonPeacockTheme" + , themeAuthor = "Kathryn Andersen" + , themeDescription = "Peacock colours" + , theme = defaultTheme { activeColor = "#190f4c" + , activeBorderColor = "#2b1980" + , activeTextColor = "white" + , inactiveColor = "#225173" + , inactiveBorderColor = "#2a638c" + , inactiveTextColor = "#8fb2cc" + } + } + +-- | Violet-Green colours, by Kathryn Andersen +kavonVioGreenTheme :: ThemeInfo +kavonVioGreenTheme = + newTheme { themeName = "kavonVioGreenTheme" + , themeAuthor = "Kathryn Andersen" + , themeDescription = "Violet-Green colours" + , theme = defaultTheme { activeColor = "#37174c" + , activeBorderColor = "#333399" + , activeTextColor = "white" + , inactiveColor = "#174c17" + , inactiveBorderColor = "#336633" + , inactiveTextColor = "#aaccaa" + } + } + +-- | Blue colours, by Kathryn Andersen +kavonBluesTheme :: ThemeInfo +kavonBluesTheme = + newTheme { themeName = "kavonBluesTheme" + , themeAuthor = "Kathryn Andersen" + , themeDescription = "Blue colours" + , theme = defaultTheme { activeColor = "#000066" + , activeBorderColor = "#111199" + , activeTextColor = "white" + , inactiveColor = "#9999ee" + , inactiveBorderColor = "#6666cc" + , inactiveTextColor = "black" + } + } + +-- | Christmas colours, by Kathryn Andersen +kavonChristmasTheme :: ThemeInfo +kavonChristmasTheme = + newTheme { themeName = "kavonChristmasTheme" + , themeAuthor = "Kathryn Andersen" + , themeDescription = "Christmas (green + red) colours" + , theme = defaultTheme { activeColor = "#660000" + , activeBorderColor = "#990000" + , activeTextColor = "white" + , inactiveColor = "#006600" + , inactiveBorderColor = "#003300" + , inactiveTextColor = "#99bb99" + } + } + +-- | Autumn colours, by Kathryn Andersen +kavonAutumnTheme :: ThemeInfo +kavonAutumnTheme = + newTheme { themeName = "kavonAutumnTheme" + , themeAuthor = "Kathryn Andersen" + , themeDescription = "Autumn (brown + red) colours" + , theme = defaultTheme { activeColor = "#660000" + , activeBorderColor = "#990000" + , activeTextColor = "white" + , inactiveColor = "#542d11" + , inactiveBorderColor = "#804d1A" + , inactiveTextColor = "#ffcc33" + } + } + +-- | Fire colours, by Kathryn Andersen +kavonFireTheme :: ThemeInfo +kavonFireTheme = + newTheme { themeName = "kavonFireTheme" + , themeAuthor = "Kathryn Andersen" + , themeDescription = "Fire (orange + red) colours" + , theme = defaultTheme { activeColor = "#660000" + , activeBorderColor = "#990000" + , activeTextColor = "white" + , inactiveColor = "#ff8000" + , inactiveBorderColor = "#d9b162" + , inactiveTextColor = "black" + } + } + hunk ./XMonad/Actions/TopicSpace.hs 13 --- This module allow to organize your workspaces on a precise topic basis. So +-- This module allows to organize your workspaces on a precise topic basis. So hunk ./XMonad/Actions/TopicSpace.hs 15 --- task. Here we will call these workspaces, topics. The great thing with +-- task. Here we call these workspaces, topics. The great thing with hunk ./XMonad/Actions/TopicSpace.hs 17 --- particular topic. One can also attach an action that will be triggered --- when switching to a topic that does not have any windows in it. So one can --- attach our mail client to the mail topic, some terminals in the right --- directory for the xmonad topic... This package also provides a nice way to --- display your topics in a historical way using a custom `pprWindowSet' +-- particular topic. One can also attach an action which will be triggered +-- when switching to a topic that does not have any windows in it. So you can +-- attach your mail client to the mail topic, some terminals in the right +-- directory to the xmonad topic... This package also provides a nice way to +-- display your topics in an historical way using a custom `pprWindowSet' hunk ./XMonad/Actions/TopicSpace.hs 28 +-- -- The list of all topics/workspaces of your xmonad configuration. +-- -- The order is important, new topics must be inserted +-- -- at the end of the list if you want hot-restarting +-- -- to work. +-- myTopics :: [Topic] +-- myTopics = +-- [ \"dashboard\" -- the first one +-- , \"admin\", \"build\", \"cleaning\", \"conf\", \"darcs\", \"haskell\", \"irc\" +-- , \"mail\", \"movie\", \"music\", \"talk\", \"text\", \"tools\", \"web\", \"xmonad\" +-- , \"yi\", \"documents\", \"twitter\", \"pdf\" +-- ] +-- @ +-- +-- @ hunk ./XMonad/Actions/TopicSpace.hs 44 --- { allTopics = --- [ \"dashboard\" -- the first one --- , \"admin\", \"build\", \"cleaning\", \"conf\", \"darcs\", \"haskell\", \"irc\" --- , \"mail\", \"movie\", \"music\", \"talk\", \"text\", \"tools\", \"web\", \"xmonad\" --- , \"yi\", \"documents\", \"twitter\", \"pdf\" --- ] --- , topicDirs = M.fromList $ +-- { topicDirs = M.fromList $ hunk ./XMonad/Actions/TopicSpace.hs 128 --- checkTopicConfig myTopicConfig +-- checkTopicConfig myTopics myTopicConfig hunk ./XMonad/Actions/TopicSpace.hs 132 --- , workspaces = allTopics myTopicConfig +-- , workspaces = myTopics hunk ./XMonad/Actions/TopicSpace.hs 204 -data TopicConfig = TopicConfig { allTopics :: [Topic] - -- ^ You have to give a list of topics, - -- this must the be same list than the workspaces field of - -- your xmonad configuration. - -- The order is important, new topics must be inserted - -- at the end of the list if you want hot-restarting - -- to work. - , topicDirs :: M.Map Topic Dir +data TopicConfig = TopicConfig { topicDirs :: M.Map Topic Dir hunk ./XMonad/Actions/TopicSpace.hs 284 -checkTopicConfig :: TopicConfig -> IO () -checkTopicConfig tg = do - unless (null diffTopic) $ xmessage $ "Seen but missing workspaces (tags): " ++ show diffTopic - unless (null dups) $ xmessage $ "Duplicate workspaces (tags): " ++ show dups - where - seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg) - dups = tags \\ nub tags - diffTopic = seenTopics \\ sort tags - tags = allTopics tg +checkTopicConfig :: [Topic] -> TopicConfig -> IO () +checkTopicConfig tags tg = do + -- tags <- gets $ map W.tag . workspaces . windowset + + let + seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg) + dups = tags \\ nub tags + diffTopic = seenTopics \\ sort tags + check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst + + check diffTopic "Seen but missing topics/workspaces" + check dups "Duplicate topics/workspaces" hunk ./XMonad/Layout/WindowNavigation.hs 71 -data Navigate = Go Direction | Swap Direction | Move Direction deriving ( Read, Show, Typeable ) +data Navigate = Go Direction | Swap Direction | Move Direction + | Apply (Window -> X()) Direction -- ^ Apply action with destination window + deriving ( Typeable ) hunk ./XMonad/Layout/WindowNavigation.hs 182 + | Just (Apply f d) <- fromMessage m = + case navigable d pt wrs of + [] -> return Nothing + ((w,_):_) -> f w >> return Nothing hunk ./XMonad/Layout/BoringWindows.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable - +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-} +{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances #-} hunk ./XMonad/Layout/BoringWindows.hs 18 - boringWindows, + -- * Usage + -- $usage + boringWindows, boringAuto, hunk ./XMonad/Layout/BoringWindows.hs 22 - focusUp, focusDown + focusUp, focusDown, + + UpdateBoring(UpdateBoring), + BoringMessage(Replace,Merge), + BoringWindows() hunk ./XMonad/Layout/BoringWindows.hs 29 -import XMonad hiding (Point) +import XMonad.Layout.LayoutModifier(ModifiedLayout(..), + LayoutModifier(handleMessOrMaybeModifyIt, redoLayout)) +import XMonad(Typeable, LayoutClass, Message, X, fromMessage, + sendMessage, windows, withFocused, Window) +import Control.Applicative((<$>)) +import Control.Monad(Monad(return, (>>))) +import Data.List((\\), union) +import Data.Maybe(Maybe(..), maybe, fromMaybe, listToMaybe, + maybeToList) +import qualified Data.Map as M hunk ./XMonad/Layout/BoringWindows.hs 40 -import XMonad.Layout.LayoutModifier -import XMonad.Util.Invisible + +-- $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: +-- +-- > myLayouts = boringWindows (Full ||| etc..) +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- Then to your keybindings, add: +-- +-- > , ((modMask, xK_j), focusUp) +-- > , ((modMask, xk_k), focusDown) +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + hunk ./XMonad/Layout/BoringWindows.hs 63 - deriving ( Read, Show, Typeable ) + | Replace String [Window] + | Merge String [Window] + deriving ( Read, Show, Typeable ) + hunk ./XMonad/Layout/BoringWindows.hs 69 +-- | 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 + hunk ./XMonad/Layout/BoringWindows.hs 78 -focusUp = sendMessage FocusUp -focusDown = sendMessage FocusDown +focusUp = sendMessage UpdateBoring >> sendMessage FocusUp +focusDown = sendMessage UpdateBoring >> sendMessage FocusDown hunk ./XMonad/Layout/BoringWindows.hs 81 -data BoringWindows a = BoringWindows (Invisible [] a) deriving ( Show, Read, Typeable ) +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) hunk ./XMonad/Layout/BoringWindows.hs 88 -boringWindows = ModifiedLayout (BoringWindows (I [])) +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 [])) hunk ./XMonad/Layout/BoringWindows.hs 95 - handleMessOrMaybeModifyIt (BoringWindows (I bs)) m - | Just (IsBoring b) <- fromMessage m = return $ Just $ Left $ BoringWindows (I (b:bs)) - | Just ClearBoring <- fromMessage m = return $ Just $ Left $ BoringWindows (I []) - | Just FocusUp <- fromMessage m = do windows $ W.modify' $ focusUp' - return Nothing + 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 hunk ./XMonad/Layout/BoringWindows.hs 116 - do windows $ W.modify' (reverseStack . focusUp' . reverseStack) + do windows $ W.modify' $ skipBoring W.focusDown' hunk ./XMonad/Layout/BoringWindows.hs 118 - where focusUp' (W.Stack t ls rs) - | (a,l:ls') <- skipBoring ls = W.Stack l ls' (a++t:rs) - | otherwise = case skipBoring (reverse (t:rs)++ls) of - (a,x:xs) -> W.Stack x xs a - _ -> W.Stack t ls rs - skipBoring [] = ([],[]) - skipBoring (x:xs) | x `elem` bs = case skipBoring xs of - (a,b) -> (x:a,b) - | otherwise = ([],x:xs) + 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 hunk ./XMonad/Layout/BoringWindows.hs 125 - --- | reverse a stack: up becomes down and down becomes up. -reverseStack :: W.Stack a -> W.Stack a -reverseStack (W.Stack t ls rs) = W.Stack t rs ls addfile ./XMonad/Layout/SubLayouts.hs hunk ./XMonad/Layout/SubLayouts.hs 1 +{-# LANGUAGE PatternGuards, ParallelListComp, DeriveDataTypeable, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, ScopedTypeVariables #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.SubLayouts +-- Copyright : (c) 2009 Adam Vogt +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : vogt.adam@gmail.com +-- Stability : unstable +-- Portability : unportable +-- +-- A layout combinator that allows layouts to be nested. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.SubLayouts ( + -- * Usage + -- $usage + subLayout, + subTabbed, + + pushGroup, pullGroup, + pushWindow, pullWindow, + onGroup, toSubl, mergeDir, + + GroupMsg(..), + Broadcast(..), + + defaultSublMap, + + -- * Todo + -- $todo + ) + where + +import XMonad.Layout.Decoration(Decoration, DefaultShrinker) +import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, modifyLayout, + redoLayout), + ModifiedLayout(..)) +import XMonad.Layout.Simplest(Simplest(..)) +import XMonad.Layout.Tabbed(defaultTheme, shrinkText, + TabbedDecoration, addTabs) +import XMonad.Layout.WindowNavigation(Direction, Navigate(Apply)) +import XMonad.Util.Invisible(Invisible(..)) +import XMonad +import Control.Applicative((<$>)) +import Control.Arrow(Arrow(second, (&&&))) +import Control.Monad(Monad(return), Functor(..), + MonadPlus(mplus), (=<<), sequence, foldM, guard, when) +import Data.Function((.), ($), flip, id, on) +import Data.List((++), foldr, filter, map, concatMap, elem, + notElem, null, nubBy, (\\), find) +import Data.Maybe(Maybe(..), maybe, fromMaybe, listToMaybe, + mapMaybe) + +import qualified XMonad.Layout.BoringWindows as B +import qualified XMonad.StackSet as W +import qualified Data.Map as M +import Data.Map(Map) + +-- $todo +-- 'subTabbed' works well, but it would be more uniform to avoid the use of +-- addTabs, with the sublayout being Simplest (but +-- 'XMonad.Layout.Tabbed.simpleTabbed' is this...). The only thing to be +-- gained by fixing this issue is the ability to mix and match decoration +-- styles. Better compatibility with some other layouts of which I am not +-- aware could be another benefit. +-- +-- 'simpleTabbed' (and other decorated layouts) fail horibly when used as +-- subLayouts: +-- +-- * decorations stick around: layout is run after being told to Hide +-- +-- * mouse events do not change focus: the group-ungroup does not respect +-- the focus changes it wants? +-- +-- * sending ReleaseResources before running it makes xmonad very slow, and +-- still leaves borders sticking around +-- +-- Issue 288: "XMonad.Layout.ResizableTile" assumes that its environment +-- contains only the windows it is running: should sublayouts be run in a +-- restricted environment that is then merged back? + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.SubLayouts +-- > import XMonad.Layout.WindowNavigation +-- +-- Using BoringWindows is optional and it allows you to add a keybinding to +-- skip over the non-visible windows. +-- +-- > import XMonad.Layout.BoringWindows +-- +-- Then edit your @layoutHook@ by adding the subTabbed layout modifier: +-- +-- > myLayouts = windowNavigation $ subTabbed $ boringWindows $ +-- > Tall 1 (3/100) (1/2) ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- "XMonad.Layout.WindowNavigation" is used to specify which windows to merge, +-- and it is not integrated into the modifier because it can be configured, and +-- works best as the outer modifier. +-- +-- Then to your keybindings add: +-- +-- > , ((modMask .|. controlMask, xK_h), sendMessage $ pullGroup L) +-- > , ((modMask .|. controlMask, xK_l), sendMessage $ pullGroup R) +-- > , ((modMask .|. controlMask, xK_k), sendMessage $ pullGroup U) +-- > , ((modMask .|. controlMask, xK_j), sendMessage $ pullGroup D) +-- > +-- > , ((modMask .|. controlMask, xK_m), withFocused (sendMessage . MergeAll)) +-- > , ((modMask .|. controlMask, xK_u), withFocused (sendMessage . UnMerge)) +-- > +-- > , ((modMask .|. controlMask, xK_period), onGroup W.focusUp') +-- > , ((modMask .|. controlMask, xK_comma), onGroup W.focusDown') +-- +-- These additional keybindings require the optional +-- "XMonad.Layout.BoringWindows" layoutModifier. The focus will skip over the +-- windows that are not focused in each sublayout. +-- +-- > , ((modMask, xK_j), focusDown) +-- > , ((modMask, xK_k), focusUp) +-- +-- A 'submap' can be used to make modifying the sublayouts using 'onGroup' and +-- 'toSubl' simpler: +-- +-- > ,((modm, xK_s), submap $ defaultSublMap conf) +-- +-- /NOTE:/ is there some reason that @asks config >>= submap . defaultSublMap@ +-- could not be used in the keybinding instead? It avoids having to explicitly +-- pass the conf. +-- +-- For more detailed instructions, see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- "XMonad.Doc.Extending#Adding_key_bindings" + +-- | The main layout modifier arguments: +-- +-- [@nextLayout@] When a new group is formed, use the layout @sl@ after +-- skipping that number of layouts. Specify a finite list and groups that do +-- not have a corresponding index get the first choice in @sls@ +-- +-- [@sl@] The single layout given to be run as a sublayout. +-- +-- [@x@] The layout that determines the rectangles that the groups get. +-- +-- Ex. The second group is Tall, the third is Circle, all others are tabbed +-- with: +-- +-- > myLayout = addTabs shrinkText defaultTheme +-- > $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| Circle) +-- > $ Tall 1 0.2 0.5 ||| Full +subLayout :: [Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a +subLayout nextLayout sl x = ModifiedLayout (Sublayout (I []) (nextLayout,sl) []) x + +-- | 'subLayout' but use 'XMonad.Layout.Tabbed.addTabs' to add decorations. +subTabbed :: (Eq a, LayoutModifier (Sublayout Simplest) a, LayoutClass l a) => + l a -> ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) + (ModifiedLayout (Sublayout Simplest) l) a +subTabbed x = addTabs shrinkText defaultTheme $ subLayout [] Simplest x + +-- | @defaultSublMap@ is an attempt to create a set of keybindings like the +-- defaults ones but to be used as a 'submap' for sending messages to the +-- sublayout. +defaultSublMap :: XConfig l -> Map (KeyMask, KeySym) (X ()) +defaultSublMap (XConfig { modMask = modm }) = M.fromList + [((modm, xK_space), toSubl NextLayout), + ((modm, xK_j), onGroup W.focusDown'), + ((modm, xK_k), onGroup W.focusUp'), + ((modm, xK_h), toSubl Shrink), + ((modm, xK_l), toSubl Expand), + ((modm, xK_Tab), onGroup W.focusDown'), + ((modm .|. shiftMask, xK_Tab), onGroup W.focusUp'), + ((modm, xK_m), onGroup focusMaster'), + ((modm, xK_comma), toSubl $ IncMasterN 1), + ((modm, xK_period), toSubl $ IncMasterN (-1)), + ((modm, xK_Return), onGroup swapMaster') + ] + where + -- should these go into XMonad.StackSet? + focusMaster' st = let (f:fs) = W.integrate st + in W.Stack f [] fs + swapMaster' (W.Stack f u d) = W.Stack f [] $ reverse u ++ d + +data Sublayout l a = Sublayout + { delayMess :: Invisible [] (SomeMessage,a) + -- ^ messages are handled when running the layout, + -- not in the handleMessage, I'm not sure that this + -- is necessary + , def :: ([Int], l a) -- ^ how many NextLayout messages to send to newly + -- populated layouts. If there is no corresponding + -- index, then don't send any. + , subls :: [(l a,W.Stack a)] + -- ^ The sublayouts and the stacks they manage + } + deriving (Read,Show) + +-- | Groups assumes this invariant: +-- M.keys gs == map W.focus (M.elems gs) (ignoring order) +-- All windows in the workspace are in the Map +-- +-- The keys are visible windows, the rest are hidden. +-- +-- This representation probably simplifies the internals of the modifier. +type Groups a = Map a (W.Stack a) + +-- | GroupMsg take window parameters to determine which group the action should +-- be applied to +data GroupMsg a + = UnMerge a -- ^ free the focused window from its tab stack + | UnMergeAll a + -- ^ separate the focused group into singleton groups + | Merge a a -- ^ merge the first group into the second group + | MergeAll a + -- ^ make one large group, keeping a focused + | WithGroup (W.Stack a -> X (W.Stack a)) a + | SubMessage SomeMessage a + -- ^ the sublayout with the given window will get the message + deriving (Typeable) + +-- | merge the window that would be focused by the function when applied to the +-- W.Stack of all windows, with the current group removed. The given window +-- should be focused by a sublayout. Example usage: @withFocused (sendMessage . +-- mergeDir W.focusDown')@ +mergeDir :: (W.Stack Window -> W.Stack Window) -> Window -> GroupMsg Window +mergeDir f w = WithGroup g w + where g cs = do + let onlyOthers = W.filter (`notElem` W.integrate cs) + flip whenJust (sendMessage . Merge (W.focus cs) . W.focus . f) + =<< fmap (onlyOthers =<<) currentStack + return cs + +data Broadcast = Broadcast SomeMessage -- ^ send a message to all sublayouts + deriving (Typeable) + +instance Message Broadcast +instance Typeable a => Message (GroupMsg a) + +-- | pullGroup, pushGroup allow you to merge windows or groups inheriting the +-- position of the current window (pull) or the other window (push). +pullGroup :: Direction -> Navigate +pullGroup = mergeNav (\o c -> sendMessage $ Merge o c) + + +pullWindow :: Direction -> Navigate +pullWindow = mergeNav (\o c -> sendMessage (UnMerge o) >> sendMessage (Merge o c)) + +pushGroup :: Direction -> Navigate +pushGroup = mergeNav (\o c -> sendMessage $ Merge c o) + +pushWindow :: Direction -> Navigate +pushWindow = mergeNav (\o c -> sendMessage (UnMerge c) >> sendMessage (Merge c o)) + +mergeNav :: (Window -> Window -> X ()) -> Direction -> Navigate +mergeNav f = Apply (\o -> withFocused (f o)) + +-- | Apply a function on the stack belonging to the currently focused group. It +-- works for rearranging windows and for changing focus. +onGroup :: (W.Stack Window -> W.Stack Window) -> X () +onGroup f = withFocused (sendMessage . WithGroup (return . f)) + +-- | Send a message to the currently focused sublayout. +toSubl :: (Message a) => a -> X () +toSubl m = withFocused (sendMessage . SubMessage (SomeMessage m)) + +instance (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModifier (Sublayout l) Window where + modifyLayout (Sublayout { subls = osls }) (W.Workspace i la st) r = do + let gs' = updateGroup st $ toGroups osls + st' = W.filter (`elem` M.keys gs') =<< st + updateWs gs' + runLayout (W.Workspace i la st') r + + redoLayout (Sublayout { delayMess = I ms, def = defl, subls = osls }) _r st arrs = do + let gs' = updateGroup st $ toGroups osls + sls <- fromGroups defl st gs' osls + + let newL :: LayoutClass l Window => Rectangle -> WorkspaceId -> (l Window,Bool) + -> (Maybe (W.Stack Window)) -> X ([(Window, Rectangle)], l Window) + newL rect n (ol, mess) sst = do + let handle l (y,_) + | mess = fromMaybe l <$> handleMessage l y + | otherwise = return l + kms = filter ((`elem` M.keys gs') . snd) ms + nl <- foldM handle ol $ filter ((`elem` W.integrate' sst) . snd) kms + fmap (fromMaybe nl) <$> runLayout (W.Workspace n nl sst) rect + + (urls,ssts) = unzip [ (newL gr i l sst, sst) + | l <- map (second $ const True) sls + | i <- map show [ 0 :: Int .. ] + | (k,gr) <- arrs, let sst = M.lookup k gs' ] + + arrs' <- sequence urls + sls' <- return . Sublayout (I []) defl <$> fromGroups defl st gs' + [ (l,s) | (_,l) <- arrs' | (Just s) <- ssts ] + return (concatMap fst arrs', sls') + + handleMess (Sublayout (I ms) defl sls) m + | Just (SubMessage sm w) <- fromMessage m = + return $ Just $ Sublayout (I ((sm,w):ms)) defl sls + + | Just (Broadcast sm) <- fromMessage m = do + ms' <- fmap (zip (repeat sm) . W.integrate') currentStack + return $ if null ms' then Nothing + else Just $ Sublayout (I $ ms' ++ ms) defl sls + + -- ReleaseResources and Hide + | Just (m' :: LayoutMessages) <- fromMessage m = do + ms' <- zip (repeat $ SomeMessage m') . W.integrate' + <$> currentStack + return $ if null ms' then Nothing + else Just $ Sublayout (I $ ms' ++ ms) defl sls + + | Just B.UpdateBoring <- fromMessage m = do + let bs = concatMap unfocused $ M.elems gs + ws <- gets (W.workspace . W.current . windowset) + flip sendMessageWithNoRefresh ws $ B.Replace "Sublayouts" bs + return Nothing + + | Just (WithGroup f w) <- fromMessage m + , Just g <- M.lookup w gs = do + g' <- f g + let gs' = M.insert (W.focus g') g' $ M.delete (W.focus g) gs + when (gs' /= gs) $ updateWs gs' + when (w /= W.focus g') $ windows (W.focusWindow $ W.focus g') + return Nothing + + | Just (MergeAll w) <- fromMessage m = + let gs' = fmap (M.singleton w) + $ (focusWindow' w =<<) $ W.differentiate + $ concatMap W.integrate $ M.elems gs + in maybe (return Nothing) fgs gs' + + | Just (UnMergeAll w) <- fromMessage m = + let ws = concatMap W.integrate $ M.elems gs + _ = w :: Window + mkSingleton f = M.singleton f (W.Stack f [] []) + in fgs $ M.unions $ map mkSingleton ws + + | Just (Merge x y) <- fromMessage m + , let findGrp z = mplus (M.lookup z gs) $ listToMaybe + $ M.elems $ M.filter ((z `elem`) . W.integrate) gs + , Just (W.Stack _ xb xn) <- findGrp x + , Just yst <- findGrp y = + let zs = W.Stack x xb (xn ++ W.integrate yst) + in fgs $ M.update (\_ -> Just zs) x $ M.delete y gs + + | Just (UnMerge x) <- fromMessage m = + fgs . M.fromList . map (W.focus &&& id) . M.elems + $ M.mapMaybe (W.filter (x/=)) gs + + | otherwise = return Nothing + where gs = toGroups sls + fgs gs' = do + st <- currentStack + Just . Sublayout (I ms) defl <$> fromGroups defl st gs' sls + +currentStack :: X (Maybe (W.Stack Window)) +currentStack = gets (W.stack . W.workspace . W.current . windowset) + +-- | update Group to follow changes in the workspace +updateGroup :: Ord a => Maybe (W.Stack a) -> Groups a -> Groups a +updateGroup mst gs = + let flatten = concatMap W.integrate . M.elems + news = W.integrate' mst \\ flatten gs + deads = flatten gs \\ W.integrate' mst + + uniNew = M.union (M.fromList $ map (\n -> (n,single n)) news) + single x = W.Stack x [] [] + + -- pass through a list to update/remove keys + remDead = M.fromList . map (\w -> (W.focus w,w)) + . mapMaybe (W.filter (`notElem` deads)) . M.elems + + -- update the current tab group's order and focus + followFocus hs = fromMaybe hs $ do + f' <- W.focus `fmap` mst + xs <- find (elem f' . W.integrate) $ M.elems hs + xs' <- W.filter (`elem` W.integrate xs) =<< mst + return $ M.insert f' xs' $ M.delete (W.focus xs) hs + + in remDead $ uniNew $ followFocus gs + +-- | rearrange the windowset to put the groups of tabs next to eachother, so +-- that the stack of tabs stays put. +updateWs :: Groups Window -> X () +updateWs = windowsMaybe . updateWs' + +updateWs' :: Groups Window -> WindowSet -> Maybe WindowSet +updateWs' gs ws = do + f <- W.peek ws + let w = W.index ws + nes = concatMap W.integrate $ mapMaybe (flip M.lookup gs) w + ws' = W.focusWindow f $ foldr W.insertUp (foldr W.delete' ws nes) nes + guard $ W.index ws' /= W.index ws + return ws' + +-- | focusWindow'. focus an element of a stack, is Nothing if that element is +-- absent. See also 'W.focusWindow' +focusWindow' :: (Eq a) => a -> W.Stack a -> Maybe (W.Stack a) +focusWindow' w st = do + guard $ not $ null $ filter (w==) $ W.integrate st + if W.focus st == w then Just st + else focusWindow' w $ W.focusDown' st + +-- update only when Just +windowsMaybe :: (WindowSet -> Maybe WindowSet) -> X () +windowsMaybe f = do + xst <- get + ws <- gets windowset + let up fws = put xst { windowset = fws } + maybe (return ()) up $ f ws + +unfocused :: W.Stack a -> [a] +unfocused x = W.up x ++ W.down x + +toGroups :: (Ord a) => [(a1, W.Stack a)] -> Map a (W.Stack a) +toGroups ws = M.fromList . map (W.focus &&& id) . nubBy (on (==) W.focus) + $ map snd ws + +-- | restore the default layout for each group. It needs the X monad to switch +-- the default layout to a specific one (handleMessage NextLayout) +fromGroups :: (LayoutClass layout a, Ord k) => + ([Int], layout a) + -> Maybe (W.Stack k) + -> Groups k + -> [(layout a, b)] + -> X [(layout a, W.Stack k)] +fromGroups (skips,defl) st gs sls = do + defls <- mapM (iterateM nextL defl !!) skips + return $ fromGroups' defl defls st gs (map fst sls) + where nextL l = fromMaybe l <$> handleMessage l (SomeMessage NextLayout) + iterateM f = iterate (>>= f) . return + +fromGroups' :: (Ord k) => a -> [a] -> Maybe (W.Stack k) -> Groups k -> [a] + -> [(a, W.Stack k)] +fromGroups' defl defls st gs sls = + [ fromMaybe2 (dl, single w) (l, M.lookup w gs) + | l <- map Just sls ++ repeat Nothing + | dl <- defls ++ repeat defl + | w <- W.integrate' $ W.filter (`notElem` unfocs) =<< st ] + where unfocs = unfocused =<< M.elems gs + single w = W.Stack w [] [] + fromMaybe2 (a,b) (x,y) = (fromMaybe a x, fromMaybe b y) hunk ./xmonad-contrib.cabal 177 + XMonad.Layout.SubLayouts hunk ./XMonad/Layout/SubLayouts.hs 1 -{-# LANGUAGE PatternGuards, ParallelListComp, DeriveDataTypeable, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, ScopedTypeVariables #-} +{-# LANGUAGE PatternGuards, ParallelListComp, DeriveDataTypeable, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances #-} hunk ./XMonad/Layout/SubLayouts.hs 49 - MonadPlus(mplus), (=<<), sequence, foldM, guard, when) + MonadPlus(mplus), (=<<), sequence, foldM, guard, when, join) hunk ./XMonad/Layout/SubLayouts.hs 55 +import Data.Traversable(sequenceA) hunk ./XMonad/Layout/SubLayouts.hs 309 - -- ReleaseResources and Hide - | Just (m' :: LayoutMessages) <- fromMessage m = do - ms' <- zip (repeat $ SomeMessage m') . W.integrate' - <$> currentStack - return $ if null ms' then Nothing - else Just $ Sublayout (I $ ms' ++ ms) defl sls - hunk ./XMonad/Layout/SubLayouts.hs 347 - | otherwise = return Nothing + | otherwise = fmap join $ sequenceA $ catchLayoutMess <$> fromMessage m hunk ./XMonad/Layout/SubLayouts.hs 353 + -- catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window)) + -- This l must be the same as from the instance head, + -- -XScopedTypeVariables should bring it into scope, but we are + -- trying to avoid warnings with ghc-6.8.2 and avoid CPP + catchLayoutMess x = do + let m' = x `asTypeOf` (undefined :: LayoutMessages) + ms' <- zip (repeat $ SomeMessage m') . W.integrate' + <$> currentStack + return $ do guard $ not $ null ms' + Just $ Sublayout (I $ ms' ++ ms) defl sls + hunk ./xmonad-contrib.cabal 60 - if impl (ghc >= 6.10.1) && arch (x86_64) + if impl (ghc == 6.10.1) && arch (x86_64) hunk ./XMonad/Layout/Mosaic.hs 26 + ,changeMaster hunk ./XMonad/Layout/Mosaic.hs 138 -growMaster [] = [] -growMaster (x:xs) = 2*x:xs +growMaster = changeMaster 2 hunk ./XMonad/Layout/Mosaic.hs 141 -shrinkMaster [] = [] -shrinkMaster (x:xs) = x/2:xs +shrinkMaster = changeMaster 0.5 + +-- | Multiply the area of the current master by a specified ratio +changeMaster :: Rational -> [Rational] -> [Rational] +changeMaster _ [] = [] +changeMaster f (x:xs) = f*x:xs addfile ./XMonad/Hooks/InsertPosition.hs hunk ./XMonad/Hooks/InsertPosition.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.InsertPosition +-- Copyright : (c) 2009 Adam Vogt +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : vogt.adam@gmail.com +-- Stability : unstable +-- Portability : portable +-- +-- Configure where new windows should be added and which window should be +-- focused. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.InsertPosition ( + -- * Usage + -- $usage + insertPosition + ,Focus(..), Position(..) + ) where + +import XMonad(ManageHook, MonadReader(ask)) +import qualified XMonad.StackSet as W +import Control.Applicative((<$>)) +import Data.Maybe(fromMaybe) +import Data.List(find) +import Data.Monoid(Endo(Endo)) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.InsertPosition +-- > xmonad defaultConfig { manageHook = insertPosition Master Newer <+> myManageHook } +-- +-- You should you put the manageHooks that use 'doShift' to take effect +-- /before/ 'insertPosition', so that the window order will be consistent. +-- Because ManageHooks compose from right to left (like function composition +-- '.'), this means that 'insertPosition' should be the leftmost ManageHook. + +data Position = Master | End | Above | Below +data Focus = Newer | Older + +-- | insertPosition. A manage hook for placing new windows. XMonad's default is +-- the same as using: @insertPosition Above Newer@. +insertPosition :: Position -> Focus -> ManageHook +insertPosition pos foc = Endo . g <$> ask + where + g w = viewingWs w (updateFocus w . ins w . W.delete w) + ins w = (\f ws -> fromMaybe id (W.focusWindow <$> W.peek ws) $ f ws) $ + case pos of + Master -> W.insertUp w . W.focusMaster + End -> insertDown w . W.modify' focusLast' + Above -> W.insertUp w + Below -> insertDown w + updateFocus = + case foc of + Older -> const id + Newer -> W.focusWindow + +-- | Modify the StackSet when the workspace containing w is focused +viewingWs :: (Eq a, Eq s, Eq i, Show i) =>a-> (W.StackSet i l a s sd -> W.StackSet i l a s sd)-> W.StackSet i l a s sd-> W.StackSet i l a s sd +viewingWs w f = do + i <- W.tag . W.workspace . W.current + ws <- find (elem w . W.integrate' . W.stack) . W.workspaces + maybe id (fmap (W.view i . f) . W.view . W.tag) ws + +-- | 'insertDown' and 'focusLast' belong in XMonad.StackSet? +insertDown :: (Eq a) => a -> W.StackSet i l a s sd -> W.StackSet i l a s sd +insertDown w = W.swapDown . W.insertUp w + +focusLast' :: W.Stack a -> W.Stack a +focusLast' st = let ws = W.integrate st + in W.Stack (last ws) (tail $ reverse ws) [] hunk ./xmonad-contrib.cabal 121 + XMonad.Hooks.InsertPosition hunk ./XMonad/Layout/Named.hs 20 - named + named, + nameTail hunk ./XMonad/Layout/Named.hs 24 +import XMonad hunk ./XMonad/Layout/Named.hs 35 --- > myLayouts = named "real big" Full ||| etc.. +-- > myLayouts = named "real big" Full ||| (nameTail $ named "real big" $ Full) ||| etc.. hunk ./XMonad/Layout/Named.hs 42 +-- | Rename a layout. hunk ./XMonad/Layout/Named.hs 50 + + +-- | Remove the first word of the name. +nameTail :: l a -> ModifiedLayout NameTail l a +nameTail = ModifiedLayout NameTail + +data NameTail a = NameTail deriving (Read,Show) + +instance LayoutModifier NameTail a where + modifyDescription NameTail i = dropWhile (==' ') $ dropWhile (/=' ') $ description i hunk ./XMonad/Layout/ThreeColumns.hs 13 --- A layout similar to tall but with three columns. +-- A layout similar to tall but with three columns. With 2560x1600 pixels this +-- layout can be used for a huge main window and up to six reasonable sized +-- slave windows. +-- +-- Screenshot: hunk ./XMonad/Layout/ThreeColumns.hs 41 --- > myLayouts = ThreeCol 1 (3/100) (1/2) ||| etc.. +-- > myLayouts = ThreeCol False 1 (3/100) (1/2) ||| etc.. hunk ./XMonad/Layout/ThreeColumns.hs 44 +-- If the first argument is true, the main window is placed in the center +-- column. The second argument specifies hom many windows initially appear in +-- the main window. The third argument argument specifies the amount to resize +-- while resizing and the fourth argument specifies the initial size of the +-- columns. A positive size designates the fraction of the screen that the main +-- window should occupy, but if the size is negative the absolute value +-- designates the fraction a slave column should occupy. If both slave columns +-- are visible, they always occupy the same amount of space. +-- hunk ./XMonad/Layout/ThreeColumns.hs 57 -data ThreeCol a = ThreeCol !Int !Rational !Rational deriving (Show,Read) +data ThreeCol a = ThreeCol !Bool !Int !Rational !Rational deriving (Show,Read) hunk ./XMonad/Layout/ThreeColumns.hs 60 - doLayout (ThreeCol nmaster _ frac) r = + doLayout (ThreeCol middle nmaster _ frac) r = hunk ./XMonad/Layout/ThreeColumns.hs 62 - ap zip (tile3 frac r nmaster . length) . W.integrate - handleMessage (ThreeCol nmaster delta frac) m = + ap zip (tile3 middle frac r nmaster . length) . W.integrate + handleMessage (ThreeCol middle nmaster delta frac) m = hunk ./XMonad/Layout/ThreeColumns.hs 66 - where resize Shrink = ThreeCol nmaster delta (max 0 $ frac-delta) - resize Expand = ThreeCol nmaster delta (min 1 $ frac+delta) - incmastern (IncMasterN d) = ThreeCol (max 0 (nmaster+d)) delta frac + where resize Shrink = ThreeCol middle nmaster delta (max (-0.5) $ frac-delta) + resize Expand = ThreeCol middle nmaster delta (min 1 $ frac+delta) + incmastern (IncMasterN d) = ThreeCol middle (max 0 (nmaster+d)) delta frac hunk ./XMonad/Layout/ThreeColumns.hs 72 -tile3 :: Rational -> Rectangle -> Int -> Int -> [Rectangle] -tile3 f r nmaster n +tile3 :: Bool -> Rational -> Rectangle -> Int -> Int -> [Rectangle] +tile3 middle f r nmaster n hunk ./XMonad/Layout/ThreeColumns.hs 76 - | otherwise = splitVertically nmaster r1 ++ splitVertically nmid r2 ++ splitVertically nright r3 - where (r1, r2, r3) = split3HorizontallyBy f r - (s1, s2) = splitHorizontallyBy f r - nslave = (n - nmaster) - nmid = ceiling (nslave % 2) - nright = (n - nmaster - nmid) + | otherwise = splitVertically nmaster r1 ++ splitVertically nslave1 r2 ++ splitVertically nslave2 r3 + where (r1, r2, r3) = split3HorizontallyBy middle (if f<0 then 1+2*f else f) r + (s1, s2) = splitHorizontallyBy (if f<0 then 1+f else f) r + nslave = (n - nmaster) + nslave1 = ceiling (nslave % 2) + nslave2 = (n - nmaster - nslave1) hunk ./XMonad/Layout/ThreeColumns.hs 83 -split3HorizontallyBy :: Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle) -split3HorizontallyBy f (Rectangle sx sy sw sh) = - ( Rectangle sx sy leftw sh - , Rectangle (sx + fromIntegral leftw) sy midw sh - , Rectangle (sx + fromIntegral leftw + fromIntegral midw) sy rightw sh ) - where leftw = ceiling $ fromIntegral sw * (2/3) * f - midw = ceiling ( (sw - leftw) % 2 ) - rightw = sw - leftw - midw +split3HorizontallyBy :: Bool -> Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle) +split3HorizontallyBy middle f (Rectangle sx sy sw sh) = + if middle + then ( Rectangle (sx + fromIntegral r2w) sy r1w sh + , Rectangle sx sy r2w sh + , Rectangle (sx + fromIntegral r2w + fromIntegral r1w) sy r3w sh ) + else ( Rectangle sx sy r1w sh + , Rectangle (sx + fromIntegral r1w) sy r2w sh + , Rectangle (sx + fromIntegral r1w + fromIntegral r2w) sy r3w sh ) + where r1w = ceiling $ fromIntegral sw * f + r2w = ceiling ( (sw - r1w) % 2 ) + r3w = sw - r1w - r2w hunk ./XMonad/Layout/ThreeColumnsMiddle.hs 1 -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} - ------------------------------------------------------------------------------ --- | --- Module : XMonad.Layout.ThreeColumnsMiddle --- Copyright : (c) Carsten Otto , --- based on ThreeColumns (c) Kai Grossjohann --- License : BSD3-style (see LICENSE) --- --- Maintainer : ? --- Stability : unstable --- Portability : unportable --- --- A layout similar to tall but with three columns, where the main window is --- in the middle. With 2560x1600 pixels this layout can be used for a huge --- main window and up to six reasonable sized slave windows. --- --- > Screenshot: http://server.c-otto.de/xmonad/ThreeColumnsMiddle.png --- ------------------------------------------------------------------------------ - -module XMonad.Layout.ThreeColumnsMiddle ( - -- * Usage - -- $usage - ThreeColMid(..) - ) where - -import XMonad -import qualified XMonad.StackSet as W - -import Data.Ratio - -import Control.Monad - --- $usage --- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Layout.ThreeColumnsMiddle --- --- Then edit your @layoutHook@ by adding the ThreeColMid layout: --- --- > myLayouts = ThreeColMid 1 (3/100) (1/2) ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } --- --- The first argument specifies how many windows appear in the main window. --- The second argument specifies how much the main window size changes when resizing. --- The third argument specifies the initial size of the main window as a fraction of --- total screen size. --- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" - -data ThreeColMid a = ThreeColMid !Int !Rational !Rational deriving (Show,Read) - -instance LayoutClass ThreeColMid a where - doLayout (ThreeColMid nmaster _ frac) r = - return . (\x->(x,Nothing)) . - ap zip (tile3 frac r nmaster . length) . W.integrate - handleMessage (ThreeColMid nmaster delta frac) m = - return $ msum [fmap resize (fromMessage m) - ,fmap incmastern (fromMessage m)] - where resize Shrink = ThreeColMid nmaster delta (max 0 $ frac-delta) - resize Expand = ThreeColMid nmaster delta (min 1 $ frac+delta) - incmastern (IncMasterN d) = ThreeColMid (max 0 (nmaster+d)) delta frac - description _ = "ThreeColMid" - --- | tile3. Compute window positions using 3 panes -tile3 :: Rational -> Rectangle -> Int -> Int -> [Rectangle] -tile3 f r nmaster n --- split horizontally, if there are very few windows (only the main screen is used) - | n <= nmaster || nmaster == 0 = splitHorizontally n r - --- one window more than the master window can hold (the additional window is shown right of the main screen) - | n == nmaster+1 = splitVertically nmaster s1 ++ splitVertically (n-nmaster) s2 - --- many windows (the main windows are shown in the center, all other windows are shown left and right of it) - | otherwise = splitVertically nmaster r1 ++ splitVertically nleft r2 ++ splitVertically nright r3 - where (r1, r2, r3) = split3HorizontallyBy f r - (s1, s2) = splitHorizontallyBy f r - nslave = (n - nmaster) - nleft = ceiling (nslave % 2) - nright = (n - nmaster - nleft) - -split3HorizontallyBy :: Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle) -split3HorizontallyBy f (Rectangle sx sy sw sh) = - ( Rectangle (sx + fromIntegral leftw) sy midw sh - , Rectangle sx sy leftw sh - , Rectangle (sx + fromIntegral leftw + fromIntegral midw) sy rightw sh ) - where midw = ceiling $ fromIntegral sw * f - leftw = ceiling ( (sw - midw) % 2 ) - rightw = sw - leftw - midw rmfile ./XMonad/Layout/ThreeColumnsMiddle.hs hunk ./xmonad-contrib.cabal 182 - XMonad.Layout.ThreeColumnsMiddle hunk ./XMonad/Layout/ThreeColumns.hs 8 --- +-- hunk ./XMonad/Layout/ThreeColumns.hs 41 --- > myLayouts = ThreeCol False 1 (3/100) (1/2) ||| etc.. +-- > myLayouts = ThreeCol 1 (3/100) (1/2) ||| etc.. hunk ./XMonad/Layout/ThreeColumns.hs 57 -data ThreeCol a = ThreeCol !Bool !Int !Rational !Rational deriving (Show,Read) +-- | Arguments are nmaster, delta, fraction +data ThreeCol a = ThreeColMid { threeColNMaster :: !Int, threeColDelta :: !Rational, threeColFrac :: !Rational} + | ThreeCol { threeColNMaster :: !Int, threeColDelta :: !Rational, threeColFrac :: !Rational} + deriving (Show,Read) hunk ./XMonad/Layout/ThreeColumns.hs 63 - doLayout (ThreeCol middle nmaster _ frac) r = - return . (\x->(x,Nothing)) . - ap zip (tile3 middle frac r nmaster . length) . W.integrate - handleMessage (ThreeCol middle nmaster delta frac) m = + pureLayout (ThreeCol n _ f) r = doL False n f r + pureLayout (ThreeColMid n _ f) r = doL True n f r + handleMessage l m = hunk ./XMonad/Layout/ThreeColumns.hs 68 - where resize Shrink = ThreeCol middle nmaster delta (max (-0.5) $ frac-delta) - resize Expand = ThreeCol middle nmaster delta (min 1 $ frac+delta) - incmastern (IncMasterN d) = ThreeCol middle (max 0 (nmaster+d)) delta frac + where resize Shrink = l { threeColFrac = max (-0.5) $ f-d } + resize Expand = l { threeColFrac = min 1 $ f+d } + incmastern (IncMasterN x) = l { threeColNMaster = max 0 (n+x) } + n = threeColNMaster l + d = threeColDelta l + f = threeColFrac l hunk ./XMonad/Layout/ThreeColumns.hs 76 +doL :: Bool-> Int-> Rational-> Rectangle-> W.Stack a-> [(a, Rectangle)] +doL m n f r = ap zip (tile3 m f r n . length) . W.integrate + addfile ./XMonad/Layout/ThreeColumnsMiddle.hs hunk ./XMonad/Layout/ThreeColumnsMiddle.hs 1 +module XMonad.Layout.ThreeColumnsMiddle {-# DEPRECATED "Import XMonad.Layout.ThreeColumns instead" #-} + (module XMonad.Layout.ThreeColumns) where + +import XMonad.Layout.ThreeColumns (ThreeCol(ThreeColMid)) hunk ./xmonad-contrib.cabal 182 + XMonad.Layout.ThreeColumnsMiddle hunk ./XMonad/Prompt/AppLauncher.hs 18 - + ,module XMonad.Prompt hunk ./XMonad/Layout/ThreeColumns.hs 41 --- > myLayouts = ThreeCol 1 (3/100) (1/2) ||| etc.. +-- > myLayouts = ThreeCol 1 (3/100) (1/2) ||| ThreeColMid 1 (3/100) (1/2) ||| etc.. hunk ./XMonad/Layout/ThreeColumns.hs 44 --- If the first argument is true, the main window is placed in the center --- column. The second argument specifies hom many windows initially appear in --- the main window. The third argument argument specifies the amount to resize --- while resizing and the fourth argument specifies the initial size of the --- columns. A positive size designates the fraction of the screen that the main --- window should occupy, but if the size is negative the absolute value --- designates the fraction a slave column should occupy. If both slave columns --- are visible, they always occupy the same amount of space. +-- The first argument specifies hom many windows initially appear in the main +-- window. The second argument argument specifies the amount to resize while +-- resizing and the third argument specifies the initial size of the columns. +-- A positive size designates the fraction of the screen that the main window +-- should occupy, but if the size is negative the absolute value designates the +-- fraction a slave column should occupy. If both slave columns are visible, +-- they always occupy the same amount of space. +-- +-- The ThreeColMid variant places the main window between the slave columns. hunk ./XMonad/Util/Loggers.hs 4 --- Copyright : (c) Brent Yorgey +-- Copyright : (c) Brent Yorgey, Wirt Wolff hunk ./XMonad/Util/Loggers.hs 11 --- A collection of simple logger functions which can be used in the --- 'XMonad.Hooks.DynamicLog.ppExtras' field of a pretty-printing status --- logger format. See "XMonad.Hooks.DynamicLog" for more information. +-- A collection of simple logger functions and formatting utilities +-- which can be used in the 'XMonad.Hooks.DynamicLog.ppExtras' field of +-- a pretty-printing status logger format. See "XMonad.Hooks.DynamicLog" +-- for more information. hunk ./XMonad/Util/Loggers.hs 18 - -- * Usage - -- $usage + -- * Usage + -- $usage hunk ./XMonad/Util/Loggers.hs 21 - Logger + Logger hunk ./XMonad/Util/Loggers.hs 23 - , date - , loadAvg - , battery - , logCmd + -- * System Loggers + -- $system + , aumixVolume + , battery + , date + , loadAvg + , maildirNew, maildirUnread + , logCmd , logFileCount hunk ./XMonad/Util/Loggers.hs 32 - ) where + -- * XMonad Loggers + -- $xmonad + , logCurrent, logLayout, logTitle hunk ./XMonad/Util/Loggers.hs 36 + -- * Formatting Utilities + -- $format + , onLogger + , wrapL, fixedWidthL + , logSp, padL + , shortenL + , dzenColorL, xmobarColorL + + , (<$>) + + ) where + +import XMonad (liftIO) hunk ./XMonad/Util/Loggers.hs 50 +import qualified XMonad.StackSet as W +import XMonad.Hooks.DynamicLog +import XMonad.Util.Font (Align (..)) +import XMonad.Util.NamedWindows (getName) hunk ./XMonad/Util/Loggers.hs 55 -import System.Time +import Control.Applicative ((<$>)) +import Data.List (isPrefixOf, isSuffixOf) +import Data.Maybe (fromMaybe) +import Data.Traversable (traverse) +import System.Directory (getDirectoryContents) hunk ./XMonad/Util/Loggers.hs 61 -import System.Process (runInteractiveCommand) hunk ./XMonad/Util/Loggers.hs 62 +import System.Process (runInteractiveCommand) +import System.Time hunk ./XMonad/Util/Loggers.hs 66 --- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@: +-- Use this module by importing it into your @~\/.xmonad\/xmonad.hs@: hunk ./XMonad/Util/Loggers.hs 72 --- 'XMonad.Hooks.DynamicLoc.PP' format. For example: +-- 'XMonad.Hooks.DynamicLoc.PP', possibly with extra formatting . +-- For example: +-- +-- > -- display load averages and a pithy quote along with xmonad status. +-- > , logHook = dynamicLogWithPP $ defaultPP { +-- > ppExtras = [ padL loadAvg, logCmd "fortune -n 40 -s" ] +-- > } +-- > -- gives something like " 3.27 3.52 3.26 Drive defensively. Buy a tank." hunk ./XMonad/Util/Loggers.hs 81 --- > -- display load averages and a pithy quote along with xmonad status. --- > , logHook = dynamicLogWithPP $ defaultPP { ppExtras = [ loadAvg, logCmd "fortune -n 40 -s" ] } +-- See the formatting section below for another example using +-- a @where@ block to define some formatted loggers for a top-level +-- @myLogHook@. +-- +-- Loggers are named either for their function, as in 'battery', +-- 'aumixVolume', and 'maildirNew', or are prefixed with \"log\" when +-- making use of other functions or by analogy with the pp* functions. +-- For example, the logger version of 'XMonad.Hooks.DynamicLog.ppTitle' +-- is 'logTitle', and 'logFileCount' loggerizes the result of file +-- counting code. +-- +-- Formatting utility names are generally as short as possible and +-- carry the suffix \"L\". For example, the logger version of +-- 'XMonad.Hooks.DynamicLog.shorten' is 'shortenL'. hunk ./XMonad/Util/Loggers.hs 97 --- \'loggers\': they are just @X (Maybe String)@ actions. So you can +-- \"loggers\": they are just @X (Maybe String)@ actions. So you can hunk ./XMonad/Util/Loggers.hs 102 --- + + hunk ./XMonad/Util/Loggers.hs 108 +-- $system + +-- | Get the current volume with @aumix@. +aumixVolume :: Logger +aumixVolume = logCmd "aumix -vq" + +-- | Get the battery status (percent charge and charging\/discharging +-- status). This is an ugly hack and may not work for some people. +-- At some point it would be nice to make this more general\/have +-- fewer dependencies (assumes @\/usr\/bin\/acpi@ and @sed@ are installed.) +battery :: Logger +battery = logCmd "/usr/bin/acpi | sed -r 's/.*?: (.*%).*/\\1/; s/discharging, ([0-9]+%)/\\1-/; s/charging, ([0-9]+%)/\\1+/; s/charged, //'" + hunk ./XMonad/Util/Loggers.hs 138 --- | Get the battery status (percent charge and charging\/discharging --- status). This is an ugly hack and may not work for some people. --- At some point it would be nice to make this more general\/have --- fewer dependencies. -battery :: Logger -battery = logCmd "/usr/bin/acpi | sed -r 's/.*?: (.*%).*/\\1/; s/discharging, ([0-9]+%)/\\1-/; s/charging, ([0-9]+%)/\\1+/; s/charged, //'" - hunk ./XMonad/Util/Loggers.hs 143 + +-- | Get a count of filtered files in a directory. +-- See 'maildirUnread' and 'maildirNew' source for usage examples. +logFileCount :: FilePath -- ^ directory in which to count files + -> (String -> Bool) -- ^ predicate to match if file should be counted + -> Logger +logFileCount d p = do + c <- liftIO ( getDirectoryContents d) + let n = length $ Prelude.filter p c + case n of + 0 -> return Nothing + _ -> return $ Just $ show n + +-- | Get a count of unread mails in a maildir. For maildir format +-- details, to write loggers for other classes of mail, see +-- and 'logFileCount'. +maildirUnread :: FilePath -> Logger +maildirUnread mdir = logFileCount (mdir ++ "/cur/") (isSuffixOf ",") + +-- | Get a count of new mails in a maildir. +maildirNew :: FilePath -> Logger +maildirNew mdir = logFileCount (mdir ++ "/new/") (not . isPrefixOf ".") + +-- $xmonad +-- +-- A very small sample of what you can log since you have access to X. For +-- example you can loggerize the number of windows on each workspace, or +-- titles on other workspaces, or the id of the previously focused workspace.... + +-- | Get the title (name) of the focused window. +logTitle :: Logger +logTitle = withWindowSet $ traverse (fmap show . getName) . W.peek + +-- | Get the name of the current layout. +logLayout :: Logger +logLayout = withWindowSet $ return . Just . ld + where ld = description . W.layout . W.workspace . W.current + +-- | Get the name of the current workspace. +logCurrent :: Logger +logCurrent = withWindowSet $ return . Just . W.currentTag + +-- $format +-- Combine logger formatting functions to make your +-- 'XMonad.Hooks.DynamicLog.ppExtras' more colorful and readable. +-- (For convenience this module exports 'Control.Applicative.<$>' to +-- use instead of \'.\' or \'$\' in hard to read formatting lines. +-- For example: +-- +-- > myLogHook = dynamicLogWithPP defaultPP { +-- > -- skipped +-- > , ppExtras = [lLoad, lTitle, logSp 3, wrapL "[" "]" $ date "%a %d %b"] +-- > , ppOrder = \(ws,l,_,xs) -> [l,ws] ++ xs +-- > } +-- > where +-- > -- lTitle = fixedWidthL AlignCenter "." 99 . dzenColorL "cornsilk3" "" . padL . shortenL 80 $ logTitle +-- > -- or something like: +-- > lTitle = fixedWidthL AlignCenter "." 99 <$> dzenColorL "cornsilk3" "" <$> padL . shortenL 80 $ logTitle +-- > +-- > lLoad = dzenColorL "#6A5ACD" "" . wrapL loadIcon " " . padL $ loadAvg +-- > loadIcon = " ^i(/home/me/.dzen/icons/load.xbm)" +-- +-- Note: When applying 'shortenL' or 'fixedWidthL' to logger strings +-- containing colors or other formatting commands, apply the formatting +-- /after/ the length adjustment, or include \"invisible\" characters +-- in the length specification, e.g. in the above \'^fg(cornsilk3)\' and +-- \'^fg()' yields 19 invisible and 80 visible characters. + +-- | Use a string formatting function to edit a 'Logger' string. +-- For example, to create a tag function to prefix or label loggers, +-- as in \'tag: output\', use: +-- +-- > tagL l = onLogger $ wrap (l ++ ": ") "" +-- > +-- > tagL "bat" battery +-- > tagL "load" loadAvg +-- +-- If you already have a (String -> String) function you want to +-- apply to a logger: +-- +-- > revL = onLogger trim +-- +-- See formatting utility source code for more 'onLogger' usage examples. +onLogger :: (String -> String) -> Logger -> Logger +onLogger = fmap . fmap + +-- | Wrap a logger's output in delimiters, unless it is @X (Nothing)@ +-- or @X (Just \"\")@. Some examples: +-- +-- > wrapL " | " " | " (date "%a %d %b") -- ' | Tue 19 Feb | ' +-- > +-- > wrapL "bat: " "" battery -- ' bat: battery_logger_output' +wrapL :: String -> String -> Logger -> Logger +wrapL l r = onLogger $ wrap l r + +-- | Make a logger's output constant width by padding with the given string, +-- /even if the logger is/ @X (Nothing)@ /or/ @X (Just \"\")@. Useful to +-- reduce visual noise as a title logger shrinks and grows, to use a fixed +-- width for a logger that sometimes becomes Nothing, or even to create +-- fancy spacers or character based art effects. +-- +-- It fills missing logger output with a repeated character like \".\", +-- \":\" or pattern, like \" -.-\". The cycling padding string is reversed on +-- the left of the logger output. This is mainly useful with AlignCenter. +fixedWidthL :: Align -- ^ AlignCenter, AlignRight, or AlignLeft + -> String -- ^ String to cycle to pad missing logger output + -> Int -- ^ Fixed length to output (including invisible formatting characters) + -> Logger -> Logger +fixedWidthL a str n logger = do + mbl <- logger + let l = fromMaybe "" mbl + case a of + AlignCenter -> toL (take n $ padhalf l ++ l ++ cs) + AlignRight -> toL (reverse (take n $ reverse l ++ cs)) + AlignLeft -> toL (take n $ l ++ cs) + where + toL = return . Just + cs = cycle str + padhalf x = reverse $ take ((n - length x) `div` 2) cs + +-- | Create a \"spacer\" logger, e.g. @logSp 3 -- loggerizes \' \'@. +-- For more complex \"spacers\", use 'fixedWidthL' with @return Nothing@. +logSp :: Int -> Logger +logSp n = return . Just . take n $ cycle " " + +-- | Pad a logger's output with a leading and trailing space, unless it +-- is @X (Nothing)@ or @X (Just \"\")@. +padL :: Logger -> Logger +padL = onLogger pad + +-- | Limit a logger's length, adding \"...\" if truncated. +shortenL :: Int -> Logger -> Logger +shortenL = onLogger . shorten + +-- | Color a logger's output with dzen foreground and background colors. +-- +-- > dzenColorL "green" "#2A4C3F" battery +dzenColorL :: String -> String -> Logger -> Logger +dzenColorL fg bg = onLogger $ dzenColor fg bg + +-- | Color a logger's output with xmobar foreground and background colors. +-- +-- > xmobarColorL "#6A5ACD" "gray6" loadAverage +xmobarColorL :: String -> String -> Logger -> Logger +xmobarColorL fg bg = onLogger $ xmobarColor fg bg + +-- todo +-- * dynamicLogXinerama logger? Or sorted onscreen Id's with "current" indicator? +-- is logCurrent really useful at all? +-- +-- * ppVisible, etc. Resolve code dup. somehow. Refactor DynamicLog so can +-- be used for regular PP stuff /and/ loggers? +-- +-- * fns for "ppExtras as a whole", combine loggers more nicely. +-- +-- * parsers to use with fixedWidthL to be smarter about invisible characters? hunk ./XMonad/Layout/Mosaic.hs 46 --- > myLayouts = Mosaic (take 5 $ iterate (*0.7) 1 ||| Mosaic [3,1,1,1,1,1] ||| Full ||| etc.. +-- > myLayouts = Mosaic (take 5 $ iterate (*0.7) 1) ||| Mosaic [3,1,1,1,1,1] ||| Full ||| etc.. hunk ./XMonad/Actions/Submap.hs 78 - io $ ungrabKeyboard d currentTime - hunk ./XMonad/Actions/Submap.hs 80 + + io $ ungrabKeyboard d currentTime addfile ./XMonad/Layout/LayoutBuilder.hs hunk ./XMonad/Layout/LayoutBuilder.hs 1 +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.LayoutBuilder +-- Copyright : (c) 2009 Anders Engstrom +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : none +-- Stability : unstable +-- Portability : unportable +-- +-- A layout combinator that sends a specified number of windows to one rectangle +-- and the rest to another. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.LayoutBuilder ( + -- * Usage + -- $usage + layoutN, + layoutR, + layoutAll, + IncLayoutN (..), + SubMeasure (..), + SubBox (..), + absBox, + relBox +) where + +import XMonad +import XMonad.Layout +import qualified XMonad.StackSet as W +import Graphics.X11.Xlib +import Data.Maybe (isJust) +import Control.Monad + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.LayoutBuilder +-- +-- Then edit your @layoutHook@ by adding something like: +-- +-- > myLayouts = ( (layoutN 1 (relBox 0 0 0.5 1) (Just $ relBox 0 0 1 1) $ simpleTabbed) +-- > $ (layoutAll (relBox 0.5 0 1 1) $ simpleTabbed) +-- > ) ||| +-- > ( (layoutN 1 (relBox (1/3) 0 (1/2) 1) (Just $ relBox 0 0 1 1) $ Tall 0 0 0) +-- > $ (layoutR 0.1 0.5 (relBox (2/3) 0 1 1) Nothing $ Tall 0 0 0) +-- > $ (layoutAll (relBox 0 0 (1/3) 1) $ Tall 0 0 0) +-- > ) ||| +-- > ( (layoutN 1 (absBox (-512-200) 0 512 0) (Just $ relBox 0 0 1 1) $ simpleTabbed) +-- > $ (layoutN 1 (absBox (-200) 0 0 0) Nothing $ simpleTabbed) +-- > $ (layoutAll (absBox 0 0 (-512-200) 0) $ simpleTabbed) +-- > ) ||| Full ||| etc... +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- This will produce a layout similar to DragPane, but with the possibility to have multiple windows in the left half +-- and tabs that show the available windows. It will also produce a layout similar to ThreeColMid and a special layout +-- created for use with a 80 columns wide Emacs window, its sidebar and a tabbed area for all other windows. +-- +-- This module can be used to create many different custom layouts, but there are limitations. The primary limitation +-- can be observed in the second and third example when there are only two columns with windows in them. The leftmost +-- area is left blank. These blank areas can be avoided by placing the rectangles appropriately. +-- +-- These examples require "XMonad.Layout.Tabbed". +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- You may wish to add the following keybindings: +-- +-- > , ((modMask x .|. shiftMask, xK_h ), sendMessage $ IncLayoutN (-1)) +-- > , ((modMask x .|. shiftMask, xK_l ), sendMessage $ IncLayoutN 1) +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Use one layout in the specified area for a number of windows and possibly let another layout handle the rest. +data LayoutN l1 l2 a = + LayoutN (Maybe a) (Maybe a) (Either Int (Rational,Rational)) SubBox (Maybe SubBox) (l1 a) (Maybe (l2 a)) + deriving (Show,Read) + +-- | Use the specified layout in the described area for N windows and send the rest of the windows to the next layout in the chain. +-- It is possible to supply an alternative area that will then be used instead, if there are no windows to send to the next layout. +layoutN :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a) => + Int -> SubBox -> Maybe SubBox -> l1 a -> LayoutN l2 l3 a -> LayoutN l1 (LayoutN l2 l3) a +layoutN num box mbox sub next = LayoutN Nothing Nothing (Left num) box mbox sub (Just next) + +-- | As layoutN, but the number of windows is given relative to the total number of windows remaining to be handled. The first +-- argument is how much to change the ratio when using IncLayoutN, and the second is the initial ratio. +layoutR :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a) => + Rational -> Rational -> SubBox -> Maybe SubBox -> l1 a -> LayoutN l2 l3 a -> LayoutN l1 (LayoutN l2 l3) a +layoutR numdiff num box mbox sub next = LayoutN Nothing Nothing (Right (numdiff,num)) box mbox sub (Just next) + +-- | Use the specified layout in the described area for all remaining windows. +layoutAll :: (Read a, Eq a, LayoutClass l1 a) => + SubBox -> l1 a -> LayoutN l1 Full a +layoutAll box sub = LayoutN Nothing Nothing (Right (0,1)) box Nothing sub Nothing + +-- | Change the number of windows handled by the focused layout. +data IncLayoutN = IncLayoutN Int deriving Typeable +instance Message IncLayoutN + +-- | The absolute or relative measures used to describe the area a layout should be placed in. For negative absolute values +-- the total remaining space will be added. For sizes, the remaining space will also be added for zeroes. Relative values +-- are applied on the remaining space after the top-left corner of the box have been removed. +data SubMeasure = Abs Int | Rel Rational deriving (Show,Read) + +-- | A box to place a layout in. The stored values are xpos, ypos, width and height. +data SubBox = SubBox SubMeasure SubMeasure SubMeasure SubMeasure deriving (Show,Read) + +-- | Create a box with only absolute measurements. +absBox :: Int -> Int -> Int -> Int -> SubBox +absBox x y w h = SubBox (Abs x) (Abs y) (Abs w) (Abs h) + +-- | Create a box with only relative measurements. +relBox :: Rational -> Rational -> Rational -> Rational -> SubBox +relBox x y w h = SubBox (Rel x) (Rel y) (Rel w) (Rel h) + +instance (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => + LayoutClass (LayoutN l1 l2) a where + + -- | Update window locations. + runLayout (W.Workspace _ (LayoutN subf nextf num box mbox sub next) s) rect + = do let (subs,nexts,subf',nextf') = splitStack s num subf nextf + selBox = if isJust nextf' + then box + else maybe box id mbox + + (sublist,sub') <- handle sub subs $ calcArea selBox rect + + (nextlist,next') <- case next of Nothing -> return ([],Nothing) + Just n -> do (res,l) <- handle n nexts rect + return (res,Just l) + + return (sublist++nextlist, Just $ LayoutN subf' nextf' num box mbox sub' next' ) + where + handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r + l' <- return $ maybe l id ml + return (res,l') + + -- | Propagate messages. + handleMessage l m + | Just (IncLayoutN _) <- fromMessage m = windowNum l m + | Just (IncMasterN _) <- fromMessage m = sendFocus l m + | Just (Shrink) <- fromMessage m = sendFocus l m + | Just (Expand) <- fromMessage m = sendFocus l m + | otherwise = sendBoth l m + + -- | Descriptive name for layout. + description (LayoutN _ _ _ _ _ sub Nothing) = "layoutAll "++ description sub + description (LayoutN _ _ (Left _) _ _ sub (Just next)) = "layoutN "++ description sub ++" "++ description next + description (LayoutN _ _ (Right _) _ _ sub (Just next)) = "layoutR "++ description sub ++" "++ description next + + +windowNum :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a)) +windowNum l@(LayoutN subf nextf num box mbox subl nextl) m | (Just (IncLayoutN n)) <- fromMessage m = + do foc <- isFocus subf + if foc then do let newnum = case num of + (Left oldnum) -> Left $ max 1 $ oldnum + n + (Right (diff,oldnum)) -> Right (diff, min 1 $ max 0 $ oldnum + (fromIntegral n)*diff) + return $ Just $ LayoutN subf nextf newnum box mbox subl nextl + else sendNext l m +windowNum l m = sendNext l m + +sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a)) +sendSub (LayoutN subf nextf num box mbox sub next) m = + do sub' <- handleMessage sub m + return $ if isJust sub' + then Just $ LayoutN subf nextf num box mbox (maybe sub id sub') next + else Nothing + +sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a)) +sendBoth l@(LayoutN _ _ _ _ _ _ Nothing) m = sendSub l m +sendBoth (LayoutN subf nextf num box mbox sub (Just next)) m = + do sub' <- handleMessage sub m + next' <- handleMessage next m + return $ if isJust sub' || isJust next' + then Just $ LayoutN subf nextf num box mbox (maybe sub id sub') (Just $ maybe next id next') + else Nothing + +sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a)) +sendNext (LayoutN _ _ _ _ _ _ Nothing) _ = return Nothing +sendNext (LayoutN subf nextf num box mbox sub (Just next)) m = + do next' <- handleMessage next m + return $ if isJust next' + then Just $ LayoutN subf nextf num box mbox sub next' + else Nothing + +sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a)) +sendFocus l@(LayoutN subf _ _ _ _ _ _) m = do foc <- isFocus subf + if foc then sendSub l m + else sendNext l m + +isFocus :: (Show a) => Maybe a -> X Bool +isFocus Nothing = return False +isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset + return $ maybe False (\s -> show w == (show $ W.focus s)) ms + + +calcNum :: Int -> Either Int (Rational,Rational) -> Int +calcNum tot num = max 1 $ case num of Left i -> i + Right (_,r) -> ceiling $ r * fromIntegral tot + +splitStack :: Eq a => Maybe (W.Stack a) -> Either Int (Rational,Rational) -> Maybe a -> Maybe a -> (Maybe (W.Stack a),Maybe (W.Stack a),Maybe a,Maybe a) +splitStack Nothing _ _ _ = (Nothing,Nothing,Nothing,Nothing) +splitStack (Just s) num subf nextf = ( differentiate' subf' subl + , differentiate' nextf' nextl + , subf' + , nextf' + ) + where + ws = W.integrate s + n = calcNum (length ws) num + subl = take n ws + nextl = drop n ws + subf' = foc subl subf + nextf' = foc nextl nextf + foc [] _ = Nothing + foc l f = if W.focus s `elem` l + then Just $ W.focus s + else if maybe False (`elem` l) f + then f + else Just $ head l + +calcArea :: SubBox -> Rectangle -> Rectangle +calcArea (SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height' + where + xpos' = calc False xpos $ rect_width rect + ypos' = calc False ypos $ rect_height rect + width' = calc True width $ rect_width rect - xpos' + height' = calc True height $ rect_height rect - ypos' + + calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $ + case val of Rel v -> floor $ v * fromIntegral tot + Abs v -> if v<0 || (zneg && v==0) + then (fromIntegral tot)+v + else v + +differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q) +differentiate' _ [] = Nothing +differentiate' Nothing w = W.differentiate w +differentiate' (Just f) w + | f `elem` w = Just $ W.Stack { W.focus = f + , W.up = reverse $ takeWhile (/=f) w + , W.down = tail $ dropWhile (/=f) w + } + | otherwise = W.differentiate w hunk ./xmonad-contrib.cabal 150 + XMonad.Layout.LayoutBuilder hunk ./XMonad/Layout/LayoutBuilder.hs 45 --- > $ (layoutAll (relBox 0.5 0 1 1) $ simpleTabbed) +-- > $ (layoutAll (relBox 0.5 0 1 1) $ simpleTabbed) hunk ./XMonad/Layout/LayoutBuilder.hs 47 --- > ( (layoutN 1 (relBox (1/3) 0 (1/2) 1) (Just $ relBox 0 0 1 1) $ Tall 0 0 0) --- > $ (layoutR 0.1 0.5 (relBox (2/3) 0 1 1) Nothing $ Tall 0 0 0) --- > $ (layoutAll (relBox 0 0 (1/3) 1) $ Tall 0 0 0) +-- > ( (layoutN 1 (relBox (1/3) 0 (1/2) 1) (Just $ relBox 0 0 1 1) $ Tall 0 0 0) +-- > $ (layoutR 0.1 0.5 (relBox (2/3) 0 1 1) Nothing $ Tall 0 0 0) +-- > $ (layoutAll (relBox 0 0 (1/3) 1) $ Tall 0 0 0) hunk ./XMonad/Layout/LayoutBuilder.hs 51 --- > ( (layoutN 1 (absBox (-512-200) 0 512 0) (Just $ relBox 0 0 1 1) $ simpleTabbed) --- > $ (layoutN 1 (absBox (-200) 0 0 0) Nothing $ simpleTabbed) --- > $ (layoutAll (absBox 0 0 (-512-200) 0) $ simpleTabbed) --- > ) ||| Full ||| etc... +-- > ( (layoutN 1 (absBox (-512-200) 0 512 0) (Just $ relBox 0 0 1 1) $ simpleTabbed) +-- > $ (layoutN 1 (absBox (-200) 0 0 0) Nothing $ simpleTabbed) +-- > $ (layoutAll (absBox 0 0 (-512-200) 0) $ simpleTabbed) +-- > ) ||| Full ||| etc... hunk ./XMonad/Layout/LayoutBuilder.hs 80 +type WindowNum = Either Int (Rational,Rational) + hunk ./XMonad/Layout/LayoutBuilder.hs 84 - LayoutN (Maybe a) (Maybe a) (Either Int (Rational,Rational)) SubBox (Maybe SubBox) (l1 a) (Maybe (l2 a)) + LayoutN (Maybe a) (Maybe a) WindowNum SubBox (Maybe SubBox) (l1 a) (Maybe (l2 a)) hunk ./XMonad/Layout/LayoutBuilder.hs 90 - Int -> SubBox -> Maybe SubBox -> l1 a -> LayoutN l2 l3 a -> LayoutN l1 (LayoutN l2 l3) a + Int -- ^ The number of windows to handle + -> SubBox -- ^ The box to place the windows in + -> Maybe SubBox -- ^ Possibly an alternative box that is used when this layout handles all windows that are left + -> l1 a -- ^ The layout to use in the specified area + -> LayoutN l2 l3 a -- ^ Where to send the remaining windows + -> LayoutN l1 (LayoutN l2 l3) a -- ^ The resulting layout hunk ./XMonad/Layout/LayoutBuilder.hs 101 - Rational -> Rational -> SubBox -> Maybe SubBox -> l1 a -> LayoutN l2 l3 a -> LayoutN l1 (LayoutN l2 l3) a + Rational -- ^ How much to change the ratio with each IncLayoutN + -> Rational -- ^ The ratio of the remaining windows to handle + -> SubBox -- ^ The box to place the windows in + -> Maybe SubBox -- ^ Possibly an alternative box that is used when this layout handles all windows that are left + -> l1 a -- ^ The layout to use in the specified area + -> LayoutN l2 l3 a -- ^ Where to send the remaining windows + -> LayoutN l1 (LayoutN l2 l3) a -- ^ The resulting layout hunk ./XMonad/Layout/LayoutBuilder.hs 112 - SubBox -> l1 a -> LayoutN l1 Full a + SubBox -- ^ The box to place the windows in + -> l1 a -- ^ The layout to use in the specified area + -> LayoutN l1 Full a -- ^ The resulting layout hunk ./XMonad/Layout/LayoutBuilder.hs 129 --- | Create a box with only absolute measurements. -absBox :: Int -> Int -> Int -> Int -> SubBox + +-- | Create a box with only absolute measurements. If the values are negative, the total remaining space will be added. For +-- sizes it will also be added for zeroes. +absBox :: Int -- ^ Absolute X-Position + -> Int -- ^ Absolute Y-Position + -> Int -- ^ Absolute width + -> Int -- ^ Absolute height + -> SubBox -- ^ The resulting 'SubBox' describing the area hunk ./XMonad/Layout/LayoutBuilder.hs 139 + hunk ./XMonad/Layout/LayoutBuilder.hs 141 -relBox :: Rational -> Rational -> Rational -> Rational -> SubBox +relBox :: Rational -- ^ Relative X-Position with respect to the surrounding area + -> Rational -- ^ Relative Y-Position with respect to the surrounding area + -> Rational -- ^ Relative width with respect to the remaining width + -> Rational -- ^ Relative height with respect to the remaining height + -> SubBox -- ^ The resulting 'SubBox' describing the area hunk ./XMonad/Layout/LayoutBuilder.hs 148 + hunk ./XMonad/Layout/LayoutBuilder.hs 230 -calcNum :: Int -> Either Int (Rational,Rational) -> Int +calcNum :: Int -> WindowNum -> Int hunk ./XMonad/Layout/LayoutBuilder.hs 234 -splitStack :: Eq a => Maybe (W.Stack a) -> Either Int (Rational,Rational) -> Maybe a -> Maybe a -> (Maybe (W.Stack a),Maybe (W.Stack a),Maybe a,Maybe a) +splitStack :: Eq a => Maybe (W.Stack a) -> WindowNum -> Maybe a -> Maybe a -> (Maybe (W.Stack a),Maybe (W.Stack a),Maybe a,Maybe a) addfile ./XMonad/Layout/Spacing.hs hunk ./XMonad/Layout/Spacing.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Spacing +-- Copyright : (c) Brent Yorgey +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : portable +-- +-- Add a configurable amount of space around windows. +----------------------------------------------------------------------------- + +module XMonad.Layout.Spacing ( + -- * Usage + -- $usage + + spacing + + ) where + +import Graphics.X11 (Rectangle(..)) +import Control.Arrow (second) + +import XMonad.Layout.LayoutModifier + +-- $usage +-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Layout.Spacing +-- +-- and modifying your layoutHook as follows (for example): +-- +-- > layoutHook = spacing 2 $ Tall 1 (3/100) (1/2) +-- > -- put a 2px space around every window +-- + +-- | Surround all windows by a certain number of pixels of blank space. +spacing :: Int -> l a -> ModifiedLayout Spacing l a +spacing p = ModifiedLayout (Spacing p) + +data Spacing a = Spacing Int deriving (Show, Read) + +instance LayoutModifier Spacing a where + + pureModifier (Spacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing) + + modifierDescription (Spacing p) = "Spacing " ++ show p + +shrinkRect :: Int -> Rectangle -> Rectangle +shrinkRect p (Rectangle x y w h) = Rectangle (x+fi p) (y+fi p) (w-2*fi p) (h-2*fi p) + where fi n = fromIntegral n -- avoid the DMR hunk ./xmonad-contrib.cabal 175 + XMonad.Layout.Spacing hunk ./XMonad/Layout/LayoutHints.hs 45 --- > myLayouts = layoutHintsWithPlacement (0.5, 0.5) (Tall 1 (3/100) (1/2)) +-- > myLayouts = layoutHintsWithPlacement (0.5, 0.5) (Tall 1 (3/100) (1/2)) hunk ./XMonad/Layout/LayoutHints.hs 60 -layoutHintsWithPlacement :: (LayoutClass l a) => (Double, Double) +layoutHintsWithPlacement :: (LayoutClass l a) => (Double, Double) hunk ./XMonad/Layout/LayoutHints.hs 80 --- as @r@, but positioned inside of @r0@ as specified by the (rx, ry) parameters (see +-- as @r@, but positioned inside of @r0@ as specified by the (rx, ry) parameters (see hunk ./XMonad/Layout/LayoutHints.hs 2 - +{-# LANGUAGE ParallelListComp, PatternGuards #-} hunk ./XMonad/Layout/LayoutHints.hs 11 --- Portability : portable +-- Portability : unportable hunk ./XMonad/Layout/LayoutHints.hs 21 + , layoutHintsToCentre hunk ./XMonad/Layout/LayoutHints.hs 23 - , placeRectangle - ) where + ) where + +import XMonad(LayoutClass(runLayout), X, mkAdjust, Window, + Dimension, Position, Rectangle(Rectangle)) +import qualified XMonad.StackSet as W hunk ./XMonad/Layout/LayoutHints.hs 29 -import XMonad hiding ( trace ) -import XMonad.Layout.LayoutModifier -import XMonad.Layout.Decoration ( isInStack ) +import XMonad.Hooks.ManageDocks(Direction(..)) +import XMonad.Layout.Decoration(isInStack) +import XMonad.Layout.LayoutModifier(ModifiedLayout(..), + LayoutModifier(modifyLayout, redoLayout, modifierDescription)) +import Control.Applicative((<$>)) +import Control.Arrow(Arrow((***), second)) +import Control.Monad(Monad(return), mapM, join) +import Data.Function(on) +import Data.List(sortBy) hunk ./XMonad/Layout/LayoutHints.hs 39 -import Control.Applicative ( (<$>) ) -import Control.Arrow ( second ) +import Data.Set (Set) +import qualified Data.Set as Set hunk ./XMonad/Layout/LayoutHints.hs 58 +-- Or, to make a reasonable attempt to eliminate gaps between windows: +-- +-- > myLayouts = layoutHintsToCentre (Tall 1 (3/100) (1/2)) +-- hunk ./XMonad/Layout/LayoutHints.hs 78 -data LayoutHints a = LayoutHints (Double, Double) +-- | @layoutHintsToCentre layout@ applies hints, sliding the window to the +-- centre of the screen and expanding its neighbours to fill the gaps. Windows +-- are never expanded in a way that increases overlap. +-- +-- @layoutHintsToCentre@ only makes one pass at resizing the neighbours of +-- hinted windows, so with some layouts (ex. the arrangment with two 'Mirror' +-- 'Tall' stacked vertically), @layoutHintsToCentre@ may leave some gaps. +-- Simple layouts like 'Tall' are unaffected. +layoutHintsToCentre :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHintsToCentre l a +layoutHintsToCentre = ModifiedLayout LayoutHintsToCentre + +data LayoutHints a = LayoutHints (Double, Double) hunk ./XMonad/Layout/LayoutHints.hs 112 + +fitting :: [Rectangle] -> Int +fitting rects = sum $ do + r <- rects + return $ length $ filter (touching r) rects + +applyOrder :: Rectangle -> [(Window, Rectangle)] -> [[(Window, Rectangle)]] +applyOrder root wrs = do + -- perhaps it would just be better to take all permutations, or apply the + -- resizing multiple times + f <- [maximum, minimum, sum, sum . map sq] + return $ sortBy (compare `on` (f . distance)) wrs + where distFC = uncurry ((+) `on` sq) . pairWise (-) (centre root) + distance = map distFC . corners . snd + pairWise f (a,b) (c,d) = (f a c, f b d) + sq = join (*) + +data LayoutHintsToCentre a = LayoutHintsToCentre deriving (Read, Show) + +instance LayoutModifier LayoutHintsToCentre Window where + modifyLayout _ ws@(W.Workspace _ _ Nothing) r = runLayout ws r + modifyLayout _ ws@(W.Workspace _ _ (Just st)) r = do + (arrs,ol) <- runLayout ws r + flip (,) ol + . head . reverse . sortBy (compare `on` (fitting . map snd)) + <$> mapM (applyHints st r) (applyOrder r arrs) + +-- apply hints to first, grow adjacent windows +applyHints :: W.Stack Window -> Rectangle -> [(Window, Rectangle)] -> X [(Window, Rectangle)] +applyHints _ _ [] = return [] +applyHints s root ((w,lrect@(Rectangle a b c d)):xs) = do + adj <- mkAdjust w + let (c',d') = adj (c,d) + redr = placeRectangle (centrePlacement root lrect :: (Double,Double)) lrect + $ if isInStack s w then Rectangle a b c' d' else lrect + + ds = (fromIntegral c - fromIntegral c',fromIntegral d - fromIntegral d') + growOther' r = growOther ds lrect (freeDirs root lrect) r + mapSnd f = map (second f) + next <- applyHints s root $ mapSnd growOther' xs + return $ (w,redr):next + +growOther :: (Position, Position) -> Rectangle -> Set Direction -> Rectangle -> Rectangle +growOther ds lrect fds r + | dirs <- flipDir <$> Set.toList (Set.intersection adj fds) + , not $ any (uncurry opposite) $ cross dirs = + foldr (flip grow ds) r dirs + | otherwise = r + where + adj = adjacent lrect r + cross xs = [ (a,b) | a <- xs, b <- xs ] + + flipDir :: Direction -> Direction + flipDir d = case d of { L -> R; U -> D; R -> L; D -> U } + + opposite :: Direction -> Direction -> Bool + opposite x y = flipDir x == y + +-- | Leave the opposite edges where they were +grow :: Direction -> (Position,Position) -> Rectangle -> Rectangle +grow L (px,_ ) (Rectangle x y w h) = Rectangle (x-px) y (w+fromIntegral px) h +grow U (_ ,py) (Rectangle x y w h) = Rectangle x (y-py) w (h+fromIntegral py) +grow R (px,_ ) (Rectangle x y w h) = Rectangle x y (w+fromIntegral px) h +grow D (_ ,py) (Rectangle x y w h) = Rectangle x y w (h+fromIntegral py) + +comparingEdges :: ([Position] -> [Position] -> Bool) -> Rectangle -> Rectangle -> Set Direction +comparingEdges surrounds r1 r2 = Set.fromList $ map fst $ filter snd [ (\k -> (dir,k)) $ + any and [[dir `elem` [R,L], allEq [a,c,w,y], [b,d] `surrounds` [x,z]] + ,[dir `elem` [U,D], allEq [b,d,x,z], [a,c] `surrounds` [w,y]]] + | ((a,b),(c,d)) <- edge $ corners r1 + | ((w,x),(y,z)) <- edge $ delay 2 $ corners r2 + | dir <- [U,R,D,L]] + where edge (x:xs) = zip (x:xs) (xs ++ [x]) + edge [] = [] + delay n xs = drop n xs ++ take n xs + allEq = all (uncurry (==)) . edge + +-- | in what direction is the second window from the first that can expand if the +-- first is shrunk, assuming that the root window is fully covered: +-- one direction for a common edge +-- two directions for a common corner +adjacent :: Rectangle -> Rectangle -> Set Direction +adjacent = comparingEdges (all . onClosedInterval) + +-- | True whenever two edges touch. not (Set.null $ adjacent x y) ==> touching x y +touching :: Rectangle -> Rectangle -> Bool +touching a b = not . Set.null $ comparingEdges c a b + where c x y = any (onClosedInterval x) y || any (onClosedInterval y) x + +onClosedInterval :: Ord a => [a] -> a -> Bool +onClosedInterval bds x = minimum bds <= x && maximum bds >= x + +-- | starting top left going clockwise +corners :: Rectangle -> [(Position, Position)] +corners (Rectangle x y w h) = [(x,y) + ,(x+fromIntegral w, y) + ,(x+fromIntegral w, y+fromIntegral h) + ,(x, y+fromIntegral h)] + +centre :: Rectangle -> (Position, Position) +centre (Rectangle x y w h) = (avg x w, avg y h) + where avg a b = a + fromIntegral b `div` 2 + +centrePlacement :: RealFrac r => Rectangle -> Rectangle -> (r, r) +centrePlacement = centrePlacement' clamp + where clamp n = case signum n of + 0 -> 0.5 + 1 -> 1 + _ -> 0 + +freeDirs :: Rectangle -> Rectangle -> Set Direction +freeDirs root = Set.fromList . uncurry (++) . (lr *** ud) + . centrePlacement' signum root + where + lr 1 = [L] + lr (-1) = [R] + lr _ = [L,R] + ud 1 = [U] + ud (-1) = [D] + ud _ = [U,D] + +centrePlacement' :: (Position -> r) -> Rectangle -> Rectangle -> (r, r) +centrePlacement' cf root assigned + = (cf $ cx - cwx, cf $ cy - cwy) + where (cx,cy) = centre root + (cwx,cwy) = centre assigned + hunk ./XMonad/Layout/ResizableTile.hs 56 -data ResizableTall a = ResizableTall Int Rational Rational [Rational] deriving (Show, Read) +data ResizableTall a = ResizableTall + { _nmaster :: Int -- ^ number of master windows + , _delta :: Rational -- ^ change when resizing by 'Shrink', 'Expand', + -- 'MirrorShrink', 'MirrorExpand' + , _frac :: Rational -- ^ width of master + , _slaves :: [Rational] -- ^ fraction to multiply the window + -- height that would be given when divided equally. + -- + -- slave windows are assigned their modified + -- heights in order, from top to bottom + -- + -- unspecified values are replaced by 1 + } deriving (Show, Read) + hunk ./XMonad/Layout/Mosaic.hs 1 -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-} hunk ./XMonad/Layout/Mosaic.hs 20 - Mosaic(Mosaic) - ,Aspect(..) - ,shallower - ,steeper - ,growMaster - ,shrinkMaster + Aspect(..) + ,mosaic hunk ./XMonad/Layout/Mosaic.hs 23 + ,changeFocused hunk ./XMonad/Layout/Mosaic.hs 30 - LayoutClass(doLayout , pureMessage, description), Message, - fromMessage, splitHorizontallyBy, splitVerticallyBy, Rectangle) -import XMonad.StackSet(integrate) + LayoutClass(doLayout, handleMessage, pureMessage, description), + Message, X, fromMessage, withWindowSet, Resize(..), + splitHorizontallyBy, splitVerticallyBy, sendMessage, Rectangle) +import qualified XMonad.StackSet as W +import Control.Arrow(Control.Arrow.Arrow(second, first)) +import Control.Monad(mplus) hunk ./XMonad/Layout/Mosaic.hs 37 -import Data.Monoid(Monoid(mappend, mempty)) +import Data.Function(on) +import Data.List(sortBy) +import Data.Monoid(Monoid(mempty, mappend)) + hunk ./XMonad/Layout/Mosaic.hs 49 --- > myLayouts = Mosaic (take 5 $ iterate (*0.7) 1) ||| Mosaic [3,1,1,1,1,1] ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayouts = mosaic 2 [3,2] ||| Full ||| etc.. +-- > main = xmonad $ defaultConfig { layoutHook = myLayouts } hunk ./XMonad/Layout/Mosaic.hs 52 --- Unfortunately, infinite lists break serialization, so don't use them. +-- Unfortunately, infinite lists break serialization, so don't use them. And if +-- the list is too short, it is extended with @++ repeat 1@, which covers the +-- main use case. hunk ./XMonad/Layout/Mosaic.hs 61 --- > , ((modMask, xK_h), sendMessage Shrink >> sendMessage (SlopeMod shallower)) --- > , ((modMask, xK_l), sendMessage Expand >> sendMessage (SlopeMod steeper)) hunk ./XMonad/Layout/Mosaic.hs 77 -data Mosaic a - {- | The relative magnitudes (the sign is ignored) of the rational numbers - - provided determine the relative areas that the windows receive. The - - first number represents the size of the master window, the second is for - - the next window in the stack, and so on. Windows without a list element - - are hidden. - -} - = Mosaic [Rational] - -- override the aspect? current index, maximum index - | MosaicSt Bool Rational Int [Rational] - deriving (Read, Show) +-- | The relative magnitudes (the sign is ignored) of the rational numbers in +-- the second argument determine the relative areas that the windows receive. +-- The first number represents the size of the master window, the second is for +-- the next window in the stack, and so on. +-- +-- The list is extended with @++ repeat 1@, so @mosaic 1.5 []@ is like a +-- resizable grid. +-- +-- The first parameter is the multiplicative factor to use when responding to +-- the 'Expand' message. +mosaic :: Rational -> [Rational] -> Mosaic a +mosaic = Mosaic Nothing + +data Mosaic a = -- | True to override the aspect, current index, maximum index + Mosaic (Maybe(Bool,Rational,Int)) Rational [Rational] deriving (Read,Show) hunk ./XMonad/Layout/Mosaic.hs 96 - pureMessage (Mosaic _ss) _ms = Nothing - pureMessage (MosaicSt _ ix mix ss) ms = fromMessage ms >>= ixMod - where ixMod Taller | rix >= mix = Nothing - | otherwise = Just $ MosaicSt False (succ ix) mix ss - ixMod Wider | rix <= 0 = Nothing - | otherwise = Just $ MosaicSt False (pred ix) mix ss - ixMod Reset = Just $ Mosaic ss - ixMod (SlopeMod f) = Just $ MosaicSt False ix mix (f ss) - rix = round ix + pureMessage (Mosaic Nothing _ _) _ = Nothing + pureMessage (Mosaic (Just(_,ix,mix)) delta ss) ms = fromMessage ms >>= ixMod + where ixMod Taller | round ix >= mix = Nothing + | otherwise = Just $ Mosaic (Just(False,succ ix,mix)) delta ss + ixMod Wider | round ix <= (0::Integer) = Nothing + | otherwise = Just $ Mosaic (Just(False,pred ix,mix)) delta ss + ixMod Reset = Just $ Mosaic Nothing delta ss + ixMod (SlopeMod f) = Just $ Mosaic (Just(False,ix,mix)) delta (f ss) hunk ./XMonad/Layout/Mosaic.hs 105 - doLayout (Mosaic ss) r st = return (zip (integrate st) rect, newLayout) - where rects = splits (length $ integrate st) r ss - lrects = length rects - rect = rects !! (lrects `div` 2) - newLayout = Just $ MosaicSt True (fromIntegral lrects / 2) (pred lrects) ss + handleMessage l@(Mosaic _ delta _) ms + | Just Expand <- fromMessage ms = changeFocused (*delta) >> return Nothing + | Just Shrink <- fromMessage ms = changeFocused (/delta) >> return Nothing + | otherwise = return $ pureMessage l ms hunk ./XMonad/Layout/Mosaic.hs 110 - doLayout (MosaicSt override ix mix ss) r st - = return (zip (integrate st) rect, newLayout) - where rects = splits (length $ integrate st) r ss - lrects = length rects - nix = if mix == 0 || override then fromIntegral $ lrects `div` 2 - else max 0 $ min (fromIntegral $ pred lrects) - $ fromIntegral (pred lrects) * ix / fromIntegral mix - rect = rects !! round nix - newLayout = Just $ MosaicSt override nix (pred lrects) ss + doLayout (Mosaic state delta ss) r st = let + ssExt = zipWith const (ss ++ repeat 1) $ W.integrate st + rects = splits r ssExt + nls = length rects + fi = fromIntegral + nextIx (ov,ix,mix) + | mix <= 0 || ov = fromIntegral $ nls `div` 2 + | otherwise = max 0 $ (*fi (pred nls)) $ min 1 $ ix / fi mix + rect = rects !! maybe (nls `div` 2) round (nextIx `fmap` state) + state' = fmap (\x@(ov,_,_) -> (ov,nextIx x,pred nls)) state + `mplus` Just (True,fromIntegral nls / 2,pred nls) + ss' | and $ zipWith (==) ss ssExt = ss + | otherwise = ssExt + in return (zip (W.integrate st) rect, Just $ Mosaic state' delta ss') hunk ./XMonad/Layout/Mosaic.hs 127 +changeMaster :: (Rational -> Rational) -> X () +changeMaster = sendMessage . SlopeMod . onHead + +-- | Apply a function to the Rational that represents the currently focused +-- window. hunk ./XMonad/Layout/Mosaic.hs 133 --- Steeper and shallower scale the ratios of successive windows. --- --- growMaster and shrinkMaster just increase and decrease the size of the first --- element, and thus they change the layout very similarily to the standard --- 'Expand' or 'Shrink' for the 'Tall' layout. +-- 'Expand' and 'Shrink' messages are responded to with @changeFocused +-- (*delta)@ or @changeFocused (delta/)@ where @delta@ is the first argument to +-- 'mosaic'. hunk ./XMonad/Layout/Mosaic.hs 137 --- It may be possible to resize the specific focused window; however the same --- result could probably be achieved by promoting it, or moving it to a higher --- place in the list of windows; when you have a decreasing list of window --- sizes, the change in position will also result in a change in size. +-- This is exported because other functions (ex. @const 1@, @(+1)@) may be +-- useful to apply to the current area. +changeFocused :: (Rational -> Rational) -> X () +changeFocused f = withWindowSet $ sendMessage . SlopeMod + . maybe id (mulIx . length . W.up) + . W.stack . W.workspace . W.current + where mulIx i = uncurry (++) . second (onHead f) . splitAt i hunk ./XMonad/Layout/Mosaic.hs 145 -steeper :: [Rational] -> [Rational] -steeper [] = [] -steeper xs = map (subtract (minimum xs*0.8)) xs +onHead :: (a -> a) -> [a] -> [a] +onHead f = uncurry (++) . first (fmap f) . splitAt 1 hunk ./XMonad/Layout/Mosaic.hs 148 -shallower :: [Rational] -> [Rational] -shallower [] = [] -shallower xs = map (+(minimum xs*2)) xs +splits :: Rectangle -> [Rational] -> [[Rectangle]] +splits rect = map (reverse . map snd . sortBy (compare `on` fst)) + . splitsL rect . makeTree snd . zip [1..] + . normalize . reverse . map abs hunk ./XMonad/Layout/Mosaic.hs 153 -growMaster :: [Rational] -> [Rational] -growMaster = changeMaster 2 - -shrinkMaster :: [Rational] -> [Rational] -shrinkMaster = changeMaster 0.5 - --- | Multiply the area of the current master by a specified ratio -changeMaster :: Rational -> [Rational] -> [Rational] -changeMaster _ [] = [] -changeMaster f (x:xs) = f*x:xs - -splits :: Int -> Rectangle -> [Rational] -> [[Rectangle]] -splits num rect = splitsL rect . makeTree . normalize - . map abs . reverse . take num - --- recursively enumerate splits -splitsL :: Rectangle -> Tree Rational -> [[Rectangle]] +splitsL :: Rectangle -> Tree (Int,Rational) -> [[(Int,Rectangle)]] hunk ./XMonad/Layout/Mosaic.hs 155 -splitsL rect (Leaf _) = [[rect]] +splitsL rect (Leaf (x,_)) = [[(x,rect)]] hunk ./XMonad/Layout/Mosaic.hs 157 - let mkSplit f = f (sum l / (sum l + sum r)) rect + let mkSplit f = f ((sumSnd l /) $ sumSnd l + sumSnd r) rect + sumSnd = sum . fmap snd hunk ./XMonad/Layout/Mosaic.hs 167 - where lx = length xs - ly = length ys - zc = zipWith (++) + where lx = length xs + ly = length ys + zc = zipWith (++) hunk ./XMonad/Layout/Mosaic.hs 171 -extend :: Int -> [a] -> [a] -extend n pat = do - (p,e) <- zip pat $ replicate m True ++ repeat False - [p | e] ++ replicate d p - where (d,m) = n `divMod` length pat + extend :: Int -> [a] -> [a] + extend n pat = do + (p,e) <- zip pat $ replicate m True ++ repeat False + [p | e] ++ replicate d p + where (d,m) = n `divMod` length pat hunk ./XMonad/Layout/Mosaic.hs 178 -normalize x = let s = sum x - in map (/s) x +normalize x = let s = sum x in map (/s) x hunk ./XMonad/Layout/Mosaic.hs 181 - deriving (Show) hunk ./XMonad/Layout/Mosaic.hs 187 +instance Functor Tree where + fmap f (Leaf x) = Leaf $ f x + fmap f (Branch l r) = Branch (fmap f l) (fmap f r) + fmap _ Empty = Empty + hunk ./XMonad/Layout/Mosaic.hs 198 -makeTree :: [Rational] -> Tree Rational -makeTree [] = Empty -makeTree [x] = Leaf x -makeTree xs = Branch (makeTree a) (makeTree b) - where ((a,b),_) = foldr w (([],[]),(0,0)) xs - w n ((ls,rs),(l,r)) = if l > r then ((ls,n:rs),(l,n+r)) - else ((n:ls,rs),(n+l,r)) +makeTree :: (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a +makeTree _ [] = Empty +makeTree _ [x] = Leaf x +makeTree f xs = Branch (makeTree f a) (makeTree f b) + where ((a,b),_) = foldr go (([],[]),(0,0)) xs + go n ((ls,rs),(l,r)) + | l > r = ((ls,n:rs),(l,f n+r)) + | otherwise = ((n:ls,rs),(f n+l,r)) addfile ./XMonad/Actions/FloatSnap.hs hunk ./XMonad/Actions/FloatSnap.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.FloatSnap +-- Copyright : (c) 2009 Anders Engstrom +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : none +-- Stability : unstable +-- Portability : unportable +-- +-- Move and resize floating windows using other windows and the edge of the +-- screen as guidelines. +----------------------------------------------------------------------------- + +module XMonad.Actions.FloatSnap ( + -- * Usage + -- $usage + Direction(..), + snapMove, + snapGrow, + snapShrink, + snapMagicMove, + snapMagicResize) where + +import XMonad +import Data.List (sort) +import Data.Maybe (listToMaybe,fromJust,isNothing) +import qualified XMonad.StackSet as W + +import XMonad.Hooks.ManageDocks (Direction(..)) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.FloatSnap +-- +-- Then add appropriate key bindings, for example: +-- +-- > , ((modMask x, xK_Left), withFocused $ snapMove L Nothing) +-- > , ((modMask x, xK_Right), withFocused $ snapMove R Nothing) +-- > , ((modMask x, xK_Up), withFocused $ snapMove U Nothing) +-- > , ((modMask x, xK_Down), withFocused $ snapMove D Nothing) +-- > , ((modMask x .|. shiftMask, xK_Left), withFocused $ snapShrink R Nothing) +-- > , ((modMask x .|. shiftMask, xK_Right), withFocused $ snapGrow R Nothing) +-- > , ((modMask x .|. shiftMask, xK_Up), withFocused $ snapShrink D Nothing) +-- > , ((modMask x .|. shiftMask, xK_Down), withFocused $ snapGrow D Nothing) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". +-- +-- And possibly add an appropriate mouse binding, for example: +-- +-- > , ((modMask x, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicMove (Just 50) (Just 50) w)) +-- > , ((modMask x, button3), (\w -> focus w >> mouseResizeWindow w >> snapMagicResize (Just 50) (Just 50) w)) +-- +-- For detailed instructions on editing your mouse bindings, see +-- "XMonad.Doc.Extending#Editing_mouse_bindings". +-- +-- Using these mouse bindings, it will not snap while moving, but allow you to click the window once after it has been moved or resized to snap it into place. +-- Note that the order in which the commands are applied in the mouse bindings are important. +-- +-- Interesting values for the distance to look for window in the orthogonal axis are Nothing (to snap against every window), Just 0 (to only snap +-- against windows that we should collide with geometrically while moving) and Just 1 (to also snap against windows we brush against). +-- +-- For 'snapMagicMove' and 'snapMagicResize', try instead setting it to the same as the maximum snapping distance. +-- +-- When a value is specified it can be geometrically conceived as adding a border with the specified width around the window and then checking which +-- windows it should collide with. + +-- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen. +snapMagicResize :: + Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. + -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary. + -> Window -- ^ The window to move and resize. + -> X () +snapMagicResize collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + + (nx,nw) <- handleAxis True d wa + (ny,nh) <- handleAxis False d wa + + io $ moveWindow d w (fromIntegral nx) (fromIntegral ny) + io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh) + float w + where + handleAxis horiz d wa = do + ((mbl,mbr,bs),(mfl,mfr,fs)) <- getSnap horiz collidedist d w + let begin = if bs + then wpos wa + else case (mbl,mbr) of + (Just bl,Just br) -> if wpos wa - bl < br - wpos wa then bl else br + (Just bl,Nothing) -> bl + (Nothing,Just br) -> br + (Nothing,Nothing) -> wpos wa + end = if fs + then wpos wa + wdim wa + else case (if mfl==(Just begin) then Nothing else mfl,mfr) of + (Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr + (Just fl,Nothing) -> fl + (Nothing,Just fr) -> fr + (Nothing,Nothing) -> wpos wa + wdim wa + begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else (wpos wa) + end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else (wpos wa + wdim wa) + return (begin',end'-begin') + where + (wpos, wdim, _, _) = constructors horiz + + +-- | Move a window by both axises in any direction to snap against the closest part of other windows or the edge of the screen. +snapMagicMove :: + Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. + -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary. + -> Window -- ^ The window to move. + -> X () +snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + + nx <- handleAxis True d wa + ny <- handleAxis False d wa + + io $ moveWindow d w (fromIntegral nx) (fromIntegral ny) + float w + where + handleAxis horiz d wa = do + ((mbl,mbr,bs),(mfl,mfr,fs)) <- getSnap horiz collidedist d w + return $ if bs || fs + then wpos wa + else let b = case (mbl,mbr) of + (Just bl,Just br) -> if wpos wa - bl < br - wpos wa then bl else br + (Just bl,Nothing) -> bl + (Nothing,Just br) -> br + (Nothing,Nothing) -> wpos wa + f = case (mfl,mfr) of + (Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr + (Just fl,Nothing) -> fl + (Nothing,Just fr) -> fr + (Nothing,Nothing) -> wpos wa + newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else (f - wdim wa) + in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else (wpos wa) + where + (wpos, wdim, _, _) = constructors horiz + +-- | Move a window in the specified direction until it snaps against another window or the edge of the screen. +snapMove :: + Direction -- ^ What direction to move the window in. + -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. + -> Window -- ^ The window to move. + -> X () +snapMove L = doSnapMove True True +snapMove R = doSnapMove True False +snapMove U = doSnapMove False True +snapMove D = doSnapMove False False + +doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X () +doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + ((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w + + let (mb,mf) = if rev then (bl,fl) + else (br,fr) + + newpos = fromIntegral $ case (mb,mf) of + (Just b,Nothing) -> b + (Nothing,Just f) -> f - wdim wa + (Just b,Just f) -> if rev /= (b < f - wdim wa) + then b + else f - wdim wa + _ -> wpos wa + + if horiz then io $ moveWindow d w newpos (fromIntegral $ wa_y wa) + else io $ moveWindow d w (fromIntegral $ wa_x wa) newpos + float w + + where + (wpos, wdim, _, _) = constructors horiz + +-- | Grow the specified edge of a window until it snaps against another window or the edge of the screen. +snapGrow :: + Direction -- ^ What edge of the window to grow. + -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. + -> Window -- ^ The window to grow. + -> X () +snapGrow = snapResize True + +-- | Shrink the specified edge of a window until it snaps against another window or the edge of the screen. +snapShrink :: + Direction -- ^ What edge of the window to shrink. + -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. + -> Window -- ^ The window to grow. + -> X () +snapShrink = snapResize False + +snapResize :: Bool -> Direction -> Maybe Int -> Window -> X () +snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do + io $ raiseWindow d w + wa <- io $ getWindowAttributes d w + mr <- case dir of + L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w + return $ case (if grow then mg else ms) of + Just v -> Just (v, wy wa, ww wa + wx wa - v, wh wa) + _ -> Nothing + R -> do ((_,_,_),(ms,mg,_)) <- getSnap True collidedist d w + return $ case (if grow then mg else ms) of + Just v -> Just (wx wa, wy wa, v - wx wa, wh wa) + _ -> Nothing + U -> do ((mg,ms,_),(_,_,_)) <- getSnap False collidedist d w + return $ case (if grow then mg else ms) of + Just v -> Just (wx wa, v, ww wa, wh wa + wy wa - v) + _ -> Nothing + D -> do ((_,_,_),(ms,mg,_)) <- getSnap False collidedist d w + return $ case (if grow then mg else ms) of + Just v -> Just (wx wa, wy wa, ww wa, v - wy wa) + _ -> Nothing + + case mr of + Nothing -> return () + Just (nx,ny,nw,nh) -> if nw>0 && nh>0 then do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny) + io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh) + else return () + float w + where + wx = fromIntegral.wa_x + wy = fromIntegral.wa_y + ww = fromIntegral.wa_width + wh = fromIntegral.wa_height + + +getSnap :: Bool -> Maybe Int -> Display -> Window -> X ((Maybe Int,Maybe Int,Bool),(Maybe Int,Maybe Int,Bool)) +getSnap horiz collidedist d w = do + wa <- io $ getWindowAttributes d w + screen <- W.current `fmap` gets windowset + let sr = screenRect $ W.screenDetail screen + wl = W.integrate' $ W.stack $ W.workspace screen + wla <- filter (collides wa) `fmap` (io $ mapM (getWindowAttributes d) $ filter (/=w) wl) + + return ( neighbours (back wa sr wla) (wpos wa) + , neighbours (front wa sr wla) (wpos wa + wdim wa) + ) + + where + wborder = fromIntegral.wa_border_width + + (wpos, wdim, rpos, rdim) = constructors horiz + (refwpos, refwdim, _, _) = constructors $ not horiz + + back wa sr wla = dropWhile (< rpos sr) $ + takeWhile (< rpos sr + rdim sr) $ + sort $ (rpos sr):foldr (\a as -> (wpos a):(wpos a + wdim a + wborder a + wborder wa):as) [] wla + + front wa sr wla = dropWhile (<= rpos sr) $ + takeWhile (<= rpos sr + rdim sr) $ + sort $ (rpos sr + rdim sr - 2*(wborder wa)):foldr (\a as -> (wpos a - wborder a - wborder wa):(wpos a + wdim a):as) [] wla + + neighbours l v = ( listToMaybe $ reverse $ takeWhile (< v) l + , listToMaybe $ dropWhile (<= v) l + , v `elem` l + ) + + collides wa oa = case collidedist of + Nothing -> True + Just dist -> ( refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist + && refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa ) + + +constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int) +constructors True = ( fromIntegral.wa_x + , fromIntegral.wa_width + , fromIntegral.rect_x + , fromIntegral.rect_width + ) +constructors False = ( fromIntegral.wa_y + , fromIntegral.wa_height + , fromIntegral.rect_y + , fromIntegral.rect_height + ) hunk ./xmonad-contrib.cabal 81 + XMonad.Actions.FloatSnap hunk ./XMonad/Actions/FloatSnap.hs 23 - snapMagicResize) where + snapMagicResize, + snapMagicMouseResize) where hunk ./XMonad/Actions/FloatSnap.hs 54 --- > , ((modMask x, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicMove (Just 50) (Just 50) w)) --- > , ((modMask x, button3), (\w -> focus w >> mouseResizeWindow w >> snapMagicResize (Just 50) (Just 50) w)) +-- > , ((modMask x, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicMove (Just 50) (Just 50) w)) +-- > , ((modMask x .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicResize [L,R,U,D] (Just 50) (Just 50) w)) +-- > , ((modMask x, button3), (\w -> focus w >> mouseResizeWindow w >> snapMagicResize [R,D] (Just 50) (Just 50) w)) hunk ./XMonad/Actions/FloatSnap.hs 67 --- For 'snapMagicMove' and 'snapMagicResize', try instead setting it to the same as the maximum snapping distance. +-- For 'snapMagicMove', 'snapMagicResize' and 'snapMagicMouseResize', try instead setting it to the same as the maximum snapping distance. hunk ./XMonad/Actions/FloatSnap.hs 72 --- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen. -snapMagicResize :: - Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. +-- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen. Use the location of the +-- mouse over the window to decide which edges to snap. In corners, the two adjoining edges will be snapped, along the middle of an edge only that edge +-- will be snapped. In the center of the window all edges will snap. Intended to be used together with "XMonad.Actions.FlexibleResize" or +-- "XMonad.Actions.FlexibleManipulate". +snapMagicMouseResize + :: Rational -- ^ How big the middle snap area of each axis should be. + -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. hunk ./XMonad/Actions/FloatSnap.hs 82 -snapMagicResize collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do +snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do + wa <- io $ getWindowAttributes d w + (_, _, _, px, py, _, _, _) <- io $ queryPointer d w + let x = (fromIntegral px - wx wa)/(ww wa) + y = (fromIntegral py - wy wa)/(wh wa) + ml = if x <= (0.5 - middle/2) then [L] else [] + mr = if x > (0.5 + middle/2) then [R] else [] + mu = if y <= (0.5 - middle/2) then [U] else [] + md = if y > (0.5 + middle/2) then [D] else [] + mdir = ml++mr++mu++md + dir = if mdir == [] + then [L,R,U,D] + else mdir + snapMagicResize dir collidedist snapdist w + where + wx = fromIntegral.wa_x + wy = fromIntegral.wa_y + ww = fromIntegral.wa_width + wh = fromIntegral.wa_height + +-- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen. +snapMagicResize + :: [Direction] -- ^ The edges to snap. + -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. + -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary. + -> Window -- ^ The window to move and resize. + -> X () +snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do hunk ./XMonad/Actions/FloatSnap.hs 113 - (nx,nw) <- handleAxis True d wa - (ny,nh) <- handleAxis False d wa + (xbegin,xend) <- handleAxis True d wa + (ybegin,yend) <- handleAxis False d wa hunk ./XMonad/Actions/FloatSnap.hs 116 - io $ moveWindow d w (fromIntegral nx) (fromIntegral ny) - io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh) + let xbegin' = if L `elem` dir then xbegin else (wx wa) + xend' = if R `elem` dir then xend else (wx wa + ww wa) + ybegin' = if U `elem` dir then ybegin else (wy wa) + yend' = if D `elem` dir then yend else (wy wa + wh wa) + + io $ moveWindow d w (fromIntegral $ xbegin') (fromIntegral $ ybegin') + io $ resizeWindow d w (fromIntegral $ xend' - xbegin') (fromIntegral $ yend' - ybegin') hunk ./XMonad/Actions/FloatSnap.hs 125 + wx = fromIntegral.wa_x + wy = fromIntegral.wa_y + ww = fromIntegral.wa_width + wh = fromIntegral.wa_height + hunk ./XMonad/Actions/FloatSnap.hs 148 - return (begin',end'-begin') + return (begin',end') hunk ./XMonad/Actions/FloatSnap.hs 154 -snapMagicMove :: - Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. +snapMagicMove + :: Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. hunk ./XMonad/Actions/FloatSnap.hs 189 -snapMove :: - Direction -- ^ What direction to move the window in. +snapMove + :: Direction -- ^ What direction to move the window in. hunk ./XMonad/Actions/FloatSnap.hs 224 -snapGrow :: - Direction -- ^ What edge of the window to grow. +snapGrow + :: Direction -- ^ What edge of the window to grow. hunk ./XMonad/Actions/FloatSnap.hs 232 -snapShrink :: - Direction -- ^ What edge of the window to shrink. +snapShrink + :: Direction -- ^ What edge of the window to shrink. hunk ./XMonad/Actions/FloatSnap.hs 235 - -> Window -- ^ The window to grow. + -> Window -- ^ The window to shrink. hunk ./XMonad/Actions/FloatSnap.hs 7 --- Maintainer : none +-- Maintainer : Anders Engstrom hunk ./XMonad/Layout/LayoutBuilder.hs 8 --- Maintainer : none +-- Maintainer : Anders Engstrom hunk ./XMonad/Actions/FloatSnap.hs 27 +import Control.Monad(filterM) +import Control.Applicative((<$>)) hunk ./XMonad/Actions/FloatSnap.hs 33 -import XMonad.Hooks.ManageDocks (Direction(..)) +import XMonad.Hooks.ManageDocks (Direction(..),getStrut) hunk ./XMonad/Actions/FloatSnap.hs 279 - screen <- W.current `fmap` gets windowset + screen <- W.current <$> gets windowset + unManaged <- unManagedDocks hunk ./XMonad/Actions/FloatSnap.hs 282 - wl = W.integrate' $ W.stack $ W.workspace screen + wl = (unManaged ++) . W.integrate' . W.stack $ W.workspace screen hunk ./XMonad/Actions/FloatSnap.hs 313 + unManagedDocks :: X [Window] + unManagedDocks = withWindowSet $ \ws -> withDisplay $ \disp -> + fmap (filter (`notElem` W.allWindows ws)) . + filterM (fmap (not . null) . getStrut) . (\(_,_,x) -> x) + =<< io . queryTree disp + =<< asks theRoot hunk ./XMonad/Hooks/ManageDocks.hs 21 - ToggleStruts(..), Direction(..) + ToggleStruts(..), Direction(..), + + -- for XMonad.Actions.FloatSnap + getStrut hunk ./XMonad/Layout/ThreeColumnsMiddle.hs 1 -module XMonad.Layout.ThreeColumnsMiddle {-# DEPRECATED "Import XMonad.Layout.ThreeColumns instead" #-} - (module XMonad.Layout.ThreeColumns) where - -import XMonad.Layout.ThreeColumns (ThreeCol(ThreeColMid)) rmfile ./XMonad/Layout/ThreeColumnsMiddle.hs hunk ./xmonad-contrib.cabal 185 - XMonad.Layout.ThreeColumnsMiddle hunk ./XMonad/Actions/Search.hs 32 + alpha, hunk ./XMonad/Actions/Search.hs 90 +* 'alpha' -- Wolfram|Alpha query. + hunk ./XMonad/Actions/Search.hs 274 -amazon, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, - imdb, isohunt, maps, mathworld, scholar, thesaurus, wayback, wikipedia, +amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, + images, imdb, isohunt, maps, mathworld, scholar, thesaurus, wayback, wikipedia, hunk ./XMonad/Actions/Search.hs 278 +alpha = searchEngine "alpha" "http://www.wolframalpha.com/input/?i=" hunk ./XMonad/Actions/Search.hs 302 -multi = namedEngine "multi" $ foldr1 (!>) [amazon, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, maps, mathworld, scholar, thesaurus, wayback, wikipedia, (prefixAware google)] +multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, maps, mathworld, scholar, thesaurus, wayback, wikipedia, (prefixAware google)] hunk ./XMonad/Layout/Mosaic.hs 121 - ss' | and $ zipWith (==) ss ssExt = ss - | otherwise = ssExt + ss' = maybe ss (const ss `either` const ssExt) $ zipRemain ss ssExt hunk ./XMonad/Layout/Mosaic.hs 124 +zipRemain :: [a] -> [b] -> Maybe (Either [a] [b]) +zipRemain (_:xs) (_:ys) = zipRemain xs ys +zipRemain [] [] = Nothing +zipRemain [] y = Just (Right y) +zipRemain x [] = Just (Left x) + hunk ./XMonad/Actions/FloatSnap.hs 27 -import Control.Monad(filterM) hunk ./XMonad/Actions/FloatSnap.hs 32 -import XMonad.Hooks.ManageDocks (Direction(..),getStrut) +import XMonad.Hooks.ManageDocks (Direction(..),calcGap) hunk ./XMonad/Actions/FloatSnap.hs 279 - unManaged <- unManagedDocks hunk ./XMonad/Actions/FloatSnap.hs 280 - wl = (unManaged ++) . W.integrate' . W.stack $ W.workspace screen + wl = W.integrate' . W.stack $ W.workspace screen + gr <- fmap ($sr) $ calcGap [L,R,U,D] hunk ./XMonad/Actions/FloatSnap.hs 284 - return ( neighbours (back wa sr wla) (wpos wa) - , neighbours (front wa sr wla) (wpos wa + wdim wa) + return ( neighbours (back wa sr gr wla) (wpos wa) + , neighbours (front wa sr gr wla) (wpos wa + wdim wa) hunk ./XMonad/Actions/FloatSnap.hs 294 - back wa sr wla = dropWhile (< rpos sr) $ - takeWhile (< rpos sr + rdim sr) $ - sort $ (rpos sr):foldr (\a as -> (wpos a):(wpos a + wdim a + wborder a + wborder wa):as) [] wla + back wa sr gr wla = dropWhile (< rpos sr) $ + takeWhile (< rpos sr + rdim sr) $ + sort $ (rpos sr):(rpos gr):(rpos gr + rdim gr): + foldr (\a as -> (wpos a):(wpos a + wdim a + wborder a + wborder wa):as) [] wla hunk ./XMonad/Actions/FloatSnap.hs 299 - front wa sr wla = dropWhile (<= rpos sr) $ - takeWhile (<= rpos sr + rdim sr) $ - sort $ (rpos sr + rdim sr - 2*(wborder wa)):foldr (\a as -> (wpos a - wborder a - wborder wa):(wpos a + wdim a):as) [] wla + front wa sr gr wla = dropWhile (<= rpos sr) $ + takeWhile (<= rpos sr + rdim sr) $ + sort $ (rpos gr - 2*wborder wa):(rpos gr + rdim gr - 2*wborder wa):(rpos sr + rdim sr - 2*wborder wa): + foldr (\a as -> (wpos a - wborder a - wborder wa):(wpos a + wdim a):as) [] wla hunk ./XMonad/Actions/FloatSnap.hs 314 - unManagedDocks :: X [Window] - unManagedDocks = withWindowSet $ \ws -> withDisplay $ \disp -> - fmap (filter (`notElem` W.allWindows ws)) . - filterM (fmap (not . null) . getStrut) . (\(_,_,x) -> x) - =<< io . queryTree disp - =<< asks theRoot hunk ./XMonad/Hooks/ManageDocks.hs 24 - getStrut + calcGap hunk ./XMonad/Util/Font.hsc 46 -#if defined XFT || defined USE_UTF8 hunk ./XMonad/Util/Font.hsc 47 -#endif + hunk ./XMonad/Util/Font.hsc 105 -#ifdef USE_UTF8 hunk ./XMonad/Util/Font.hsc 106 -#else - fmap Core $ initCoreFont s -#endif hunk ./XMonad/Util/Font.hsc 193 -#if defined XFT || defined USE_UTF8 hunk ./XMonad/Util/Font.hsc 194 -#else -decodeInput = id -#endif hunk ./XMonad/Util/Font.hsc 196 -#if defined XFT || defined USE_UTF8 hunk ./XMonad/Util/Font.hsc 197 -#else -encodeOutput = id -#endif hunk ./XMonad/Util/XSelection.hs 34 -#ifdef USE_UTF8 hunk ./XMonad/Util/XSelection.hs 35 -#else -import Data.Bits (shiftL, (.&.), (.|.)) -import Data.Char (chr) -import Data.Word (Word8) -{- | Decode a UTF8 string packed into a list of Word8 values, directly to - String; does not deal with CChar, hence you will want the counter-intuitive @map fromIntegral@ - UTF-8 decoding for internal use in getSelection. - - This code is copied from Eric Mertens's "utf-string" library - (as of version 0.1),\which is BSD-3 licensed like this module. - It'd be better to just @import Codec.Binary.UTF8.String (decode)@, but then users of this would need to install it; XMonad has enough - dependencies already. -} -decode :: [Word8] -> String -decode [] = "" -decode (c:cs) - | c < 0x80 = chr (fromEnum c) : decode cs - | c < 0xc0 = replacement_character : decode cs - | c < 0xe0 = multi_byte 1 0x1f 0x80 - | c < 0xf0 = multi_byte 2 0xf 0x800 - | c < 0xf8 = multi_byte 3 0x7 0x10000 - | c < 0xfc = multi_byte 4 0x3 0x200000 - | c < 0xfe = multi_byte 5 0x1 0x4000000 - | otherwise = replacement_character : decode cs - where - - replacement_character :: Char - replacement_character = '\xfffd' - - multi_byte :: Int -> Word8 -> Int -> [Char] - multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask)) - where - aux 0 rs acc - | overlong <= acc && acc <= 0x10ffff && - (acc < 0xd800 || 0xdfff < acc) && - (acc < 0xfffe || 0xffff < acc) = chr acc : decode rs - | otherwise = replacement_character : decode rs - aux n (r:rs) acc - | r .&. 0xc0 == 0x80 = aux (n-1) rs - $ shiftL acc 6 .|. fromEnum (r .&. 0x3f) - aux _ rs _ = replacement_character : decode rs -#endif hunk ./xmonad-contrib.cabal 55 - cpp-options: -DUSE_UTF8 hunk ./XMonad/Actions/FlexibleResize.hs 18 - XMonad.Actions.FlexibleResize.mouseResizeWindow + XMonad.Actions.FlexibleResize.mouseResizeWindow, + XMonad.Actions.FlexibleResize.mouseResizeEdgeWindow hunk ./XMonad/Actions/FlexibleResize.hs 39 -mouseResizeWindow :: Window -> X () -mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do +mouseResizeWindow + :: Window -- ^ The window to resize. + -> X () +mouseResizeWindow = mouseResizeEdgeWindow 0 + + +-- | Resize a floating window from whichever corner or edge the mouse is +-- closest to. +mouseResizeEdgeWindow + :: Rational -- ^ The size of the area where only one edge is resized. + -> Window -- ^ The window to resize. + -> X () +mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do hunk ./XMonad/Actions/FlexibleResize.hs 57 - [pos_x, pos_y, width, height] = map (fromIntegral . ($ wa)) [wa_x, wa_y, wa_width, wa_height] - west = firstHalf ix width - north = firstHalf iy height + [pos_x, pos_y, width, height] = map (fi . ($ wa)) [wa_x, wa_y, wa_width, wa_height] + west = findPos ix width + north = findPos iy height hunk ./XMonad/Actions/FlexibleResize.hs 63 - mouseDrag (\ex ey -> do - wa' <- io $ getWindowAttributes d w - let [px, py] = map (fromIntegral . ($ wa')) [wa_x, wa_y] - io $ moveResizeWindow d w (fx px (fromIntegral ex)) - (fy py (fromIntegral ey)) - `uncurry` applySizeHintsContents sh (gx $ fromIntegral ex, gy $ fromIntegral ey)) + mouseDrag (\ex ey -> do let (nw,nh) = applySizeHintsContents sh (gx ex, gy ey) + io $ moveResizeWindow d w (fx nw) (fy nh) nw nh) hunk ./XMonad/Actions/FlexibleResize.hs 67 - firstHalf :: CInt -> Position -> Bool - firstHalf a b = fromIntegral a * 2 <= b - cfst = curry fst - csnd = curry snd - mkSel :: Bool -> Position -> Position -> (Position, a -> a -> a, CInt -> Position) - mkSel b k p = - if b - then (0, csnd, ((k + p) -) . fromIntegral) - else (k, cfst, subtract p . fromIntegral) + findPos :: CInt -> Position -> Maybe Bool + findPos m s = if p < 0.5 - edge/2 + then Just True + else if p < 0.5 + edge/2 + then Nothing + else Just False + where p = fi m / fi s + mkSel :: Maybe Bool -> Position -> Position -> (Position, Dimension -> Position, Position -> Dimension) + mkSel b k p = case b of + Just True -> (0, (fi k + fi p -).fi, (fi k + fi p -).fi) + Nothing -> (k `div` 2, const p, const $ fi k) + Just False -> (k, const p, subtract (fi p) . fi) + +fi :: (Num b, Integral a) => a -> b +fi = fromIntegral hunk ./XMonad/Actions/UpdatePointer.hs 29 +import Data.Maybe hunk ./XMonad/Actions/UpdatePointer.hs 70 + drag <- gets dragging hunk ./XMonad/Actions/UpdatePointer.hs 73 + || isJust drag addfile ./XMonad/Layout/AutoMaster.hs hunk ./XMonad/Layout/AutoMaster.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.AutoMaster +-- Copyright : (c) 2009 Ilya Portnov +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Ilya Portnov +-- Stability : unstable +-- Portability : unportable +-- +-- Provides layout modifier AutoMaster. It separates screen in two parts - +-- master and slave. Size of slave area automatically changes depending on +-- number of slave windows. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.AutoMaster ( + -- * Usage + -- $usage + autoMaster + ) where +import Control.Monad + +import XMonad +import qualified XMonad.StackSet as W +import XMonad.Layout.LayoutModifier + +-- $usage +-- This module defines layout modifier named autoMaster. It separates +-- screen in two parts - master and slave. Master windows are arranged +-- in one row, in slave area underlying layout is run. Size of slave area +-- automatically increases when number of slave windows is increasing. +-- +-- You can use this module by adding folowing in your @xmonad.hs@: +-- +-- > import XMonad.Layout.AutoMaster +-- +-- Then add layouts to your layoutHook: +-- +-- > myLayoutHook = autoMaster 1 (1/100) Grid ||| ... +-- +-- In this example, master area by default contains 1 window (you can +-- change this number in runtime with usual IncMasterN message), changing +-- slave area size with 1/100 on each Shrink/Expand message. + +-- | Data type for layout modifier +data AutoMaster a = AutoMaster Int Float Float + deriving (Read,Show) + +instance LayoutModifier AutoMaster Window where + modifyLayout (AutoMaster k bias _) = autoLayout k bias + pureMess = autoMess + +-- | Handle Shrink/Expand and IncMasterN messages +autoMess :: AutoMaster a -> SomeMessage -> Maybe (AutoMaster a) +autoMess (AutoMaster k bias delta) m = msum [fmap resize (fromMessage m), + fmap incmastern (fromMessage m)] + where incmastern (IncMasterN d) = AutoMaster (max 1 (k+d)) bias delta + resize Expand = AutoMaster k (min ( 0.4) $ bias+delta) delta + resize Shrink = AutoMaster k (max (-0.4) $ bias-delta) delta + +-- | Main layout function +autoLayout :: (LayoutClass l Window) => + Int -> + Float -> + W.Workspace WorkspaceId (l Window) Window + -> Rectangle + -> X ([(Window, Rectangle)], Maybe (l Window)) +autoLayout k bias wksp rect = do + let stack = W.stack wksp + let ws = W.integrate' stack + let n = length ws + if null ws then + runLayout wksp rect + else do + if (n<=k) then + return ((divideRow rect ws),Nothing) + else do + let master = take k ws + let filtStack = stack >>= W.filter (\w -> not (w `elem` master)) + wrs <- runLayout (wksp {W.stack = filtStack}) (slaveRect rect n bias) + return ((divideRow (masterRect rect n bias) master) ++ (fst wrs), + snd wrs) + +-- | Calculates height of master area, depending on number of windows. +masterHeight :: Int -> Float -> Float +masterHeight n bias = (calcHeight n) + bias + where calcHeight :: Int -> Float + calcHeight 1 = 1.0 + calcHeight m = if (m<9) then (43/45) - (fromIntegral m)*(7/90) else (1/3) + +-- | Rectangle for master area +masterRect :: Rectangle -> Int -> Float -> Rectangle +masterRect (Rectangle sx sy sw sh) n bias = Rectangle sx sy sw h + where h = round $ (fromIntegral sh)*(masterHeight n bias) + +-- | Rectangle for slave area +slaveRect :: Rectangle -> Int -> Float -> Rectangle +slaveRect (Rectangle sx sy sw sh) n bias = Rectangle sx (sy+(fromIntegral mh)) sw h + where mh = round $ (fromIntegral sh)*(masterHeight n bias) + h = round $ (fromIntegral sh)*(1-masterHeight n bias) + +-- | Divide rectangle between windows +divideRow :: Rectangle -> [a] -> [(a, Rectangle)] +divideRow (Rectangle x y w h) ws = zip ws rects + where n = length ws + oneW = fromIntegral w `div` n + oneRect = Rectangle x y (fromIntegral oneW) h + rects = take n $ iterate (shiftR (fromIntegral oneW)) oneRect + +-- | Shift rectangle right +shiftR :: Position -> Rectangle -> Rectangle +shiftR s (Rectangle x y w h) = Rectangle (x+s) y w h + +-- | User interface function +autoMaster :: LayoutClass l a => + Int -> -- Number of master windows + Float -> -- Step for which to increment/decrement master area size with Shrink/Expand + l a -> + ModifiedLayout AutoMaster l a +autoMaster nmaster delta = ModifiedLayout (AutoMaster nmaster 0 delta) + hunk ./xmonad-contrib.cabal 131 + XMonad.Layout.AutoMaster hunk ./XMonad/Layout/AutoMaster.hs 100 -slaveRect (Rectangle sx sy sw sh) n bias = Rectangle sx (sy+(fromIntegral mh)) sw h +slaveRect (Rectangle sx sy sw sh) n bias = Rectangle sx (sy+mh) sw h hunk ./XMonad/Actions/PhysicalScreens.hs 36 -physical location reletive to each other (as reported by Xinerama), +physical location relative to each other (as reported by Xinerama), hunk ./XMonad/Layout/ResizableTile.hs 111 - where smallh = floor $ fromIntegral (sh `div` fromIntegral n) * f --hmm, this is a fold or map. + where smallh = min sh (floor $ fromIntegral (sh `div` fromIntegral n) * f) --hmm, this is a fold or map. hunk ./XMonad/Layout/StackTile.hs 15 --- Moastly usefull on small screens. +-- Mostly usefull on small screens. hunk ./XMonad/Actions/Plane.hs 81 - | Lines Int -- ^ Specify the number of lines explicity. + | Lines Int -- ^ Specify the number of lines explicitly. hunk ./XMonad/Actions/Plane.hs 83 --- | This is the way most people would like to use this module. It ataches the +-- | This is the way most people would like to use this module. It attaches the hunk ./XMonad/Actions/TopicSpace.hs 22 --- function. You can also easily switch to recents topics using this history +-- function. You can also easily switch to recent topics using this history hunk ./XMonad/Actions/UpdateFocus.hs 3 --- Module : XMonadContrib.UpdateFocus +-- Module : XMonad.Actions.UpdateFocus hunk ./XMonad/Hooks/Place.hs 410 --- other rectangles aready present. The first rectangles in +-- other rectangles already present. The first rectangles in hunk ./XMonad/Hooks/Place.hs 414 - -> [SmartRectangle a] -- ^ The parts aready in use + -> [SmartRectangle a] -- ^ The parts already in use hunk ./XMonad/Hooks/Place.hs 420 - = case filter largeEnough $ cleanup $ substractRects total rs of + = case filter largeEnough $ cleanup $ subtractRects total rs of hunk ./XMonad/Hooks/Place.hs 426 --- | Substracts smaller rectangles from a total rectangle +-- | Subtracts smaller rectangles from a total rectangle hunk ./XMonad/Hooks/Place.hs 428 -substractRects :: Real a => SmartRectangle a +subtractRects :: Real a => SmartRectangle a hunk ./XMonad/Hooks/Place.hs 430 -substractRects total [] = [total] -substractRects total (r:rs) - = do total' <- substractRects total rs +subtractRects total [] = [total] +subtractRects total (r:rs) + = do total' <- subtractRects total rs hunk ./XMonad/Hooks/Script.hs 46 --- Now, everytime the startup hook runs, the command +-- Now, every time the startup hook runs, the command hunk ./XMonad/Layout/ComboP.hs 56 --- required becase @Move@ commands don't work when one of the parts is empty. +-- required because @Move@ commands don't work when one of the parts is empty. hunk ./XMonad/Layout/DecorationMadness.hs 130 --- The deafult theme can be dynamically change with the xmonad theme --- selector. See "XMonad.Prompt.Theme". For more themse, look at +-- The default theme can be dynamically change with the xmonad theme +-- selector. See "XMonad.Prompt.Theme". For more themes, look at hunk ./XMonad/Layout/IM.hs 13 --- Layout modfier suitable for workspace with multi-windowed instant messanger +-- Layout modfier suitable for workspace with multi-windowed instant messenger hunk ./XMonad/Layout/LayoutHints.hs 21 - , layoutHintsToCentre + , layoutHintsToCenter hunk ./XMonad/Layout/LayoutHints.hs 60 --- > myLayouts = layoutHintsToCentre (Tall 1 (3/100) (1/2)) +-- > myLayouts = layoutHintsToCenter (Tall 1 (3/100) (1/2)) hunk ./XMonad/Layout/LayoutHints.hs 78 --- | @layoutHintsToCentre layout@ applies hints, sliding the window to the --- centre of the screen and expanding its neighbours to fill the gaps. Windows +-- | @layoutHintsToCenter layout@ applies hints, sliding the window to the +-- center of the screen and expanding its neighbors to fill the gaps. Windows hunk ./XMonad/Layout/LayoutHints.hs 82 --- @layoutHintsToCentre@ only makes one pass at resizing the neighbours of --- hinted windows, so with some layouts (ex. the arrangment with two 'Mirror' --- 'Tall' stacked vertically), @layoutHintsToCentre@ may leave some gaps. +-- @layoutHintsToCenter@ only makes one pass at resizing the neighbors of +-- hinted windows, so with some layouts (ex. the arrangement with two 'Mirror' +-- 'Tall' stacked vertically), @layoutHintsToCenter@ may leave some gaps. hunk ./XMonad/Layout/LayoutHints.hs 86 -layoutHintsToCentre :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHintsToCentre l a -layoutHintsToCentre = ModifiedLayout LayoutHintsToCentre +layoutHintsToCenter :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHintsToCenter l a +layoutHintsToCenter = ModifiedLayout LayoutHintsToCenter hunk ./XMonad/Layout/LayoutHints.hs 124 - where distFC = uncurry ((+) `on` sq) . pairWise (-) (centre root) + where distFC = uncurry ((+) `on` sq) . pairWise (-) (center root) hunk ./XMonad/Layout/LayoutHints.hs 129 -data LayoutHintsToCentre a = LayoutHintsToCentre deriving (Read, Show) +data LayoutHintsToCenter a = LayoutHintsToCenter deriving (Read, Show) hunk ./XMonad/Layout/LayoutHints.hs 131 -instance LayoutModifier LayoutHintsToCentre Window where +instance LayoutModifier LayoutHintsToCenter Window where hunk ./XMonad/Layout/LayoutHints.hs 145 - redr = placeRectangle (centrePlacement root lrect :: (Double,Double)) lrect + redr = placeRectangle (centerPlacement root lrect :: (Double,Double)) lrect hunk ./XMonad/Layout/LayoutHints.hs 211 -centre :: Rectangle -> (Position, Position) -centre (Rectangle x y w h) = (avg x w, avg y h) +center :: Rectangle -> (Position, Position) +center (Rectangle x y w h) = (avg x w, avg y h) hunk ./XMonad/Layout/LayoutHints.hs 215 -centrePlacement :: RealFrac r => Rectangle -> Rectangle -> (r, r) -centrePlacement = centrePlacement' clamp +centerPlacement :: RealFrac r => Rectangle -> Rectangle -> (r, r) +centerPlacement = centerPlacement' clamp hunk ./XMonad/Layout/LayoutHints.hs 224 - . centrePlacement' signum root + . centerPlacement' signum root hunk ./XMonad/Layout/LayoutHints.hs 233 -centrePlacement' :: (Position -> r) -> Rectangle -> Rectangle -> (r, r) -centrePlacement' cf root assigned +centerPlacement' :: (Position -> r) -> Rectangle -> Rectangle -> (r, r) +centerPlacement' cf root assigned hunk ./XMonad/Layout/LayoutHints.hs 236 - where (cx,cy) = centre root - (cwx,cwy) = centre assigned + where (cx,cy) = center root + (cwx,cwy) = center assigned hunk ./XMonad/Layout/Master.hs 50 --- | Modifier wich converts given layout to a mastered one +-- | Modifier which converts given layout to a mastered one hunk ./XMonad/Layout/OneBig.hs 30 --- You can use this module by adding folowing in your @xmonad.hs@: +-- You can use this module by adding following in your @xmonad.hs@: hunk ./XMonad/Layout/ShowWName.hs 48 --- is possible to provide a costum configuration. +-- is possible to provide a custom configuration. hunk ./XMonad/Layout/StackTile.hs 15 --- Mostly usefull on small screens. +-- Mostly useful on small screens. hunk ./XMonad/Layout/SubLayouts.hs 70 --- 'simpleTabbed' (and other decorated layouts) fail horibly when used as +-- 'simpleTabbed' (and other decorated layouts) fail horribly when used as hunk ./XMonad/Layout/ThreeColumns.hs 44 --- The first argument specifies hom many windows initially appear in the main +-- The first argument specifies how many windows initially appear in the main hunk ./XMonad/Layout/WindowArranger.hs 206 --- | Get the list of elements to be deleted and the list ef elements to +-- | Get the list of elements to be deleted and the list of elements to hunk ./XMonad/Layout/WindowNavigation.hs 93 -navigateBrightness f | f > 1 = navigateBrightness 1 - | f < 0 = navigateBrightness 0 -navigateBrightness f = defaultWNConfig { brightness = Just f } +navigateBrightness f = defaultWNConfig { brightness = Just $ max 0 $ min 1 f } hunk ./XMonad/Layout/WindowNavigation.hs 130 - (\d -> truncHead $ navigable d pt wrs) [U,D,R,L] + (\d -> take 1 $ navigable d pt wrs) [U,D,R,L] hunk ./XMonad/Util/EZConfig.hs 59 --- For more information and usage eamples, see the documentation +-- For more information and usage examples, see the documentation hunk ./XMonad/Util/EZConfig.hs 223 --- present in your particular setup althrough most likely they will do. +-- present in your particular setup although most likely they will do. hunk ./XMonad/Util/Font.hsc 94 --- | When initXMF gets a font name that starts with 'xft:' it switchs to the Xft backend +-- | When initXMF gets a font name that starts with 'xft:' it switches to the Xft backend hunk ./XMonad/Util/Run.hs 54 --- This corresponds to dmenu's notion of exit code 1 for a cancelled invocation. +-- This corresponds to dmenu's notion of exit code 1 for a canceled invocation. hunk ./XMonad/Util/Scratchpad.hs 86 --- | Action to pop up any program with the user specifiying how to set +-- | Action to pop up any program with the user specifying how to set hunk ./XMonad/Layout/WindowNavigation.hs 133 - truncHead $ navigable d pt wrs) [U,D,R,L] + take 1 $ navigable d pt wrs) [U,D,R,L] hunk ./XMonad/Layout/WindowNavigation.hs 195 -truncHead :: [a] -> [a] -truncHead (x:_) = [x] -truncHead [] = [] - hunk ./XMonad/Doc/Extending.hs 246 -* "XMonad.Hooks.EventHook": a hook to handle X events at the layout level. - hunk ./XMonad/Doc/Extending.hs 255 -* "XMonad.Hooks.ServerMode": example use of "XMonad.Hooks.EventHook". +* "XMonad.Hooks.ServerMode": Allows sending commands to a running xmonad process. hunk ./XMonad/Hooks/EventHook.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable -{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} - ------------------------------------------------------------------------------ --- | --- Module : XMonad.Hooks.EventHook --- Copyright : (c) 2007 Andrea Rossato --- License : BSD-style (see xmonad/LICENSE) --- --- Maintainer : andrea.rossato@unibz.it --- Stability : unstable --- Portability : unportable --- --- A layout modifier that implements an event hook at the layout level. --- --- Since it operates at the 'Workspace' level, it will install itself --- on the first current 'Workspace' and will broadcast a 'Message' to --- all other 'Workspace's not to handle events. ------------------------------------------------------------------------------ - -module XMonad.Hooks.EventHook - ( -- * Usage - -- $usage - - -- * Writing a hook - -- $hook - EventHook (..) - , eventHook - , HandleEvent - ) where - -import Data.Maybe - -import XMonad -import XMonad.StackSet (Workspace (..), currentTag) - --- $usage --- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Hooks.EventHook --- --- Then edit your @layoutHook@ by adding the 'eventHook': --- --- > layoutHook = eventHook EventHookExample $ avoidStruts $ simpleTabbed ||| Full ||| etc.. --- --- and then: --- --- > main = xmonad defaultConfig { layoutHook = myLayouts } --- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" - --- $hook --- Writing a hook is very simple. --- --- This is a basic example to log all events: --- --- > data EventHookExample = EventHookExample deriving ( Show, Read ) --- > instance EventHook EventHookExample where --- > handleEvent _ e = io $ hPutStrLn stderr . show $ e --return () --- --- This is an 'EventHook' to log mouse button events: --- --- > data EventHookButton = EventHookButton deriving ( Show, Read ) --- > instance EventHook EventHookButton where --- > handleEvent _ (ButtonEvent {ev_window = w}) = do --- > io $ hPutStrLn stderr $ "This is a button event on window " ++ (show w) --- > handleEvent _ _ = return () --- --- Obviously you can compose event hooks: --- --- > layoutHook = eventHook EventHookButton $ eventHook EventHookExample $ avoidStruts $ simpleTabbed ||| Full ||| etc.. - -eventHook :: EventHook eh => eh -> l a -> (HandleEvent eh l) a -eventHook = HandleEvent Nothing True - -class (Read eh, Show eh) => EventHook eh where - handleEvent :: eh -> Event -> X () - handleEvent _ _ = return () - -data HandleEvent eh l a = HandleEvent (Maybe WorkspaceId) Bool eh (l a) deriving ( Show, Read ) - -data EventHandleMsg = HandlerOff deriving ( Typeable ) -instance Message EventHandleMsg - -instance (EventHook eh, LayoutClass l a) => LayoutClass (HandleEvent eh l) a where - runLayout (Workspace i (HandleEvent Nothing True eh l) ms) r = do - broadcastMessage HandlerOff - iws <- gets (currentTag . windowset) - (wrs, ml) <- runLayout (Workspace i l ms) r - return (wrs, Just $ HandleEvent (Just iws) True eh (fromMaybe l ml)) - - runLayout (Workspace i (HandleEvent mi b eh l) ms) r = do - (wrs, ml) <- runLayout (Workspace i l ms) r - return (wrs, Just $ HandleEvent mi b eh (fromMaybe l ml)) - - handleMessage (HandleEvent i True eh l) m - | Just HandlerOff <- fromMessage m = return . Just $ HandleEvent i False eh l - | Just e <- fromMessage m = handleMessage l (SomeMessage e) >>= \ml -> - handleEvent eh e >> - maybe (return Nothing) (\l' -> return . Just $ HandleEvent i True eh l') ml - handleMessage (HandleEvent i b eh l) m = handleMessage l m >>= - maybe (return Nothing) (\l' -> return . Just $ HandleEvent i b eh l') - - description (HandleEvent _ _ _ l) = description l rmfile ./XMonad/Hooks/EventHook.hs hunk ./xmonad-contrib.cabal 117 - XMonad.Hooks.EventHook addfile ./XMonad/Layout/LimitWindows.hs hunk ./XMonad/Layout/LimitWindows.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.LimitWindows +-- Copyright : (c) 2009 Adam Vogt +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : vogt.adam@gmail.com +-- Stability : unstable +-- Portability : unportable +-- +-- A layout modifier that limits the number of windows that can be shown. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.LimitWindows (limitWindows,limitSlice) where + +import XMonad.Layout.LayoutModifier +import XMonad +import qualified XMonad.StackSet as W + +-- | Only display the first @n@ windows. +limitWindows :: Int -> l a -> ModifiedLayout LimitWindows l a +limitWindows n = ModifiedLayout (LimitWindows FirstN n) + +-- | Only display @n@ windows around the focused window. This makes sense with +-- layouts that arrange windows linearily, like 'XMonad.Layout.Layout.Accordion'. +limitSlice :: Int -> l a -> ModifiedLayout LimitWindows l a +limitSlice n = ModifiedLayout (LimitWindows Slice n) + +data LimitWindows a = LimitWindows SliceStyle Int deriving (Read,Show) + +data SliceStyle = FirstN | Slice deriving (Read,Show) + +-- do the runLayout call in an environment with only the windows chosen by f ... ? +instance LayoutModifier LimitWindows a where + modifyLayout (LimitWindows style n) ws r = + runLayout ws { W.stack = f n `fmap` W.stack ws } r + where f = case style of + FirstN -> firstN + Slice -> slice + +firstN :: Int -> W.Stack a -> W.Stack a +firstN n st = W.Stack f (reverse u) d + where (u,f:d) = splitAt (min (n-1) $ length $ W.up st) + $ take n $ W.integrate st + +slice :: Int -> W.Stack t -> W.Stack t +slice n (W.Stack f u d) = + W.Stack f (take (nu + unusedD) u) + (take (nd + unusedU) d) + where unusedD = max 0 $ nd - length d + unusedU = max 0 $ nu - length u + nd = div (n - 1) 2 + nu = uncurry (+) $ divMod (n - 1) 2 hunk ./xmonad-contrib.cabal 155 + XMonad.Layout.LimitWindows hunk ./XMonad/Layout/Decoration.hs 29 + , findWindowByDecoration hunk ./XMonad/Layout/Decoration.hs 311 +findWindowByDecoration :: Window -> DecorationState -> Maybe (OrigWin,(Window,Maybe Rectangle)) +findWindowByDecoration w ds = lookFor w (decos ds) + hunk ./XMonad/Layout/Tabbed.hs 154 + decorationMouseFocusHook _ ds ButtonEvent { ev_window = ew + , ev_event_type = et + , ev_button = eb } + | et == buttonPress + , Just ((w,_),_) <-findWindowByDecoration ew ds = + if eb == button2 + then killWindow w + else focus w + decorationMouseFocusHook _ _ _ = return () + hunk ./XMonad/Layout/Tabbed.hs 56 +-- This layout has hardcoded behaviour for mouse clicks on tab decorations: +-- Left click on the tab switches focus to that window. +-- Middle click on the tab closes the window. +-- hunk ./XMonad/Layout/LimitWindows.hs 1 -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-} hunk ./XMonad/Layout/LimitWindows.hs 16 -module XMonad.Layout.LimitWindows (limitWindows,limitSlice) where +module XMonad.Layout.LimitWindows ( + -- * Usage + -- $usage + + -- Layout Modifiers + limitWindows,limitSlice, + + -- Change the number of windows + increaseLimit,decreaseLimit,setLimit + ) where hunk ./XMonad/Layout/LimitWindows.hs 30 +import Control.Monad((<=<),guard) + +-- $usage +-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.LimitWindows +-- +-- > myLayout = limitWindows 6 $ Tall 1 0.03 0.5 ||| Full ||| RandomOtherLayout... +-- > main = xmonad defaultConfig { layoutHook = myLayout } +-- +-- You may also be interested in dynamically changing the number dynamically, +-- by binding keys to the 'increaseLimit', 'decreaseLimit', or 'setLimit' +-- actions. +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +increaseLimit :: X () +increaseLimit = sendMessage $ LimitChange succ + +decreaseLimit :: X () +decreaseLimit = sendMessage . LimitChange $ max 1 . pred + +setLimit :: Int -> X () +setLimit tgt = sendMessage . LimitChange $ const tgt hunk ./XMonad/Layout/LimitWindows.hs 69 --- do the runLayout call in an environment with only the windows chosen by f ... ? +data LimitChange = LimitChange { unLC :: (Int -> Int) } deriving (Typeable) + +instance Message LimitChange + hunk ./XMonad/Layout/LimitWindows.hs 74 + pureMess (LimitWindows s n) = + fmap (LimitWindows s) . pos <=< (`app` n) . unLC <=< fromMessage + where pos x = guard (x>=0) >> return x + app f x = guard (f x /= x) >> return (f x) + hunk ./XMonad/Layout/LimitWindows.hs 90 +-- | A non-wrapping, fixed-size slice of a stack around the focused element hunk ./XMonad/Layout/LimitWindows.hs 31 +import Data.Maybe(fromJust) hunk ./XMonad/Layout/LimitWindows.hs 47 +-- +-- See also 'XMonad.Layout.BoringWindows.boringAuto' for keybindings that skip +-- the hidden windows. hunk ./XMonad/Layout/LimitWindows.hs 80 - where pos x = guard (x>=0) >> return x + where pos x = guard (x>=1) >> return x hunk ./XMonad/Layout/LimitWindows.hs 90 -firstN n st = W.Stack f (reverse u) d - where (u,f:d) = splitAt (min (n-1) $ length $ W.up st) - $ take n $ W.integrate st +firstN n st = upfocus $ fromJust $ W.differentiate $ take (max 1 n) $ W.integrate st + where upfocus = foldr (.) id $ replicate (length (W.up st)) W.focusDown' hunk ./XMonad/Actions/WindowGo.hs 72 - user. Currently, there are three such useful booleans defined in - "XMonad.ManageHook": title, resource, className. Each one tests based pretty + user. Currently, there are 3 such useful booleans defined in + "XMonad.ManageHook": 'title', 'resource', 'className'. Each one tests based pretty hunk ./XMonad/Actions/WindowGo.hs 75 - useful of which is (=?). So a useful test might be finding a Window whose + useful of which is (=?). So a useful test might be finding a @Window@ whose hunk ./XMonad/Actions/WindowGo.hs 138 - if your variables are simple and look like 'firefox' or 'emacs'. -} + if your variables are simple and look like \"firefox\" or \"emacs\". -} hunk ./XMonad/Actions/WindowGo.hs 143 -{- | if the window is found the window is focused and the third argument is called +{- | If the window is found the window is focused and the third argument is called hunk ./XMonad/Actions/WindowGo.hs 145 - See 'raiseMaster' for an example -} + See 'raiseMaster' for an example. -} hunk ./XMonad/Actions/WindowGo.hs 154 -{- | if the window is found the window is focused and the third argument is called - otherwise, raisef is called -} +{- | If a window matching the second arugment is found, the window is focused and the third argument is called; + otherwise, the first argument is called. -} hunk ./XMonad/Actions/WindowGo.hs 160 - otherwise, the first argument is called + otherwise, the first argument is called. hunk ./XMonad/Actions/WindowGo.hs 162 - raiseMaster (runInTerm \"-title ghci\" \"zsh -c \'ghci\'\") (title =? \"ghci\") -} + > raiseMaster (runInTerm \"-title ghci\" \"zsh -c \'ghci\'\") (title =? \"ghci\") -} hunk ./XMonad/Actions/WindowGo.hs 166 -{- | if the window is found the window is focused and set to master - otherwise, action is run +{- | If the window is found the window is focused and set to master + otherwise, action is run. hunk ./XMonad/Actions/WindowGo.hs 169 - runOrRaiseMaster \"firefox\" (className =? \"Firefox\")) + > runOrRaiseMaster \"firefox\" (className =? \"Firefox\")) hunk ./XMonad/Util/Run.hs 24 + safeSpawnProg, hunk ./XMonad/Util/Run.hs 113 +-- | Like 'safeSpawn', but only takes a program (and no arguments for it). eg. +-- +-- > safeSpawnProg "firefox" +safeSpawnProg :: MonadIO m => FilePath -> m () +safeSpawnProg = flip safeSpawn "" + hunk ./XMonad/Actions/WindowGo.hs 37 -import XMonad (Query(), X(), withWindowSet, spawn, runQuery, liftIO) +import XMonad (Query(), X(), withWindowSet, runQuery, liftIO) hunk ./XMonad/Actions/WindowGo.hs 43 +import XMonad.Util.Run (safeSpawnProg) hunk ./XMonad/Actions/WindowGo.hs 63 --- | 'action' is an executable to be run via 'spawn' (of "XMonad.Core") if the Window cannot be found. +-- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found. hunk ./XMonad/Actions/WindowGo.hs 66 -runOrRaise = raiseMaybe . spawn +runOrRaise = raiseMaybe . safeSpawnProg hunk ./XMonad/Actions/WindowGo.hs 107 -runOrRaiseNext = raiseNextMaybe . spawn +runOrRaiseNext = raiseNextMaybe . safeSpawnProg hunk ./XMonad/Actions/WindowGo.hs 158 -runOrRaiseAndDo = raiseAndDo . spawn +runOrRaiseAndDo = raiseAndDo . safeSpawnProg hunk ./XMonad/Util/Run.hs 110 -safeSpawn :: MonadIO m => FilePath -> String -> m () -safeSpawn prog arg = liftIO (try (forkProcess $ executeFile prog True [arg] Nothing) >> return ()) +safeSpawn :: MonadIO m => FilePath -> [String] -> m () +safeSpawn prog args = liftIO (try (forkProcess $ executeFile prog True args Nothing) >> return ()) hunk ./XMonad/Util/Run.hs 117 -safeSpawnProg = flip safeSpawn "" +safeSpawnProg = flip safeSpawn [] hunk ./XMonad/Util/Run.hs 130 -safeRunInTerm options command = asks (terminal . config) >>= \t -> safeSpawn t (options ++ " -e " ++ command) +safeRunInTerm options command = asks (terminal . config) >>= \t -> safeSpawn t [options, " -e " ++ command] hunk ./XMonad/Actions/Search.hs 234 -search browser site query = safeSpawn browser $ site query +search browser site query = safeSpawn browser [site query] hunk ./XMonad/Prompt/Shell.hs 80 - where run = safeSpawn c . encodeOutput + where run = safeSpawn c . return . encodeOutput hunk ./XMonad/Util/XSelection.hs 132 -safePromptSelection app = join $ io $ liftM (safeSpawn app) getSelection +safePromptSelection app = join $ io $ liftM (safeSpawn app . return) getSelection hunk ./XMonad/Util/XSelection.hs 139 -transformPromptSelection f app = join $ io $ liftM (safeSpawn app) (fmap f getSelection) +transformPromptSelection f app = join $ io $ liftM (safeSpawn app . return) (fmap f getSelection) hunk ./XMonad/Actions/SpawnOn.hs 11 --- Provides a way to spawn an application on a specific workspace by using --- the _NET_WM_PID property that most windows set on creation. Hence this module --- won't work on applications that don't set this property. +-- Provides a way to modify a window spawned by a command(e.g shift it to the workspace +-- it was launched on) by using the _NET_WM_PID property that most windows set on creation. +-- Hence this module won't work on applications that don't set this property. hunk ./XMonad/Actions/SpawnOn.hs 25 + spawnAndDo, hunk ./XMonad/Actions/SpawnOn.hs 59 +-- The module can also be used to apply other manage hooks to the window of +-- the spawned application(e.g. float or resize it). +-- hunk ./XMonad/Actions/SpawnOn.hs 65 -newtype Spawner = Spawner {pidsRef :: IORef [(ProcessID, WorkspaceId)]} +newtype Spawner = Spawner {pidsRef :: IORef [(ProcessID, ManageHook)]} hunk ./XMonad/Actions/SpawnOn.hs 82 - Just w -> do + Just mh -> do hunk ./XMonad/Actions/SpawnOn.hs 85 - doShift w + mh hunk ./XMonad/Actions/SpawnOn.hs 110 -spawnOn sp ws cmd = do +spawnOn sp ws cmd = spawnAndDo sp (doShift ws) cmd + +-- | Spawn an application and apply the manage hook when it opens. +spawnAndDo :: Spawner -> ManageHook -> String -> X () +spawnAndDo sp mh cmd = do hunk ./XMonad/Actions/SpawnOn.hs 116 - io $ modifyIORef (pidsRef sp) (take maxPids . ((p, ws) :)) + io $ modifyIORef (pidsRef sp) (take maxPids . ((p,mh) :)) hunk ./XMonad/Actions/TopicSpace.hs 162 + , shiftNthLastFocused hunk ./XMonad/Actions/TopicSpace.hs 172 -import Data.Maybe (fromMaybe, isNothing) +import Data.Maybe (fromMaybe, isNothing, listToMaybe) hunk ./XMonad/Actions/TopicSpace.hs 278 +-- | Shift the focused window to the Nth last focused topic, or fallback to doing nothing. +shiftNthLastFocused :: Int -> X () +shiftNthLastFocused n = do + ws <- fmap (listToMaybe . drop n) getLastFocusedTopics + whenJust ws $ windows . W.shift + hunk ./XMonad/Actions/TopicSpace.hs 97 --- [ ((modMask, k), switchNthLastFocused defaultTopic i) +-- [ ((modMask, k), switchNthLastFocused myTopicConfig i) hunk ./XMonad/Actions/TopicSpace.hs 175 -import Graphics.X11.Xlib hunk ./XMonad/Actions/TopicSpace.hs 177 -import Foreign.C.String (castCCharToChar,castCharToCChar) hunk ./XMonad/Actions/TopicSpace.hs 179 -import Control.Applicative ((<$>)) hunk ./XMonad/Actions/TopicSpace.hs 189 +import XMonad.Util.StringProp(getStringListProp,setStringListProp) hunk ./XMonad/Actions/TopicSpace.hs 221 -getLastFocusedTopics = getStringListProp "_XMONAD_LAST_FOCUSED_WORKSPACES" +getLastFocusedTopics = asks display >>= flip getStringListProp "_XMONAD_LAST_FOCUSED_WORKSPACES" hunk ./XMonad/Actions/TopicSpace.hs 227 -setLastFocusedTopic tg w predicate = - getLastFocusedTopics >>= - setStringListProp "_XMONAD_LAST_FOCUSED_WORKSPACES" - . take (maxTopicHistory tg) . nub . (w:) . filter predicate +setLastFocusedTopic tg w predicate = do + disp <- asks display + setStringListProp disp "_XMONAD_LAST_FOCUSED_WORKSPACES" + . take (maxTopicHistory tg) . nub . (w:) . filter predicate =<< getLastFocusedTopics hunk ./XMonad/Actions/TopicSpace.hs 302 -type StringProp = String - -withStringProp :: StringProp -> (Display -> Window -> Atom -> X a) -> X a -withStringProp prop f = - withDisplay $ \dpy -> do - rootw <- asks theRoot - a <- io $ internAtom dpy prop False - f dpy rootw a - --- | Get the name of a string property and returns it as a 'Maybe'. -getStringProp :: StringProp -> X (Maybe String) -getStringProp prop = - withStringProp prop $ \dpy rootw a -> do - p <- io $ getWindowProperty8 dpy a rootw - return $ map castCCharToChar <$> p - --- | Set the value of a string property. -setStringProp :: StringProp -> String -> X () -setStringProp prop string = - withStringProp prop $ \dpy rootw a -> - io $ changeProperty8 dpy rootw a a propModeReplace $ map castCharToCChar string - --- | Given a property name, returns its contents as a list. It uses the empty --- list as default value. -getStringListProp :: StringProp -> X [String] -getStringListProp prop = return . maybe [] words =<< getStringProp prop - --- | Given a property name and a list, sets the value of this property with --- the list given as argument. -setStringListProp :: StringProp -> [String] -> X () -setStringListProp prop = setStringProp prop . unwords - hunk ./XMonad/Actions/TopicSpace.hs 308 - addfile ./XMonad/Util/StringProp.hs hunk ./XMonad/Util/StringProp.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.StringProp +-- Copyright : (c) Nicolas Pouillard 2009 +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Nicolas Pouillard +-- Stability : unstable +-- Portability : unportable +-- +-- Internal utility functions for storing Strings with the root window. +-- +-- Used for global state like IORefs with string keys, but more latency, +-- persistent between xmonad restarts. + +module XMonad.Util.StringProp ( + StringProp, + getStringProp, setStringProp, + getStringListProp, setStringListProp, + ) where + +import XMonad +import Control.Monad(liftM) +import Control.Applicative((<$>)) +import Foreign.C.String (castCCharToChar,castCharToCChar) + +type StringProp = String + +withStringProp :: (MonadIO m) => StringProp -> Display -> (Window -> Atom -> m b) -> m b +withStringProp prop dpy f = do + rootw <- io $ rootWindow dpy $ defaultScreen dpy + a <- io $ internAtom dpy prop False + f rootw a + +-- | Set the value of a string property. +setStringProp :: (MonadIO m) => Display -> StringProp -> [Char] -> m () +setStringProp dpy prop string = + withStringProp prop dpy $ \rootw a -> + io $ changeProperty8 dpy rootw a a propModeReplace $ map castCharToCChar string + +-- | Get the name of a string property and returns it as a 'Maybe'. +getStringProp :: (MonadIO m) => Display -> StringProp -> m (Maybe [Char]) +getStringProp dpy prop = + withStringProp prop dpy $ \rootw a -> do + p <- io $ getWindowProperty8 dpy a rootw + return $ map castCCharToChar <$> p + +-- | Given a property name, returns its contents as a list. It uses the empty +-- list as default value. +getStringListProp :: (MonadIO m) => Display -> StringProp -> m [String] +getStringListProp dpy prop = maybe [] words `liftM` getStringProp dpy prop + +-- | Given a property name and a list, sets the value of this property with +-- the list given as argument. +setStringListProp :: (MonadIO m) => Display -> StringProp -> [String] -> m () +setStringListProp dpy prop str = setStringProp dpy prop (unwords str) hunk ./xmonad-contrib.cabal 216 + XMonad.Util.StringProp hunk ./XMonad/Actions/Search.hs 339 - up searching for google:xmonad if google is your fallback engine and you - explicitly add the prefix. -} + up searching for google:xmonad if google is your fallback engine and you + explicitly add the prefix. -} hunk ./XMonad/Actions/WindowBringer.hs 18 - -- * Usage - -- $usage - gotoMenu, gotoMenu', bringMenu, windowMap, - bringWindow - ) where + -- * Usage + -- $usage + gotoMenu, gotoMenu', bringMenu, windowMap, + bringWindow + ) where hunk ./XMonad/Hooks/EwmhDesktops.hs 154 - return () + return () hunk ./XMonad/Layout/DecorationMadness.hs 544 - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a hunk ./XMonad/Layout/DecorationMadness.hs 549 - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a hunk ./XMonad/Layout/DecorationMadness.hs 558 - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a hunk ./XMonad/Layout/DecorationMadness.hs 565 - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a hunk ./XMonad/Layout/DecorationMadness.hs 575 - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a hunk ./XMonad/Layout/DecorationMadness.hs 582 - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a hunk ./XMonad/Layout/DecorationMadness.hs 592 - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a hunk ./XMonad/Layout/DecorationMadness.hs 599 - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a hunk ./XMonad/Prompt/Window.hs 82 - BringCopy -> fmap bringCopyAction windowMap + BringCopy -> fmap bringCopyAction windowMap hunk ./XMonad/Util/Dmenu.hs 18 - -- * Usage - -- $usage - dmenu, dmenuXinerama, dmenuMap, menu, menuMap - ) where + -- * Usage + -- $usage + dmenu, dmenuXinerama, dmenuMap, menu, menuMap + ) where hunk ./XMonad/Util/Dmenu.hs 57 + hunk ./XMonad/Util/Themes.hs 99 - , kavonForestTheme - , kavonLakeTheme - , kavonPeacockTheme - , kavonVioGreenTheme - , kavonBluesTheme - , kavonAutumnTheme - , kavonFireTheme - , kavonChristmasTheme + , kavonForestTheme + , kavonLakeTheme + , kavonPeacockTheme + , kavonVioGreenTheme + , kavonBluesTheme + , kavonAutumnTheme + , kavonFireTheme + , kavonChristmasTheme hunk ./xmonad-contrib.cabal 57 - ghc-options: -Werror + ghc-options: -fwarn-tabs -Werror hunk ./XMonad/Actions/WindowGo.hs 31 + + ifWindows, + ifWindow, + raiseHook, hunk ./XMonad/Actions/WindowGo.hs 38 -import Control.Monad (filterM) +import Control.Monad hunk ./XMonad/Actions/WindowGo.hs 40 - -import XMonad (Query(), X(), withWindowSet, runQuery, liftIO) +import Data.Monoid +import XMonad (Query(), X(), ManageHook, withWindowSet, runQuery, liftIO, ask) hunk ./XMonad/Actions/WindowGo.hs 67 +-- | If windows that satisfy the query exist, apply the supplied +-- function to them, otherwise run the action given as +-- second parameter. +ifWindows :: Query Bool -> ([Window] -> X ()) -> X () -> X () +ifWindows qry f el = withWindowSet $ \wins -> do + matches <- filterM (runQuery qry) $ W.allWindows wins + case matches of + [] -> el + ws -> f ws + +-- | The same as ifWindows, but applies a ManageHook to the first match +-- instead and discards the other matches +ifWindow :: Query Bool -> ManageHook -> X () -> X () +ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . head) + hunk ./XMonad/Actions/WindowGo.hs 118 -raiseMaybe f thatUserQuery = withWindowSet $ \s -> do - maybeResult <- filterM (runQuery thatUserQuery) (W.allWindows s) - case maybeResult of - [] -> f - (x:_) -> windows $ W.focusWindow x +raiseMaybe f qry = ifWindow qry raiseHook f + +-- | A manage hook that raises the window. +raiseHook :: ManageHook +raiseHook = ask >>= doF . W.focusWindow hunk ./XMonad/Actions/WindowGo.hs 138 + hunk ./XMonad/Actions/WindowGo.hs 140 -raiseNextMaybe f thatUserQuery = withWindowSet $ \s -> do - ws <- filterM (runQuery thatUserQuery) (W.allWindows s) - case ws of - [] -> f - (x:_) -> let go (Just w) | (w `elem` ws) = next w $ cycle ws - go _ = windows $ W.focusWindow x - in go $ W.peek s - where - next w (x:y:_) | x==w = windows $ W.focusWindow y - next w (_:xs) = next w xs - next _ _ = error "raiseNextMaybe: empty list" +raiseNextMaybe f qry = flip (ifWindows qry) f $ \ws -> do + foc <- withWindowSet $ return . W.peek + case foc of + Just w | w `elem` ws -> let (_:y:_) = dropWhile (/=w) $ cycle ws -- cannot fail to match + in windows $ W.focusWindow y + _ -> windows . W.focusWindow . head $ ws hunk ./XMonad/Actions/WindowGo.hs 163 -raiseAndDo raisef thatUserQuery afterRaise = withWindowSet $ \s -> do - maybeResult <- filterM (runQuery thatUserQuery) (W.allWindows s) - case maybeResult of - [] -> raisef - (x:_) -> do windows $ W.focusWindow x - afterRaise x +raiseAndDo f qry after = ifWindow qry (afterRaise `mappend` raiseHook) f + where afterRaise = ask >>= (>> idHook) . liftX . after hunk ./XMonad/Actions/Search.hs 44 + lucky, hunk ./XMonad/Actions/Search.hs 115 +* 'lucky' -- Google "I'm feeling lucky" search. + hunk ./XMonad/Actions/Search.hs 277 -amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, - images, imdb, isohunt, maps, mathworld, scholar, thesaurus, wayback, wikipedia, +amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, + images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, hunk ./XMonad/Actions/Search.hs 293 +lucky = searchEngine "lucky" "http://www.google.com/search?btnI&q=" hunk ./XMonad/Actions/Search.hs 306 -multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, maps, mathworld, scholar, thesaurus, wayback, wikipedia, (prefixAware google)] +multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, (prefixAware google)] addfile ./XMonad/Layout/Column.hs hunk ./XMonad/Layout/Column.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Column +-- Copyright : (c) 2009 Ilya Portnov +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Ilya Portnov +-- Stability : unstable +-- Portability : unportable +-- +-- Provides Column layout that places all windows in one column. Windows +-- heights are calculated from equation: H1/H2 = H2/H3 = ... = q, where q is +-- given. With Shrink/Expand messages you can change the q value. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.Column ( + -- * Usage + -- $usage + Column (..) + ) where +import XMonad +import qualified XMonad.StackSet as W + +-- $usage +-- This module defines layot named Column. It places all windows in one +-- column. Windows heights are calculated from equation: H1/H2 = H2/H3 = ... = +-- q, where `q' is given (thus, windows heights are members of geometric +-- progression). With Shrink/Expand messages one can change the `q' value. +-- +-- You can use this module by adding folowing in your @xmonad.hs@: +-- +-- > import XMonad.Layout.Column +-- +-- Then add layouts to your layoutHook: +-- +-- > myLayoutHook = Column 1.6 ||| ... +-- +-- In this example, each next window will have height 1.6 times less then +-- previous window. + +data Column a = Column Float deriving (Read,Show) + +instance LayoutClass Column a where + pureLayout = columnLayout + pureMessage = columnMessage + +columnMessage :: Column a -> SomeMessage -> Maybe (Column a) +columnMessage (Column q) m = fmap resize (fromMessage m) + where resize Shrink = Column (q-0.1) + resize Expand = Column (q+0.1) + +columnLayout :: Column a -> Rectangle -> W.Stack a -> [(a,Rectangle)] +columnLayout (Column q) rect stack = zip ws rects + where ws = W.integrate stack + n = length ws + heights = map (xn n rect q) [1..n] + ys = [fromIntegral $ sum $ take k heights | k <- [0..n-1]] + rects = map (mkRect rect) $ zip heights ys + +mkRect :: Rectangle -> (Dimension,Position) -> Rectangle +mkRect (Rectangle xs ys ws _) (h,y) = Rectangle xs (ys+fromIntegral y) ws h + +xn :: Int -> Rectangle -> Float -> Int -> Dimension +xn n (Rectangle _ _ _ h) q k = if q==1 then + h `div` (fromIntegral n) + else + round ((fromIntegral h)*q^(n-k)*(1-q)/(1-q^n)) + + hunk ./xmonad-contrib.cabal 135 + XMonad.Layout.Column hunk ./XMonad/Hooks/ManageDocks.hs 3 --- deriving Typeable +-- deriving Typeable for ghc-6.6 compatibility, which is retained in the core hunk ./XMonad/Layout/Decoration.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable -{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} hunk ./XMonad/Layout/DragPane.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} hunk ./XMonad/Layout/Gaps.hs 1 -{-# 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 -} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, PatternGuards #-} hunk ./XMonad/Layout/LayoutCombinators.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} hunk ./XMonad/Layout/LayoutModifier.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} hunk ./XMonad/Layout/Magnifier.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} hunk ./XMonad/Layout/Maximize.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable -{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} hunk ./XMonad/Layout/MosaicAlt.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable -{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-} hunk ./XMonad/Layout/MultiToggle.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} +{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, Rank2Types, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, PatternGuards #-} hunk ./XMonad/Layout/MultiToggle.hs 95 --- beginning of your file (ghc 6.8 only; with ghc 6.6 you can use --- @{-\# OPTIONS_GHC -fglasgow-exts \#-}@ instead) to be able to --- derive "Data.Typeable". --- +-- beginning of your file. hunk ./XMonad/Layout/MultiToggle/Instances.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} --- above is for compatibility with GHC 6.6. -{- LANGUAGE TypeSynonymInstances, DeriveDataTypeable -} +{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses #-} hunk ./XMonad/Layout/Reflect.hs 1 -{-# 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 -} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances #-} hunk ./XMonad/Layout/ResizableTile.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable -{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} hunk ./XMonad/Layout/StackTile.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable -{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} hunk ./XMonad/Layout/ToggleLayouts.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} hunk ./XMonad/Layout/WindowArranger.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable -{-# LANGUAGE PatternGuards #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} hunk ./XMonad/Layout/WindowNavigation.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable -{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} hunk ./XMonad/Layout/WorkspaceDir.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} addfile ./XMonad/Actions/RandomBackground.hs hunk ./XMonad/Actions/RandomBackground.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.RandomBackground +-- Copyright : (c) 2009 Anze Slosar +-- translation to Haskell by Adam Vogt +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- An action to start terminals with a random background color +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.RandomBackground (randomBg,randomBg') where + +import XMonad(X, XConf(config), XConfig(terminal), io, spawn, + MonadIO, asks) +import System.Random(Random(randomRIO)) +import Control.Monad(replicateM) +import Numeric(showHex) + +-- | randomHex produces hex values in the form @xxyyzz@, with each of @xx@, +-- @yy@, @zz@ within the range specified. The first parameter determines the +-- the number of such groups. +randomHex :: Int -> (Int, Int) -> IO String +randomHex n = fmap disp . replicateM n . randomRIO + where ensure x = reverse . take x . (++repeat '0') . reverse + disp = concatMap $ ensure 2 . ($ "") . showHex + +-- | randomBg' appends the random hex @ -bg '#xxyyzz'@ to the supplied string +randomBg' :: (MonadIO m) => (Int, Int) -> String -> m String +randomBg' x t = do + num <- io $ randomHex 3 x + return $ concat [t," -bg '#",num,"'"] + +randomBg :: (Int,Int) -> X () +randomBg x = spawn =<< randomBg' x =<< asks (terminal . config) hunk ./xmonad-contrib.cabal 92 + XMonad.Actions.RandomBackground hunk ./XMonad/Actions/RandomBackground.hs 16 -module XMonad.Actions.RandomBackground (randomBg,randomBg') where +module XMonad.Actions.RandomBackground (randomBg',randomBg,RandomColor(HSV,RGB)) where hunk ./XMonad/Actions/RandomBackground.hs 20 -import System.Random(Random(randomRIO)) -import Control.Monad(replicateM) +import System.Random +import Control.Monad(replicateM,liftM) hunk ./XMonad/Actions/RandomBackground.hs 24 --- | randomHex produces hex values in the form @xxyyzz@, with each of @xx@, --- @yy@, @zz@ within the range specified. The first parameter determines the --- the number of such groups. -randomHex :: Int -> (Int, Int) -> IO String -randomHex n = fmap disp . replicateM n . randomRIO +-- | RandomColor fixes constraints when generating random colors +data RandomColor = RGB { _colorMin :: Int, _colorMax :: Int } + | HSV { _colorSaturation :: Double, _colorValue :: Double } + +toHex :: [Int] -> String +toHex = ("'#"++) . (++"'") . concatMap (ensure 2 . ($ "") . showHex) hunk ./XMonad/Actions/RandomBackground.hs 31 - disp = concatMap $ ensure 2 . ($ "") . showHex hunk ./XMonad/Actions/RandomBackground.hs 32 --- | randomBg' appends the random hex @ -bg '#xxyyzz'@ to the supplied string -randomBg' :: (MonadIO m) => (Int, Int) -> String -> m String -randomBg' x t = do - num <- io $ randomHex 3 x - return $ concat [t," -bg '#",num,"'"] +randPermutation :: (RandomGen g) => [a] -> g -> [a] +randPermutation xs g = swap $ zip (randoms g) xs + where + swap ((True,x):(c,y):ys) = y:swap ((c,x):ys) + swap ((False,x):ys) = x:swap ys + swap x = map snd x + +-- | randomBg' produces a random hex number in the form @'#xxyyzz'@ +randomBg' :: (MonadIO m) => RandomColor -> m String +randomBg' (RGB l h) = liftM toHex $ replicateM 3 $ io $ randomRIO (l,h) +randomBg' (HSV s v) = io $ do + g <- newStdGen + let -- x = (sqrt 3 - tan theta) / sqrt 3 + x = (^2) $ fst $ randomR (0,sqrt $ pi / 3) g + return $ toHex $ map round $ randPermutation [v,(v-s)*x + s,s] g hunk ./XMonad/Actions/RandomBackground.hs 48 -randomBg :: (Int,Int) -> X () -randomBg x = spawn =<< randomBg' x =<< asks (terminal . config) +randomBg :: RandomColor -> X () +randomBg x = do + t <- asks (terminal . config) + c <- randomBg' x + spawn $ t ++ " -bg " ++ c hunk ./XMonad/Layout/SubLayouts.hs 82 --- contains only the windows it is running: should sublayouts be run in a --- restricted environment that is then merged back? +-- contains only the windows it is running: sublayouts are run in a restricted +-- environment, should it be merged back? hunk ./XMonad/Layout/SubLayouts.hs 283 + orgStack <- currentStack + -- this would be much cleaner with some kind of data-accessor + let chStack x = modify (\s -> s { windowset = (windowset s) + { W.current = (W.current $ windowset s) + { W.workspace = (W.workspace $ W.current $ windowset s) { W.stack = x }}}}) hunk ./XMonad/Layout/SubLayouts.hs 292 + chStack sst hunk ./XMonad/Layout/SubLayouts.hs 294 - fmap (fromMaybe nl) <$> runLayout (W.Workspace n nl sst) rect + result <- runLayout (W.Workspace n nl sst) rect + chStack orgStack -- FIXME: merge back reordering, deletions? + return $ fromMaybe nl `second` result hunk ./XMonad/Layout/SubLayouts.hs 280 - let newL :: LayoutClass l Window => Rectangle -> WorkspaceId -> (l Window,Bool) + let newL :: LayoutClass l Window => Rectangle -> WorkspaceId -> (l Window) -> Bool hunk ./XMonad/Layout/SubLayouts.hs 282 - newL rect n (ol, mess) sst = do + newL rect n ol isNew sst = do hunk ./XMonad/Layout/SubLayouts.hs 289 - | mess = fromMaybe l <$> handleMessage l y + | not isNew = fromMaybe l <$> handleMessage l y hunk ./XMonad/Layout/SubLayouts.hs 298 - (urls,ssts) = unzip [ (newL gr i l sst, sst) - | l <- map (second $ const True) sls + (urls,ssts) = unzip [ (newL gr i l isNew sst, sst) + | (isNew,(l,_st)) <- sls hunk ./XMonad/Layout/SubLayouts.hs 304 - sls' <- return . Sublayout (I []) defl <$> fromGroups defl st gs' + sls' <- return . Sublayout (I []) defl . map snd <$> fromGroups defl st gs' hunk ./XMonad/Layout/SubLayouts.hs 359 - Just . Sublayout (I ms) defl <$> fromGroups defl st gs' sls + Just . Sublayout (I ms) defl . map snd <$> fromGroups defl st gs' sls hunk ./XMonad/Layout/SubLayouts.hs 442 - -> X [(layout a, W.Stack k)] + -> X [(Bool,(layout a, W.Stack k))] hunk ./XMonad/Layout/SubLayouts.hs 450 - -> [(a, W.Stack k)] + -> [(Bool,(a, W.Stack k))] hunk ./XMonad/Layout/SubLayouts.hs 452 - [ fromMaybe2 (dl, single w) (l, M.lookup w gs) + [ (isNew,fromMaybe2 (dl, single w) (l, M.lookup w gs)) hunk ./XMonad/Layout/SubLayouts.hs 454 - | dl <- defls ++ repeat defl + | (isNew,dl) <- map ((,) False) defls ++ map ((,) True) (repeat defl) hunk ./XMonad/Hooks/ManageHelpers.hs 45 + doFloatAt, + doFloatDep, hunk ./XMonad/Hooks/ManageHelpers.hs 190 +-- | Floats a new window using a rectangle computed as a function of +-- the rectangle that it would have used by default. +doFloatDep :: (W.RationalRect -> W.RationalRect) -> ManageHook +doFloatDep move = ask >>= \w -> doF . W.float w . move . snd =<< liftX (floatLocation w) + +-- | Floats a new window with its original size, and its top left +-- corner at a specific point on the screen (both coordinates should +-- be in the range 0 to 1). +doFloatAt :: Rational -> Rational -> ManageHook +doFloatAt x y = doFloatDep move + where + move (W.RationalRect _ _ w h) = W.RationalRect x y w h + hunk ./XMonad/Hooks/ManageHelpers.hs 206 -doSideFloat side = ask >>= \w -> doF . W.float w . move . snd =<< liftX (floatLocation w) - where +doSideFloat side = doFloatDep move + where hunk ./XMonad/Hooks/ManageHelpers.hs 209 - where - cx = if side `elem` [SC,C ,NC] then (1-w)/2 - else if side `elem` [SW,CW,NW] then 0 - else {- side `elem` [SE,CE,NE] -} 1-w - cy = if side `elem` [CE,C ,CW] then (1-h)/2 - else if side `elem` [NE,NC,NW] then 0 - else {- side `elem` [SE,SC,SW] -} 1-h + where cx = if side `elem` [SC,C ,NC] then (1-w)/2 + else if side `elem` [SW,CW,NW] then 0 + else {- side `elem` [SE,CE,NE] -} 1-w + cy = if side `elem` [CE,C ,CW] then (1-h)/2 + else if side `elem` [NE,NC,NW] then 0 + else {- side `elem` [SE,SC,SW] -} 1-h hunk ./XMonad/Actions/Search.hs 288 -hackage = searchEngine "hackage" "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/" +hackage = searchEngine "hackage" "http://hackage.haskell.org/package/" hunk ./XMonad/Prompt/Layout.hs 53 - mkXPrompt (Wor "") c (mkCompl $ sort $ nub ls) (sendMessage . JumpToLayout) - -mkCompl :: [String] -> String -> IO [String] -mkCompl l s = return $ filter (\x -> take (length s) x == s) l + mkXPrompt (Wor "") c (mkComplFunFromList' $ sort $ nub ls) (sendMessage . JumpToLayout) hunk ./XMonad/Prompt/Workspace.hs 46 - mkXPrompt (Wor "") c (mkCompl ts) job - -mkCompl :: [String] -> String -> IO [String] -mkCompl l s = return $ filter (\x -> take (length s) x == s) l + mkXPrompt (Wor "") c (mkComplFunFromList' ts) job hunk ./XMonad/Actions/CopyWindow.hs 25 -import Control.Monad (filterM) +import Control.Monad hunk ./XMonad/Actions/CopyWindow.hs 28 +import XMonad.Actions.WindowGo hunk ./XMonad/Actions/CopyWindow.hs 102 --- | copyMaybe. Copies "XMonad.Actions.WindowGo" ('raiseMaybe') --- TODO: Factor out and improve with regard to WindowGo. +-- | Copy a window if it exists, run the first argument otherwise hunk ./XMonad/Actions/CopyWindow.hs 104 -copyMaybe f thatUserQuery = withWindowSet $ \s -> do - maybeResult <- filterM (runQuery thatUserQuery) (W.allWindows s) - case maybeResult of - [] -> f - (x:_) -> windows $ copyWindow x (W.currentTag s) - +copyMaybe f qry = ifWindow qry copyWin f + where copyWin = ask >>= \w -> doF (\ws -> copyWindow w (W.currentTag ws) ws) addfile ./XMonad/Actions/OnScreen.hs hunk ./XMonad/Actions/OnScreen.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.OnScreen +-- Copyright : (c) 2009 Nils Schweinsberg +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Nils Schweinsberg +-- Stability : unstable +-- Portability : unportable +-- +-- Control workspaces on different screens (in xinerama mode). +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.OnScreen ( + -- * Usage + -- $usage + onScreen + , viewOnScreen + , greedyViewOnScreen + , onlyOnScreen + ) where + +import XMonad.StackSet +import Data.List + +-- $usage +-- +-- This module provides an easy way to control, what you see on other screens in +-- xinerama mode without having to focus them. Put this into your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.OnScreen +-- +-- Then add the appropriate keybindings, for example replace your current keys +-- to switch the workspaces with this at the bottom of your keybindings: +-- +-- > ++ +-- > [ ((m .|. modMask, k), windows (f i)) +-- > | (i, k) <- zip (workspaces conf) ([xK_1 .. xK_9] ++ [xK_0]) +-- > , (f, m) <- [ (viewOnScreen 0, 0) +-- > , (viewOnScreen 1, controlMask) +-- > , (greedyView, controlMask .|. shiftMask) ] +-- > ] +-- +-- This will provide you with the following keybindings: +-- +-- * modkey + 1-0: +-- Switch to workspace 1-0 on screen 0 +-- +-- * modkey + control + 1-0: +-- Switch to workspace 1-0 on screen 1 +-- +-- * modkey + control + shift + 1-0: +-- Default greedyView behaviour +-- +-- +-- A more basic version inside the default keybindings would be: +-- +-- > , ((modMask .|. controlMask, xK_1) windows (viewOnScreen 0 "1")) +-- +-- where 0 is the first screen and "1" the workspace with the tag "1". +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Switch to the (hidden) workspace with index 'i' on the screen 'sc'. +-- A default function (for example 'view' or 'greedyView') will be run if 'sc' is +-- the current screen, no valid screen id or workspace 'i' is already visible. +onScreen :: (Eq sid, Eq i) + => (i -> StackSet i l a sid sd -> StackSet i l a sid sd) -- ^ default action + -> sid -- ^ screen id + -> i -- ^ index of the workspace + -> StackSet i l a sid sd -- ^ current stack + -> StackSet i l a sid sd +onScreen defFunc sc i st + | screen (current st) /= sc = + case ( find ((i==) . tag) (hidden st) + , find ((sc==) . screen) (screens st) + , find ((sc==) . screen) (visible st)) of + + (Just x, Just s, Just o) -> + let newScreen = s { workspace = x } + in st { visible = newScreen : (deleteBy (equating screen) newScreen (visible st)) + , hidden = (workspace o) : (deleteBy (equating tag) x (hidden st)) + } + _ -> defFunc i st -- no valid screen id/workspace already visible + + | otherwise = defFunc i st -- on current screen + + where equating f x y = f x == f y + +-- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible use 'greedyView' +-- to switch the current workspace with workspace 'i'. +greedyViewOnScreen :: (Eq sid, Eq i) + => sid -- ^ screen id + -> i -- ^ index of the workspace + -> StackSet i l a sid sd -- ^ current stack + -> StackSet i l a sid sd +greedyViewOnScreen = onScreen greedyView + +-- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible use 'view' to +-- switch focus to the workspace 'i'. +viewOnScreen :: (Eq sid, Eq i) + => sid -- ^ screen id + -> i -- ^ index of the workspace + -> StackSet i l a sid sd -- ^ current stack + -> StackSet i l a sid sd +viewOnScreen = onScreen view + +-- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible do nothing. +onlyOnScreen :: (Eq sid, Eq i) + => sid -- ^ screen id + -> i -- ^ index of the workspace + -> StackSet i l a sid sd -- ^ current stack + -> StackSet i l a sid sd +onlyOnScreen = onScreen doNothing + where doNothing _ st = st hunk ./xmonad-contrib.cabal 87 + XMonad.Actions.OnScreen hunk ./XMonad/Actions/OnScreen.hs 25 +import Control.Monad(guard) hunk ./XMonad/Actions/OnScreen.hs 27 +import Data.Maybe(fromMaybe) +import Data.Function(on) hunk ./XMonad/Actions/OnScreen.hs 64 --- +-- hunk ./XMonad/Actions/OnScreen.hs 79 -onScreen defFunc sc i st - | screen (current st) /= sc = - case ( find ((i==) . tag) (hidden st) - , find ((sc==) . screen) (screens st) - , find ((sc==) . screen) (visible st)) of - - (Just x, Just s, Just o) -> - let newScreen = s { workspace = x } - in st { visible = newScreen : (deleteBy (equating screen) newScreen (visible st)) - , hidden = (workspace o) : (deleteBy (equating tag) x (hidden st)) - } - _ -> defFunc i st -- no valid screen id/workspace already visible - - | otherwise = defFunc i st -- on current screen - - where equating f x y = f x == f y +onScreen defFunc sc i st = fromMaybe (defFunc i st) $ do + -- on unfocused current screen + guard $ screen (current st) /= sc + x <- find ((i==) . tag ) (hidden st) + s <- find ((sc==) . screen) (screens st) + o <- find ((sc==) . screen) (visible st) + let newScreen = s { workspace = x } + return st { visible = newScreen : deleteBy ((==) `on` screen) newScreen (visible st) + , hidden = workspace o : deleteBy ((==) `on` tag) x (hidden st) + } hunk ./XMonad/Actions/FocusNth.hs 17 - focusNth) where + focusNth,focusNth') where addfile ./XMonad/Actions/WorkspaceCursors.hs hunk ./XMonad/Actions/WorkspaceCursors.hs 1 +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.WorkspaceCursors +-- Copyright : (c) 2009 Adam Vogt +-- License : BSD +-- +-- Maintainer : Adam Vogt +-- Stability : unstable +-- Portability : portable +-- +-- Generalizes plane to arbitrary dimensions. +----------------------------------------------------------------------------- + +module XMonad.Actions.WorkspaceCursors + ( + -- * Usage + -- $usage + toList + ,focusDepth + + ,workspaceCursors + + ,modifyLayer + ,makeCursors + ,sampleCursors + + -- * Functions to pass to 'modifyLayer' + ,focusNth' + ,noWrapUp,noWrapDown + ) where + + +import XMonad.Actions.FocusNth(focusNth') +import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, + redoLayout)) +import XMonad(Typeable, Message, WorkspaceId, X, XState(windowset), + fromMessage, sendMessage, windows, gets) +import Control.Applicative((<$>)) +import Control.Monad(Monad(return, (>>=), (>>)), Functor(..), + guard, unless) +import Data.Foldable(Foldable(foldMap), toList) +import Data.Maybe(Maybe(Nothing), fromJust, listToMaybe) +import Data.Monoid(Monoid(mconcat, mappend)) +import Data.Traversable(sequenceA) + +import qualified XMonad.StackSet as W + +-- $usage +-- +-- Here is an example config: +-- +-- > import XMonad +-- > import XMonad.Actions.WorkspaceCursors +-- > import XMonad.Config.Desktops +-- > import XMonad.Util.EZConfig +-- > +-- > main = do +-- > xmonad $ additionalKeysP desktopConfig +-- > { workspaces = toList sampleCurs +-- > , layoutHook = workspaceCursors myCursors $ layoutHook desktopConfig +-- > } +-- > [("M-"++shift++[k], modifyLayer f depth) +-- > | (f,shift) <- zip [W.focusUp',W.focusDown'] [[],"S-"] +-- > , (depth,k) <- zip [1..focusDepth myCursors] "asdf"] +-- > +-- > myCursors = makeCursors $ map (map show) [[1..3],[1..3],[1..3],[1..9]] + +------------------------------------------------------------------------------- + +sampleCursors :: Cursors String +sampleCursors = makeCursors $ map (map show) [[1..3::Int],[1..3],[1..9]] + +makeCursors :: [[String]] -> Cursors String +makeCursors (x:xs) = Prelude.foldr addDim (end x) xs +makeCursors [] = error "Cursors cannot be empty" + +addDim :: (Monoid a) => [a] -> Cursors a -> Cursors a +addDim prefixes prev = Cons . fromJust . W.differentiate + $ map (\p -> fmap (p `mappend`) prev) prefixes + +end :: [String] -> Cursors String +end = Cons . fromJust . W.differentiate . map End + +data Cursors a + = Cons (W.Stack (Cursors a)) + | End a deriving (Eq,Show,Read,Typeable) + +instance Foldable Cursors where + foldMap f (End x) = f x + foldMap f (Cons st) = mconcat $ map (foldMap f) $ W.integrate st + +instance Functor Cursors where + fmap f (End a) = End $ f a + fmap f (Cons (W.Stack x y z)) = Cons $ W.Stack (fmap f x) (fmap (fmap f) y) (fmap (fmap f) z) + +changeFocus :: (Cursors t -> Bool) -> Cursors t -> [Cursors t] +changeFocus p (Cons x) = chFocus p x >>= changeFocus p . Cons +changeFocus p x = guard (p x) >> return x + +chFocus :: (a -> Bool) -> W.Stack a -> [W.Stack a] +chFocus p st = filter (p . W.focus) $ zipWith const (iterate W.focusDown' st) (W.integrate st) + +getFocus :: Cursors b -> b +getFocus (Cons x) = getFocus $ W.focus x +getFocus (End x) = x + +focusTo :: (Eq t) => t -> Cursors t -> Maybe (Cursors t) +focusTo x = listToMaybe . changeFocus ((x==) . getFocus) + +-- | non-wrapping version of 'XMonad.StackSet.focusUp'' +noWrapUp :: W.Stack t -> W.Stack t +noWrapUp (W.Stack t (l:ls) rs) = W.Stack l ls (t:rs) +noWrapUp x@(W.Stack _ [] _ ) = x + +-- | non-wrapping version of 'XMonad.StackSet.focusDown'' +noWrapDown :: W.Stack t -> W.Stack t +noWrapDown = reverseStack . noWrapUp . reverseStack + where reverseStack (W.Stack t ls rs) = W.Stack t rs ls + +focusDepth :: Cursors t -> Int +focusDepth (Cons x) = 1 + focusDepth (W.focus x) +focusDepth (End _) = 0 + +descend :: (W.Stack (Cursors a) -> W.Stack (Cursors a))-> Int-> Cursors a-> Cursors a +descend f 1 (Cons x) = Cons $ f x +descend f n (Cons x) | n > 1 = Cons $ descend f (pred n) `onFocus` x +descend _ _ x = x + +onFocus :: (a -> a) -> W.Stack a -> W.Stack a +onFocus f st = st { W.focus = f $ W.focus st } + +modifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors String)) -> Int -> X () +modifyLayer f depth = modifyCursors (return . descend f depth) + +modifyCursors :: (Cursors String -> X (Cursors String)) -> X () +modifyCursors = sendMessage . ChangeCursors + +currentWs :: X WorkspaceId +currentWs = gets $ W.tag . W.workspace . W.current . windowset + +data WorkspaceCursors a = WorkspaceCursors Bool (Cursors String) deriving (Typeable,Read,Show) + +-- | WorkspaceCursors is implemented as a layout modifier, since that state is +-- serialized, and easily modified (with sendMessage) +workspaceCursors :: Cursors String -> WorkspaceCursors a +workspaceCursors = WorkspaceCursors False + +data ChangeCursors = ChangeCursors { + unWrap :: Cursors String -> X (Cursors String) + } deriving (Typeable) + +instance Message ChangeCursors + +instance LayoutModifier WorkspaceCursors a where + redoLayout (WorkspaceCursors False cs) _ _ arrs = do + cws <- currentWs + return (arrs,do + guard (getFocus cs /= cws) + fmap (WorkspaceCursors True) $ focusTo cws cs) + + redoLayout (WorkspaceCursors _ cs) _ _ arrs = do + cws <- currentWs + -- redundant check to avoid switching workspaces + unless (getFocus cs == cws) $ windows $ W.greedyView (getFocus cs) + return (arrs,Nothing) + + handleMess (WorkspaceCursors prevMod cs) m = + let wrap x = WorkspaceCursors (max prevMod (x /= cs)) x + in sequenceA $ fmap wrap . ($ cs) . unWrap <$> fromMessage m hunk ./xmonad-contrib.cabal 109 + XMonad.Actions.WorkspaceCursors hunk ./XMonad/Actions/WorkspaceCursors.hs 12 --- Generalizes plane to arbitrary dimensions. +-- Like Plane for an arbitrary number of dimensions. hunk ./XMonad/Actions/WorkspaceCursors.hs 19 - toList - ,focusDepth hunk ./XMonad/Actions/WorkspaceCursors.hs 20 + focusDepth + ,makeCursors + ,toList hunk ./XMonad/Actions/WorkspaceCursors.hs 25 + ,WorkspaceCursors + ,getFocus + + -- * Modifying the focus hunk ./XMonad/Actions/WorkspaceCursors.hs 30 - ,makeCursors - ,sampleCursors + ,modifyLayer' + ,shiftModifyLayer,shiftLayer hunk ./XMonad/Actions/WorkspaceCursors.hs 36 + + -- * Todo + -- $todo hunk ./XMonad/Actions/WorkspaceCursors.hs 41 +import qualified XMonad.StackSet as W hunk ./XMonad/Actions/WorkspaceCursors.hs 44 -import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, - redoLayout)) +import XMonad.Layout.LayoutModifier(ModifiedLayout(..), + LayoutModifier(handleMess, redoLayout)) hunk ./XMonad/Actions/WorkspaceCursors.hs 48 +import Control.Monad((<=<), guard, liftM, liftM2, when) hunk ./XMonad/Actions/WorkspaceCursors.hs 50 -import Control.Monad(Monad(return, (>>=), (>>)), Functor(..), - guard, unless) hunk ./XMonad/Actions/WorkspaceCursors.hs 51 -import Data.Maybe(Maybe(Nothing), fromJust, listToMaybe) -import Data.Monoid(Monoid(mconcat, mappend)) +import Data.Maybe(fromJust, listToMaybe) +import Data.Monoid(Monoid(mappend, mconcat)) hunk ./XMonad/Actions/WorkspaceCursors.hs 55 -import qualified XMonad.StackSet as W - hunk ./XMonad/Actions/WorkspaceCursors.hs 61 --- > import XMonad.Config.Desktops +-- > import XMonad.Hooks.DynamicLog hunk ./XMonad/Actions/WorkspaceCursors.hs 63 +-- > import qualified XMonad.StackSet as W hunk ./XMonad/Actions/WorkspaceCursors.hs 66 --- > xmonad $ additionalKeysP desktopConfig --- > { workspaces = toList sampleCurs --- > , layoutHook = workspaceCursors myCursors $ layoutHook desktopConfig --- > } --- > [("M-"++shift++[k], modifyLayer f depth) --- > | (f,shift) <- zip [W.focusUp',W.focusDown'] [[],"S-"] --- > , (depth,k) <- zip [1..focusDepth myCursors] "asdf"] +-- > x <- xmobar conf +-- > xmonad x +-- > +-- > conf = additionalKeysP defaultConfig +-- > { layoutHook = workspaceCursors myCursors $ layoutHook defaultConfig +-- > , workspaces = toList myCursors } $ +-- > [("M-"++shift++control++[k], f direction depth) +-- > | (f,shift) <- zip [modifyLayer,shiftModifyLayer] ["","S-"] +-- > , (direction,control) <- zip [W.focusUp',W.focusDown'] ["C-",""] +-- > , (depth,k) <- zip (reverse [1..focusDepth myCursors]) "asdf"] +-- > ++ moreKeybindings +-- > +-- > moreKeybindings = [] hunk ./XMonad/Actions/WorkspaceCursors.hs 80 --- > myCursors = makeCursors $ map (map show) [[1..3],[1..3],[1..3],[1..9]] +-- > myCursors = makeCursors $ map (map (\x -> [x])) [ "1234", "abc", "xyz"] +-- > -- myCursors = makeCursors [["wsA","wsB","wsC"],["-alpha-","-beta-","-gamma-"],["x","y"]] hunk ./XMonad/Actions/WorkspaceCursors.hs 83 -------------------------------------------------------------------------------- hunk ./XMonad/Actions/WorkspaceCursors.hs 84 -sampleCursors :: Cursors String -sampleCursors = makeCursors $ map (map show) [[1..3::Int],[1..3],[1..9]] +-- $todo +-- +-- * Find and document how to raise the allowable length of arguments: +-- restoring xmonad's state results in: @xmonad: executeFile: resource +-- exhausted (Argument list too long)@ when you specify more than about 50 +-- workspaces. Or change it such that workspaces are created when you try to +-- view it. +-- +-- * Function for pretty printing for DynamicLog that groups workspaces by +-- common prefixes +-- +-- * Examples of adding workspaces to the cursors, having them appear multiple +-- times for being able to show jumping to some n'th multiple workspace hunk ./XMonad/Actions/WorkspaceCursors.hs 98 +-- | makeCursors requires a nonempty string, and each sublist must be nonempty hunk ./XMonad/Actions/WorkspaceCursors.hs 100 -makeCursors (x:xs) = Prelude.foldr addDim (end x) xs -makeCursors [] = error "Cursors cannot be empty" +makeCursors [] = error "Workspace Cursors cannot be empty" +makeCursors a = concat . reverse <$> foldl addDim x xs + where x = end $ map return $ head a + xs = map (map return) $ tail a + -- this could probably be simplified, but this true: + -- toList . makeCursors == map (concat . reverse) . sequence . reverse . map (map (:[])) + -- the strange order is used because it makes the regular M-1..9 + -- bindings change the prefixes first hunk ./XMonad/Actions/WorkspaceCursors.hs 109 -addDim :: (Monoid a) => [a] -> Cursors a -> Cursors a -addDim prefixes prev = Cons . fromJust . W.differentiate - $ map (\p -> fmap (p `mappend`) prev) prefixes +addDim :: (Monoid a) => Cursors a -> [a] -> Cursors a +addDim prev prefixes = Cons . fromJust . W.differentiate + $ map ((<$> prev) . mappend) prefixes hunk ./XMonad/Actions/WorkspaceCursors.hs 113 -end :: [String] -> Cursors String +end :: [a] -> Cursors a hunk ./XMonad/Actions/WorkspaceCursors.hs 122 - foldMap f (Cons st) = mconcat $ map (foldMap f) $ W.integrate st + foldMap f (Cons (W.Stack x y z)) = foldMap f x `mappend` mconcat (map (foldMap f) $ reverse y ++ z) hunk ./XMonad/Actions/WorkspaceCursors.hs 129 -changeFocus p (Cons x) = chFocus p x >>= changeFocus p . Cons +changeFocus p (Cons x) = do + choose <- chFocus p x + foc <- changeFocus p $ W.focus choose + return . Cons $ choose { W.focus = foc } hunk ./XMonad/Actions/WorkspaceCursors.hs 142 +-- This could be made more efficient, if the fact that the suffixes are grouped hunk ./XMonad/Actions/WorkspaceCursors.hs 144 -focusTo x = listToMaybe . changeFocus ((x==) . getFocus) +focusTo x = listToMaybe . filter ((x==) . getFocus) . changeFocus (const True) hunk ./XMonad/Actions/WorkspaceCursors.hs 146 --- | non-wrapping version of 'XMonad.StackSet.focusUp'' +-- | non-wrapping version of 'W.focusUp'' hunk ./XMonad/Actions/WorkspaceCursors.hs 151 --- | non-wrapping version of 'XMonad.StackSet.focusDown'' +-- | non-wrapping version of 'W.focusDown'' hunk ./XMonad/Actions/WorkspaceCursors.hs 160 -descend :: (W.Stack (Cursors a) -> W.Stack (Cursors a))-> Int-> Cursors a-> Cursors a -descend f 1 (Cons x) = Cons $ f x -descend f n (Cons x) | n > 1 = Cons $ descend f (pred n) `onFocus` x -descend _ _ x = x +descend :: Monad m =>(W.Stack (Cursors a) -> m (W.Stack (Cursors a)))-> Int-> Cursors a-> m (Cursors a) +descend f 1 (Cons x) = Cons `liftM` f x +descend f n (Cons x) | n > 1 = liftM Cons $ descend f (pred n) `onFocus` x +descend _ _ x = return x hunk ./XMonad/Actions/WorkspaceCursors.hs 165 -onFocus :: (a -> a) -> W.Stack a -> W.Stack a -onFocus f st = st { W.focus = f $ W.focus st } +onFocus :: (Monad m) => (a1 -> m a1) -> W.Stack a1 -> m (W.Stack a1) +onFocus f st = (\x -> st { W.focus = x}) `liftM` f (W.focus st) hunk ./XMonad/Actions/WorkspaceCursors.hs 168 +-- | @modifyLayer@ is used to change the focus at a given depth hunk ./XMonad/Actions/WorkspaceCursors.hs 170 -modifyLayer f depth = modifyCursors (return . descend f depth) +modifyLayer f depth = modifyCursors (descend (return . f) depth) hunk ./XMonad/Actions/WorkspaceCursors.hs 172 -modifyCursors :: (Cursors String -> X (Cursors String)) -> X () -modifyCursors = sendMessage . ChangeCursors +-- | @shiftModifyLayer@ is the same as 'modifyLayer', but also shifts the +-- currently focused window to the new workspace +shiftModifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors WorkspaceId))-> Int-> X () +shiftModifyLayer f = modifyLayer' $ \st -> do + let st' = f st + windows $ W.shift $ getFocus (Cons st') + return st' hunk ./XMonad/Actions/WorkspaceCursors.hs 180 -currentWs :: X WorkspaceId -currentWs = gets $ W.tag . W.workspace . W.current . windowset +-- | @shiftLayer@ is the same as 'shiftModifyLayer', but the focus remains on +-- the current workspace. +shiftLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors WorkspaceId))-> Int-> X () +shiftLayer f = modifyLayer' $ \st -> do + windows $ W.shift $ getFocus $ Cons $ f st + return st hunk ./XMonad/Actions/WorkspaceCursors.hs 187 -data WorkspaceCursors a = WorkspaceCursors Bool (Cursors String) deriving (Typeable,Read,Show) +-- | example usages are 'shiftLayer' and 'shiftModifyLayer' +modifyLayer' :: (W.Stack (Cursors String) -> X (W.Stack (Cursors String))) -> Int -> X () +modifyLayer' f depth = modifyCursors (descend f depth) hunk ./XMonad/Actions/WorkspaceCursors.hs 191 --- | WorkspaceCursors is implemented as a layout modifier, since that state is --- serialized, and easily modified (with sendMessage) -workspaceCursors :: Cursors String -> WorkspaceCursors a -workspaceCursors = WorkspaceCursors False +modifyCursors :: (Cursors String -> X (Cursors String)) -> X () +modifyCursors = sendMessage . ChangeCursors . (liftM2 (>>) updateXMD return <=<) hunk ./XMonad/Actions/WorkspaceCursors.hs 194 -data ChangeCursors = ChangeCursors { - unWrap :: Cursors String -> X (Cursors String) - } deriving (Typeable) +data WorkspaceCursors a = WorkspaceCursors (Cursors String) + deriving (Typeable,Read,Show) + +-- | The state is stored in the 'WorkspaceCursors' layout modifier. Put this as +-- your outermost modifier, unless you want different cursors at different +-- times (using "XMonad.Layout.MultiToggle") +workspaceCursors :: Cursors String -> l a -> ModifiedLayout WorkspaceCursors l a +workspaceCursors = ModifiedLayout . WorkspaceCursors + +data ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) } + deriving (Typeable) hunk ./XMonad/Actions/WorkspaceCursors.hs 208 -instance LayoutModifier WorkspaceCursors a where - redoLayout (WorkspaceCursors False cs) _ _ arrs = do - cws <- currentWs - return (arrs,do - guard (getFocus cs /= cws) - fmap (WorkspaceCursors True) $ focusTo cws cs) +updateXMD :: Cursors WorkspaceId -> X () +updateXMD cs = do + changed <- gets $ (getFocus cs /=) . W.currentTag . windowset + when changed $ windows $ W.greedyView $ getFocus cs hunk ./XMonad/Actions/WorkspaceCursors.hs 213 - redoLayout (WorkspaceCursors _ cs) _ _ arrs = do - cws <- currentWs - -- redundant check to avoid switching workspaces - unless (getFocus cs == cws) $ windows $ W.greedyView (getFocus cs) - return (arrs,Nothing) +instance LayoutModifier WorkspaceCursors a where + redoLayout (WorkspaceCursors cs) _ _ arrs = do + cws <- gets $ W.currentTag . windowset + return (arrs,WorkspaceCursors <$> focusTo cws cs) hunk ./XMonad/Actions/WorkspaceCursors.hs 218 - handleMess (WorkspaceCursors prevMod cs) m = - let wrap x = WorkspaceCursors (max prevMod (x /= cs)) x - in sequenceA $ fmap wrap . ($ cs) . unWrap <$> fromMessage m + handleMess (WorkspaceCursors cs) m = + sequenceA $ fmap WorkspaceCursors . ($ cs) . unWrap <$> fromMessage m hunk ./XMonad/Layout/SubLayouts.hs 53 -import Data.Maybe(Maybe(..), maybe, fromMaybe, listToMaybe, +import Data.Maybe(Maybe(..), isNothing, maybe, fromMaybe, listToMaybe, hunk ./XMonad/Layout/SubLayouts.hs 453 - | l <- map Just sls ++ repeat Nothing - | (isNew,dl) <- map ((,) False) defls ++ map ((,) True) (repeat defl) + | l <- map Just sls ++ repeat Nothing, let isNew = isNothing l + | dl <- defls ++ repeat defl hunk ./XMonad/Layout/SubLayouts.hs 46 -import Control.Applicative((<$>)) +import Control.Applicative((<$>),(<*)) hunk ./XMonad/Layout/SubLayouts.hs 63 +-- Issue 288: "XMonad.Layout.ResizableTile" assumes that its environment +-- contains only the windows it is running: sublayouts are currently run with +-- the stack containing only the windows passed to it in its environment, but +-- any changes that the layout makes are not merged back. +-- +-- Should the behavior be made optional? +-- +-- Features: +-- +-- * suggested managehooks for merging specific windows, or the apropriate +-- layout based hack to find out the number of groups currently showed, but +-- the size of current window groups is not available (outside of this +-- growing module) +-- +-- SimpleTabbed as a SubLayout +-- hunk ./XMonad/Layout/SubLayouts.hs 97 --- Issue 288: "XMonad.Layout.ResizableTile" assumes that its environment --- contains only the windows it is running: sublayouts are run in a restricted --- environment, should it be merged back? hunk ./XMonad/Layout/SubLayouts.hs 287 - runLayout (W.Workspace i la st') r + oldStack <- gets $ W.stack . W.workspace . W.current . windowset + setStack st' + runLayout (W.Workspace i la st') r <* setStack oldStack + -- FIXME: merge back reordering, deletions? hunk ./XMonad/Layout/SubLayouts.hs 300 - -- this would be much cleaner with some kind of data-accessor - let chStack x = modify (\s -> s { windowset = (windowset s) - { W.current = (W.current $ windowset s) - { W.workspace = (W.workspace $ W.current $ windowset s) { W.stack = x }}}}) hunk ./XMonad/Layout/SubLayouts.hs 304 - chStack sst + setStack sst hunk ./XMonad/Layout/SubLayouts.hs 307 - chStack orgStack -- FIXME: merge back reordering, deletions? + setStack orgStack -- FIXME: merge back reordering, deletions? hunk ./XMonad/Layout/SubLayouts.hs 471 + + +-- this would be much cleaner with some kind of data-accessor +setStack :: Maybe (W.Stack Window) -> X () +setStack x = modify (\s -> s { windowset = (windowset s) + { W.current = (W.current $ windowset s) + { W.workspace = (W.workspace $ W.current $ windowset s) { W.stack = x }}}}) hunk ./XMonad/Layout/SubLayouts.hs 231 - -- ^ make one large group, keeping a focused + -- ^ make one large group, keeping the parameter focused + | Migrate a a + -- ^ used to move windows from one group to another, this may + -- be replaced by a combination of 'UnMerge' and 'Merge' hunk ./XMonad/Layout/SubLayouts.hs 258 --- | pullGroup, pushGroup allow you to merge windows or groups inheriting the --- position of the current window (pull) or the other window (push). -pullGroup :: Direction -> Navigate +-- | @pullGroup@, @pushGroup@ allow you to merge windows or groups inheriting +-- the position of the current window (pull) or the other window (push). +-- +-- @pushWindow@ and @pullWindow@ move individual windows between groups. They +-- are less effective at preserving window positions. +pullGroup,pushGroup,pullWindow,pushWindow :: Direction -> Navigate hunk ./XMonad/Layout/SubLayouts.hs 265 - - -pullWindow :: Direction -> Navigate -pullWindow = mergeNav (\o c -> sendMessage (UnMerge o) >> sendMessage (Merge o c)) - -pushGroup :: Direction -> Navigate hunk ./XMonad/Layout/SubLayouts.hs 266 - -pushWindow :: Direction -> Navigate -pushWindow = mergeNav (\o c -> sendMessage (UnMerge c) >> sendMessage (Merge c o)) +pullWindow = mergeNav (\o c -> sendMessage $ Migrate o c) +pushWindow = mergeNav (\o c -> sendMessage $ Migrate c o) hunk ./XMonad/Layout/SubLayouts.hs 366 + -- XXX sometimes this migrates an incorrect window, why? + | Just (Migrate x y) <- fromMessage m + , Just xst <- findGroup x + , Just (W.Stack yf yu yd) <- findGroup y = + let zs = W.Stack x (yf:yu) yd + nxsAdd = maybe id (\e -> M.insert (W.focus e) e) $ W.filter (x/=) xst + in fgs $ nxsAdd $ M.insert x zs $ M.delete yf gs + + hunk ./XMonad/Layout/SubLayouts.hs 381 + findGroup z = mplus (M.lookup z gs) $ listToMaybe + $ M.elems $ M.filter ((z `elem`) . W.integrate) gs hunk ./XMonad/Layout/SubLayouts.hs 355 - , let findGrp z = mplus (M.lookup z gs) $ listToMaybe - $ M.elems $ M.filter ((z `elem`) . W.integrate) gs - , Just (W.Stack _ xb xn) <- findGrp x - , Just yst <- findGrp y = + , Just (W.Stack _ xb xn) <- findGroup x + , Just yst <- findGroup y = hunk ./XMonad/Layout/SubLayouts.hs 358 - in fgs $ M.update (\_ -> Just zs) x $ M.delete y gs + in fgs $ M.insert x zs $ M.delete (W.focus yst) gs hunk ./XMonad/Layout/SubLayouts.hs 233 - -- ^ used to move windows from one group to another, this may - -- be replaced by a combination of 'UnMerge' and 'Merge' + -- ^ used to the window named in the first argument to the + -- second argument's group, this may be replaced by a + -- combination of 'UnMerge' and 'Merge' hunk ./XMonad/Actions/CycleSelectedLayouts.hs 28 --- +-- hunk ./XMonad/Actions/CycleWindows.hs 21 --- +-- hunk ./XMonad/Actions/CycleWindows.hs 73 --- editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". +-- editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". hunk ./XMonad/Actions/GridSelect.hs 233 -defaultColorizer s active = +defaultColorizer s active = hunk ./XMonad/Actions/GridSelect.hs 257 -colorRangeFromClassName startC endC activeC inactiveT activeT w active = +colorRangeFromClassName startC endC activeC inactiveT activeT w active = hunk ./XMonad/Actions/GridSelect.hs 259 - if active + if active hunk ./XMonad/Actions/GridSelect.hs 261 - else return (rgbToHex $ mix startC endC + else return (rgbToHex $ mix startC endC hunk ./XMonad/Actions/GridSelect.hs 267 --- | Creates a mix of two colors according to a ratio +-- | Creates a mix of two colors according to a ratio hunk ./XMonad/Actions/MessageFeedback.hs 55 --- For example, to correct the previous example: --- +-- For example, to correct the previous example: +-- hunk ./XMonad/Actions/WindowGo.hs 181 - > runOrRaiseMaster \"firefox\" (className =? \"Firefox\")) + > runOrRaiseMaster \"firefox\" (className =? \"Firefox\")) hunk ./XMonad/Config/Droundy.hs 98 - + hunk ./XMonad/Config/Droundy.hs 115 - + hunk ./XMonad/Config/Droundy.hs 146 - shrinkIt shr s | Just s' <- dropFromHead " " s = shrinkIt shr s' - shrinkIt shr s | Just s' <- dropFromTail " " s = shrinkIt shr s' - shrinkIt shr s | Just s' <- dropFromTail "- Iceweasel" s = shrinkIt shr s' - shrinkIt shr s | Just s' <- dropFromTail "- KPDF" s = shrinkIt shr s' - shrinkIt shr s | Just s' <- dropFromHead "file://" s = shrinkIt shr s' - shrinkIt shr s | Just s' <- dropFromHead "http://" s = shrinkIt shr s' + shrinkIt shr s | Just s' <- dropFromHead " " s = shrinkIt shr s' + shrinkIt shr s | Just s' <- dropFromTail " " s = shrinkIt shr s' + shrinkIt shr s | Just s' <- dropFromTail "- Iceweasel" s = shrinkIt shr s' + shrinkIt shr s | Just s' <- dropFromTail "- KPDF" s = shrinkIt shr s' + shrinkIt shr s | Just s' <- dropFromHead "file://" s = shrinkIt shr s' + shrinkIt shr s | Just s' <- dropFromHead "http://" s = shrinkIt shr s' hunk ./XMonad/Config/Gnome.hs 33 --- +-- hunk ./XMonad/Config/Kde.hs 35 --- +-- hunk ./XMonad/Config/Monad.hs 41 -set :: Accessor (XConfig LayoutList) a -> a -> Config () +set :: Accessor (XConfig LayoutList) a -> a -> Config () hunk ./XMonad/Config/Xfce.hs 32 --- +-- hunk ./XMonad/Hooks/DynamicHooks.hs 56 --- > xmonad { keys = myKeys `Data.Map.union` Data.Map.fromList --- > [((modMask conf, xK_i), oneShotHook dynHooksRef --- > "FFlaunchHook" (className =? "firefox") (doShift "3") +-- > xmonad { keys = myKeys `Data.Map.union` Data.Map.fromList +-- > [((modMask conf, xK_i), oneShotHook dynHooksRef +-- > "FFlaunchHook" (className =? "firefox") (doShift "3") hunk ./XMonad/Hooks/DynamicHooks.hs 60 --- > ,((modMask conf, xK_u), addDynamicHook dynHooksRef +-- > ,((modMask conf, xK_u), addDynamicHook dynHooksRef hunk ./XMonad/Hooks/DynamicHooks.hs 69 - + hunk ./XMonad/Hooks/DynamicHooks.hs 83 -dynamicMasterHook ref = return True --> +dynamicMasterHook ref = return True --> hunk ./XMonad/Hooks/DynamicHooks.hs 102 -updateDynamicHook ref f = +updateDynamicHook ref f = hunk ./XMonad/Hooks/DynamicHooks.hs 111 --- you must call 'oneShotHook' as +-- you must call 'oneShotHook' as hunk ./XMonad/Hooks/DynamicHooks.hs 114 --- +-- hunk ./XMonad/Hooks/EwmhDesktops.hs 103 - case elemIndex (W.tag w) (map W.tag ws) of + case elemIndex (W.tag w) (map W.tag ws) of hunk ./XMonad/Hooks/FloatNext.hs 11 --- Hook and keybindings for automatically sending the next +-- Hook and keybindings for automatically sending the next hunk ./XMonad/Hooks/FloatNext.hs 75 --- to automatically send the next spawned window(s) to the floating +-- to automatically send the next spawned window(s) to the floating hunk ./XMonad/Hooks/FloatNext.hs 79 --- +-- hunk ./XMonad/Hooks/FloatNext.hs 133 --- state of 'floatNext' and 'floatAllNew' in your +-- state of 'floatNext' and 'floatAllNew' in your hunk ./XMonad/Hooks/FloatNext.hs 136 --- to the 'XMonad.Hooks.DynamicLog.ppExtras' field of your +-- to the 'XMonad.Hooks.DynamicLog.ppExtras' field of your hunk ./XMonad/Hooks/FloatNext.hs 142 --- +-- hunk ./XMonad/Hooks/FloatNext.hs 146 --- 'willFloatAllNewPP' will be applied to their output, you +-- 'willFloatAllNewPP' will be applied to their output, you hunk ./XMonad/Hooks/FloatNext.hs 149 - + hunk ./XMonad/Hooks/Place.hs 17 - + hunk ./XMonad/Hooks/Place.hs 56 --- +-- hunk ./XMonad/Hooks/Place.hs 64 --- Note that 'placeHook' should be applied after most other hooks, especially hooks +-- Note that 'placeHook' should be applied after most other hooks, especially hooks hunk ./XMonad/Hooks/Place.hs 74 --- the placement policy to use (smart, under the mouse, fixed position, etc.). See +-- the placement policy to use (smart, under the mouse, fixed position, etc.). See hunk ./XMonad/Hooks/Place.hs 121 -fixed :: (Rational, Rational) -- ^ Where windows should go. - -- - -- * (0,0) -> top left of the screen - -- +fixed :: (Rational, Rational) -- ^ Where windows should go. + -- + -- * (0,0) -> top left of the screen + -- hunk ./XMonad/Hooks/Place.hs 126 - -- + -- hunk ./XMonad/Hooks/Place.hs 139 --- | Apply the given placement policy, constraining the +-- | Apply the given placement policy, constraining the hunk ./XMonad/Hooks/Place.hs 141 -inBounds :: Placement -> Placement +inBounds :: Placement -> Placement hunk ./XMonad/Hooks/Place.hs 146 -withGaps :: (Dimension, Dimension, Dimension, Dimension) +withGaps :: (Dimension, Dimension, Dimension, Dimension) hunk ./XMonad/Hooks/Place.hs 163 - + hunk ./XMonad/Hooks/Place.hs 185 - - -- Look for the workspace(s) on which the window is to be + + -- Look for the workspace(s) on which the window is to be hunk ./XMonad/Hooks/Place.hs 194 - + hunk ./XMonad/Hooks/Place.hs 226 -purePlaceWindow (Bounds (t,r,b,l) p') (Rectangle sx sy sw sh) rs p w +purePlaceWindow (Bounds (t,r,b,l) p') (Rectangle sx sy sw sh) rs p w hunk ./XMonad/Hooks/Place.hs 270 - = S.RationalRect ((fi x-fi x0) % fi w0) - ((fi y-fi y0) % fi h0) - (fi w % fi w0) + = S.RationalRect ((fi x-fi x0) % fi w0) + ((fi y-fi y0) % fi h0) + (fi w % fi w0) hunk ./XMonad/Hooks/Place.hs 289 - + hunk ./XMonad/Hooks/Place.hs 308 -organizeClients ws w floats - = let (floatCs, layoutCs) = partition (`elem` floats) $ filter (/= w) +organizeClients ws w floats + = let (floatCs, layoutCs) = partition (`elem` floats) $ filter (/= w) hunk ./XMonad/Hooks/Place.hs 312 - -- About the ordering: the smart algorithm will overlap windows + -- About the ordering: the smart algorithm will overlap windows hunk ./XMonad/Hooks/Place.hs 326 -getNecessaryData :: Window +getNecessaryData :: Window hunk ./XMonad/Hooks/Place.hs 332 - + hunk ./XMonad/Hooks/Place.hs 337 - + hunk ./XMonad/Hooks/Place.hs 346 -data SmartRectangle a = SR +data SmartRectangle a = SR hunk ./XMonad/Hooks/Place.hs 383 - in position free (scale rx sx (sx + fi sw - fi w)) - (scale ry sy (sy + fi sh - fi h)) + in position free (scale rx sx (sx + fi sw - fi w)) + (scale ry sy (sy + fi sh - fi h)) hunk ./XMonad/Hooks/Place.hs 387 --- | Second part of the algorithm: --- Chooses the best position in which to place a window, +-- | Second part of the algorithm: +-- Chooses the best position in which to place a window, hunk ./XMonad/Hooks/Place.hs 398 - where distanceOrder r1 r2 + where distanceOrder r1 r2 hunk ./XMonad/Hooks/Place.hs 401 - distance (x1,y1) (x2,y2) = truncate $ (sqrt :: Double -> Double) - $ fi $ (x1 - x2)^(2::Int) + distance (x1,y1) (x2,y2) = truncate $ (sqrt :: Double -> Double) + $ fi $ (x1 - x2)^(2::Int) hunk ./XMonad/Hooks/Place.hs 408 --- Tries to find an area in which to place a new +-- Tries to find an area in which to place a new hunk ./XMonad/Hooks/Place.hs 428 -subtractRects :: Real a => SmartRectangle a +subtractRects :: Real a => SmartRectangle a hunk ./XMonad/Hooks/Place.hs 431 -subtractRects total (r:rs) +subtractRects total (r:rs) hunk ./XMonad/Hooks/Place.hs 442 --- already contained in another rectangle of the list. +-- already contained in another rectangle of the list. hunk ./XMonad/Hooks/Place.hs 456 -dropIfContained :: Real a => SmartRectangle a +dropIfContained :: Real a => SmartRectangle a hunk ./XMonad/Hooks/XPropManage.hs 37 --- > manageHook = xPropManageHook xPropMatches +-- > manageHook = xPropManageHook xPropMatches hunk ./XMonad/Hooks/XPropManage.hs 74 - mkHook func = ask >>= Query . lift . fmap Endo . func + mkHook func = ask >>= Query . lift . fmap Endo . func hunk ./XMonad/Layout/AutoMaster.hs 12 --- Provides layout modifier AutoMaster. It separates screen in two parts - +-- Provides layout modifier AutoMaster. It separates screen in two parts - hunk ./XMonad/Layout/AutoMaster.hs 52 - modifyLayout (AutoMaster k bias _) = autoLayout k bias + modifyLayout (AutoMaster k bias _) = autoLayout k bias hunk ./XMonad/Layout/AutoMaster.hs 104 --- | Divide rectangle between windows +-- | Divide rectangle between windows hunk ./XMonad/Layout/AutoMaster.hs 112 --- | Shift rectangle right +-- | Shift rectangle right hunk ./XMonad/Layout/CenteredMaster.hs 12 --- Two layout modifiers. centerMaster places master window at center, --- on top of all other windows, which are managed by base layout. --- topRightMaster is similar, but places master window in top right corner +-- Two layout modifiers. centerMaster places master window at center, +-- on top of all other windows, which are managed by base layout. +-- topRightMaster is similar, but places master window in top right corner hunk ./XMonad/Layout/CenteredMaster.hs 33 --- centerMaster places master window at center of screen, on top of others. +-- centerMaster places master window at center of screen, on top of others. hunk ./XMonad/Layout/CenteredMaster.hs 36 --- +-- hunk ./XMonad/Layout/CenteredMaster.hs 40 --- +-- hunk ./XMonad/Layout/CenteredMaster.hs 42 --- +-- hunk ./XMonad/Layout/CenteredMaster.hs 48 --- | Data type for LayoutModifier +-- | Data type for LayoutModifier hunk ./XMonad/Layout/CenteredMaster.hs 59 --- | Modifier that puts master window in center, other windows in background +-- | Modifier that puts master window in center, other windows in background hunk ./XMonad/Layout/CenteredMaster.hs 64 --- | Modifier that puts master window in top right corner, other windows in background +-- | Modifier that puts master window in top right corner, other windows in background hunk ./XMonad/Layout/Column.hs 68 - else + else hunk ./XMonad/Layout/DragPane.hs 10 --- +-- hunk ./XMonad/Layout/DragPane.hs 32 -import qualified XMonad.StackSet as W +import qualified XMonad.StackSet as W hunk ./XMonad/Layout/DragPane.hs 59 -data DragPane a = - DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double +data DragPane a = + DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double hunk ./XMonad/Layout/DragPane.hs 89 -handleEvent (DragPane (I (Just (win,r,ident))) ty _ _) +handleEvent (DragPane (I (Just (win,r,ident))) ty _ _) hunk ./XMonad/Layout/DragPane.hs 117 - if length wrs > 1 + if length wrs > 1 hunk ./XMonad/Layout/DragPane.hs 119 - I (Just (w,_,ident)) -> do + I (Just (w,_,ident)) -> do hunk ./XMonad/Layout/DragPane.hs 122 - I Nothing -> do + I Nothing -> do hunk ./XMonad/Layout/LayoutBuilder.hs 54 --- > ) ||| Full ||| etc... +-- > ) ||| Full ||| etc... hunk ./XMonad/Layout/LayoutHints.hs 95 - redoLayout (LayoutHints al) _ (Just s) xs + redoLayout (LayoutHints al) _ (Just s) xs hunk ./XMonad/Layout/Monitor.hs 50 --- +-- hunk ./XMonad/Layout/Monitor.hs 54 --- > } +-- > } hunk ./XMonad/Layout/Monitor.hs 57 --- +-- hunk ./XMonad/Layout/Monitor.hs 74 --- +-- hunk ./XMonad/Layout/Monitor.hs 76 --- +-- hunk ./XMonad/Layout/Monitor.hs 78 --- +-- hunk ./XMonad/Layout/Monitor.hs 80 --- +-- hunk ./XMonad/Layout/Monitor.hs 86 --- +-- hunk ./XMonad/Layout/Monitor.hs 148 - + hunk ./XMonad/Layout/MosaicAlt.hs 8 --- +-- hunk ./XMonad/Layout/MosaicAlt.hs 13 --- A layout which gives each window a specified amount of screen space +-- A layout which gives each window a specified amount of screen space hunk ./XMonad/Layout/OneBig.hs 57 -oneBigLayout (OneBig cx cy) rect stack = [(master,masterRect)] +oneBigLayout (OneBig cx cy) rect stack = [(master,masterRect)] hunk ./XMonad/Layout/OneBig.hs 109 --- | Divide bottom rectangle between windows +-- | Divide bottom rectangle between windows hunk ./XMonad/Layout/OneBig.hs 125 --- | Shift rectangle right +-- | Shift rectangle right hunk ./XMonad/Layout/Roledex.hs 30 --- > import XMonad.Layout.Roledex +-- > import XMonad.Layout.Roledex hunk ./XMonad/Layout/Roledex.hs 54 - rect = fst $ splitHorizontallyBy (2%3 :: Ratio Int) $ fst (splitVerticallyBy (2%3 :: Ratio Int) sc) - gw = div' (w - rw) (fromIntegral c) + rect = fst $ splitHorizontallyBy (2%3 :: Ratio Int) $ fst (splitVerticallyBy (2%3 :: Ratio Int) sc) + gw = div' (w - rw) (fromIntegral c) hunk ./XMonad/Layout/Roledex.hs 63 - mainPane = mrect (gw * fromIntegral c) (gh * fromIntegral c) rect + mainPane = mrect (gw * fromIntegral c) (gh * fromIntegral c) rect hunk ./XMonad/Layout/Roledex.hs 68 - cd n m = if n > m + cd n m = if n > m hunk ./XMonad/Layout/Spacing.hs 36 --- > layoutHook = spacing 2 $ Tall 1 (3/100) (1/2) +-- > layoutHook = spacing 2 $ Tall 1 (3/100) (1/2) hunk ./XMonad/Layout/Tabbed.hs 57 --- Left click on the tab switches focus to that window. +-- Left click on the tab switches focus to that window. hunk ./XMonad/Layout/Tabbed.hs 102 -tabbed :: (Eq a, Shrinker s) => s -> Theme +tabbed :: (Eq a, Shrinker s) => s -> Theme hunk ./XMonad/Layout/Tabbed.hs 106 -tabbedAlways :: (Eq a, Shrinker s) => s -> Theme +tabbedAlways :: (Eq a, Shrinker s) => s -> Theme hunk ./XMonad/Layout/Tabbed.hs 112 -tabbedBottom :: (Eq a, Shrinker s) => s -> Theme +tabbedBottom :: (Eq a, Shrinker s) => s -> Theme hunk ./XMonad/Layout/Tabbed.hs 116 -tabbedBottomAlways :: (Eq a, Shrinker s) => s -> Theme +tabbedBottomAlways :: (Eq a, Shrinker s) => s -> Theme hunk ./XMonad/Layout/Tabbed.hs 163 - if eb == button2 + if eb == button2 hunk ./XMonad/Layout/Tabbed.hs 169 - pureDecoration (Tabbed lc sh) _ ht _ s wrs (w,r@(Rectangle x y wh hh)) + pureDecoration (Tabbed lc sh) _ ht _ s wrs (w,r@(Rectangle x y wh hh)) hunk ./XMonad/Layout/Tabbed.hs 182 - shrink (Tabbed loc _ ) (Rectangle _ _ _ dh) (Rectangle x y w h) + shrink (Tabbed loc _ ) (Rectangle _ _ _ dh) (Rectangle x y w h) hunk ./XMonad/Layout/TwoPane.hs 8 --- +-- hunk ./XMonad/Layout/TwoPane.hs 42 -data TwoPane a = - TwoPane Rational Rational +data TwoPane a = + TwoPane Rational Rational hunk ./XMonad/Layout/TwoPane.hs 56 - handleMessage (TwoPane delta split) x = + handleMessage (TwoPane delta split) x = hunk ./XMonad/Prompt.hs 722 - setFileMode path mode + setFileMode path mode hunk ./XMonad/Prompt/AppLauncher.hs 11 --- A module for launch applicationes that receive parameters in the command +-- A module for launch applicationes that receive parameters in the command hunk ./XMonad/Prompt/AppLauncher.hs 34 - + hunk ./XMonad/Util/Invisible.hs 8 --- +-- hunk ./XMonad/Util/Invisible.hs 17 -module XMonad.Util.Invisible ( +module XMonad.Util.Invisible ( hunk ./XMonad/Util/WindowProperties.hs 41 - | And Property Property + | And Property Property hunk ./XMonad/Layout/CenteredMaster.hs 6 --- License : GNU GPL v3 or any later +-- License : BSD-style (see xmonad/LICENSE) hunk ./XMonad/Prompt.hs 59 -import XMonad.Util.XSelection (getSelection) +import XMonad.Util.XSelection (getSelection, putSelection) hunk ./XMonad/Prompt.hs 374 + | ks == xK_c -> copyString >> go hunk ./XMonad/Prompt.hs 463 +-- | Copy the currently entered string into the X selection. +copyString :: XP () +copyString = gets command >>= io . putSelection + hunk ./XMonad/Actions/CopyWindow.hs 12 --- Provides a binding to duplicate a window on multiple workspaces, +-- Provides bindings to duplicate a window on multiple workspaces, hunk ./XMonad/Actions/CopyWindow.hs 22 + -- * Highlight workspaces containing copies in logHook + -- $logHook + , wsContainingCopies hunk ./XMonad/Actions/CopyWindow.hs 27 -import Prelude hiding (filter) +import XMonad +import Control.Arrow ((&&&)) hunk ./XMonad/Actions/CopyWindow.hs 31 -import XMonad hiding (modify, workspaces) + hunk ./XMonad/Actions/CopyWindow.hs 60 --- Instead of copying a window from a workset to a workset maybe you don't +-- Instead of copying a window from one workspace to another maybe you don't hunk ./XMonad/Actions/CopyWindow.hs 79 --- | copy. Copy the focused window to a new workspace. +-- $logHook +-- To distinguish workspaces containing copies of the focused window use +-- something like: +-- +-- > sampleLogHook h = do +-- > copies <- wsContainingCopies +-- > let check ws | ws `elem` copies = pad . xmobarColor "red" "black" $ ws +-- > | otherwise = pad ws +-- > dynamicLogWithPP myPP {ppHidden = check, ppOutput = hPutStrLn h} +-- > +-- > main = do +-- > h <- spawnPipe "xmobar" +-- > xmonad defaultConfig { logHook = sampleLogHook h } + +-- | Copy the focused window to a workspace. hunk ./XMonad/Actions/CopyWindow.hs 98 --- | copyToAll. Copy the focused window to all of workspaces. +-- | Copy the focused window to all workspaces. hunk ./XMonad/Actions/CopyWindow.hs 102 --- | copyWindow. Copy a window to a new workspace +-- | Copy an arbitrary window to a workspace. hunk ./XMonad/Actions/CopyWindow.hs 114 --- | runOrCopy . runOrCopy will run the provided shell command unless it can +-- | runOrCopy will run the provided shell command unless it can hunk ./XMonad/Actions/CopyWindow.hs 120 --- | Copy a window if it exists, run the first argument otherwise +-- | Copy a window if it exists, run the first argument otherwise. hunk ./XMonad/Actions/CopyWindow.hs 130 --- supports the delete protocol, send a delete event (e.g. firefox) +-- supports the delete protocol, send a delete event (e.g. firefox). hunk ./XMonad/Actions/CopyWindow.hs 138 --- | Kill all other copies of focused window (if they're present) --- 'All other' means here 'copies, which are not on current workspace' --- --- TODO: Call this function after 'copyToAll'? +-- | Kill all other copies of focused window (if they're present). +-- 'All other' means here 'copies which are not on the current workspace'. hunk ./XMonad/Actions/CopyWindow.hs 150 + +-- | A list of hidden workspaces containing a copy of the focused window. +wsContainingCopies :: X [WorkspaceId] +wsContainingCopies = do + ws <- gets windowset + return $ copiesOfOn (W.peek ws) (taggedWindows $ W.hidden ws) + +-- | Get a list of tuples (tag, [Window]) for each workspace. +taggedWindows :: [W.Workspace i l a] -> [(i, [a])] +taggedWindows = map $ W.tag &&& W.integrate' . W.stack + +-- | Get tags with copies of the focused window (if present.) +copiesOfOn :: (Eq a) => Maybe a -> [(i, [a])] -> [i] +copiesOfOn foc tw = maybe [] hasCopyOf foc + where hasCopyOf f = map fst $ filter ((f `elem` ) . snd) tw hunk ./XMonad/Layout/Tabbed.hs 9 --- Maintainer : droundy@darcs.net, andrea.rossato@unibz.it +-- Maintainer : andrea.rossato@unibz.it hunk ./XMonad/Prompt/Directory.hs 7 --- Maintainer : droundy@darcs.net +-- Maintainer : hunk ./XMonad/Prompt/Layout.hs 7 --- Maintainer : droundy@darcs.net +-- Maintainer : hunk ./XMonad/Prompt/Workspace.hs 7 --- Maintainer : droundy@darcs.net +-- Maintainer : hunk ./XMonad/Util/Invisible.hs 9 --- Maintainer : andrea.rossato@unibz.it, droundy@darcs.net +-- Maintainer : andrea.rossato@unibz.it hunk ./XMonad/Util/WindowProperties.hs 41 + | Machine String -- ^ WM_CLIENT_MACHINE property hunk ./XMonad/Util/WindowProperties.hs 55 -hasProperty (Role s) w = withDisplay $ \d -> fmap ((==) (Just s)) $ getStringProperty d w "WM_WINDOW_ROLE" +hasProperty (Role s) w = withDisplay $ \d -> fmap ((==) (Just s)) $ getStringProperty d w "WM_WINDOW_ROLE" +hasProperty (Machine s) w = withDisplay $ \d -> fmap ((==) (Just s)) $ getStringProperty d w "WM_CLIENT_MACHINE" hunk ./XMonad/Util/WindowProperties.hs 84 +propertyToQuery (Machine s) = stringProperty "WM_CLIENT_MACHINE" =? s hunk ./XMonad/Actions/RandomBackground.hs 44 - let -- x = (sqrt 3 - tan theta) / sqrt 3 - x = (^2) $ fst $ randomR (0,sqrt $ pi / 3) g + let x = (^(2::Int)) $ fst $ randomR (0,sqrt $ pi / 3) g hunk ./XMonad/Actions/Submap.hs 21 - +import Data.Bits hunk ./XMonad/Actions/Submap.hs 77 - - m' <- cleanMask m + -- Remove num lock mask and Xkb group state bits + m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1) hunk ./XMonad/Layout/LayoutBuilder.hs 47 --- > ( (layoutN 1 (relBox (1/3) 0 (1/2) 1) (Just $ relBox 0 0 1 1) $ Tall 0 0 0) --- > $ (layoutR 0.1 0.5 (relBox (2/3) 0 1 1) Nothing $ Tall 0 0 0) --- > $ (layoutAll (relBox 0 0 (1/3) 1) $ Tall 0 0 0) +-- > ( (layoutN 1 (relBox (1/3) 0 (1/2) 1) (Just $ relBox 0 0 1 1) $ Tall 0 0.01 0.5) +-- > $ (layoutR 0.1 0.5 (relBox (2/3) 0 1 1) Nothing $ Tall 0 0.01 0.5) +-- > $ (layoutAll (relBox 0 0 (1/3) 1) $ Tall 0 0.01 0.5) hunk ./XMonad/Actions/GridSelect.hs 1 -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving #-} hunk ./XMonad/Actions/GridSelect.hs 35 +import Data.Traversable (traverse) hunk ./XMonad/Actions/GridSelect.hs 37 +import Control.Applicative hunk ./XMonad/Actions/GridSelect.hs 41 -import XMonad +import qualified Data.Map as M +import XMonad hiding (liftX) hunk ./XMonad/Actions/GridSelect.hs 76 - gs_font :: String + gs_font :: String, + gs_navigate :: NavigateMap hunk ./XMonad/Actions/GridSelect.hs 80 +type NavigateMap = M.Map (KeyMask,KeySym) (TwoDPosition -> TwoDPosition) + hunk ./XMonad/Actions/GridSelect.hs 95 -type TwoD a b = StateT (TwoDState a) X b +newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b } + deriving (Monad,Functor,MonadState (TwoDState a)) + +instance Applicative (TwoD a) where + (<*>) = ap + pure = return + +liftX :: X a1 -> TwoD a a1 +liftX = TwoD . lift + +evalTwoD :: TwoD a1 a -> TwoDState a1 -> X a +evalTwoD m s = flip evalStateT s $ unTwoD m hunk ./XMonad/Actions/GridSelect.hs 168 - updateElement (pos@(x,y),(text, element)) = lift $ do - colors <- (gs_colorizer gsconfig) element (pos == curpos) + updateElement (pos@(x,y),(text, element)) = liftX $ do + colors <- gs_colorizer gsconfig element (pos == curpos) hunk ./XMonad/Actions/GridSelect.hs 178 - mapM updateElement elementmap - return () + mapM_ updateElement elementmap hunk ./XMonad/Actions/GridSelect.hs 182 - (keysym,string,event) <- lift $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do + (keysym,string,event) <- liftX $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do hunk ./XMonad/Actions/GridSelect.hs 191 -handle :: (KeySym, String) - -> Event - -> StateT (TwoDState a) X (Maybe a) -handle (ks,_) (KeyEvent {ev_event_type = t}) +handle :: (KeySym, t) -> Event -> TwoD a (Maybe a) +handle (ks,_) (KeyEvent {ev_event_type = t, ev_state = m }) hunk ./XMonad/Actions/GridSelect.hs 194 - | t == keyPress && (ks == xK_Left || ks == xK_h) = diffAndRefresh (-1,0) - | t == keyPress && (ks == xK_Right || ks == xK_l) = diffAndRefresh (1,0) - | t == keyPress && (ks == xK_Down || ks == xK_j) = diffAndRefresh (0,1) - | t == keyPress && (ks == xK_Up || ks == xK_k) = diffAndRefresh (0,-1) hunk ./XMonad/Actions/GridSelect.hs 197 + | t == keyPress = fmap join $ traverse diffAndRefresh . M.lookup (m,ks) + =<< gets (gs_navigate . td_gsconfig) hunk ./XMonad/Actions/GridSelect.hs 203 - newPos = oldPos `tupadd` diff + newPos = diff oldPos hunk ./XMonad/Actions/GridSelect.hs 212 - (TwoDState { td_elementmap = elmap, td_paneX = px, td_paneY = py, - td_gsconfig = (GSConfig ch cw _ _ _) }) <- get + TwoDState { td_elementmap = elmap, td_paneX = px, td_paneY = py, + td_gsconfig = (GSConfig ch cw _ _ _ _) } <- get hunk ./XMonad/Actions/GridSelect.hs 321 - selectedElement <- evalStateT (updateAllElements >> eventLoop) - (TwoDState (0,0) - elmap' - gsconfig - font - screenWidth - screenHeight - win) - return selectedElement + + evalTwoD (updateAllElements >> eventLoop) + (TwoDState (0,0) + elmap' + gsconfig + font + screenWidth + screenHeight + win) hunk ./XMonad/Actions/GridSelect.hs 369 -buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" +buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultGSNav + +defaultGSNav :: NavigateMap +defaultGSNav = M.map tupadd $ M.fromList + [((0,xK_Left) ,(-1,0)) + ,((0,xK_h) ,(-1,0)) + ,((0,xK_Right),(1,0)) + ,((0,xK_l) ,(1,0)) + ,((0,xK_Down) ,(0,1)) + ,((0,xK_j) ,(0,1)) + ,((0,xK_Up) ,(0,-1)) + ,((0,xK_k) ,(0,-1)) + ] hunk ./XMonad/Layout/LayoutHints.hs 25 -import XMonad(LayoutClass(runLayout), X, mkAdjust, Window, - Dimension, Position, Rectangle(Rectangle)) +import XMonad(LayoutClass(runLayout), mkAdjust, Window, + Dimension, Position, Rectangle(Rectangle),D) hunk ./XMonad/Layout/LayoutHints.hs 34 -import Control.Arrow(Arrow((***), second)) +import Control.Arrow(Arrow((***), first, second)) hunk ./XMonad/Layout/LayoutHints.hs 118 -applyOrder :: Rectangle -> [(Window, Rectangle)] -> [[(Window, Rectangle)]] +applyOrder :: Rectangle -> [((Window, Rectangle),t)] -> [[((Window, Rectangle),t)]] hunk ./XMonad/Layout/LayoutHints.hs 125 - distance = map distFC . corners . snd + distance = map distFC . corners . snd . fst hunk ./XMonad/Layout/LayoutHints.hs 137 - <$> mapM (applyHints st r) (applyOrder r arrs) + . map (applyHints st r) . applyOrder r + <$> mapM (\x -> fmap ((,) x) $ mkAdjust (fst x)) arrs hunk ./XMonad/Layout/LayoutHints.hs 141 -applyHints :: W.Stack Window -> Rectangle -> [(Window, Rectangle)] -> X [(Window, Rectangle)] -applyHints _ _ [] = return [] -applyHints s root ((w,lrect@(Rectangle a b c d)):xs) = do - adj <- mkAdjust w +applyHints :: W.Stack Window -> Rectangle -> [((Window, Rectangle),(D -> D))] -> [(Window, Rectangle)] +applyHints _ _ [] = [] +applyHints s root (((w,lrect@(Rectangle a b c d)),adj):xs) = hunk ./XMonad/Layout/LayoutHints.hs 150 - mapSnd f = map (second f) - next <- applyHints s root $ mapSnd growOther' xs - return $ (w,redr):next + mapSnd f = map (first $ second f) + next = applyHints s root $ mapSnd growOther' xs + in (w,redr):next hunk ./XMonad/Actions/GridSelect.hs 35 -import Data.Traversable (traverse) hunk ./XMonad/Actions/GridSelect.hs 196 - | t == keyPress = fmap join $ traverse diffAndRefresh . M.lookup (m,ks) - =<< gets (gs_navigate . td_gsconfig) + | t == keyPress = maybe eventLoop diffAndRefresh . M.lookup (m,ks) + =<< gets (gs_navigate . td_gsconfig) hunk ./XMonad/Util/EZConfig.hs 30 + mkNamedKeymap hunk ./XMonad/Util/EZConfig.hs 36 +import XMonad.Util.NamedActions + hunk ./XMonad/Util/EZConfig.hs 355 +mkNamedKeymap :: XConfig l -> [(String, NamedAction)] -> [((KeyMask, KeySym), NamedAction)] +mkNamedKeymap c = mkNamedSubmaps . readKeymap c + hunk ./XMonad/Util/EZConfig.hs 360 + +mkNamedSubmaps :: [([(KeyMask, KeySym)], NamedAction)] -> [((KeyMask, KeySym), NamedAction)] +mkNamedSubmaps binds = map combine gathered + where gathered = groupBy fstKey + . sortBy (comparing fst) + $ binds + combine [([k],act)] = (k,act) + combine ks = (head . fst . head $ ks, + submapName . mkNamedSubmaps $ map (first tail) ks) + fstKey = (==) `on` (head . fst) + hunk ./XMonad/Util/EZConfig.hs 388 -readKeymap :: XConfig l -> [(String, X())] -> [([(KeyMask,KeySym)], X())] +readKeymap :: XConfig l -> [(String, t)] -> [([(KeyMask, KeySym)], t)] addfile ./XMonad/Util/NamedActions.hs hunk ./XMonad/Util/NamedActions.hs 1 +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances, StandaloneDeriving #-} +{-# LANGUAGE ExistentialQuantification, FlexibleContexts #-} +-------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.NamedActions +-- Copyright : Adam Vogt +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Adam Vogt +-- Stability : unstable +-- Portability : unportable +-- +-- Present a list of the keybindings in use. +-------------------------------------------------------------------- + +module XMonad.Util.NamedActions ( + -- * Usage: + -- $usage + sendMessage', + spawn', + submapName, + addDescrKeys, + xMessage, + + showKmSimple, + showKm, + + noName, + oneName, + addName, + + (^++^), + + NamedAction(..), + HasName, + defaultKeysDescr + ) where + +import XMonad.Actions.Submap(submap) +import XMonad(KeySym, KeyMask, X, Layout, Message, + XConfig(workspaces, terminal, modMask, layoutHook, keys, XConfig), + io, spawn, whenJust, ChangeLayout(NextLayout), IncMasterN(..), + Resize(..), kill, refresh, screenWorkspace, sendMessage, setLayout, + windows, withFocused, controlMask, mod1Mask, mod2Mask, mod3Mask, + mod4Mask, mod5Mask, shiftMask, xK_1, xK_9, xK_Return, xK_Tab, xK_c, + xK_comma, xK_e, xK_h, xK_j, xK_k, xK_l, xK_m, xK_n, xK_p, + xK_period, xK_q, xK_r, xK_space, xK_t, xK_w, keysymToString) +import System.Posix.Process(executeFile, forkProcess) +import Control.Arrow(Arrow((***), second, (&&&), first)) +import Data.Bits(Bits((.|.), complement, (.&.))) +import Data.Function((.), const, ($), flip, id, on) +import Data.List((++), filter, zip, map, concatMap, elem, head, + last, null, unlines, groupBy, intercalate, partition, sortBy) +import System.Exit(ExitCode(ExitSuccess), exitWith) + +import qualified Data.Map as M +import qualified XMonad.StackSet as W + +-- $usage +-- Here is an example config that demonstrates the usage of 'sendMessage'', +-- 'mkNamedKeymap', 'addDescrKeys', and '^++^' +-- +-- > import XMonad +-- > import XMonad.Util.NamedActions +-- > import XMonad.Util.EZConfig +-- > +-- > main = xmonad $ addDescrKeys ((mod4Mask, xK_d), xMessage) myKeys +-- > defaultConfig { modMask = mod4Mask } +-- > +-- > myKeys = flip mkNamedKeymap $ +-- > [("M-x a", addName "useless..." $ spawn "xmessage foo"), +-- > ("M-c", sendMessage' Expand)] +-- > ^++^ +-- > [("", spawn "mpc toggle" :: X ()), +-- > ("", spawn "mpc next"] +-- +-- Due to the type of '^++^', you can combine bindings whose actions are @X ()@ +-- as well as actions that have descriptions. However you cannot mix the two in +-- a single list, unless each is prefixed with 'addName' or 'noName'. '^++^' +-- works with traditional-style keybindings too. +-- +-- Also note the unfortunate necessity of a type annotation, since 'spawn' is +-- too general. + +deriving instance Show XMonad.Resize +deriving instance Show XMonad.IncMasterN + +-- | 'sendMessage' but add a description that is @show message@. Note that not +-- all messages have show instances. +sendMessage' :: (Message a, Show a) => a -> NamedAction +sendMessage' x = NamedAction $ (XMonad.sendMessage x,show x) + +-- | 'spawn' but the description is the string passed +spawn' :: String -> NamedAction +spawn' x = addName x $ spawn x + +class HasName a where + showName :: a -> [String] + showName = const [""] + getAction :: a -> X () + +instance HasName (X ()) where + getAction = id + +instance HasName (IO ()) where + getAction = io + +instance HasName (X (),String) where + showName = (:[]) . snd + getAction = fst + +instance HasName (X (),[String]) where + showName = snd + getAction = fst + +-- show only the outermost description +instance HasName (NamedAction,String) where + showName = (:[]) . snd + getAction = getAction . fst + +instance HasName NamedAction where + showName (NamedAction x) = showName x + getAction (NamedAction x) = getAction x + +-- | An existential wrapper so that different types can be combined in lists, +-- and maps +data NamedAction = forall a. HasName a => NamedAction a + +-- | 'submap', but propagate the descriptions of the actions. Does this belong +-- in "XMonad.Actions.Submap"? +submapName :: (HasName a) => [((KeyMask, KeySym), a)] -> NamedAction +submapName = NamedAction . (submap . M.map getAction . M.fromList &&& showKm) + . map (second NamedAction) + +-- | Combine keymap lists with actions that may or may not have names +(^++^) :: (HasName b, HasName b1) => + [(d, b)] -> [(d, b1)] -> [(d, NamedAction)] +a ^++^ b = map (second NamedAction) a ++ map (second NamedAction) b + +-- | Or allow another lookup table? +modToString :: KeyMask -> String +modToString mask = concatMap (++"-") $ filter (not . null) + $ map (uncurry w) + [(mod1Mask, "M1") + ,(mod2Mask, "M2") + ,(mod3Mask, "M3") + ,(mod4Mask, "M4") + ,(mod5Mask, "M5") + ,(controlMask, "C") + ,(shiftMask,"Shift")] + where w m str = if m .&. complement mask == 0 then str else "" + +keyToString :: (KeyMask, KeySym) -> [Char] +keyToString = uncurry (++) . (modToString *** keysymToString) + +-- | Squeezes bindings from [xK_1 .. xK_9] +showKm :: [((KeyMask, KeySym), NamedAction)] -> [[Char]] +showKm = uncurry (flip (++)) + . second showKmSimple + . first (map ( intercalate " ... " . showKmSimple . uncurry (:) + . (head &&& (:[]) . last) + . sortBy (compare `on` (snd . fst))) + . groupBy ((==) `on` (fst . fst)) + ) + . partition ((`elem` [xK_1 .. xK_9]) . snd . fst) + +showKmSimple :: [((KeyMask, KeySym), NamedAction)] -> [[Char]] +showKmSimple = concatMap (\(k,e) -> map ((keyToString k ++) . smartSpace) $ showName e) + where smartSpace [] = [] + smartSpace xs = ' ':xs + +-- | An action to send to 'addDescrKeys' for showing the keybindings. See also 'showKm' and 'showKmSimple' +xMessage :: [((KeyMask, KeySym), NamedAction)] -> NamedAction +xMessage x = addName "Show Keybindings" $ io $ do + forkProcess $ executeFile "xmessage" True ["-default", "okay", unlines $ showKm x] Nothing + return () + +-- | Merge the supplied keys with 'defaultKeysDescr' +addDescrKeys :: (HasName b1, HasName b) => + ((KeyMask, KeySym),[((KeyMask, KeySym), NamedAction)] -> b) + -> (XConfig Layout -> [((KeyMask, KeySym), b1)]) + -> XConfig l + -> XConfig l +addDescrKeys k ks = addDescrKeys' k (\l -> defaultKeysDescr l ^++^ ks l) + +-- | Without merging with 'defaultKeysDescr' +addDescrKeys' :: (HasName b) => + ((KeyMask, KeySym),[((KeyMask, KeySym), NamedAction)] -> b) + -> (XConfig Layout -> [((KeyMask, KeySym), NamedAction)]) -> XConfig l -> XConfig l +addDescrKeys' (k,f) ks conf = + let shk l = f $ [(k,f $ ks l)] ^++^ ks l + keylist l = M.map getAction $ M.fromList $ ks l ^++^ [(k, shk l)] + in conf { keys = keylist } + +-- | A version of the default keys from 'XMonad.Config.defaultConfig', but with +-- 'NamedAction' instead of @X ()@ +defaultKeysDescr :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)] +defaultKeysDescr conf@(XConfig {XMonad.modMask = modm}) = + -- launching and killing programs + [ ((modm .|. shiftMask, xK_Return), addName "Launch Terminal" $ spawn $ XMonad.terminal conf) -- %! Launch terminal + , ((modm, xK_p ), addName "Launch dmenu" $ spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu + , ((modm .|. shiftMask, xK_p ), addName "Launch gmrun" $ spawn "gmrun") -- %! Launch gmrun + , ((modm .|. shiftMask, xK_c ), addName "Close the focused window" kill) -- %! Close the focused window + + , ((modm, xK_space ), sendMessage' NextLayout) -- %! Rotate through the available layout algorithms + , ((modm .|. shiftMask, xK_space ), addName "Reset the layout" $ setLayout $ XMonad.layoutHook conf) -- %! Reset the layouts on the current workspace to default + + , ((modm, xK_n ), addName "Refresh" refresh) -- %! Resize viewed windows to the correct size + + -- move focus up or down the window stack + , ((modm, xK_Tab ), addName "Focus down" $ windows W.focusDown) -- %! Move focus to the next window + , ((modm .|. shiftMask, xK_Tab ), addName "Focus up" $ windows W.focusUp ) -- %! Move focus to the previous window + , ((modm, xK_j ), addName "Focus down" $ windows W.focusDown) -- %! Move focus to the next window + , ((modm, xK_k ), addName "Focus up" $ windows W.focusUp ) -- %! Move focus to the previous window + , ((modm, xK_m ), addName "Focus the master" $ windows W.focusMaster ) -- %! Move focus to the master window + + -- modifying the window order + , ((modm, xK_Return), addName "Swap with the master" $ windows W.swapMaster) -- %! Swap the focused window and the master window + , ((modm .|. shiftMask, xK_j ), addName "Swap down" $ windows W.swapDown ) -- %! Swap the focused window with the next window + , ((modm .|. shiftMask, xK_k ), addName "Swap up" $ windows W.swapUp ) -- %! Swap the focused window with the previous window + + -- resizing the master/slave ratio + , ((modm, xK_h ), sendMessage' Shrink) -- %! Shrink the master area + , ((modm, xK_l ), sendMessage' Expand) -- %! Expand the master area + + -- floating layer support + , ((modm, xK_t ), addName "Push floating to tiled" $ withFocused $ windows . W.sink) -- %! Push window back into tiling + + -- increase or decrease number of windows in the master area + , ((modm , xK_comma ), sendMessage' (IncMasterN 1)) -- %! Increment the number of windows in the master area + , ((modm , xK_period), sendMessage' (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area + + -- quit, or restart + , ((modm .|. shiftMask, xK_q ), addName "Quit" $ io (exitWith ExitSuccess)) -- %! Quit xmonad + , ((modm , xK_q ), addName "Restart" $ spawn "xmonad --recompile && xmonad --restart") -- %! Restart xmonad + ] + ++ + -- mod-[1..9] %! Switch to workspace N + -- mod-shift-[1..9] %! Move client to workspace N + [((m .|. modm, k), addName (n ++ i) $ windows $ f i) + | (f, m, n) <- [(W.greedyView, 0, "Switch to workspace "), (W.shift, shiftMask, "Move client to workspace ")] + , (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]] + ++ + -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 + -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3 + [((m .|. modm, key), addName (n ++ show sc) $ screenWorkspace sc >>= flip whenJust (windows . f)) + | (f, m, n) <- [(W.view, 0, "Switch to screen number "), (W.shift, shiftMask, "Move client to screen number ")] + , (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]] + +-- | These are just the @NamedAction@ constructor but with a more specialized +-- type, so that you don't have to supply any annotations, for ex coercing +-- spawn to @X ()@ from the more general @MonadIO m => m ()@ +noName :: X () -> NamedAction +noName = NamedAction + +oneName :: (X (), String) -> NamedAction +oneName = NamedAction + +addName :: String -> X () -> NamedAction +addName = flip (curry NamedAction) hunk ./xmonad-contrib.cabal 218 + XMonad.Util.NamedActions hunk ./XMonad/Util/NamedActions.hs 33 + separator, + subtitle, + hunk ./XMonad/Util/NamedActions.hs 89 +-- TODO: squeeze titles that have no entries (consider titles containing \n) +-- +-- pad as if by columns +-- +-- Multiple columns +-- +-- Devin Mullin's suggestions: +-- +--Reduce redundancy wrt mkNamedSubmaps, mkSubmaps and mkNamedKeymap to have a +--HasName context (and leave mkKeymap as a specific case of it?) +-- +-- Suggestions for UI: +-- +-- - An IO () -> IO () that wraps the main xmonad action and wrests control +-- from it if the user asks for --keys. +-- +-- Just a separate binary: keep this as the only way to show keys for simplicity +-- +-- - An X () that toggles a cute little overlay like the ? window for gmail +-- and reader. +-- +-- Add dzen binding + hunk ./XMonad/Util/NamedActions.hs 135 +instance HasName [Char] where + getAction _ = return () + showName = (:[]) + hunk ./XMonad/Util/NamedActions.hs 199 -showKmSimple = concatMap (\(k,e) -> map ((keyToString k ++) . smartSpace) $ showName e) +showKmSimple = concatMap (\(k,e) -> if snd k == 0 then "":showName e else map ((keyToString k ++) . smartSpace) $ showName e) hunk ./XMonad/Util/NamedActions.hs 230 - -- launching and killing programs - [ ((modm .|. shiftMask, xK_Return), addName "Launch Terminal" $ spawn $ XMonad.terminal conf) -- %! Launch terminal + [ subtitle "launching and killing programs" + , ((modm .|. shiftMask, xK_Return), addName "Launch Terminal" $ spawn $ XMonad.terminal conf) -- %! Launch terminal hunk ./XMonad/Util/NamedActions.hs 236 + , subtitle "changing layouts" hunk ./XMonad/Util/NamedActions.hs 240 + , separator hunk ./XMonad/Util/NamedActions.hs 243 - -- move focus up or down the window stack + , subtitle "move focus up or down the window stack" hunk ./XMonad/Util/NamedActions.hs 250 - -- modifying the window order + , subtitle "modifying the window order" hunk ./XMonad/Util/NamedActions.hs 255 - -- resizing the master/slave ratio + , subtitle "resizing the master/slave ratio" hunk ./XMonad/Util/NamedActions.hs 259 - -- floating layer support + , subtitle "floating layer support" hunk ./XMonad/Util/NamedActions.hs 262 - -- increase or decrease number of windows in the master area + , subtitle "increase or decrease number of windows in the master area" hunk ./XMonad/Util/NamedActions.hs 266 - -- quit, or restart + , subtitle "quit, or restart" hunk ./XMonad/Util/NamedActions.hs 270 - ++ + hunk ./XMonad/Util/NamedActions.hs 273 + ++ + subtitle "switching workspaces": hunk ./XMonad/Util/NamedActions.hs 278 - ++ hunk ./XMonad/Util/NamedActions.hs 280 - [((m .|. modm, key), addName (n ++ show sc) $ screenWorkspace sc >>= flip whenJust (windows . f)) + ++ + subtitle "switching screens" : + [((m .|. modm, key), addName (n ++ show sc) $ screenWorkspace sc >>= flip whenJust (windows . f)) hunk ./XMonad/Util/NamedActions.hs 286 +-- | For a prettier presentation: keymask, keysym of 0 are reserved for this +-- purpose: they do not happen, afaik, and keysymToString 0 would raise error +-- otherwise +separator :: ((KeyMask,KeySym), NamedAction) +separator = ((0,0), NamedAction (return () :: X (),[] :: [String])) + +subtitle :: String -> ((KeyMask, KeySym), NamedAction) +subtitle x = ((0,0), NamedAction $ x ++ ":") + hunk ./XMonad/Util/EZConfig.hs 362 -mkNamedSubmaps binds = map combine gathered - where gathered = groupBy fstKey - . sortBy (comparing fst) - $ binds - combine [([k],act)] = (k,act) - combine ks = (head . fst . head $ ks, - submapName . mkNamedSubmaps $ map (first tail) ks) - fstKey = (==) `on` (head . fst) +mkNamedSubmaps = mkSubmaps' submapName hunk ./XMonad/Util/EZConfig.hs 365 -mkSubmaps binds = map combine gathered +mkSubmaps = mkSubmaps' $ submap . M.fromList + +mkSubmaps' :: (Ord a) => ([(a, c)] -> c) -> [([a], c)] -> [(a, c)] +mkSubmaps' subm binds = map combine gathered hunk ./XMonad/Util/EZConfig.hs 374 - submap . M.fromList . mkSubmaps $ map (first tail) ks) + subm . mkSubmaps' subm $ map (first tail) ks) hunk ./XMonad/Util/NamedActions.hs 2 -{-# LANGUAGE FlexibleInstances, StandaloneDeriving #-} -{-# LANGUAGE ExistentialQuantification, FlexibleContexts #-} +{-# LANGUAGE ExistentialQuantification, FlexibleContexts, FlexibleInstances, StandaloneDeriving #-} hunk ./XMonad/Util/NamedActions.hs 6 --- Copyright : Adam Vogt +-- Copyright : 2009 Adam Vogt hunk ./XMonad/Util/NamedActions.hs 13 --- Present a list of the keybindings in use. +-- A wrapper for keybinding configuration that can list the available +-- keybindings. hunk ./XMonad/Util/NamedActions.hs 43 + hunk ./XMonad/Util/NamedActions.hs 46 - XConfig(workspaces, terminal, modMask, layoutHook, keys, XConfig), + XConfig(keys, layoutHook, modMask, terminal, workspaces, XConfig), hunk ./XMonad/Util/NamedActions.hs 54 -import Control.Arrow(Arrow((***), second, (&&&), first)) -import Data.Bits(Bits((.|.), complement, (.&.))) -import Data.Function((.), const, ($), flip, id, on) -import Data.List((++), filter, zip, map, concatMap, elem, head, - last, null, unlines, groupBy, intercalate, partition, sortBy) +import Control.Arrow(Arrow((&&&), second, (***))) +import Data.Bits(Bits((.&.), complement, (.|.))) +import Data.Function((.), const, ($), flip, id) +import Data.List((++), filter, zip, map, concatMap, null, unlines, + groupBy) hunk ./XMonad/Util/NamedActions.hs 61 +import Control.Applicative ((<*>)) + hunk ./XMonad/Util/NamedActions.hs 65 +import qualified XMonad hunk ./XMonad/Util/NamedActions.hs 75 --- > main = xmonad $ addDescrKeys ((mod4Mask, xK_d), xMessage) myKeys +-- > main = xmonad $ addDescrKeys ((mod4Mask, xK_F1), xMessage) myKeys hunk ./XMonad/Util/NamedActions.hs 78 --- > myKeys = flip mkNamedKeymap $ --- > [("M-x a", addName "useless..." $ spawn "xmessage foo"), +-- > myKeys c = (subtitle "Custom Keys":) $ mkNamedKeymap c $ +-- > [("M-x a", addName "useless message" $ spawn "xmessage foo"), hunk ./XMonad/Util/NamedActions.hs 83 --- > ("", spawn "mpc next"] +-- > ("", spawn "mpc next")] hunk ./XMonad/Util/NamedActions.hs 85 --- Due to the type of '^++^', you can combine bindings whose actions are @X ()@ +-- Using '^++^', you can combine bindings whose actions are @X ()@ hunk ./XMonad/Util/NamedActions.hs 87 --- a single list, unless each is prefixed with 'addName' or 'noName'. '^++^' --- works with traditional-style keybindings too. +-- a single list, unless each is prefixed with 'addName' or 'noName'. +-- +-- If you don't like EZConfig, you can still use '^++^' with the basic XMonad +-- keybinding configuration too. hunk ./XMonad/Util/NamedActions.hs 97 --- pad as if by columns --- --- Multiple columns +-- Output to Multiple columns hunk ./XMonad/Util/NamedActions.hs 101 ---Reduce redundancy wrt mkNamedSubmaps, mkSubmaps and mkNamedKeymap to have a ---HasName context (and leave mkKeymap as a specific case of it?) +-- Reduce redundancy wrt mkNamedSubmaps, mkSubmaps and mkNamedKeymap to have a +-- HasName context (and leave mkKeymap as a specific case of it?) +-- Currently kept separate to aid error messages, common lines factored out hunk ./XMonad/Util/NamedActions.hs 179 - $ map (uncurry w) + $ map (uncurry pick) hunk ./XMonad/Util/NamedActions.hs 187 - where w m str = if m .&. complement mask == 0 then str else "" + where pick m str = if m .&. complement mask == 0 then str else "" hunk ./XMonad/Util/NamedActions.hs 192 --- | Squeezes bindings from [xK_1 .. xK_9] -showKm :: [((KeyMask, KeySym), NamedAction)] -> [[Char]] -showKm = uncurry (flip (++)) - . second showKmSimple - . first (map ( intercalate " ... " . showKmSimple . uncurry (:) - . (head &&& (:[]) . last) - . sortBy (compare `on` (snd . fst))) - . groupBy ((==) `on` (fst . fst)) - ) - . partition ((`elem` [xK_1 .. xK_9]) . snd . fst) - hunk ./XMonad/Util/NamedActions.hs 194 - where smartSpace [] = [] - smartSpace xs = ' ':xs + +smartSpace :: String -> String +smartSpace [] = [] +smartSpace xs = ' ':xs + +_test :: String +_test = unlines $ showKm $ defaultKeysDescr XMonad.defaultConfig { XMonad.layoutHook = XMonad.Layout $ XMonad.layoutHook XMonad.defaultConfig } + +showKm :: [((KeyMask, KeySym), NamedAction)] -> [String] +showKm keybindings = padding $ do + (k,e) <- keybindings + if snd k == 0 then map ((,) "") $ showName e + else map ((,) (keyToString k) . smartSpace) $ showName e + where padding = let pad n (k,e) = if null k then "\n>> "++e else take n (k++repeat ' ') ++ e + expand xs n = map (pad n) xs + getMax = map (maximum . map (length . fst)) + in concat . (zipWith expand <*> getMax) . groupBy (const $ not . null . fst) hunk ./XMonad/Util/NamedActions.hs 218 --- | Merge the supplied keys with 'defaultKeysDescr' +-- | Merge the supplied keys with 'defaultKeysDescr', also adding a keybinding +-- to run an action for showing the keybindings. hunk ./XMonad/Util/NamedActions.hs 272 - , subtitle "increase or decrease number of windows in the master area" + , subtitle "change the number of windows in the master area" hunk ./XMonad/Util/NamedActions.hs 297 --- purpose: they do not happen, afaik, and keysymToString 0 would raise error --- otherwise +-- purpose: they do not happen, afaik, and keysymToString 0 would raise an +-- error otherwise addfile ./XMonad/Layout/MessageControl.hs hunk ./XMonad/Layout/MessageControl.hs 1 - +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.MessageControl +-- Copyright : (c) 2008 Quentin Moser +-- License : BSD3 +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Provides message \"escaping\" and filtering facilities which +-- help control complex nested layouts. +----------------------------------------------------------------------------- + +module XMonad.Layout.MessageControl ( + -- * Usage + -- $usage + Ignore() + , ignore + , UnEscape() + , unEscape + , EscapedMessage(Escape) + , escape + ) where + +import XMonad.Core (Message, SomeMessage(..) + , fromMessage, LayoutClass(..)) +import XMonad.StackSet (Workspace(..)) + +import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..)) + +import Data.Typeable (Typeable) +import Control.Applicative ((<$>)) +import Control.Arrow (second) + +-- $usage +-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Layout.MessageEscape +-- +-- Then, if you use a modified layout where the modifier would intercept +-- a message, but you'd want to be able to send it to the inner layout +-- only, add the 'unEscape' modifier to the inner layout like so: +-- +-- > import XMonad.Layout.Master (mastered) +-- > import XMonad.Layout.Tabbed (simpleTabbed) +-- > import XMonad.Layout.LayoutCombinators ((|||)) +-- > +-- > myLayout = Tall ||| unEscape (mastered 0.01 0.5 $ Full ||| simpleTabbed) +-- +-- you can now send a message to the inner layout with +-- @sendMessage $ escape message@, e.g. +-- +-- > -- Change the inner layout +-- > ((modMask .|. controlMask, xK_space), sendMessage $ escape NextLayout) +-- +-- If you want unescaped messages to be handled /only/ by the enclosing +-- layout, use the 'ignore' modifier: +-- +-- > myLayout = Tall ||| (ignore NextLayout $ ignore (JumpToLayout "") $ +-- > unEscape $ mastered 0.01 0.5 +-- > $ Full ||| simpleTabbed) +-- +-- /IMPORTANT NOTE:/ The standard '(|||)' operator from "XMonad.Layout" +-- does not behave correctly with 'ignore'. Make sure you use the one +-- from "XMonad.Layout.LayoutCombinators". + +-- | the Ignore layout modifier. Prevents its inner layout from receiving +-- messages of a certain type. + +data Ignore m l w = I (l w) + deriving (Show, Read) + +instance (Message m, LayoutClass l w) => LayoutClass (Ignore m l) w where + runLayout ws r = second (I <$>) <$> runLayout (unILayout ws) r + where unILayout :: Workspace i (Ignore m l w) w -> Workspace i (l w) w + unILayout w@(Workspace { layout = (I l) }) = w { layout = l } + handleMessage l@(I l') sm + = case fromMessageAs sm l of + Just _ -> return Nothing + Nothing -> (I <$>) <$> handleMessage l' sm + where fromMessageAs :: Message m' => SomeMessage -> Ignore m' l w -> Maybe m' + fromMessageAs a _ = fromMessage a + description (I l) = "Ignore "++description l + +-- | the UnEscape layout modifier. Listens to 'EscapedMessage's and sends +-- their nested message to the inner layout. + +data UnEscape w = UE + deriving (Show, Read) + +instance LayoutModifier UnEscape a where + handleMessOrMaybeModifyIt _ mess + = return $ case fromMessage mess of + Just (Escape mess') -> Just $ Right mess' + Nothing -> Nothing + + +-- | Data type for an escaped message. Send with 'escape'. + +newtype EscapedMessage = Escape SomeMessage + deriving Typeable + +instance Message EscapedMessage + + +-- | Creates an 'EscapedMessage'. + +escape :: Message m => m -> EscapedMessage +escape = Escape . SomeMessage + + +-- | Applies the UnEscape layout modifier to a layout. + +unEscape :: LayoutClass l w => l w -> ModifiedLayout UnEscape l w +unEscape l = ModifiedLayout UE l + + +-- | Applies the Ignore layout modifier to a layout, blocking +-- all messages of the same type as the one passed as its first argument. + +ignore :: (Message m, LayoutClass l w) + => m -> l w -> (Ignore m l w) +ignore _ l = I l hunk ./xmonad-contrib.cabal 164 + XMonad.Layout.MessageControl hunk ./XMonad/Layout/LayoutCombinators.hs 49 - , JumpToLayout(JumpToLayout) + , JumpToLayout(..) hunk ./XMonad/Layout/LayoutCombinators.hs 216 -data NoWrap = NextLayoutNoWrap | Wrap deriving ( Read, Show, Typeable ) -instance Message NoWrap - --- | A message to jump to a particular layout, specified by its --- description string. -data JumpToLayout = JumpToLayout String deriving ( Read, Show, Typeable ) +-- | +data JumpToLayout = JumpToLayout String -- ^ A message to jump to a particular layout + -- , specified by its description string.. + | NextLayoutNoWrap + | Wrap + deriving ( Read, Show, Typeable ) hunk ./XMonad/Actions/Search.hs 51 + wiktionary, hunk ./XMonad/Actions/Search.hs 279 - images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, + images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, wiktionary, hunk ./XMonad/Actions/Search.hs 300 +wiktionary = searchEngine "wikt" "http://en.wiktionary.org/wiki/Special:Search?go=Go&search=" hunk ./XMonad/Actions/Search.hs 23 - hasPrefix, + isPrefixOf, hunk ./XMonad/Actions/Search.hs 59 +import Data.List (isPrefixOf) hunk ./XMonad/Actions/Search.hs 261 -> searchFunc s | s `hasPrefix` "wiki:" = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s) -> | s `hasPrefix` "http://" = s +> searchFunc s | s `isPrefixOf` "wiki:" = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s) +> | s `isPrefixOf` "http://" = s hunk ./XMonad/Actions/Search.hs 277 - hunk ./XMonad/Actions/Search.hs 308 -multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, (prefixAware google)] +multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, wiktionary, (prefixAware google)] hunk ./XMonad/Actions/Search.hs 320 -{- | Checks if a string starts with a given prefix -} -hasPrefix :: String -> String -> Bool -hasPrefix _ [] = True -hasPrefix [] (_:_) = False -hasPrefix (t:ts) (p:ps) = if t == p then hasPrefix ts ps else False - +-- | > removeColonPrefix "foo://bar" ~> "//bar" +-- > removeColonPrefix "foo//bar" ~> "foo//bar" hunk ./XMonad/Actions/Search.hs 337 -(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if s `hasPrefix` (name1++":") then site1 (removeColonPrefix s) else site2 s) +(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if s `isPrefixOf` (name1++":") then site1 (removeColonPrefix s) else site2 s) hunk ./XMonad/Actions/Search.hs 344 -prefixAware (SearchEngine name site) = SearchEngine name (\s -> if s `hasPrefix` (name++":") then site $ removeColonPrefix s else site s) +prefixAware (SearchEngine name site) = SearchEngine name (\s -> if s `isPrefixOf` (name++":") then site $ removeColonPrefix s else site s) hunk ./XMonad/Actions/Search.hs 323 -removeColonPrefix str = tail $ snd $ break (==':') str +removeColonPrefix s = if ':' `elem` s then drop 1 $ dropWhile (':' /=) s else s hunk ./XMonad/Hooks/UrgencyHook.hs 141 --- @sleep 1; echo -e \'\a\'@. +-- @sleep 1; echo -e \'\\a\'@. hunk ./XMonad/Layout/ThreeColumns.hs 95 - then ( Rectangle (sx + fromIntegral r2w) sy r1w sh - , Rectangle sx sy r2w sh - , Rectangle (sx + fromIntegral r2w + fromIntegral r1w) sy r3w sh ) + then ( Rectangle (sx + fromIntegral r3w) sy r1w sh + , Rectangle (sx + fromIntegral r3w + fromIntegral r1w) sy r2w sh + , Rectangle sx sy r3w sh ) hunk ./XMonad/Util/NamedScratchpad.hs 20 + nonFloating, + defaultFloating, + customFloating, hunk ./XMonad/Util/NamedScratchpad.hs 60 --- > -- run htop in xterm, find it by title, use default geometry --- > NS "htop" "xterm -e htop" (title =? "htop") Nothing , --- > -- run stardict, find it by class name, place the window +-- > -- run htop in xterm, find it by title, use default floating window placement +-- > NS "htop" "xterm -e htop" (title =? "htop") defaultFloating , +-- > +-- > -- run stardict, find it by class name, place it in the floating window hunk ./XMonad/Util/NamedScratchpad.hs 67 --- > (Just $ W.RationalRect (1/6) (1/6) (2/3) (2/3)) --- > ] +-- > (customFloating $ W.RationalRect (1/6) (1/6) (2/3) (2/3)) , +-- > +-- > -- run gvim, find by role, don't float +-- > NS "notes" "gvim --role notes ~/notes.txt" (role =? "notes") nonFloating +-- > ] where role = stringProperty "WM_WINDOW_ROLE" hunk ./XMonad/Util/NamedScratchpad.hs 77 +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_n), namedScratchpadAction scratchpads "notes") hunk ./XMonad/Util/NamedScratchpad.hs 88 -data NamedScratchpad = NS { name :: String -- ^ Scratchpad name - , cmd :: String -- ^ Command used to run application - , query :: Query Bool -- ^ Query to find already running application - , rect :: Maybe W.RationalRect -- ^ Floating window geometry +data NamedScratchpad = NS { name :: String -- ^ Scratchpad name + , cmd :: String -- ^ Command used to run application + , query :: Query Bool -- ^ Query to find already running application + , hook :: ManageHook -- ^ Manage hook called for application window, use it to define the placement. See @nonFloating@, @defaultFloating@ and @customFloating@ hunk ./XMonad/Util/NamedScratchpad.hs 94 +-- | Manage hook that makes the window non-floating +nonFloating :: ManageHook +nonFloating = idHook + +-- | Manage hook that makes the window floating with the default placement +defaultFloating :: ManageHook +defaultFloating = doFloat + +-- | Manage hook that makes the window floating with custom placement +customFloating :: W.RationalRect -> ManageHook +customFloating = doRectFloat + hunk ./XMonad/Util/NamedScratchpad.hs 111 -findByName c s = listToMaybe $ filter ((s==).name) c +findByName c s = listToMaybe $ filter ((s==) . name) c hunk ./XMonad/Util/NamedScratchpad.hs 151 -namedScratchpadManageHook = composeAll . fmap (\c -> query c --> maybe doFloat doRectFloat (rect c)) +namedScratchpadManageHook = composeAll . fmap (\c -> query c --> hook c) hunk ./XMonad/Util/Scratchpad.hs 28 -import XMonad.Hooks.ManageHelpers (doRectFloat) -import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace) - -import Control.Monad (filterM) - hunk ./XMonad/Util/Scratchpad.hs 29 +import XMonad.Util.NamedScratchpad hunk ./XMonad/Util/Scratchpad.hs 37 --- send it to a hidden workspace called @SP@. +-- send it to a hidden workspace called @NSP@. hunk ./XMonad/Util/Scratchpad.hs 39 --- If you already have a workspace called @SP@, it will use that. --- @SP@ will also appear in xmobar and dzen status bars. You can tweak your +-- If you already have a workspace called @NSP@, it will use that. +-- @NSP@ will also appear in xmobar and dzen status bars. You can tweak your hunk ./XMonad/Util/Scratchpad.hs 72 - scratchpadAction $ spawn $ terminal conf ++ " -name scratchpad" + scratchpadSpawnActionCustom $ terminal conf ++ " -name scratchpad" hunk ./XMonad/Util/Scratchpad.hs 79 - scratchpadAction $ spawn $ term ++ " -name scratchpad" + scratchpadSpawnActionCustom $ term ++ " -name scratchpad" hunk ./XMonad/Util/Scratchpad.hs 89 -scratchpadSpawnActionCustom = scratchpadAction . spawn - --- The heart of the new summon/banish terminal. --- The logic is thus: --- 1. if the scratchpad is on the current workspace, send it to the hidden one. --- - if the scratchpad workspace doesn't exist yet, create it first. --- 2. if the scratchpad is elsewhere, bring it here. -scratchpadAction :: X () -> X () -scratchpadAction action = withWindowSet $ \s -> do - filterCurrent <- filterM (runQuery scratchpadQuery) - ( (maybe [] W.integrate - . W.stack - . W.workspace - . W.current) s) - case filterCurrent of - (x:_) -> do - if null (filter ( (== scratchpadWorkspaceTag) . W.tag) (W.workspaces s)) - then addHiddenWorkspace scratchpadWorkspaceTag - else return () - windows (W.shiftWin scratchpadWorkspaceTag x) - [] -> do - filterAll <- filterM (runQuery scratchpadQuery) (W.allWindows s) - case filterAll of - (x:_) -> windows (W.shiftWin (W.currentTag s) x) - [] -> action -- run the provided action to spawn it. - - --- factored out since it appears in several places -scratchpadWorkspaceTag :: String -scratchpadWorkspaceTag = "SP" +scratchpadSpawnActionCustom c = namedScratchpadAction [NS "scratchpad" c scratchpadQuery nonFloating] "scratchpad" hunk ./XMonad/Util/Scratchpad.hs 99 -scratchpadManageHookDefault = scratchpadManageHook scratchpadDefaultRect +scratchpadManageHookDefault = namedScratchpadManageHook [NS "" "" scratchpadQuery (customFloating scratchpadDefaultRect)] hunk ./XMonad/Util/Scratchpad.hs 110 -scratchpadManageHook rect = scratchpadQuery --> doRectFloat rect +scratchpadManageHook rect = namedScratchpadManageHook [NS "" "" scratchpadQuery (customFloating rect)] hunk ./XMonad/Util/Scratchpad.hs 116 -scratchpadFilterOutWorkspace = filter (\(W.Workspace tag _ _) -> tag /= scratchpadWorkspaceTag) +scratchpadFilterOutWorkspace = namedScratchpadFilterOutWorkspace hunk ./XMonad/Hooks/EwmhDesktops.hs 155 - else trace $ "Unknown ClientMessageEvent " ++ show mt + else do + -- The Message is unknown to us, but that is ok, not all are meant + -- to be handled by the wndow manager + return () hunk ./XMonad/Hooks/EwmhDesktops.hs 156 - -- The Message is unknown to us, but that is ok, not all are meant - -- to be handled by the wndow manager - return () + -- The Message is unknown to us, but that is ok, not all are meant + -- to be handled by the window manager + return () hunk ./xmonad-contrib.cabal 53 - ghc-options: -Wall + ghc-options: -fwarn-tabs -Wall hunk ./XMonad/Actions/CycleWS.hs 45 + + -- * Toggling the previous workspace + -- $toggling hunk ./XMonad/Actions/CycleWS.hs 49 + , toggleOrView hunk ./XMonad/Actions/CycleWS.hs 72 + , toggleOrDoSkip + , skipTags hunk ./XMonad/Actions/CycleWS.hs 77 +import Control.Monad ( unless ) hunk ./XMonad/Actions/CycleWS.hs 112 --- > do t <- findWorkspace getXineramaWsCompare Next NonEmptyWS 2 +-- > do t <- findWorkspace getSortByXineramaRule Next NonEmptyWS 2 hunk ./XMonad/Actions/CycleWS.hs 145 +-- $toggling + hunk ./XMonad/Actions/CycleWS.hs 149 -toggleWS = windows $ view =<< tag . head . hidden +toggleWS = do + hs <- gets (hidden . windowset) + unless (null hs) (windows . view . tag $ head hs) + +-- | 'XMonad.StackSet.greedyView' a workspace, or if already there, view +-- the previously displayed workspace ala weechat. Change @greedyView@ to +-- @toggleOrView@ in your workspace bindings as in the 'XMonad.StackSet.view' +-- faq at . +-- For more flexibility see 'toggleOrDoSkip'. +toggleOrView :: WorkspaceId -> X () +toggleOrView = toggleOrDoSkip [] greedyView + +-- | Allows ignoring listed workspace tags (such as scratchpad's \"NSP\") while +-- finding the previously displayed workspace, or choice of different actions, +-- like view, shift, etc. For example: +-- +-- > import qualified XMonad.StackSet as W +-- > import XMonad.Actions.CycleWS +-- > +-- > -- toggleOrView for people who prefer view to greedyView +-- > toggleOrView' = toggleOrDoSkip [] W.view +-- > +-- > -- toggleOrView ignoring scratchpad and named scratchpad workspace +-- > toggleOrViewNoSP = toggleOrDoSkip ["NSP"] W.greedyView +toggleOrDoSkip :: [WorkspaceId] -> (WorkspaceId -> WindowSet -> WindowSet) + -> WorkspaceId -> X () +toggleOrDoSkip skips f toWS = do + ws <- gets windowset + let hs' = hidden ws `skipTags` skips + if toWS == (tag . workspace $ current ws) + then unless (null hs') (windows . f . tag $ head hs') + else windows (f toWS) + +-- | List difference ('\\') for workspaces and tags. Removes workspaces +-- matching listed tags from the given workspace list. +skipTags :: (Eq i) => [Workspace i l a] -> [i] -> [Workspace i l a] +skipTags wss ids = filter ((`notElem` ids) . tag) wss hunk ./XMonad/Actions/CycleWS.hs 277 - ws' = filter wsPred $ pivoted + ws' = filter wsPred pivoted hunk ./XMonad/Util/Scratchpad.hs 83 --- its resource to \"scratchpad\". For example, with gnome-terminal --- bind the following to a key: +-- its resource to \"scratchpad\". For example, with gnome-terminal: hunk ./XMonad/Util/Scratchpad.hs 85 --- > scratchpadSpawnActionCustom "gnome-terminal --name scratchpad" +-- > scratchpadSpawnActionCustom "gnome-terminal --disable-factory --name scratchpad" hunk ./XMonad/Hooks/FadeInactive.hs 22 + fadeIf, hunk ./XMonad/Hooks/FadeInactive.hs 39 --- > where fadeAmount = 0xdddddddd +-- > where fadeAmount = 0.8 hunk ./XMonad/Hooks/FadeInactive.hs 43 --- fadeAmount can be any integer +-- fadeAmount can be any rational between 0 and 1. hunk ./XMonad/Hooks/FadeInactive.hs 55 --- | --- sets the opacity of a window -setOpacity :: Window -> Integer -> X () +-- | Converts a percentage to the format required for _NET_WM_WINDOW_OPACITY +rationalToOpacity :: Integral a => Rational -> a +rationalToOpacity perc + | perc < 0 || perc > 1 = 0xffffffff -- invalid input, default to opaque + | otherwise = round $ perc * 0xffffffff + +-- | sets the opacity of a window +setOpacity :: Window -> Rational -> X () hunk ./XMonad/Hooks/FadeInactive.hs 66 - io $ changeProperty32 dpy w a c propModeReplace [fromIntegral t] + io $ changeProperty32 dpy w a c propModeReplace [rationalToOpacity t] hunk ./XMonad/Hooks/FadeInactive.hs 68 --- | --- fades a window out by setting the opacity -fadeOut :: Integer -> Window -> X () -fadeOut amt = flip setOpacity amt +-- | fades a window out by setting the opacity +fadeOut :: Rational -> Window -> X () +fadeOut = flip setOpacity hunk ./XMonad/Hooks/FadeInactive.hs 72 --- | --- makes a window completely opaque +-- | makes a window completely opaque hunk ./XMonad/Hooks/FadeInactive.hs 74 -fadeIn = flip setOpacity 0xffffffff +fadeIn = fadeOut 1 + +-- | Fades a window by the specified amount if it satisfies the first query, otherwise +-- makes it opaque. +fadeIf :: Query Bool -> Rational -> Query Rational +fadeIf qry amt = qry >>= \b -> return $ if b then amt else 1 hunk ./XMonad/Hooks/FadeInactive.hs 81 --- | --- lowers the opacity of inactive windows to the specified amount -fadeInactiveLogHook :: Integer -> X () -fadeInactiveLogHook amt = fadeOutLogHook isUnfocused amt +-- | sets the opacity of inactive windows to the specified amount +fadeInactiveLogHook :: Rational -> X () +fadeInactiveLogHook = fadeOutLogHook . fadeIf isUnfocused hunk ./XMonad/Hooks/FadeInactive.hs 86 -isUnfocused :: Window -> X Bool -isUnfocused w = withWindowSet $ \s -> return $ - case W.stack . W.workspace . W.current $ s of - Nothing -> False - Just stack -> W.focus stack /= w +isUnfocused :: Query Bool +isUnfocused = ask >>= \w -> liftX . gets $ maybe False (w /=) . W.peek . windowset hunk ./XMonad/Hooks/FadeInactive.hs 89 --- | fades out every window that satisfies a given property. -fadeOutLogHook :: (Window -> X Bool) -> Integer -> X () -fadeOutLogHook p amt = withWindowSet $ \s -> do +-- | fades out every window by the amount returned by the query. +fadeOutLogHook :: Query Rational -> X () +fadeOutLogHook qry = withWindowSet $ \s -> do hunk ./XMonad/Hooks/FadeInactive.hs 94 - mapM_ fadeIn =<< filterM (fmap not . p) visibleWins - mapM_ (fadeOut amt) =<< filterM p visibleWins + forM_ visibleWins $ liftM2 (=<<) setOpacity (runQuery qry) hunk ./XMonad/Layout/Monitor.hs 66 --- > , opacity = 0xAAAAAAAA +-- > , opacity = 0.6 hunk ./XMonad/Layout/Monitor.hs 92 - { prop :: Property -- ^ property which uniquely identifies monitor window - , rect :: Rectangle -- ^ specifies where to put monitor - , visible :: Bool -- ^ is it visible by default? - , name :: String -- ^ name of monitor (useful when we have many of them) - , persistent :: Bool -- ^ is it shown on all layouts? - , opacity :: Integer -- ^ opacity level + { prop :: Property -- ^ property which uniquely identifies monitor window + , rect :: Rectangle -- ^ specifies where to put monitor + , visible :: Bool -- ^ is it visible by default? + , name :: String -- ^ name of monitor (useful when we have many of them) + , persistent :: Bool -- ^ is it shown on all layouts? + , opacity :: Rational -- ^ opacity level hunk ./XMonad/Layout/Monitor.hs 109 - , opacity = 0xFFFFFFFF + , opacity = 1 hunk ./XMonad/Hooks/FadeInactive.hs 58 - | perc < 0 || perc > 1 = 0xffffffff -- invalid input, default to opaque + | perc < 0 || perc > 1 = round perc -- to maintain backwards-compatability hunk ./XMonad/Hooks/DynamicLog.hs 479 + , ppUrgent = xmobarColor "red" "yellow" hunk ./XMonad/Actions/GridSelect.hs 182 - nextEvent d e + maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e hunk ./XMonad/Actions/TagWindows.hs 47 --- > , ((modMask x .|. shiftMask, xK_f ), withTaggedGlobal "abc" sink) --- > , ((modMask x, xK_d ), withTaggedP "abc" (shiftWin "2")) +-- > , ((modMask x .|. shiftMask, xK_f ), withTaggedGlobalP "abc" W.sink) +-- > , ((modMask x, xK_d ), withTaggedP "abc" (W.shiftWin "2")) hunk ./XMonad/Actions/TagWindows.hs 54 --- > , ((modWinMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedP s (shiftWin "2"))) +-- > , ((modWinMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedP s (W.shiftWin "2"))) hunk ./XMonad/Config/Arossato.hs 27 +import XMonad.Actions.Commands hunk ./XMonad/Config/Arossato.hs 102 - , handleEventHook = serverModeEventHook + , handleEventHook = serverModeEventHook defaultCommands hunk ./XMonad/Hooks/ServerMode.hs 78 +-- > import XMonad.Actions.Commands hunk ./XMonad/Hooks/ServerMode.hs 82 --- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook } +-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook defaultCommands } hunk ./XMonad/Hooks/ServerMode.hs 87 -serverModeEventHook :: Event -> X All -serverModeEventHook (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do +-- | Executes a command of the list when receiving its index via a special ClientMessageEvent +-- (indexing starts at 1) +serverModeEventHook :: X [(String,X ())] -> Event -> X All +serverModeEventHook cmdAction (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do hunk ./XMonad/Hooks/ServerMode.hs 94 - cl <- defaultCommands + cl <- cmdAction hunk ./XMonad/Hooks/ServerMode.hs 100 -serverModeEventHook _ = return (All True) +serverModeEventHook _ _ = return (All True) hunk ./XMonad/Config/Arossato.hs 27 -import XMonad.Actions.Commands hunk ./XMonad/Config/Arossato.hs 101 - , handleEventHook = serverModeEventHook defaultCommands + , handleEventHook = serverModeEventHook hunk ./XMonad/Hooks/ServerMode.hs 63 + , serverModeEventHook' hunk ./XMonad/Hooks/ServerMode.hs 83 --- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook defaultCommands } +-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook } hunk ./XMonad/Hooks/ServerMode.hs 90 -serverModeEventHook :: X [(String,X ())] -> Event -> X All -serverModeEventHook cmdAction (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do +serverModeEventHook :: Event -> X All +serverModeEventHook = serverModeEventHook' defaultCommands + +-- | serverModeEventHook' additionally takes an action to generate the list of +-- commands. +serverModeEventHook' :: X [(String,X ())] -> Event -> X All +serverModeEventHook' cmdAction (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do hunk ./XMonad/Hooks/ServerMode.hs 106 -serverModeEventHook _ _ = return (All True) +serverModeEventHook' _ _ = return (All True) hunk ./XMonad/Hooks/ServerMode.hs 103 - Just (c,_) -> runCommand' c - Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl + Just (_,action) -> action + Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl hunk ./XMonad/Hooks/FadeInactive.hs 87 -isUnfocused = ask >>= \w -> liftX . gets $ maybe False (w /=) . W.peek . windowset +isUnfocused = ask >>= \w -> liftX . gets $ maybe True (w /=) . W.peek . windowset hunk ./XMonad/Config/Sjanssen.hs 13 +import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat) hunk ./XMonad/Config/Sjanssen.hs 23 -sjanssenConfigXmobar = statusBar "xmobar" sjanssenPP strutkey =<< sjanssenConfig +sjanssenConfigXmobar = statusBar "exec xmobar" sjanssenPP strutkey =<< sjanssenConfig hunk ./XMonad/Config/Sjanssen.hs 30 - { terminal = "urxvtc" + { terminal = "exec urxvt" hunk ./XMonad/Config/Sjanssen.hs 44 + <+> (isFullscreen --> doFullFloat) hunk ./XMonad/Config/Sjanssen.hs 51 - mykeys sp (XConfig {modMask = modm, workspaces = ws}) = M.fromList $ + mykeys sp (XConfig {modMask = modm}) = M.fromList $ hunk ./XMonad/Config/Sjanssen.hs 53 + ,((modm .|. shiftMask, xK_Return), spawnHere sp =<< asks (terminal . config)) hunk ./XMonad/Config/Sjanssen.hs 56 - ,((modm .|. shiftMask, xK_0 ), windows $ \w -> foldr copy w ws) + ,((modm .|. shiftMask, xK_0 ), windows $ copyToAll) hunk ./XMonad/Actions/ConstrainedResize.hs 8 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Actions/DeManage.hs 8 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Actions/DwmPromote.hs 8 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Actions/FindEmptyWorkspace.hs 8 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Actions/FlexibleManipulate.hs 10 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Actions/FloatKeys.hs 8 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Actions/FocusNth.hs 8 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Actions/NoBorders.hs 8 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Actions/RotSlaves.hs 8 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Actions/WindowBringer.hs 8 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Layout/Accordion.hs 10 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Prompt/AppendFile.hs 8 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Prompt/Email.hs 8 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Prompt/Input.hs 8 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Util/Dzen.hs 8 --- Stability : unstable +-- Stability : stable hunk ./XMonad/Actions/Commands.hs 85 - sr = broadcastMessage ReleaseResources hunk ./XMonad/Actions/Commands.hs 90 - , ("restart-wm" , sr >> restart "xmonad" True ) - , ("restart-wm-no-resume", sr >> restart "xmonad" False ) + , ("restart-wm" , restart "xmonad" True ) + , ("restart-wm-no-resume", restart "xmonad" False ) hunk ./XMonad/Config/Gnome.hs 18 - gnomeRun + gnomeRun, + gnomeRegister hunk ./XMonad/Config/Gnome.hs 27 +import System.Environment (getEnvironment) +import System.Cmd (rawSystem) + +import Control.Concurrent (forkIO) + hunk ./XMonad/Config/Gnome.hs 38 --- > main = xmonad gnomeConfig --- +-- > main = do +-- > gnomeRegister +-- > xmonad gnomeConfig hunk ./XMonad/Config/Gnome.hs 63 + +-- | Register xmonad with gnome. 'dbus-send' must be in the $PATH with which +-- xmonad is started. +-- +-- This action reduces a delay on startup only only if you have configured +-- gnome-session>=2.26: to start xmonad with a command as such: +-- +-- > gconftool-2 -s /desktop/gnome/session/required_components/windowmanager xmonad --type string +gnomeRegister :: IO () +gnomeRegister = do + let void_ = fmap (const ()) + x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment + whenJust x $ \sessionId -> void_ $ forkIO $ void_ $ + rawSystem "dbus-send" + ["--session" + ,"--print-reply=string" + ,"--dest=org.gnome.SessionManager" + ,"/org/gnome/SessionManager" + ,"org.gnome.SessionManager.RegisterClient" + ,"string:xmonad" + ,"string:"++sessionId] hunk ./XMonad/Config/Gnome.hs 24 +import XMonad.Util.Run (safeSpawn) hunk ./XMonad/Config/Gnome.hs 29 -import System.Cmd (rawSystem) - -import Control.Concurrent (forkIO) hunk ./XMonad/Config/Gnome.hs 71 - let void_ = fmap (const ()) hunk ./XMonad/Config/Gnome.hs 72 - whenJust x $ \sessionId -> void_ $ forkIO $ void_ $ - rawSystem "dbus-send" + whenJust x $ \sessionId -> safeSpawn "dbus-send" hunk ./XMonad/Config/Gnome.hs 36 --- > main = do --- > gnomeRegister --- > xmonad gnomeConfig +-- > main = xmonad gnomeConfig hunk ./XMonad/Config/Gnome.hs 40 - , keys = \c -> gnomeKeys c `M.union` keys desktopConfig c } + , keys = \c -> gnomeKeys c `M.union` keys desktopConfig c + , startupHook = gnomeRegister } hunk ./XMonad/Config/Gnome.hs 68 -gnomeRegister :: IO () -gnomeRegister = do +gnomeRegister :: MonadIO m => m () +gnomeRegister = io $ do hunk ./XMonad/Prompt.hs 28 + , XP + , defaultXPKeymap + , completion + , quit + , killBefore, killAfter, startOfLine, endOfLine + , pasteString, copyString + , moveWord, killWord, deleteString + , moveHistory, setSuccess, setDone + , Direction (..) hunk ./XMonad/Prompt.hs 70 -import Control.Arrow ((&&&)) +import Control.Arrow ((&&&),first) hunk ./XMonad/Prompt.hs 85 -import qualified Data.Map as Map -import Data.Map (Map) +import qualified Data.Map as M hunk ./XMonad/Prompt.hs 113 + , done :: Bool hunk ./XMonad/Prompt.hs 130 + , promptKeymap :: M.Map (KeyMask,KeySym) (XP ()) + -- ^ Mapping from key combinations to actions hunk ./XMonad/Prompt.hs 192 + hunk ./XMonad/Prompt.hs 201 + , promptKeymap = defaultXPKeymap hunk ./XMonad/Prompt.hs 234 + , done = False hunk ./XMonad/Prompt.hs 262 - let hs = fromMaybe [] $ Map.lookup (showXPrompt t) hist + let hs = fromMaybe [] $ M.lookup (showXPrompt t) hist hunk ./XMonad/Prompt.hs 270 - liftIO $ writeHistory $ Map.insertWith + liftIO $ writeHistory $ M.insertWith hunk ./XMonad/Prompt.hs 318 + gets done >>= flip unless (eventLoop action) hunk ./XMonad/Prompt.hs 322 -handle k@(ks,_) e@(KeyEvent {ev_event_type = t}) - | t == keyPress && ks == xK_Tab = do - c <- getCompletions - if length c > 1 then modify $ \s -> s { showComplWin = True } else return () - completionHandle c k e hunk ./XMonad/Prompt.hs 327 - eventLoop handle -handle _ _ = eventLoop handle +handle _ _ = return () hunk ./XMonad/Prompt.hs 329 --- completion event handler -completionHandle :: [String] -> KeyStroke -> Event -> XP () -completionHandle c (ks,_) (KeyEvent {ev_event_type = t}) - | t == keyPress && ks == xK_Tab = do +completion :: XP () +completion = do + c <- getCompletions + when (length c > 1) $ modify (\s -> s { showComplWin = True }) hunk ./XMonad/Prompt.hs 342 + + +-- completion event handler +completionHandle :: [String] -> KeyStroke -> Event -> XP () +completionHandle c (ks,_) (KeyEvent {ev_event_type = t}) + | t == keyPress && ks == xK_Tab = completion hunk ./XMonad/Prompt.hs 356 + hunk ./XMonad/Prompt.hs 379 +defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) +defaultXPKeymap = M.fromList $ + map (first $ (,) controlMask) -- control + + [ (xK_u, killBefore) + , (xK_k, killAfter) + , (xK_a, startOfLine) + , (xK_e, endOfLine) + , (xK_y, pasteString) + , (xK_c, copyString) + , (xK_Right, moveWord Next) + , (xK_Left, moveWord Prev) + , (xK_Delete, killWord Next) + , (xK_BackSpace, killWord Prev) + , (xK_w, killWord Prev) + , (xK_q, quit) + ] ++ + map (first $ (,) 0) + [ (xK_Return, setSuccess True >> setDone True) + , (xK_KP_Enter, setSuccess True >> setDone True) + , (xK_BackSpace, deleteString Prev) + , (xK_Delete, deleteString Next) + , (xK_Left, moveCursor Prev) + , (xK_Right, moveCursor Next) + , (xK_Home, startOfLine) + , (xK_End, endOfLine) + , (xK_Down, moveHistory W.focusUp') + , (xK_Up, moveHistory W.focusDown') + , (xK_Tab, completion) + , (xK_Escape, quit) + ] + hunk ./XMonad/Prompt.hs 411 --- commands: ctrl + ... todo -keyPressHandle mask (ks,_) - | (mask .&. controlMask) > 0 = - -- control sequences - case () of - _ | ks == xK_u -> killBefore >> go - | ks == xK_k -> killAfter >> go - | ks == xK_a -> startOfLine >> go - | ks == xK_e -> endOfLine >> go - | ks == xK_y -> pasteString >> go - | ks == xK_c -> copyString >> 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_w -> killWord Prev >> go - | ks == xK_g || ks == xK_c -> quit - | otherwise -> eventLoop handle -- unhandled control sequence - | ks == xK_Return || ks == xK_KP_Enter = setSuccess True - | ks == xK_BackSpace = deleteString Prev >> go - | ks == xK_Delete = deleteString Next >> go - | ks == xK_Left = moveCursor Prev >> go - | ks == xK_Right = moveCursor Next >> go - | ks == xK_Home = startOfLine >> go - | ks == xK_End = endOfLine >> go - | ks == xK_Down = moveHistory W.focusUp' >> go - | ks == xK_Up = moveHistory W.focusDown' >> go - | ks == xK_Escape = quit - where - go = updateWindows >> eventLoop handle - quit = flushString >> setSuccess False -- quit and discard everything --- insert a character -keyPressHandle _ (_,s) - | s == "" = eventLoop handle - | otherwise = do insertString (decodeInput s) - updateWindows - completed <- tryAutoComplete - if completed then setSuccess True else eventLoop handle +keyPressHandle mask (ks,str) = do + km <- gets (promptKeymap . config) + case M.lookup (mask,ks) km of + Just action -> action >> updateWindows + Nothing -> case str of + "" -> eventLoop handle + _ -> when (mask .&. controlMask == 0) $ do + insertString (decodeInput str) + updateWindows + completed <- tryAutoComplete + when completed $ setSuccess True >> setDone True hunk ./XMonad/Prompt.hs 426 +setDone :: Bool -> XP () +setDone b = modify $ \s -> s { done = b } + hunk ./XMonad/Prompt.hs 431 +-- | Quit. +quit :: XP () +quit = flushString >> setSuccess False >> setDone True + hunk ./XMonad/Prompt.hs 734 -type History = Map String [String] +type History = M.Map String [String] hunk ./XMonad/Prompt.hs 737 -emptyHistory = Map.empty +emptyHistory = M.empty hunk ./XMonad/Prompt.hs 854 -historyCompletion x = fmap (deleteConsecutive . filter (isInfixOf x) . Map.fold (++) []) readHistory +historyCompletion x = fmap (deleteConsecutive . filter (isInfixOf x) . M.fold (++) []) readHistory hunk ./XMonad/Layout/MagicFocus.hs 21 - promoteWarp' + promoteWarp', + followOnlyIf, + disableFollowOnWS hunk ./XMonad/Layout/MagicFocus.hs 94 + +-- | Another event hook to override the focusFollowsMouse and make the pointer +-- only follow if a given condition is satisfied. This could be used to disable +-- focusFollowsMouse only for given workspaces or layouts. +-- Beware that your focusFollowsMouse setting is ignored if you use this event hook. +followOnlyIf :: X Bool -> Event -> X All +followOnlyIf cond e@(CrossingEvent {ev_window = w, ev_event_type = t}) + | t == enterNotify && ev_mode e == notifyNormal + = whenX cond (focus w) >> return (All False) +followOnlyIf _ _ = return $ All True + +-- | Disables focusFollow on the given workspaces: +disableFollowOnWS :: [WorkspaceId] -> X Bool +disableFollowOnWS wses = (`notElem` wses) `fmap` gets (W.currentTag . windowset) hunk ./XMonad/Actions/CycleWS.hs 63 - , WSDirection(..) + , Direction1D(..) hunk ./XMonad/Actions/CycleWS.hs 83 +import XMonad.Util.Types hunk ./XMonad/Actions/CycleWS.hs 215 --- | Direction to cycle through the sort order. -data WSDirection = Next | Prev - hunk ./XMonad/Actions/CycleWS.hs 239 -moveTo :: WSDirection -> WSType -> X () +moveTo :: Direction1D -> WSType -> X () hunk ./XMonad/Actions/CycleWS.hs 244 -shiftTo :: WSDirection -> WSType -> X () +shiftTo :: Direction1D -> WSType -> X () hunk ./XMonad/Actions/CycleWS.hs 260 -findWorkspace :: X WorkspaceSort -> WSDirection -> WSType -> Int -> X WorkspaceId +findWorkspace :: X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceId hunk ./XMonad/Actions/FloatSnap.hs 18 - Direction(..), + Direction2D(..), hunk ./XMonad/Actions/FloatSnap.hs 32 -import XMonad.Hooks.ManageDocks (Direction(..),calcGap) +import XMonad.Hooks.ManageDocks (calcGap) +import XMonad.Util.Types (Direction2D(..)) hunk ./XMonad/Actions/FloatSnap.hs 106 - :: [Direction] -- ^ The edges to snap. + :: [Direction2D] -- ^ The edges to snap. hunk ./XMonad/Actions/FloatSnap.hs 192 - :: Direction -- ^ What direction to move the window in. + :: Direction2D -- ^ What direction to move the window in. hunk ./XMonad/Actions/FloatSnap.hs 227 - :: Direction -- ^ What edge of the window to grow. + :: Direction2D -- ^ What edge of the window to grow. hunk ./XMonad/Actions/FloatSnap.hs 235 - :: Direction -- ^ What edge of the window to shrink. + :: Direction2D -- ^ What edge of the window to shrink. hunk ./XMonad/Actions/FloatSnap.hs 241 -snapResize :: Bool -> Direction -> Maybe Int -> Window -> X () +snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X () hunk ./XMonad/Actions/MouseGestures.hs 18 - Direction(..), + Direction2D(..), hunk ./XMonad/Actions/MouseGestures.hs 25 -import XMonad.Hooks.ManageDocks (Direction(..)) +import XMonad.Util.Types (Direction2D(..)) hunk ./XMonad/Actions/MouseGestures.hs 67 -dir :: Pos -> Pos -> Direction +dir :: Pos -> Pos -> Direction2D hunk ./XMonad/Actions/MouseGestures.hs 70 - trans :: Double -> Direction + trans :: Double -> Direction2D hunk ./XMonad/Actions/MouseGestures.hs 78 -gauge :: (Direction -> X ()) -> Pos -> IORef (Maybe (Direction, Pos)) -> Position -> Position -> X () +gauge :: (Direction2D -> X ()) -> Pos -> IORef (Maybe (Direction2D, Pos)) -> Position -> Position -> X () hunk ./XMonad/Actions/MouseGestures.hs 99 -mouseGestureH :: (Direction -> X ()) -> X () -> X () +mouseGestureH :: (Direction2D -> X ()) -> X () -> X () hunk ./XMonad/Actions/MouseGestures.hs 111 -mouseGesture :: Map [Direction] (Window -> X ()) -> Window -> X () +mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X () hunk ./XMonad/Actions/MouseGestures.hs 124 -mkCollect :: (MonadIO m, MonadIO m') => m (Direction -> m' [Direction], m' [Direction]) +mkCollect :: (MonadIO m, MonadIO m') => m (Direction2D -> m' [Direction2D], m' [Direction2D]) hunk ./XMonad/Actions/SwapWorkspaces.hs 22 - WSDirection(..) + Direction1D(..) hunk ./XMonad/Actions/SwapWorkspaces.hs 28 +import XMonad.Util.Types hunk ./XMonad/Actions/SwapWorkspaces.hs 56 -swapTo :: WSDirection -> X () +swapTo :: Direction1D -> X () hunk ./XMonad/Actions/WindowNavigation.hs 37 - Direction(..) + Direction2D(..) hunk ./XMonad/Actions/WindowNavigation.hs 41 -import XMonad.Hooks.ManageDocks (Direction(..)) +import XMonad.Util.Types (Direction2D(..)) hunk ./XMonad/Actions/WindowNavigation.hs 107 -data WNAction = WNGo Direction | WNSwap Direction +data WNAction = WNGo Direction2D | WNSwap Direction2D hunk ./XMonad/Actions/WindowNavigation.hs 116 -go :: IORef WNState -> Direction -> X () +go :: IORef WNState -> Direction2D -> X () hunk ./XMonad/Actions/WindowNavigation.hs 119 -swap :: IORef WNState -> Direction -> X () +swap :: IORef WNState -> Direction2D -> X () hunk ./XMonad/Actions/WindowNavigation.hs 131 -withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction -> X () +withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X () hunk ./XMonad/Actions/WindowNavigation.hs 178 -navigableTargets :: Point -> Direction -> X [(Window, Rectangle)] +navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)] hunk ./XMonad/Actions/WindowNavigation.hs 182 --- the Direction. -navigable :: Direction -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] +-- the Direction2D. +navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] hunk ./XMonad/Actions/WindowNavigation.hs 200 -inr :: Direction -> Point -> Rectangle -> Bool +inr :: Direction2D -> Point -> Rectangle -> Bool hunk ./XMonad/Actions/WindowNavigation.hs 210 -sortby :: Direction -> [(a,Rectangle)] -> [(a,Rectangle)] +sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)] hunk ./XMonad/Config/Droundy.hs 25 -import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction(U,D,R,L), +import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction2D(U,D,R,L), hunk ./XMonad/Config/Droundy.hs 43 - WSDirection( Prev, Next) ) + Direction1D( Prev, Next) ) hunk ./XMonad/Hooks/ManageDocks.hs 21 - ToggleStruts(..), Direction(..), + ToggleStruts(..), + module XMonad.Util.Types, hunk ./XMonad/Hooks/ManageDocks.hs 34 +import XMonad.Util.Types hunk ./XMonad/Hooks/ManageDocks.hs 88 --- | An enumeration of the four cardinal directions\/sides of the --- screen. --- --- Ideally this would go in its own separate module in Util, --- but ManageDocks is angling for inclusion into the xmonad core, --- so keep the dependencies to a minimum. -data Direction = U -- ^ Up\/top - | D -- ^ Down\/bottom - | R -- ^ Right - | L -- ^ Left - deriving ( Read, Show, Eq, Ord, Enum, Bounded ) - hunk ./XMonad/Hooks/ManageDocks.hs 122 -calcGap :: [Direction] -> X (Rectangle -> Rectangle) +calcGap :: [Direction2D] -> X (Rectangle -> Rectangle) hunk ./XMonad/Hooks/ManageDocks.hs 146 - [Direction] + [Direction2D] hunk ./XMonad/Hooks/ManageDocks.hs 151 -data AvoidStruts a = AvoidStruts [Direction] deriving ( Read, Show ) +data AvoidStruts a = AvoidStruts [Direction2D] deriving ( Read, Show ) hunk ./XMonad/Hooks/ManageDocks.hs 156 - | ToggleStrut Direction + | ToggleStrut Direction2D hunk ./XMonad/Hooks/ManageDocks.hs 178 -type Strut = (Direction, CLong, CLong, CLong) +type Strut = (Direction2D, CLong, CLong, CLong) hunk ./XMonad/Layout/Gaps.hs 31 - Direction(..), + Direction2D(..), hunk ./XMonad/Layout/Gaps.hs 39 -import XMonad.Hooks.ManageDocks (Direction(..)) hunk ./XMonad/Layout/Gaps.hs 40 +import XMonad.Util.Types (Direction2D(..)) hunk ./XMonad/Layout/Gaps.hs 82 -type GapSpec = [(Direction,Int)] +type GapSpec = [(Direction2D,Int)] hunk ./XMonad/Layout/Gaps.hs 87 -data Gaps a = Gaps GapSpec [Direction] +data Gaps a = Gaps GapSpec [Direction2D] hunk ./XMonad/Layout/Gaps.hs 92 - | ToggleGap !Direction -- ^ Toggle a single gap. - | IncGap !Int !Direction -- ^ Increase a gap by a certain number of pixels. - | DecGap !Int !Direction -- ^ Decrease a gap. + | ToggleGap !Direction2D -- ^ Toggle a single gap. + | IncGap !Int !Direction2D -- ^ Increase a gap by a certain number of pixels. + | DecGap !Int !Direction2D -- ^ Decrease a gap. hunk ./XMonad/Layout/Gaps.hs 124 -toggleGaps :: GapSpec -> [Direction] -> [Direction] +toggleGaps :: GapSpec -> [Direction2D] -> [Direction2D] hunk ./XMonad/Layout/Gaps.hs 128 -toggleGap :: GapSpec -> [Direction] -> Direction -> [Direction] +toggleGap :: GapSpec -> [Direction2D] -> Direction2D -> [Direction2D] hunk ./XMonad/Layout/Gaps.hs 133 -incGap :: GapSpec -> Direction -> Int -> GapSpec +incGap :: GapSpec -> Direction2D -> Int -> GapSpec hunk ./XMonad/Layout/LayoutHints.hs 29 -import XMonad.Hooks.ManageDocks(Direction(..)) hunk ./XMonad/Layout/LayoutHints.hs 32 +import XMonad.Util.Types(Direction2D(..)) hunk ./XMonad/Layout/LayoutHints.hs 154 -growOther :: (Position, Position) -> Rectangle -> Set Direction -> Rectangle -> Rectangle +growOther :: (Position, Position) -> Rectangle -> Set Direction2D -> Rectangle -> Rectangle hunk ./XMonad/Layout/LayoutHints.hs 164 - flipDir :: Direction -> Direction + flipDir :: Direction2D -> Direction2D hunk ./XMonad/Layout/LayoutHints.hs 167 - opposite :: Direction -> Direction -> Bool + opposite :: Direction2D -> Direction2D -> Bool hunk ./XMonad/Layout/LayoutHints.hs 171 -grow :: Direction -> (Position,Position) -> Rectangle -> Rectangle +grow :: Direction2D -> (Position,Position) -> Rectangle -> Rectangle hunk ./XMonad/Layout/LayoutHints.hs 177 -comparingEdges :: ([Position] -> [Position] -> Bool) -> Rectangle -> Rectangle -> Set Direction +comparingEdges :: ([Position] -> [Position] -> Bool) -> Rectangle -> Rectangle -> Set Direction2D hunk ./XMonad/Layout/LayoutHints.hs 193 -adjacent :: Rectangle -> Rectangle -> Set Direction +adjacent :: Rectangle -> Rectangle -> Set Direction2D hunk ./XMonad/Layout/LayoutHints.hs 222 -freeDirs :: Rectangle -> Rectangle -> Set Direction +freeDirs :: Rectangle -> Rectangle -> Set Direction2D hunk ./XMonad/Layout/SubLayouts.hs 43 -import XMonad.Layout.WindowNavigation(Direction, Navigate(Apply)) +import XMonad.Layout.WindowNavigation(Navigate(Apply)) hunk ./XMonad/Layout/SubLayouts.hs 45 +import XMonad.Util.Types(Direction2D(..)) hunk ./XMonad/Layout/SubLayouts.hs 265 -pullGroup,pushGroup,pullWindow,pushWindow :: Direction -> Navigate +pullGroup,pushGroup,pullWindow,pushWindow :: Direction2D -> Navigate hunk ./XMonad/Layout/SubLayouts.hs 271 -mergeNav :: (Window -> Window -> X ()) -> Direction -> Navigate +mergeNav :: (Window -> Window -> X ()) -> Direction2D -> Navigate hunk ./XMonad/Layout/WindowNavigation.hs 21 - Navigate(..), Direction(..), + Navigate(..), Direction2D(..), hunk ./XMonad/Layout/WindowNavigation.hs 32 +import XMonad.Util.Types (Direction2D(..)) hunk ./XMonad/Layout/WindowNavigation.hs 35 -import XMonad.Hooks.ManageDocks (Direction(..)) - hunk ./XMonad/Layout/WindowNavigation.hs 69 -data Navigate = Go Direction | Swap Direction | Move Direction - | Apply (Window -> X()) Direction -- ^ Apply action with destination window +data Navigate = Go Direction2D | Swap Direction2D | Move Direction2D + | Apply (Window -> X()) Direction2D -- ^ Apply action with destination window hunk ./XMonad/Layout/WindowNavigation.hs 190 -navigable :: Direction -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] +navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] hunk ./XMonad/Layout/WindowNavigation.hs 199 -centerd :: Direction -> Point -> Rectangle -> Point +centerd :: Direction2D -> Point -> Rectangle -> Point hunk ./XMonad/Layout/WindowNavigation.hs 203 -inr :: Direction -> Point -> Rectangle -> Bool +inr :: Direction2D -> Point -> Rectangle -> Bool hunk ./XMonad/Layout/WindowNavigation.hs 217 -sortby :: Direction -> [(a,Rectangle)] -> [(a,Rectangle)] +sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)] hunk ./XMonad/Prompt.hs 36 - , Direction (..) + , Direction1D(..) hunk ./XMonad/Prompt.hs 68 +import XMonad.Util.Types hunk ./XMonad/Prompt.hs 378 -data Direction = Prev | Next deriving (Eq,Show,Read) - hunk ./XMonad/Prompt.hs 445 -killWord :: Direction -> XP () +killWord :: Direction1D -> XP () hunk ./XMonad/Prompt.hs 494 -deleteString :: Direction -> XP () +deleteString :: Direction1D -> XP () hunk ./XMonad/Prompt.hs 506 -moveCursor :: Direction -> XP () +moveCursor :: Direction1D -> XP () hunk ./XMonad/Prompt.hs 512 -moveWord :: Direction -> XP () +moveWord :: Direction1D -> XP () addfile ./XMonad/Util/Types.hs hunk ./XMonad/Util/Types.hs 1 +{-# LANGUAGE DeriveDataTypeable #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Types +-- Copyright : (c) Daniel Schoepe (2009) +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Daniel Schoepe +-- Stability : unstable +-- Portability : unportable +-- +-- Miscellaneous commonly used types. +-- +----------------------------------------------------------------------------- + +module XMonad.Util.Types (Direction1D(..) + ,Direction2D(..) + ) where + +import Data.Typeable (Typeable) + +-- | One-dimensional directions: +data Direction1D = Next | Prev deriving (Eq,Read,Show,Typeable) + +-- | Two-dimensional directions: +data Direction2D = U -- ^ Up + | D -- ^ Down + | R -- ^ Right + | L -- ^ Left + deriving (Eq,Read,Show,Ord,Bounded,Typeable) hunk ./xmonad-contrib.cabal 227 + XMonad.Util.Types hunk ./XMonad/Util/EZConfig.hs 39 -import Data.List (foldl', intersperse, sortBy, groupBy, nub) +import Data.List (foldl', sortBy, groupBy, nub) hunk ./XMonad/Util/EZConfig.hs 416 - return (mod1Mask + (read [n]) - 1) + return $ indexMod (read [n] - 1) + where indexMod = (!!) [mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask] hunk ./XMonad/Util/EZConfig.hs 445 -functionKeys = [ ("F" ++ show n, k) +functionKeys = [ ('F' : show n, k) hunk ./XMonad/Util/EZConfig.hs 707 - showBindings = concat . intersperse " " . map ((++"\"") . ("\""++)) + showBindings = unwords . map (("\""++) . (++"\"")) hunk ./XMonad/Prompt.hs 33 - , pasteString, copyString + , pasteString, copyString, moveCursor hunk ./XMonad/Prompt.hs 65 -import XMonad hiding (config, io) +import XMonad hiding (config, io, numlockMask, cleanMask) +import qualified XMonad as X (numlockMask,config) hunk ./XMonad/Prompt.hs 78 -import Data.Bits ((.&.)) +import Data.Bits ((.&.),complement) hunk ./XMonad/Prompt.hs 115 + , numlockMask :: KeyMask hunk ./XMonad/Prompt.hs 238 + , numlockMask = X.numlockMask defaultConfig hunk ./XMonad/Prompt.hs 266 + numlock <- asks $ X.numlockMask . X.config hunk ./XMonad/Prompt.hs 268 - st = initState d rw w s compl gc fs (XPT t) hs conf + st = (initState d rw w s compl gc fs (XPT t) hs conf) + { numlockMask = numlock } hunk ./XMonad/Prompt.hs 326 +-- | Removes numlock and capslock from a keymask. +-- Duplicate of cleanMask from core, but in the +-- XP monad instead of X. +cleanMask :: KeyMask -> XP KeyMask +cleanMask msk = do + numlock <- gets numlockMask + return (complement (numlock .|. lockMask) .&. msk) + hunk ./XMonad/Prompt.hs 337 - | t == keyPress = keyPressHandle m ks + | t == keyPress = cleanMask m >>= flip keyPressHandle ks hunk ./XMonad/Prompt.hs 30 - , completion hunk ./XMonad/Prompt.hs 133 + , completionKey :: KeySym -- ^ Key that should trigger completion hunk ./XMonad/Prompt.hs 205 + , completionKey = xK_Tab hunk ./XMonad/Prompt.hs 337 -handle ks (KeyEvent {ev_event_type = t, ev_state = m}) - | t == keyPress = cleanMask m >>= flip keyPressHandle ks +handle ks@(sym,_) e@(KeyEvent {ev_event_type = t, ev_state = m}) = do + complKey <- gets $ completionKey . config + c <- getCompletions + when (length c > 1) $ modify (\s -> s { showComplWin = True }) + if complKey == sym + then completionHandle c ks e + else when (t == keyPress) $ cleanMask m >>= flip keyPressHandle ks hunk ./XMonad/Prompt.hs 349 -completion :: XP () -completion = do - c <- getCompletions - when (length c > 1) $ modify (\s -> s { showComplWin = True }) +-- completion event handler +completionHandle :: [String] -> KeyStroke -> Event -> XP () +completionHandle c (ks,_) (KeyEvent {ev_event_type = t}) + | t == keyPress && ks == xK_Tab = do hunk ./XMonad/Prompt.hs 362 - - --- completion event handler -completionHandle :: [String] -> KeyStroke -> Event -> XP () -completionHandle c (ks,_) (KeyEvent {ev_event_type = t}) - | t == keyPress && ks == xK_Tab = completion hunk ./XMonad/Prompt.hs 418 - , (xK_Tab, completion) hunk ./XMonad/Actions/Search.hs 62 -import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig(), historyCompletion) +import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig(), historyCompletionP) hunk ./XMonad/Actions/Search.hs 354 -promptSearchBrowser config browser (SearchEngine name site) = mkXPrompt (Search name) config historyCompletion $ search browser site +promptSearchBrowser config browser (SearchEngine name site) = + mkXPrompt (Search name) config (historyCompletionP ("Search [" `isPrefixOf`)) $ search browser site hunk ./XMonad/Prompt.hs 57 + , historyCompletionP hunk ./XMonad/Prompt.hs 131 - -- ^ a filter to determine which - -- history entries to remember + -- ^ a filter to determine which + -- history entries to remember hunk ./XMonad/Prompt.hs 134 - , completionKey :: KeySym -- ^ Key that should trigger completion - -- ^ Mapping from key combinations to actions + -- ^ Mapping from key combinations to actions + , completionKey :: KeySym -- ^ Key that should trigger completion hunk ./XMonad/Prompt.hs 139 - -- and delay by x microseconds + -- and delay by x microseconds hunk ./XMonad/Prompt.hs 281 - (showXPrompt t) [command st'] hist + (showXPrompt t) (historyFilter conf [command st']) + hist + -- we need to apply historyFilter before as well, since + -- otherwise the filter would not be applied if + -- there is no history hunk ./XMonad/Prompt.hs 870 -historyCompletion x = fmap (deleteConsecutive . filter (isInfixOf x) . M.fold (++) []) readHistory +historyCompletion = historyCompletionP (const True) + +-- | Like 'historyCompletion' but only uses history data from Prompts whose +-- name satisfies the given predicate. +historyCompletionP :: (String -> Bool) -> ComplFunction +historyCompletionP p x = fmap (toComplList . M.filterWithKey (const . p)) readHistory + where toComplList = deleteConsecutive . filter (isInfixOf x) . M.fold (++) [] hunk ./XMonad/Prompt.hs 348 - else when (t == keyPress) $ cleanMask m >>= flip keyPressHandle ks + else when (t == keyPress) $ keyPressHandle m ks hunk ./XMonad/Prompt.hs 427 -keyPressHandle mask (ks,str) = do +keyPressHandle m (ks,str) = do hunk ./XMonad/Prompt.hs 429 + mask <- cleanMask m hunk ./XMonad/Prompt.hs 356 -completionHandle c (ks,_) (KeyEvent {ev_event_type = t}) - | t == keyPress && ks == xK_Tab = do - st <- get - let updateState l = do let new_command = nextCompletion (xptype st) (command st) l - modify $ \s -> setCommand new_command $ s { offset = length new_command } - updateWins l = do redrawWindows l - eventLoop (completionHandle l) - case c of - [] -> updateWindows >> eventLoop handle - [x] -> updateState [x] >> getCompletions >>= updateWins - l -> updateState l >> updateWins l --- key release - | t == keyRelease && ks == xK_Tab = eventLoop (completionHandle c) --- other keys -completionHandle _ ks (KeyEvent {ev_event_type = t, ev_state = m}) - | t == keyPress = keyPressHandle m ks +completionHandle c ks@(sym,_) (KeyEvent { ev_event_type = t, ev_state = m }) = do + complKey <- gets $ completionKey . config + case () of + () | t == keyPress && sym == complKey -> + do + st <- get + let updateState l = + let new_command = nextCompletion (xptype st) (command st) l + in modify $ \s -> setCommand new_command $ s { offset = length new_command } + updateWins l = redrawWindows l >> + eventLoop (completionHandle l) + case c of + [] -> updateWindows >> eventLoop handle + [x] -> updateState [x] >> getCompletions >>= updateWins + l -> updateState l >> updateWins l + | t == keyRelease && sym == complKey -> eventLoop (completionHandle c) + | otherwise -> keyPressHandle m ks -- some other key, handle it normally addfile ./XMonad/Layout/Minimize.hs hunk ./XMonad/Layout/Minimize.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Minimize +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- Makes it possible to minimize windows, temporarily removing them +-- from the layout until they are restored. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.Minimize ( + -- * Usage + -- $usage + minimize, + MinimizeMsg(..) + ) where + +import XMonad +import qualified XMonad.StackSet as W +import XMonad.Layout.LayoutModifier +import XMonad.Layout.BoringWindows as BW +import Data.List + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Minimize +-- +-- Then edit your @layoutHook@ by adding the Minimize layout modifier: +-- +-- > myLayouts = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- In the key-bindings, do something like: +-- +-- > , ((modMask', xK_m ), withFocused (\f -> sendMessage (MinimizeWin f))) +-- > , ((modMask' .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin) +-- +-- The first action will minimize the focused window, while the second one will restore +-- the next minimized window. +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". +-- +-- The module is designed to work together with XMonad.Layout.BoringWindows so +-- that minimized windows are marked as boring and will be skipped when switching +-- the focused window. See the documentation for BoringWindows and use the boringAuto +-- function, to automatically mark minimized windows as boring. +-- +-- Also see XMonad.Hooks.RestoreMinimized if you want to be able to restore +-- minimized windows from your taskbar. + +data Minimize a = Minimize [Window] deriving ( Read, Show ) +minimize :: LayoutClass l Window => l Window -> ModifiedLayout Minimize l Window +minimize = ModifiedLayout $ Minimize [] + +data MinimizeMsg = MinimizeWin Window + | RestoreMinimizedWin Window + | RestoreNextMinimizedWin + deriving (Typeable, Eq) +instance Message MinimizeMsg + +instance LayoutModifier Minimize Window where + modifierDescription (Minimize _) = "Minimize" + + modifyLayout (Minimize minimized) wksp rect = do + let stack = W.stack wksp + filtStack = stack >>=W.filter (\w -> not (w `elem` minimized)) + runLayout (wksp {W.stack = filtStack}) rect + + handleMess (Minimize minimized) m = case fromMessage m of + Just (MinimizeWin w) + | not (w `elem` minimized) -> do + BW.focusDown + return $ Just $ Minimize (w:minimized) + | otherwise -> return Nothing + Just (RestoreMinimizedWin w) -> + return $ Just $ Minimize (minimized \\ [w]) + Just (RestoreNextMinimizedWin) + | not (null minimized) -> do + focus (head minimized) + return $ Just $ Minimize (tail minimized) + | otherwise -> return Nothing + _ -> return Nothing hunk ./xmonad-contrib.cabal 165 + XMonad.Layout.Minimize addfile ./XMonad/Hooks/RestoreMinimized.hs hunk ./XMonad/Hooks/RestoreMinimized.hs 1 +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.RestoreMinimized +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- Lets you restore minimized windows (see XMonad.Layout.Minimize) +-- by selecting them on a taskbar (listens for _NET_ACTIVE_WINDOW +-- and WM_CHANGE_STATE). +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.RestoreMinimized + ( -- * Usage + -- $usage + RestoreMinimized (..) + , restoreMinimizedEventHook + ) where + +import Data.Monoid +import Control.Monad(when) + +import XMonad +import XMonad.Layout.Minimize + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.RestoreMinimized +-- > +-- > myHandleEventHook = restoreMinimizedEventHook +-- > +-- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook } + +data RestoreMinimized = RestoreMinimized deriving ( Show, Read ) + +restoreMinimizedEventHook :: Event -> X All +restoreMinimizedEventHook (ClientMessageEvent {ev_window = w, + ev_message_type = mt}) = do + a_aw <- getAtom "_NET_ACTIVE_WINDOW" + a_cs <- getAtom "WM_CHANGE_STATE" + when (mt == a_aw || mt == a_cs) $ do + sendMessage (RestoreMinimizedWin w) + return (All True) +restoreMinimizedEventHook _ = return (All True) hunk ./xmonad-contrib.cabal 127 + XMonad.Hooks.RestoreMinimized hunk ./XMonad/Layout/Maximize.hs 26 +import qualified XMonad.StackSet as S hunk ./XMonad/Layout/Maximize.hs 64 - redoLayout (Maximize mw) rect _ wrs = case mw of - Just win -> - return (maxed ++ rest, Nothing) - where - maxed = map (\(w, _) -> (w, maxRect)) toMax - (toMax, rest) = partition (\(w, _) -> w == win) wrs - maxRect = Rectangle (rect_x rect + 50) (rect_y rect + 50) - (rect_width rect - 100) (rect_height rect - 100) - Nothing -> return (wrs, Nothing) + pureModifier (Maximize (Just target)) rect (Just (S.Stack focused _ _)) wrs = + if focused == target + then (maxed ++ rest, Nothing) + else (rest ++ maxed, Nothing) + where + (toMax, rest) = partition (\(w, _) -> w == target) wrs + maxed = map (\(w, _) -> (w, maxRect)) toMax + maxRect = Rectangle (rect_x rect + 25) (rect_y rect + 25) + (rect_width rect - 50) (rect_height rect - 50) + pureModifier _ _ _ wrs = (wrs, Nothing) + hunk ./XMonad/Layout/Maximize.hs 77 - Just _ -> return $ Just $ Maximize Nothing - Nothing -> return $ Just $ Maximize $ Just w + Just w' -> if (w == w') + then return $ Just $ Maximize Nothing -- restore window + else return $ Just $ Maximize $ Just w -- maximize different window + Nothing -> return $ Just $ Maximize $ Just w -- maximize window hunk ./XMonad/Layout/Maximize.hs 75 - handleMess (Maximize mw) m = case fromMessage m of + pureMess (Maximize mw) m = case fromMessage m of hunk ./XMonad/Layout/Maximize.hs 78 - then return $ Just $ Maximize Nothing -- restore window - else return $ Just $ Maximize $ Just w -- maximize different window - Nothing -> return $ Just $ Maximize $ Just w -- maximize window - _ -> return Nothing + then Just $ Maximize Nothing -- restore window + else Just $ Maximize $ Just w -- maximize different window + Nothing -> Just $ Maximize $ Just w -- maximize window + _ -> Nothing addfile ./XMonad/Layout/MouseResizableTile.hs hunk ./XMonad/Layout/MouseResizableTile.hs 1 +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.MouseResizableTile +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- A layout in the spirit of XMonad.Layout.ResizableTile, but with the option +-- to use the mouse to adjust the layout. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.MouseResizableTile ( + -- * Usage + -- $usage + mouseResizableTile, + mouseResizableTileMirrored, + MRTMessage (ShrinkSlave, ExpandSlave) + ) where + +import XMonad hiding (tile, splitVertically, splitHorizontallyBy) +import qualified XMonad.StackSet as W +import XMonad.Util.XUtils + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.MouseResizableTile +-- +-- Then edit your @layoutHook@ by adding the MouseResizableTile layout. +-- Either in its normal form or the mirrored version. (The mirror layout modifier +-- will not work correctly here because of the use of the mouse.) +-- +-- > myLayouts = mouseResizableTile ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- or +-- > myLayouts = mouseResizableTileMirrored ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- You may also want to add the following key bindings: +-- +-- > , ((modMask x, xK_u), sendMessage ShrinkSlave) -- %! Shrink a slave area +-- > , ((modMask x, xK_i), sendMessage ExpandSlave) -- %! Expand a slave area +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data MRTMessage = SetMasterFraction Rational + | SetLeftSlaveFraction Int Rational + | SetRightSlaveFraction Int Rational + | ShrinkSlave + | ExpandSlave + deriving Typeable +instance Message MRTMessage + +data DraggerInfo = MasterDragger Position Rational + | LeftSlaveDragger Position Rational Int + | RightSlaveDragger Position Rational Int + deriving (Show, Read) +type DraggerWithRect = (Rectangle, Glyph, DraggerInfo) +type DraggerWithWin = (Window, DraggerInfo) + +data MouseResizableTile a = MRT { nmaster :: Int, + masterFrac :: Rational, + leftFracs :: [Rational], + rightFracs :: [Rational], + draggers :: [DraggerWithWin], + focusPos :: Int, + numWindows :: Int, + isMirrored :: Bool + } deriving (Show, Read) + +mrtFraction :: Rational +mrtFraction = 0.5 +mrtDelta :: Rational +mrtDelta = 0.03 +mrtDraggerOffset :: Position +mrtDraggerOffset = 3 +mrtDraggerSize :: Dimension +mrtDraggerSize = 6 +mrtHDoubleArrow :: Glyph +mrtHDoubleArrow = 108 +mrtVDoubleArrow :: Glyph +mrtVDoubleArrow = 116 + +mouseResizableTile :: MouseResizableTile a +mouseResizableTile = MRT 1 mrtFraction [] [] [] 0 0 False + +mouseResizableTileMirrored :: MouseResizableTile a +mouseResizableTileMirrored= MRT 1 mrtFraction [] [] [] 0 0 True + +instance LayoutClass MouseResizableTile a where + doLayout state sr (W.Stack w l r) = + let wins = reverse l ++ w : r + num = length wins + sr' = mirrorAdjust sr (mirrorRect sr) + (rects, preparedDraggers) = tile (nmaster state) (masterFrac state) + ((leftFracs state) ++ repeat mrtFraction) + ((rightFracs state) ++ repeat mrtFraction) sr' num + rects' = map (mirrorAdjust id mirrorRect . sanitizeRectangle sr') rects + in do + mapM_ deleteDragger $ draggers state + newDraggers <- mapM (createDragger sr . adjustForMirror (isMirrored state)) preparedDraggers + return (zip wins rects', Just $ state { draggers = newDraggers, + focusPos = length l, + numWindows = length wins }) + where + mirrorAdjust a b = if (isMirrored state) + then b + else a + + handleMessage state m + | Just (IncMasterN d) <- fromMessage m = + return $ Just $ state { nmaster = max 0 (nmaster state + d) } + | Just (Shrink) <- fromMessage m = + return $ Just $ state { masterFrac = max 0 (masterFrac state - mrtDelta) } + | Just (Expand) <- fromMessage m = + return $ Just $ state { masterFrac = min 1 (masterFrac state + mrtDelta) } + | Just ShrinkSlave <- fromMessage m = + return $ Just $ modifySlave state (-mrtDelta) + | Just ExpandSlave <- fromMessage m = + return $ Just $ modifySlave state mrtDelta + | Just (SetMasterFraction f) <- fromMessage m = + return $ Just $ state { masterFrac = max 0 (min 1 f) } + | Just (SetLeftSlaveFraction pos f) <- fromMessage m = + return $ Just $ state { leftFracs = replaceAtPos (leftFracs state) pos (max 0 (min 1 f)) } + | Just (SetRightSlaveFraction pos f) <- fromMessage m = + return $ Just $ state { rightFracs = replaceAtPos (rightFracs state) pos (max 0 (min 1 f)) } + + | Just e <- fromMessage m :: Maybe Event = handleResize (draggers state) (isMirrored state) e >> return Nothing + | Just Hide <- fromMessage m = releaseResources >> return (Just $ state { draggers = [] }) + | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ state { draggers = [] }) + where releaseResources = mapM_ deleteDragger $ draggers state + handleMessage _ _ = return Nothing + + description _ = "MouseResizableTile" + +adjustForMirror :: Bool -> DraggerWithRect -> DraggerWithRect +adjustForMirror False dragger = dragger +adjustForMirror True (draggerRect, draggerCursor, draggerInfo) = + (mirrorRect draggerRect, draggerCursor', draggerInfo) + where + draggerCursor' = if (draggerCursor == mrtHDoubleArrow) + then mrtVDoubleArrow + else mrtHDoubleArrow + +modifySlave :: MouseResizableTile a -> Rational-> MouseResizableTile a +modifySlave state delta = + let pos = focusPos state + num = numWindows state + nmaster' = nmaster state + leftFracs' = leftFracs state + rightFracs' = rightFracs state + draggersLeft = nmaster' - 1 + draggersRight = (num - nmaster') - 1 + in if pos < nmaster' + then if draggersLeft > 0 + then let draggerPos = min (draggersLeft - 1) pos + oldFraction = (leftFracs' ++ repeat mrtFraction) !! draggerPos + in state { leftFracs = replaceAtPos leftFracs' draggerPos + (max 0 (min 1 (oldFraction + delta))) } + else state + else if draggersRight > 0 + then let draggerPos = min (draggersRight - 1) (pos - nmaster') + oldFraction = (rightFracs' ++ repeat mrtFraction) !! draggerPos + in state { rightFracs = replaceAtPos rightFracs' draggerPos + (max 0 (min 1 (oldFraction + delta))) } + else state + +replaceAtPos :: (Num t) => [Rational] -> t -> Rational -> [Rational] +replaceAtPos [] 0 x' = [x'] +replaceAtPos [] pos x' = mrtFraction : replaceAtPos [] (pos - 1) x' +replaceAtPos (_:xs) 0 x' = x' : xs +replaceAtPos (x:xs) pos x' = x : replaceAtPos xs (pos -1 ) x' + +sanitizeRectangle :: Rectangle -> Rectangle -> Rectangle +sanitizeRectangle (Rectangle sx sy swh sht) (Rectangle x y wh ht) = + (Rectangle (within 0 (sx + fromIntegral swh) x) (within 0 (sy + fromIntegral sht) y) + (within 1 swh wh) (within 1 sht ht)) + +within :: (Ord a) => a -> a -> a -> a +within low high a = max low $ min high a + +tile :: Int -> Rational -> [Rational] -> [Rational] -> Rectangle -> Int -> ([Rectangle], [DraggerWithRect]) +tile nmaster' masterFrac' leftFracs' rightFracs' sr num + | num <= nmaster' = splitVertically (take (num - 1) leftFracs') sr True 0 + | nmaster' == 0 = splitVertically (take (num - 1) rightFracs') sr False 0 + | otherwise = (leftRects ++ rightRects, [masterDragger] ++ leftDraggers ++ rightDraggers) + where ((sr1, sr2), masterDragger) = splitHorizontallyBy masterFrac' sr + (leftRects, leftDraggers) = splitVertically (take (nmaster' - 1) leftFracs') sr1 True 0 + (rightRects, rightDraggers) = splitVertically (take (num - nmaster' - 1) rightFracs') sr2 False 0 + +splitVertically :: RealFrac r => [r] -> Rectangle -> Bool -> Int -> ([Rectangle], [DraggerWithRect]) +splitVertically [] r _ _ = ([r], []) +splitVertically (f:fx) (Rectangle sx sy sw sh) isLeft num = + let nextRect = Rectangle sx sy sw (smallh - (div mrtDraggerSize 2)) + (otherRects, otherDragger) = splitVertically fx + (Rectangle sx (sy + fromIntegral smallh + mrtDraggerOffset) + sw (sh - smallh - (div mrtDraggerSize 2))) + isLeft (num + 1) + draggerRect = Rectangle sx (sy + fromIntegral smallh - mrtDraggerOffset) sw mrtDraggerSize + draggerInfo = if isLeft + then LeftSlaveDragger sy (fromIntegral sh) num + else RightSlaveDragger sy (fromIntegral sh) num + nextDragger = (draggerRect, mrtVDoubleArrow, draggerInfo) + in (nextRect : otherRects, nextDragger : otherDragger) + where smallh = floor $ fromIntegral sh * f + +splitHorizontallyBy :: RealFrac r => r -> Rectangle -> ((Rectangle, Rectangle), DraggerWithRect) +splitHorizontallyBy f (Rectangle sx sy sw sh) = ((leftHalf, rightHalf), (draggerRect, mrtHDoubleArrow, draggerInfo)) + where leftw = floor $ fromIntegral sw * f + leftHalf = Rectangle sx sy (leftw - (div mrtDraggerSize 2)) sh + rightHalf = Rectangle (sx + fromIntegral leftw + mrtDraggerOffset) sy + (sw - fromIntegral leftw - (div mrtDraggerSize 2)) sh + draggerRect = Rectangle (sx + fromIntegral leftw - mrtDraggerOffset) sy mrtDraggerSize sh + draggerInfo = MasterDragger sx (fromIntegral sw) + +createDragger :: Rectangle -> DraggerWithRect -> X DraggerWithWin +createDragger sr (draggerRect, draggerCursor, draggerInfo) = do + draggerWin <- createInputWindow draggerCursor $ sanitizeRectangle sr draggerRect + return (draggerWin, draggerInfo) + +deleteDragger :: DraggerWithWin -> X () +deleteDragger (draggerWin, _) = deleteWindow draggerWin + + +handleResize :: [DraggerWithWin] -> Bool -> Event -> X () +handleResize draggers' isM ButtonEvent { ev_window = ew, ev_event_type = et } + | et == buttonPress = do + case (lookup ew draggers') of + Just (MasterDragger lowerBound range) -> do + mouseDrag (\x y -> do + let axis = chooseAxis isM x y + fraction = fromIntegral (axis - lowerBound) / range + sendMessage (SetMasterFraction fraction)) (return ()) + Just (LeftSlaveDragger lowerBound range num) -> do + mouseDrag (\x y -> do + let axis = chooseAxis isM y x + fraction = fromIntegral (axis - lowerBound) / range + sendMessage (SetLeftSlaveFraction num fraction)) (return ()) + Just (RightSlaveDragger lowerBound range num) -> do + mouseDrag (\x y -> do + let axis = chooseAxis isM y x + fraction = fromIntegral (axis - lowerBound) / range + sendMessage (SetRightSlaveFraction num fraction)) (return ()) + Nothing -> return () + where + chooseAxis isM' axis1 axis2 = if isM' then axis2 else axis1 +handleResize _ _ _ = return () + +createInputWindow :: Glyph -> Rectangle -> X Window +createInputWindow cursorGlyph r = withDisplay $ \d -> do + win <- mkInputWindow d r + io $ selectInput d win (exposureMask .|. buttonPressMask) + cursor <- io $ createFontCursor d cursorGlyph + io $ defineCursor d win cursor + io $ freeCursor d cursor + showWindow win + return win + +mkInputWindow :: Display -> Rectangle -> X Window +mkInputWindow d (Rectangle x y w h) = do + rw <- asks theRoot + let screen = defaultScreenOfDisplay d + visual = defaultVisualOfScreen screen + attrmask = cWOverrideRedirect + io $ allocaSetWindowAttributes $ + \attributes -> do + set_override_redirect attributes True + createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes hunk ./xmonad-contrib.cabal 170 + XMonad.Layout.MouseResizableTile addfile ./XMonad/Hooks/WorkspaceByPos.hs hunk ./XMonad/Hooks/WorkspaceByPos.hs 1 +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.WorkspaceByPos +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- Useful in a dual-head setup: Looks at the requested geometry of +-- new windows and moves them to the workspace of the non-focused +-- screen if necessary. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.WorkspaceByPos ( + -- * Usage + -- $usage + workspaceByPos + ) where + +import XMonad +import qualified XMonad.StackSet as W + +import Data.Maybe +import Control.Applicative((<$>)) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.WorkspaceByPos +-- > +-- > myManageHook = workspaceByPos <+> manageHook defaultConfig +-- > +-- > main = xmonad defaultConfig { manageHook = myManageHook } + +workspaceByPos :: ManageHook +workspaceByPos = ask >>= \w -> do + b <- liftX $ needsMoving w + case b of + Nothing -> idHook + Just wkspc -> doShift wkspc + +needsMoving :: Window -> X (Maybe WorkspaceId) +needsMoving w = withDisplay $ \d -> do + -- only relocate windows with non-zero position + wa <- io $ getWindowAttributes d w + if ((wa_x wa) == 0) && ((wa_y wa) == 0) + then return Nothing + else do + ws <- gets windowset + sc <- fromMaybe (W.current ws) + <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) + maybeWkspc <- screenWorkspace (W.screen sc) + case maybeWkspc of + Nothing -> return Nothing + Just wkspc -> do + let currentWksp = W.currentTag ws + if currentWksp == wkspc + then return Nothing + else return (Just wkspc) + +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral hunk ./xmonad-contrib.cabal 132 + XMonad.Hooks.WorkspaceByPos hunk ./XMonad/Actions/GridSelect.hs 30 + runSelectedAction, hunk ./XMonad/Actions/GridSelect.hs 77 - gs_navigate :: NavigateMap + gs_navigate :: NavigateMap, + gs_originFractX :: Double, + gs_originFractY :: Double hunk ./XMonad/Actions/GridSelect.hs 120 -diamondRestrict :: (Enum t, Num t, Ord t) => t -> t -> [(t, t)] -diamondRestrict x y = L.filter (\(x',y') -> abs x' <= x && abs y' <= y) . - L.takeWhile (\(x',y') -> abs x' + abs y' <= x+y) $ diamond +diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)] +diamondRestrict x y originX originY = + L.filter (\(x',y') -> abs x' <= x && abs y' <= y) . + map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) . + take 1000 $ diamond hunk ./XMonad/Actions/GridSelect.hs 216 - TwoDState { td_elementmap = elmap, td_paneX = px, td_paneY = py, - td_gsconfig = (GSConfig ch cw _ _ _ _) } <- get + (TwoDState { td_elementmap = elmap, td_paneX = px, td_paneY = py, + td_gsconfig = (GSConfig ch cw _ _ _ _ _ _) }) <- get hunk ./XMonad/Actions/GridSelect.hs 324 - elmap' = zip (diamondRestrict restrictX restrictY) elmap + originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX + originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY + coords = diamondRestrict restrictX restrictY originPosX originPosY + elmap' = zip coords elmap hunk ./XMonad/Actions/GridSelect.hs 330 - (TwoDState (0,0) + (TwoDState (head coords) hunk ./XMonad/Actions/GridSelect.hs 376 -buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultGSNav +buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultGSNav (1/2) (1/2) hunk ./XMonad/Actions/GridSelect.hs 411 +-- | Select an action and run it in the X monad +runSelectedAction :: GSConfig (X ()) -> [(String, X ())] -> X () +runSelectedAction conf actions = do + selectedActionM <- gridselect conf actions + case selectedActionM of + Just selectedAction -> selectedAction + Nothing -> return () addfile ./XMonad/Actions/WindowMenu.hs hunk ./XMonad/Actions/WindowMenu.hs 1 +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.WindowMenu +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- Uses XMonad.Actions.GridSelect to display a number of actions related to +-- window management in the center of the focused window. Actions include: Closing, +-- maximizing, minimizing and shifting the window to another workspace. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.WindowMenu ( + -- * Usage + -- $usage + windowMenu + ) where + +import XMonad +import qualified XMonad.StackSet as W +import XMonad.Actions.GridSelect +import XMonad.Layout.Maximize +import XMonad.Layout.Minimize + +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.WindowMenu +-- +-- Then add a keybinding, e.g. +-- +-- > , ((modMask x, xK_o ), windowMenu) + +simpleColorizer :: (Monad m) => t -> t -> t1 -> Bool -> m (t, [Char]) +simpleColorizer nBC _ _ False = return (nBC, "black") +simpleColorizer _ fBC _ True = return (fBC, "black") + +windowMenu :: X () +windowMenu = withFocused $ \w -> do + nBC <- asks (normalBorderColor . config) + fBC <- asks (focusedBorderColor . config) + tags <- asks (workspaces . config) + Rectangle x y wh ht <- getSize w + Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset + let originFractX = (fromIntegral x - fromIntegral sx + (fromIntegral wh / 2)) + / fromIntegral swh + originFractY = (fromIntegral y -fromIntegral sy + (fromIntegral ht / 2)) + / fromIntegral sht + colorizer = simpleColorizer nBC fBC + gsConfig = buildDefaultGSConfig colorizer + gsConfig' = gsConfig { gs_originFractX = originFractX, + gs_originFractY = originFractY } + actions = [ ("Cancel menu", return ()) + , ("Close" , kill) + , ("Maximize" , sendMessage $ maximizeRestore w) + , ("Minimize" , sendMessage $ MinimizeWin w) + ] ++ + [ ("Move to " ++ tag, windows $ W.shift tag) + | tag <- tags ] + runSelectedAction gsConfig' actions + +getSize :: Window -> X (Rectangle) +getSize w = do + d <- asks display + wa <- io $ getWindowAttributes d w + let x = fromIntegral $ wa_x wa + y = fromIntegral $ wa_y wa + wh = fromIntegral $ wa_width wa + ht = fromIntegral $ wa_height wa + return (Rectangle x y wh ht) hunk ./xmonad-contrib.cabal 105 + XMonad.Actions.WindowMenu hunk ./XMonad/Layout/MouseResizableTile.hs 40 +-- hunk ./XMonad/Layout/MouseResizableTile.hs 42 +-- hunk ./XMonad/Actions/Commands.hs 96 - , ("focus-up" , windows $ focusUp ) - , ("focus-down" , windows $ focusDown ) - , ("swap-up" , windows $ swapUp ) - , ("swap-down" , windows $ swapDown ) - , ("swap-master" , windows $ swapMaster ) + , ("focus-up" , windows focusUp ) + , ("focus-down" , windows focusDown ) + , ("swap-up" , windows swapUp ) + , ("swap-down" , windows swapDown ) + , ("swap-master" , windows swapMaster ) hunk ./XMonad/Layout/MouseResizableTile.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} hunk ./XMonad/Layout/MouseResizableTile.hs 240 - | et == buttonPress = do - case (lookup ew draggers') of - Just (MasterDragger lowerBound range) -> do - mouseDrag (\x y -> do - let axis = chooseAxis isM x y - fraction = fromIntegral (axis - lowerBound) / range - sendMessage (SetMasterFraction fraction)) (return ()) - Just (LeftSlaveDragger lowerBound range num) -> do - mouseDrag (\x y -> do - let axis = chooseAxis isM y x - fraction = fromIntegral (axis - lowerBound) / range - sendMessage (SetLeftSlaveFraction num fraction)) (return ()) - Just (RightSlaveDragger lowerBound range num) -> do - mouseDrag (\x y -> do - let axis = chooseAxis isM y x - fraction = fromIntegral (axis - lowerBound) / range - sendMessage (SetRightSlaveFraction num fraction)) (return ()) - Nothing -> return () + | et == buttonPress, Just x <- lookup ew draggers' = case x of + MasterDragger lb r -> mouseDrag' id lb r SetMasterFraction + LeftSlaveDragger lb r num -> mouseDrag' flip lb r (SetLeftSlaveFraction num) + RightSlaveDragger lb r num -> mouseDrag' flip lb r (SetRightSlaveFraction num) hunk ./XMonad/Layout/MouseResizableTile.hs 246 + mouseDrag' flp lowerBound range msg = flip mouseDrag (return ()) $ \x y -> do + let axis = flp (chooseAxis isM) x y + fraction = fromIntegral (axis - lowerBound) / range + sendMessage (msg fraction) + hunk ./XMonad/Actions/DeManage.hs 13 --- like kicker and gnome-panel. +-- like kicker and gnome-panel. See also 'XMonad.Hooks.ManageDocks' for +-- more a more automated solution. hunk ./XMonad/Hooks/WorkspaceByPos.hs 25 +import XMonad.Util.XUtils (fi) hunk ./XMonad/Hooks/WorkspaceByPos.hs 29 +import Control.Monad.Error ((<=<),guard,lift,runErrorT,throwError) hunk ./XMonad/Hooks/WorkspaceByPos.hs 41 -workspaceByPos = ask >>= \w -> do - b <- liftX $ needsMoving w - case b of - Nothing -> idHook - Just wkspc -> doShift wkspc +workspaceByPos = (maybe idHook doShift <=< liftX . needsMoving) =<< ask hunk ./XMonad/Hooks/WorkspaceByPos.hs 45 - -- only relocate windows with non-zero position - wa <- io $ getWindowAttributes d w - if ((wa_x wa) == 0) && ((wa_y wa) == 0) - then return Nothing - else do - ws <- gets windowset - sc <- fromMaybe (W.current ws) - <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) - maybeWkspc <- screenWorkspace (W.screen sc) - case maybeWkspc of - Nothing -> return Nothing - Just wkspc -> do - let currentWksp = W.currentTag ws - if currentWksp == wkspc - then return Nothing - else return (Just wkspc) - -fi :: (Integral a, Num b) => a -> b -fi = fromIntegral + -- only relocate windows with non-zero position + wa <- io $ getWindowAttributes d w + fmap (const Nothing `either` Just) . runErrorT $ do + guard $ wa_x wa == 0 && wa_y wa == 0 + ws <- gets windowset + sc <- lift $ fromMaybe (W.current ws) + <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) + Just wkspc <- lift $ screenWorkspace (W.screen sc) + guard $ W.currentTag ws /= wkspc + return wkspc `asTypeOf` throwError "" hunk ./XMonad/Layout/MouseResizableTile.hs 109 - ((leftFracs state) ++ repeat mrtFraction) - ((rightFracs state) ++ repeat mrtFraction) sr' num + (leftFracs state ++ repeat mrtFraction) + (rightFracs state ++ repeat mrtFraction) sr' num hunk ./XMonad/Layout/MouseResizableTile.hs 126 - | Just (Shrink) <- fromMessage m = + | Just Shrink <- fromMessage m = hunk ./XMonad/Layout/MouseResizableTile.hs 128 - | Just (Expand) <- fromMessage m = + | Just Expand <- fromMessage m = hunk ./XMonad/Layout/MouseResizableTile.hs 199 - | otherwise = (leftRects ++ rightRects, [masterDragger] ++ leftDraggers ++ rightDraggers) + | otherwise = (leftRects ++ rightRects, masterDragger : leftDraggers ++ rightDraggers) hunk ./XMonad/Layout/MouseResizableTile.hs 207 - let nextRect = Rectangle sx sy sw (smallh - (div mrtDraggerSize 2)) + let nextRect = Rectangle sx sy sw $ smallh - div mrtDraggerSize 2 hunk ./XMonad/Layout/MouseResizableTile.hs 210 - sw (sh - smallh - (div mrtDraggerSize 2))) + sw (sh - smallh - div mrtDraggerSize 2)) hunk ./XMonad/Layout/MouseResizableTile.hs 223 - leftHalf = Rectangle sx sy (leftw - (div mrtDraggerSize 2)) sh + leftHalf = Rectangle sx sy (leftw - mrtDraggerSize `div` 2) sh hunk ./XMonad/Layout/MouseResizableTile.hs 225 - (sw - fromIntegral leftw - (div mrtDraggerSize 2)) sh + (sw - fromIntegral leftw - mrtDraggerSize `div` 2) sh hunk ./XMonad/Layout/MouseResizableTile.hs 237 - hunk ./XMonad/Prompt.hs 330 - gets done >>= flip unless (eventLoop action) + gets done >>= flip unless (eventLoop handle) hunk ./XMonad/Actions/WindowMenu.hs 28 +import XMonad.Util.XUtils (fi) hunk ./XMonad/Actions/WindowMenu.hs 51 - let originFractX = (fromIntegral x - fromIntegral sx + (fromIntegral wh / 2)) - / fromIntegral swh - originFractY = (fromIntegral y -fromIntegral sy + (fromIntegral ht / 2)) - / fromIntegral sht + let originFractX = (fi x - fi sx + fi wh / 2) / fi swh + originFractY = (fi y - fi sy + fi ht / 2) / fi sht hunk ./XMonad/Actions/WindowMenu.hs 54 - gsConfig = buildDefaultGSConfig colorizer - gsConfig' = gsConfig { gs_originFractX = originFractX, - gs_originFractY = originFractY } + gsConfig = (buildDefaultGSConfig colorizer) + { gs_originFractX = originFractX + , gs_originFractY = originFractY } hunk ./XMonad/Actions/WindowMenu.hs 64 - runSelectedAction gsConfig' actions + runSelectedAction gsConfig actions hunk ./XMonad/Actions/WindowMenu.hs 70 - let x = fromIntegral $ wa_x wa - y = fromIntegral $ wa_y wa - wh = fromIntegral $ wa_width wa - ht = fromIntegral $ wa_height wa + let x = fi $ wa_x wa + y = fi $ wa_y wa + wh = fi $ wa_width wa + ht = fi $ wa_height wa hunk ./XMonad/Actions/WindowMenu.hs 15 +-- Note: For maximizing and minimizing to actually work, you will need +-- to integrate XMonad.Layout.Maximize and XMonad.Layout.Minimize into your setup. +-- See the documentation of those modules for more information. +-- hunk ./XMonad/Layout/SimplestFloat.hs 26 +import XMonad.Util.XUtils (fi) hunk ./XMonad/Layout/SimplestFloat.hs 46 -simplestFloat = (windowArrangeAll $ SF) +simplestFloat = windowArrangeAll SF hunk ./XMonad/Layout/SimplestFloat.hs 50 - doLayout SF sc (S.Stack w l r) = do wrs <- mapM (getSize sc) (w : reverse l ++ r) - return (wrs, Nothing) + doLayout SF sc (S.Stack w l r) = fmap (flip (,) Nothing) + $ mapM (getSize sc) (w : reverse l ++ r) hunk ./XMonad/Layout/SimplestFloat.hs 64 - where - fi x = fromIntegral x + hunk ./XMonad/Actions/WindowMenu.hs 11 --- Uses XMonad.Actions.GridSelect to display a number of actions related to +-- Uses "XMonad.Actions.GridSelect" to display a number of actions related to hunk ./XMonad/Actions/WindowMenu.hs 16 --- to integrate XMonad.Layout.Maximize and XMonad.Layout.Minimize into your setup. --- See the documentation of those modules for more information. +-- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your +-- setup. See the documentation of those modules for more information. hunk ./XMonad/Hooks/RestoreMinimized.hs 11 --- Lets you restore minimized windows (see XMonad.Layout.Minimize) +-- Lets you restore minimized windows (see "XMonad.Layout.Minimize") hunk ./XMonad/Layout/Minimize.hs 56 --- The module is designed to work together with XMonad.Layout.BoringWindows so --- that minimized windows are marked as boring and will be skipped when switching --- the focused window. See the documentation for BoringWindows and use the boringAuto --- function, to automatically mark minimized windows as boring. +-- The module is designed to work together with "XMonad.Layout.BoringWindows" so +-- that minimized windows will be skipped when switching the focus window with +-- the keyboard. Use the 'BW.boringAuto' function. hunk ./XMonad/Layout/Minimize.hs 60 --- Also see XMonad.Hooks.RestoreMinimized if you want to be able to restore +-- Also see "XMonad.Hooks.RestoreMinimized" if you want to be able to restore addfile ./XMonad/Hooks/SetCursor.hs hunk ./XMonad/Hooks/SetCursor.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.SetCursor +-- Copyright : (c) 2009 Nils Schweinsberg +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Nils Schweinsberg +-- Stability : unstable +-- Portability : unportable +-- +-- Set a default cursor on startup. +-- +-- Thanks to Andres Salomon for his initial idea for this startup hook. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.SetCursor ( + -- * Usage + -- $usage + setDefaultCursor + ) where + +import XMonad + +{- $usage + +To use this startup hook add a line to your startup hook: + +> myStartupHook = do +> setDefaultCursor 68 +> -- more stuff + +Where @68@ is the default left pointer. + +-} + +-- | Set the default (root) cursor +setDefaultCursor :: Glyph -- ^ the cursor to use + -> X () +setDefaultCursor glyph = do + dpy <- asks display + rootw <- asks theRoot + liftIO $ do + curs <- createFontCursor dpy glyph + defineCursor dpy rootw curs + flush dpy + freeCursor dpy curs hunk ./xmonad-contrib.cabal 130 + XMonad.Hooks.SetCursor hunk ./XMonad/Prompt.hs 174 - nextCompletion t c l = getNextOfLastWord t c l + nextCompletion = getNextOfLastWord hunk ./XMonad/Prompt.hs 179 - commandToComplete _ c = getLastWord c + commandToComplete _ = getLastWord hunk ./XMonad/Prompt.hs 262 - hist <- liftIO $ readHistory + hist <- liftIO readHistory hunk ./XMonad/Prompt.hs 492 -flushString = do - modify $ \s -> setCommand "" $ s { offset = 0} +flushString = modify $ \s -> setCommand "" $ s { offset = 0} hunk ./XMonad/Prompt.hs 505 -pasteString = join $ io $ liftM insertString $ getSelection +pasteString = join $ io $ liftM insertString getSelection hunk ./XMonad/Prompt.hs 540 - Prev -> o - (ln reverse f ) - Next -> o + (ln id ss) + Prev -> o - ln reverse f + Next -> o + ln id ss hunk ./XMonad/Prompt.hs 628 - io $ (completionFunction s) (commandToComplete (xptype s) (command s)) + io $ completionFunction s (commandToComplete (xptype s) (command s)) hunk ./XMonad/Prompt.hs 668 - columns = max 1 $ wh `div` (fi max_compl_len) + columns = max 1 $ wh `div` fi max_compl_len hunk ./XMonad/Prompt.hs 670 - (rows,r) = (length compl) `divMod` fi columns + (rows,r) = length compl `divMod` fi columns hunk ./XMonad/Prompt.hs 702 - let ac = splitInSubListsAt (length yy) (take ((length xx) * (length yy)) compl) + let ac = splitInSubListsAt (length yy) (take (length xx * length yy) compl) hunk ./XMonad/Prompt.hs 714 - if (compl /= [] && showComplWin st) + if compl /= [] && showComplWin st hunk ./XMonad/Prompt/AppendFile.hs 64 -doAppend fn s = io $ bracket (openFile fn AppendMode) - hClose - (flip hPutStrLn s) +doAppend fn = io . bracket (openFile fn AppendMode) hClose . flip hPutStrLn hunk ./XMonad/Prompt/Directory.hs 34 -directoryPrompt c prom job = mkXPrompt (Dir prom) c getDirCompl job +directoryPrompt c prom = mkXPrompt (Dir prom) c getDirCompl hunk ./XMonad/Prompt/RunOrRaise.hs 28 -import Control.Monad (liftM2) +import Control.Monad (liftM, liftM2) hunk ./XMonad/Prompt/RunOrRaise.hs 50 -runOrRaisePrompt c = do cmds <- io $ getCommands +runOrRaisePrompt c = do cmds <- io getCommands hunk ./XMonad/Prompt/RunOrRaise.hs 53 -open path = (io $ isNormalFile path) >>= \b -> +open path = io (isNormalFile path) >>= \b -> hunk ./XMonad/Prompt/RunOrRaise.hs 58 - isNormalFile f = exists f >>= \e -> if e then (notExecutable f) else return False + isNormalFile f = exists f >>= \e -> if e then notExecutable f else return False hunk ./XMonad/Prompt/RunOrRaise.hs 69 -pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `catch` (\_ -> return $ 0) +pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `catch` (\_ -> return 0) hunk ./XMonad/Prompt/RunOrRaise.hs 74 - getWindowProperty32 d a w >>= return . getPID' + liftM getPID' (getWindowProperty32 d a w) hunk ./XMonad/Prompt/Shell.hs 60 - cmds <- io $ getCommands + cmds <- io getCommands hunk ./XMonad/Prompt/Ssh.hs 57 - sc <- io $ sshComplList + sc <- io sshComplList hunk ./XMonad/Prompt/Ssh.hs 61 -ssh s = runInTerm "" ("ssh " ++ s) +ssh = runInTerm "" . ("ssh " ++ ) hunk ./XMonad/Prompt/Window.hs 71 -windowPromptGoto c = doPrompt Goto c -windowPromptBring c = doPrompt Bring c -windowPromptBringCopy c = doPrompt BringCopy c +windowPromptGoto = doPrompt Goto +windowPromptBring = doPrompt Bring +windowPromptBringCopy = doPrompt BringCopy hunk ./XMonad/Prompt/Window.hs 97 -bringCopyWindow w ws = copyWindow w (W.currentTag $ ws) ws +bringCopyWindow w ws = copyWindow w (W.currentTag ws) ws hunk ./XMonad/Actions/GridSelect.hs 20 + + -- * Configuration hunk ./XMonad/Actions/GridSelect.hs 23 + NavigateMap, + TwoDPosition, hunk ./XMonad/Actions/GridSelect.hs 28 + + -- * Variations on 'gridselect' hunk ./XMonad/Actions/GridSelect.hs 37 + + -- * Utility functions for customizing the 'GSConfig' hunk ./XMonad/Actions/GridSelect.hs 71 --- Screenshot: +-- Screenshot: +-- +-- <> hunk ./XMonad/Actions/GridSelect.hs 314 -gridselect :: forall a . GSConfig a -> [(String,a)] -> X (Maybe a) +gridselect :: GSConfig a -> [(String,a)] -> X (Maybe a) hunk ./XMonad/Actions/GridSelect.hs 330 - let restriction :: Integer -> (GSConfig a -> Integer) -> Double - restriction ss cs = ((fromInteger ss)/(fromInteger $ cs gsconfig)-1)/2 + let restriction ss cs = ((fromInteger ss)/(fromInteger $ cs gsconfig)-1)/2 hunk ./XMonad/Actions/GridSelect.hs 380 +-- | The default 'GSConfig' to use when selecting windows. hunk ./XMonad/Actions/CycleWindows.hs 24 --- "XMonad.Layout.Mosaic" with three or four panes. See also --- "XMonad.Actions.RotSlaves" for related actions. +-- when using "XMonad.Layout.LimitWindows" to only show three or four +-- panes. See also "XMonad.Actions.RotSlaves" for related actions. hunk ./XMonad/Actions/CycleWindows.hs 56 +import Control.Arrow (second) + hunk ./XMonad/Actions/CycleWindows.hs 179 - (l',t':r') = (\(f,s) -> (f, reverse s)) . splitAt (length l) $ + (l',t':r') = second reverse . splitAt (length l) $ hunk ./XMonad/Actions/CycleWindows.hs 184 --- Rotate windows through the focused frame, excluding the \"next\" window. +-- Most people will want the @rotAllUp@ or @rotAllDown@ actions from +-- "XMonad.Actions.RotSlaves" to cycle all windows in the stack. +-- +-- The following actions keep the \"next\" window stable, which is +-- mostly useful in two window layouts, or when you have a log viewer or +-- buffer window you want to keep next to the cycled window. + +-- | Rotate windows through the focused frame, excluding the \"next\" window. hunk ./XMonad/Actions/CycleWindows.hs 211 --- rotSlaves, from "XMonad.Actions.RotSlaves", but excludes the current +-- @rotSlaves@, from "XMonad.Actions.RotSlaves", but excludes the current hunk ./XMonad/Hooks/WorkspaceByPos.hs 48 - guard $ wa_x wa == 0 && wa_y wa == 0 + guard $ wa_x wa /= 0 || wa_y wa /= 0 hunk ./XMonad/Actions/GridSelect.hs 42 + + -- * Screenshots + -- $screenshots hunk ./XMonad/Actions/GridSelect.hs 74 --- Screenshot: --- --- <> --- hunk ./XMonad/Actions/GridSelect.hs 80 +-- $screenshots +-- +-- Selecting a workspace: +-- +-- <> +-- +-- Selecting a window by title: +-- +-- <> + hunk ./XMonad/Actions/GridSelect.hs 1 -{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-} hunk ./XMonad/Actions/GridSelect.hs 23 + GSCONFIG(defaultGSConfig), hunk ./XMonad/Actions/GridSelect.hs 26 - defaultGSConfig, - defaultGSSpawnConfig, hunk ./XMonad/Actions/GridSelect.hs 77 --- > , ((modMask x, xK_s), spawnSelected defaultGSSpawnConfig ["xterm","gmplayer","gvim"]) +-- > , ((modMask x, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"]) hunk ./XMonad/Actions/GridSelect.hs 100 +class GSCONFIG a where + defaultGSConfig :: GSConfig a -- ^ A basic configuration for 'gridselect'. + -- To configure your own colorizer, use + -- 'buildDefaultGSConfig', otherwise the + -- default colorizer with the correct type + -- will be used. + -- + -- That is 'fromClassName' if + -- you are selecting a 'Window', or + -- 'defaultColorizer' if you are selecting a + -- 'String'. The catch-all instance @GSCONFIG + -- a@ uses the 'focusedBorderColor' and + -- 'normalBorderColor' colors. + +instance GSCONFIG Window where + defaultGSConfig = buildDefaultGSConfig fromClassName + +instance GSCONFIG String where + defaultGSConfig = buildDefaultGSConfig defaultColorizer + +instance GSCONFIG a where + defaultGSConfig = buildDefaultGSConfig $ \_ isFg -> do + let getColor = if isFg then focusedBorderColor else normalBorderColor + asks $ flip (,) "black" . getColor . config + hunk ./XMonad/Actions/GridSelect.hs 361 - selectedElement <- if (status == grabSuccess) then - do - let restriction ss cs = ((fromInteger ss)/(fromInteger $ cs gsconfig)-1)/2 + selectedElement <- if (status == grabSuccess) then do + let restriction ss cs = (fromInteger ss/fromInteger (cs gsconfig)-1)/2 :: Double hunk ./XMonad/Actions/GridSelect.hs 412 --- | The default 'GSConfig' to use when selecting windows. -defaultGSConfig :: GSConfig Window -defaultGSConfig = buildDefaultGSConfig fromClassName - hunk ./XMonad/Actions/GridSelect.hs 442 -defaultGSSpawnConfig :: GSConfig String -defaultGSSpawnConfig = buildDefaultGSConfig defaultColorizer - hunk ./XMonad/Actions/WindowMenu.hs 44 -simpleColorizer :: (Monad m) => t -> t -> t1 -> Bool -> m (t, [Char]) -simpleColorizer nBC _ _ False = return (nBC, "black") -simpleColorizer _ fBC _ True = return (fBC, "black") - hunk ./XMonad/Actions/WindowMenu.hs 46 - nBC <- asks (normalBorderColor . config) - fBC <- asks (focusedBorderColor . config) hunk ./XMonad/Actions/WindowMenu.hs 51 - colorizer = simpleColorizer nBC fBC - gsConfig = (buildDefaultGSConfig colorizer) + gsConfig = defaultGSConfig hunk ./XMonad/Actions/GridSelect.hs 21 + -- ** Customizing + -- *** Using a common GSConfig + -- $commonGSConfig + -- *** Custom keybindings + -- $keybindings + hunk ./XMonad/Actions/GridSelect.hs 29 - GSCONFIG(defaultGSConfig), + defaultGSConfig, hunk ./XMonad/Actions/GridSelect.hs 43 - -- * Utility functions for customizing the 'GSConfig' + -- * Colorizers + HasColorizer(defaultColorizer), hunk ./XMonad/Actions/GridSelect.hs 46 - defaultColorizer, + stringColorizer, hunk ./XMonad/Actions/GridSelect.hs 86 +-- $commonGSConfig +-- +-- It is possible to bind a @gsconfig@ at top-level in your configuration. Like so: +-- +-- > gsconfig1 :: HasColorizer a => GSConfig a +-- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellWidth = 100 } +-- +-- Regarding type signatures: to leave them out in this case, add @{-# LANGUAGE +-- NoMonomorphismRestriction #-}@ to the top of your @xmonad.hs@. Refer to +-- this page for an explanation: +-- +-- +-- @gsconfig2@ is an example where 'buildDefaultGSConfig' is used instead of +-- 'defaultGSConfig' in order to specify a custom colorizer (found in +-- "XMonad.Actions.GridSelect#Colorizers"): +-- +-- > gsconfig2 colorizer = (buildDefaultGSConfig colorizer) { gs_cellheight = 30, gs_cellWidth = 100 } +-- +-- > -- | A green monochrome colorizer based on window class +-- > greenColorizer = colorRangeFromClassName +-- > black -- lowest inactive bg +-- > (0x70,0xFF,0x70) -- highest inactive bg +-- > black -- active bg +-- > white -- inactive fg +-- > white -- active fg +-- > where black = minBound +-- > white = maxBound + +-- Then you can bind to: +-- +-- ,((modMask x, xK_g), goToSelected $ gsconfig2 myWinColorizer) +-- ,((modMask x, xK_p), spawnSelected $ spawnSelected defaultColorizer) + +-- $keybindings +-- +-- Adding more keybindings for gridselect to listen to is similar: +-- +-- At the top of your config: +-- +-- > import qualified Data.Map as M +-- +-- Then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@: +-- +-- > gsconfig3 :: HasColorizer a => GSConfig a +-- > gsconfig3 = defaultGSConfig +-- > { gs_cellheight = 30 +-- > , gs_cellWidth = 100 +-- > , gs_navigate = M.unions [reset, nethackKeys, gs_navigate $ defaultGSConfig `asTypeOf` gsconfig3] } +-- > where addPair (a,b) (x,y) = (a+x,b+y) +-- > nethackKeys = M.map addPair +-- > $ M.fromList [((0,xK_y),(-1,-1) +-- > ,((0,xK_i),(1,-1) +-- > ,((0,xK_n),(-1,1) +-- > ,((0,xK_m),(1,1) +-- > ] +-- > -- jump back to the center with the spacebar, regardless of the current position. +-- > reset = M.singleton (0,xK_space) (const (0,0)) + hunk ./XMonad/Actions/GridSelect.hs 165 -class GSCONFIG a where - defaultGSConfig :: GSConfig a -- ^ A basic configuration for 'gridselect'. - -- To configure your own colorizer, use - -- 'buildDefaultGSConfig', otherwise the - -- default colorizer with the correct type - -- will be used. - -- - -- That is 'fromClassName' if - -- you are selecting a 'Window', or - -- 'defaultColorizer' if you are selecting a - -- 'String'. The catch-all instance @GSCONFIG - -- a@ uses the 'focusedBorderColor' and - -- 'normalBorderColor' colors. +-- | That is 'fromClassName' if you are selecting a 'Window', or +-- 'defaultColorizer' if you are selecting a 'String'. The catch-all instance +-- @HasColorizer a@ uses the 'focusedBorderColor' and 'normalBorderColor' +-- colors. +class HasColorizer a where + defaultColorizer :: a -> Bool -> X (String, String) hunk ./XMonad/Actions/GridSelect.hs 172 -instance GSCONFIG Window where - defaultGSConfig = buildDefaultGSConfig fromClassName +instance HasColorizer Window where + defaultColorizer = fromClassName hunk ./XMonad/Actions/GridSelect.hs 175 -instance GSCONFIG String where - defaultGSConfig = buildDefaultGSConfig defaultColorizer +instance HasColorizer String where + defaultColorizer = stringColorizer hunk ./XMonad/Actions/GridSelect.hs 178 -instance GSCONFIG a where - defaultGSConfig = buildDefaultGSConfig $ \_ isFg -> do +instance HasColorizer a where + defaultColorizer _ isFg = hunk ./XMonad/Actions/GridSelect.hs 181 - asks $ flip (,) "black" . getColor . config + in asks $ flip (,) "black" . getColor . config + +-- | A basic configuration for 'gridselect', with the colorizer chosen based on the type. +-- +-- If you want to replace the 'gs_colorizer' field, use 'buildDefaultGSConfig' +-- instead, to avoid ambiguous type variables. +defaultGSConfig :: HasColorizer a => GSConfig a +defaultGSConfig = buildDefaultGSConfig defaultColorizer hunk ./XMonad/Actions/GridSelect.hs 356 -defaultColorizer :: String -> Bool -> X (String, String) -defaultColorizer s active = +stringColorizer :: String -> Bool -> X (String, String) +stringColorizer s active = hunk ./XMonad/Util/Types.hs 30 - deriving (Eq,Read,Show,Ord,Bounded,Typeable) + deriving (Eq,Read,Show,Ord,Enum,Bounded,Typeable) hunk ./XMonad/Actions/FloatSnap.hs 35 +import qualified Data.Set as S + hunk ./XMonad/Actions/FloatSnap.hs 284 - gr <- fmap ($sr) $ calcGap [L,R,U,D] + gr <- fmap ($sr) $ calcGap $ S.fromList [minBound .. maxBound] hunk ./XMonad/Hooks/ManageDocks.hs 22 + SetStruts(..), hunk ./XMonad/Hooks/ManageDocks.hs 38 -import Data.List (delete) +import qualified Data.Set as S hunk ./XMonad/Hooks/ManageDocks.hs 123 -calcGap :: [Direction2D] -> X (Rectangle -> Rectangle) +calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle) hunk ./XMonad/Hooks/ManageDocks.hs 136 - where careAbout (s,_,_,_) = s `elem` ss + where careAbout (s,_,_,_) = s `S.member` ss hunk ./XMonad/Hooks/ManageDocks.hs 150 -avoidStrutsOn ss = ModifiedLayout (AvoidStruts ss) +avoidStrutsOn ss = ModifiedLayout $ AvoidStruts $ S.fromList ss hunk ./XMonad/Hooks/ManageDocks.hs 152 -data AvoidStruts a = AvoidStruts [Direction2D] deriving ( Read, Show ) +data AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show ) hunk ./XMonad/Hooks/ManageDocks.hs 162 +-- | SetStruts is a message constructor used to set or unset specific struts, +-- regardless of whether or not the struts were originally set. Here are some +-- example bindings: +-- +-- Show all gaps: +-- +-- > ,((modMask x .|. shiftMask ,xK_b),sendMessage $ SetStruts [minBound .. maxBound] []) +-- +-- Hide all gaps: +-- +-- > ,((modMask x .|. controlMask,xK_b),sendMessage $ SetStruts [] [minBound .. maxBound]) +-- +-- Show only upper and left gaps: +-- +-- > ,((modMask x .|. controlMask .|. shiftMask,xK_b),sendMessage $ SetStruts [U,L] [minBound .. maxBound]) +-- +-- Hide the bottom keeping whatever the other values were: +-- +-- > ,((modMask x .|. controlMask .|. shiftMask,xK_g),sendMessage $ SetStruts [] [D]) +data SetStruts = SetStruts { addedStruts :: [Direction2D] + , removedStruts :: [Direction2D] -- ^ These are removed from + } + deriving (Read,Show,Typeable) + +instance Message SetStruts + hunk ./XMonad/Hooks/ManageDocks.hs 193 - handleMess (AvoidStruts ss) m - | Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (toggleAll ss) - | Just (ToggleStrut s) <- fromMessage m = return $ Just $ AvoidStruts (toggleOne s ss) - | otherwise = return Nothing - where toggleAll [] = [U,D,L,R] - toggleAll _ = [] - toggleOne x xs | x `elem` xs = delete x xs - | otherwise = x : xs + pureMess (AvoidStruts ss) m + | Just ToggleStruts <- fromMessage m = Just $ AvoidStruts (toggleAll ss) + | Just (ToggleStrut s) <- fromMessage m = Just $ AvoidStruts (toggleOne s ss) + | Just (SetStruts n k) <- fromMessage m + , let newSS = S.fromList n `S.union` (ss S.\\ S.fromList k) + , newSS /= ss = Just $ AvoidStruts newSS + | otherwise = Nothing + where toggleAll x | S.null x = S.fromList [minBound .. maxBound] + | otherwise = S.empty + toggleOne x xs | x `S.member` xs = S.delete x xs + | otherwise = x `S.insert` xs hunk ./XMonad/Hooks/ManageDocks.hs 182 - , removedStruts :: [Direction2D] -- ^ These are removed from + , removedStruts :: [Direction2D] -- ^ These are removed from the currently set struts before 'addedStruts' are added. hunk ./XMonad/Layout/MouseResizableTile.hs 12 --- A layout in the spirit of XMonad.Layout.ResizableTile, but with the option +-- A layout in the spirit of "XMonad.Layout.ResizableTile", but with the option hunk ./XMonad/Layout/Tabbed.hs 62 --- modifiers ending in "Always". +-- modifiers ending in @Always@. hunk ./XMonad/Actions/WorkspaceCursors.hs 10 --- Portability : portable +-- Portability : unportable hunk ./XMonad/Actions/WorkspaceCursors.hs 12 --- Like Plane for an arbitrary number of dimensions. +-- Like "XMonad.Actions.Plane" for an arbitrary number of dimensions. hunk ./XMonad/Layout/BoringWindows.hs 22 - focusUp, focusDown, + focusUp, focusDown, focusMaster, hunk ./XMonad/Layout/BoringWindows.hs 55 --- > , ((modMask, xk_k), focusDown) +-- > , ((modMask, xK_k), focusDown) +-- > , ((modMask, xK_m), focusMaster) hunk ./XMonad/Layout/BoringWindows.hs 63 -data BoringMessage = FocusUp | FocusDown | IsBoring Window | ClearBoring +data BoringMessage = FocusUp | FocusDown | FocusMaster | IsBoring Window | ClearBoring hunk ./XMonad/Layout/BoringWindows.hs 76 -markBoring, clearBoring, focusUp, focusDown :: X () +markBoring, clearBoring, focusUp, focusDown, focusMaster :: X () hunk ./XMonad/Layout/BoringWindows.hs 81 +focusMaster = sendMessage UpdateBoring >> sendMessage FocusMaster hunk ./XMonad/Layout/BoringWindows.hs 120 + | 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 hunk ./XMonad/Layout/BoringWindows.hs 133 + +-- | 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 hunk ./XMonad/Actions/TopicSpace.hs 12 --- +----------------------------------------------------------------------------- + +module XMonad.Actions.TopicSpace + ( + -- * Overview + -- $overview + + -- * Usage + -- $usage + Topic + , Dir + , TopicConfig(..) + , getLastFocusedTopics + , setLastFocusedTopic + , pprWindowSet + , topicActionWithPrompt + , topicAction + , currentTopicAction + , switchTopic + , switchNthLastFocused + , shiftNthLastFocused + , currentTopicDir + , checkTopicConfig + , (>*>) + ) +where + +import XMonad + +import Data.List +import Data.Maybe (fromMaybe, isNothing, listToMaybe) +import Data.Ord +import qualified Data.Map as M +import Control.Monad ((=<<),liftM2,when,unless,replicateM_) +import System.IO + +import XMonad.Operations +import qualified XMonad.StackSet as W + +import XMonad.Prompt +import XMonad.Prompt.Workspace + +import XMonad.Hooks.UrgencyHook +import XMonad.Hooks.DynamicLog (PP(..)) +import qualified XMonad.Hooks.DynamicLog as DL + +import XMonad.Util.Run (spawnPipe) +import XMonad.Util.StringProp(getStringListProp,setStringListProp) + +-- $overview hunk ./XMonad/Actions/TopicSpace.hs 73 --- + +-- $usage hunk ./XMonad/Actions/TopicSpace.hs 200 -module XMonad.Actions.TopicSpace - ( Topic - , Dir - , TopicConfig(..) - , getLastFocusedTopics - , setLastFocusedTopic - , pprWindowSet - , topicActionWithPrompt - , topicAction - , currentTopicAction - , switchTopic - , switchNthLastFocused - , shiftNthLastFocused - , currentTopicDir - , checkTopicConfig - , (>*>) - ) -where - -import XMonad - -import Data.List -import Data.Maybe (fromMaybe, isNothing, listToMaybe) -import Data.Ord -import qualified Data.Map as M -import Control.Monad ((=<<),liftM2,when,unless,replicateM_) -import System.IO - -import XMonad.Operations -import qualified XMonad.StackSet as W - -import XMonad.Prompt -import XMonad.Prompt.Workspace - -import XMonad.Hooks.UrgencyHook -import XMonad.Hooks.DynamicLog (PP(..)) -import qualified XMonad.Hooks.DynamicLog as DL - -import XMonad.Util.Run (spawnPipe) -import XMonad.Util.StringProp(getStringListProp,setStringListProp) addfile ./XMonad/Layout/NoFrillsDecoration.hs hunk ./XMonad/Layout/NoFrillsDecoration.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.NoFrillsDecoration +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- Most basic version of decoration for windows without any additional +-- modifications. In contrast to "XMonad.Layout.SimpleDecoration" this will +-- result in title bars that span the entire window instead of being only the +-- length of the window title. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.NoFrillsDecoration + ( -- * Usage: + -- $usage + noFrillsDeco + ) where + +import XMonad.Layout.Decoration + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.NoFrillsDecoration +-- +-- Then edit your @layoutHook@ by adding the NoFrillsDecoration to +-- your layout: +-- +-- > myL = noFrillsDeco shrinkText defaultTheme (layoutHook defaultConfig) +-- > main = xmonad defaultConfig { layoutHook = myL } +-- + +-- | Add very simple decorations to windows of a layout. +noFrillsDeco :: (Eq a, Shrinker s) => s -> Theme + -> l a -> ModifiedLayout (Decoration NoFrillsDecoration s) l a +noFrillsDeco s c = decoration s c $ NFD True + +data NoFrillsDecoration a = NFD Bool deriving (Show, Read) + +instance Eq a => DecorationStyle NoFrillsDecoration a where + describeDeco _ = "NoFrillsDeco" hunk ./xmonad-contrib.cabal 178 + XMonad.Layout.NoFrillsDecoration hunk ./XMonad/Actions/DeManage.hs 13 --- like kicker and gnome-panel. See also 'XMonad.Hooks.ManageDocks' for +-- like kicker and gnome-panel. See also "XMonad.Hooks.ManageDocks" for hunk ./XMonad/Actions/WindowNavigation.hs 8 +-- Stability : unstable +-- Portability : unportable hunk ./XMonad/Config/Azerty.hs 10 +-- Stability : stable +-- Portability : unportable hunk ./XMonad/Config/Desktop.hs 10 +-- Stability : unstable +-- Portability : unportable hunk ./XMonad/Config/Gnome.hs 10 +-- Stability : unstable +-- Portability : unportable hunk ./XMonad/Config/Kde.hs 10 +-- Stability : unstable +-- Portability : unportable hunk ./XMonad/Config/Xfce.hs 10 +-- Stability : unstable +-- Portability : unportable hunk ./XMonad/Layout/LayoutScreens.hs 13 +-- Divide a single screen into multiple screens. hunk ./XMonad/Layout/Minimize.hs 1 -{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleContexts #-} hunk ./XMonad/Layout/Roledex.hs 13 --- Screenshot : --- hunk ./XMonad/Layout/Roledex.hs 19 + + -- * Screenshots + -- $screenshot hunk ./XMonad/Layout/Roledex.hs 42 +-- $screenshot +-- <> + hunk ./XMonad/Layout/ThreeColumns.hs 16 --- --- Screenshot: --- hunk ./XMonad/Layout/ThreeColumns.hs 21 + + -- * Screenshots + -- $screenshot hunk ./XMonad/Layout/ThreeColumns.hs 58 + +-- $screenshot +-- <> + hunk ./XMonad/Layout/Mosaic.hs 34 -import Control.Arrow(Control.Arrow.Arrow(second, first)) +import Control.Arrow(second, first) hunk ./XMonad/Layout/Mosaic.hs 36 -import Data.Foldable(Foldable(foldMap), sum) +import Data.Foldable(Foldable,foldMap, sum) hunk ./XMonad/Layout/Mosaic.hs 39 -import Data.Monoid(Monoid(mempty, mappend)) +import Data.Monoid(Monoid,mempty, mappend) hunk ./XMonad/Util/XSelection.hs 136 -One example is to wrap code, such as a command line action copied out of the browser to be run as '"sudo" ++ cmd' or '"su - -c \"" ++ cmd ++ "\"". +One example is to wrap code, such as a command line action copied out of the browser to be run as @"sudo" ++ cmd@ or @"su - -c \""++ cmd ++"\""@. hunk ./XMonad/Doc/Extending.hs 119 -* "XMonad.Actions.Commands": running internal xmonad actions - interactively. +* "XMonad.Actions.Commands": + Allows you to run internal xmonad commands (X () actions) using + a dmenu menu in addition to key bindings. Requires dmenu and + the Dmenu XMonad.Actions module. hunk ./XMonad/Doc/Extending.hs 124 -* "XMonad.Actions.ConstrainedResize": an aspect-ratio-constrained - window resizing mode. +* "XMonad.Actions.ConstrainedResize": + Lets you constrain the aspect ratio of a floating + window (by, say, holding shift while you resize). + Useful for making a nice circular XClock window. hunk ./XMonad/Doc/Extending.hs 129 -* "XMonad.Actions.CopyWindow": duplicating windows on multiple - workspaces. +* "XMonad.Actions.CopyWindow": + Provides bindings to duplicate a window on multiple workspaces, + providing dwm-like tagging functionality. hunk ./XMonad/Doc/Extending.hs 133 -* "XMonad.Actions.CycleSelectedLayouts": bind a key to cycle through a - particular subset of your layouts. +* "XMonad.Actions.CycleRecentWS": + Provides bindings to cycle through most recently used workspaces + with repeated presses of a single key (as long as modifier key is + held down). This is similar to how many window managers handle + window switching. hunk ./XMonad/Doc/Extending.hs 139 -* "XMonad.Actions.CycleWS": move between workspaces in various ways. +* "XMonad.Actions.CycleSelectedLayouts": + This module allows to cycle through the given subset of layouts. hunk ./XMonad/Doc/Extending.hs 142 -* "XMonad.Actions.DeManage": cease management of a window without - unmapping it. +* "XMonad.Actions.CycleWS": + Provides bindings to cycle forward or backward through the list of + workspaces, to move windows between workspaces, and to cycle + between screens. Replaces "XMonad.Actions.RotView". hunk ./XMonad/Doc/Extending.hs 147 -* "XMonad.Actions.DwmPromote": dwm-like master window swapping. +* "XMonad.Actions.CycleWindows": + Provides bindings to cycle windows up or down on the current workspace + stack while maintaining focus in place. hunk ./XMonad/Doc/Extending.hs 151 -* "XMonad.Actions.DynamicWorkspaces": add, delete, and rename workspaces. +* "XMonad.Actions.DeManage": + This module provides a method to cease management of a window + without unmapping it. "XMonad.Hooks.ManageDocks" is a + more automated solution if your panel supports it. hunk ./XMonad/Doc/Extending.hs 156 -* "XMonad.Actions.FindEmptyWorkspace": find an empty workspace. +* "XMonad.Actions.DwmPromote": + Dwm-like swap function for xmonad. + Swaps focused window with the master window. If focus is in the + master, swap it with the next window in the stack. Focus stays in the + master. hunk ./XMonad/Doc/Extending.hs 162 -* "XMonad.Actions.FlexibleManipulate": move\/resize windows without - warping the mouse. +* "XMonad.Actions.DynamicWorkspaces": + Provides bindings to add and delete workspaces. Note that you may only + delete a workspace that is already empty. hunk ./XMonad/Doc/Extending.hs 166 -* "XMonad.Actions.FlexibleResize": resize windows from any corner. +* "XMonad.Actions.FindEmptyWorkspace": + Find an empty workspace. hunk ./XMonad/Doc/Extending.hs 169 -* "XMonad.Actions.FloatKeys": move\/resize floating windows with - keybindings. +* "XMonad.Actions.FlexibleManipulate": + Move and resize floating windows without warping the mouse. hunk ./XMonad/Doc/Extending.hs 172 -* "XMonad.Actions.FocusNth": focus the nth window on the screen. +* "XMonad.Actions.FlexibleResize": + Resize floating windows from any corner. hunk ./XMonad/Doc/Extending.hs 175 -* "XMonad.Actions.MouseGestures": bind mouse gestures to actions. +* "XMonad.Actions.FloatKeys": + Move and resize floating windows. hunk ./XMonad/Doc/Extending.hs 178 -* "XMonad.Actions.MouseResize": use with - "XMonad.Layout.WindowArranger" to resize windows with the mouse when - using a floating layout. +* "XMonad.Layout.FloatSnap": + Move and resize floating windows using other windows and the edge of the + screen as guidelines. hunk ./XMonad/Doc/Extending.hs 182 -* "XMonad.Actions.NoBorders": forcibly remove borders from a window. - Not to be confused with "XMonad.Layout.NoBorders". +* "XMonad.Actions.FocusNth": + Focus the nth window of the current workspace. hunk ./XMonad/Doc/Extending.hs 185 -* "XMonad.Actions.PerWorkspaceKeys": configure keybindings - per-workspace. +* "XMonad.Actions.GridSelect": + GridSelect displays items(e.g. the opened windows) in a 2D grid and lets + the user select from it with the cursor/hjkl keys or the mouse. hunk ./XMonad/Doc/Extending.hs 189 -* "XMonad.Actions.Promote": An action to move the focused window to - the master pane, or swap the master with the next window. +* "XMonad.Actions.MessageFeedback": + Alternative to 'XMonad.Operations.sendMessage' that provides knowledge + of whether the message was handled, and utility functions based on + this facility. hunk ./XMonad/Doc/Extending.hs 194 -* "XMonad.Actions.RotSlaves": rotate non-master windows. +* "XMonad.Actions.MouseGestures": + Support for simple mouse gestures. hunk ./XMonad/Doc/Extending.hs 197 -* "XMonad.Actions.Search": provide helpful functions for easily - running web searchs. +* "XMonad.Actions.MouseResize": + A layout modifier to resize windows with the mouse by grabbing the + window's lower right corner. hunk ./XMonad/Doc/Extending.hs 201 -* "XMonad.Actions.SimpleDate": display the date in a popup menu. +* "XMonad.Actions.NoBorders": + This module provides helper functions for dealing with window borders. hunk ./XMonad/Doc/Extending.hs 204 -* "XMonad.Actions.SinkAll": sink all floating windows. +* "XMonad.Actions.OnScreen": + Control workspaces on different screens (in xinerama mode). hunk ./XMonad/Doc/Extending.hs 207 -* "XMonad.Actions.Submap": create key submaps, i.e. the ability to - bind actions to key sequences rather than being limited to single - key combinations. +* "XMonad.Actions.PerWorkspaceKeys": + Define key-bindings on per-workspace basis. hunk ./XMonad/Doc/Extending.hs 210 -* "XMonad.Actions.SwapWorkspaces": swap workspace tags. +* "XMonad.Actions.PhysicalScreens": + Manipulate screens ordered by physical location instead of ID hunk ./XMonad/Doc/Extending.hs 213 -* "XMonad.Actions.TagWindows": tag windows and select by tag. +* "XMonad.Actions.Plane": + This module has functions to navigate through workspaces in a bidimensional + manner. hunk ./XMonad/Doc/Extending.hs 217 -* "XMonad.Actions.UpdatePointer": mouse-follows-focus. +* "XMonad.Actions.Promote": + Alternate promote function for xmonad. hunk ./XMonad/Doc/Extending.hs 220 -* "XMonad.Actions.Warp": warp the pointer. +* "XMonad.Actions.RandomBackground": + An action to start terminals with a random background color hunk ./XMonad/Doc/Extending.hs 223 -* "XMonad.Actions.WindowBringer": bring windows to you, and you to - windows. +* "XMonad.Actions.RotSlaves": + Rotate all windows except the master window and keep the focus in + place. hunk ./XMonad/Doc/Extending.hs 227 -* "XMonad.Actions.WindowGo": travel to windows based on various - criteria; conditionally start a program if a window does not exist, - or travel to that window if it does. +* "XMonad.Actions.Search": + A module for easily running Internet searches on web sites through xmonad. + Modeled after the handy Surfraw CLI search tools at . + +* "XMonad.Actions.SimpleDate": + An example external contrib module for XMonad. + Provides a simple binding to dzen2 to print the date as a popup menu. + +* "XMonad.Actions.SinkAll": + Provides a simple binding that pushes all floating windows on the + current workspace back into tiling. Use the more general general + "XMonad.Actions.WithAll" + +* "XMonad.Actions.SpawnOn": + Provides a way to modify a window spawned by a command(e.g shift it to the workspace + it was launched on) by using the _NET_WM_PID property that most windows set on creation. + +* "XMonad.Actions.Submap": + A module that allows the user to create a sub-mapping of key bindings. + +* "XMonad.Actions.SwapWorkspaces": + Lets you swap workspace tags, so you can keep related ones next to + each other, without having to move individual windows. + +* "XMonad.Actions.TagWindows": + Functions for tagging windows and selecting them by tags. + +* "XMonad.Actions.TopicSpace": + Turns your workspaces into a more topic oriented system. + +* "XMonad.Actions.UpdateFocus": + Updates the focus on mouse move in unfocused windows. + +* "XMonadContrib.UpdatePointer": + Causes the pointer to follow whichever window focus changes to. + +* "XMonad.Actions.Warp": + Warp the pointer to a given window or screen. + +* "XMonad.Actions.WindowBringer": + dmenu operations to bring windows to you, and bring you to windows. + That is to say, it pops up a dmenu with window names, in case you forgot + where you left your XChat. + +* "XMonad.Actions.WindowGo": + Defines a few convenient operations for raising (traveling to) windows based on XMonad's Query + monad, such as 'runOrRaise'. + +* "XMonad.Actions.WindowMenu": + Uses "XMonad.Actions.GridSelect" to display a number of actions related to + window management in the center of the focused window. + +* "XMonad.Actions.WindowNavigation": + Experimental rewrite of "XMonad.Layout.WindowNavigation". + +* "XMonad.Actions.WithAll": + Provides functions for performing a given action on all windows of + the current workspace. + +* "XMonad.Actions.WorkspaceCursors": + Like "XMonad.Actions.Plane" for an arbitrary number of dimensions. hunk ./XMonad/Doc/Extending.hs 299 + hunk ./XMonad/Doc/Extending.hs 301 + This module specifies my xmonad defaults. + +* "XMonad.Config.Azerty" + +* "XMonad.Config.Desktop" + This module provides a config suitable for use with a desktop + environment such as KDE or GNOME. hunk ./XMonad/Doc/Extending.hs 309 -* "XMonad.Config.Dons" +* "XMonad.Config.Gnome" hunk ./XMonad/Doc/Extending.hs 311 -* "XMonad.Config.Droundy" +* "XMonad.Config.Kde" hunk ./XMonad/Doc/Extending.hs 315 +* "XMonad.Config.Xfce" + + hunk ./XMonad/Doc/Extending.hs 346 +* "XMonad.Hooks.DynamicHooks": + One-shot and permanent ManageHooks that can be updated at runtime. + hunk ./XMonad/Doc/Extending.hs 354 -* "XMonad.Hooks.EwmhDesktops": support for pagers in panel applications. +* "XMonad.Hooks.EwmhDesktops": + Makes xmonad use the EWMH hints to tell panel applications about its + workspaces and the windows therein. It also allows the user to interact + with xmonad by clicking on panels and window lists. + +* "XMonad.Hooks.FadeInactive": + Makes XMonad set the _NET_WM_WINDOW_OPACITY atom for inactive windows, + which causes those windows to become slightly translucent if something + like xcompmgr is running hunk ./XMonad/Doc/Extending.hs 364 -* "XMonad.Hooks.ManageDocks": handle DOCK and STRUT windows (such as - status bars) appropriately, by de-managing them and creating - appropriate gaps so as not to place other windows covering them. +* "XMonad.Hooks.FloatNext": + Hook and keybindings for automatically sending the next + spawned window(s) to the floating layer. + +* "XMonad.Hooks.InsertPosition": + Configure where new windows should be added and which window should be + focused. + +* "XMonad.Hooks.ManageDocks": + This module provides tools to automatically manage 'dock' type programs, + such as gnome-panel, kicker, dzen, and xmobar. hunk ./XMonad/Doc/Extending.hs 379 +* "XMonad.Hooks.Place": + Automatic placement of floating windows. + +* "XMonad.Hooks.RestoreMinimized": + Lets you restore minimized windows (see "XMonad.Layout.Minimize") + by selecting them on a taskbar (listens for _NET_ACTIVE_WINDOW + and WM_CHANGE_STATE). + +* "XMonad.Hooks.Script": + Provides a simple interface for running a ~\/.xmonad\/hooks script with the + name of a hook. + hunk ./XMonad/Doc/Extending.hs 393 -* "XMonad.Hooks.SetWMName": set the WM name. Useful when e.g. running - Java GUI programs. +* "XMonad.Hooks.SetCursor": + Set a default cursor on startup. + Thanks to Andres Salomon for his initial idea for this startup hook. + +* "XMonad.Hooks.SetWMName": + Sets the WM name to a given string, so that it could be detected using + _NET_SUPPORTING_WM_CHECK protocol. May be useful for making Java GUI + programs work. + +* "XMonad.Hooks.UrgencyHook": + UrgencyHook lets you configure an action to occur when a window demands + your attention. (In traditional WMs, this takes the form of \"flashing\" + on your \"taskbar.\" Blech.) hunk ./XMonad/Doc/Extending.hs 407 -* "XMonad.Hooks.UrgencyHook": configure an action to occur when a window - sets the urgent flag. +* "XMonad.Hooks.WorkspaceByPos": + Useful in a dual-head setup: Looks at the requested geometry of + new windows and moves them to the workspace of the non-focused + screen if necessary. hunk ./XMonad/Doc/Extending.hs 412 -* "XMonad.Hooks.XPropManage": match on XProperties in your - 'XMonad.Core.manageHook'. +* "XMonad.Hooks.XPropManage": + A ManageHook matching on XProperties. hunk ./XMonad/Doc/Extending.hs 434 -* "XMonad.Layout.Accordion": put non-focused windows in ribbons at the - top and bottom of the screen. +* "XMonad.Layout.Accordion": + LayoutClass that puts non-focused windows in ribbons at the top and bottom + of the screen. hunk ./XMonad/Doc/Extending.hs 438 -* "XMonad.Layout.Circle": an elliptical, overlapping layout. +* "XMonad.Layout.AutoMaster": + Provides layout modifier AutoMaster. It separates screen in two parts - + master and slave. Size of slave area automatically changes depending on + number of slave windows. hunk ./XMonad/Doc/Extending.hs 443 -* "XMonad.Layout.Combo": combine multiple layouts into one. +* "XMonad.Layout.BorderResize": + This layout modifier will allow to resize windows by dragging their + borders with the mouse. However, it only works in layouts or modified + layouts that react to the SetGeometry message. + "XMonad.Layout.WindowArranger" can be used to create such a setup. + BorderResize is probably most useful in floating layouts. hunk ./XMonad/Doc/Extending.hs 450 -* "XMonad.Layout.Decoration": decorated layouts. +* "XMonad.Layout.BoringWindows": + BoringWindows is an extension to allow windows to be marked boring hunk ./XMonad/Doc/Extending.hs 453 -* "XMonad.Layout.DecorationMadness": some examples of decorated layouts. +* "XMonad.Layout.CenteredMaster": + Two layout modifiers. centerMaster places master window at center, + on top of all other windows, which are managed by base layout. + topRightMaster is similar, but places master window in top right corner + instead of center. hunk ./XMonad/Doc/Extending.hs 459 -* "XMonad.Layout.Dishes": stack extra windows underneath the master windows. +* "XMonad.Layout.Circle": + Circle is an elliptical, overlapping layout, by Peter De Wachter hunk ./XMonad/Doc/Extending.hs 462 -* "XMonad.Layout.DragPane": split the screen into two windows with a - draggable divider. +* "XMonad.Layout.Column": + Provides Column layout that places all windows in one column. Windows + heights are calculated from equation: H1/H2 = H2/H3 = ... = q, where q is + given. With Shrink/Expand messages you can change the q value. hunk ./XMonad/Doc/Extending.hs 467 -* "XMonad.Layout.DwmStyle": windows decorated in a dwm-like style. +* "XMonad.Layout.Combo": + A layout that combines multiple layouts. hunk ./XMonad/Doc/Extending.hs 470 -* "XMonad.Layout.Grid": put windows in a square grid. +* "XMonad.Layout.ComboP": + A layout that combines multiple layouts and allows to specify where to put + new windows. hunk ./XMonad/Doc/Extending.hs 474 -* "XMonad.Layout.HintedTile": gapless tiled layout that attempts to - obey window size hints. +* "XMonad.Layout.Cross": + A Cross Layout with the main window in the center. hunk ./XMonad/Doc/Extending.hs 477 -* "XMonad.Layout.IM": a layout for multi-window instant message clients. +* "XMonad.Layout.Decoration": + A layout modifier and a class for easily creating decorated + layouts. hunk ./XMonad/Doc/Extending.hs 481 -* "XMonad.Layout.LayoutCombinators": general layout combining. +* "XMonad.Layout.DecorationMadness": + A collection of decorated layouts: some of them may be nice, some + usable, others just funny. hunk ./XMonad/Doc/Extending.hs 485 -* "XMonad.Layout.LayoutHints": make layouts respect window size hints. +* "XMonad.Layout.Dishes": + Dishes is a layout that stacks extra windows underneath the master + windows. hunk ./XMonad/Doc/Extending.hs 489 -* "XMonad.Layout.LayoutModifier": a general framework for creating - layout \"modifiers\"; useful for creating new layout modules. +* "XMonad.Layout.DragPane": + Layouts that splits the screen either horizontally or vertically and + shows two windows. The first window is always the master window, and + the other is either the currently focused window or the second window in + layout order. hunk ./XMonad/Doc/Extending.hs 495 -* "XMonad.Layout.LayoutScreens": divide the screen into multiple - virtual \"screens\". +* "XMonad.Layout.DwmStyle": + A layout modifier for decorating windows in a dwm like style. hunk ./XMonad/Doc/Extending.hs 498 -* "XMonad.Layout.MagicFocus": automagically put the focused window in - the master area. +* "XMonad.Layout.FixedColumn": + A layout much like Tall, but using a multiple of a window's minimum + resize amount instead of a percentage of screen to decide where to + split. This is useful when you usually leave a text editor or + terminal in the master pane and like it to be 80 columns wide. hunk ./XMonad/Doc/Extending.hs 504 -* "XMonad.Layout.Magnifier": increase the size of the focused window +* "XMonad.Layout.Gaps": + Create manually-sized gaps along edges of the screen which will not + be used for tiling, along with support for toggling gaps on and + off. You probably want "XMonad.Hooks.ManageDocks". hunk ./XMonad/Doc/Extending.hs 509 -* "XMonad.Layout.Maximize": temporarily maximize the focused window. +* "XMonad.Layout.Grid": + A simple layout that attempts to put all windows in a square grid. hunk ./XMonad/Doc/Extending.hs 512 -* "XMonad.Layout.MosaicAlt": give each window a specified relative - amount of screen space. +* "XMonad.Layout.GridVariants": + Two layouts: one is a variant of the Grid layout that allows the + desired aspect ratio of windows to be specified. The other is like + Tall but places a grid with fixed number of rows and columns in the + master area and uses an aspect-ratio-specified layout for the + slaves. hunk ./XMonad/Doc/Extending.hs 519 -* "XMonad.Layout.MultiToggle": dynamically apply and unapply layout - transformers. +* "XMonad.Layout.HintedGrid": + A not so simple layout that attempts to put all windows in a square grid + while obeying their size hints. hunk ./XMonad/Doc/Extending.hs 523 -* "XMonad.Layout.Named": change the names of layouts (as reported by - e.g. "XMonad.Hooks.DynamicLog"). +* "XMonad.Layout.HintedTile": + A gapless tiled layout that attempts to obey window size hints, + rather than simply ignoring them. hunk ./XMonad/Doc/Extending.hs 527 -* "XMonad.Layout.NoBorders": display windows without borders. +* "XMonad.Layout.IM": + Layout modfier suitable for workspace with multi-windowed instant messenger + (like Psi or Tkabber). hunk ./XMonad/Doc/Extending.hs 531 -* "XMonad.Layout.PerWorkspace": configure layouts on a per-workspace basis. +* "XMonad.Layout.IndependentScreens": + Utility functions for simulating independent sets of workspaces on + each screen (like dwm's workspace model), using internal tags to + distinguish workspaces associated with each screen. hunk ./XMonad/Doc/Extending.hs 536 -* "XMonad.Layout.Reflect": reflect any layout vertically or horizontally. +* "XMonad.Layout.LayoutBuilder": + A layout combinator that sends a specified number of windows to one rectangle + and the rest to another. hunk ./XMonad/Doc/Extending.hs 540 -* "XMonad.Layout.ResizableTile": tiled layout allowing you to change - width and height of windows. +* "XMonad.Layout.LayoutCombinators": + The "XMonad.Layout.LayoutCombinators" module provides combinators + for easily combining multiple layouts into one composite layout, as + well as a way to jump directly to any particular layout (say, with + a keybinding) without having to cycle through other layouts to get + to it. hunk ./XMonad/Doc/Extending.hs 547 -* "XMonad.Layout.ResizeScreen": a layout modifier to change the screen - geometry on one side. +* "XMonad.Layout.LayoutHints": + Make layouts respect size hints. hunk ./XMonad/Doc/Extending.hs 550 -* "XMonad.Layout.Roledex": a \"completely pointless layout which acts - like Microsoft's Flip 3D\". +* "XMonad.Layout.LayoutModifier": + A module for writing easy layout modifiers, which do not define a + layout in and of themselves, but modify the behavior of or add new + functionality to other layouts. If you ever find yourself writing + a layout which takes another layout as a parameter, chances are you + should be writing a LayoutModifier instead! + + In case it is not clear, this module is not intended to help you + configure xmonad, it is to help you write other extension modules. + So get hacking! hunk ./XMonad/Doc/Extending.hs 561 -* "XMonad.Layout.ScratchWorkspace": implements a scratch workspace - which can be shown and hidden with keybindings. +* "XMonad.Layout.LayoutScreens": + Divide a single screen into multiple screens. hunk ./XMonad/Doc/Extending.hs 564 -* "XMonad.Layout.ShowWName": Show the name of the current workspace when switching. +* "XMonad.Layout.LimitWindows": + A layout modifier that limits the number of windows that can be shown. hunk ./XMonad/Doc/Extending.hs 567 -* "XMonad.Layout.SimpleDecoration": add simple decorations to windows. +* "XMonad.Layout.MagicFocus": + Automagically put the focused window in the master area. hunk ./XMonad/Doc/Extending.hs 570 -* "XMonad.Layout.SimpleFloat": a basic floating layout. +* "XMonad.Layout.Magnifier": + Screenshot : + This is a layout modifier that will make a layout increase the size + of the window that has focus. hunk ./XMonad/Doc/Extending.hs 575 -* "XMonad.Layout.Simplest": a basic, simple layout that just lays out - all windows with a fullscreen geometry. Used by - "XMonad.Layout.Tabbed". +* "XMonad.Layout.Master": + Layout modfier that adds a master window to another layout. hunk ./XMonad/Doc/Extending.hs 578 -* "XMonad.Layout.Spiral": Fibonacci spiral layout. +* "XMonad.Layout.Maximize": + Temporarily yanks the focused window out of the layout to mostly fill + the screen. hunk ./XMonad/Doc/Extending.hs 582 -* "XMonad.Layout.Square": split the screen into a square area plus the rest. +* "XMonad.Layout.MessageControl": + Provides message escaping and filtering facilities which + help control complex nested layouts. hunk ./XMonad/Doc/Extending.hs 586 -* "XMonad.Layout.TabBarDecoration": add a bar of tabs to any layout. +* "XMonad.Layout.Minimize": + Makes it possible to minimize windows, temporarily removing them + from the layout until they are restored. hunk ./XMonad/Doc/Extending.hs 590 -* "XMonad.Layout.Tabbed": a tabbed layout. +* "XMonad.Layout.Monitor": + Layout modfier for displaying some window (monitor) above other windows hunk ./XMonad/Doc/Extending.hs 593 -* "XMonad.Layout.ThreeColumns": a layout with three columns instead of two. +* "XMonad.Layout.Mosaic": + Based on MosaicAlt, but aspect ratio messages always change the aspect + ratios, and rearranging the window stack changes the window sizes. hunk ./XMonad/Doc/Extending.hs 597 -* "XMonad.Layout.ToggleLayouts": toggle between two layouts. +* "XMonad.Layout.MosaicAlt": + A layout which gives each window a specified amount of screen space + relative to the others. Compared to the 'Mosaic' layout, this one + divides the space in a more balanced way. hunk ./XMonad/Doc/Extending.hs 602 -* "XMonad.Layout.TwoPane": split the screen horizontally and show two - windows. +* "XMonad.Layout.MouseResizableTile": + A layout in the spirit of "XMonad.Layout.ResizableTile", but with the option + to use the mouse to adjust the layout. hunk ./XMonad/Doc/Extending.hs 606 -* "XMonad.Layout.WindowArranger": make any layout into a - pseudo-floating layout by allowing you to move and resize windows. +* "XMonad.Layout.MultiToggle": + Dynamically apply and unapply transformers to your window layout. This can + be used to rotate your window layout by 90 degrees, or to make the + currently focused window occupy the whole screen (\"zoom in\") then undo + the transformation (\"zoom out\"). hunk ./XMonad/Doc/Extending.hs 612 -* "XMonad.Layout.WindowNavigation": navigate around a workspace - directionally instead of using mod-j\/k. +* "XMonad.Layout.Named": + A module for assigning a name to a given layout. hunk ./XMonad/Doc/Extending.hs 615 -* "XMonad.Layout.WorkspaceDir": set the current working directory in a - workspace. +* "XMonad.Layout.NoBorders": + Make a given layout display without borders. This is useful for + full-screen or tabbed layouts, where you don't really want to waste a + couple of pixels of real estate just to inform yourself that the visible + window has focus. + +* "XMonad.Layout.NoFrillsDecoration": + Most basic version of decoration for windows without any additional + modifications. In contrast to "XMonad.Layout.SimpleDecoration" this will + result in title bars that span the entire window instead of being only the + length of the window title. + +* "XMonad.Layout.OneBig": + Provides layout named OneBig. It places one (master) window at top left corner of screen, and other (slave) windows at top + +* "XMonad.Layout.PerWorkspace": + Configure layouts on a per-workspace basis: use layouts and apply + layout modifiers selectively, depending on the workspace. + +* "XMonad.Layout.Reflect": + Reflect a layout horizontally or vertically. + +* "XMonad.Layout.ResizableTile": + More useful tiled layout that allows you to change a width\/height of window. + +* "XMonad.Layout.ResizeScreen": + A layout transformer to have a layout respect a given screen + geometry. Mostly used with "Decoration" (the Horizontal and the + Vertical version will react to SetTheme and change their dimension + accordingly. + +* "XMonad.Layout.Roledex": + This is a completely pointless layout which acts like Microsoft's Flip 3D + +* "XMonad.Layout.ShowWName": + This is a layout modifier that will show the workspace name + +* "XMonad.Layout.SimpleDecoration": + A layout modifier for adding simple decorations to the windows of a + given layout. The decorations are in the form of ion-like tabs + for window titles. + +* "XMonad.Layout.SimpleFloat": + A basic floating layout. + +* "XMonad.Layout.Simplest": + A very simple layout. The simplest, afaik. + +* "XMonad.Layout.SimplestFloat": + A basic floating layout like SimpleFloat but without the decoration. + +* "XMonad.Layout.Spacing": + Add a configurable amount of space around windows. + +* "XMonad.Layout.Spiral": + A spiral tiling layout. + +* "XMonad.Layout.Square": + A layout that splits the screen into a square area and the rest of the + screen. + This is probably only ever useful in combination with + "XMonad.Layout.Combo". + It sticks one window in a square region, and makes the rest + of the windows live with what's left (in a full-screen sense). + +* "XMonad.Layout.StackTile": + A stacking layout, like dishes but with the ability to resize master pane. + Mostly useful on small screens. + +* "XMonad.Layout.SubLayouts": + A layout combinator that allows layouts to be nested. + +* "XMonad.Layout.TabBarDecoration": + A layout modifier to add a bar of tabs to your layouts. + +* "XMonad.Layout.Tabbed": + A tabbed layout for the Xmonad Window Manager + +* "XMonad.Layout.ThreeColumns": + A layout similar to tall but with three columns. With 2560x1600 pixels this + layout can be used for a huge main window and up to six reasonable sized + slave windows. + +* "XMonad.Layout.ToggleLayouts": + A module to toggle between two layouts. + +* "XMonad.Layout.TwoPane": + A layout that splits the screen horizontally and shows two windows. The + left window is always the master window, and the right is either the + currently focused window or the second window in layout order. + +* "XMonad.Layout.WindowArranger": + This is a pure layout modifier that will let you move and resize + windows with the keyboard in any layout. + +* "XMonad.Layout.WindowNavigation": + WindowNavigation is an extension to allow easy navigation of a workspace. + +* "XMonad.Layout.WorkspaceDir": + WorkspaceDir is an extension to set the current directory in a workspace. + Actually, it sets the current directory in a layout, since there's no way I + know of to attach a behavior to a workspace. This means that any terminals + (or other programs) pulled up in that workspace (with that layout) will + execute in that working directory. Sort of handy, I think. + Note this extension requires the 'directory' package to be installed. hunk ./XMonad/Doc/Extending.hs 734 -* "XMonad.Prompt.AppendFile": append lines of text to a file. +* "XMonad.Prompt.AppLauncher": + A module for launch applicationes that receive parameters in the command + line. The launcher call a prompt to get the parameters. hunk ./XMonad/Doc/Extending.hs 738 -* "XMonad.Prompt.Directory": prompt for a directory. +* "XMonad.Prompt.AppendFile": + A prompt for appending a single line of text to a file. Useful for + keeping a file of notes, things to remember for later, and so on--- + using a keybinding, you can write things down just about as quickly + as you think of them, so it doesn't have to interrupt whatever else + you're doing. + Who knows, it might be useful for other purposes as well! hunk ./XMonad/Doc/Extending.hs 746 -* "XMonad.Prompt.DirExec": put a bunch of scripts you want in a - directory, then choose from among them with this prompt. +* "XMonad.Prompt.DirExec": + A directory file executables prompt for XMonad. This might be useful if you + don't want to have scripts in your PATH environment variable (same + executable names, different behavior) - otherwise you might want to use + "XMonad.Prompt.Shell" instead - but you want to have easy access to these + executables through the xmonad's prompt. hunk ./XMonad/Doc/Extending.hs 753 -* "XMonad.Prompt.Email": an example of "XMonad.Prompt.Input", send - simple short e-mails from a prompt. +* "XMonad.Prompt.Directory": + A directory prompt for XMonad hunk ./XMonad/Doc/Extending.hs 756 -* "XMonad.Prompt.Input": useful for building general actions requiring - input from a prompt. +* "XMonad.Prompt.Email": + A prompt for sending quick, one-line emails, via the standard GNU + \'mail\' utility (which must be in your $PATH). This module is + intended mostly as an example of using "XMonad.Prompt.Input" to + build an action requiring user input. hunk ./XMonad/Doc/Extending.hs 762 -* "XMonad.Prompt.Layout": choose a layout from a prompt. +* "XMonad.Prompt.Input": + A generic framework for prompting the user for input and passing it + along to some other action. hunk ./XMonad/Doc/Extending.hs 766 -* "XMonad.Prompt.Man": open man pages. +* "XMonad.Prompt.Layout": + A layout-selection prompt for XMonad hunk ./XMonad/Doc/Extending.hs 769 -* "XMonad.Prompt.RunOrRaise": choose a program, and run it if not - already running, or raise its window if it is. +* "XMonad.Prompt.Man": + A manual page prompt for XMonad window manager. + TODO + * narrow completions by section number, if the one is specified + (like @\/etc\/bash_completion@ does) hunk ./XMonad/Doc/Extending.hs 775 -* "XMonad.Prompt.Shell": run a shell command. +* "XMonad.Prompt.RunOrRaise": + A prompt for XMonad which will run a program, open a file, + or raise an already running program, depending on context. hunk ./XMonad/Doc/Extending.hs 779 -* "XMonad.Prompt.Ssh": open an ssh connection. +* "XMonad.Prompt.Shell": + A shell prompt for XMonad hunk ./XMonad/Doc/Extending.hs 782 -* "XMonad.Prompt.Theme": choose a decoration theme. +* "XMonad.Prompt.Ssh": + A ssh prompt for XMonad hunk ./XMonad/Doc/Extending.hs 785 -* "XMonad.Prompt.Window": choose an open window. +* "XMonad.Prompt.Theme": + A prompt for changing the theme of the current workspace hunk ./XMonad/Doc/Extending.hs 788 -* "XMonad.Prompt.Workspace": choose a workspace. +* "XMonad.Prompt.Window": + xprompt operations to bring windows to you, and bring you to windows. hunk ./XMonad/Doc/Extending.hs 791 -* "XMonad.Prompt.XMonad": perform various xmonad actions by choosing - one from a prompt. +* "XMonad.Prompt.Workspace": + A workspace prompt for XMonad + +* "XMonad.Prompt.XMonad": + A prompt for running XMonad commands hunk ./XMonad/Doc/Extending.hs 817 -* "XMonad.Util.Dmenu": a dmenu binding. +* "XMonad.Util.Dmenu": + A convenient binding to dmenu. + Requires the process-1.0 package hunk ./XMonad/Doc/Extending.hs 821 -* "XMonad.Util.Dzen" "XMonad.Util.Dmenu" provide useful functions for - running dzen as a xmonad status bar and dmenu as a program launcher; +* "XMonad.Util.Dzen": + Handy wrapper for dzen. Requires dzen >= 0.2.4. hunk ./XMonad/Doc/Extending.hs 830 -* "XMonad.Util.Invisible": a wrapper data type to store layout state - which should not be persisted across restarts. +* "XMonad.Util.Invisible": + A data type to store the layout state + +* "XMonad.Util.Loggers": + A collection of simple logger functions and formatting utilities + which can be used in the 'XMonad.Hooks.DynamicLog.ppExtras' field of + a pretty-printing status logger format. See "XMonad.Hooks.DynamicLog" + for more information. + +* "XMonad.Util.NamedActions": + A wrapper for keybinding configuration that can list the available + keybindings. + +* "XMonad.Util.NamedScratchpad": + Named scratchpads that support several arbitrary applications at the same time. + +* "XMonad.Util.NamedWindows": + This module allows you to associate the X titles of windows with + them. hunk ./XMonad/Doc/Extending.hs 850 -* "XMonad.Util.Loggers": a collection of loggers that can be used in - conjunction with "XMonad.Hooks.DynamicLog". +* "XMonad.Util.Paste": + A module for sending key presses to windows. This modules provides generalized + and specialized functions for this task. hunk ./XMonad/Doc/Extending.hs 854 -* "XMonad.Util.NamedWindows": associate windows with their X titles. - Used by, e.g. "XMonad.Layout.Tabbed". +* "XMonad.Util.Replace": + Implements a @--replace@ flag outside of core. hunk ./XMonad/Doc/Extending.hs 857 -* "XMonad.Util.Run": a collection of functions for running external - processes. +* "XMonad.Util.Run": + This modules provides several commands to run an external process. + It is composed of functions formerly defined in "XMonad.Util.Dmenu" (by + Spencer Janssen), "XMonad.Util.Dzen" (by glasser\@mit.edu) and + XMonad.Util.RunInXTerm (by Andrea Rossato). hunk ./XMonad/Doc/Extending.hs 863 -* "XMonad.Util.Scratchpad": hotkey-launched floating terminal window. +* "XMonad.Util.Scratchpad": + Very handy hotkey-launched floating terminal window. hunk ./XMonad/Doc/Extending.hs 866 -* "XMonad.Util.Themes": a collection of themes to be used with - floating layouts. +* "XMonad.Util.StringProp": + Internal utility functions for storing Strings with the root window. + Used for global state like IORefs with string keys, but more latency, + persistent between xmonad restarts. hunk ./XMonad/Doc/Extending.hs 871 -* "XMonad.Util.Timer": set up a timer to handle deferred events. +* "XMonad.Util.Themes": + A (hopefully) growing collection of themes for decorated layouts. hunk ./XMonad/Doc/Extending.hs 874 -* "XMonad.Util.WindowProperties": an EDSL for specifying and matching - on window properties. +* "XMonad.Util.Timer": + A module for setting up timers hunk ./XMonad/Doc/Extending.hs 877 -* "XMonad.Util.WorkspaceCompare": general combinators for sorting - workspaces in various ways, used by several other modules which need - to sort workspaces (e.g. "XMonad.Hooks.DynamicLog"). +* "XMonad.Util.Types": + Miscellaneous commonly used types. hunk ./XMonad/Doc/Extending.hs 880 -* "XMonad.Util.Paste" provides utilities for pasting or sending keys and - strings to windows; +* "XMonad.Util.WindowProperties": + EDSL for specifying window properties; various utilities related to window + properties. hunk ./XMonad/Doc/Extending.hs 884 -* "XMonad.Util.XSelection" provide utilities for using the mouse - selection; +* "XMonad.Util.XSelection": + A module for accessing and manipulating X Window's mouse selection (the buffer used in copy and pasting). + 'getSelection' and 'putSelection' are adaptations of Hxsel.hs and Hxput.hs from the XMonad-utils hunk ./XMonad/Doc/Extending.hs 888 -* "XMonad.Util.XUtils" and "XMonad.Util.Font" are libraries for - accessing Xlib and XFT function in a convenient way. +* "XMonad.Util.XUtils": + A module for painting on the screen addfile ./scripts/grabDescriptions.hs hunk ./scripts/grabDescriptions.hs 1 +#!/usr/bin/env runhaskell + +import Control.Applicative +import Control.Arrow +import Control.Monad +import Data.Char +import Data.List +import Data.Maybe +import System.Directory +import System.Environment + +-- needs haskell-src-exts +import qualified Language.Haskell.Exts.Annotated as H + +getComments = (fmap . fmap) (map (\(H.Comment _ _ x) -> x) . snd) + . H.parseFileWithComments H.defaultParseMode + +-- | Used to grab the description fields from all the modules in the current +-- directory for updating XMonad.Docs.Extending +main = putStrLn . intercalate "\n" + =<< mapM (fmap . handleFailure description <*> getComments) =<< filterM doesFileExist . sort + =<< getDirectoryContents . fromMaybe "." . listToMaybe + =<< getArgs -- somehow only the "." fallback works... + +handleFailure :: (String -> [String] -> String) -> String -> H.ParseResult [String] -> String +handleFailure f n (H.ParseOk x) = f n x +handleFailure f n (H.ParseFailed _ msg) = n ++ " Parse Failure: " ++ msg + +description :: String -> [String] -> String +description path xs = + let (hs,desc) + = uncurry (\x (y,descr) -> (x++y,takeWhile (not . or . sequence [null,("* Usage" `isInfixOf`),all (=='-'),all isSpace]) . dropWhile (all isSpace) $ descr)) + . second (splitAt 1) + . break (isPrefixOf "Portability") + . map (dropWhile isSpace) $ concatMap lines xs + modName = maybe path (takeWhile (not . isSpace) . dropWhile isSpace . drop 1 . dropWhile (/=':')) $ find ("Module" `isInfixOf`) hs + in "* \""++modName++"\":\n"++unlines (map (" "++) desc) addfile ./XMonad/Util/Replace.hs hunk ./XMonad/Util/Replace.hs 1 +{-# LANGUAGE DeriveDataTypeable #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Replace +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Adam Vogt +-- Stability : unstable +-- Portability : unportable +-- +-- Implements a @--replace@ behavior outside of core. +-- +----------------------------------------------------------------------------- + +-- refer to core patches: +-- http://article.gmane.org/gmane.comp.lang.haskell.xmonad/8358 +module XMonad.Util.Replace + ( -- * Usage + -- $usage + replace + + -- * Notes + -- $shortcomings + + -- ** Implementing a @--replace@ flag + -- $getArgs + ) where + +import XMonad +import Data.Function +import Control.Monad + +-- $usage +-- You must run the 'replace' action before starting xmonad proper, this +-- results in xmonad replacing the currently running WM regardless of the +-- arguments it is run with: +-- +-- > import XMonad +-- > import XMonad.Util.Replace +-- > main = do +-- > replace +-- > xmonad $ defaultConfig { .... } +-- + +-- $shortcomings +-- This doesn't seem to work for replacing WMs that have been started +-- from within xmonad, such as with @'restart' "openbox" False@, but no other +-- WMs that implements --replace manage this either. 'replace' works for +-- replacing metacity when the full gnome-session is started at least. + +-- $getArgs +-- You can use 'System.Environment.getArgs' to watch for an explicit +-- @--replace@ flag: +-- +-- > import XMonad +-- > import XMonad.Util.Replace (replace) +-- > import Control.Monad (when) +-- > import System.Environment (getArgs) +-- > +-- > main = do +-- > args <- getArgs +-- > when ("--replace" `elem` args) replace +-- > xmonad $ defaultConfig { .... } +-- +-- +-- Note that your @~\/.xmonad/xmonad-$arch-$os@ binary is not run with the same +-- flags as the @xmonad@ binary that calls it. You may be able to work around +-- this by running your @~\/.xmonad/xmonad-$arch-$os@ binary directly, which is +-- otherwise not recommended. + +-- | @replace@ must be run before xmonad starts to signals to compliant window +-- managers that they must exit and let xmonad take over. +replace :: IO () +replace = do + dpy <- openDisplay "" + let dflt = defaultScreen dpy + + rootw <- rootWindow dpy dflt + + -- check for other WM + wmSnAtom <- internAtom dpy ("WM_S" ++ (show dflt)) False + currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom + when (currentWmSnOwner /= 0) $ do + putStrLn $ "Screen " ++ (show dflt) ++ " on display \"" + ++ (displayString dpy) ++ "\" already has a window manager." + + -- prepare to receive destroyNotify for old WM + selectInput dpy currentWmSnOwner structureNotifyMask + + -- create off-screen window + netWmSnOwner <- allocaSetWindowAttributes $ \attributes -> do + set_override_redirect attributes True + set_event_mask attributes propertyChangeMask + let screen = defaultScreenOfDisplay dpy + let visual = defaultVisualOfScreen screen + let attrmask = cWOverrideRedirect .|. cWEventMask + createWindow dpy rootw (-100) (-100) 1 1 0 copyFromParent copyFromParent visual attrmask attributes + + -- try to acquire wmSnAtom, this should signal the old WM to terminate + putStrLn $ "Replacing existing window manager..." + xSetSelectionOwner dpy wmSnAtom netWmSnOwner currentTime + + -- SKIPPED: check if we acquired the selection + -- SKIPPED: send client message indicating that we are now the WM + + -- wait for old WM to go away + putStr $ "Waiting for other window manager to terminate... " + fix $ \again -> do + evt <- allocaXEvent $ \event -> do + windowEvent dpy currentWmSnOwner structureNotifyMask event + get_EventType event + + when (evt /= destroyNotify) again + putStrLn $ "done" + closeDisplay dpy hunk ./xmonad-contrib.cabal 238 + XMonad.Util.Replace addfile ./XMonad/Layout/BorderResize.hs hunk ./XMonad/Layout/BorderResize.hs 1 +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-} +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.BorderResize +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- This layout modifier will allow to resize windows by dragging their +-- borders with the mouse. However, it only works in layouts or modified +-- layouts that react to the SetGeometry message. +-- "XMonad.Layout.WindowArranger" can be used to create such a setup. +-- BorderResize is probably most useful in floating layouts. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.BorderResize + ( -- * Usage + -- $usage + borderResize + , BorderResize (..) + ) where + +import XMonad +import XMonad.Layout.Decoration +import XMonad.Layout.WindowArranger +import XMonad.Util.XUtils +import Control.Monad(when,forM) + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.BorderResize +-- > myLayout = borderResize (... layout setup that reacts to SetGeometry ...) +-- > main = xmonad defaultConfig { layoutHook = myLayout } +-- + +data BorderInfo = RightSideBorder Window Rectangle + | LeftSideBorder Window Rectangle + | TopSideBorder Window Rectangle + | BottomSideBorder Window Rectangle + deriving (Show, Read, Eq) +type BorderWithRect = (Rectangle, Rectangle, Glyph, BorderInfo) +type BorderWithWin = (Window, BorderInfo) + +data BorderResize a = BR [BorderWithWin] deriving (Show, Read) + +brBorderOffset :: Position +brBorderOffset = 5 +brBorderSize :: Dimension +brBorderSize = 10 + +brCursorRightSide :: Glyph +brCursorRightSide = 96 +brCursorLeftSide :: Glyph +brCursorLeftSide = 70 +brCursorTopSide :: Glyph +brCursorTopSide = 138 +brCursorBottomSide :: Glyph +brCursorBottomSide = 16 + +borderResize :: l a -> ModifiedLayout BorderResize l a +borderResize = ModifiedLayout (BR []) + +instance LayoutModifier BorderResize Window where + redoLayout _ _ Nothing wrs = return (wrs, Nothing) + redoLayout (BR borders) _ _ wrs = + let preparedBorders = for wrs $ \wr -> (wr, prepareBorders wr) + in do + mapM_ deleteBorder borders + newBorders <- forM preparedBorders $ \(wr, (b1, b2, b3, b4)) -> do + (b1WR, b1BWW) <- createBorder b1 + (b2WR, b2BWW) <- createBorder b2 + (b3WR, b3BWW) <- createBorder b3 + (b4WR, b4BWW) <- createBorder b4 + return ([b1WR, b2WR, b3WR, b4WR, wr], + [b1BWW, b2BWW, b3BWW, b4BWW]) + let wrs' = concat $ map fst newBorders + newBordersSerialized = concat $ map snd newBorders + return (wrs', Just $ BR newBordersSerialized) + -- What we return is the original wrs with the new border + -- windows inserted at the correct positions - this way, the core + -- will restack the borders correctly. + -- We also return information about our borders, so that we + -- can handle events that they receive and destroy them when + -- they are no longer needed. + + handleMess (BR borders) m + | Just e <- fromMessage m :: Maybe Event = handleResize borders e >> return Nothing + | Just Hide <- fromMessage m = releaseResources >> return (Just $ BR []) + | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ BR []) + where releaseResources = mapM_ deleteBorder borders + handleMess _ _ = return Nothing + +prepareBorders :: (Window, Rectangle) -> (BorderWithRect, BorderWithRect, BorderWithRect, BorderWithRect) +prepareBorders (w, r@(Rectangle x y wh ht)) = + ((r, (Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht) , brCursorRightSide , RightSideBorder w r), + (r, (Rectangle (x - brBorderOffset) y brBorderSize ht) , brCursorLeftSide , LeftSideBorder w r), + (r, (Rectangle x (y - brBorderOffset) wh brBorderSize) , brCursorTopSide , TopSideBorder w r), + (r, (Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize) , brCursorBottomSide , BottomSideBorder w r) + ) + +handleResize :: [BorderWithWin] -> Event -> X () +handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et } + | et == buttonPress = do + case (lookup ew borders) of + Just (RightSideBorder hostWin (Rectangle hx hy _ hht)) -> do + mouseDrag (\x _ -> do + let nwh = max 1 $ fi (x - hx) + rect = Rectangle hx hy nwh hht + focus hostWin + when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) + Just (LeftSideBorder hostWin (Rectangle hx hy hwh hht)) -> do + mouseDrag (\x _ -> do + let nx = max 0 $ min (hx + fi hwh) $ x + nwh = max 1 $ hwh + fi (hx - x) + rect = Rectangle nx hy nwh hht + focus hostWin + when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin) + Just (TopSideBorder hostWin (Rectangle hx hy hwh hht)) -> do + mouseDrag (\_ y -> do + let ny = max 0 $ min (hy + fi hht) $ y + nht = max 1 $ hht + fi (hy - y) + rect = Rectangle hx ny hwh nht + focus hostWin + when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin) + Just (BottomSideBorder hostWin (Rectangle hx hy hwh _)) -> do + mouseDrag (\_ y -> do + let nht = max 1 $ fi (y - hy) + rect = Rectangle hx hy hwh nht + focus hostWin + when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) + Nothing -> return () +handleResize _ _ = return () + +createBorder :: BorderWithRect -> X (((Window, Rectangle), BorderWithWin)) +createBorder (_, borderRect, borderCursor, borderInfo) = do + borderWin <- createInputWindow borderCursor borderRect + return ((borderWin, borderRect), (borderWin, borderInfo)) + +deleteBorder :: BorderWithWin -> X () +deleteBorder (borderWin, _) = deleteWindow borderWin + +createInputWindow :: Glyph -> Rectangle -> X Window +createInputWindow cursorGlyph r = withDisplay $ \d -> do + win <- mkInputWindow d r + io $ selectInput d win (exposureMask .|. buttonPressMask) + cursor <- io $ createFontCursor d cursorGlyph + io $ defineCursor d win cursor + io $ freeCursor d cursor + showWindow win + return win + +mkInputWindow :: Display -> Rectangle -> X Window +mkInputWindow d (Rectangle x y w h) = do + rw <- asks theRoot + let screen = defaultScreenOfDisplay d + visual = defaultVisualOfScreen screen + attrmask = cWOverrideRedirect + io $ allocaSetWindowAttributes $ + \attributes -> do + set_override_redirect attributes True + createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes + +for :: [a] -> (a -> b) -> [b] +for = flip map hunk ./xmonad-contrib.cabal 138 + XMonad.Layout.BorderResize hunk ./XMonad/Layout/BorderResize.hs 14 --- layouts that react to the SetGeometry message. +-- layouts that react to the 'SetGeometry' message. hunk ./XMonad/Layout/BorderResize.hs 32 +import Control.Arrow(first) +import Control.Applicative((<$>)) hunk ./XMonad/Layout/BorderResize.hs 73 - redoLayout (BR borders) _ _ wrs = + redoLayout (BR borders) _ _ wrs = do hunk ./XMonad/Layout/BorderResize.hs 75 - in do - mapM_ deleteBorder borders - newBorders <- forM preparedBorders $ \(wr, (b1, b2, b3, b4)) -> do - (b1WR, b1BWW) <- createBorder b1 - (b2WR, b2BWW) <- createBorder b2 - (b3WR, b3BWW) <- createBorder b3 - (b4WR, b4BWW) <- createBorder b4 - return ([b1WR, b2WR, b3WR, b4WR, wr], - [b1BWW, b2BWW, b3BWW, b4BWW]) - let wrs' = concat $ map fst newBorders - newBordersSerialized = concat $ map snd newBorders - return (wrs', Just $ BR newBordersSerialized) - -- What we return is the original wrs with the new border - -- windows inserted at the correct positions - this way, the core - -- will restack the borders correctly. - -- We also return information about our borders, so that we - -- can handle events that they receive and destroy them when - -- they are no longer needed. + mapM_ deleteBorder borders + newBorders <- forM preparedBorders $ \(wr, (b1, b2, b3, b4)) -> + first (++[wr]) . unzip <$> mapM createBorder [b1,b2,b3,b4] + let wrs' = concat $ map fst newBorders + newBordersSerialized = concat $ map snd newBorders + return (wrs', Just $ BR newBordersSerialized) + -- What we return is the original wrs with the new border + -- windows inserted at the correct positions - this way, the core + -- will restack the borders correctly. + -- We also return information about our borders, so that we + -- can handle events that they receive and destroy them when + -- they are no longer needed. hunk ./XMonad/Layout/BorderResize.hs 90 - | Just Hide <- fromMessage m = releaseResources >> return (Just $ BR []) - | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ BR []) - where releaseResources = mapM_ deleteBorder borders + | Just _ <- fromMessage m :: Maybe LayoutMessages = + mapM_ deleteBorder borders >> return (Just $ BR []) hunk ./XMonad/Layout/BorderResize.hs 104 - | et == buttonPress = do - case (lookup ew borders) of - Just (RightSideBorder hostWin (Rectangle hx hy _ hht)) -> do - mouseDrag (\x _ -> do - let nwh = max 1 $ fi (x - hx) - rect = Rectangle hx hy nwh hht - focus hostWin - when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) - Just (LeftSideBorder hostWin (Rectangle hx hy hwh hht)) -> do - mouseDrag (\x _ -> do - let nx = max 0 $ min (hx + fi hwh) $ x - nwh = max 1 $ hwh + fi (hx - x) - rect = Rectangle nx hy nwh hht - focus hostWin - when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin) - Just (TopSideBorder hostWin (Rectangle hx hy hwh hht)) -> do - mouseDrag (\_ y -> do - let ny = max 0 $ min (hy + fi hht) $ y - nht = max 1 $ hht + fi (hy - y) - rect = Rectangle hx ny hwh nht - focus hostWin - when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin) - Just (BottomSideBorder hostWin (Rectangle hx hy hwh _)) -> do - mouseDrag (\_ y -> do - let nht = max 1 $ fi (y - hy) - rect = Rectangle hx hy hwh nht - focus hostWin - when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) - Nothing -> return () + | et == buttonPress, Just edge <- lookup ew borders = + case edge of + RightSideBorder hostWin (Rectangle hx hy _ hht) -> + mouseDrag (\x _ -> do + let nwh = max 1 $ fi (x - hx) + rect = Rectangle hx hy nwh hht + focus hostWin + when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) + LeftSideBorder hostWin (Rectangle hx hy hwh hht) -> + mouseDrag (\x _ -> do + let nx = max 0 $ min (hx + fi hwh) $ x + nwh = max 1 $ hwh + fi (hx - x) + rect = Rectangle nx hy nwh hht + focus hostWin + when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin) + TopSideBorder hostWin (Rectangle hx hy hwh hht) -> + mouseDrag (\_ y -> do + let ny = max 0 $ min (hy + fi hht) $ y + nht = max 1 $ hht + fi (hy - y) + rect = Rectangle hx ny hwh nht + focus hostWin + when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin) + BottomSideBorder hostWin (Rectangle hx hy hwh _) -> + mouseDrag (\_ y -> do + let nht = max 1 $ fi (y - hy) + rect = Rectangle hx hy hwh nht + focus hostWin + when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) hunk ./XMonad/Prompt.hs 78 -import Data.Bits ((.&.),complement) +import Data.Bits hunk ./XMonad/Prompt.hs 338 - return (complement (numlock .|. lockMask) .&. msk) + let highMasks = 1 `shiftL` 12 - 1 + return (complement (numlock .|. lockMask) .&. msk .&. highMasks) addfile ./XMonad/Layout/Selective.hs hunk ./XMonad/Layout/Selective.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Selective +-- Copyright : (c) 2009 Max Rabkin +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Max Rabkin +-- Stability : unstable +-- Portability : unportable +-- +-- Provides a layout modifier that only shows the master pane and windows +-- around the focussed window. +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE MultiParamTypeClasses, + FlexibleInstances, + NoMonomorphismRestriction, + NamedFieldPuns #-} + +module XMonad.Layout.Selective where + +import XMonad.Core +import XMonad.StackSet +import XMonad.Layout.LayoutModifier +import Control.Applicative ((<$>)) + +-- invariant: 0 <= nMaster <= start; 0 <= nRest +data Selection = Sel { nMaster :: Int, start :: Int, nRest :: Int } + deriving (Read, Show, Eq) + +select :: Selection -> Stack a -> Stack a +select (Sel { nMaster, start, nRest }) stk + | lups < nMaster + = stk { down=take (nMaster - lups - 1) downs ++ + (take nRest . drop (start - lups - 1) $ downs) } + | otherwise + = stk { up=reverse (take nMaster ups ++ drop start ups), + down=take (nRest - (lups - start) - 1) downs } + where + downs = down stk + ups = reverse $ up stk + lups = length ups + +{- +select :: Selection -> Stack a -> (Selection, Stack a) +select sel@(Sel { nMaster, start, nRest }) stk + | lups < nMaster -- the focussed window is in the master pane + = let start' = start `min` (lups + ldown - nRest + 1) + `max` nMaster + in (sel { start=start' }, + stk { down=take (nMaster - lups - 1) downs ++ + (take nRest . drop (start' - lups - 1) $ downs) }) + | otherwise + = let start' = start `min` lups + `max` (lups - nRest + 1) + `min` (lups + ldown - nRest + 1) + `max` nMaster + in (sel { start=start' }, + stk { up=reverse (take nMaster ups ++ drop start' ups), + down=take (nRest - (lups - start') - 1) downs }) + where + downs = down stk + ups = reverse $ up stk + lups = length ups + ldown = length downs +-} + +updateStart :: Selection -> Stack a -> Int +updateStart (Sel { nMaster, start, nRest }) stk + | lups < nMaster -- the focussed window is in the master pane + = start `min` (lups + ldown - nRest + 1) `max` nMaster + | otherwise + = start `min` lups + `max` (lups - nRest + 1) + `min` (lups + ldown - nRest + 1) + `max` nMaster + where + lups = length $ up stk + ldown = length $ down stk + +update :: Selection -> Stack a -> Selection +update sel stk = sel { start=updateStart sel stk } + +updateAndSelect :: Selection -> Stack a -> Stack a +updateAndSelect sel stk = select (update sel stk) stk + +data Selective a = Selective Selection + deriving (Read, Show) + +instance LayoutModifier Selective a where + modifyLayout (Selective s) w r = + runLayout (w { stack = updateAndSelect s <$> stack w }) r + + pureModifier (Selective sel) _ stk wins = (wins, Selective . update sel <$> stk) + +selective :: Int -> Int -> l a -> ModifiedLayout Selective l a +selective m r = ModifiedLayout . Selective $ Sel { nMaster=m, start=m, nRest=r } addfile ./tests/test_Selective.hs hunk ./tests/test_Selective.hs 1 +{-# LANGUAGE ScopedTypeVariables, FlexibleInstances #-} + +import XMonad.Layout.Selective +import XMonad.StackSet hiding (focusUp, focusDown) +import Control.Applicative ((<$>)) +import Test.QuickCheck +import Control.Arrow (second) + +instance Arbitrary (Stack Int) where + arbitrary = do + xs <- arbNat + ys <- arbNat + return $ Stack { up=[xs-1,xs-2..0], focus=xs, down=[xs+1..xs+ys] } + coarbitrary = undefined + +instance Arbitrary Selection where + arbitrary = do + nm <- arbNat + st <- arbNat + nr <- arbPos + return $ Sel nm (st+nm) nr + coarbitrary = undefined + +arbNat = abs <$> arbitrary +arbPos = (+1) . abs <$> arbitrary + +-- as many windows as possible should be selected +-- (when the selection is normalized) +prop_select_length sel (stk :: Stack Int) = + (length . integrate $ select sel' stk) == ((nMaster sel' + nRest sel') `min` length (integrate stk)) + where + sel' = updateSel sel stk + +-- update normalizes selections (is idempotent) +prop_update_idem sel (stk :: Stack Int) = sel' == updateSel sel' stk + where + sel' = updateSel sel stk + +-- select selects the master pane +prop_select_master sel (stk :: Stack Int) = + take (nMaster sel) (integrate stk) == take (nMaster sel) (integrate $ select sel stk) + +-- the focus should always be selected in normalized selections +prop_select_focus sel (stk :: Stack Int) = focus stk == (focus $ select sel' stk) + where + sel' = updateSel sel stk + +-- select doesn't change order (or duplicate elements) +-- relies on the Arbitrary instance for Stack Int generating increasing stacks +prop_select_increasing sel (stk :: Stack Int) = + let res = integrate $ select sel stk + in and . zipWith (<) res $ tail res + +-- moving the focus to a window that's already selected doesn't change the selection +prop_update_focus_up sel (stk :: Stack Int) x' = + (length (up stk) >= x) && ((up stk !! (x-1)) `elem` integrate stk') ==> + sel' == updateSel sel' (iterate focusUp stk !! x) + where + x = 1 + abs x' + sel' = updateSel sel stk + stk' = select sel' stk + +prop_update_focus_down sel (stk :: Stack Int) x' = + (length (down stk) >= x) && ((down stk !! (x-1)) `elem` integrate stk') ==> + sel' == updateSel sel' (iterate focusDown stk !! x) + where + x = 1 + abs x' + sel' = updateSel sel stk + stk' = select sel' stk + +upSel sel stk = let sel' = updateSel sel stk in (sel', select sel' stk) + +focusUp stk = stk { up=tail (up stk), focus=head (up stk), down=focus stk:down stk } +focusDown stk = stk { down=tail (down stk), focus=head (down stk), up=focus stk:up stk } hunk ./xmonad-contrib.cabal 186 + XMonad.Layout.Selective hunk ./tests/test_Selective.hs 32 - sel' = updateSel sel stk + sel' = update sel stk hunk ./tests/test_Selective.hs 35 -prop_update_idem sel (stk :: Stack Int) = sel' == updateSel sel' stk +prop_update_idem sel (stk :: Stack Int) = sel' == update sel' stk hunk ./tests/test_Selective.hs 37 - sel' = updateSel sel stk + sel' = update sel stk hunk ./tests/test_Selective.hs 46 - sel' = updateSel sel stk + sel' = update sel stk hunk ./tests/test_Selective.hs 57 - sel' == updateSel sel' (iterate focusUp stk !! x) + sel' == update sel' (iterate focusUp stk !! x) hunk ./tests/test_Selective.hs 60 - sel' = updateSel sel stk + sel' = update sel stk hunk ./tests/test_Selective.hs 65 - sel' == updateSel sel' (iterate focusDown stk !! x) + sel' == update sel' (iterate focusDown stk !! x) hunk ./tests/test_Selective.hs 68 - sel' = updateSel sel stk + sel' = update sel stk hunk ./tests/test_Selective.hs 71 -upSel sel stk = let sel' = updateSel sel stk in (sel', select sel' stk) +upSel sel stk = let sel' = update sel stk in (sel', select sel' stk) hunk ./XMonad/Layout/Selective.hs 28 --- invariant: 0 <= nMaster <= start; 0 <= nRest +-- invariant: 0 <= nMaster <= start; 1 <= nRest hunk ./tests/test_Selective.hs 31 - where - sel' = update sel stk + where sel' = update sel stk hunk ./tests/test_Selective.hs 35 - where - sel' = update sel stk + where sel' = update sel stk hunk ./tests/test_Selective.hs 43 - where - sel' = update sel stk + where sel' = update sel stk hunk ./tests/test_Selective.hs 51 +-- update preserves invariants on selections +prop_update_nm sel (stk :: Stack Int) = nMaster (update sel stk) >= 0 +prop_update_start sel (stk :: Stack Int) = nMaster sel' <= start sel' + where sel' = update sel stk +prop_update_nr sel (stk :: Stack Int) = nRest (update sel stk) >= 0 + hunk ./tests/test_Selective.hs 74 -upSel sel stk = let sel' = update sel stk in (sel', select sel' stk) - hunk ./XMonad/Layout/Selective.hs 45 -{- -select :: Selection -> Stack a -> (Selection, Stack a) -select sel@(Sel { nMaster, start, nRest }) stk - | lups < nMaster -- the focussed window is in the master pane - = let start' = start `min` (lups + ldown - nRest + 1) - `max` nMaster - in (sel { start=start' }, - stk { down=take (nMaster - lups - 1) downs ++ - (take nRest . drop (start' - lups - 1) $ downs) }) - | otherwise - = let start' = start `min` lups - `max` (lups - nRest + 1) - `min` (lups + ldown - nRest + 1) - `max` nMaster - in (sel { start=start' }, - stk { up=reverse (take nMaster ups ++ drop start' ups), - down=take (nRest - (lups - start') - 1) downs }) - where - downs = down stk - ups = reverse $ up stk - lups = length ups - ldown = length downs --} - hunk ./XMonad/Layout/Selective.hs 25 +import XMonad.Layout (IncMasterN (..)) hunk ./XMonad/Layout/Selective.hs 74 + pureMess (Selective s) m = Selective . incmastern <$> fromMessage m + where + incmastern (IncMasterN n) = + let nm = (nMaster s + n) `max` 0 + in if nMaster s == start s + then s { nMaster = nm, start = nm } + else s { nMaster = nm } + hunk ./XMonad/Layout/Selective.hs 21 -module XMonad.Layout.Selective where +module XMonad.Layout.Selective ( + -- * Description + -- $description + -- * Usage + -- $usage + + -- The Layout Modifier + selective + ) where hunk ./XMonad/Layout/Selective.hs 37 +-- $description +-- Selective is a layout modifier which limits the number of windows on screen. +-- The first @n@ windows ("the master pane", which may correspond to the +-- master pane of the underlying layout) plus several others are shown, such +-- that the focussed window is always visible. Windows are not moved until a +-- hidden window gains focus. + +-- $usage +-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Selective +-- +-- > myLayout = (selective 1 3 $ Tall 1 0.03 0.5) ||| Full ||| RandomOtherLayout... +-- > main = xmonad defaultConfig { layoutHook = myLayout } +-- +-- The layout modifier accepts the IncMasterN message to change the number of +-- windows in the "master pane". +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". +-- +-- See also 'XMonad.Layout.BoringWindows.boringAuto' for keybindings that skip +-- the hidden windows. + hunk ./XMonad/Layout/Selective.hs 114 +-- | Only display the first @m@ windows and @r@ others. +-- The @IncMasterN@ message will change @m@, as well as passing it onto the +-- underlying layout. hunk ./XMonad/Layout/LimitWindows.hs 1 -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, NamedFieldPuns, PatternGuards #-} hunk ./XMonad/Layout/LimitWindows.hs 6 +-- (c) 2009 Max Rabkin -- wrote limitSelect hunk ./XMonad/Layout/LimitWindows.hs 21 - -- Layout Modifiers - limitWindows,limitSlice, + -- * Layout Modifiers + limitWindows,limitSlice,limitSelect, hunk ./XMonad/Layout/LimitWindows.hs 24 - -- Change the number of windows + -- * Change the number of windows hunk ./XMonad/Layout/LimitWindows.hs 31 +import XMonad.Layout (IncMasterN (..)) hunk ./XMonad/Layout/LimitWindows.hs 33 +import Control.Applicative((<$>)) hunk ./XMonad/Layout/LimitWindows.hs 72 +-- | Only display the first @m@ windows and @r@ others. +-- The @IncMasterN@ message will change @m@, as well as passing it onto the +-- underlying layout. +limitSelect :: Int -> Int -> l a -> ModifiedLayout Selection l a +limitSelect m r = ModifiedLayout Sel{ nMaster=m, start=m, nRest=r } + hunk ./XMonad/Layout/LimitWindows.hs 93 - runLayout ws { W.stack = f n `fmap` W.stack ws } r + runLayout ws { W.stack = f n <$> W.stack ws } r hunk ./XMonad/Layout/LimitWindows.hs 111 + +data Selection a = Sel { nMaster :: Int, start :: Int, nRest :: Int } + deriving (Read, Show, Eq) + +instance LayoutModifier Selection a where + modifyLayout s w r = + runLayout (w { W.stack = updateAndSelect s <$> W.stack w }) r + + pureModifier sel _ stk wins = (wins, update sel <$> stk) + + pureMess sel m + | Just f <- unLC <$> fromMessage m = + Just $ sel { nRest = max 0 (f (nMaster sel + nRest sel) - nMaster sel) } + | Just (IncMasterN n) <- fromMessage m = + Just $ sel { nMaster = max 0 (nMaster sel + n) } + | otherwise = + Nothing + +select :: Selection l -> W.Stack a -> W.Stack a +select (Sel { nMaster, start, nRest }) stk + | lups < nMaster + = stk { W.down=take (nMaster - lups - 1) downs ++ + (take nRest . drop (start - lups - 1) $ downs) } + | otherwise + = stk { W.up=reverse (take nMaster ups ++ drop start ups), + W.down=take (nRest - (lups - start) - 1) downs } + where + downs = W.down stk + ups = reverse $ W.up stk + lups = length ups + +updateStart :: Selection l -> W.Stack a -> Int +updateStart (Sel { nMaster, start, nRest }) stk + | lups < nMaster -- the focussed window is in the master pane + = start `min` (lups + ldown - nRest + 1) `max` nMaster + | otherwise + = start `min` lups + `max` (lups - nRest + 1) + `min` (lups + ldown - nRest + 1) + `max` nMaster + where + lups = length $ W.up stk + ldown = length $ W.down stk + +update :: Selection l -> W.Stack a -> Selection a +update sel stk = sel { start=updateStart sel stk } + +updateAndSelect :: Selection l -> W.Stack a -> W.Stack a +updateAndSelect sel stk = select (update sel stk) stk hunk ./XMonad/Layout/Selective.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonad.Layout.Selective --- Copyright : (c) 2009 Max Rabkin --- License : BSD3-style (see LICENSE) --- --- Maintainer : Max Rabkin --- Stability : unstable --- Portability : unportable --- --- Provides a layout modifier that only shows the master pane and windows --- around the focussed window. --- ------------------------------------------------------------------------------ - -{-# LANGUAGE MultiParamTypeClasses, - FlexibleInstances, - NoMonomorphismRestriction, - NamedFieldPuns #-} - -module XMonad.Layout.Selective ( - -- * Description - -- $description - -- * Usage - -- $usage - - -- The Layout Modifier - selective - ) where - -import XMonad.Core -import XMonad.StackSet -import XMonad.Layout (IncMasterN (..)) -import XMonad.Layout.LayoutModifier -import Control.Applicative ((<$>)) - --- $description --- Selective is a layout modifier which limits the number of windows on screen. --- The first @n@ windows ("the master pane", which may correspond to the --- master pane of the underlying layout) plus several others are shown, such --- that the focussed window is always visible. Windows are not moved until a --- hidden window gains focus. - --- $usage --- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Layout.Selective --- --- > myLayout = (selective 1 3 $ Tall 1 0.03 0.5) ||| Full ||| RandomOtherLayout... --- > main = xmonad defaultConfig { layoutHook = myLayout } --- --- The layout modifier accepts the IncMasterN message to change the number of --- windows in the "master pane". --- --- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". --- --- See also 'XMonad.Layout.BoringWindows.boringAuto' for keybindings that skip --- the hidden windows. - --- invariant: 0 <= nMaster <= start; 1 <= nRest -data Selection = Sel { nMaster :: Int, start :: Int, nRest :: Int } - deriving (Read, Show, Eq) - -select :: Selection -> Stack a -> Stack a -select (Sel { nMaster, start, nRest }) stk - | lups < nMaster - = stk { down=take (nMaster - lups - 1) downs ++ - (take nRest . drop (start - lups - 1) $ downs) } - | otherwise - = stk { up=reverse (take nMaster ups ++ drop start ups), - down=take (nRest - (lups - start) - 1) downs } - where - downs = down stk - ups = reverse $ up stk - lups = length ups - -updateStart :: Selection -> Stack a -> Int -updateStart (Sel { nMaster, start, nRest }) stk - | lups < nMaster -- the focussed window is in the master pane - = start `min` (lups + ldown - nRest + 1) `max` nMaster - | otherwise - = start `min` lups - `max` (lups - nRest + 1) - `min` (lups + ldown - nRest + 1) - `max` nMaster - where - lups = length $ up stk - ldown = length $ down stk - -update :: Selection -> Stack a -> Selection -update sel stk = sel { start=updateStart sel stk } - -updateAndSelect :: Selection -> Stack a -> Stack a -updateAndSelect sel stk = select (update sel stk) stk - -data Selective a = Selective Selection - deriving (Read, Show) - -instance LayoutModifier Selective a where - modifyLayout (Selective s) w r = - runLayout (w { stack = updateAndSelect s <$> stack w }) r - - pureModifier (Selective sel) _ stk wins = (wins, Selective . update sel <$> stk) - - pureMess (Selective s) m = Selective . incmastern <$> fromMessage m - where - incmastern (IncMasterN n) = - let nm = (nMaster s + n) `max` 0 - in if nMaster s == start s - then s { nMaster = nm, start = nm } - else s { nMaster = nm } - --- | Only display the first @m@ windows and @r@ others. --- The @IncMasterN@ message will change @m@, as well as passing it onto the --- underlying layout. -selective :: Int -> Int -> l a -> ModifiedLayout Selective l a -selective m r = ModifiedLayout . Selective $ Sel { nMaster=m, start=m, nRest=r } rmfile ./XMonad/Layout/Selective.hs hunk ./tests/test_Selective.hs 3 -import XMonad.Layout.Selective +-- Tests for limitSelect-related code in L.LimitWindows. +-- To run these tests, export (select,update,Selection(..),updateAndSelect) from +-- L.LimitWindows. + +import XMonad.Layout.LimitWindows hunk ./tests/test_Selective.hs 20 -instance Arbitrary Selection where +instance Arbitrary (Selection a) where hunk ./xmonad-contrib.cabal 186 - XMonad.Layout.Selective hunk ./XMonad/Layout/LimitWindows.hs 14 +-- See "XMonad.Layout.Minimize" for manually setting hidden windows. hunk ./tests/test_Selective.hs 8 -import XMonad.StackSet hiding (focusUp, focusDown) +import XMonad.StackSet hiding (focusUp, focusDown, filter) hunk ./tests/test_Selective.hs 55 +-- selection has the form [0..l] ++ [m..n] +-- relies on the Arbitrary instance for Stack Int generating stacks like [0..k] +prop_select_two_consec sel (stk :: Stack Int) = + let wins = integrate $ select sel stk + in (length . filter not . zipWith ((==) . (+1)) wins $ tail wins) <= 1 + hunk ./XMonad/Layout/LimitWindows.hs 1 -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, NamedFieldPuns, PatternGuards #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-} hunk ./XMonad/Layout/LimitWindows.hs 131 -select (Sel { nMaster, start, nRest }) stk - | lups < nMaster - = stk { W.down=take (nMaster - lups - 1) downs ++ - (take nRest . drop (start - lups - 1) $ downs) } +select s stk + | lups < nMaster s + = stk { W.down=take (nMaster s - lups - 1) downs ++ + (take (nRest s) . drop (start s - lups - 1) $ downs) } hunk ./XMonad/Layout/LimitWindows.hs 136 - = stk { W.up=reverse (take nMaster ups ++ drop start ups), - W.down=take (nRest - (lups - start) - 1) downs } + = stk { W.up=reverse (take (nMaster s) ups ++ drop (start s) ups), + W.down=take ((nRest s) - (lups - start s) - 1) downs } hunk ./XMonad/Layout/LimitWindows.hs 144 -updateStart (Sel { nMaster, start, nRest }) stk - | lups < nMaster -- the focussed window is in the master pane - = start `min` (lups + ldown - nRest + 1) `max` nMaster +updateStart s stk + | lups < nMaster s -- the focussed window is in the master pane + = start s `min` (lups + ldown - (nRest s) + 1) `max` nMaster s hunk ./XMonad/Layout/LimitWindows.hs 148 - = start `min` lups - `max` (lups - nRest + 1) - `min` (lups + ldown - nRest + 1) - `max` nMaster + = start s `min` lups + `max` (lups - (nRest s) + 1) + `min` (lups + ldown - (nRest s) + 1) + `max` nMaster s hunk ./XMonad/Layout/SubLayouts.hs 31 + -- * Screenshots + -- $screenshots + hunk ./XMonad/Layout/SubLayouts.hs 66 +-- $screenshots +-- +-- <> +-- +-- Larger version: + hunk ./XMonad/Layout/SubLayouts.hs 39 +import XMonad.Layout.Circle () -- so haddock can find the link + hunk ./XMonad/Layout/SubLayouts.hs 116 --- Using BoringWindows is optional and it allows you to add a keybinding to --- skip over the non-visible windows. +-- Using "XMonad.Layout.BoringWindows" is optional and it allows you to add a +-- keybinding to skip over the non-visible windows. hunk ./XMonad/Layout/SubLayouts.hs 121 --- Then edit your @layoutHook@ by adding the subTabbed layout modifier: +-- Then edit your @layoutHook@ by adding the 'subTabbed' layout modifier: hunk ./XMonad/Layout/SubLayouts.hs 175 --- Ex. The second group is Tall, the third is Circle, all others are tabbed +-- Ex. The second group is 'Tall', the third is 'Circle', all others are tabbed hunk ./XMonad/Layout/SubLayouts.hs 184 --- | 'subLayout' but use 'XMonad.Layout.Tabbed.addTabs' to add decorations. +-- | @subTabbed@ is a use of 'subLayout' with 'addTabs' to show decorations. hunk ./XMonad/Layout/SubLayouts.hs 75 --- Issue 288: "XMonad.Layout.ResizableTile" assumes that its environment +-- /Issue 288/ +-- +-- "XMonad.Layout.ResizableTile" assumes that its environment hunk ./XMonad/Layout/SubLayouts.hs 84 --- Features: +-- /Features/ hunk ./XMonad/Layout/SubLayouts.hs 91 --- SimpleTabbed as a SubLayout +-- /SimpleTabbed as a SubLayout/ hunk ./XMonad/Layout/SubLayouts.hs 135 --- > , ((modMask .|. controlMask, xK_h), sendMessage $ pullGroup L) --- > , ((modMask .|. controlMask, xK_l), sendMessage $ pullGroup R) --- > , ((modMask .|. controlMask, xK_k), sendMessage $ pullGroup U) --- > , ((modMask .|. controlMask, xK_j), sendMessage $ pullGroup D) +-- > , ((modm .|. controlMask, xK_h), sendMessage $ pullGroup L) +-- > , ((modm .|. controlMask, xK_l), sendMessage $ pullGroup R) +-- > , ((modm .|. controlMask, xK_k), sendMessage $ pullGroup U) +-- > , ((modm .|. controlMask, xK_j), sendMessage $ pullGroup D) hunk ./XMonad/Layout/SubLayouts.hs 140 --- > , ((modMask .|. controlMask, xK_m), withFocused (sendMessage . MergeAll)) --- > , ((modMask .|. controlMask, xK_u), withFocused (sendMessage . UnMerge)) +-- > , ((modm .|. controlMask, xK_m), withFocused (sendMessage . MergeAll)) +-- > , ((modm .|. controlMask, xK_u), withFocused (sendMessage . UnMerge)) hunk ./XMonad/Layout/SubLayouts.hs 143 --- > , ((modMask .|. controlMask, xK_period), onGroup W.focusUp') --- > , ((modMask .|. controlMask, xK_comma), onGroup W.focusDown') +-- > , ((modm .|. controlMask, xK_period), onGroup W.focusUp') +-- > , ((modm .|. controlMask, xK_comma), onGroup W.focusDown') hunk ./XMonad/Layout/SubLayouts.hs 150 --- > , ((modMask, xK_j), focusDown) --- > , ((modMask, xK_k), focusUp) +-- > , ((modm, xK_j), focusDown) +-- > , ((modm, xK_k), focusUp) hunk ./XMonad/Layout/SubLayouts.hs 169 --- [@nextLayout@] When a new group is formed, use the layout @sl@ after --- skipping that number of layouts. Specify a finite list and groups that do --- not have a corresponding index get the first choice in @sls@ +-- @subLayout advanceInnerLayouts innerLayout outerLayout@ hunk ./XMonad/Layout/SubLayouts.hs 171 --- [@sl@] The single layout given to be run as a sublayout. +-- [@advanceInnerLayouts@] When a new group at index @n@ in the outer layout +-- is created (even with one element), the @innerLayout@ is used as the +-- layout within that group after being advanced with @advanceInnerLayouts !! +-- n@ 'NextLayout' messages. If there is no corresponding element in the +-- @advanceInnerLayouts@ list, then @innerLayout@ is not given any 'NextLayout' +-- messages. hunk ./XMonad/Layout/SubLayouts.hs 178 --- [@x@] The layout that determines the rectangles that the groups get. +-- [@innerLayout@] The single layout given to be run as a sublayout. +-- +-- [@outerLayout@] The layout that determines the rectangles given to each +-- group. hunk ./XMonad/Actions/GridSelect.hs 24 + hunk ./XMonad/Actions/GridSelect.hs 91 --- > gsconfig1 :: HasColorizer a => GSConfig a +-- > -- the top of your config +-- > {-# LANGUAGE NoMonomorphismRestriction #-} +-- > import XMonad +-- > ... hunk ./XMonad/Actions/GridSelect.hs 97 --- Regarding type signatures: to leave them out in this case, add @{-# LANGUAGE --- NoMonomorphismRestriction #-}@ to the top of your @xmonad.hs@. Refer to --- this page for an explanation: --- --- --- @gsconfig2@ is an example where 'buildDefaultGSConfig' is used instead of --- 'defaultGSConfig' in order to specify a custom colorizer (found in +-- An example where 'buildDefaultGSConfig' is used instead of 'defaultGSConfig' +-- in order to specify a custom colorizer is @gsconfig2@ (found in hunk ./XMonad/Actions/GridSelect.hs 112 - +-- hunk ./XMonad/Actions/GridSelect.hs 124 +-- > {-# LANGAUGE NoMonomorphismRestriction #-} +-- > import XMonad hunk ./XMonad/Actions/GridSelect.hs 130 --- > gsconfig3 :: HasColorizer a => GSConfig a hunk ./XMonad/Actions/GridSelect.hs 132 --- > , gs_cellWidth = 100 --- > , gs_navigate = M.unions [reset, nethackKeys, gs_navigate $ defaultGSConfig `asTypeOf` gsconfig3] } --- > where addPair (a,b) (x,y) = (a+x,b+y) --- > nethackKeys = M.map addPair --- > $ M.fromList [((0,xK_y),(-1,-1) --- > ,((0,xK_i),(1,-1) --- > ,((0,xK_n),(-1,1) --- > ,((0,xK_m),(1,1) +-- > , gs_cellwidth = 100 +-- > , gs_navigate = M.unions +-- > [reset +-- > ,nethackKeys +-- > ,gs_navigate -- get the default navigation bindings +-- > $ defaultGSConfig `asTypeOf` gsconfig3 -- needed to fix an ambiguous type variable +-- > ] +-- > } +-- > where addPair (a,b) (x,y) = (a+x,b+y) +-- > nethackKeys = M.map addPair $ M.fromList +-- > [((0,xK_y),(-1,-1)) +-- > ,((0,xK_i),(1,-1)) +-- > ,((0,xK_n),(-1,1)) +-- > ,((0,xK_m),(1,1)) hunk ./XMonad/Actions/GridSelect.hs 147 --- > -- jump back to the center with the spacebar, regardless of the current position. --- > reset = M.singleton (0,xK_space) (const (0,0)) +-- > -- jump back to the center with the spacebar, regardless of the current position. +-- > reset = M.singleton (0,xK_space) (const (0,0)) hunk ./XMonad/Actions/GridSelect.hs 115 --- ,((modMask x, xK_g), goToSelected $ gsconfig2 myWinColorizer) --- ,((modMask x, xK_p), spawnSelected $ spawnSelected defaultColorizer) +-- > ,((modMask x, xK_g), goToSelected $ gsconfig2 myWinColorizer) +-- > ,((modMask x, xK_p), spawnSelected $ spawnSelected defaultColorizer) hunk ./XMonad/Doc/Extending.hs 814 +* "XMonad.Util.Cursor": configure the default cursor/pointer glyph. + addfile ./XMonad/Util/Cursor.hs hunk ./XMonad/Util/Cursor.hs 1 +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Cursor +-- Copyright : (c) 2009 Collabora Ltd +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : Andres Salomon +-- Stability : unstable +-- Portability : unportable +-- +-- A module for setting the default mouse cursor. +-- +-- Some ideas shamelessly stolen from Nils Schweinsberg; thanks! +----------------------------------------------------------------------------- + +module XMonad.Util.Cursor + ( -- * Usage: + -- $usage + module Graphics.X11.Xlib.Cursor, + setDefaultCursor + ) where + +import Graphics.X11.Xlib.Cursor +import XMonad + +-- $usage +-- setDefaultCursor xC_left_ptr +-- For example, to override the default gnome cursor: +-- import XMonad.Util.Cursor +-- main = xmonad gnomeConfig { startupHook = setDefaultCursor xC_pirate } +-- Arrr! + +-- | Set the default (root) cursor +setDefaultCursor :: Glyph -> X () +setDefaultCursor glyph = do + dpy <- asks display + rootw <- asks theRoot + liftIO $ do + curs <- createFontCursor dpy glyph + defineCursor dpy rootw curs + flush dpy + freeCursor dpy curs hunk ./xmonad-contrib.cabal 220 + XMonad.Util.Cursor hunk ./XMonad/Config/Desktop.hs 25 +import XMonad.Util.Cursor hunk ./XMonad/Config/Desktop.hs 33 + , startupHook = setDefaultCursor xC_left_ptr hunk ./XMonad/Util/Cursor.hs 27 --- setDefaultCursor xC_left_ptr +-- +-- > setDefaultCursor xC_left_ptr +-- hunk ./XMonad/Util/Cursor.hs 31 --- import XMonad.Util.Cursor --- main = xmonad gnomeConfig { startupHook = setDefaultCursor xC_pirate } +-- +-- > import XMonad.Util.Cursor +-- > main = xmonad gnomeConfig { startupHook = setDefaultCursor xC_pirate } +-- hunk ./XMonad/Hooks/SetCursor.hs 1 ------------------------------------------------------------------------------ --- | --- Module : XMonad.Hooks.SetCursor --- Copyright : (c) 2009 Nils Schweinsberg --- License : BSD3-style (see LICENSE) --- --- Maintainer : Nils Schweinsberg --- Stability : unstable --- Portability : unportable --- --- Set a default cursor on startup. --- --- Thanks to Andres Salomon for his initial idea for this startup hook. --- ------------------------------------------------------------------------------ - -module XMonad.Hooks.SetCursor ( - -- * Usage - -- $usage - setDefaultCursor - ) where - -import XMonad - -{- $usage - -To use this startup hook add a line to your startup hook: - -> myStartupHook = do -> setDefaultCursor 68 -> -- more stuff - -Where @68@ is the default left pointer. - --} - --- | Set the default (root) cursor -setDefaultCursor :: Glyph -- ^ the cursor to use - -> X () -setDefaultCursor glyph = do - dpy <- asks display - rootw <- asks theRoot - liftIO $ do - curs <- createFontCursor dpy glyph - defineCursor dpy rootw curs - flush dpy - freeCursor dpy curs rmfile ./XMonad/Hooks/SetCursor.hs hunk ./xmonad-contrib.cabal 130 - XMonad.Hooks.SetCursor hunk ./XMonad/Config/Gnome.hs 43 - , startupHook = gnomeRegister } + , startupHook = gnomeRegister >> startupHook desktopConfig } hunk ./XMonad/Config/Gnome.hs 65 --- +-- hunk ./xmonad-contrib.cabal 52 - build-depends: mtl, unix, X11>=1.4.3, xmonad>=0.8, xmonad<0.9, utf8-string + build-depends: mtl, unix, X11>=1.4.6.1, xmonad>=0.8, xmonad<0.9, utf8-string hunk ./XMonad/Actions/RandomBackground.hs 16 -module XMonad.Actions.RandomBackground (randomBg',randomBg,RandomColor(HSV,RGB)) where +module XMonad.Actions.RandomBackground ( + -- * Usage + -- $usage + randomBg', + randomBg, + RandomColor(HSV,RGB) + ) where hunk ./XMonad/Actions/RandomBackground.hs 30 --- | RandomColor fixes constraints when generating random colors -data RandomColor = RGB { _colorMin :: Int, _colorMax :: Int } - | HSV { _colorSaturation :: Double, _colorValue :: Double } +-- $usage +-- +-- Add to your keybindings something like: +-- +-- > ,((modm .|. shiftMask, xK_Return), randomBg $ HSV 0xff 0x20 + +-- | RandomColor fixes constraints when generating random colors. All +-- parameters should be in the range 0 -- 0xff +data RandomColor = RGB { _colorMin :: Int + , _colorMax :: Int + } -- ^ specify the minimum and maximum lowest values for each color channel. + | HSV { _colorSaturation :: Double + , _colorValue :: Double + } -- ^ specify the saturation and value, leaving the hue random. hunk ./XMonad/Actions/RandomBackground.hs 56 --- | randomBg' produces a random hex number in the form @'#xxyyzz'@ +-- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@ hunk ./XMonad/Actions/RandomBackground.hs 64 +-- | @randomBg@ starts a terminal with the background color taken from 'randomBg'' +-- +-- This depends on the your 'terminal' configuration field accepting an +-- argument like @-bg '#ff0023'@ hunk ./XMonad/Actions/RandomBackground.hs 27 -import Control.Monad(replicateM,liftM) +import Control.Monad(liftM) hunk ./XMonad/Actions/RandomBackground.hs 58 -randomBg' (RGB l h) = liftM toHex $ replicateM 3 $ io $ randomRIO (l,h) +randomBg' (RGB l h) = io $ liftM (toHex . take 3 . randomRs (l,h)) newStdGen hunk ./XMonad/Actions/GridSelect.hs 315 - | t == keyPress = maybe eventLoop diffAndRefresh . M.lookup (m,ks) - =<< gets (gs_navigate . td_gsconfig) + | t == keyPress = do + m' <- liftX (cleanMask m) + keymap <- gets (gs_navigate . td_gsconfig) + maybe eventLoop diffAndRefresh . M.lookup (m',ks) $ keymap hunk ./XMonad/Config/Desktop.hs 15 - +----------------------------------------------------------------------------- hunk ./XMonad/Config/Desktop.hs 17 + + -- | Several basic integration settings are common to all of xmonad\'s + -- desktop integration configurations. The specific desktop environment + -- (DE) modules like "XMonad.Config.Gnome" use this module\'s + -- @desktopConfig@ to set up basic communication between xmonad and + -- the DE via a subset of the Extended Window Manager Hints (EWMH) + -- specification. Extra xmonad settings unique to specific DE\'s are + -- added by overriding or modifying @desktopConfig@ fields in the + -- same way that @defaultConfig@ is customized in @~/.xmonad/xmonad.hs@. + -- + -- For more information about EWMH see: + -- + -- + -- + -- See also: "XMonad.Hooks.EwmhDesktops", "XMonad.Hooks.ManageDocks", + -- "XMonad.Util.EZConfig". + + -- * Usage + -- $usage + hunk ./XMonad/Config/Desktop.hs 38 + + -- * Customizing a desktop config + -- $customizing + + -- ** Modifying layouts, manageHook, or key bindings + -- $layouts hunk ./XMonad/Config/Desktop.hs 45 + + -- ** Modifying the logHook + -- $logHook + + -- ** Modifying the handleEventHook + -- $eventHook + + -- ** Modifying the startupHook + -- $startupHook hunk ./XMonad/Config/Desktop.hs 64 +-- $usage +-- While this document describes how to configure xmonad, you also need +-- to set up your Desktop Environment (DE) and display manager to use +-- xmonad as its window manager. For DE and distro specific tips on +-- how to do so, see the xmonad wiki: +-- +-- +-- +-- To configure xmonad for use with a DE or with DE tools like panels +-- and pagers, in place of @defaultConfig@ in your @~/.xmonad/xmonad.hs@, +-- use @desktopConfig@ or one of the other desktop configs from the +-- @XMonad.Config@ hierarchy. The following setup and customization examples +-- work the same way for the other desktop configs as for @desktopConfig@. +-- If you are using a specific DE config, import its module instead, and +-- use its config in place of @desktopConfig@ in the following examples. +-- +-- > import XMonad +-- > import XMonad.Config.Desktop +-- > +-- > main = xmonad desktopConfig +-- +-- @desktopConfig@ is an 'XConfig' that configures xmonad to +-- ignore and leave room for dock type windows like panels and trays, adds +-- the default key binding to toggle panel visibility, and activates basic +-- EWMH support. It also sets a prettier root window mouse pointer. + +-- $customizing +-- To customize a desktop config, modify its fields as is illustrated with +-- @defaultConfig@ in the \"Extending xmonad\" section of "XMonad.Doc.Extending". + +-- $layouts +-- See also "XMonad.Util.EZConfig" for more options for modifying key bindings. +-- To add to layouts, manageHook or key bindings use something like the following +-- to combine your modifications with the desktop config settings: +-- +-- > import XMonad +-- > import XMonad.Config.Desktop +-- > import XMonad.Layout.Tabbed +-- > import XMonad.Util.EZConfig (additionalKeys) +-- > +-- > main = +-- > xmonad $ desktopConfig { +-- > -- add manage hooks while still ignoring panels and using default manageHooks +-- > manageHook = myManageHook <+> manageHook desktopConfig +-- > +-- > -- add a fullscreen tabbed layout that does not avoid covering +-- > -- up desktop panels before the desktop layouts +-- > , layoutHook = simpleTabbed ||| layoutHook desktopConfig +-- > } +-- > -- add a screenshot key to the default desktop bindings +-- > `additionalKeys` [ ((mod4Mask, xK_F8), spawn "scrot") ] +-- +-- To replace the desktop layouts with your own choices, but still +-- allow toggling panel visibility, use 'desktopLayoutModifiers' to +-- modify your layouts: +-- +-- > , layoutHook = desktopLayoutModifiers $ simpleTabbed ||| Tall 1 0.03 0.5 +-- +-- @desktopLayoutModifiers@ modifies a layout to avoid covering docks, panels, +-- etc. that set the @_NET_WM_STRUT_PARTIAL@ property. +-- See also "XMonad.Hooks.ManageDocks". + +-- $logHook +-- To add to the logHook while still sending workspace and window information +-- to DE apps use something like: +-- +-- > , logHook = myLogHook >> logHook desktopConfig +-- +-- Or for more elaborate logHooks you can use @do@: +-- +-- > , logHook = do +-- > dynamicLogWithPP xmobarPP +-- > updatePointer (Relative 0.9 0.9) +-- > logHook desktopConfig +-- + +-- $eventHook +-- To customize xmonad\'s event handling while still having it respond +-- to EWMH events from pagers, task bars, etc. add to your imports: +-- +-- > import Data.Monoid +-- +-- and use 'Data.Monoid.mappend' to combine event hooks (right to left application like @\<+\>@) +-- +-- > , handleEventHook = mappend myEventHooks (handleEventHook desktopConfig) +-- +-- or 'Data.Monoid.mconcat' (like @composeAll@) +-- +-- > , handleEventHook = mconcat +-- > [ myMouseHandler +-- > , myMessageHandler +-- > , handleEventHook desktopConfig ] +-- + +-- $startupHook +-- To run the desktop startupHook, plus add further actions to be run each +-- time xmonad starts or restarts, use '>>' to combine actions as in the +-- logHook example, or something like: +-- +-- > , startupHook = do +-- > startupHook desktopConfig +-- > spawn "xmonad-restart.sh" +-- > adjustEvenInput +-- + hunk ./XMonad/Config/Desktop.hs 181 + hunk ./XMonad/Config/Gnome.hs 39 +-- +-- For examples of how to further customize @gnomeConfig@ see "XMonad.Config.Desktop". hunk ./XMonad/Config/Kde.hs 38 +-- For examples of how to further customize @kdeConfig@ see "XMonad.Config.Desktop". + hunk ./XMonad/Config/Xfce.hs 9 --- Maintainer : Ivan Miljenovic +-- Maintainer : none hunk ./XMonad/Config/Xfce.hs 35 +-- For examples of how to further customize @xfceConfig@ see "XMonad.Config.Desktop". hunk ./XMonad/Config/Desktop.hs 18 - -- | Several basic integration settings are common to all of xmonad\'s + -- | Several basic integration settings are common to all of xmonad's hunk ./XMonad/Config/Desktop.hs 20 - -- (DE) modules like "XMonad.Config.Gnome" use this module\'s + -- (DE) modules like "XMonad.Config.Gnome" use this module's hunk ./XMonad/Config/Desktop.hs 23 - -- specification. Extra xmonad settings unique to specific DE\'s are + -- specification. Extra xmonad settings unique to specific DE's are hunk ./XMonad/Config/Desktop.hs 25 - -- same way that @defaultConfig@ is customized in @~/.xmonad/xmonad.hs@. + -- same way that @defaultConfig@ is customized in @~\/.xmonad/xmonad.hs@. hunk ./XMonad/Config/Desktop.hs 73 --- and pagers, in place of @defaultConfig@ in your @~/.xmonad/xmonad.hs@, +-- and pagers, in place of @defaultConfig@ in your @~\/.xmonad/xmonad.hs@, hunk ./XMonad/Config/Desktop.hs 141 --- To customize xmonad\'s event handling while still having it respond +-- To customize xmonad's event handling while still having it respond hunk ./XMonad/Config/Desktop.hs 166 --- > adjustEvenInput +-- > adjustEventInput hunk ./XMonad/Config/Desktop.hs 173 - , startupHook = setDefaultCursor xC_left_ptr hunk ./XMonad/Config/Desktop.hs 174 - , keys = \c -> desktopKeys c `M.union` keys defaultConfig c } + , keys = \c -> desktopKeys c `M.union` keys defaultConfig c } hunk ./XMonad/Config/Droundy.hs 46 -import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsLogHook, +import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsStartup, ewmhDesktopsLogHook, hunk ./XMonad/Config/Droundy.hs 135 + , startupHook = ewmhDesktopsStartup hunk ./XMonad/Config/Sjanssen.hs 37 - , layoutHook = modifiers layouts - , logHook = ewmhDesktopsLogHook - , manageHook = composeAll [className =? x --> doShift w + , layoutHook = modifiers layouts + , logHook = ewmhDesktopsLogHook + , startupHook = ewmhDesktopsStartup + , manageHook = composeAll [className =? x --> doShift w hunk ./XMonad/Config/Sjanssen.hs 44 - <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn sp - <+> (isFullscreen --> doFullFloat) + <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn sp + <+> (isFullscreen --> doFullFloat) hunk ./XMonad/Hooks/EwmhDesktops.hs 18 + ewmhDesktopsStartup, hunk ./XMonad/Hooks/EwmhDesktops.hs 42 --- > myLogHook :: X () --- > myLogHook = ewmhDesktopsLogHook --- > --- > myHandleEventHook = ewmhDesktopsEventHook --- > --- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook, logHook = myLogHook } --- --- 'avoidStruts' is used to automatically leave space for dock programs, and --- can be found in 'XMonad.Hooks.ManageDocks'. --- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" +-- > main = xmonad defaultConfig { startupHook = ewmhDesktopsStartup +-- > , handleEventHook = ewmhDesktopsEventHook +-- > , logHook = ewmhDesktopsLogHook } hunk ./XMonad/Hooks/EwmhDesktops.hs 46 --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" - +-- You may also be interested in 'avoidStruts' from XMonad.Hooks.ManageDocks. hunk ./XMonad/Hooks/EwmhDesktops.hs 49 +-- | +-- Initializes EwmhDesktops and advertises EWMH support to the X +-- server +ewmhDesktopsStartup :: X () +ewmhDesktopsStartup = setSupported hunk ./XMonad/Hooks/EwmhDesktops.hs 61 - hunk ./XMonad/Hooks/EwmhDesktops.hs 69 - setSupported - hunk ./XMonad/Config/Desktop.hs 170 - { logHook = ewmhDesktopsLogHook - , layoutHook = desktopLayoutModifiers $ layoutHook defaultConfig - , manageHook = manageHook defaultConfig <+> manageDocks + { startupHook = ewmhDesktopsStartup >> setDefaultCursor xC_left_ptr + , logHook = ewmhDesktopsLogHook + , layoutHook = desktopLayoutModifiers $ layoutHook defaultConfig + , manageHook = manageHook defaultConfig <+> manageDocks hunk ./XMonad/Actions/Commands.hs 44 --- > , ((modMask x .|. controlMask, xK_y), commands >>= runCommand) +-- > , ((modm .|. controlMask, xK_y), commands >>= runCommand) hunk ./XMonad/Actions/ConstrainedResize.hs 34 --- > , ((modMask x, button3), (\w -> focus w >> Sqr.mouseResizeWindow w False)) --- > , ((modMask x .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True )) +-- > , ((modm, button3), (\w -> focus w >> Sqr.mouseResizeWindow w False)) +-- > , ((modm .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True )) hunk ./XMonad/Actions/CopyWindow.hs 46 --- > [((m .|. modMask x, k), windows $ f i) +-- > [((m .|. modm, k), windows $ f i) hunk ./XMonad/Actions/CopyWindow.hs 58 --- > , ((modMask x .|. shiftMask, xK_c ), kill1) -- @@ Close the focused window +-- > , ((modm .|. shiftMask, xK_c ), kill1) -- @@ Close the focused window hunk ./XMonad/Actions/CopyWindow.hs 63 --- > , ((modMask x, xK_b ), runOrCopy "firefox" (className =? "Firefox")) -- @@ run or copy firefox +-- > , ((modm, xK_b ), runOrCopy "firefox" (className =? "Firefox")) -- @@ run or copy firefox hunk ./XMonad/Actions/CopyWindow.hs 73 --- > , ((modMask x, xK_v ), windows copyToAll) -- @@ Make focused window always visible --- > , ((modMask x .|. shiftMask, xK_v ), killAllOtherCopies) -- @@ Toggle window state back +-- > , ((modm, xK_v ), windows copyToAll) -- @@ Make focused window always visible +-- > , ((modm .|. shiftMask, xK_v ), killAllOtherCopies) -- @@ Toggle window state back hunk ./XMonad/Actions/CycleRecentWS.hs 33 --- > , ((modMask x, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave) +-- > , ((modm, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave) hunk ./XMonad/Actions/CycleSelectedLayouts.hs 33 --- > , ((modMask x, xK_t ), cycleThroughLayouts ["Tall", "Mirror Tall"]) +-- > , ((modm, xK_t ), cycleThroughLayouts ["Tall", "Mirror Tall"]) hunk ./XMonad/Actions/CycleWS.hs 93 --- > , ((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_z), toggleWS) +-- > , ((modm, xK_Down), nextWS) +-- > , ((modm, xK_Up), prevWS) +-- > , ((modm .|. shiftMask, xK_Down), shiftToNext) +-- > , ((modm .|. shiftMask, xK_Up), shiftToPrev) +-- > , ((modm, xK_Right), nextScreen) +-- > , ((modm, xK_Left), prevScreen) +-- > , ((modm .|. shiftMask, xK_Right), shiftNextScreen) +-- > , ((modm .|. shiftMask, xK_Left), shiftPrevScreen) +-- > , ((modm, xK_z), toggleWS) hunk ./XMonad/Actions/CycleWS.hs 105 --- > , ((modMask x .|. shiftMask, xK_Down), shiftToNext >> nextWS) --- > , ((modMask x .|. shiftMask, xK_Up), shiftToPrev >> prevWS) +-- > , ((modm .|. shiftMask, xK_Down), shiftToNext >> nextWS) +-- > , ((modm .|. shiftMask, xK_Up), shiftToPrev >> prevWS) hunk ./XMonad/Actions/CycleWS.hs 111 --- > , ((modMask x , xK_f), moveTo Next EmptyWS) -- find a free workspace --- > , ((modMask x .|. controlMask, xK_Right), -- a crazy keybinding! +-- > , ((modm , xK_f), moveTo Next EmptyWS) -- find a free workspace +-- > , ((modm .|. controlMask, xK_Right), -- a crazy keybinding! hunk ./XMonad/Actions/CycleWindows.hs 67 --- > , ((modMask x, xK_z), rotOpposite) --- > , ((modMask x , xK_i), rotUnfocusedUp) --- > , ((modMask x , xK_u), rotUnfocusedDown) --- > , ((modMask x .|. controlMask, xK_i), rotFocusedUp) --- > , ((modMask x .|. controlMask, xK_u), rotFocusedDown) +-- > , ((modm, xK_z), rotOpposite) +-- > , ((modm , xK_i), rotUnfocusedUp) +-- > , ((modm , xK_u), rotUnfocusedDown) +-- > , ((modm .|. controlMask, xK_i), rotFocusedUp) +-- > , ((modm .|. controlMask, xK_u), rotFocusedDown) hunk ./XMonad/Actions/CycleWindows.hs 91 -> , ((modMask x .|. controlMask, xK_i ), rotFocusedUp +> , ((modm .|. controlMask, xK_i ), rotFocusedUp hunk ./XMonad/Actions/CycleWindows.hs 93 -> , ((modMask x .|. controlMask, xK_u ), rotFocusedDown +> , ((modm .|. controlMask, xK_u ), rotFocusedDown hunk ./XMonad/Actions/DeManage.hs 47 --- > , ((modMask x, xK_d ), withFocused demanage) +-- > , ((modm, xK_d ), withFocused demanage) hunk ./XMonad/Actions/DwmPromote.hs 36 --- > , ((modMask x, xK_Return), dwmpromote) +-- > , ((modm, xK_Return), dwmpromote) hunk ./XMonad/Actions/DynamicWorkspaces.hs 39 --- > , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace) --- > , ((modMask x .|. shiftMask, xK_v ), selectWorkspace defaultXPConfig) --- > , ((modMask x, xK_m ), withWorkspace defaultXPConfig (windows . W.shift)) --- > , ((modMask x .|. shiftMask, xK_m ), withWorkspace defaultXPConfig (windows . copy)) --- > , ((modMask x .|. shiftMask, xK_r ), renameWorkspace defaultXPConfig) +-- > , ((modm .|. shiftMask, xK_BackSpace), removeWorkspace) +-- > , ((modm .|. shiftMask, xK_v ), selectWorkspace defaultXPConfig) +-- > , ((modm, xK_m ), withWorkspace defaultXPConfig (windows . W.shift)) +-- > , ((modm .|. shiftMask, xK_m ), withWorkspace defaultXPConfig (windows . copy)) +-- > , ((modm .|. shiftMask, xK_r ), renameWorkspace defaultXPConfig) hunk ./XMonad/Actions/DynamicWorkspaces.hs 48 --- > zip (zip (repeat (modMask x)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..]) +-- > zip (zip (repeat (modm)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..]) hunk ./XMonad/Actions/DynamicWorkspaces.hs 50 --- > zip (zip (repeat (modMask x .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..]) +-- > zip (zip (repeat (modm .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..]) hunk ./XMonad/Actions/FindEmptyWorkspace.hs 35 --- > , ((modMask x, xK_m ), viewEmptyWorkspace) --- > , ((modMask x .|. shiftMask, xK_m ), tagToEmptyWorkspace) +-- > , ((modm, xK_m ), viewEmptyWorkspace) +-- > , ((modm .|. shiftMask, xK_m ), tagToEmptyWorkspace) hunk ./XMonad/Actions/FlexibleManipulate.hs 34 --- > , ((modMask x, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w)) +-- > , ((modm, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w)) hunk ./XMonad/Actions/FlexibleResize.hs 32 --- > , ((modMask x, button3), (\w -> focus w >> Flex.mouseResizeWindow w)) +-- > , ((modm, button3), (\w -> focus w >> Flex.mouseResizeWindow w)) hunk ./XMonad/Actions/FloatKeys.hs 31 --- > , ((modMask x, xK_d ), withFocused (keysResizeWindow (-10,-10) (1,1))) --- > , ((modMask x, xK_s ), withFocused (keysResizeWindow (10,10) (1,1))) --- > , ((modMask x .|. shiftMask, xK_d ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752))) --- > , ((modMask x .|. shiftMask, xK_s ), withFocused (keysAbsResizeWindow (10,10) (1024,752))) --- > , ((modMask x, xK_a ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2))) +-- > , ((modm, xK_d ), withFocused (keysResizeWindow (-10,-10) (1,1))) +-- > , ((modm, xK_s ), withFocused (keysResizeWindow (10,10) (1,1))) +-- > , ((modm .|. shiftMask, xK_d ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752))) +-- > , ((modm .|. shiftMask, xK_s ), withFocused (keysAbsResizeWindow (10,10) (1024,752))) +-- > , ((modm, xK_a ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2))) hunk ./XMonad/Actions/FloatSnap.hs 44 --- > , ((modMask x, xK_Left), withFocused $ snapMove L Nothing) --- > , ((modMask x, xK_Right), withFocused $ snapMove R Nothing) --- > , ((modMask x, xK_Up), withFocused $ snapMove U Nothing) --- > , ((modMask x, xK_Down), withFocused $ snapMove D Nothing) --- > , ((modMask x .|. shiftMask, xK_Left), withFocused $ snapShrink R Nothing) --- > , ((modMask x .|. shiftMask, xK_Right), withFocused $ snapGrow R Nothing) --- > , ((modMask x .|. shiftMask, xK_Up), withFocused $ snapShrink D Nothing) --- > , ((modMask x .|. shiftMask, xK_Down), withFocused $ snapGrow D Nothing) +-- > , ((modm, xK_Left), withFocused $ snapMove L Nothing) +-- > , ((modm, xK_Right), withFocused $ snapMove R Nothing) +-- > , ((modm, xK_Up), withFocused $ snapMove U Nothing) +-- > , ((modm, xK_Down), withFocused $ snapMove D Nothing) +-- > , ((modm .|. shiftMask, xK_Left), withFocused $ snapShrink R Nothing) +-- > , ((modm .|. shiftMask, xK_Right), withFocused $ snapGrow R Nothing) +-- > , ((modm .|. shiftMask, xK_Up), withFocused $ snapShrink D Nothing) +-- > , ((modm .|. shiftMask, xK_Down), withFocused $ snapGrow D Nothing) hunk ./XMonad/Actions/FloatSnap.hs 58 --- > , ((modMask x, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicMove (Just 50) (Just 50) w)) --- > , ((modMask x .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicResize [L,R,U,D] (Just 50) (Just 50) w)) --- > , ((modMask x, button3), (\w -> focus w >> mouseResizeWindow w >> snapMagicResize [R,D] (Just 50) (Just 50) w)) +-- > , ((modm, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicMove (Just 50) (Just 50) w)) +-- > , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicResize [L,R,U,D] (Just 50) (Just 50) w)) +-- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> snapMagicResize [R,D] (Just 50) (Just 50) w)) hunk ./XMonad/Actions/FocusNth.hs 30 --- > ++ [((modMask x, k), focusNth i) +-- > ++ [((modm, k), focusNth i) hunk ./XMonad/Actions/GridSelect.hs 79 --- > , ((modMask x, xK_g), goToSelected defaultGSConfig) +-- > , ((modm, xK_g), goToSelected defaultGSConfig) hunk ./XMonad/Actions/GridSelect.hs 85 --- > , ((modMask x, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"]) +-- > , ((modm, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"]) hunk ./XMonad/Actions/GridSelect.hs 115 --- > ,((modMask x, xK_g), goToSelected $ gsconfig2 myWinColorizer) --- > ,((modMask x, xK_p), spawnSelected $ spawnSelected defaultColorizer) +-- > ,((modm, xK_g), goToSelected $ gsconfig2 myWinColorizer) +-- > ,((modm, xK_p), spawnSelected $ spawnSelected defaultColorizer) hunk ./XMonad/Actions/MouseGestures.hs 42 --- > , ((modMask x .|. shiftMask, button3), mouseGesture gestures) +-- > , ((modm .|. shiftMask, button3), mouseGesture gestures) hunk ./XMonad/Actions/NoBorders.hs 24 --- > , ((modMask x, xK_g ), withFocused toggleBorder) +-- > , ((modm, xK_g ), withFocused toggleBorder) hunk ./XMonad/Actions/OnScreen.hs 42 --- > [ ((m .|. modMask, k), windows (f i)) +-- > [ ((m .|. modm, k), windows (f i)) hunk ./XMonad/Actions/OnScreen.hs 63 --- > , ((modMask .|. controlMask, xK_1) windows (viewOnScreen 0 "1")) +-- > , ((modm .|. controlMask, xK_1) windows (viewOnScreen 0 "1")) hunk ./XMonad/Actions/PhysicalScreens.hs 51 -> [((modMask .|. mask, key), f sc) +> [((modm .|. mask, key), f sc) hunk ./XMonad/Actions/Promote.hs 36 --- > , ((modMask x, xK_Return), promote) +-- > , ((modm, xK_Return), promote) hunk ./XMonad/Actions/RotSlaves.hs 31 --- > , ((modMask x .|. shiftMask, xK_Tab ), rotSlavesUp) +-- > , ((modm .|. shiftMask, xK_Tab ), rotSlavesUp) hunk ./XMonad/Actions/SimpleDate.hs 32 --- > , ((modMask x, xK_d ), date) +-- > , ((modm, xK_d ), date) hunk ./XMonad/Actions/SinkAll.hs 31 --- , ((modMask x .|. shiftMask, xK_t), sinkAll) +-- > , ((modm .|. shiftMask, xK_t), sinkAll) hunk ./XMonad/Actions/Submap.hs 37 -> , ((modMask x, xK_a), submap . M.fromList $ +> , ((modm, xK_a), submap . M.fromList $ hunk ./XMonad/Actions/SwapWorkspaces.hs 40 --- > [((modMask x .|. controlMask, k), windows $ swapWithCurrent i) +-- > [((modm .|. controlMask, k), windows $ swapWithCurrent i) hunk ./XMonad/Actions/TagWindows.hs 45 --- > , ((modMask x, xK_f ), withFocused (addTag "abc")) --- > , ((modMask x .|. controlMask, xK_f ), withFocused (delTag "abc")) --- > , ((modMask x .|. shiftMask, xK_f ), withTaggedGlobalP "abc" W.sink) --- > , ((modMask x, xK_d ), withTaggedP "abc" (W.shiftWin "2")) --- > , ((modMask x .|. shiftMask, xK_d ), withTaggedGlobalP "abc" shiftHere) --- > , ((modMask x .|. controlMask, xK_d ), focusUpTaggedGlobal "abc") --- > , ((modMask x, xK_g ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s))) --- > , ((modMask x .|. controlMask, xK_g ), tagDelPrompt defaultXPConfig) --- > , ((modMask x .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float)) +-- > , ((modm, xK_f ), withFocused (addTag "abc")) +-- > , ((modm .|. controlMask, xK_f ), withFocused (delTag "abc")) +-- > , ((modm .|. shiftMask, xK_f ), withTaggedGlobalP "abc" W.sink) +-- > , ((modm, xK_d ), withTaggedP "abc" (W.shiftWin "2")) +-- > , ((modm .|. shiftMask, xK_d ), withTaggedGlobalP "abc" shiftHere) +-- > , ((modm .|. controlMask, xK_d ), focusUpTaggedGlobal "abc") +-- > , ((modm, xK_g ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s))) +-- > , ((modm .|. controlMask, xK_g ), tagDelPrompt defaultXPConfig) +-- > , ((modm .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float)) hunk ./XMonad/Actions/TopicSpace.hs 139 --- myKeys = --- [ ((modMask , xK_n ), spawnShell) -- %! Launch terminal --- , ((modMask , xK_a ), currentTopicAction myTopicConfig) --- , ((modMask , xK_g ), promptedGoto) --- , ((modMask .|. shiftMask, xK_g ), promptedShift) +-- myKeys conf\@XConfig{modMask=modm} = +-- [ ((modm , xK_n ), spawnShell) -- %! Launch terminal +-- , ((modm , xK_a ), currentTopicAction myTopicConfig) +-- , ((modm , xK_g ), promptedGoto) +-- , ((modm .|. shiftMask, xK_g ), promptedShift) hunk ./XMonad/Actions/TopicSpace.hs 147 --- [ ((modMask, k), switchNthLastFocused myTopicConfig i) +-- [ ((modm, k), switchNthLastFocused myTopicConfig i) hunk ./XMonad/Actions/Warp.hs 37 -> , ((modMask x, xK_z ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window +> , ((modm, xK_z ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window hunk ./XMonad/Actions/Warp.hs 41 -> [((modMask x .|. controlMask, key), warpToScreen sc (1%2) (1%2)) +> [((modm .|. controlMask, key), warpToScreen sc (1%2) (1%2)) hunk ./XMonad/Actions/WindowBringer.hs 41 --- > , ((modMask x .|. shiftMask, xK_g ), gotoMenu) --- > , ((modMask x .|. shiftMask, xK_b ), bringMenu) +-- > , ((modm .|. shiftMask, xK_g ), gotoMenu) +-- > , ((modm .|. shiftMask, xK_b ), bringMenu) hunk ./XMonad/Actions/WindowGo.hs 56 -> , ((modMask x .|. shiftMask, xK_g), raise (className =? "Firefox")) -> , ((modMask x .|. shiftMask, xK_b), runOrRaise "firefox" (className =? "Firefox")) +> , ((modm .|. shiftMask, xK_g), raise (className =? "Firefox")) +> , ((modm .|. shiftMask, xK_b), runOrRaise "firefox" (className =? "Firefox")) hunk ./XMonad/Actions/WindowMenu.hs 42 --- > , ((modMask x, xK_o ), windowMenu) +-- > , ((modm, xK_o ), windowMenu) hunk ./XMonad/Actions/WindowNavigation.hs 89 -withWindowNavigation (u,l,d,r) conf = - withWindowNavigationKeys [ ((modMask conf , u), WNGo U), - ((modMask conf , l), WNGo L), - ((modMask conf , d), WNGo D), - ((modMask conf , r), WNGo R), - ((modMask conf .|. shiftMask, u), WNSwap U), - ((modMask conf .|. shiftMask, l), WNSwap L), - ((modMask conf .|. shiftMask, d), WNSwap D), - ((modMask conf .|. shiftMask, r), WNSwap R) ] +withWindowNavigation (u,l,d,r) conf@XConfig{modMask=modm} = + withWindowNavigationKeys [ ((modm , u), WNGo U), + ((modm , l), WNGo L), + ((modm , d), WNGo D), + ((modm , r), WNGo R), + ((modm .|. shiftMask, u), WNSwap U), + ((modm .|. shiftMask, l), WNSwap L), + ((modm .|. shiftMask, d), WNSwap D), + ((modm .|. shiftMask, r), WNSwap R) ] hunk ./XMonad/Actions/WithAll.hs 33 --- , ((modMask x .|. shiftMask, xK_t), sinkAll) +-- , ((modm .|. shiftMask, xK_t), sinkAll) hunk ./XMonad/Doc/Extending.hs 925 -> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) -> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) +> [ ((modm, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modm, xK_F3 ), shellPrompt defaultXPConfig) hunk ./XMonad/Doc/Extending.hs 969 -> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) -> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) +> [ ((modm, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modm, xK_F3 ), shellPrompt defaultXPConfig) hunk ./XMonad/Doc/Extending.hs 1002 -> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) -> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) +> [ ((modm, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modm, xK_F3 ), shellPrompt defaultXPConfig) hunk ./XMonad/Doc/Extending.hs 1029 -> [ ((modMask x , xK_q ), return ()) -> , ((modMask x .|. shiftMask, xK_q ), return ()) +> [ ((modm , xK_q ), return ()) +> , ((modm .|. shiftMask, xK_q ), return ()) hunk ./XMonad/Doc/Extending.hs 1045 -> [ (modMask x , xK_q ) -> , (modMask x .|. shiftMask, xK_q ) +> [ (modm , xK_q ) +> , (modm .|. shiftMask, xK_q ) hunk ./XMonad/Doc/Extending.hs 1066 -> toRemove x = -> [ (modMask x , xK_j ) -> , (modMask x , xK_k ) -> , (modMask x , xK_p ) -> , (modMask x .|. shiftMask, xK_p ) -> , (modMask x .|. shiftMask, xK_q ) -> , (modMask x , xK_q ) +> toRemove XConfig{modMask = modm} = +> [ (modm , xK_j ) +> , (modm , xK_k ) +> , (modm , xK_p ) +> , (modm .|. shiftMask, xK_p ) +> , (modm .|. shiftMask, xK_q ) +> , (modm , xK_q ) hunk ./XMonad/Doc/Extending.hs 1074 -> -- I want modMask .|. shiftMask 1-9 to be free! -> [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]] +> -- I want modm .|. shiftMask 1-9 to be free! +> [(shiftMask .|. modm, k) | k <- [xK_1 .. xK_9]] hunk ./XMonad/Doc/Extending.hs 1077 -> toAdd x = -> [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) -> , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) +> toAdd XConfig{modMask = modm} = +> [ ((modm , xK_F12 ), xmonadPrompt defaultXPConfig ) +> , ((modm , xK_F3 ), shellPrompt defaultXPConfig ) hunk ./XMonad/Doc/Extending.hs 1081 -> -- Use modMask .|. shiftMask .|. controlMask 1-9 instead -> [( (m .|. modMask x, k), windows $ f i) +> -- Use modm .|. shiftMask .|. controlMask 1-9 instead +> [( (m .|. modm, k), windows $ f i) hunk ./XMonad/Doc/Extending.hs 1091 +NOTE: modm is defined as the modMask you defined (or left as the default) in +your config. hunk ./XMonad/Hooks/DynamicHooks.hs 57 --- > [((modMask conf, xK_i), oneShotHook dynHooksRef +-- > [((modm, xK_i), oneShotHook dynHooksRef hunk ./XMonad/Hooks/DynamicHooks.hs 60 --- > ,((modMask conf, xK_u), addDynamicHook dynHooksRef +-- > ,((modm, xK_u), addDynamicHook dynHooksRef hunk ./XMonad/Hooks/DynamicHooks.hs 62 --- > ,((modMask conf, xK_y), updatePermanentHook dynHooksRef +-- > ,((modm, xK_y), updatePermanentHook dynHooksRef hunk ./XMonad/Hooks/FloatNext.hs 89 --- > , ((modMask, xK_e), toggleFloatNext) +-- > , ((modm, xK_e), toggleFloatNext) hunk ./XMonad/Hooks/FloatNext.hs 94 --- > , ((modMask, xK_r), toggleFloatAllNew) +-- > , ((modm, xK_r), toggleFloatAllNew) hunk ./XMonad/Hooks/FloatNext.hs 143 --- > , ((modMask, xK_e), toggleFloatNext >> runLogHook) +-- > , ((modm, xK_e), toggleFloatNext >> runLogHook) hunk ./XMonad/Hooks/ManageDocks.hs 62 --- > ,((modMask x, xK_b ), sendMessage ToggleStruts) +-- > ,((modm, xK_b ), sendMessage ToggleStruts) hunk ./XMonad/Hooks/ManageDocks.hs 67 --- > ,((modMask x .|. controlMask, xK_t), sendMessage $ ToggleStrut U) +-- > ,((modm .|. controlMask, xK_t), sendMessage $ ToggleStrut U) hunk ./XMonad/Hooks/ManageDocks.hs 168 --- > ,((modMask x .|. shiftMask ,xK_b),sendMessage $ SetStruts [minBound .. maxBound] []) +-- > ,((modm .|. shiftMask ,xK_b),sendMessage $ SetStruts [minBound .. maxBound] []) hunk ./XMonad/Hooks/ManageDocks.hs 172 --- > ,((modMask x .|. controlMask,xK_b),sendMessage $ SetStruts [] [minBound .. maxBound]) +-- > ,((modm .|. controlMask,xK_b),sendMessage $ SetStruts [] [minBound .. maxBound]) hunk ./XMonad/Hooks/ManageDocks.hs 176 --- > ,((modMask x .|. controlMask .|. shiftMask,xK_b),sendMessage $ SetStruts [U,L] [minBound .. maxBound]) +-- > ,((modm .|. controlMask .|. shiftMask,xK_b),sendMessage $ SetStruts [U,L] [minBound .. maxBound]) hunk ./XMonad/Hooks/ManageDocks.hs 180 --- > ,((modMask x .|. controlMask .|. shiftMask,xK_g),sendMessage $ SetStruts [] [D]) +-- > ,((modm .|. controlMask .|. shiftMask,xK_g),sendMessage $ SetStruts [] [D]) hunk ./XMonad/Hooks/Place.hs 71 --- > , ((modMask, xK_w), placeFocused simpleSmart) +-- > , ((modm, xK_w), placeFocused simpleSmart) hunk ./XMonad/Hooks/UrgencyHook.hs 254 --- > , ((modMask , xK_BackSpace), focusUrgent) +-- > , ((modm , xK_BackSpace), focusUrgent) hunk ./XMonad/Hooks/UrgencyHook.hs 261 --- > , ((modMask .|. shiftMask, xK_BackSpace), clearUrgents) +-- > , ((modm .|. shiftMask, xK_BackSpace), clearUrgents) hunk ./XMonad/Layout/BoringWindows.hs 54 --- > , ((modMask, xK_j), focusUp) --- > , ((modMask, xK_k), focusDown) --- > , ((modMask, xK_m), focusMaster) +-- > , ((modm, xK_j), focusUp) +-- > , ((modm, xK_k), focusDown) +-- > , ((modm, xK_m), focusMaster) hunk ./XMonad/Layout/Combo.hs 54 --- > , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_Up ), sendMessage $ Move U) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D) +-- > , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) +-- > , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L) +-- > , ((modm .|. controlMask .|. shiftMask, xK_Up ), sendMessage $ Move U) +-- > , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D) hunk ./XMonad/Layout/ComboP.hs 60 --- > , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_Up ), sendMessage $ Move U) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_s ), sendMessage $ SwapWindow) +-- > , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) +-- > , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L) +-- > , ((modm .|. controlMask .|. shiftMask, xK_Up ), sendMessage $ Move U) +-- > , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D) +-- > , ((modm .|. controlMask .|. shiftMask, xK_s ), sendMessage $ SwapWindow) hunk ./XMonad/Layout/Gaps.hs 57 --- > , ((modMask x .|. controlMask, xK_g), sendMessage $ ToggleGaps) -- toggle all gaps --- > , ((modMask x .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap --- > , ((modMask x .|. controlMask, xK_w), sendMessage $ IncGap R 5) -- increment the right-hand gap --- > , ((modMask x .|. controlMask, xK_q), sendMessage $ DecGap R 5) -- decrement the right-hand gap +-- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps) -- toggle all gaps +-- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap +-- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap R 5) -- increment the right-hand gap +-- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap R 5) -- decrement the right-hand gap hunk ./XMonad/Layout/GridVariants.hs 54 --- > ((modMask .|. shiftMask, xK_equal), sendMessage $ IncMasterCols 1), --- > ((modMask .|. shiftMask, xK_minus), sendMessage $ IncMasterCols (-1)), --- > ((modMask .|. ctrlMask, xK_equal), sendMessage $ IncMasterRows 1), --- > ((modMask .|. ctrlMask, xK_minus), sendMessage $ IncMasterRows (-1)) +-- > ((modm .|. shiftMask, xK_equal), sendMessage $ IncMasterCols 1), +-- > ((modm .|. shiftMask, xK_minus), sendMessage $ IncMasterCols (-1)), +-- > ((modm .|. controlMask, xK_equal), sendMessage $ IncMasterRows 1), +-- > ((modm .|. controlMask, xK_minus), sendMessage $ IncMasterRows (-1)) hunk ./XMonad/Layout/IndependentScreens.hs 51 --- > [((m .|. modMask, k), windows $ f i) +-- > [((m .|. modm, k), windows $ f i) hunk ./XMonad/Layout/IndependentScreens.hs 57 --- > [((m .|. modMask, k), windows $ onCurrentScreen f i) +-- > [((m .|. modm, k), windows $ onCurrentScreen f i) hunk ./XMonad/Layout/LayoutBuilder.hs 73 --- > , ((modMask x .|. shiftMask, xK_h ), sendMessage $ IncLayoutN (-1)) --- > , ((modMask x .|. shiftMask, xK_l ), sendMessage $ IncLayoutN 1) +-- > , ((modm .|. shiftMask, xK_h ), sendMessage $ IncLayoutN (-1)) +-- > , ((modm .|. shiftMask, xK_l ), sendMessage $ IncLayoutN 1) hunk ./XMonad/Layout/LayoutCombinators.hs 81 --- > , ((modMask x .|. controlMask, xK_f), sendMessage $ JumpToLayout "Full") -- jump directly to the Full layout +-- > , ((modm .|. controlMask, xK_f), sendMessage $ JumpToLayout "Full") -- jump directly to the Full layout hunk ./XMonad/Layout/LayoutScreens.hs 42 --- > , ((modMask x .|. shiftMask, xK_space), layoutScreens 2 (TwoPane 0.5 0.5)) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_space), rescreen) +-- > , ((modm .|. shiftMask, xK_space), layoutScreens 2 (TwoPane 0.5 0.5)) +-- > , ((modm .|. controlMask .|. shiftMask, xK_space), rescreen) hunk ./XMonad/Layout/LayoutScreens.hs 51 --- > , ((modMask x .|. shiftMask, xK_space), +-- > , ((modm .|. shiftMask, xK_space), hunk ./XMonad/Layout/LayoutScreens.hs 53 --- > , ((modMask x .|. controlMask .|. shiftMask, xK_space), rescreen) +-- > , ((modm .|. controlMask .|. shiftMask, xK_space), rescreen) hunk ./XMonad/Layout/Magnifier.hs 62 --- > , ((modMask x .|. controlMask , xK_plus ), sendMessage MagnifyMore) --- > , ((modMask x .|. controlMask , xK_minus), sendMessage MagnifyLess) --- > , ((modMask x .|. controlMask , xK_o ), sendMessage ToggleOff ) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_o ), sendMessage ToggleOn ) --- > , ((modMask x .|. controlMask , xK_m ), sendMessage Toggle ) +-- > , ((modm .|. controlMask , xK_plus ), sendMessage MagnifyMore) +-- > , ((modm .|. controlMask , xK_minus), sendMessage MagnifyLess) +-- > , ((modm .|. controlMask , xK_o ), sendMessage ToggleOff ) +-- > , ((modm .|. controlMask .|. shiftMask, xK_o ), sendMessage ToggleOn ) +-- > , ((modm .|. controlMask , xK_m ), sendMessage Toggle ) hunk ./XMonad/Layout/Maximize.hs 46 --- > , ((modMask x, xK_backslash), withFocused (sendMessage . maximizeRestore)) +-- > , ((modm, xK_backslash), withFocused (sendMessage . maximizeRestore)) hunk ./XMonad/Layout/MessageControl.hs 57 --- > ((modMask .|. controlMask, xK_space), sendMessage $ escape NextLayout) +-- > ((modm .|. controlMask, xK_space), sendMessage $ escape NextLayout) hunk ./XMonad/Layout/Minimize.hs 46 --- > , ((modMask', xK_m ), withFocused (\f -> sendMessage (MinimizeWin f))) --- > , ((modMask' .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin) +-- > , ((modm, xK_m ), withFocused (\f -> sendMessage (MinimizeWin f))) +-- > , ((modm .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin) hunk ./XMonad/Layout/Mosaic.hs 59 --- > , ((modMask, xK_a), sendMessage Taller) --- > , ((modMask, xK_z), sendMessage Wider) +-- > , ((modm, xK_a), sendMessage Taller) +-- > , ((modm, xK_z), sendMessage Wider) hunk ./XMonad/Layout/Mosaic.hs 62 --- > , ((modMask, xK_r), sendMessage Reset) +-- > , ((modm, xK_r), sendMessage Reset) hunk ./XMonad/Layout/MosaicAlt.hs 53 --- > , ((modMask x .|. shiftMask , xK_a ), withFocused (sendMessage . expandWindowAlt)) --- > , ((modMask x .|. shiftMask , xK_z ), withFocused (sendMessage . shrinkWindowAlt)) --- > , ((modMask x .|. shiftMask , xK_s ), withFocused (sendMessage . tallWindowAlt)) --- > , ((modMask x .|. shiftMask , xK_d ), withFocused (sendMessage . wideWindowAlt)) --- > , ((modMask x .|. controlMask, xK_space), sendMessage resetAlt) +-- > , ((modm .|. shiftMask , xK_a ), withFocused (sendMessage . expandWindowAlt)) +-- > , ((modm .|. shiftMask , xK_z ), withFocused (sendMessage . shrinkWindowAlt)) +-- > , ((modm .|. shiftMask , xK_s ), withFocused (sendMessage . tallWindowAlt)) +-- > , ((modm .|. shiftMask , xK_d ), withFocused (sendMessage . wideWindowAlt)) +-- > , ((modm .|. controlMask, xK_space), sendMessage resetAlt) hunk ./XMonad/Layout/MouseResizableTile.hs 52 --- > , ((modMask x, xK_u), sendMessage ShrinkSlave) -- %! Shrink a slave area --- > , ((modMask x, xK_i), sendMessage ExpandSlave) -- %! Expand a slave area +-- > , ((modm, xK_u), sendMessage ShrinkSlave) -- %! Shrink a slave area +-- > , ((modm, xK_i), sendMessage ExpandSlave) -- %! Expand a slave area hunk ./XMonad/Layout/MultiToggle.hs 66 --- > , ((modMask, xK_x ), sendMessage $ Toggle MIRROR) +-- > , ((modm, xK_x ), sendMessage $ Toggle MIRROR) hunk ./XMonad/Layout/Reflect.hs 61 --- > , ((modMask x .|. controlMask, xK_x), sendMessage $ Toggle REFLECTX) --- > , ((modMask x .|. controlMask, xK_y), sendMessage $ Toggle REFLECTY) +-- > , ((modm .|. controlMask, xK_x), sendMessage $ Toggle REFLECTX) +-- > , ((modm .|. controlMask, xK_y), sendMessage $ Toggle REFLECTY) hunk ./XMonad/Layout/ResizableTile.hs 45 --- > , ((modMask x, xK_a), sendMessage MirrorShrink) --- > , ((modMask x, xK_z), sendMessage MirrorExpand) +-- > , ((modm, xK_a), sendMessage MirrorShrink) +-- > , ((modm, xK_z), sendMessage MirrorExpand) hunk ./XMonad/Layout/ToggleLayouts.hs 41 --- > , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout) +-- > , ((modm .|. controlMask, xK_space), sendMessage ToggleLayout) hunk ./XMonad/Layout/ToggleLayouts.hs 45 --- > , ((modMask x .|. controlMask, xK_space), sendMessage (Toggle "Full")) +-- > , ((modm .|. controlMask, xK_space), sendMessage (Toggle "Full")) hunk ./XMonad/Layout/WindowArranger.hs 56 --- > , ((modMask x .|. controlMask , xK_s ), sendMessage Arrange ) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_s ), sendMessage DeArrange ) --- > , ((modMask x .|. controlMask , xK_Left ), sendMessage (MoveLeft 1)) --- > , ((modMask x .|. controlMask , xK_Right), sendMessage (MoveRight 1)) --- > , ((modMask x .|. controlMask , xK_Down ), sendMessage (MoveDown 1)) --- > , ((modMask x .|. controlMask , xK_Up ), sendMessage (MoveUp 1)) --- > , ((modMask x .|. shiftMask, xK_Left ), sendMessage (IncreaseLeft 1)) --- > , ((modMask x .|. shiftMask, xK_Right), sendMessage (IncreaseRight 1)) --- > , ((modMask x .|. shiftMask, xK_Down ), sendMessage (IncreaseDown 1)) --- > , ((modMask x .|. shiftMask, xK_Up ), sendMessage (IncreaseUp 1)) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage (DecreaseLeft 1)) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage (DecreaseRight 1)) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage (DecreaseDown 1)) --- > , ((modMask x .|. controlMask .|. shiftMask, xK_Up ), sendMessage (DecreaseUp 1)) +-- > , ((modm .|. controlMask , xK_s ), sendMessage Arrange ) +-- > , ((modm .|. controlMask .|. shiftMask, xK_s ), sendMessage DeArrange ) +-- > , ((modm .|. controlMask , xK_Left ), sendMessage (MoveLeft 1)) +-- > , ((modm .|. controlMask , xK_Right), sendMessage (MoveRight 1)) +-- > , ((modm .|. controlMask , xK_Down ), sendMessage (MoveDown 1)) +-- > , ((modm .|. controlMask , xK_Up ), sendMessage (MoveUp 1)) +-- > , ((modm .|. shiftMask, xK_Left ), sendMessage (IncreaseLeft 1)) +-- > , ((modm .|. shiftMask, xK_Right), sendMessage (IncreaseRight 1)) +-- > , ((modm .|. shiftMask, xK_Down ), sendMessage (IncreaseDown 1)) +-- > , ((modm .|. shiftMask, xK_Up ), sendMessage (IncreaseUp 1)) +-- > , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage (DecreaseLeft 1)) +-- > , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage (DecreaseRight 1)) +-- > , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage (DecreaseDown 1)) +-- > , ((modm .|. controlMask .|. shiftMask, xK_Up ), sendMessage (DecreaseUp 1)) hunk ./XMonad/Layout/WindowNavigation.hs 52 --- > , ((modMask x, xK_Right), sendMessage $ Go R) --- > , ((modMask x, xK_Left ), sendMessage $ Go L) --- > , ((modMask x, xK_Up ), sendMessage $ Go U) --- > , ((modMask x, xK_Down ), sendMessage $ Go D) --- > , ((modMask x .|. controlMask, xK_Right), sendMessage $ Swap R) --- > , ((modMask x .|. controlMask, xK_Left ), sendMessage $ Swap L) --- > , ((modMask x .|. controlMask, xK_Up ), sendMessage $ Swap U) --- > , ((modMask x .|. controlMask, xK_Down ), sendMessage $ Swap D) +-- > , ((modm, xK_Right), sendMessage $ Go R) +-- > , ((modm, xK_Left ), sendMessage $ Go L) +-- > , ((modm, xK_Up ), sendMessage $ Go U) +-- > , ((modm, xK_Down ), sendMessage $ Go D) +-- > , ((modm .|. controlMask, xK_Right), sendMessage $ Swap R) +-- > , ((modm .|. controlMask, xK_Left ), sendMessage $ Swap L) +-- > , ((modm .|. controlMask, xK_Up ), sendMessage $ Swap U) +-- > , ((modm .|. controlMask, xK_Down ), sendMessage $ Swap D) hunk ./XMonad/Layout/WorkspaceDir.hs 59 --- > , ((modMask x .|. shiftMask, xK_x ), changeDir defaultXPConfig) +-- > , ((modm .|. shiftMask, xK_x ), changeDir defaultXPConfig) hunk ./XMonad/Prompt/AppendFile.hs 44 --- > , ((modMask x .|. controlMask, xK_n), appendFilePrompt defaultXPConfig "/home/me/NOTES") +-- > , ((modm .|. controlMask, xK_n), appendFilePrompt defaultXPConfig "/home/me/NOTES") hunk ./XMonad/Prompt/Email.hs 39 --- > , ((modMask x .|. controlMask, xK_e), emailPrompt defaultXPConfig addresses) +-- > , ((modm .|. controlMask, xK_e), emailPrompt defaultXPConfig addresses) hunk ./XMonad/Prompt/Input.hs 62 --- > , ((modMask x .|. controlMask, xK_f), firingPrompt) +-- > , ((modm .|. controlMask, xK_f), firingPrompt) hunk ./XMonad/Prompt/Layout.hs 33 --- > , ((modMask x .|. shiftMask, xK_m ), layoutPrompt defaultXPConfig) +-- > , ((modm .|. shiftMask, xK_m ), layoutPrompt defaultXPConfig) hunk ./XMonad/Prompt/Man.hs 47 --- > , ((modMask x, xK_F1), manPrompt defaultXPConfig) +-- > , ((modm, xK_F1), manPrompt defaultXPConfig) hunk ./XMonad/Prompt/RunOrRaise.hs 40 -> , ((modMask x .|. controlMask, xK_x), runOrRaisePrompt defaultXPConfig) +> , ((modm .|. controlMask, xK_x), runOrRaisePrompt defaultXPConfig) hunk ./XMonad/Prompt/Shell.hs 47 --- > , ((modMask x .|. controlMask, xK_x), shellPrompt defaultXPConfig) +-- > , ((modm .|. controlMask, xK_x), shellPrompt defaultXPConfig) hunk ./XMonad/Prompt/Shell.hs 70 --- > , ((modMask, xK_b), safePrompt "firefox" greenXPConfig) --- > , ((modMask .|. shiftMask, xK_c), prompt ("xterm" ++ " -e") greenXPConfig) +-- > , ((modm, xK_b), safePrompt "firefox" greenXPConfig) +-- > , ((modm .|. shiftMask, xK_c), prompt ("xterm" ++ " -e") greenXPConfig) hunk ./XMonad/Prompt/Ssh.hs 40 --- > , ((modMask x .|. controlMask, xK_s), sshPrompt defaultXPConfig) +-- > , ((modm .|. controlMask, xK_s), sshPrompt defaultXPConfig) hunk ./XMonad/Prompt/Theme.hs 38 --- > , ((modMask x .|. controlMask, xK_t), themePrompt defaultXPConfig) +-- > , ((modm .|. controlMask, xK_t), themePrompt defaultXPConfig) hunk ./XMonad/Prompt/Window.hs 47 --- > , ((modMask x .|. shiftMask, xK_g ), windowPromptGoto defaultXPConfig) --- > , ((modMask x .|. shiftMask, xK_b ), windowPromptBring defaultXPConfig) +-- > , ((modm .|. shiftMask, xK_g ), windowPromptGoto defaultXPConfig) +-- > , ((modm .|. shiftMask, xK_b ), windowPromptBring defaultXPConfig) hunk ./XMonad/Prompt/Window.hs 52 --- > , ((modMask x .|. shiftMask, xK_g ), windowPromptGoto +-- > , ((modm .|. shiftMask, xK_g ), windowPromptGoto hunk ./XMonad/Prompt/Workspace.hs 32 --- > , ((modMask x .|. shiftMask, xK_m ), workspacePrompt defaultXPConfig (windows . W.shift)) +-- > , ((modm .|. shiftMask, xK_m ), workspacePrompt defaultXPConfig (windows . W.shift)) hunk ./XMonad/Prompt/XMonad.hs 35 --- > , ((modMask x .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) +-- > , ((modm .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) hunk ./XMonad/Util/NamedScratchpad.hs 75 --- > , ((modMask x .|. controlMask .|. shiftMask, xK_t), namedScratchpadAction scratchpads "htop") --- > , ((modMask x .|. controlMask .|. shiftMask, xK_s), namedScratchpadAction scratchpads "stardict") --- > , ((modMask x .|. controlMask .|. shiftMask, xK_n), namedScratchpadAction scratchpads "notes") +-- > , ((modm .|. controlMask .|. shiftMask, xK_t), namedScratchpadAction scratchpads "htop") +-- > , ((modm .|. controlMask .|. shiftMask, xK_s), namedScratchpadAction scratchpads "stardict") +-- > , ((modm .|. controlMask .|. shiftMask, xK_n), namedScratchpadAction scratchpads "notes") hunk ./XMonad/Util/Run.hs 103 -> , ((modMask, xK_Print), unsafeSpawn "import -window root $HOME/xwd-$(date +%s)$$.png") -> , ((modMask, xK_d ), safeSpawn "firefox" "") +> , ((modm, xK_Print), unsafeSpawn "import -window root $HOME/xwd-$(date +%s)$$.png") +> , ((modm, xK_d ), safeSpawn "firefox" "") hunk ./XMonad/Util/XSelection.hs 43 - > , ((modMask .|. shiftMask, xK_b), promptSelection "firefox") + > , ((modm .|. shiftMask, xK_b), promptSelection "firefox") hunk ./XMonad/Hooks/EwmhDesktops.hs 18 + ewmh, hunk ./XMonad/Hooks/EwmhDesktops.hs 43 --- > main = xmonad defaultConfig { startupHook = ewmhDesktopsStartup --- > , handleEventHook = ewmhDesktopsEventHook --- > , logHook = ewmhDesktopsLogHook } +-- > main = xmonad $ ewmh defaultConfig hunk ./XMonad/Hooks/EwmhDesktops.hs 48 +-- | Add EWMH functionality to the given config. See above for an example. +ewmh :: XConfig a -> XConfig a +ewmh c = c { startupHook = startupHook c +++ ewmhDesktopsStartup + , handleEventHook = handleEventHook c +++ ewmhDesktopsEventHook + , logHook = logHook c +++ ewmhDesktopsLogHook } + where x +++ y = mappend x y + hunk ./XMonad/Hooks/EwmhDesktops.hs 66 - hunk ./XMonad/Config/Desktop.hs 169 -desktopConfig = defaultConfig - { startupHook = ewmhDesktopsStartup >> setDefaultCursor xC_left_ptr - , logHook = ewmhDesktopsLogHook +desktopConfig = ewmh defaultConfig + { startupHook = setDefaultCursor xC_left_ptr hunk ./XMonad/Config/Desktop.hs 173 - , handleEventHook = ewmhDesktopsEventHook hunk ./XMonad/Config/Droundy.hs 46 -import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsStartup, ewmhDesktopsLogHook, - ewmhDesktopsEventHook ) +import XMonad.Hooks.EwmhDesktops ( ewmh ) hunk ./XMonad/Config/Droundy.hs 120 -config = defaultConfig +config = ewmh defaultConfig hunk ./XMonad/Config/Droundy.hs 133 - , logHook = ewmhDesktopsLogHook -- actually, no logging here, just other stuff - , startupHook = ewmhDesktopsStartup hunk ./XMonad/Config/Droundy.hs 136 - , handleEventHook = ewmhDesktopsEventHook hunk ./XMonad/Config/Sjanssen.hs 29 - return $ defaultConfig + return . ewmh $ defaultConfig hunk ./XMonad/Config/Sjanssen.hs 38 - , logHook = ewmhDesktopsLogHook - , startupHook = ewmhDesktopsStartup hunk ./XMonad/Actions/MouseResize.hs 50 --- > myLayouts = mouseResize $ windowArrange $ layoutHook defaultConfig +-- > myLayout = mouseResize $ windowArrange $ layoutHook defaultConfig hunk ./XMonad/Actions/MouseResize.hs 54 --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Actions/TopicSpace.hs 183 --- , layoutHook = myModifiers myLayouts +-- , layoutHook = myModifiers myLayout hunk ./XMonad/Layout/Accordion.hs 33 --- > myLayouts = Accordion ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = Accordion ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/BoringWindows.hs 49 --- > myLayouts = boringWindows (Full ||| etc..) --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = boringWindows (Full ||| etc..) +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/Circle.hs 34 --- > myLayouts = Circle ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = Circle ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/Cross.hs 31 --- > myLayouts = simpleCross ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = simpleCross ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/Dishes.hs 36 --- > myLayouts = Dishes 2 (1/6) ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = Dishes 2 (1/6) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/DragPane.hs 43 --- > myLayouts = dragPane Horizontal 0.1 0.5 ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = dragPane Horizontal 0.1 0.5 ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/FixedColumn.hs 45 --- > myLayouts = FixedColumn 1 20 80 10 ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = FixedColumn 1 20 80 10 ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/Grid.hs 33 --- > myLayouts = Grid ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = Grid ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/Grid.hs 40 --- > myLayouts = GridRatio (4/3) ||| etc. +-- > myLayout = GridRatio (4/3) ||| etc. hunk ./XMonad/Layout/HintedGrid.hs 44 --- > myLayouts = Grid False ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = Grid False ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/HintedGrid.hs 50 --- > myLayouts = GridRatio (4/3) False ||| etc. +-- > myLayout = GridRatio (4/3) False ||| etc. hunk ./XMonad/Layout/IM.hs 48 --- > myLayouts = withIM (1%7) (ClassName "Tkabber") Grid ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = withIM (1%7) (ClassName "Tkabber") Grid ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/LayoutBuilder.hs 44 --- > myLayouts = ( (layoutN 1 (relBox 0 0 0.5 1) (Just $ relBox 0 0 1 1) $ simpleTabbed) +-- > myLayout = ( (layoutN 1 (relBox 0 0 0.5 1) (Just $ relBox 0 0 1 1) $ simpleTabbed) hunk ./XMonad/Layout/LayoutBuilder.hs 55 --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/LayoutCombinators.hs 67 --- > myLayouts = (Tall 1 (3/100) (1/2) *//* Full) ||| (Tall 1 (3/100) (1/2) ***||** Full) ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = (Tall 1 (3/100) (1/2) *//* Full) ||| (Tall 1 (3/100) (1/2) ***||** Full) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/LayoutHints.hs 50 --- > myLayouts = layoutHints (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = layoutHints (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/LayoutHints.hs 55 --- > myLayouts = layoutHintsWithPlacement (0.5, 0.5) (Tall 1 (3/100) (1/2)) +-- > myLayout = layoutHintsWithPlacement (0.5, 0.5) (Tall 1 (3/100) (1/2)) hunk ./XMonad/Layout/LayoutHints.hs 60 --- > myLayouts = layoutHintsToCenter (Tall 1 (3/100) (1/2)) +-- > myLayout = layoutHintsToCenter (Tall 1 (3/100) (1/2)) hunk ./XMonad/Layout/MagicFocus.hs 42 --- > myLayouts = magicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts, +-- > myLayout = magicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout, hunk ./XMonad/Layout/Magnifier.hs 44 --- > myLayouts = magnifier (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = magnifier (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/Maximize.hs 37 --- > myLayouts = maximize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = maximize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/Minimize.hs 37 --- > myLayouts = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/Monitor.hs 79 --- > myLayouts = ModifiedLayout clock $ tall ||| Full ||| ... +-- > myLayout = ModifiedLayout clock $ tall ||| Full ||| ... hunk ./XMonad/Layout/Mosaic.hs 49 --- > myLayouts = mosaic 2 [3,2] ||| Full ||| etc.. --- > main = xmonad $ defaultConfig { layoutHook = myLayouts } +-- > myLayout = mosaic 2 [3,2] ||| Full ||| etc.. +-- > main = xmonad $ defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/MosaicAlt.hs 44 --- > myLayouts = MosaicAlt M.empty ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = MosaicAlt M.empty ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/MouseResizableTile.hs 38 --- > myLayouts = mouseResizableTile ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = mouseResizableTile ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/MouseResizableTile.hs 43 --- > myLayouts = mouseResizableTileMirrored ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = mouseResizableTileMirrored ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/Named.hs 35 --- > myLayouts = named "real big" Full ||| (nameTail $ named "real big" $ Full) ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = named "real big" Full ||| (nameTail $ named "real big" $ Full) ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/ResizableTile.hs 36 --- > myLayouts = ResizableTall 1 (3/100) (1/2) [] ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = ResizableTall 1 (3/100) (1/2) [] ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/Roledex.hs 35 --- > myLayouts = Roledex ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = Roledex ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/SimpleFloat.hs 41 --- > myLayouts = simpleFloat ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = simpleFloat ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/Simplest.hs 32 --- > myLayouts = Simplest ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = Simplest ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/SimplestFloat.hs 36 --- > myLayouts = simplestFloat ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = simplestFloat ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/Spiral.hs 37 --- > myLayouts = spiral (6/7) ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = spiral (6/7) ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/StackTile.hs 35 --- > myLayouts = StackTile 1 (3/100) (1/2) ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = StackTile 1 (3/100) (1/2) ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/SubLayouts.hs 125 --- > myLayouts = windowNavigation $ subTabbed $ boringWindows $ +-- > myLayout = windowNavigation $ subTabbed $ boringWindows $ hunk ./XMonad/Layout/SubLayouts.hs 127 --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/Tabbed.hs 46 --- > myLayouts = simpleTabbed ||| Full ||| etc.. +-- > myLayout = simpleTabbed ||| Full ||| etc.. hunk ./XMonad/Layout/Tabbed.hs 50 --- > myLayouts = tabbed shrinkText defaultTheme ||| Full ||| etc.. +-- > myLayout = tabbed shrinkText defaultTheme ||| Full ||| etc.. hunk ./XMonad/Layout/Tabbed.hs 54 --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/ThreeColumns.hs 41 --- > myLayouts = ThreeCol 1 (3/100) (1/2) ||| ThreeColMid 1 (3/100) (1/2) ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = ThreeCol 1 (3/100) (1/2) ||| ThreeColMid 1 (3/100) (1/2) ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/ToggleLayouts.hs 32 --- > myLayouts = toggleLayouts Full (Tall 1 (3/100) (1/2)) ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = toggleLayouts Full (Tall 1 (3/100) (1/2)) ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/TwoPane.hs 35 --- > myLayouts = TwoPane (3/100) (1/2) ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = TwoPane (3/100) (1/2) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/WindowNavigation.hs 43 --- > myLayouts = windowNavigation (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = windowNavigation (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/WorkspaceDir.hs 49 --- > myLayouts = workspaceDir "~" (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. --- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- > myLayout = workspaceDir "~" (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Actions/CycleWindows.hs 12 --- stack while maintaining focus in place. Bindings are available to: +-- stack while maintaining focus in place. +-- +-- Bindings are available to: hunk ./XMonad/Config/Desktop.hs 75 --- @XMonad.Config@ hierarchy. The following setup and customization examples +-- @XMonad.Config@ namespace. The following setup and customization examples hunk ./XMonad/Doc/Configuring.hs 52 -NOTE for users of previous versions (< 0.5) of xmonad: this is a major -change in the way xmonad is configured. Prior to version 0.5, -configuring xmonad required editing an xmonad source file called -Config.hs, recompiling xmonad, and then restarting. From version 0.5 -onwards, however, you should NOT edit this file. All you have to do -is edit xmonad.hs and restart with @mod-q@; xmonad does the -recompiling itself. The format of the configuration file has also -changed; it is now simpler and much shorter, only requiring you to -list those settings which are different from the defaults. +HISTORICAL NOTE regarding upgrading from versions (< 0.5) of xmonad +or using old documentation: hunk ./XMonad/Doc/Configuring.hs 55 +xmonad-0.5 delivered a major change in the way xmonad is configured. Prior +to version 0.5, configuring xmonad required editing a source file called +Config.hs, manually recompiling xmonad, and then restarting. From +version 0.5 onwards, however, you should NOT edit this file or manually +compile with ghc --make. All you have to do is edit xmonad.hs and restart +with @mod-q@; xmonad does the recompiling itself. The format of the +configuration file also changed with version 0.5; enabling simpler and +much shorter xmonad.hs files that only require listing those settings which +are different from the defaults. + +While the complicated template.hs (man/xmonad.hs) files listing all default +settings are still provided for reference, once you wish to make substantial +changes to your configuration, the template.hs style configuration is not +recommended. It is fine to use top-level definitions to organize your +xmonad.hs, but wherever possible it is better to leave out settings that +simply duplicate defaults. hunk ./XMonad/Doc/Configuring.hs 102 -the xmonad wiki at -@http:\/\/haskell.org\/haskellwiki\/Xmonad\/Config_archive\/Template_xmonad.hs@) +the xmonad wiki config archive at +) hunk ./XMonad/Doc/Configuring.hs 147 -GHC and xmonad are in your @$PATH@. +GHC and xmonad are in the @$PATH@ in the environment from which xmonad +is started. hunk ./XMonad/Doc/Extending.hs 145 - between screens. Replaces "XMonad.Actions.RotView". + between screens. Replaces the former XMonad.Actions.RotView. hunk ./XMonad/Doc/Extending.hs 236 - Provides a simple binding that pushes all floating windows on the - current workspace back into tiling. Use the more general general + (Deprecated) Provides a simple binding that pushes all floating windows on the + current workspace back into tiling. Instead, use the more general hunk ./XMonad/Doc/Extending.hs 304 + Fixes some keybindings for users of French keyboard layouts. hunk ./XMonad/Doc/Extending.hs 307 - This module provides a config suitable for use with a desktop - environment such as KDE or GNOME. + This module provides core desktop environment settings used + in the Gnome, Kde, and Xfce config configs. It is also useful + for people using other environments such as lxde, or using + tray or panel applications without full desktop environments. hunk ./XMonad/Doc/Extending.hs 320 - hunk ./XMonad/Doc/Extending.hs 346 +* 'XMonad.Core.handleEventHook': this hook is called on all events handled + by xmonad, thus it is extremely powerful. See "Graphics.X11.Xlib.Extras" + and xmonad source and development documentation for more details. + hunk ./XMonad/Doc/Extending.hs 400 - Set a default cursor on startup. - Thanks to Andres Salomon for his initial idea for this startup hook. + Set a default mouse cursor on startup. hunk ./XMonad/Doc/Extending.hs 429 -different layouts, such as "XMonad.Layout.Combo", or +different layouts, such as "XMonad.Layout.Combo", "XMonad.Layout.ComboP", +"XMonad.Layout.LayoutBuilder", "XMonad.Layout.SubLayouts", or hunk ./XMonad/Doc/Extending.hs 466 - Circle is an elliptical, overlapping layout, by Peter De Wachter + Circle is an elliptical, overlapping layout. hunk ./XMonad/Doc/Extending.hs 499 - layout order. + layout order. See also "XMonad.Layout.MouseResizableTall" hunk ./XMonad/Doc/Extending.hs 562 - + hunk ./XMonad/Doc/Extending.hs 634 - Provides layout named OneBig. It places one (master) window at top left corner of screen, and other (slave) windows at top + Places one (master) window at top left corner of screen, and other (slave) + windows at the top. hunk ./XMonad/Doc/Extending.hs 646 + See also "XMonad.Layout.MouseResizableTile". hunk ./XMonad/Doc/Extending.hs 669 - A very simple layout. The simplest, afaik. + A very simple layout. The simplest, afaik. Used as a base for + decorated layouts. hunk ./XMonad/Doc/Extending.hs 721 + See also "XMonad.Actions.WindowNavigation". hunk ./XMonad/Doc/Extending.hs 856 - Named scratchpads that support several arbitrary applications at the same time. + Like "XMonad.Util.Scratchpad" toggle windows to and from the current + workspace. Supports several arbitrary applications at the same time. hunk ./XMonad/Doc/Extending.hs 877 - Very handy hotkey-launched floating terminal window. + Very handy hotkey-launched toggleable floating terminal window. hunk ./XMonad/Doc/Extending.hs 935 -> myKeys x = +> myKeys conf@(XConfig {XMonad.modMask = modm}) = hunk ./XMonad/Doc/Extending.hs 948 -. + hunk ./XMonad/Doc/Extending.hs 959 -Adding key bindings can be done in different ways. The type signature -of 'XMonad.Core.XConfig.keys' is: +Adding key bindings can be done in different ways. See the end of this +section for the easiest ways. The type signature of +'XMonad.Core.XConfig.keys' is: hunk ./XMonad/Doc/Extending.hs 980 -> myKeys x = +> myKeys conf@(XConfig {XMonad.modMask = modm}) = hunk ./XMonad/Doc/Extending.hs 1013 -> myKeys x = +> myKeys conf@(XConfig {XMonad.modMask = modm}) = hunk ./README 1 -3rd party xmonad extensions and contributions. + xmonad-contrib : third party extensions to the xmonad window manager hunk ./README 3 -Build and install through Cabal as for other Haskell packages: + http://xmonad.org hunk ./README 5 - runhaskell Setup configure --user --prefix=$HOME - runhaskell Setup build - runhaskell Setup install --user + You need the ghc compiler and xmonad window manager installed in + order to use these extensions. hunk ./README 8 -(You may want to remove the --user flag when installing as root.) + For installation and configuration instructions, please see the + xmonad website, the documents included with the xmonad source + distribution, and online haddock documentation: hunk ./README 12 -scripts/ contains further external programs useful with xmonad. + http://www.xmonad.org/xmonad-docs hunk ./README 14 -Haskell code contributed to this repo should live under the -appropriate subdivision of the 'XMonad.' namespace (currently includes -Actions, Config, Hooks, Layout, Prompt, and Util). For example, to use -the Mosaic layout, one would import: +------------------------------------------------------------------------ + +Changelogs hunk ./README 18 - XMonad.Layout.Mosaic + For a list of changes since the 0.8.x releases, see: + +http://www.haskell.org/haskellwiki/Xmonad/Notable_changes_since_0.8 + +------------------------------------------------------------------------ + +Updates to XMonadContrib-0.9 that may Require Changes to ~/.xmonad/xmonad.hs + + Please see the Changelogs and xmonad-contrib haddock documentation + links for further details regarding the following changes. + + * XMonad.Hooks.EwmhDesktops no longer uses layoutHook, the + ewmhDesktopsLayout modifier has been removed from xmonad-contrib. It + uses logHook, handleEventHook, and startupHook instead and provides + a convenient function 'ewmh' to add EWMH support to a defaultConfig. + + * Most DynamicLog users can continue with configs unchanged, but users + of the quickbar functions 'xmobar' or 'dzen' will need to change + xmonad.hs: their types have changed to allow easier composition with + other XConfig modifiers. The 'dynamicLogDzen' and 'dynamicLogXmobar' + functions have been removed. + + * WindowGo or safeSpawn users may need to change command lines due to + safeSpawn changes. + + * People explicitly referencing the "SP" scratchpad workspace should + change it to "NSP" which is also used by the new Util.NamedScratchpad. + + * (Optional) People who explicitly use swapMaster in key or mouse + bindings should change it to shiftMaster. It's the current default + used where swapMaster had been used previously. It works better than + swapMaster when using floating and tiled windows together on the + same workspace. + +------------------------------------------------------------------------ + +Getting or updating XMonadContrib + + latest release: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib + + darcs version: darcs get http://code.haskell.org/XMonadContrib + + (To use darcs xmonad-contrib you must also use the darcs version + of xmonad.) + +------------------------------------------------------------------------ + +Contributing + + Haskell code contributed to this repo should live under the + appropriate subdivision of the 'XMonad.' namespace (currently + includes Actions, Config, Hooks, Layout, Prompt, and Util). For + example, to use the Grid layout, one would import: + + XMonad.Layout.Grid + + For further details, see the documentation for the + XMonad.Doc.Developing module and http://xmonad.org website. hunk ./README 83 - -Documentation for the extensions and configuration system is available -in Haddock form in the XMonad.Doc module and submodules. hunk ./xmonad-contrib.cabal 2 -version: 0.8.1 +version: 0.9 hunk ./xmonad-contrib.cabal 52 - build-depends: mtl, unix, X11>=1.4.6.1, xmonad>=0.8, xmonad<0.9, utf8-string + build-depends: mtl, unix, X11>=1.4.6.1, xmonad>=0.9, xmonad<1, utf8-string hunk ./XMonad/Util/Run.hs 144 + closeFd rd hunk ./XMonad/Hooks/DynamicLog.hs 267 - where printer | S.tag w == this = ppCurrent + where printer | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents = ppUrgent + | S.tag w == this = ppCurrent hunk ./XMonad/Hooks/DynamicLog.hs 270 - | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents = \ppC -> ppUrgent ppC . ppHidden ppC hunk ./XMonad/Hooks/DynamicLog.hs 342 --- | Strip dzen formatting or commands. Useful to remove ppHidden --- formatting in ppUrgent field. For example: --- --- > , ppHidden = dzenColor "gray20" "" . wrap "(" ")" --- > , ppUrgent = dzenColor "dark orange" "" . dzenStrip +-- | Strip dzen formatting or commands. hunk ./XMonad/Hooks/DynamicLog.hs 363 --- | Strip xmobar markup. Useful to remove ppHidden color from ppUrgent --- field. For example: --- --- > , ppHidden = xmobarColor "gray20" "" . wrap "<" ">" --- > , ppUrgent = xmobarColor "dark orange" "" . xmobarStrip +-- | Strip xmobar markup. hunk ./XMonad/Hooks/DynamicLog.hs 389 - -- NOTE that 'ppUrgent' is applied /in addition to/ - -- 'ppHidden'! hunk ./XMonad/Hooks/DynamicLog.hs 444 --- | Settings to emulate dwm's statusbar, dzen only. Uses dzenStrip in --- ppUrgent. +-- | Settings to emulate dwm's statusbar, dzen only. hunk ./XMonad/Hooks/DynamicLog.hs 450 - , ppUrgent = dzenColor "red" "yellow" . dzenStrip + , ppUrgent = dzenColor "red" "yellow" . pad hunk ./XMonad/Hooks/DynamicLog.hs 468 - , ppUrgent = xmobarColor "red" "yellow" + , ppUrgent = xmobarColor "red" "yellow" hunk ./XMonad/Hooks/DynamicLog.hs 484 - , ppUrgent = dzenColor "red" "yellow" + , ppUrgent = dzenColor "red" "yellow" . pad addfile ./XMonad/Layout/MultiColumns.hs hunk ./XMonad/Layout/MultiColumns.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.MultiColumns +-- Copyright : (c) Anders Engstrom +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Anders Engstrom +-- Stability : unstable +-- Portability : unportable +-- +-- This layout tiles windows in a growing number of columns. The number of +-- windows in each column can be controlled by messages. +----------------------------------------------------------------------------- + +module XMonad.Layout.MultiColumns ( + -- * Usage + -- $usage + + multiCol + ) where + +import XMonad +import qualified XMonad.StackSet as W + +import Control.Monad + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.MultiColumns +-- +-- Then edit your @layoutHook@ by adding the multiCol layout: +-- +-- > myLayouts = multiCol [1] 4 0.01 0.5 ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- Or alternatively: +-- +-- > myLayouts = Mirror (multiCol [1] 2 0.01 (-0.25)) ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- The maximum number of windows in a column can be controlled using the +-- IncMasterN messages and the column containing the focused window will be +-- modified. If the value is 0, all remaining windows will be placed in that +-- column when all columns before that has been filled. +-- +-- The size can be set to between 1 and -0.5. If the value is positive, the +-- master column will be of that size. The rest of the screen is split among +-- the other columns. But if the size is negative, it instead indicates the +-- size of all non-master columns and the master column will cover the rest of +-- the screen. If the master column would become smaller than the other +-- columns, the screen is instead split equally among all columns. Therefore, +-- if equal size among all columns are desired, set the size to -0.5. +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +-- | Layout creator. +multiCol + :: [Int] -- ^ Windows in each column, starting with master. Set to 0 to catch the rest. + -> Int -- ^ Default value for all following columns. + -> Rational -- ^ How much to change size each time. + -> Rational -- ^ Initial size of master area, or column area if the size is negative. + -> MultiCol a +multiCol n defn ds s = MultiCol (map (max 1) n) (max 1 defn) ds s 0 + +data MultiCol a = MultiCol + { multiColNWin :: ![Int] + , multiColDefWin :: !Int + , multiColDeltaSize :: !Rational + , multiColSize :: !Rational + , multiColActive :: !Int + } deriving (Show,Read,Eq) + +instance LayoutClass MultiCol a where + doLayout l r s = return (zip w rlist, resl) + where rlist = doL (multiColNWin l') (multiColSize l') r wlen + w = W.integrate s + wlen = length w + -- Make sure the list of columns is big enough and update active column + nw = multiColNWin l ++ repeat (multiColDefWin l) + l' = l { multiColNWin = take (getCol (wlen-1) nw + 1) nw + , multiColActive = getCol (length $ W.up s) (multiColNWin l) + } + -- Only return new layout if it has been modified + resl = if l'==l + then Nothing + else Just l' + handleMessage l m = + return $ msum [fmap resize (fromMessage m) + ,fmap incmastern (fromMessage m)] + where resize Shrink = l { multiColSize = max (-0.5) $ s-ds } + resize Expand = l { multiColSize = min 1 $ s+ds } + incmastern (IncMasterN x) + = l { multiColNWin = take a n ++ [newval] ++ tail r } + where newval = max 0 $ head r + x + r = drop a n + n = multiColNWin l + ds = multiColDeltaSize l + s = multiColSize l + a = multiColActive l + description _ = "MultiCol" + + +-- Get which column a window is in. +getCol :: Int -> [Int] -> Int +getCol w (n:ns) = if n<1 || w < n + then 0 + else 1 + getCol (w-n) ns +-- Should never occur... +getCol _ _ = -1 + +doL :: [Int] -> Rational -> Rectangle -> Int -> [Rectangle] +doL nwin s r n = rlist + where -- Number of columns to tile + size = floor $ abs s * fromIntegral (rect_width r) + ncol = getCol (n-1) nwin + 1 + -- Extract all but last column to tile + c = take (ncol-1) nwin + -- Compute number of windows in last column and add it to the others + col = c ++ [n-sum c] + -- Compute width of columns + width = if s>0 + then if ncol==1 + then [fromIntegral $ rect_width r] + else size:replicate (ncol-1) ((fromIntegral (rect_width r) - size) `div` (ncol-1)) + else if fromIntegral ncol * abs s >= 1 + -- Split equally + then replicate ncol $ fromIntegral (rect_width r) `div` ncol + -- Let the master cover what is left... + else (fromIntegral (rect_width r) - (ncol-1)*size):replicate (ncol-1) size + -- Compute the horizontal position of columns + xpos = accumEx (fromIntegral $ rect_x r) width + -- Exclusive accumulation + accumEx a (x:xs) = a:accumEx (a+x) xs + accumEx _ _ = [] + -- Create a rectangle for each column + cr = zipWith (\x w -> r { rect_x=fromIntegral x, rect_width=fromIntegral w }) xpos width + -- Split the columns into the windows + rlist = concat $ zipWith (\num rect -> splitVertically num rect) col cr hunk ./xmonad-contrib.cabal 174 + XMonad.Layout.MultiColumns hunk ./XMonad/Layout/MultiColumns.hs 85 - l' = l { multiColNWin = take (getCol (wlen-1) nw + 1) nw + l' = l { multiColNWin = take (max (length $ multiColNWin l) $ getCol (wlen-1) nw + 1) nw hunk ./XMonad/Layout/MultiColumns.hs 80 - where rlist = doL (multiColNWin l') (multiColSize l') r wlen - w = W.integrate s - wlen = length w - -- Make sure the list of columns is big enough and update active column - nw = multiColNWin l ++ repeat (multiColDefWin l) - l' = l { multiColNWin = take (max (length $ multiColNWin l) $ getCol (wlen-1) nw + 1) nw - , multiColActive = getCol (length $ W.up s) (multiColNWin l) - } - -- Only return new layout if it has been modified - resl = if l'==l - then Nothing - else Just l' + where rlist = doL (multiColNWin l') (multiColSize l') r wlen + w = W.integrate s + wlen = length w + -- Make sure the list of columns is big enough and update active column + nw = multiColNWin l ++ repeat (multiColDefWin l) + l' = l { multiColNWin = take (max (length $ multiColNWin l) $ getCol (wlen-1) nw + 1) nw + , multiColActive = getCol (length $ W.up s) nw + } + -- Only return new layout if it has been modified + resl = if l'==l + then Nothing + else Just l' hunk ./XMonad/Layout/MultiColumns.hs 97 - incmastern (IncMasterN x) - = l { multiColNWin = take a n ++ [newval] ++ tail r } - where newval = max 0 $ head r + x - r = drop a n + incmastern (IncMasterN x) = l { multiColNWin = take a n ++ [newval] ++ tail r } + where newval = max 0 $ head r + x + r = drop a n hunk ./XMonad/Layout/MultiColumns.hs 107 --- Get which column a window is in. +-- | Get which column a window is in, starting at 0. hunk ./XMonad/Layout/MultiColumns.hs 117 - where -- Number of columns to tile - size = floor $ abs s * fromIntegral (rect_width r) - ncol = getCol (n-1) nwin + 1 - -- Extract all but last column to tile - c = take (ncol-1) nwin - -- Compute number of windows in last column and add it to the others - col = c ++ [n-sum c] - -- Compute width of columns - width = if s>0 - then if ncol==1 - then [fromIntegral $ rect_width r] - else size:replicate (ncol-1) ((fromIntegral (rect_width r) - size) `div` (ncol-1)) - else if fromIntegral ncol * abs s >= 1 - -- Split equally - then replicate ncol $ fromIntegral (rect_width r) `div` ncol - -- Let the master cover what is left... - else (fromIntegral (rect_width r) - (ncol-1)*size):replicate (ncol-1) size - -- Compute the horizontal position of columns - xpos = accumEx (fromIntegral $ rect_x r) width - -- Exclusive accumulation - accumEx a (x:xs) = a:accumEx (a+x) xs - accumEx _ _ = [] - -- Create a rectangle for each column - cr = zipWith (\x w -> r { rect_x=fromIntegral x, rect_width=fromIntegral w }) xpos width - -- Split the columns into the windows - rlist = concat $ zipWith (\num rect -> splitVertically num rect) col cr + where -- Number of columns to tile + size = floor $ abs s * fromIntegral (rect_width r) + ncol = getCol (n-1) nwin + 1 + -- Extract all but last column to tile + c = take (ncol-1) nwin + -- Compute number of windows in last column and add it to the others + col = c ++ [n-sum c] + -- Compute width of columns + width = if s>0 + then if ncol==1 + then [fromIntegral $ rect_width r] + else size:replicate (ncol-1) ((fromIntegral (rect_width r) - size) `div` (ncol-1)) + else if fromIntegral ncol * abs s >= 1 + -- Split equally + then replicate ncol $ fromIntegral (rect_width r) `div` ncol + -- Let the master cover what is left... + else (fromIntegral (rect_width r) - (ncol-1)*size):replicate (ncol-1) size + -- Compute the horizontal position of columns + xpos = accumEx (fromIntegral $ rect_x r) width + -- Exclusive accumulation + accumEx a (x:xs) = a:accumEx (a+x) xs + accumEx _ _ = [] + -- Create a rectangle for each column + cr = zipWith (\x w -> r { rect_x=fromIntegral x, rect_width=fromIntegral w }) xpos width + -- Split the columns into the windows + rlist = concat $ zipWith (\num rect -> splitVertically num rect) col cr hunk ./XMonad/Hooks/ManageHelpers.hs 31 + currentWs, hunk ./XMonad/Hooks/ManageHelpers.hs 122 +-- | Return the current workspace +currentWs :: Query WorkspaceId +currentWs = liftX (withWindowSet $ return . W.currentTag) + hunk ./XMonad/Layout/MultiColumns.hs 61 --- | Layout creator. +-- | Layout constructor. hunk ./XMonad/Layout/MultiColumns.hs 68 -multiCol n defn ds s = MultiCol (map (max 1) n) (max 1 defn) ds s 0 +multiCol n defn ds s = MultiCol (map (max 0) n) (max 0 defn) ds s 0 hunk ./XMonad/Layout/MultiColumns.hs 118 - size = floor $ abs s * fromIntegral (rect_width r) hunk ./XMonad/Layout/MultiColumns.hs 119 + -- Compute the actual size + size = floor $ abs s * fromIntegral (rect_width r) hunk ./XMonad/Layout/MultiColumns.hs 128 + -- Only one window hunk ./XMonad/Layout/MultiColumns.hs 130 + -- Give the master it's space and split the rest equally for the other columns hunk ./XMonad/Hooks/FadeInactive.hs 47 --- For more detailed instructions on editing the layoutHook see: +-- For more detailed instructions on editing the logHook see: hunk ./XMonad/Prompt.hs 32 - , pasteString, copyString, moveCursor + , pasteString, moveCursor hunk ./XMonad/Prompt.hs 70 -import XMonad.Util.XSelection (getSelection, putSelection) +import XMonad.Util.XSelection (getSelection) hunk ./XMonad/Prompt.hs 406 - , (xK_c, copyString) hunk ./XMonad/Prompt.hs 507 --- | Copy the currently entered string into the X selection. -copyString :: XP () -copyString = gets command >>= io . putSelection - hunk ./XMonad/Util/XSelection.hs 12 -'getSelection' and 'putSelection' are adaptations of Hxsel.hs and Hxput.hs from the XMonad-utils, available: +'getSelection' is an adaptation of Hxsel.hs and Hxput.hs from the XMonad-utils, available: hunk ./XMonad/Util/XSelection.hs 23 - transformSafePromptSelection, - putSelection) where + transformSafePromptSelection) where hunk ./XMonad/Util/XSelection.hs 25 -import Control.Concurrent (forkIO) hunk ./XMonad/Util/XSelection.hs 27 -import Data.Char (ord) hunk ./XMonad/Util/XSelection.hs 81 --- | Set the current X Selection to a specified string. -putSelection :: MonadIO m => String -> m () -putSelection text = io $ do - dpy <- openDisplay "" - let dflt = defaultScreen dpy - rootw <- rootWindow dpy dflt - win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0 - p <- internAtom dpy "PRIMARY" True - ty <- internAtom dpy "UTF8_STRING" False - xSetSelectionOwner dpy p win currentTime - winOwn <- xGetSelectionOwner dpy p - if winOwn == win - then do forkIO ((allocaXEvent $ processEvent dpy ty text) >> destroyWindow dpy win) >> return () - else do putStrLn "Unable to obtain ownership of the selection" >> destroyWindow dpy win - return () - where - processEvent :: Display -> Atom -> [Char] -> XEventPtr -> IO () - processEvent dpy ty txt e = do - nextEvent dpy e - ev <- getEvent e - if ev_event_type ev == selectionRequest - then do print ev - allocaXEvent $ \replyPtr -> do - changeProperty8 (ev_event_display ev) - (ev_requestor ev) - (ev_property ev) - ty - propModeReplace - (map (fromIntegral . ord) txt) - setSelectionNotify replyPtr (ev_requestor ev) (ev_selection ev) - (ev_target ev) (ev_property ev) (ev_time ev) - sendEvent dpy (ev_requestor ev) False noEventMask replyPtr - sync dpy False - else do putStrLn "Unexpected Message Received" - print ev - processEvent dpy ty text e - hunk ./XMonad/Prompt.hs 33 + , setInput, getInput hunk ./XMonad/Prompt.hs 251 +-- | Sets the input string to the given value. +setInput :: String -> XP () +setInput = modify . setCommand + +-- | Returns the current input string. Intented for use in custom keymaps +-- where the 'get' or similar can't be used to retrieve it. +getInput :: XP String +getInput = gets command + hunk ./XMonad/Util/WindowProperties.hs 52 -hasProperty (Title s) w = withDisplay $ \d -> fmap (Just s ==) $ io $ fetchName d w -hasProperty (Resource s) w = withDisplay $ \d -> fmap ((==) s . resName ) $ io $ getClassHint d w -hasProperty (ClassName s) w = withDisplay $ \d -> fmap ((==) s . resClass) $ io $ getClassHint d w -hasProperty (Role s) w = withDisplay $ \d -> fmap ((==) (Just s)) $ getStringProperty d w "WM_WINDOW_ROLE" -hasProperty (Machine s) w = withDisplay $ \d -> fmap ((==) (Just s)) $ getStringProperty d w "WM_CLIENT_MACHINE" -hasProperty (And p1 p2) w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 && r2 } -hasProperty (Or p1 p2) w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 || r2 } -hasProperty (Not p1) w = do { r1 <- hasProperty p1 w; return $ not r1 } -hasProperty (Const b) _ = return b +hasProperty p w = runQuery (propertyToQuery p) w hunk ./XMonad/Actions/UpdatePointer.hs 94 -windowAttributesToRectangle wa = Rectangle (fi (wa_x wa)) (fi (wa_y wa)) - (fi (wa_width wa)) (fi (wa_height wa)) +windowAttributesToRectangle wa = Rectangle (fi (wa_x wa)) + (fi (wa_y wa)) + (fi (wa_width wa + 2 * wa_border_width wa)) + (fi (wa_height wa + 2 * wa_border_width wa)) hunk ./XMonad/Layout/BoringWindows.hs 9 --- Maintainer : none +-- Maintainer : Adam Vogt hunk ./XMonad/Layout/BoringWindows.hs 34 -import Control.Monad(Monad(return, (>>))) hunk ./XMonad/Layout/BoringWindows.hs 35 -import Data.Maybe(Maybe(..), maybe, fromMaybe, listToMaybe, - maybeToList) +import Data.Maybe(fromMaybe, listToMaybe, maybeToList) hunk ./XMonad/Actions/Search.hs 292 -imdb = searchEngine "imdb" "http://www.imdb.com/Find?select=all&for=" +imdb = searchEngine "imdb" "http://www.imdb.com/find?s=all&q=" hunk ./XMonad/Hooks/DynamicLog.hs 32 + xmonadPropLog, + hunk ./XMonad/Hooks/DynamicLog.hs 68 + +import qualified Codec.Binary.UTF8.String as UTF8 +import Foreign.C (CChar) + hunk ./XMonad/Hooks/DynamicLog.hs 207 +-- | Write a string to the property _XMONAD_LOG on the root window. This +-- property is of type UTF8_STRING. +xmonadPropLog :: String -> X () +xmonadPropLog msg = do + d <- asks display + r <- asks theRoot + xlog <- getAtom "_XMONAD_LOG" + ustring <- getAtom "UTF8_STRING" + io $ changeProperty8 d r xlog ustring propModeReplace (encodeCChar msg) + where + encodeCChar :: String -> [CChar] + encodeCChar = map fromIntegral . UTF8.encode + addfile ./scripts/xmonadpropread.hs hunk ./scripts/xmonadpropread.hs 1 +-- Copyright Spencer Janssen +-- BSD3 (see LICENSE) +-- +-- Experimental, will add proper documentation later (famous last words) + +import Control.Monad +import Graphics.X11 +import Graphics.X11.Xlib.Extras +import Codec.Binary.UTF8.String as UTF8 +import Foreign.C (CChar) + +main = do + d <- openDisplay "" + xlog <- internAtom d "_XMONAD_LOG" False + + root <- rootWindow d (defaultScreen d) + selectInput d root propertyChangeMask + + allocaXEvent $ \ep -> forever $ do + nextEvent d ep + e <- getEvent ep + case e of + PropertyEvent { ev_atom = a } | a == xlog -> do + mwp <- getWindowProperty8 d xlog root + maybe (return ()) (putStrLn . decodeCChar) mwp + _ -> return () + + return () + +decodeCChar :: [CChar] -> String +decodeCChar = UTF8.decode . map fromIntegral hunk ./XMonad/Config/Sjanssen.hs 2 -module XMonad.Config.Sjanssen (sjanssenConfig, sjanssenConfigXmobar) where +module XMonad.Config.Sjanssen (sjanssenConfig) where hunk ./XMonad/Config/Sjanssen.hs 11 -import XMonad.Hooks.DynamicLog hiding (xmobar) +import XMonad.Hooks.DynamicLog hunk ./XMonad/Config/Sjanssen.hs 23 -sjanssenConfigXmobar = statusBar "exec xmobar" sjanssenPP strutkey =<< sjanssenConfig - where - strutkey (XConfig {modMask = modm}) = (modm, xK_b) - hunk ./XMonad/Config/Sjanssen.hs 24 - sp <- mkSpawner + sp <- mkSpawner :: IO Spawner hunk ./XMonad/Config/Sjanssen.hs 33 + , logHook = dynamicLogString sjanssenPP >>= xmonadPropLog hunk ./XMonad/Config/Sjanssen.hs 45 - modifiers = smartBorders + modifiers = avoidStruts . smartBorders hunk ./XMonad/Config/Sjanssen.hs 55 + , ((modm , xK_b ), sendMessage ToggleStruts) addfile ./XMonad/Util/ExtensibleState.hs hunk ./XMonad/Util/ExtensibleState.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.ExtensibleState +-- Copyright : (c) Daniel Schoepe 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : daniel.schoepe@gmail.com +-- Stability : unstable +-- Portability : not portable +-- +-- Module for storing custom mutable state in xmonad. +-- +----------------------------------------------------------------------------- + +module XMonad.Util.ExtensibleState ( + -- * Usage + -- $usage + putState + , modifyState + , removeState + , getState + ) where + +import Control.Applicative +import Data.Typeable (typeOf,Typeable,cast) +import qualified Data.Map as M +import XMonad.Core +import Control.Monad.State + +-- --------------------------------------------------------------------- +-- $usage +-- +-- To utilize this feature in a contrib module create a data type, +-- and make it an instance of ExtensionClass. You can then use +-- the functions from this module for storing your data: +-- +-- > {-# LANGUAGE DeriveDataTypeable #-} +-- > +-- > data ListStorage = ListStorage [Integer] deriving Typeable +-- > instance ExtensionClass ListStorage where +-- > initialValue = ListStorage [] +-- > +-- > .. putState (ListStorage [23,42]) +-- +-- To retrieve the stored data call: +-- +-- > .. getState +-- +-- If the type can't be infered from the usage of the retrieved data, you +-- might need to add an explicit type signature: +-- +-- > .. getState :: X ListStorage +-- +-- To make your data persistent between restarts, the data type needs to be +-- an instance of Read and Show and the instance declaration has to be changed: +-- +-- > data ListStorage = ListStorage [Integer] deriving (Typeable,Read,Show) +-- > +-- > instance ExtensionClass ListStorage where +-- > initialValue = ListStorage [] +-- > extensionType = PersistentExtension +-- +-- One should take care that the string representation of the chosen type +-- is unique among the stored values, otherwise it will be overwritten. +-- Normally these values contain fully qualified module names when deriving Typeable, so +-- name collisions should not be a problem in most cases. +-- A module should not try to store common datatypes(e.g. a list of Integers) +-- without a custom data type as a wrapper to avoid those collisions. +-- + +-- | Modify the map of state extensions by applying the given function. +modifyStateExts :: (M.Map String (Either String StateExtension) + -> M.Map String (Either String StateExtension)) + -> X () +modifyStateExts f = modify $ \st -> st { extensibleState = f (extensibleState st) } + +-- | Apply a function to a stored value of the matching type or the initial value if there +-- is none. +modifyState :: ExtensionClass a => (a -> a) -> X () +modifyState f = putState =<< f <$> getState + +-- | Add a value to the extensible state field. A previously stored value with the same +-- type will be overwritten. (More precisely: A value whose string representation of its type +-- is equal to the new one's) +putState :: ExtensionClass a => a -> X () +putState v = modifyStateExts . M.insert (show . typeOf $ v) . Right . extensionType $ v + +-- | Try to retrieve a value of the requested type, return an initial value if there is no such value. +getState :: ExtensionClass a => X a +getState = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables + where toValue val = maybe initialValue id $ cast val + getState' :: ExtensionClass a => a -> X a + getState' k = do + v <- gets $ M.lookup (show . typeOf $ k) . extensibleState + return $ case v of + Just (Right (StateExtension val)) -> toValue val + Just (Right (PersistentExtension val)) -> toValue val + Just (Left str) -> case extensionType (undefined `asTypeOf` k) of + PersistentExtension x -> maybe initialValue id $ + cast =<< safeRead str `asTypeOf` (Just x) + _ -> initialValue + _ -> initialValue + safeRead str = case reads str of + [(x,"")] -> Just x + _ -> Nothing + +-- | Remove the value from the extensible state field that has the same type as the supplied argument +removeState :: ExtensionClass a => a -> X () +removeState wit = modifyStateExts $ M.delete (show . typeOf $ wit) hunk ./xmonad-contrib.cabal 224 + XMonad.Util.ExtensibleState hunk ./XMonad/Actions/SpawnOn.hs 1 +{-# LANGUAGE DeriveDataTypeable #-} hunk ./XMonad/Actions/SpawnOn.hs 22 - mkSpawner, hunk ./XMonad/Actions/SpawnOn.hs 31 -import Data.IORef hunk ./XMonad/Actions/SpawnOn.hs 39 +import XMonad.Util.ExtensibleState hunk ./XMonad/Actions/SpawnOn.hs 47 --- > sp <- mkSpawner hunk ./XMonad/Actions/SpawnOn.hs 49 --- > manageHook = manageSpawn sp <+> manageHook defaultConfig +-- > manageHook = manageSpawn <+> manageHook defaultConfig hunk ./XMonad/Actions/SpawnOn.hs 55 --- > , ((mod1Mask,xK_o), spawnHere sp "urxvt") --- > , ((mod1Mask,xK_s), shellPromptHere sp defaultXPConfig) +-- > , ((mod1Mask,xK_o), spawnHere "urxvt") +-- > , ((mod1Mask,xK_s), shellPromptHere defaultXPConfig) hunk ./XMonad/Actions/SpawnOn.hs 64 -newtype Spawner = Spawner {pidsRef :: IORef [(ProcessID, ManageHook)]} +newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]} deriving Typeable + +instance ExtensionClass Spawner where + initialValue = Spawner [] hunk ./XMonad/Actions/SpawnOn.hs 72 --- | Create 'Spawner' which then has to be passed to other functions. -mkSpawner :: (Functor m, MonadIO m) => m Spawner -mkSpawner = io . fmap Spawner $ newIORef [] +-- | Get the current Spawner or create one if it doesn't exist. +modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X () +modifySpawner f = putState . Spawner . f . pidsRef =<< getState hunk ./XMonad/Actions/SpawnOn.hs 78 -manageSpawn :: Spawner -> ManageHook -manageSpawn sp = do - pids <- io . readIORef $ pidsRef sp +manageSpawn :: ManageHook +manageSpawn = do + Spawner pids <- liftX getState hunk ./XMonad/Actions/SpawnOn.hs 83 - Nothing -> doF id + Nothing -> idHook hunk ./XMonad/Actions/SpawnOn.hs 86 - io . modifyIORef (pidsRef sp) $ filter ((/= p) . fst) + liftX . modifySpawner $ filter ((/= p) . fst) hunk ./XMonad/Actions/SpawnOn.hs 96 -shellPromptHere :: Spawner -> XPConfig -> X () -shellPromptHere sp = mkPrompt (spawnHere sp) +shellPromptHere :: XPConfig -> X () +shellPromptHere = mkPrompt spawnHere hunk ./XMonad/Actions/SpawnOn.hs 101 -shellPromptOn :: Spawner -> WorkspaceId -> XPConfig -> X () -shellPromptOn sp ws = mkPrompt (spawnOn sp ws) +shellPromptOn :: WorkspaceId -> XPConfig -> X () +shellPromptOn ws = mkPrompt (spawnOn ws) hunk ./XMonad/Actions/SpawnOn.hs 106 -spawnHere :: Spawner -> String -> X () -spawnHere sp cmd = withWindowSet $ \ws -> spawnOn sp (W.currentTag ws) cmd +spawnHere :: String -> X () +spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd hunk ./XMonad/Actions/SpawnOn.hs 111 -spawnOn :: Spawner -> WorkspaceId -> String -> X () -spawnOn sp ws cmd = spawnAndDo sp (doShift ws) cmd +spawnOn :: WorkspaceId -> String -> X () +spawnOn ws cmd = spawnAndDo (doShift ws) cmd hunk ./XMonad/Actions/SpawnOn.hs 115 -spawnAndDo :: Spawner -> ManageHook -> String -> X () -spawnAndDo sp mh cmd = do +spawnAndDo :: ManageHook -> String -> X () +spawnAndDo mh cmd = do hunk ./XMonad/Actions/SpawnOn.hs 118 - io $ modifyIORef (pidsRef sp) (take maxPids . ((p,mh) :)) + modifySpawner $ (take maxPids . ((p,mh) :)) hunk ./XMonad/Actions/SpawnOn.hs 124 - hunk ./XMonad/Config/Sjanssen.hs 24 - sp <- mkSpawner :: IO Spawner + sp <- mkSpawner hunk ./XMonad/Config/Sjanssen.hs 33 - , logHook = dynamicLogString sjanssenPP >>= xmonadPropLog hunk ./XMonad/Config/Sjanssen.hs 38 - <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn sp + <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn hunk ./XMonad/Config/Sjanssen.hs 46 - mykeys sp (XConfig {modMask = modm}) = M.fromList $ - [((modm, xK_p ), shellPromptHere sp myPromptConfig) - ,((modm .|. shiftMask, xK_Return), spawnHere sp =<< asks (terminal . config)) + mykeys (XConfig {modMask = modm}) = M.fromList $ + [((modm, xK_p ), shellPromptHere myPromptConfig) + ,((modm .|. shiftMask, xK_Return), spawnHere =<< asks (terminal . config)) hunk ./XMonad/Hooks/DynamicHooks.hs 1 +{-# LANGUAGE DeriveDataTypeable #-} hunk ./XMonad/Hooks/DynamicHooks.hs 19 - initDynamicHooks - ,dynamicMasterHook + dynamicMasterHook hunk ./XMonad/Hooks/DynamicHooks.hs 26 -import System.IO +import XMonad.Util.ExtensibleState hunk ./XMonad/Hooks/DynamicHooks.hs 31 -import Data.IORef hunk ./XMonad/Hooks/DynamicHooks.hs 42 --- First, you must execute 'initDynamicHooks' from 'main' in your @xmonad.hs@: +-- To use this module, add 'dynamicMasterHook' to your 'manageHook': hunk ./XMonad/Hooks/DynamicHooks.hs 44 --- > dynHooksRef <- initDynamicHooks +-- > xmonad { manageHook = myManageHook <+> dynamicMasterHook } hunk ./XMonad/Hooks/DynamicHooks.hs 46 --- and then pass this value to the other functions in this module. +-- You can then use the supplied functions in your keybindings: hunk ./XMonad/Hooks/DynamicHooks.hs 48 --- You also need to add the base 'ManageHook': --- --- > xmonad { manageHook = myManageHook <+> dynamicMasterHook dynHooksRef } --- --- You must include this @dynHooksRef@ value when using the functions in this --- module: --- --- > xmonad { keys = myKeys `Data.Map.union` Data.Map.fromList --- > [((modm, xK_i), oneShotHook dynHooksRef --- > "FFlaunchHook" (className =? "firefox") (doShift "3") --- > >> spawn "firefox") --- > ,((modm, xK_u), addDynamicHook dynHooksRef --- > (className =? "example" --> doFloat)) --- > ,((modm, xK_y), updatePermanentHook dynHooksRef --- > (const idHook))) ] -- resets the permanent hook. +-- > ((modMask,xK_a), oneShotHook (className =? "example") doFloat) hunk ./XMonad/Hooks/DynamicHooks.hs 54 + deriving Typeable hunk ./XMonad/Hooks/DynamicHooks.hs 56 +instance ExtensionClass DynamicHooks where + initialValue = DynamicHooks [] idHook hunk ./XMonad/Hooks/DynamicHooks.hs 59 --- | Creates the 'IORef' that stores the dynamically created 'ManageHook's. -initDynamicHooks :: IO (IORef DynamicHooks) -initDynamicHooks = newIORef (DynamicHooks { transients = [], - permanent = idHook }) - - --- this hook is always executed, and the IORef's contents checked. +-- this hook is always executed, and the contents of the stored hooks checked. hunk ./XMonad/Hooks/DynamicHooks.hs 64 -dynamicMasterHook :: IORef DynamicHooks -> ManageHook -dynamicMasterHook ref = return True --> - (ask >>= \w -> liftX (do - dh <- io $ readIORef ref +dynamicMasterHook :: ManageHook +dynamicMasterHook = (ask >>= \w -> liftX (do + dh <- getState hunk ./XMonad/Hooks/DynamicHooks.hs 72 - io $ writeIORef ref $ dh { transients = map snd nts } + putState $ dh { transients = map snd nts } hunk ./XMonad/Hooks/DynamicHooks.hs 75 - hunk ./XMonad/Hooks/DynamicHooks.hs 76 -addDynamicHook :: IORef DynamicHooks -> ManageHook -> X () -addDynamicHook ref m = updateDynamicHook ref (<+> m) - +addDynamicHook :: ManageHook -> X () +addDynamicHook m = updateDynamicHook (<+> m) hunk ./XMonad/Hooks/DynamicHooks.hs 80 -updateDynamicHook :: IORef DynamicHooks -> (ManageHook -> ManageHook) -> X () -updateDynamicHook ref f = - io $ modifyIORef ref $ \dh -> dh { permanent = f (permanent dh) } - +updateDynamicHook :: (ManageHook -> ManageHook) -> X () +updateDynamicHook f = modifyState $ \dh -> dh { permanent = f (permanent dh) } hunk ./XMonad/Hooks/DynamicHooks.hs 92 -oneShotHook :: IORef DynamicHooks -> Query Bool -> ManageHook -> X () -oneShotHook ref q a = - io $ modifyIORef ref - $ \dh -> dh { transients = (q,a):(transients dh) } - - - - +oneShotHook :: Query Bool -> ManageHook -> X () +oneShotHook q a = modifyState $ \dh -> dh { transients = (q,a):(transients dh) } hunk ./XMonad/Hooks/UrgencyHook.hs 1 -{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} +{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards, DeriveDataTypeable, + FlexibleInstances #-} hunk ./XMonad/Hooks/UrgencyHook.hs 75 +import XMonad.Util.ExtensibleState hunk ./XMonad/Hooks/UrgencyHook.hs 82 -import Data.IORef hunk ./XMonad/Hooks/UrgencyHook.hs 85 -import Foreign (unsafePerformIO) hunk ./XMonad/Hooks/UrgencyHook.hs 216 +data Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show,Typeable) + +onUrgents :: ([Window] -> [Window]) -> Urgents -> Urgents +onUrgents f = Urgents . f . fromUrgents + +instance ExtensionClass Urgents where + initialValue = Urgents [] + extensionType = PersistentExtension + hunk ./XMonad/Hooks/UrgencyHook.hs 274 --- | Stores the global set of all urgent windows, across workspaces. Not exported -- use --- 'readUrgents' or 'withUrgents' instead. -{-# NOINLINE urgents #-} -urgents :: IORef [Window] -urgents = unsafePerformIO (newIORef []) --- (Hey, I don't like it any more than you do.) - hunk ./XMonad/Hooks/UrgencyHook.hs 278 -readUrgents = io $ readIORef urgents +readUrgents = fromUrgents <$> getState hunk ./XMonad/Hooks/UrgencyHook.hs 285 -adjustUrgents f = io $ modifyIORef urgents f +adjustUrgents f = modifyState $ onUrgents f hunk ./XMonad/Hooks/UrgencyHook.hs 295 - } deriving Eq + } deriving (Show,Read,Eq,Typeable) + +instance ExtensionClass [Reminder] where + initialValue = [] + extensionType = PersistentExtension hunk ./XMonad/Hooks/UrgencyHook.hs 302 -{-# NOINLINE reminders #-} -reminders :: IORef [Reminder] -reminders = unsafePerformIO (newIORef []) hunk ./XMonad/Hooks/UrgencyHook.hs 304 -readReminders = io $ readIORef reminders +readReminders = getState hunk ./XMonad/Hooks/UrgencyHook.hs 307 -adjustReminders f = io $ modifyIORef reminders f +adjustReminders f = modifyState f hunk ./XMonad/Hooks/UrgencyHook.hs 338 - userCodeDef () =<< asks (logHook . config) -- call *after* IORef has been modified + userCodeDef () =<< asks (logHook . config) hunk ./XMonad/Config/Sjanssen.hs 23 -sjanssenConfig = do - sp <- mkSpawner - return . ewmh $ defaultConfig +sjanssenConfig = + ewmh $ defaultConfig hunk ./XMonad/Config/Sjanssen.hs 31 - , keys = \c -> mykeys sp c `M.union` keys defaultConfig c + , keys = \c -> mykeys c `M.union` keys defaultConfig c + , logHook = dynamicLogString sjanssenPP >>= xmonadPropLog hunk ./XMonad/Util/ExtensibleState.hs 95 - return $ case v of - Just (Right (StateExtension val)) -> toValue val - Just (Right (PersistentExtension val)) -> toValue val - Just (Left str) -> case extensionType (undefined `asTypeOf` k) of - PersistentExtension x -> maybe initialValue id $ - cast =<< safeRead str `asTypeOf` (Just x) - _ -> initialValue - _ -> initialValue + case v of + Just (Right (StateExtension val)) -> return $ toValue val + Just (Right (PersistentExtension val)) -> return $ toValue val + Just (Left str) -> case extensionType (undefined `asTypeOf` k) of + PersistentExtension x -> do + let val = maybe initialValue id $ + cast =<< safeRead str `asTypeOf` (Just x) + putState (val `asTypeOf` k) + return val + _ -> return $ initialValue + _ -> return $ initialValue addfile ./XMonad/Util/SpawnOnce.hs hunk ./XMonad/Util/SpawnOnce.hs 1 +{-# LANGUAGE DeriveDataTypeable #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.ExtensibleState +-- Copyright : (c) Spencer Janssen 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : spencerjanssen@gmail.com +-- Stability : unstable +-- Portability : not portable +-- +-- A module for spawning a command once, and only once. Useful to start +-- status bars and make session settings inside startupHook. +-- +----------------------------------------------------------------------------- + +module XMonad.Util.SpawnOnce (spawnOnce) where + +import XMonad +import Data.Set as Set +import XMonad.Util.ExtensibleState +import Control.Monad + +data SpawnOnce = SpawnOnce { unspawnOnce :: (Set String) } + deriving (Read, Show, Typeable) + +instance ExtensionClass SpawnOnce where + initialValue = SpawnOnce $ Set.empty + extensionType = PersistentExtension + +-- | The first time 'spawnOnce' is executed on a particular command, that +-- command is executed. Subsequent invocations for a command do nothing. +spawnOnce :: String -> X () +spawnOnce xs = do + b <- fmap (Set.member xs . unspawnOnce) $ getState + when (not b) $ do + spawn xs + modifyState (SpawnOnce . Set.insert xs . unspawnOnce) hunk ./xmonad-contrib.cabal 235 + XMonad.Util.SpawnOnce hunk ./XMonad/Config/Sjanssen.hs 17 +import XMonad.Util.SpawnOnce hunk ./XMonad/Config/Sjanssen.hs 41 + , startupHook = mapM_ spawnOnce spawns hunk ./XMonad/Config/Sjanssen.hs 48 + spawns = [ "xmobar" + , "xset -b", "xset s off", "xset dpms 0 600 1200" + , "nitrogen --set-tiled wallpaper/wallpaper.jpg" + , "trayer --transparent true --expand true --align right " + ++ "--edge bottom --widthtype request" ] + hunk ./xmonad-contrib.cabal 92 - XMonad.Actions.RotSlaves hunk ./xmonad-contrib.cabal 93 + XMonad.Actions.RotSlaves hunk ./xmonad-contrib.cabal 102 - XMonad.Actions.UpdatePointer hunk ./xmonad-contrib.cabal 103 + XMonad.Actions.UpdatePointer hunk ./xmonad-contrib.cabal 105 + XMonad.Actions.WindowBringer + XMonad.Actions.WindowGo hunk ./xmonad-contrib.cabal 109 - XMonad.Actions.WindowGo - XMonad.Actions.WindowBringer hunk ./xmonad-contrib.cabal 130 - XMonad.Hooks.SetWMName hunk ./xmonad-contrib.cabal 131 + XMonad.Hooks.SetWMName hunk ./xmonad-contrib.cabal 141 - XMonad.Layout.Cross hunk ./xmonad-contrib.cabal 144 + XMonad.Layout.Cross hunk ./xmonad-contrib.cabal 186 - XMonad.Layout.Simplest + XMonad.Layout.ShowWName hunk ./xmonad-contrib.cabal 189 + XMonad.Layout.Simplest + XMonad.Layout.SimplestFloat hunk ./xmonad-contrib.cabal 194 - XMonad.Layout.ShowWName hunk ./xmonad-contrib.cabal 196 - XMonad.Layout.Tabbed hunk ./xmonad-contrib.cabal 197 + XMonad.Layout.Tabbed hunk ./xmonad-contrib.cabal 204 - XMonad.Layout.SimplestFloat - XMonad.Prompt.Directory hunk ./xmonad-contrib.cabal 207 - XMonad.Prompt.Input + XMonad.Prompt.Directory + XMonad.Prompt.DirExec hunk ./xmonad-contrib.cabal 210 + XMonad.Prompt.Input hunk ./xmonad-contrib.cabal 213 - XMonad.Prompt.DirExec hunk ./xmonad-contrib.cabal 232 - XMonad.Util.StringProp + XMonad.Util.Paste + XMonad.Util.Replace hunk ./xmonad-contrib.cabal 237 + XMonad.Util.StringProp hunk ./xmonad-contrib.cabal 243 - XMonad.Util.Paste - XMonad.Util.Replace hunk ./XMonad/Actions/GridSelect.hs 240 -tupadd :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1) -tupadd (a,b) (c,d) = (a+c,b+d) - hunk ./XMonad/Actions/GridSelect.hs 487 -defaultGSNav = M.map tupadd $ M.fromList +defaultGSNav = M.map (\(x,y) (a,b) -> (x+a,y+b)) $ M.fromList hunk ./XMonad/Actions/TopicSpace.hs 1 +{-# LANGUAGE DeriveDataTypeable #-} hunk ./XMonad/Actions/TopicSpace.hs 47 +import Control.Applicative ((<$>)) hunk ./XMonad/Actions/TopicSpace.hs 61 -import XMonad.Util.StringProp(getStringListProp,setStringListProp) +import XMonad.Util.ExtensibleState hunk ./XMonad/Actions/TopicSpace.hs 230 +newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable) +instance ExtensionClass PrevTopics where + initialValue = PrevTopics [] + extensionType = PersistentExtension + hunk ./XMonad/Actions/TopicSpace.hs 236 --- This function rely on a reserved property namely _XMONAD_LAST_FOCUSED_WORKSPACES. hunk ./XMonad/Actions/TopicSpace.hs 237 -getLastFocusedTopics = asks display >>= flip getStringListProp "_XMONAD_LAST_FOCUSED_WORKSPACES" +getLastFocusedTopics = getPrevTopics <$> getState hunk ./XMonad/Actions/TopicSpace.hs 243 -setLastFocusedTopic tg w predicate = do - disp <- asks display - setStringListProp disp "_XMONAD_LAST_FOCUSED_WORKSPACES" - . take (maxTopicHistory tg) . nub . (w:) . filter predicate =<< getLastFocusedTopics +setLastFocusedTopic tg w predicate = + modifyState $ PrevTopics + . take (maxTopicHistory tg) . nub . (w:) . filter predicate + . getPrevTopics hunk ./XMonad/Hooks/EwmhDesktops.hs 35 +import XMonad.Util.XUtils (fi) hunk ./XMonad/Hooks/EwmhDesktops.hs 136 - let n = fromIntegral (head d) - if 0 <= n && n < length ws then - windows $ W.view (W.tag (ws !! n)) + let n = head d + if 0 <= n && fi n < length ws then + windows $ W.view (W.tag (ws !! fi n)) hunk ./XMonad/Hooks/EwmhDesktops.hs 141 - let n = fromIntegral (head d) - if 0 <= n && n < length ws then - windows $ W.shiftWin (W.tag (ws !! n)) w + let n = head d + if 0 <= n && fi n < length ws then + windows $ W.shiftWin (W.tag (ws !! fi n)) w hunk ./XMonad/Actions/DynamicWorkspaces.hs 19 - addWorkspace, removeWorkspace, + addWorkspace, addWorkspacePrompt, + removeWorkspace, hunk ./XMonad/Actions/DynamicWorkspaces.hs 105 +-- | Prompt for the name of a new workspace, and add it. +addWorkspacePrompt :: XPConfig -> X () +addWorkspacePrompt conf = mkXPrompt (Wor "New workspace name: ") conf (const (return [])) addWorkspace hunk ./XMonad/Util/ExtensibleState.hs 24 -import Control.Applicative hunk ./XMonad/Util/ExtensibleState.hs 79 -modifyState f = putState =<< f <$> getState +modifyState f = putState . f =<< getState hunk ./scripts/xmonadpropread.hs 11 +import System.IO hunk ./scripts/xmonadpropread.hs 14 + hSetBuffering stdout LineBuffering + hunk ./XMonad/Hooks/ManageHelpers.hs 60 --- | Denotes a side of a screen. @S@ stands for South, @NE@ for Northwest +-- | Denotes a side of a screen. @S@ stands for South, @NE@ for Northeast hunk ./XMonad/Actions/GridSelect.hs 41 + gridselectViewWorkspace, hunk ./XMonad/Actions/GridSelect.hs 525 +-- | Select a workspace and view it using the given function +-- (normally 'W.view' or 'W.greedyView') +gridselectViewWorkspace :: GSConfig WorkspaceId -> + (WorkspaceId -> WindowSet -> WindowSet) -> X () +gridselectViewWorkspace conf viewFunc = withWindowSet $ \ws -> do + let wss = map W.tag $ W.hidden ws ++ map W.workspace (W.current ws : W.visible ws) + gridselect conf (zip wss wss) >>= flip whenJust (windows . viewFunc) hunk ./XMonad/Util/SpawnOnce.hs 29 - initialValue = SpawnOnce $ Set.empty + initialValue = SpawnOnce Set.empty hunk ./XMonad/Util/SpawnOnce.hs 36 - b <- fmap (Set.member xs . unspawnOnce) $ getState + b <- fmap (Set.member xs . unspawnOnce) getState hunk ./XMonad/Actions/WindowGo.hs 61 -appropriate one, or cover your bases by using instead something like - @(className =? \"Firefox\" <||> className =? \"Firefox-bin\")@.) +appropriate one, or cover your bases by using instead something like: + +> (className =? "Firefox" <||> className =? "Firefox-bin") hunk ./XMonad/Actions/WindowGo.hs 175 - > raiseMaster (runInTerm \"-title ghci\" \"zsh -c \'ghci\'\") (title =? \"ghci\") -} + > raiseMaster (runInTerm "-title ghci" "zsh -c 'ghci'") (title =? "ghci") -} hunk ./XMonad/Actions/WindowGo.hs 182 - > runOrRaiseMaster \"firefox\" (className =? \"Firefox\")) + > runOrRaiseMaster "firefox" (className =? "Firefox")) hunk ./XMonad/Actions/TopicSpace.hs 25 + , defaultTopicConfig hunk ./XMonad/Actions/TopicSpace.hs 231 +defaultTopicConfig :: TopicConfig +defaultTopicConfig = TopicConfig { topicDirs = M.empty + , topicActions = M.empty + , defaultTopicAction = const (ask >>= spawn . terminal . config) + , defaultTopic = "1" + , maxTopicHistory = 10 + } + hunk ./XMonad/Actions/TopicSpace.hs 80 --- @ --- -- The list of all topics/workspaces of your xmonad configuration. --- -- The order is important, new topics must be inserted --- -- at the end of the list if you want hot-restarting --- -- to work. --- myTopics :: [Topic] --- myTopics = --- [ \"dashboard\" -- the first one --- , \"admin\", \"build\", \"cleaning\", \"conf\", \"darcs\", \"haskell\", \"irc\" --- , \"mail\", \"movie\", \"music\", \"talk\", \"text\", \"tools\", \"web\", \"xmonad\" --- , \"yi\", \"documents\", \"twitter\", \"pdf\" --- ] --- @ --- --- @ --- myTopicConfig :: TopicConfig --- myTopicConfig = TopicConfig --- { topicDirs = M.fromList $ --- [ (\"conf\", \"w\/conf\") --- , (\"dashboard\", \"Desktop\") --- , (\"yi\", \"w\/dev-haskell\/yi\") --- , (\"darcs\", \"w\/dev-haskell\/darcs\") --- , (\"haskell\", \"w\/dev-haskell\") --- , (\"xmonad\", \"w\/dev-haskell\/xmonad\") --- , (\"tools\", \"w\/tools\") --- , (\"movie\", \"Movies\") --- , (\"talk\", \"w\/talks\") --- , (\"music\", \"Music\") --- , (\"documents\", \"w\/documents\") --- , (\"pdf\", \"w\/documents\") --- ] --- , defaultTopicAction = const $ spawnShell >*> 3 --- , defaultTopic = \"dashboard\" --- , maxTopicHistory = 10 --- , topicActions = M.fromList $ --- [ (\"conf\", spawnShell >> spawnShellIn \"wd\/ertai\/private\") --- , (\"darcs\", spawnShell >*> 3) --- , (\"yi\", spawnShell >*> 3) --- , (\"haskell\", spawnShell >*> 2 >> --- spawnShellIn \"wd\/dev-haskell\/ghc\") --- , (\"xmonad\", spawnShellIn \"wd\/x11-wm\/xmonad\" >> --- spawnShellIn \"wd\/x11-wm\/xmonad\/contrib\" >> --- spawnShellIn \"wd\/x11-wm\/xmonad\/utils\" >> --- spawnShellIn \".xmonad\" >> --- spawnShellIn \".xmonad\") --- , (\"mail\", mailAction) --- , (\"irc\", ssh somewhere) --- , (\"admin\", ssh somewhere >> --- ssh nowhere) --- , (\"dashboard\", spawnShell) --- , (\"twitter\", spawnShell) --- , (\"web\", spawn browserCmd) --- , (\"movie\", spawnShell) --- , (\"documents\", spawnShell >*> 2 >> --- spawnShellIn \"Documents\" >*> 2) --- , (\"pdf\", spawn pdfViewerCmd) --- ] --- } --- @ --- --- @ --- -- extend your keybindings --- myKeys conf\@XConfig{modMask=modm} = --- [ ((modm , xK_n ), spawnShell) -- %! Launch terminal --- , ((modm , xK_a ), currentTopicAction myTopicConfig) --- , ((modm , xK_g ), promptedGoto) --- , ((modm .|. shiftMask, xK_g ), promptedShift) --- ... --- ] --- ++ --- [ ((modm, k), switchNthLastFocused myTopicConfig i) --- | (i, k) <- zip [1..] workspaceKeys] --- @ --- --- @ --- spawnShell :: X () --- spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn --- @ --- --- @ --- spawnShellIn :: Dir -> X () --- spawnShellIn dir = spawn $ \"urxvt '(cd ''\" ++ dir ++ \"'' && \" ++ myShell ++ \" )'\" --- @ --- --- @ --- goto :: Topic -> X () --- goto = switchTopic myTopicConfig --- @ --- --- @ --- promptedGoto :: X () --- promptedGoto = workspacePrompt myXPConfig goto --- @ --- --- @ --- promptedShift :: X () --- promptedShift = workspacePrompt myXPConfig $ windows . W.shift --- @ --- --- @ --- myConfig = do --- checkTopicConfig myTopics myTopicConfig --- myLogHook <- makeMyLogHook --- return $ defaultConfig --- { borderWidth = 1 -- Width of the window border in pixels. --- , workspaces = myTopics --- , layoutHook = myModifiers myLayout --- , manageHook = myManageHook --- , logHook = myLogHook --- , handleEventHook = myHandleEventHook --- , terminal = myTerminal -- The preferred terminal program. --- , normalBorderColor = \"#3f3c6d\" --- , focusedBorderColor = \"#4f66ff\" --- , XMonad.modMask = mod1Mask --- , keys = myKeys --- , mouseBindings = myMouseBindings --- } --- @ --- --- @ --- main :: IO () --- main = xmonad =<< myConfig --- @ +-- > -- The list of all topics/workspaces of your xmonad configuration. +-- > -- The order is important, new topics must be inserted +-- > -- at the end of the list if you want hot-restarting +-- > -- to work. +-- > myTopics :: [Topic] +-- > myTopics = +-- > [ "dashboard" -- the first one +-- > , "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc" +-- > , "mail", "movie", "music", "talk", "text", "tools", "web", "xmonad" +-- > , "yi", "documents", "twitter", "pdf" +-- > ] +-- > +-- > myTopicConfig :: TopicConfig +-- > myTopicConfig = defaultTopicConfig +-- > { topicDirs = M.fromList $ +-- > [ ("conf", "w/conf") +-- > , ("dashboard", "Desktop") +-- > , ("yi", "w/dev-haskell/yi") +-- > , ("darcs", "w/dev-haskell/darcs") +-- > , ("haskell", "w/dev-haskell") +-- > , ("xmonad", "w/dev-haskell/xmonad") +-- > , ("tools", "w/tools") +-- > , ("movie", "Movies") +-- > , ("talk", "w/talks") +-- > , ("music", "Music") +-- > , ("documents", "w/documents") +-- > , ("pdf", "w/documents") +-- > ] +-- > , defaultTopicAction = const $ spawnShell >*> 3 +-- > , defaultTopic = "dashboard" +-- > , topicActions = M.fromList $ +-- > [ ("conf", spawnShell >> spawnShellIn "wd/ertai/private") +-- > , ("darcs", spawnShell >*> 3) +-- > , ("yi", spawnShell >*> 3) +-- > , ("haskell", spawnShell >*> 2 >> +-- > spawnShellIn "wd/dev-haskell/ghc") +-- > , ("xmonad", spawnShellIn "wd/x11-wm/xmonad" >> +-- > spawnShellIn "wd/x11-wm/xmonad/contrib" >> +-- > spawnShellIn "wd/x11-wm/xmonad/utils" >> +-- > spawnShellIn ".xmonad" >> +-- > spawnShellIn ".xmonad") +-- > , ("mail", mailAction) +-- > , ("irc", ssh somewhere) +-- > , ("admin", ssh somewhere >> +-- > ssh nowhere) +-- > , ("dashboard", spawnShell) +-- > , ("twitter", spawnShell) +-- > , ("web", spawn browserCmd) +-- > , ("movie", spawnShell) +-- > , ("documents", spawnShell >*> 2 >> +-- > spawnShellIn "Documents" >*> 2) +-- > , ("pdf", spawn pdfViewerCmd) +-- > ] +-- > } +-- > +-- > -- extend your keybindings +-- > myKeys conf@XConfig{modMask=modm} = +-- > [ ((modm , xK_n ), spawnShell) -- %! Launch terminal +-- > , ((modm , xK_a ), currentTopicAction myTopicConfig) +-- > , ((modm , xK_g ), promptedGoto) +-- > , ((modm .|. shiftMask, xK_g ), promptedShift) +-- > {- more keys ... -} +-- > ] +-- > ++ +-- > [ ((modm, k), switchNthLastFocused myTopicConfig i) +-- > | (i, k) <- zip [1..] workspaceKeys] +-- > +-- > spawnShell :: X () +-- > spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn +-- > +-- > spawnShellIn :: Dir -> X () +-- > spawnShellIn dir = spawn $ "urxvt '(cd ''" ++ dir ++ "'' && " ++ myShell ++ " )'" +-- > +-- > goto :: Topic -> X () +-- > goto = switchTopic myTopicConfig +-- > +-- > promptedGoto :: X () +-- > promptedGoto = workspacePrompt myXPConfig goto +-- > +-- > promptedShift :: X () +-- > promptedShift = workspacePrompt myXPConfig $ windows . W.shift +-- > +-- > myConfig = do +-- > checkTopicConfig myTopics myTopicConfig +-- > myLogHook <- makeMyLogHook +-- > return $ defaultConfig +-- > { borderWidth = 1 -- Width of the window border in pixels. +-- > , workspaces = myTopics +-- > , layoutHook = myModifiers myLayout +-- > , manageHook = myManageHook +-- > , logHook = myLogHook +-- > , handleEventHook = myHandleEventHook +-- > , terminal = myTerminal -- The preferred terminal program. +-- > , normalBorderColor = "#3f3c6d" +-- > , focusedBorderColor = "#4f66ff" +-- > , XMonad.modMask = mod1Mask +-- > , keys = myKeys +-- > , mouseBindings = myMouseBindings +-- > } +-- > +-- > main :: IO () +-- > main = xmonad =<< myConfig hunk ./XMonad/Config/Desktop.hs 92 --- @defaultConfig@ in the \"Extending xmonad\" section of "XMonad.Doc.Extending". +-- @defaultConfig@ in "XMonad.Doc.Extending#Extending xmonad". hunk ./XMonad/Hooks/FloatNext.hs 1 +{-# LANGUAGE DeriveDataTypeable #-} hunk ./XMonad/Hooks/FloatNext.hs 42 +import XMonad.Util.ExtensibleState hunk ./XMonad/Hooks/FloatNext.hs 44 -import Control.Monad (join) +import Control.Monad (join,guard) hunk ./XMonad/Hooks/FloatNext.hs 47 -import Control.Concurrent.MVar -import System.IO.Unsafe (unsafePerformIO) - hunk ./XMonad/Hooks/FloatNext.hs 50 -modifyMVar2 :: MVar a -> (a -> a) -> IO () -modifyMVar2 v f = modifyMVar_ v (return . f) - hunk ./XMonad/Hooks/FloatNext.hs 51 -_set f b = io $ modifyMVar2 floatModeMVar (f $ const b) +_set f b = modifyState' (f $ const b) hunk ./XMonad/Hooks/FloatNext.hs 54 -_toggle f = io $ modifyMVar2 floatModeMVar (f not) +_toggle f = modifyState' (f not) hunk ./XMonad/Hooks/FloatNext.hs 57 -_get f = io $ f <$> readMVar floatModeMVar +_get f = f . getFloatMode <$> getState hunk ./XMonad/Hooks/FloatNext.hs 60 -_pp f s st = _get f >>= \b -> if b then return $ Just $ st s else return Nothing - +_pp f s st = (\b -> guard b >> Just (st s)) <$> _get f hunk ./XMonad/Hooks/FloatNext.hs 64 -floatModeMVar :: MVar (Bool, Bool) -floatModeMVar = unsafePerformIO $ newMVar (False, False) +data FloatMode = FloatMode { getFloatMode :: (Bool,Bool) } deriving (Typeable) + +instance ExtensionClass FloatMode where + initialValue = FloatMode (False,False) hunk ./XMonad/Hooks/FloatNext.hs 69 +modifyState' :: ((Bool,Bool) -> (Bool,Bool)) -> X () +modifyState' f = modifyState (FloatMode . f . getFloatMode) hunk ./XMonad/Hooks/FloatNext.hs 99 -floatNextHook = do (next, all) <- io $ takeMVar floatModeMVar - io $ putMVar floatModeMVar (False, all) +floatNextHook = do (next, all) <- liftX $ getFloatMode <$> getState + liftX $ putState $ FloatMode (False, all) hunk ./XMonad/Hooks/FloatNext.hs 95 - hunk ./XMonad/Hooks/FloatNext.hs 102 - hunk ./XMonad/Hooks/FloatNext.hs 118 - hunk ./XMonad/Hooks/FloatNext.hs 126 - hunk ./XMonad/Hooks/FloatNext.hs 153 + hunk ./XMonad/Actions/DynamicWorkspaces.hs 101 --- | Add a new workspace with the given name. +-- | Add a new workspace with the given name, or do nothing if a +-- workspace with the given name already exists; then switch to the +-- newly created workspace. hunk ./XMonad/Actions/DynamicWorkspaces.hs 107 --- | Prompt for the name of a new workspace, and add it. +-- | Prompt for the name of a new workspace, add it if it does not +-- already exist, and switch to it. hunk ./XMonad/Actions/DynamicWorkspaces.hs 112 --- | Add a new hidden workspace with the given name. +-- | Add a new hidden workspace with the given name, or do nothing if +-- a workspace with the given name already exists. hunk ./XMonad/Actions/DynamicWorkspaces.hs 115 -addHiddenWorkspace newtag = do l <- asks (layoutHook . config) - windows (addHiddenWorkspace' newtag l) +addHiddenWorkspace newtag = + whenX (gets (not . tagMember newtag . windowset)) $ do + l <- asks (layoutHook . config) + windows (addHiddenWorkspace' newtag l) hunk ./XMonad/Actions/GridSelect.hs 41 - gridselectViewWorkspace, + gridselectWorkspace, hunk ./XMonad/Actions/GridSelect.hs 527 -gridselectViewWorkspace :: GSConfig WorkspaceId -> +-- +-- Another option is to shift the current window to the selected workspace: +-- +-- > gridselectWorkspace (\ws -> W.greedyView ws . W.shift ws) +gridselectWorkspace :: GSConfig WorkspaceId -> hunk ./XMonad/Actions/GridSelect.hs 533 -gridselectViewWorkspace conf viewFunc = withWindowSet $ \ws -> do +gridselectWorkspace conf viewFunc = withWindowSet $ \ws -> do hunk ./XMonad/Hooks/InsertPosition.hs 49 - g w = viewingWs w (updateFocus w . ins w . W.delete w) + g w = viewingWs w (updateFocus w . ins w . W.delete' w) hunk ./XMonad/Util/EZConfig.hs 30 - mkNamedKeymap + mkNamedKeymap, + + parseKey -- used by XMonad.Util.Paste hunk ./XMonad/Util/Paste.hs 31 +import Data.Maybe (listToMaybe) hunk ./XMonad/Util/Paste.hs 34 +import XMonad.Util.EZConfig (parseKey) +import Text.ParserCombinators.ReadP (readP_to_S) hunk ./XMonad/Util/Paste.hs 76 -pasteChar m c = sendKey m $ stringToKeysym [c] +pasteChar m c = sendKey m $ maybe (stringToKeysym [c]) fst + $ listToMaybe $ readP_to_S parseKey [c] hunk ./XMonad/Util/Run.hs 54 --- | Return output if the command succeeded, otherwise return @()@. --- This corresponds to dmenu's notion of exit code 1 for a canceled invocation. +-- | Returns the output. hunk ./XMonad/Config/Arossato.hs 1 -{-# OPTIONS_GHC -fglasgow-exts -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# LANGUAGE NoMonomorphismRestriction #-} hunk ./XMonad/Prompt/Email.hs 62 - io $ runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n") + runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n") hunk ./XMonad/Util/Dmenu.hs 40 - io $ runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts) + runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts) hunk ./XMonad/Util/Dmenu.hs 46 -menu menuCmd opts = io $ runProcessWithInput menuCmd [] (unlines opts) +menu menuCmd opts = runProcessWithInput menuCmd [] (unlines opts) hunk ./XMonad/Util/Dzen.hs 37 -dzenWithArgs str args timeout = io $ runProcessWithInputAndWait "dzen2" args (unchomp str) timeout +dzenWithArgs str args timeout = runProcessWithInputAndWait "dzen2" args (unchomp str) timeout hunk ./XMonad/Util/Run.hs 55 -runProcessWithInput :: FilePath -> [String] -> String -> IO String -runProcessWithInput cmd args input = do +runProcessWithInput :: MonadIO m => FilePath -> [String] -> String -> m String +runProcessWithInput cmd args input = io $ do hunk ./XMonad/Util/Run.hs 68 -runProcessWithInputAndWait :: FilePath -> [String] -> String -> Int -> IO () -runProcessWithInputAndWait cmd args input timeout = do +runProcessWithInputAndWait :: MonadIO m => FilePath -> [String] -> String -> Int -> m () +runProcessWithInputAndWait cmd args input timeout = io $ do hunk ./XMonad/Util/Run.hs 132 -spawnPipe :: String -> IO Handle -spawnPipe x = do +spawnPipe :: MonadIO m => String -> m Handle +spawnPipe x = io $ do hunk ./XMonad/Util/Dzen.hs 16 + -- * Flexible interface + dzenConfig, + timeout, + font, + xScreen, + vCenter, + hCenter, + center, + onCurr, + x, + y, + addArgs, + + -- * Legacy interface hunk ./XMonad/Util/Dzen.hs 31 - dzenWithArgs, hunk ./XMonad/Util/Dzen.hs 32 - seconds + dzenWithArgs, + + -- * Miscellaneous + seconds, + chomp, + (>=>) hunk ./XMonad/Util/Dzen.hs 40 +import Control.Monad +import Data.List hunk ./XMonad/Util/Dzen.hs 43 +import XMonad.StackSet hunk ./XMonad/Util/Dzen.hs 46 +type DzenConfig = (Int, [String]) -> X (Int, [String]) + +-- | @dzenConfig config s@ will display the string @s@ according to the +-- configuration @config@. For example, to display the string @\"foobar\"@ with +-- all the default settings, you can simply call +-- +-- > dzenConfig return "foobar" +-- +-- Or, to set a longer timeout, you could use +-- +-- > dzenConfig (timeout 10) "foobar" +-- +-- You can combine configurations with the (>=>) operator. To display +-- @\"foobar\"@ for 10 seconds on the first screen, you could use +-- +-- > dzenConfig (timeout 10 >=> xScreen 0) "foobar" +-- +-- As a final example, you could adapt the above to display @\"foobar\"@ for +-- 10 seconds on the current screen with +-- +-- > dzenConfig (timeout 10 >=> onCurr xScreen) "foobar" +dzenConfig :: DzenConfig -> String -> X () +dzenConfig conf s = do + (t, args) <- conf (seconds 3, []) + runProcessWithInputAndWait "dzen2" args (chomp s) t + +-- | dzen wants exactly one newline at the end of its input, so this can be +-- used for your own invocations of dzen. However, all functions in this +-- module will call this for you. +chomp :: String -> String +chomp = (++"\n") . reverse . dropWhile ('\n' ==) . reverse + +-- | Set the timeout, in seconds. This defaults to 3 seconds if not +-- specified. +timeout :: Rational -> DzenConfig +timeout = timeoutMicro . seconds + +-- | Set the timeout, in microseconds. Mostly here for the legacy +-- interface. +timeoutMicro :: Int -> DzenConfig +timeoutMicro n (_, ss) = return (n, ss) + +-- | Add raw command-line arguments to the configuration. These will be +-- passed on verbatim to dzen2. The default includes no arguments. +addArgs :: [String] -> DzenConfig +addArgs ss (n, ss') = return (n, ss ++ ss') + +-- | Start dzen2 on a particular screen. Only works with versions of dzen +-- that support the "-xs" argument. +xScreen :: ScreenId -> DzenConfig +xScreen sc = addArgs ["-xs", show (fromIntegral sc + 1 :: Int)] + +-- | Take a screen-specific configuration and supply it with the screen ID +-- of the currently focused screen, according to xmonad. For example, show +-- a 100-pixel wide bar centered within the current screen, you could use +-- +-- > dzenConfig (onCurr (hCenter 100)) "foobar" +-- +-- Of course, you can still combine these with (>=>); for example, to center +-- the string @\"foobar\"@ both horizontally and vertically in a 100x14 box +-- using the lovely Terminus font, you could use +-- +-- > terminus = "-*-terminus-*-*-*-*-12-*-*-*-*-*-*-*" +-- > dzenConfig (onCurr (center 100 14) >=> font terminus) "foobar" +onCurr :: (ScreenId -> DzenConfig) -> DzenConfig +onCurr f conf = gets (screen . current . windowset) >>= flip f conf + +-- | Put the top of the dzen bar at a particular pixel. +x :: Int -> DzenConfig +x n = addArgs ["-x", show n] +-- | Put the left of the dzen bar at a particular pixel. +y :: Int -> DzenConfig +y n = addArgs ["-y", show n] + +-- | Specify the font. Check out xfontsel to get the format of the String +-- right; if your dzen supports xft, then you can supply that here, too. +font :: String -> DzenConfig +font fn = addArgs ["-fn", fn] + +-- | @vCenter height sc@ sets the configuration to have the dzen bar appear +-- on screen @sc@ with height @height@, vertically centered with respect to +-- the actual size of that screen. +vCenter :: Int -> ScreenId -> DzenConfig +vCenter = center' rect_height "-h" "-y" + +-- | @hCenter width sc@ sets the configuration to have the dzen bar appear +-- on screen @sc@ with width @width@, horizontally centered with respect to +-- the actual size of that screen. +hCenter :: Int -> ScreenId -> DzenConfig +hCenter = center' rect_width "-w" "-x" + +-- | @center width height sc@ sets the configuration to have the dzen bar +-- appear on screen @sc@ with width @width@ and height @height@, centered +-- both horizontally and vertically with respect to the actual size of that +-- screen. +center :: Int -> Int -> ScreenId -> DzenConfig +center width height sc = hCenter width sc >=> vCenter height sc + +-- Center things along a single dimension on a particular screen. +center' :: (Rectangle -> Dimension) -> String -> String -> Int -> ScreenId -> DzenConfig +center' selector extentName positionName extent sc conf = do + rect <- gets (detailFromScreenId sc . windowset) + case rect of + Nothing -> return conf + Just r -> addArgs + [extentName , show extent, + positionName, show ((fromIntegral (selector r) - extent) `div` 2), + "-xs" , show (fromIntegral sc + 1 :: Int) + ] conf + +-- Get the rectangle outlining a particular screen. +detailFromScreenId :: ScreenId -> WindowSet -> Maybe Rectangle +detailFromScreenId sc ws = fmap screenRect maybeSD where + c = current ws + v = visible ws + mapping = map (\s -> (screen s, screenDetail s)) (c:v) + maybeSD = lookup sc mapping + hunk ./XMonad/Util/Dzen.hs 169 -dzen str timeout = dzenWithArgs str [] timeout +dzen = flip (dzenConfig . timeoutMicro) hunk ./XMonad/Util/Dzen.hs 176 -dzenWithArgs str args timeout = runProcessWithInputAndWait "dzen2" args (unchomp str) timeout - -- dzen seems to require the input to terminate with exactly one newline. - where unchomp s@['\n'] = s - unchomp [] = ['\n'] - unchomp (c:cs) = c : unchomp cs +dzenWithArgs str args t = dzenConfig (timeoutMicro t >=> addArgs args) str hunk ./XMonad/Util/Dzen.hs 180 -dzenScreen :: ScreenId -> String -> Int -> X() -dzenScreen sc str timeout = dzenWithArgs str ["-xs", screen] timeout - where screen = toXineramaArg sc - toXineramaArg n = show ( ((fromIntegral n)+1)::Int ) +dzenScreen :: ScreenId -> String -> Int -> X () +dzenScreen sc str t = dzenConfig (timeoutMicro t >=> xScreen sc) str hunk ./XMonad/Actions/DynamicWorkspaces.hs 11 --- Provides bindings to add and delete workspaces. Note that you may only --- delete a workspace that is already empty. +-- Provides bindings to add and delete workspaces. hunk ./XMonad/Actions/DynamicWorkspaces.hs 20 + removeEmptyWorkspace, + removeEmptyWorkspaceAfter, + removeEmptyWorkspaceAfterExcept, hunk ./XMonad/Actions/DynamicWorkspaces.hs 34 +import Data.List (find) +import Data.Maybe (isNothing) +import Control.Monad (when) hunk ./XMonad/Actions/DynamicWorkspaces.hs 126 +removeEmptyWorkspace :: X () +removeEmptyWorkspace = do t <- (tag.workspace.current) `fmap` gets windowset + removeEmptyWorkspaceByTag t + +-- | Remove the current workspace. hunk ./XMonad/Actions/DynamicWorkspaces.hs 132 -removeWorkspace = do s <- gets windowset - case s of - StackSet { current = Screen { workspace = torem } - , hidden = (w:_) } - -> do windows $ view (tag w) - windows (removeWorkspace' (tag torem)) - _ -> return () +removeWorkspace = do t <- (tag.workspace.current) `fmap` gets windowset + removeWorkspaceByTag t + + +-- | Remove workspace with specific tag if it contains no windows. Only works +-- on the current or the last workspace. +removeEmptyWorkspaceByTag :: String -> X () +removeEmptyWorkspaceByTag t = whenX (isEmpty t) $ removeWorkspaceByTag t + +-- | Remove workspace with specific tag. Only works on the current or the last workspace. +removeWorkspaceByTag :: String -> X () +removeWorkspaceByTag torem = do s <- gets windowset + case s of + StackSet { current = Screen { workspace = cur } + , hidden = (w:_) } + -> do when (torem==tag cur) $ windows $ view $ tag w + windows $ removeWorkspace' torem + _ -> return () + +-- | Remove the current workspace after an operation if it is empty and hidden. +-- Can be used to remove a workspace if it is empty when leaving it. The +-- operation may only change workspace once, otherwise the workspace will not +-- be removed. +removeEmptyWorkspaceAfter :: X () -> X () +removeEmptyWorkspaceAfter = removeEmptyWorkspaceAfterExcept [] + +-- | Like 'removeEmptyWorkspaceAfter' but use a list of sticky workspaces, +-- whose entries will never be removed. +removeEmptyWorkspaceAfterExcept :: [String] -> X () -> X () +removeEmptyWorkspaceAfterExcept sticky f = do before <- getTag + f + after <- getTag + when (before/=after && before `notElem` sticky) $ removeEmptyWorkspaceByTag before + where getTag = (tag.workspace.current) `fmap` gets windowset + +isEmpty :: String -> X Bool +isEmpty t = do wsl <- gets $ workspaces . windowset + let mws = find (\ws -> tag ws == t) wsl + return $ maybe True (isNothing.stack) mws hunk ./XMonad/Actions/DynamicWorkspaces.hs 127 -removeEmptyWorkspace = do t <- (tag.workspace.current) `fmap` gets windowset - removeEmptyWorkspaceByTag t +removeEmptyWorkspace = gets (currentTag . windowset) >>= removeEmptyWorkspaceByTag hunk ./XMonad/Actions/DynamicWorkspaces.hs 131 -removeWorkspace = do t <- (tag.workspace.current) `fmap` gets windowset - removeWorkspaceByTag t - +removeWorkspace = gets (currentTag . windowset) >>= removeWorkspaceByTag hunk ./XMonad/Actions/DynamicWorkspaces.hs 140 -removeWorkspaceByTag torem = do s <- gets windowset - case s of - StackSet { current = Screen { workspace = cur } - , hidden = (w:_) } - -> do when (torem==tag cur) $ windows $ view $ tag w - windows $ removeWorkspace' torem - _ -> return () +removeWorkspaceByTag torem = do + s <- gets windowset + case s of + StackSet { current = Screen { workspace = cur }, hidden = (w:_) } -> do + when (torem==tag cur) $ windows $ view $ tag w + windows $ removeWorkspace' torem + _ -> return () hunk ./XMonad/Actions/DynamicWorkspaces.hs 158 -removeEmptyWorkspaceAfterExcept sticky f = do before <- getTag - f - after <- getTag - when (before/=after && before `notElem` sticky) $ removeEmptyWorkspaceByTag before - where getTag = (tag.workspace.current) `fmap` gets windowset +removeEmptyWorkspaceAfterExcept sticky f = do + before <- gets (currentTag . windowset) + f + after <- gets (currentTag . windowset) + when (before/=after && before `notElem` sticky) $ removeEmptyWorkspaceByTag before hunk ./XMonad/Actions/DynamicWorkspaces.hs 167 - return $ maybe True (isNothing.stack) mws + return $ maybe True (isNothing . stack) mws hunk ./XMonad/Prompt.hs 732 -printComplList _ _ _ _ _ _ _ [] = return () -printComplList _ _ _ _ _ [] _ _ = return () -printComplList d drw gc fc bc (x:xs) y (s:ss) = do - printComplColumn d drw gc fc bc x y s - printComplList d drw gc fc bc xs y ss - -printComplColumn :: Display -> Drawable -> GC -> String -> String - -> Position -> [Position] -> [String] -> XP () -printComplColumn _ _ _ _ _ _ _ [] = return () -printComplColumn _ _ _ _ _ _ [] _ = return () -printComplColumn d drw gc fc bc x (y:yy) (s:ss) = do - printComplString d drw gc fc bc x y s - printComplColumn d drw gc fc bc x yy ss - -printComplString :: Display -> Drawable -> GC -> String -> String - -> Position -> Position -> String -> XP () -printComplString d drw gc fc bc x y s = do - st <- get - if completionToCommand (xptype st) s == commandToComplete (xptype st) (command st) - then printStringXMF d drw (fontS st) gc - (fgHLight $ config st) (bgHLight $ config st) x y s - else printStringXMF d drw (fontS st) gc fc bc x y s +printComplList d drw gc fc bc xs ys sss = + zipWithM_ (\x ss -> + zipWithM_ (\y s -> do + st <- get + let (f,b) = if completionToCommand (xptype st) s == commandToComplete (xptype st) (command st) + then (fgHLight $ config st,bgHLight $ config st) + else (fc,bc) + printStringXMF d drw (fontS st) gc f b x y s) + ys ss) xs sss hunk ./XMonad/Prompt.hs 66 -import XMonad hiding (config, io, numlockMask, cleanMask) +import XMonad hiding (config, numlockMask, cleanMask) hunk ./XMonad/Prompt.hs 72 +import XMonad.Util.XUtils (fi) hunk ./XMonad/Prompt.hs 830 --- Lift an IO action into the XP -io :: IO a -> XP a -io = liftIO - --- Shorthand for fromIntegral -fi :: (Num b, Integral a) => a -> b -fi = fromIntegral - hunk ./XMonad/Prompt.hs 272 - s <- gets $ screenRect . W.screenDetail . W.current . windowset - hist <- liftIO readHistory - w <- liftIO $ createWin d rw conf s - liftIO $ selectInput d w $ exposureMask .|. keyPressMask - gc <- liftIO $ createGC d w - liftIO $ setGraphicsExposures d gc False + s <- gets $ screenRect . W.screenDetail . W.current . windowset + hist <- io readHistory + w <- io $ createWin d rw conf s + io $ selectInput d w $ exposureMask .|. keyPressMask + gc <- io $ createGC d w + io $ setGraphicsExposures d gc False hunk ./XMonad/Prompt.hs 283 - st' <- liftIO $ execStateT runXP st + st' <- io $ execStateT runXP st hunk ./XMonad/Prompt.hs 286 - liftIO $ freeGC d gc + io $ freeGC d gc hunk ./XMonad/Prompt.hs 289 - liftIO $ writeHistory $ M.insertWith + io $ writeHistory $ M.insertWith hunk ./XMonad/Prompt.hs 269 - c <- ask - let d = display c - rw = theRoot c + XConf { display = d, theRoot = rw } <- ask hunk ./XMonad/Prompt.hs 314 - st <- get - let (d,w) = (dpy &&& win) st + (d,w) <- gets (dpy &&& win) hunk ./XMonad/Actions/CycleWS.hs 221 + | WSTagGroup Char + -- ^ cycle through workspaces in the same group, the + -- group name is all characters up to the first + -- separator character or the end of the tag hunk ./XMonad/Actions/CycleWS.hs 239 +wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) `fmap` gets windowset + return $ (cur ==).groupName + where groupName = takeWhile (/=sep).tag hunk ./XMonad/Hooks/DynamicLog.hs 466 - , ppVisible = dzenColor "black" "#999999" . pad - , ppHidden = dzenColor "black" "#cccccc" . pad - , ppHiddenNoWindows = const "" - , ppUrgent = dzenColor "red" "yellow" . pad - , ppWsSep = "" - , ppSep = "" - , ppLayout = dzenColor "black" "#cccccc" . - (\ x -> case x of - "TilePrime Horizontal" -> " TTT " - "TilePrime Vertical" -> " []= " - "Hinted Full" -> " [ ] " - _ -> pad x - ) - , ppTitle = ("^bg(#324c80) " ++) . dzenEscape - } + , ppVisible = dzenColor "black" "#999999" . pad + , ppHidden = dzenColor "black" "#cccccc" . pad + , ppHiddenNoWindows = const "" + , ppUrgent = dzenColor "red" "yellow" . pad + , ppWsSep = "" + , ppSep = "" + , ppLayout = dzenColor "black" "#cccccc" . + (\ x -> case x of + "TilePrime Horizontal" -> " TTT " + "TilePrime Vertical" -> " []= " + "Hinted Full" -> " [ ] " + _ -> pad x + ) + , ppTitle = ("^bg(#324c80) " ++) . dzenEscape + } hunk ./XMonad/Hooks/UrgencyHook.hs 198 --- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHook' +-- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHookC' addfile ./XMonad/Util/PositionStore.hs hunk ./XMonad/Util/PositionStore.hs 1 +{-# LANGUAGE DeriveDataTypeable #-} + +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.PositionStore +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- A utility module to store information about position and size of a window. +-- +----------------------------------------------------------------------------- + +module XMonad.Util.PositionStore ( + getPosStore, + modifyPosStore, + + posStoreInsert, + posStoreMove, + posStoreQuery, + posStoreRemove + ) where + +import XMonad +import XMonad.Util.ExtensibleState +import Graphics.X11.Xlib +import Graphics.X11.Types +import Data.Typeable +import qualified Data.Map as M + +-- Store window positions relative to the upper left screen edge +-- and windows sizes as well as positions as fractions of the screen size. +-- This way windows can be easily relocated and scaled when switching screens. + +data PositionStore = PS (M.Map Window PosStoreRectangle) + deriving (Read,Show,Typeable) +data PosStoreRectangle = PSRectangle Double Double Double Double + deriving (Read,Show,Typeable) + +instance ExtensionClass PositionStore where + initialValue = PS M.empty + extensionType = PersistentExtension + +getPosStore :: X (PositionStore) +getPosStore = getState + +modifyPosStore :: (PositionStore -> PositionStore) -> X () +modifyPosStore f = do + posStore <- getState + putState (f posStore) + +posStoreInsert :: PositionStore -> Window -> Rectangle -> Rectangle -> PositionStore +posStoreInsert (PS posStoreMap) w (Rectangle x y wh ht) (Rectangle srX srY srWh srHt) = + let offsetX = x - srX + offsetY = y - srY + in PS $ M.insert w (PSRectangle (fromIntegral offsetX / fromIntegral srWh) + (fromIntegral offsetY / fromIntegral srHt) + (fromIntegral wh / fromIntegral srWh) + (fromIntegral ht / fromIntegral srHt)) posStoreMap + +posStoreRemove :: PositionStore -> Window -> PositionStore +posStoreRemove (PS posStoreMap) w = PS $ M.delete w posStoreMap + +posStoreQuery :: PositionStore -> Window -> Rectangle -> Maybe Rectangle +posStoreQuery (PS posStoreMap) w (Rectangle srX srY srWh srHt) = do + (PSRectangle x y wh ht) <- M.lookup w posStoreMap + let realWh = fromIntegral srWh * wh + realHt = fromIntegral srHt * ht + realOffsetX = fromIntegral srWh * x + realOffsetY = fromIntegral srHt * y + return (Rectangle (srX + round realOffsetX) (srY + round realOffsetY) + (round realWh) (round realHt)) + +posStoreMove :: PositionStore -> Window -> Position -> Position -> Rectangle -> Rectangle -> PositionStore +posStoreMove posStore w x y oldSr newSr = + case (posStoreQuery posStore w oldSr) of + Nothing -> posStore -- not in store, can't move -> do nothing + Just (Rectangle _ _ wh ht) -> posStoreInsert posStore w (Rectangle x y wh ht) newSr hunk ./xmonad-contrib.cabal 233 + XMonad.Util.PositionStore addfile ./XMonad/Hooks/PositionStoreHooks.hs hunk ./XMonad/Hooks/PositionStoreHooks.hs 1 +{-# LANGUAGE PatternSignatures #-} + +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.PositionStoreHooks +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- This module contains two hooks for the +-- PositionStore (see "XMonad.Util.PositionStore") - a ManageHook and +-- an EventHook. +-- +-- The ManageHook can be used to fill the PositionStore with position and size +-- information about new windows. The advantage of using this hook is, that the +-- information is recorded independent of the currently active layout. So the +-- floating shape of the window can later be restored even if it was opened in a +-- tiled layout initially. +-- +-- For windows, that do not request a particular position, a random position will +-- be assigned. This prevents windows from piling up exactly on top of each other. +-- +-- The EventHook makes sure that windows are deleted from the PositionStore +-- when they are closed. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.PositionStoreHooks ( + -- * Usage + -- $usage + positionStoreManageHook, + positionStoreEventHook + ) where + +import XMonad +import qualified XMonad.StackSet as W +import XMonad.Util.PositionStore + +import System.Random(randomRIO) +import Control.Applicative((<$>)) +import Control.Monad(when) +import Data.Maybe +import Data.Monoid + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.PositionStoreHooks +-- +-- and adding 'positionStoreManageHook' to your 'ManageHook' as well +-- as 'positionStoreEventHook' to your event hooks: +-- +-- > myManageHook = positionStoreManageHook <+> manageHook defaultConfig +-- > myHandleEventHook = positionStoreEventHook +-- > +-- > main = xmonad defaultConfig { manageHook = myManageHook +-- > , handleEventHook = myHandleEventHook +-- > } +-- + +positionStoreManageHook :: ManageHook +positionStoreManageHook = ask >>= liftX . positionStoreInit >> idHook + +positionStoreInit :: Window -> X () +positionStoreInit w = withDisplay $ \d -> do + wa <- io $ getWindowAttributes d w + ws <- gets windowset + arbitraryOffsetX <- randomIntOffset + arbitraryOffsetY <- randomIntOffset + if (wa_x wa == 0) && (wa_y wa == 0) + then do + let sr@(Rectangle srX srY _ _) = screenRect . W.screenDetail . W.current $ ws + modifyPosStore (\ps -> posStoreInsert ps w + (Rectangle (srX + fi arbitraryOffsetX) + (srY + fi arbitraryOffsetY) + (fi $ wa_width wa) + (fi $ wa_height wa)) sr ) + else do + sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) + let sr = screenRect . W.screenDetail $ sc + modifyPosStore (\ps -> posStoreInsert ps w + (Rectangle (fi $ wa_x wa) (fi $ wa_y wa) + (fi $ wa_width wa) (fi $ wa_height wa)) sr ) + where + fi :: (Integral a, Num b) => a -> b + fi = fromIntegral + randomIntOffset :: X (Int) + randomIntOffset = io $ randomRIO (42, 242) + +positionStoreEventHook :: Event -> X All +positionStoreEventHook (DestroyWindowEvent {ev_window = w, ev_event_type = et}) = do + when (et == destroyNotify) $ do + modifyPosStore (\ps -> posStoreRemove ps w) + return (All True) +positionStoreEventHook _ = return (All True) hunk ./XMonad/Layout/BorderResize.hs 15 --- "XMonad.Layout.WindowArranger" can be used to create such a setup. --- BorderResize is probably most useful in floating layouts. +-- "XMonad.Layout.WindowArranger" can be used to create such a setup, +-- but it is probably must useful in a floating layout such as +-- "XMonad.Layout.PositionStoreFloat" with which it has been mainly tested. +-- See the documentation of PositionStoreFloat for a typical usage example. addfile ./XMonad/Layout/PositionStoreFloat.hs hunk ./XMonad/Layout/PositionStoreFloat.hs 1 +{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-} +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.PositionStoreFloat +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- A floating layout which has been designed with a dual-head setup +-- in mind. It makes use of "XMonad.Util.PositionStore" as well as +-- "XMonad.Hooks.PositionStoreHooks" . Since there is currently no way +-- to move or resize windows with the keyboard alone in this layout, +-- it is adviced to use it in combination with a decoration such as +-- "XMonad.Layout.NoFrillsDecoration" (to move windows) and the +-- layout modifier "XMonad.Layout.BorderResize" (to resize windows). +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.PositionStoreFloat + ( -- * Usage + -- $usage + positionStoreFloat + ) where + +import XMonad +import XMonad.Util.PositionStore +import qualified XMonad.StackSet as S +import XMonad.Layout.WindowArranger +import Control.Monad(when) +import Data.Maybe(isJust) +import Data.List(nub) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.PositionStoreFloat +-- > import XMonad.Layout.NoFrillsDecoration +-- > import XMonad.Layout.BorderResize +-- +-- Then edit your @layoutHook@ by adding the PositionStoreFloat layout. +-- Below is a suggestion which uses the mentioned NoFrillsDecoration and +-- BorderResize: +-- +-- > myLayouts = floatingDeco $ borderResize $ positionStoreFloat ||| etc.. +-- > where floatingDeco l = noFrillsDeco shrinkText defaultTheme l +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- See the documentation of "XMonad.Hooks.PositionStoreHooks" on how +-- to add the support hooks. + +positionStoreFloat :: PositionStoreFloat a +positionStoreFloat = PSF (Nothing, []) + +data PositionStoreFloat a = PSF (Maybe Rectangle, [a]) deriving (Show, Read) +instance LayoutClass PositionStoreFloat Window where + description _ = "PSF" + doLayout (PSF (maybeChange, paintOrder)) sr (S.Stack w l r) = do + posStore <- getPosStore + let wrs = map (\w' -> (w', pSQ posStore w' sr)) (reverse l ++ r) + let focused = case maybeChange of + Nothing -> (w, pSQ posStore w sr) + Just changedRect -> (w, changedRect) + let wrs' = focused : wrs + let paintOrder' = nub (w : paintOrder) + when (isJust maybeChange) $ do + updatePositionStore focused sr + return (reorder wrs' paintOrder', Just $ PSF (Nothing, paintOrder')) + where + pSQ posStore w' sr' = case (posStoreQuery posStore w' sr') of + Just rect -> rect + Nothing -> (Rectangle 50 50 200 200) -- should usually not happen + pureMessage (PSF (_, paintOrder)) m + | Just (SetGeometry rect) <- fromMessage m = + Just $ PSF (Just rect, paintOrder) + | otherwise = Nothing + +updatePositionStore :: (Window, Rectangle) -> Rectangle -> X () +updatePositionStore (w, rect) sr = modifyPosStore (\ps -> + posStoreInsert ps w rect sr) + +reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)] +reorder wrs order = + let ordered = concat $ map (pickElem wrs) order + rest = filter (\(w, _) -> not (w `elem` order)) wrs + in ordered ++ rest + where + pickElem list e = case (lookup e list) of + Just result -> [(e, result)] + Nothing -> [] hunk ./XMonad/Util/PositionStore.hs 14 +-- See "XMonad.Layout.PositionStoreFloat" for a layout that makes use of this. hunk ./xmonad-contrib.cabal 128 + XMonad.Hooks.PositionStoreHooks hunk ./xmonad-contrib.cabal 183 + XMonad.Layout.PositionStoreFloat hunk ./XMonad/Actions/SpawnOn.hs 39 -import XMonad.Util.ExtensibleState +import qualified XMonad.Util.ExtensibleState as XS hunk ./XMonad/Actions/SpawnOn.hs 74 -modifySpawner f = putState . Spawner . f . pidsRef =<< getState +modifySpawner f = XS.modify (Spawner . f . pidsRef) hunk ./XMonad/Actions/SpawnOn.hs 80 - Spawner pids <- liftX getState + Spawner pids <- liftX XS.get hunk ./XMonad/Actions/TopicSpace.hs 48 -import Control.Applicative ((<$>)) hunk ./XMonad/Actions/TopicSpace.hs 61 -import XMonad.Util.ExtensibleState +import qualified XMonad.Util.ExtensibleState as XS hunk ./XMonad/Actions/TopicSpace.hs 224 -getLastFocusedTopics = getPrevTopics <$> getState +getLastFocusedTopics = XS.gets getPrevTopics hunk ./XMonad/Actions/TopicSpace.hs 231 - modifyState $ PrevTopics + XS.modify $ PrevTopics hunk ./XMonad/Hooks/DynamicHooks.hs 26 -import XMonad.Util.ExtensibleState +import qualified XMonad.Util.ExtensibleState as XS hunk ./XMonad/Hooks/DynamicHooks.hs 66 - dh <- getState + dh <- XS.get hunk ./XMonad/Hooks/DynamicHooks.hs 72 - putState $ dh { transients = map snd nts } + XS.put $ dh { transients = map snd nts } hunk ./XMonad/Hooks/DynamicHooks.hs 81 -updateDynamicHook f = modifyState $ \dh -> dh { permanent = f (permanent dh) } +updateDynamicHook f = XS.modify $ \dh -> dh { permanent = f (permanent dh) } hunk ./XMonad/Hooks/DynamicHooks.hs 93 -oneShotHook q a = modifyState $ \dh -> dh { transients = (q,a):(transients dh) } +oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):(transients dh) } hunk ./XMonad/Hooks/FloatNext.hs 42 -import XMonad.Util.ExtensibleState +import qualified XMonad.Util.ExtensibleState as XS hunk ./XMonad/Hooks/FloatNext.hs 51 -_set f b = modifyState' (f $ const b) +_set f b = modify' (f $ const b) hunk ./XMonad/Hooks/FloatNext.hs 54 -_toggle f = modifyState' (f not) +_toggle f = modify' (f not) hunk ./XMonad/Hooks/FloatNext.hs 57 -_get f = f . getFloatMode <$> getState +_get f = XS.gets (f . getFloatMode) hunk ./XMonad/Hooks/FloatNext.hs 69 -modifyState' :: ((Bool,Bool) -> (Bool,Bool)) -> X () -modifyState' f = modifyState (FloatMode . f . getFloatMode) +modify' :: ((Bool,Bool) -> (Bool,Bool)) -> X () +modify' f = XS.modify (FloatMode . f . getFloatMode) hunk ./XMonad/Hooks/FloatNext.hs 98 -floatNextHook = do (next, all) <- liftX $ getFloatMode <$> getState - liftX $ putState $ FloatMode (False, all) +floatNextHook = do (next, all) <- liftX $ XS.gets getFloatMode + liftX $ XS.put $ FloatMode (False, all) hunk ./XMonad/Hooks/PositionStoreHooks.hs 1 -{-# LANGUAGE PatternSignatures #-} - hunk ./XMonad/Hooks/UrgencyHook.hs 75 -import XMonad.Util.ExtensibleState +import qualified XMonad.Util.ExtensibleState as XS hunk ./XMonad/Hooks/UrgencyHook.hs 278 -readUrgents = fromUrgents <$> getState +readUrgents = XS.gets fromUrgents hunk ./XMonad/Hooks/UrgencyHook.hs 285 -adjustUrgents f = modifyState $ onUrgents f +adjustUrgents = XS.modify . onUrgents hunk ./XMonad/Hooks/UrgencyHook.hs 304 -readReminders = getState +readReminders = XS.get hunk ./XMonad/Hooks/UrgencyHook.hs 307 -adjustReminders f = modifyState f +adjustReminders = XS.modify hunk ./XMonad/Util/ExtensibleState.hs 18 - putState - , modifyState - , removeState - , getState + put + , modify + , remove + , get + , gets hunk ./XMonad/Util/ExtensibleState.hs 28 -import Control.Monad.State +import qualified Control.Monad.State as State hunk ./XMonad/Util/ExtensibleState.hs 38 +-- > import qualified XMonad.Util.ExtensibleState as XS hunk ./XMonad/Util/ExtensibleState.hs 44 --- > .. putState (ListStorage [23,42]) +-- > .. XS.put (ListStorage [23,42]) hunk ./XMonad/Util/ExtensibleState.hs 48 --- > .. getState +-- > .. XS.get hunk ./XMonad/Util/ExtensibleState.hs 53 --- > .. getState :: X ListStorage +-- > .. XS.get :: X ListStorage hunk ./XMonad/Util/ExtensibleState.hs 76 -modifyStateExts f = modify $ \st -> st { extensibleState = f (extensibleState st) } +modifyStateExts f = State.modify $ \st -> st { extensibleState = f (extensibleState st) } hunk ./XMonad/Util/ExtensibleState.hs 80 -modifyState :: ExtensionClass a => (a -> a) -> X () -modifyState f = putState . f =<< getState +modify :: ExtensionClass a => (a -> a) -> X () +modify f = put . f =<< get hunk ./XMonad/Util/ExtensibleState.hs 86 -putState :: ExtensionClass a => a -> X () -putState v = modifyStateExts . M.insert (show . typeOf $ v) . Right . extensionType $ v +put :: ExtensionClass a => a -> X () +put v = modifyStateExts . M.insert (show . typeOf $ v) . Right . extensionType $ v hunk ./XMonad/Util/ExtensibleState.hs 90 -getState :: ExtensionClass a => X a -getState = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables +get :: ExtensionClass a => X a +get = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables hunk ./XMonad/Util/ExtensibleState.hs 95 - v <- gets $ M.lookup (show . typeOf $ k) . extensibleState + v <- State.gets $ M.lookup (show . typeOf $ k) . extensibleState hunk ./XMonad/Util/ExtensibleState.hs 103 - putState (val `asTypeOf` k) + put (val `asTypeOf` k) hunk ./XMonad/Util/ExtensibleState.hs 111 +gets :: ExtensionClass a => (a -> b) -> X b +gets = flip fmap get + hunk ./XMonad/Util/ExtensibleState.hs 115 -removeState :: ExtensionClass a => a -> X () -removeState wit = modifyStateExts $ M.delete (show . typeOf $ wit) +remove :: ExtensionClass a => a -> X () +remove wit = modifyStateExts $ M.delete (show . typeOf $ wit) hunk ./XMonad/Util/PositionStore.hs 29 -import XMonad.Util.ExtensibleState +import qualified XMonad.Util.ExtensibleState as XS hunk ./XMonad/Util/PositionStore.hs 49 -getPosStore = getState +getPosStore = XS.get hunk ./XMonad/Util/PositionStore.hs 52 -modifyPosStore f = do - posStore <- getState - putState (f posStore) +modifyPosStore = XS.modify hunk ./XMonad/Util/SpawnOnce.hs 22 -import XMonad.Util.ExtensibleState +import qualified XMonad.Util.ExtensibleState as XS hunk ./XMonad/Util/SpawnOnce.hs 36 - b <- fmap (Set.member xs . unspawnOnce) getState + b <- XS.gets (Set.member xs . unspawnOnce) hunk ./XMonad/Util/SpawnOnce.hs 39 - modifyState (SpawnOnce . Set.insert xs . unspawnOnce) + XS.modify (SpawnOnce . Set.insert xs . unspawnOnce) hunk ./XMonad/Hooks/PositionStoreHooks.hs 39 +import XMonad.Util.XUtils (fi) hunk ./XMonad/Hooks/PositionStoreHooks.hs 87 - fi :: (Integral a, Num b) => a -> b - fi = fromIntegral hunk ./XMonad/Hooks/ManageDocks.hs 239 - L | p (y0, y1) -> (mx x0 sx0 , y0 , x1 , y1 ) - R | p (y0, y1) -> (x0 , y0 , mn x1 sx1, y1 ) - U | p (x0, x1) -> (x0 , mx y0 sy0, x1 , y1 ) - D | p (x0, x1) -> (x0 , y0 , x1 , mn y1 sy1) - _ -> (x0 , y0 , x1 , y1 ) + L | p (y0, y1) && qh x1 -> (mx x0 sx0, y0 , x1 , y1 ) + R | p (y0, y1) && qv sx1 x0 -> (x0 , y0 , mn x1 sx1, y1 ) + U | p (x0, x1) && qh y1 -> (x0 , mx y0 sy0, x1 , y1 ) + D | p (x0, x1) && qv sy1 y0 -> (x0 , y0 , x1 , mn y1 sy1) + _ -> (x0 , y0 , x1 , y1 ) hunk ./XMonad/Hooks/ManageDocks.hs 248 + -- Filter out struts that cover the entire rectangle: + qh d1 = n <= d1 + qv sd1 d0 = sd1 - n >= d0 hunk ./XMonad/Hooks/DynamicLog.hs 90 --- > main = xmonad =<< xmobar conf +-- > main = xmonad =<< xmobar myConfig +-- > +-- > myConfig = defaultConfig { ... } hunk ./XMonad/Hooks/DynamicLog.hs 155 --- > main = xmonad =<< dzen conf +-- > main = xmonad =<< dzen myConfig +-- > +-- > myConfig = defaultConfig { ... } hunk ./XMonad/Hooks/DynamicLog.hs 180 --- > main = xmonad =<< xmobar conf +-- > main = xmonad =<< xmobar myConfig +-- > +-- > myConfig = defaultConfig { ... } hunk ./XMonad/Hooks/DynamicLog.hs 61 -import Data.Char ( isSpace ) +import Data.Char ( isSpace, ord ) hunk ./XMonad/Hooks/DynamicLog.hs 69 -import qualified Codec.Binary.UTF8.String as UTF8 hunk ./XMonad/Hooks/DynamicLog.hs 213 --- property is of type UTF8_STRING. +-- property is of type UTF8_STRING. The string must have been processed by +-- encodeString (dynamicLogString does this). hunk ./XMonad/Hooks/DynamicLog.hs 224 - encodeCChar = map fromIntegral . UTF8.encode + encodeCChar = map (fromIntegral . ord) hunk ./XMonad/Layout/BorderResize.hs 33 -import Control.Monad(when,forM) -import Control.Arrow(first) -import Control.Applicative((<$>)) +import Control.Monad(when) +import qualified Data.Map as M hunk ./XMonad/Layout/BorderResize.hs 45 -data BorderInfo = RightSideBorder Window Rectangle - | LeftSideBorder Window Rectangle - | TopSideBorder Window Rectangle - | BottomSideBorder Window Rectangle +type BorderBlueprint = (Rectangle, Glyph, BorderType) + +data BorderType = RightSideBorder + | LeftSideBorder + | TopSideBorder + | BottomSideBorder hunk ./XMonad/Layout/BorderResize.hs 52 -type BorderWithRect = (Rectangle, Rectangle, Glyph, BorderInfo) -type BorderWithWin = (Window, BorderInfo) +data BorderInfo = BI { bWin :: Window, + bRect :: Rectangle, + bType :: BorderType + } deriving (Show, Read) + +type RectWithBorders = (Rectangle, [BorderInfo]) hunk ./XMonad/Layout/BorderResize.hs 59 -data BorderResize a = BR [BorderWithWin] deriving (Show, Read) +data BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read) hunk ./XMonad/Layout/BorderResize.hs 76 -borderResize = ModifiedLayout (BR []) +borderResize = ModifiedLayout (BR M.empty) hunk ./XMonad/Layout/BorderResize.hs 80 - redoLayout (BR borders) _ _ wrs = do - let preparedBorders = for wrs $ \wr -> (wr, prepareBorders wr) - mapM_ deleteBorder borders - newBorders <- forM preparedBorders $ \(wr, (b1, b2, b3, b4)) -> - first (++[wr]) . unzip <$> mapM createBorder [b1,b2,b3,b4] - let wrs' = concat $ map fst newBorders - newBordersSerialized = concat $ map snd newBorders - return (wrs', Just $ BR newBordersSerialized) + redoLayout (BR wrsLastTime) _ _ wrs = do + let correctOrder = map fst wrs + wrsCurrent = M.fromList wrs + wrsGone = M.difference wrsLastTime wrsCurrent + wrsAppeared = M.difference wrsCurrent wrsLastTime + wrsStillThere = M.intersectionWith testIfUnchanged wrsLastTime wrsCurrent + handleGone wrsGone + wrsCreated <- handleAppeared wrsAppeared + let wrsChanged = handleStillThere wrsStillThere + wrsThisTime = M.union wrsChanged wrsCreated + return (compileWrs wrsThisTime correctOrder, Just $ BR wrsThisTime) hunk ./XMonad/Layout/BorderResize.hs 97 + where + testIfUnchanged entry@(rLastTime, _) rCurrent = + if rLastTime == rCurrent + then (Nothing, entry) + else (Just rCurrent, entry) hunk ./XMonad/Layout/BorderResize.hs 103 - handleMess (BR borders) m - | Just e <- fromMessage m :: Maybe Event = handleResize borders e >> return Nothing + handleMess (BR wrsLastTime) m + | Just e <- fromMessage m :: Maybe Event = + handleResize (createBorderLookupTable wrsLastTime) e >> return Nothing hunk ./XMonad/Layout/BorderResize.hs 107 - mapM_ deleteBorder borders >> return (Just $ BR []) + handleGone wrsLastTime >> return (Just $ BR M.empty) hunk ./XMonad/Layout/BorderResize.hs 110 -prepareBorders :: (Window, Rectangle) -> (BorderWithRect, BorderWithRect, BorderWithRect, BorderWithRect) -prepareBorders (w, r@(Rectangle x y wh ht)) = - ((r, (Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht) , brCursorRightSide , RightSideBorder w r), - (r, (Rectangle (x - brBorderOffset) y brBorderSize ht) , brCursorLeftSide , LeftSideBorder w r), - (r, (Rectangle x (y - brBorderOffset) wh brBorderSize) , brCursorTopSide , TopSideBorder w r), - (r, (Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize) , brCursorBottomSide , BottomSideBorder w r) - ) +compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)] +compileWrs wrsThisTime correctOrder = let wrs = reorder (M.toList wrsThisTime) correctOrder + in concat $ map compileWr wrs + +compileWr :: (Window, RectWithBorders) -> [(Window, Rectangle)] +compileWr (w, (r, borderInfos)) = + let borderWrs = for borderInfos $ \bi -> (bWin bi, bRect bi) + in borderWrs ++ [(w, r)] + +handleGone :: M.Map Window RectWithBorders -> X () +handleGone wrsGone = mapM_ deleteWindow borderWins + where + borderWins = map bWin . concat . map snd . M.elems $ wrsGone + +handleAppeared :: M.Map Window Rectangle -> X (M.Map Window RectWithBorders) +handleAppeared wrsAppeared = do + let wrs = M.toList wrsAppeared + wrsCreated <- mapM handleSingleAppeared wrs + return $ M.fromList wrsCreated + +handleSingleAppeared :: (Window, Rectangle) -> X (Window, RectWithBorders) +handleSingleAppeared (w, r) = do + let borderBlueprints = prepareBorders r + borderInfos <- mapM createBorder borderBlueprints + return (w, (r, borderInfos)) + +handleStillThere :: M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders +handleStillThere wrsStillThere = M.map handleSingleStillThere wrsStillThere hunk ./XMonad/Layout/BorderResize.hs 139 -handleResize :: [BorderWithWin] -> Event -> X () +handleSingleStillThere :: (Maybe Rectangle, RectWithBorders) -> RectWithBorders +handleSingleStillThere (Nothing, entry) = entry +handleSingleStillThere (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos) + where + changedBorderBlueprints = prepareBorders rCurrent + updatedBorderInfos = map updateBorderInfo . zip borderInfos $ changedBorderBlueprints + -- assuming that the four borders are always in the same order + +updateBorderInfo :: (BorderInfo, BorderBlueprint) -> BorderInfo +updateBorderInfo (borderInfo, (r, _, _)) = borderInfo { bRect = r } + +createBorderLookupTable :: M.Map Window RectWithBorders -> [(Window, (BorderType, Window, Rectangle))] +createBorderLookupTable wrsLastTime = concat $ map processSingleEntry $ M.toList wrsLastTime + where + processSingleEntry :: (Window, RectWithBorders) -> [(Window, (BorderType, Window, Rectangle))] + processSingleEntry (w, (r, borderInfos)) = for borderInfos $ \bi -> (bWin bi, (bType bi, w, r)) + +prepareBorders :: Rectangle -> [BorderBlueprint] +prepareBorders (Rectangle x y wh ht) = + [((Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht), brCursorRightSide , RightSideBorder), + ((Rectangle (x - brBorderOffset) y brBorderSize ht) , brCursorLeftSide , LeftSideBorder), + ((Rectangle x (y - brBorderOffset) wh brBorderSize) , brCursorTopSide , TopSideBorder), + ((Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize), brCursorBottomSide , BottomSideBorder) + ] + +handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X () hunk ./XMonad/Layout/BorderResize.hs 168 - RightSideBorder hostWin (Rectangle hx hy _ hht) -> + (RightSideBorder, hostWin, (Rectangle hx hy _ hht)) -> hunk ./XMonad/Layout/BorderResize.hs 174 - LeftSideBorder hostWin (Rectangle hx hy hwh hht) -> + (LeftSideBorder, hostWin, (Rectangle hx hy hwh hht)) -> hunk ./XMonad/Layout/BorderResize.hs 181 - TopSideBorder hostWin (Rectangle hx hy hwh hht) -> + (TopSideBorder, hostWin, (Rectangle hx hy hwh hht)) -> hunk ./XMonad/Layout/BorderResize.hs 188 - BottomSideBorder hostWin (Rectangle hx hy hwh _) -> + (BottomSideBorder, hostWin, (Rectangle hx hy hwh _)) -> hunk ./XMonad/Layout/BorderResize.hs 196 -createBorder :: BorderWithRect -> X (((Window, Rectangle), BorderWithWin)) -createBorder (_, borderRect, borderCursor, borderInfo) = do +createBorder :: BorderBlueprint -> X (BorderInfo) +createBorder (borderRect, borderCursor, borderType) = do hunk ./XMonad/Layout/BorderResize.hs 199 - return ((borderWin, borderRect), (borderWin, borderInfo)) - -deleteBorder :: BorderWithWin -> X () -deleteBorder (borderWin, _) = deleteWindow borderWin + return BI { bWin = borderWin, bRect = borderRect, bType = borderType } hunk ./XMonad/Layout/BorderResize.hs 224 + +reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)] +reorder wrs order = + let ordered = concat $ map (pickElem wrs) order + rest = filter (\(w, _) -> not (w `elem` order)) wrs + in ordered ++ rest + where + pickElem list e = case (lookup e list) of + Just result -> [(e, result)] + Nothing -> [] hunk ./XMonad/Layout/MouseResizableTile.hs 232 + io . flip lowerWindow draggerWin =<< asks display hunk ./XMonad/Layout/Decoration.hs 160 - pureDecoration _ _ ht _ s _ (w,Rectangle x y wh _) = if isInStack s w - then Just $ Rectangle x y wh ht - else Nothing + pureDecoration _ _ ht _ s _ (w,Rectangle x y wh ht') = if isInStack s w && (ht < ht') + then Just $ Rectangle x y wh ht + else Nothing hunk ./XMonad/Util/Font.hsc 146 -data Align = AlignCenter | AlignRight | AlignLeft +data Align = AlignCenter | AlignRight | AlignLeft | AlignRightOffset Int hunk ./XMonad/Util/Font.hsc 159 + AlignRightOffset offset -> fi (w - (fi width + 1)) - fi offset; hunk ./XMonad/Util/Loggers.hs 257 - AlignLeft -> toL (take n $ l ++ cs) + _ -> toL (take n $ l ++ cs) hunk ./XMonad/Layout/Decoration.hs 377 - paintAndWrite dw fs wh ht 1 bc borderc tc bc AlignCenter name + paintAndWrite dw fs wh ht 1 bc borderc tc bc [AlignCenter] [name] hunk ./XMonad/Layout/ShowWName.hs 99 - paintAndWrite w f (fi width) (fi hight) 0 "" "" (swn_color c) (swn_bgcolor c) AlignCenter n + paintAndWrite w f (fi width) (fi hight) 0 "" "" (swn_color c) (swn_bgcolor c) [AlignCenter] [n] hunk ./XMonad/Util/XUtils.hs 106 --- | Fill a window with a rectangle and a border, and write a string at given position +-- | Fill a window with a rectangle and a border, and write +-- | a number of strings to given positions hunk ./XMonad/Util/XUtils.hs 117 - -> Align -- ^ String 'Align'ment - -> String -- ^ String to be printed + -> [Align] -- ^ String 'Align'ments + -> [String] -- ^ Strings to be printed hunk ./XMonad/Util/XUtils.hs 120 -paintAndWrite w fs wh ht bw bc borc ffc fbc al str = do +paintAndWrite w fs wh ht bw bc borc ffc fbc als strs = do hunk ./XMonad/Util/XUtils.hs 122 - (x,y) <- stringPosition d fs (Rectangle 0 0 wh ht) al str - paintWindow' w (Rectangle x y wh ht) bw bc borc ms - where ms = Just (fs,ffc,fbc,str) + strPositions <- forM (zip als strs) $ \(al, str) -> + stringPosition d fs (Rectangle 0 0 wh ht) al str + let ms = Just (fs,ffc,fbc, zip strs strPositions) + paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms hunk ./XMonad/Util/XUtils.hs 129 -paintWindow' :: Window -> Rectangle -> Dimension -> String -> String -> Maybe (XMonadFont,String,String,String) -> X () -paintWindow' win (Rectangle x y wh ht) bw color b_color str = do +paintWindow' :: Window -> Rectangle -> Dimension -> String -> String -> Maybe (XMonadFont,String,String,[(String, (Position, Position))]) -> X () +paintWindow' win (Rectangle _ _ wh ht) bw color b_color strStuff = do hunk ./XMonad/Util/XUtils.hs 143 - when (isJust str) $ do - let (xmf,fc,bc,s) = fromJust str - printStringXMF d p xmf gc fc bc x y s + when (isJust strStuff) $ do + let (xmf,fc,bc,strAndPos) = fromJust strStuff + forM_ strAndPos $ \(s, (x, y)) -> + printStringXMF d p xmf gc fc bc x y s hunk ./XMonad/Layout/Decoration.hs 80 + , windowTitleAddons :: [(String, Align)] -- ^ Extra text to appear in a window's title bar hunk ./XMonad/Layout/Decoration.hs 98 + , windowTitleAddons = [] hunk ./XMonad/Layout/Decoration.hs 379 - paintAndWrite dw fs wh ht 1 bc borderc tc bc [AlignCenter] [name] + let als = AlignCenter : map snd (windowTitleAddons t) + strs = name : map fst (windowTitleAddons t) + paintAndWrite dw fs wh ht 1 bc borderc tc bc als strs hunk ./XMonad/Util/Font.hsc 147 + deriving (Show, Read) hunk ./XMonad/Layout/Decoration.hs 5 --- Copyright : (c) 2007 Andrea Rossato +-- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger hunk ./XMonad/Layout/Decoration.hs 35 +import Foreign.C.Types(CInt) hunk ./XMonad/Layout/Decoration.hs 142 - -- | The decoration event hook, where the - -- 'decorationMouseFocusHook' and 'decorationMouseDragHook' are - -- called. If you reimplement it those methods will not be - -- called. + -- | The decoration event hook hunk ./XMonad/Layout/Decoration.hs 144 - decorationEventHook ds s e = do decorationMouseFocusHook ds s e - decorationMouseDragHook ds s e + decorationEventHook ds s e = handleMouseFocusDrag ds s e hunk ./XMonad/Layout/Decoration.hs 146 - -- | This method is called when the user clicks the pointer over - -- the decoration. - decorationMouseFocusHook :: ds a -> DecorationState -> Event -> X () - decorationMouseFocusHook _ s e = handleMouseFocusDrag False s e + -- | A hook that can be used to catch the cases when the user + -- clicks on the decoration. If you return True here, the click event + -- will be considered as dealt with and no further processing will take place. + decorationCatchClicksHook :: ds a + -> Window + -> Int -- ^ distance from the left where the click happened on the decoration + -> Int -- ^ distance from the right where the click happened on the decoration + -> X Bool + decorationCatchClicksHook _ _ _ _ = return False hunk ./XMonad/Layout/Decoration.hs 156 - -- | This method is called when the user starts grabbing the - -- decoration. - decorationMouseDragHook :: ds a -> DecorationState -> Event -> X () - decorationMouseDragHook _ s e = handleMouseFocusDrag True s e + -- | This hook is called while a window is dragged using the decoration. + -- The hook can be overwritten if a different way of handling the dragging + -- is required. + decorationWhileDraggingHook :: ds a -> CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () + decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleDraggingInProgress ex ey (mainw, r) x y + + -- | This hoook is called after a window has been dragged using the decoration. + decorationAfterDraggingHook :: ds a -> (Window, Rectangle) -> Window -> X () + decorationAfterDraggingHook _ds (mainw, _r) _decoWin = focus mainw hunk ./XMonad/Layout/Decoration.hs 295 -handleMouseFocusDrag :: Bool -> DecorationState -> Event -> X () -handleMouseFocusDrag b (DS dwrs _) ButtonEvent { ev_window = ew - , ev_event_type = et - , ev_x_root = ex - , ev_y_root = ey } +handleMouseFocusDrag :: (DecorationStyle ds a) => ds a -> DecorationState -> Event -> X () +handleMouseFocusDrag ds (DS dwrs _) ButtonEvent { ev_window = ew + , ev_event_type = et + , ev_x_root = ex + , ev_y_root = ey } hunk ./XMonad/Layout/Decoration.hs 301 - , Just ((mainw,r),_) <- lookFor ew dwrs = do - focus mainw - when b $ mouseDrag (\x y -> do - let rect = Rectangle (x - (fi ex - rect_x r)) - (y - (fi ey - rect_y r)) - (rect_width r) - (rect_height r) - sendMessage (SetGeometry rect)) (return ()) + , Just ((mainw,r), (_, decoRectM)) <- lookFor ew dwrs = do + let Just (Rectangle dx _ dwh _) = decoRectM + distFromLeft = ex - fi dx + distFromRight = fi dwh - (ex - fi dx) + dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight) + when (not dealtWith) $ do + mouseDrag (\x y -> focus mainw >> decorationWhileDraggingHook ds ex ey (mainw, r) x y) + (decorationAfterDraggingHook ds (mainw, r) ew) hunk ./XMonad/Layout/Decoration.hs 311 +handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () +handleDraggingInProgress ex ey (_, r) x y = do + let rect = Rectangle (x - (fi ex - rect_x r)) + (y - (fi ey - rect_y r)) + (rect_width r) + (rect_height r) + sendMessage $ SetGeometry rect + hunk ./XMonad/Layout/TabBarDecoration.hs 69 - decorationMouseDragHook _ _ _ = return () + decorationCatchClicksHook _ mainw _ _ = focus mainw >> return True hunk ./XMonad/Layout/Tabbed.hs 158 - decorationMouseFocusHook _ ds ButtonEvent { ev_window = ew - , ev_event_type = et - , ev_button = eb } + decorationEventHook _ ds ButtonEvent { ev_window = ew + , ev_event_type = et + , ev_button = eb } hunk ./XMonad/Layout/Tabbed.hs 166 - decorationMouseFocusHook _ _ _ = return () + decorationEventHook _ _ _ = return () hunk ./XMonad/Layout/Tabbed.hs 168 - decorationMouseDragHook _ _ _ = return () hunk ./XMonad/Prompt.hs 419 - , (xK_q, quit) + , (xK_g, quit) + , (xK_bracketleft, quit) hunk ./XMonad/Actions/Search.hs 299 -wikipedia = searchEngine "wiki" "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search=" -wiktionary = searchEngine "wikt" "http://en.wiktionary.org/wiki/Special:Search?go=Go&search=" +wikipedia = searchEngine "wiki" "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=" +wiktionary = searchEngine "wikt" "http://en.wiktionary.org/wiki/Special:Search?go=Go&search=" hunk ./XMonad/Actions/Search.hs 302 -{- This doesn't seem to work, but nevertheless, it seems to be the official - method at to get the - latest backup. -} -wayback = searchEngine "wayback" "http://web.archive.org/" +wayback = searchEngineF "wayback" ("http://web.archive.org/web/*/"++) addfile ./XMonad/Layout/ButtonDecoration.hs hunk ./XMonad/Layout/ButtonDecoration.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.ButtonDecoration +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- A decoration that includes small buttons on both ends which invoke +-- various actions when clicked on: Show a window menu (see +-- "XMonad.Actions.WindowMenu"), minimize, maximize or close the window. +-- +-- Note: For maximizing and minimizing to actually work, you will need +-- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your +-- setup. See the documentation of those modules for more information. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.ButtonDecoration + ( -- * Usage: + -- $usage + buttonDeco + ) where + +import XMonad +import XMonad.Layout.Decoration +import XMonad.Layout.DecorationAddons + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.DecorationAddons +-- > import XMonad.Layout.ButtonDecoration +-- +-- Then edit your @layoutHook@ by adding the ButtonDecoration to +-- your layout: +-- +-- > myL = buttonDeco shrinkText defaultThemeWithButtons (layoutHook defaultConfig) +-- > main = xmonad defaultConfig { layoutHook = myL } +-- + +buttonDeco :: (Eq a, Shrinker s) => s -> Theme + -> l a -> ModifiedLayout (Decoration ButtonDecoration s) l a +buttonDeco s c = decoration s c $ NFD True + +data ButtonDecoration a = NFD Bool deriving (Show, Read) + +instance Eq a => DecorationStyle ButtonDecoration a where + describeDeco _ = "ButtonDeco" + decorationCatchClicksHook _ mainw dFL dFR = titleBarButtonHandler mainw dFL dFR + decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return () addfile ./XMonad/Layout/DecorationAddons.hs hunk ./XMonad/Layout/DecorationAddons.hs 1 +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.DecorationAddons +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- Various stuff that can be added to the decoration. Most of it +-- is intended to be used by other modules. See +-- "XMonad.Layout.ButtonDecoration" for a module that makes use of this. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.DecorationAddons ( + titleBarButtonHandler + ,defaultThemeWithButtons + ,handleScreenCrossing + ) where + +import XMonad +import qualified XMonad.StackSet as W +import XMonad.Layout.Decoration +import XMonad.Actions.WindowMenu +import XMonad.Layout.Minimize +import XMonad.Layout.Maximize +import XMonad.Hooks.ManageDocks +import XMonad.Util.Font +import XMonad.Util.PositionStore +import XMonad.Util.XUtils (fi) + +import Control.Applicative((<$>)) +import Data.Maybe +import qualified Data.Set as S + +minimizeButtonOffset :: Int +minimizeButtonOffset = 48 + +maximizeButtonOffset :: Int +maximizeButtonOffset = 25 + +closeButtonOffset :: Int +closeButtonOffset = 10 + +buttonSize :: Int +buttonSize = 10 + +-- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration. +-- It will intercept clicks on the buttons of the decoration and invoke the associated action. +-- To actually see the buttons, you will need to use a theme that includes them. +-- See 'defaultThemeWithButtons' below. +titleBarButtonHandler :: Window -> Int -> Int -> X Bool +titleBarButtonHandler mainw distFromLeft distFromRight = do + let action = if (fi distFromLeft <= 3 * buttonSize) + then focus mainw >> windowMenu >> return True + else if (fi distFromRight >= closeButtonOffset && + fi distFromRight <= closeButtonOffset + buttonSize) + then focus mainw >> kill >> return True + else if (fi distFromRight >= maximizeButtonOffset && + fi distFromRight <= maximizeButtonOffset + (2 * buttonSize)) + then focus mainw >> sendMessage (maximizeRestore mainw) >> return True + else if (fi distFromRight >= minimizeButtonOffset && + fi distFromRight <= minimizeButtonOffset + buttonSize) + then focus mainw >> sendMessage (MinimizeWin mainw) >> return True + else return False + action + +-- | Intended to be used together with 'titleBarButtonHandler'. See above. +defaultThemeWithButtons :: Theme +defaultThemeWithButtons = defaultTheme { + windowTitleAddons = [ (" (M)", AlignLeft) + , ("_" , AlignRightOffset minimizeButtonOffset) + , ("[]" , AlignRightOffset maximizeButtonOffset) + , ("X" , AlignRightOffset closeButtonOffset) + ] + } + +-- | A function intended to be plugged into the 'decorationAfterDraggingHook' of a decoration. +-- It will check if the window has been dragged onto another screen and shift it there. +-- The PositionStore is also updated accordingly, as this is designed to be used together +-- with "XMonad.Layout.PositionStoreFloat". +handleScreenCrossing :: Window -> Window -> X Bool +handleScreenCrossing w decoWin = withDisplay $ \d -> do + root <- asks theRoot + (_, _, _, px, py, _, _, _) <- io $ queryPointer d root + ws <- gets windowset + sc <- fromMaybe (W.current ws) <$> pointScreen (fi px) (fi py) + maybeWksp <- screenWorkspace $ W.screen sc + let targetWksp = maybeWksp >>= \wksp -> + W.findTag w ws >>= \currentWksp -> + if (currentWksp /= wksp) + then Just wksp + else Nothing + case targetWksp of + Just wksp -> do + -- find out window under cursor on target workspace + -- apparently we have to switch to the workspace first + -- to make this work, which unforunately introduces some flicker + windows $ \ws' -> W.view wksp ws' + (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root + + -- adjust PositionStore + let oldScreenRect = screenRect . W.screenDetail $ W.current ws + newScreenRect = screenRect . W.screenDetail $ sc + {-- somewhat ugly hack to get proper ScreenRect, + creates unwanted inter-dependencies + TODO: get ScreenRects in a proper way --} + oldScreenRect' <- fmap ($ oldScreenRect) (calcGap $ S.fromList [minBound .. maxBound]) + newScreenRect' <- fmap ($ newScreenRect) (calcGap $ S.fromList [minBound .. maxBound]) + wa <- io $ getWindowAttributes d decoWin + modifyPosStore (\ps -> + posStoreMove ps w (fi $ wa_x wa) (fi $ wa_y wa) + oldScreenRect' newScreenRect') + + -- set focus correctly so the window will be inserted + -- at the correct position on the target workspace + -- and then shift the window + windows $ \ws' -> W.shiftWin wksp w . W.focusWindow selWin $ ws' + + -- return True to signal that screen crossing has taken place + return True + Nothing -> return False hunk ./xmonad-contrib.cabal 140 + XMonad.Layout.ButtonDecoration hunk ./xmonad-contrib.cabal 148 + XMonad.Layout.DecorationAddons addfile ./XMonad/Layout/DraggingVisualizer.hs hunk ./XMonad/Layout/DraggingVisualizer.hs 1 +{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-} +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.DraggingVisualizer +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- A helper module to visualize the process of dragging a window by +-- making it follow the mouse cursor. See "XMonad.Layout.WindowSwitcherDecoration" +-- for a module that makes use of this. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.DraggingVisualizer + ( draggingVisualizer, + DraggingVisualizerMsg (..) + ) where + +import XMonad +import XMonad.Layout.LayoutModifier + +data DraggingVisualizer a = DraggingVisualizer (Maybe (Window, Rectangle)) deriving ( Read, Show ) +draggingVisualizer :: LayoutClass l Window => l Window -> ModifiedLayout DraggingVisualizer l Window +draggingVisualizer = ModifiedLayout $ DraggingVisualizer Nothing + +data DraggingVisualizerMsg = DraggingWindow Window Rectangle + | DraggingStopped + deriving ( Typeable, Eq ) +instance Message DraggingVisualizerMsg + +instance LayoutModifier DraggingVisualizer Window where + modifierDescription (DraggingVisualizer _) = "DraggingVisualizer" + pureModifier (DraggingVisualizer (Just dragged@(draggedWin, _))) _ _ wrs = + if draggedWin `elem` (map fst wrs) + then (dragged : rest, Nothing) + else (wrs, Just $ DraggingVisualizer Nothing) + where + rest = filter (\(w, _) -> w /= draggedWin) wrs + pureModifier _ _ _ wrs = (wrs, Nothing) + + pureMess (DraggingVisualizer _) m = case fromMessage m of + Just (DraggingWindow w rect) -> Just $ DraggingVisualizer $ Just (w, rect) + Just (DraggingStopped) -> Just $ DraggingVisualizer Nothing + _ -> Nothing addfile ./XMonad/Layout/WindowSwitcherDecoration.hs hunk ./XMonad/Layout/WindowSwitcherDecoration.hs 1 +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.WindowSwitcherDecoration +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- A decoration that allows to switch the position of windows by dragging +-- them onto each other. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.WindowSwitcherDecoration + ( -- * Usage: + -- $usage + windowSwitcherDecoration, + windowSwitcherDecorationWithButtons + ) where + +import XMonad +import XMonad.Layout.Decoration +import XMonad.Layout.DecorationAddons +import XMonad.Layout.DraggingVisualizer +import qualified XMonad.StackSet as S +import Control.Monad +import Foreign.C.Types(CInt) + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.WindowSwitcherDecoration +-- > import XMonad.Layout.DraggingVisualizer +-- +-- Then edit your @layoutHook@ by adding the WindowSwitcherDecoration to +-- your layout: +-- +-- > myL = windowSwitcherDecoration shrinkText defaultTheme (draggingVisualizer $ layoutHook defaultConfig) +-- > main = xmonad defaultConfig { layoutHook = myL } +-- +-- There is also a version of the decoration that contains buttons like +-- "XMonad.Layout.ButtonDecoration". To use that version, you will need to +-- import "XMonad.Layout.DecorationAddons" as well and modify your @layoutHook@ +-- in the following way: +-- +-- > import XMonad.Layout.DecorationAddons +-- > +-- > myL = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer $ layoutHook defaultConfig) +-- > main = xmonad defaultConfig { layoutHook = myL } +-- + +windowSwitcherDecoration :: (Eq a, Shrinker s) => s -> Theme + -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a +windowSwitcherDecoration s c = decoration s c $ WSD False + +windowSwitcherDecorationWithButtons :: (Eq a, Shrinker s) => s -> Theme + -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a +windowSwitcherDecorationWithButtons s c = decoration s c $ WSD True + +data WindowSwitcherDecoration a = WSD Bool deriving (Show, Read) + +instance Eq a => DecorationStyle WindowSwitcherDecoration a where + describeDeco _ = "WindowSwitcherDeco" + + decorationCatchClicksHook (WSD withButtons) mainw dFL dFR = if withButtons + then titleBarButtonHandler mainw dFL dFR + else return False + decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y + decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw + hasCrossed <- handleScreenCrossing mainw decoWin + unless hasCrossed $ do sendMessage $ DraggingStopped + performWindowSwitching mainw + +handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () +handleTiledDraggingInProgress ex ey (mainw, r) x y = do + let rect = Rectangle (x - (fi ex - rect_x r)) + (y - (fi ey - rect_y r)) + (rect_width r) + (rect_height r) + sendMessage $ DraggingWindow mainw rect + +performWindowSwitching :: Window -> X () +performWindowSwitching win = + withDisplay $ \d -> do + root <- asks theRoot + (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root + ws <- gets windowset + let allWindows = S.index ws + -- do a little double check to be sure + if (win `elem` allWindows) && (selWin `elem` allWindows) + then do + let allWindowsSwitched = map (switchEntries win selWin) allWindows + let (ls, t:rs) = break (win ==) allWindowsSwitched + let newStack = S.Stack t (reverse ls) rs + windows $ S.modify' $ \_ -> newStack + else return () + where + switchEntries a b x + | x == a = b + | x == b = a + | otherwise = x hunk ./xmonad-contrib.cabal 151 + XMonad.Layout.DraggingVisualizer hunk ./xmonad-contrib.cabal 208 + XMonad.Layout.WindowSwitcherDecoration addfile ./XMonad/Hooks/CurrentWorkspaceOnTop.hs hunk ./XMonad/Hooks/CurrentWorkspaceOnTop.hs 1 +{-# LANGUAGE DeriveDataTypeable #-} +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.CurrentWorkspaceOnTop +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- Ensures that the windows of the current workspace are always in front +-- of windows that are located on other visible screens. This becomes important +-- if you use decoration and drag windows from one screen to another. Using this +-- module, the dragged window will always be in front of other windows. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.CurrentWorkspaceOnTop ( + -- * Usage + -- $usage + currentWorkspaceOnTop + ) where + +import XMonad +import qualified XMonad.StackSet as S +import qualified XMonad.Util.ExtensibleState as XS +import Control.Monad(when) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.CurrentWorkspaceOnTop +-- > +-- > main = xmonad $ defaultConfig { +-- > ... +-- > logHook = currentWorkspaceOnTop +-- > ... +-- > } +-- + +data CWOTState = CWOTS String deriving Typeable + +instance ExtensionClass CWOTState where + initialValue = CWOTS "" + +currentWorkspaceOnTop :: X () +currentWorkspaceOnTop = withDisplay $ \d -> do + ws <- gets windowset + (CWOTS lastTag) <- XS.get + let curTag = S.tag . S.workspace . S.current $ ws + when (curTag /= lastTag) $ do + let s = S.current ws + wsp = S.workspace s + viewrect = screenRect $ S.screenDetail s + tmpStack = S.stack . S.workspace $ s + (rs, _) <- runLayout wsp { S.stack = tmpStack } viewrect + let wins = map fst rs + when (not . null $ wins) $ do + io $ raiseWindow d (head wins) -- raise first window of current workspace to the very top, + io $ restackWindows d wins -- then use restackWindows to let all other windows from the workspace follow + XS.put(CWOTS curTag) hunk ./xmonad-contrib.cabal 119 + XMonad.Hooks.CurrentWorkspaceOnTop hunk ./XMonad/Actions/OnScreen.hs 18 - onScreen + onScreen + , Focus(..) hunk ./XMonad/Actions/OnScreen.hs 23 + , toggleOnScreen + , toggleGreedyOnScreen hunk ./XMonad/Actions/OnScreen.hs 27 +import XMonad.Core hunk ./XMonad/Actions/OnScreen.hs 29 -import Control.Monad(guard) -import Data.List + +import Control.Monad (guard) hunk ./XMonad/Actions/OnScreen.hs 32 -import Data.Function(on) + + +-- | Focus data definitions +data Focus = FocusNew -- ^ always focus the new screen + | FocusCurrent -- ^ always keep the focus on the current screen + | FocusTag WorkspaceId -- ^ always focus tag i on the new stack + | FocusTagVisible WorkspaceId -- ^ focus tag i only if workspace with tag i is visible on the old stack + + +-- | Run any function that modifies the stack on a given screen. This function +-- will also need to know which Screen to focus after the function has been +-- run. +onScreen :: (WindowSet -> WindowSet) -- ^ function to run + -> Focus -- ^ what to do with the focus + -> ScreenId -- ^ screen id + -> WindowSet -- ^ current stack + -> WindowSet +onScreen f foc sc st = fromMaybe st $ do + ws <- lookupWorkspace sc st + + let fStack = f $ view ws st + curScreen = screen $ current st + focusCur = lookupWorkspace curScreen fStack >>= return . flip view fStack + isVisible = (`elem` map (tag.workspace) (visible st)) + + -- set focus for new stack + setFocus FocusNew = return $ fStack + setFocus FocusCurrent = focusCur + setFocus (FocusTag i) = return $ view i fStack + setFocus (FocusTagVisible i) = + if isVisible i + then setFocus (FocusTag i) + else setFocus FocusCurrent + + setFocus foc + +-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @view@ to +-- switch focus to the workspace @i@. +viewOnScreen :: ScreenId -- ^ screen id + -> WorkspaceId -- ^ index of the workspace + -> WindowSet -- ^ current stack + -> WindowSet +viewOnScreen sid i = + onScreen (view i) (FocusTag i) sid + +-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @greedyView@ +-- to switch the current workspace with workspace @i@. +greedyViewOnScreen :: ScreenId -- ^ screen id + -> WorkspaceId -- ^ index of the workspace + -> WindowSet -- ^ current stack + -> WindowSet +greedyViewOnScreen sid i = + onScreen (greedyView i) (FocusTagVisible i) sid + +-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible do nothing. +onlyOnScreen :: ScreenId -- ^ screen id + -> WorkspaceId -- ^ index of the workspace + -> WindowSet -- ^ current stack + -> WindowSet +onlyOnScreen sid i = + onScreen (view i) FocusCurrent sid + +-- | @toggleOrView@ as in "XMonad.Actions.CycleWS" for @onScreen@ with view +toggleOnScreen :: ScreenId -- ^ screen id + -> WorkspaceId -- ^ index of the workspace + -> WindowSet -- ^ current stack + -> WindowSet +toggleOnScreen sid i = + onScreen (toggleOrView' view i) FocusCurrent sid + +-- | @toggleOrView@ from "XMonad.Actions.CycleWS" for @onScreen@ with greedyView +toggleGreedyOnScreen :: ScreenId -- ^ screen id + -> WorkspaceId -- ^ index of the workspace + -> WindowSet -- ^ current stack + -> WindowSet +toggleGreedyOnScreen sid i = + onScreen (toggleOrView' greedyView i) FocusCurrent sid + + +-- a \"pure\" version of X.A.CycleWS.toggleOrDoSkip +toggleOrView' :: (WorkspaceId -> WindowSet -> WindowSet) -- ^ function to run + -> WorkspaceId -- ^ tag to look for + -> WindowSet -- ^ current stackset + -> WindowSet +toggleOrView' f i st = fromMaybe (f i st) $ do + let st' = hidden st + -- make sure we actually have to do something + guard $ i == (tag . workspace $ current st) + guard $ not (null st') + -- finally, toggle! + return $ f (tag . head $ st') st + + hunk ./XMonad/Actions/OnScreen.hs 161 --- where 0 is the first screen and "1" the workspace with the tag "1". +-- where 0 is the first screen and \"1\" the workspace with the tag \"1\". hunk ./XMonad/Actions/OnScreen.hs 165 - --- | Switch to the (hidden) workspace with index 'i' on the screen 'sc'. --- A default function (for example 'view' or 'greedyView') will be run if 'sc' is --- the current screen, no valid screen id or workspace 'i' is already visible. -onScreen :: (Eq sid, Eq i) - => (i -> StackSet i l a sid sd -> StackSet i l a sid sd) -- ^ default action - -> sid -- ^ screen id - -> i -- ^ index of the workspace - -> StackSet i l a sid sd -- ^ current stack - -> StackSet i l a sid sd -onScreen defFunc sc i st = fromMaybe (defFunc i st) $ do - -- on unfocused current screen - guard $ screen (current st) /= sc - x <- find ((i==) . tag ) (hidden st) - s <- find ((sc==) . screen) (screens st) - o <- find ((sc==) . screen) (visible st) - let newScreen = s { workspace = x } - return st { visible = newScreen : deleteBy ((==) `on` screen) newScreen (visible st) - , hidden = workspace o : deleteBy ((==) `on` tag) x (hidden st) - } - --- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible use 'greedyView' --- to switch the current workspace with workspace 'i'. -greedyViewOnScreen :: (Eq sid, Eq i) - => sid -- ^ screen id - -> i -- ^ index of the workspace - -> StackSet i l a sid sd -- ^ current stack - -> StackSet i l a sid sd -greedyViewOnScreen = onScreen greedyView - --- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible use 'view' to --- switch focus to the workspace 'i'. -viewOnScreen :: (Eq sid, Eq i) - => sid -- ^ screen id - -> i -- ^ index of the workspace - -> StackSet i l a sid sd -- ^ current stack - -> StackSet i l a sid sd -viewOnScreen = onScreen view - --- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible do nothing. -onlyOnScreen :: (Eq sid, Eq i) - => sid -- ^ screen id - -> i -- ^ index of the workspace - -> StackSet i l a sid sd -- ^ current stack - -> StackSet i l a sid sd -onlyOnScreen = onScreen doNothing - where doNothing _ st = st hunk ./XMonad/Actions/PerWorkspaceKeys.hs 24 -import Data.List (find) hunk ./XMonad/Actions/PerWorkspaceKeys.hs 44 - chooser ws = case find ((ws==).fst) bindings of - Just (_, action) -> action - Nothing -> case find ((""==).fst) bindings of - Just (_, action) -> action + chooser ws = case lookup ws bindings of + Just action -> action + Nothing -> case lookup "" bindings of + Just action -> action addfile ./XMonad/Actions/BluetileCommands.hs hunk ./XMonad/Actions/BluetileCommands.hs 1 +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.BluetileCommands +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- This is a list of selected commands that can be made available using +-- "XMonad.Hooks.ServerMode" to allow external programs to control +-- the window manager. Bluetile () +-- uses this to enable its dock application to do things like changing +-- workspaces and layouts. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.BluetileCommands ( + -- * Usage + -- $usage + bluetileCommands + ) where + +import XMonad +import qualified XMonad.StackSet as W +import XMonad.Layout.LayoutCombinators +import System.Exit + +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.ServerMode +-- > import XMonad.Actions.BluetileCommands +-- +-- Then edit your @handleEventHook@: +-- +-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook' bluetileCommands } +-- +-- See the documentation of "XMonad.Hooks.ServerMode" for details on +-- how to actually invoke the commands from external programs. + +workspaceCommands :: Int -> X [(String, X ())] +workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return + [(("greedyView" ++ show i), + activateScreen sid >> windows (W.greedyView i)) + | i <- spaces ] + +layoutCommands :: Int -> [(String, X ())] +layoutCommands sid = [ ("layout floating" , activateScreen sid >> + sendMessage (JumpToLayout "Floating")) + , ("layout tiled1" , activateScreen sid >> + sendMessage (JumpToLayout "Tiled1")) + , ("layout tiled2" , activateScreen sid >> + sendMessage (JumpToLayout "Tiled2")) + , ("layout fullscreen" , activateScreen sid >> + sendMessage (JumpToLayout "Fullscreen")) + ] + +masterAreaCommands :: Int -> [(String, X ())] +masterAreaCommands sid = [ ("increase master n", activateScreen sid >> + sendMessage (IncMasterN 1)) + , ("decrease master n", activateScreen sid >> + sendMessage (IncMasterN (-1))) + ] + +quitCommands :: [(String, X ())] +quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess)) + , ("quit bluetile and start metacity", restart "metacity" False) + ] + +bluetileCommands :: X [(String, X ())] +bluetileCommands = do + let restartCommand = [ ("restart bluetile", restart "bluetile" True) ] + wscmds0 <- workspaceCommands 0 + wscmds1 <- workspaceCommands 1 + return $ restartCommand + ++ wscmds0 ++ layoutCommands 0 ++ masterAreaCommands 0 ++ quitCommands + ++ wscmds1 ++ layoutCommands 1 ++ masterAreaCommands 1 ++ quitCommands + +activateScreen :: Int -> X () +activateScreen sid = screenWorkspace (S sid) >>= flip whenJust (windows . W.view) hunk ./xmonad-contrib.cabal 66 + XMonad.Actions.BluetileCommands addfile ./XMonad/Config/Bluetile.hs hunk ./XMonad/Config/Bluetile.hs 1 +{-# OPTIONS -fno-warn-missing-signatures #-} +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Config.Bluetile +-- Copyright : (c) Jan Vornberger 2009 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : jan.vornberger@informatik.uni-oldenburg.de +-- Stability : unstable +-- Portability : not portable +-- +-- This is the default configuration of Bluetile +-- (). If you +-- are migrating from Bluetile to xmonad or want to create +-- a similar setup, then this will give you pretty much +-- the same thing, except for Bluetile's helper applications +-- such as the dock. +-- +----------------------------------------------------------------------------- + +module XMonad.Config.Bluetile ( + -- * Usage + -- $usage + bluetileConfig + ) where + +import XMonad hiding ( (|||) ) + +import XMonad.Layout hiding ( (|||) ) +import XMonad.Layout.BorderResize +import XMonad.Layout.BoringWindows +import XMonad.Layout.ButtonDecoration +import XMonad.Layout.Decoration +import XMonad.Layout.DecorationAddons +import XMonad.Layout.DraggingVisualizer +import XMonad.Layout.LayoutCombinators +import XMonad.Layout.Maximize +import XMonad.Layout.Minimize +import XMonad.Layout.MouseResizableTile +import XMonad.Layout.Named +import XMonad.Layout.NoBorders +import XMonad.Layout.PositionStoreFloat +import XMonad.Layout.WindowSwitcherDecoration + +import XMonad.Actions.BluetileCommands +import XMonad.Actions.CycleWS +import XMonad.Actions.WindowMenu + +import XMonad.Hooks.CurrentWorkspaceOnTop +import XMonad.Hooks.EwmhDesktops +import XMonad.Hooks.ManageDocks +import XMonad.Hooks.PositionStoreHooks +import XMonad.Hooks.RestoreMinimized +import XMonad.Hooks.ServerMode +import XMonad.Hooks.WorkspaceByPos + +import XMonad.Config.Gnome + +import qualified XMonad.StackSet as W +import qualified Data.Map as M + +import System.Exit +import Data.Monoid +import Control.Monad(when) + +-- $usage +-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad +-- > import XMonad.Config.Bluetile +-- > import XMonad.Util.Replace +-- > +-- > main = replace >> xmonad bluetileConfig +-- +-- The invocation of 'replace' will replace a currently running +-- window manager. This is the default behaviour of Bluetile as well. +-- See "XMonad.Util.Replace" for more information. + +bluetileWorkspaces :: [String] +bluetileWorkspaces = ["1","2","3","4","5","6","7","8","9","0"] + +bluetileKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) +bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $ + -- launching and killing programs + [ ((modMask' , xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal + , ((modMask', xK_p ), gnomeRun) -- %! Launch Gnome "Run application" dialog + , ((modMask' .|. shiftMask, xK_c ), kill) -- %! Close the focused window + + , ((modMask', xK_F5 ), refresh) -- %! Resize viewed windows to the correct size + , ((modMask' .|. shiftMask, xK_F5 ), setLayout $ XMonad.layoutHook conf) -- %! Reset the layouts on the current workspace to default + + , ((modMask', xK_o ), windowMenu) + + -- move focus up or down the window stack + , ((modMask', xK_Tab ), focusDown) -- %! Move focus to the next window + , ((modMask' .|. shiftMask, xK_Tab ), focusUp) -- %! Move focus to the previous window + , ((modMask', xK_j ), focusDown) -- %! Move focus to the next window + , ((modMask', xK_k ), focusUp) -- %! Move focus to the previous window + , ((modMask', xK_space ), focusMaster) -- %! Move focus to the master window + + -- modifying the window order + , ((modMask' .|. shiftMask, xK_space ), windows W.swapMaster) -- %! Swap the focused window and the master window + , ((modMask' .|. shiftMask, xK_j ), windows W.swapDown ) -- %! Swap the focused window with the next window + , ((modMask' .|. shiftMask, xK_k ), windows W.swapUp ) -- %! Swap the focused window with the previous window + + -- resizing the master/slave ratio + , ((modMask', xK_h ), sendMessage Shrink) -- %! Shrink the master area + , ((modMask', xK_l ), sendMessage Expand) -- %! Expand the master area + , ((modMask', xK_u ), sendMessage ShrinkSlave) -- %! Shrink a slave area + , ((modMask', xK_i ), sendMessage ExpandSlave) -- %! Expand a slave area + + -- floating layer support + , ((modMask', xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling + , ((modMask' .|. shiftMask, xK_t ), withFocused $ float ) -- %! Float window + + -- increase or decrease number of windows in the master area + , ((modMask' , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area + , ((modMask' , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area + + -- quit, or restart + , ((modMask' .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit bluetile + , ((modMask' , xK_q ), spawn "bluetile --restart") -- %! Restart bluetile + + -- Metacity-like workspace switching + , ((mod1Mask .|. controlMask, xK_Left), prevWS) + , ((mod1Mask .|. controlMask, xK_Right), nextWS) + , ((mod1Mask .|. controlMask .|. shiftMask, xK_Left), shiftToPrev >> prevWS) + , ((mod1Mask .|. controlMask .|. shiftMask, xK_Right), shiftToNext >> nextWS) + + -- more Metacity keys + , ((mod1Mask , xK_F2), gnomeRun) + , ((mod1Mask , xK_F4), kill) + + -- Switching to layouts + , ((modMask' , xK_a), sendMessage $ JumpToLayout "Floating") + , ((modMask' , xK_s), sendMessage $ JumpToLayout "Tiled1") + , ((modMask' , xK_d), sendMessage $ JumpToLayout "Tiled2") + , ((modMask' , xK_f), sendMessage $ JumpToLayout "Fullscreen") + + -- Maximizing + , ((modMask' , xK_z), withFocused (sendMessage . maximizeRestore)) + + -- Minimizing + , ((modMask', xK_m ), withFocused (\f -> sendMessage (MinimizeWin f))) + , ((modMask' .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin) + ] + ++ + -- mod-[1..9] ++ [0] %! Switch to workspace N + -- mod-shift-[1..9] ++ [0] %! Move client to workspace N + [((m .|. modMask', k), windows $ f i) + | (i, k) <- zip (XMonad.workspaces conf) ([xK_1 .. xK_9] ++ [xK_0]) + , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] + ++ + -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 + -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3 + [((m .|. modMask', key), screenWorkspace sc >>= flip whenJust (windows . f)) + | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..] + , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] + +bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) +bluetileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $ + -- mod-button1 %! Move a floated window by dragging + [ ((modMask', button1), (\w -> isFloating w >>= \isF -> when (isF) $ + focus w >> mouseMoveWindow w >> windows W.shiftMaster)) + -- mod-button2 %! Switch to next and first layout + , ((modMask', button2), (\_ -> sendMessage NextLayout)) + , ((modMask' .|. shiftMask, button2), (\_ -> sendMessage $ JumpToLayout "Floating")) + -- mod-button3 %! Resize a floated window by dragging + , ((modMask', button3), (\w -> isFloating w >>= \isF -> when (isF) $ + focus w >> mouseResizeWindow w >> windows W.shiftMaster)) + ] + +isFloating :: Window -> X (Bool) +isFloating w = do + ws <- gets windowset + return $ M.member w (W.floating ws) + +bluetileManageHook :: ManageHook +bluetileManageHook = composeAll + [ workspaceByPos, positionStoreManageHook + , className =? "MPlayer" --> doFloat + , manageDocks] + +bluetileLayoutHook = avoidStruts $ boringAuto $ minimize $ ( + named "Floating" floating ||| + named "Tiled1" tiled1 ||| + named "Tiled2" tiled2 ||| + named "Fullscreen" fullscreen + ) + where + floating = floatingDeco $ maximize $ borderResize $ positionStoreFloat + tiled1 = tilingDeco $ maximize $ mouseResizableTileMirrored + tiled2 = tilingDeco $ maximize $ mouseResizableTile + fullscreen = tilingDeco $ maximize $ smartBorders Full + + tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l) + floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l + +bluetileConfig = + defaultConfig + { modMask = mod4Mask, -- logo key + manageHook = bluetileManageHook, + layoutHook = bluetileLayoutHook, + logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook, + handleEventHook = ewmhDesktopsEventHook + `mappend` restoreMinimizedEventHook + `mappend` serverModeEventHook' bluetileCommands + `mappend` positionStoreEventHook, + workspaces = bluetileWorkspaces, + keys = bluetileKeys, + mouseBindings = bluetileMouseBindings, + focusFollowsMouse = False, + focusedBorderColor = "#ff5500", + terminal = "gnome-terminal" + } hunk ./xmonad-contrib.cabal 114 + XMonad.Config.Bluetile hunk ./XMonad/Config/Bluetile.hs 184 -bluetileLayoutHook = avoidStruts $ boringAuto $ minimize $ ( +bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ ( hunk ./XMonad/Layout/Minimize.hs 1 -{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleContexts, PatternGuards #-} hunk ./XMonad/Layout/Minimize.hs 57 --- that minimized windows will be skipped when switching the focus window with --- the keyboard. Use the 'BW.boringAuto' function. +-- that minimized windows will be skipped over when switching the focused window with +-- the keyboard. Include 'BW.boringWindows' in your layout hook and see the +-- documentation of "XMonad.Layout.BoringWindows" on how to modify your keybindings. hunk ./XMonad/Layout/Minimize.hs 82 - handleMess (Minimize minimized) m = case fromMessage m of - Just (MinimizeWin w) - | not (w `elem` minimized) -> do + handleMess (Minimize minimized) m + | Just (MinimizeWin w) <- fromMessage m = + if not (w `elem` minimized) + then do hunk ./XMonad/Layout/Minimize.hs 88 - | otherwise -> return Nothing - Just (RestoreMinimizedWin w) -> + else return Nothing + | Just (RestoreMinimizedWin w) <- fromMessage m = hunk ./XMonad/Layout/Minimize.hs 91 - Just (RestoreNextMinimizedWin) - | not (null minimized) -> do + | Just RestoreNextMinimizedWin <- fromMessage m = + if not (null minimized) + then do hunk ./XMonad/Layout/Minimize.hs 96 - | otherwise -> return Nothing - _ -> return Nothing + else return Nothing + | Just BW.UpdateBoring <- fromMessage m = do + ws <- gets (W.workspace . W.current . windowset) + flip sendMessageWithNoRefresh ws $ BW.Replace "Minimize" minimized + return Nothing + | otherwise = return Nothing hunk ./XMonad/Actions/OnScreen.hs 19 + , onScreen' hunk ./XMonad/Actions/OnScreen.hs 28 +import XMonad hunk ./XMonad/Actions/OnScreen.hs 30 -import XMonad.StackSet +import XMonad.StackSet hiding (new) hunk ./XMonad/Actions/OnScreen.hs 33 -import Data.Maybe(fromMaybe) +-- import Control.Monad.State.Class (gets) +import Data.Maybe (fromMaybe) hunk ./XMonad/Actions/OnScreen.hs 56 - curScreen = screen $ current st - focusCur = lookupWorkspace curScreen fStack >>= return . flip view fStack - isVisible = (`elem` map (tag.workspace) (visible st)) hunk ./XMonad/Actions/OnScreen.hs 57 - -- set focus for new stack - setFocus FocusNew = return $ fStack - setFocus FocusCurrent = focusCur - setFocus (FocusTag i) = return $ view i fStack - setFocus (FocusTagVisible i) = - if isVisible i - then setFocus (FocusTag i) - else setFocus FocusCurrent + return $ setFocus foc st fStack + + +-- set focus for new stack +setFocus :: Focus + -> WindowSet -- ^ old stack + -> WindowSet -- ^ new stack + -> WindowSet +setFocus FocusNew _ new = new +setFocus FocusCurrent old new = + case lookupWorkspace (screen $ current old) new of + Nothing -> new + Just i -> view i new +setFocus (FocusTag i) _ new = view i new +setFocus (FocusTagVisible i) old new = + if i `elem` map (tag . workspace) (visible old) + then setFocus (FocusTag i) old new + else setFocus FocusCurrent old new + +-- | A variation of @onScreen@ which will take any @X ()@ function and run it +-- on the given screen. +-- Warning: This function will change focus even if the function it's supposed +-- to run doesn't succeed. +onScreen' :: X () -- ^ X function to run + -> Focus -- ^ focus + -> ScreenId -- ^ screen id + -> X () +onScreen' x foc sc = do + st <- gets windowset + case lookupWorkspace sc st of + Nothing -> return () + Just ws -> do + windows $ view ws + x + windows $ setFocus foc st hunk ./XMonad/Actions/OnScreen.hs 93 - setFocus foc hunk ./XMonad/Actions/OnScreen.hs 151 - hunk ./XMonad/Actions/GridSelect.hs 419 +gridselect _ [] = return Nothing hunk ./XMonad/Actions/GridSelect.hs 96 --- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellWidth = 100 } +-- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellwidth = 100 } hunk ./XMonad/Actions/GridSelect.hs 102 --- > gsconfig2 colorizer = (buildDefaultGSConfig colorizer) { gs_cellheight = 30, gs_cellWidth = 100 } +-- > gsconfig2 colorizer = (buildDefaultGSConfig colorizer) { gs_cellheight = 30, gs_cellwidth = 100 } hunk ./XMonad/Layout/MouseResizableTile.hs 147 - description _ = "MouseResizableTile" + description state = mirror "MouseResizableTile" + where mirror = if isMirrored state then ("Mirror " ++) else id hunk ./XMonad/Prompt.hs 67 -import qualified XMonad as X (numlockMask,config) +import qualified XMonad as X (numlockMask) hunk ./XMonad/Prompt.hs 222 - -> GC -> XMonadFont -> p -> [String] -> XPConfig -> XPState -initState d rw w s compl gc fonts pt h c = + -> GC -> XMonadFont -> p -> [String] -> XPConfig -> KeyMask -> XPState +initState d rw w s compl gc fonts pt h c nm = hunk ./XMonad/Prompt.hs 242 - , numlockMask = X.numlockMask defaultConfig + , numlockMask = nm hunk ./XMonad/Prompt.hs 277 - numlock <- asks $ X.numlockMask . X.config + numlock <- gets $ X.numlockMask hunk ./XMonad/Prompt.hs 279 - st = (initState d rw w s compl gc fs (XPT t) hs conf) - { numlockMask = numlock } + st = initState d rw w s compl gc fs (XPT t) hs conf numlock hunk ./xmonad-contrib.cabal 52 - build-depends: mtl, unix, X11>=1.4.6.1, xmonad>=0.9, xmonad<1, utf8-string + build-depends: mtl, unix, X11>=1.4.6.1 && < 1.5, xmonad>=0.9, xmonad<1, utf8-string hunk ./xmonad-contrib.cabal 52 - build-depends: mtl, unix, X11>=1.4.6.1 && < 1.5, xmonad>=0.9, xmonad<1, utf8-string + build-depends: mtl, unix, X11>=1.5.0.0 && < 1.6, xmonad>=0.9, xmonad<1, utf8-string hunk ./xmonad-contrib.cabal 2 -version: 0.9 +version: 0.9.1 hunk ./xmonad-contrib.cabal 52 - build-depends: mtl, unix, X11>=1.5.0.0 && < 1.6, xmonad>=0.9, xmonad<1, utf8-string + build-depends: mtl, unix, X11>=1.5.0.0 && < 1.6, xmonad>=0.9.1, xmonad<0.10, utf8-string hunk ./XMonad/Hooks/EwmhDesktops.hs 22 - ewmhDesktopsEventHook + ewmhDesktopsEventHook, + fullscreenEventHook hunk ./XMonad/Hooks/EwmhDesktops.hs 38 +import XMonad.Util.WindowProperties (getProp32) hunk ./XMonad/Hooks/EwmhDesktops.hs 159 +-- | +-- An event hook to handle applications that wish to fullscreen using the +-- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen() +-- function, such as Totem, Evince and OpenOffice.org. +fullscreenEventHook :: Event -> X All +fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ dat) = do + state <- getAtom "_NET_WM_STATE" + fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN" + wstate' <- getProp32 state win + let wstate = case wstate' of + Just ps -> ps + Nothing -> [] + isFull = fromIntegral fullsc `elem` wstate + + -- Constants for the _NET_WM_STATE protocol: + remove = 0 + add = 1 + toggle = 2 + + action = head dat + ptype = 4 -- The atom property type for changeProperty + + when (typ == state && fromIntegral fullsc `elem` tail dat) $ do + when (action == add || (action == toggle && not isFull)) $ do + io $ changeProperty32 dpy win state ptype propModeReplace (fromIntegral fullsc:wstate) + windows $ W.float win $ W.RationalRect 0 0 1 1 + when (action == remove || (action == toggle && isFull)) $ do + io $ changeProperty32 dpy win state ptype propModeReplace (delete (fromIntegral fullsc) wstate) + windows $ W.sink win + + return $ All True + +fullscreenEventHook _ = return $ All True hunk ./XMonad/Hooks/EwmhDesktops.hs 164 -fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ dat) = do +fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do hunk ./XMonad/Hooks/EwmhDesktops.hs 167 - wstate' <- getProp32 state win - let wstate = case wstate' of - Just ps -> ps - Nothing -> [] - isFull = fromIntegral fullsc `elem` wstate + wstate <- fromMaybe [] `fmap` getProp32 state win + + let isFull = fromIntegral fullsc `elem` wstate hunk ./XMonad/Hooks/EwmhDesktops.hs 175 - - action = head dat hunk ./XMonad/Hooks/EwmhDesktops.hs 176 + chWstate f = io $ changeProperty32 dpy win state ptype propModeReplace (f wstate) hunk ./XMonad/Hooks/EwmhDesktops.hs 178 - when (typ == state && fromIntegral fullsc `elem` tail dat) $ do + when (typ == state && fi fullsc `elem` dats) $ do hunk ./XMonad/Hooks/EwmhDesktops.hs 180 - io $ changeProperty32 dpy win state ptype propModeReplace (fromIntegral fullsc:wstate) + chWstate (fi fullsc:) hunk ./XMonad/Hooks/EwmhDesktops.hs 183 - io $ changeProperty32 dpy win state ptype propModeReplace (delete (fromIntegral fullsc) wstate) + chWstate $ delete (fi fullsc) hunk ./XMonad/Util/ExtensibleState.hs 1 +{-# LANGUAGE PatternGuards #-} hunk ./XMonad/Util/ExtensibleState.hs 30 +import Data.Maybe (fromMaybe) hunk ./XMonad/Util/ExtensibleState.hs 101 - Just (Left str) -> case extensionType (undefined `asTypeOf` k) of - PersistentExtension x -> do - let val = maybe initialValue id $ - cast =<< safeRead str `asTypeOf` (Just x) - put (val `asTypeOf` k) - return val - _ -> return $ initialValue + Just (Left str) | PersistentExtension x <- extensionType k -> do + let val = fromMaybe initialValue $ cast =<< safeRead str `asTypeOf` Just x + put (val `asTypeOf` k) + return val hunk ./XMonad/Layout/MultiToggle.hs 44 --- A side effect of this meta-layout is that layout transformers no longer --- 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. --- hunk ./XMonad/Layout/MultiToggle.hs 87 --- > transform _ x k = k (Mirror x) +-- > transform _ x k = k (Mirror x) (\(Mirror x') -> x') hunk ./XMonad/Layout/MultiToggle.hs 95 - transform :: (LayoutClass l a) => t -> l a -> (forall l'. (LayoutClass l' a) => l' a -> b) -> b + transform :: (LayoutClass l a) => t -> l a -> + (forall l'. (LayoutClass l' a) => l' a -> (l' a -> l a) -> b) -> b + +data (LayoutClass l a) => EL l a = forall l'. (LayoutClass l' a) => EL (l' a) (l' a -> l a) hunk ./XMonad/Layout/MultiToggle.hs 100 -data EL a = forall l. (LayoutClass l a) => EL (l a) +unEL :: (LayoutClass l a) => EL l a -> (forall l'. (LayoutClass l' a) => l' a -> b) -> b +unEL (EL x _) k = k x hunk ./XMonad/Layout/MultiToggle.hs 103 -unEL :: EL a -> (forall l. (LayoutClass l a) => l a -> b) -> b -unEL (EL x) k = k x +deEL :: (LayoutClass l a) => EL l a -> l a +deEL (EL x det) = det x hunk ./XMonad/Layout/MultiToggle.hs 106 -transform' :: (Transformer t a) => t -> EL a -> EL a -transform' t el = el `unEL` \l -> transform t l EL +transform' :: (Transformer t a, LayoutClass l a) => t -> EL l a -> EL l a +transform' t (EL l det) = transform t l (\l' det' -> EL l' (det . det')) hunk ./XMonad/Layout/MultiToggle.hs 119 - baseLayout :: l a, - currLayout :: EL a, + currLayout :: EL l a, hunk ./XMonad/Layout/MultiToggle.hs 121 - currTrans :: EL a -> EL a, hunk ./XMonad/Layout/MultiToggle.hs 128 - let g = transform' x in - mt{ - currLayout = g . EL $ baseLayout mt, - currTrans = g - } + let g = transform' x in mt{ currLayout = g $ currLayout mt } hunk ./XMonad/Layout/MultiToggle.hs 130 - (MultiToggle b (EL b) i id ts) + (MultiToggle (EL b id) i ts) hunk ./XMonad/Layout/MultiToggle.hs 132 -collapse :: MultiToggle ts l a -> MultiToggleS ts l a -collapse mt = MultiToggleS (baseLayout mt) (currIndex mt) (transformers mt) +collapse :: (LayoutClass l a) => MultiToggle ts l a -> MultiToggleS ts l a +collapse mt = MultiToggleS (deEL (currLayout mt)) (currIndex mt) (transformers mt) hunk ./XMonad/Layout/MultiToggle.hs 138 -instance (Show ts, Show (l a)) => Show (MultiToggle ts l a) where +instance (Show ts, Show (l a), LayoutClass l a) => Show (MultiToggle ts l a) where hunk ./XMonad/Layout/MultiToggle.hs 144 -mkToggle ts l = MultiToggle l (EL l) Nothing id ts +mkToggle ts l = MultiToggle (EL l id) Nothing ts hunk ./XMonad/Layout/MultiToggle.hs 186 -acceptChange :: (LayoutClass l' a) => MultiToggle ts l a -> ((l' a -> MultiToggle ts l a) -> b -> c) -> X b -> X c -acceptChange mt f = fmap (f (\x -> mt{ currLayout = EL x })) - hunk ./XMonad/Layout/MultiToggle.hs 189 - runLayout (Workspace i mt s) r - | isNothing (currIndex mt) = - acceptChange mt (fmap . fmap . \f x -> (f x){ baseLayout = x }) $ runLayout (Workspace i (baseLayout mt) s) r - | otherwise = currLayout mt `unEL` \l -> - acceptChange mt (fmap . fmap) $ runLayout (Workspace i l s) r + runLayout (Workspace i mt s) r = case currLayout mt of + EL l det -> fmap (fmap . fmap $ (\x -> mt { currLayout = EL x det })) $ + runLayout (Workspace i l s) r hunk ./XMonad/Layout/MultiToggle.hs 196 - = currLayout mt `unEL` \l -> - if i == currIndex mt - then do - handleMessage l (SomeMessage ReleaseResources) + = case currLayout mt of + EL l det -> do + l' <- fromMaybe l `fmap` handleMessage l (SomeMessage ReleaseResources) hunk ./XMonad/Layout/MultiToggle.hs 200 - mt{ - currLayout = EL $ baseLayout mt, - currIndex = Nothing, - currTrans = id + mt { + currLayout = (if cur then id else transform' t) (EL (det l') id), + currIndex = if cur then Nothing else i hunk ./XMonad/Layout/MultiToggle.hs 204 - else do - handleMessage l (SomeMessage ReleaseResources) - let f = transform' t - return . Just $ - mt{ - currLayout = f . EL $ baseLayout mt, - currIndex = i, - currTrans = f - } - | fromMessage m == Just ReleaseResources || - fromMessage m == Just Hide - = currLayout mt `unEL` \l -> acceptChange mt fmap (handleMessage l m) - | otherwise = do - ml <- handleMessage (baseLayout mt) m - case ml of - Nothing -> return Nothing - Just b' -> currLayout mt `unEL` \l -> do - handleMessage l (SomeMessage ReleaseResources) - return . Just $ - mt{ baseLayout = b', currLayout = currTrans mt . EL $ b' } + where cur = (i == currIndex mt) + | otherwise + = case currLayout mt of + EL l det -> fmap (fmap (\x -> mt { currLayout = EL x det })) $ + handleMessage l m hunk ./XMonad/Layout/MultiToggle/Instances.hs 25 +import XMonad.Layout.LayoutModifier hunk ./XMonad/Layout/MultiToggle/Instances.hs 35 - transform FULL _ k = k Full - transform NBFULL _ k = k (noBorders Full) - transform MIRROR x k = k (Mirror x) - transform NOBORDERS x k = k (noBorders x) - transform SMARTBORDERS x k = k (smartBorders x) + transform FULL x k = k Full (const x) + transform NBFULL x k = k (noBorders Full) (const x) + transform MIRROR x k = k (Mirror x) (\(Mirror x') -> x') + transform NOBORDERS x k = k (noBorders x) (\(ModifiedLayout _ x') -> x') + transform SMARTBORDERS x k = k (smartBorders x) (\(ModifiedLayout _ x') -> x') hunk ./XMonad/Layout/Reflect.hs 108 - transform REFLECTX x k = k (reflectHoriz x) + transform REFLECTX x k = k (reflectHoriz x) (\(ModifiedLayout _ x') -> x') hunk ./XMonad/Layout/Reflect.hs 111 - transform REFLECTY x k = k (reflectVert x) + transform REFLECTY x k = k (reflectVert x) (\(ModifiedLayout _ x') -> x') + hunk ./XMonad/Doc/Extending.hs 980 -> myKeys conf@(XConfig {XMonad.modMask = modm}) = +> myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList hunk ./XMonad/Doc/Extending.hs 988 -> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) +> newKeys x = myKeys x `M.union` keys defaultConfig x hunk ./XMonad/Doc/Extending.hs 995 +Alternatively, the '<+>' operator can be used which in this usage does exactly +the same as the explicit usage of 'M.union' and propagation of the config +argument, thanks to appropriate instances in "Data.Monoid". + +> main = xmonad $ defaultConfig { keys = myKeys <+> keys defaultConfig } + hunk ./XMonad/Doc/Extending.hs 1015 -> main = xmonad $ defaultConfig { keys = newKeys } -> -> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) +> main = xmonad $ defaultConfig { keys = myKeys <+> keys defaultConfig } hunk ./XMonad/Doc/Extending.hs 1017 -> myKeys conf@(XConfig {XMonad.modMask = modm}) = +> myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList hunk ./XMonad/Doc/Extending.hs 1041 -> newKeys x = M.difference (keys defaultConfig x) (M.fromList $ keysToRemove x) +> newKeys x = keys defaultConfig x `M.difference` keysToRemove x hunk ./XMonad/Doc/Extending.hs 1043 -> keysToRemove :: XConfig Layout -> [((KeyMask, KeySym),X ())] -> keysToRemove x = +> keysToRemove :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) +> keysToRemove x = M.fromList hunk ./XMonad/Prompt.hs 141 - -- and delay by x microseconds + -- and delay by x microseconds + , searchPredicate :: String -> String -> Bool + -- ^ Given the typed string and a possible + -- completion, is the completion valid? hunk ./XMonad/Prompt.hs 218 - , showCompletionOnTab = False } + , showCompletionOnTab = False + , searchPredicate = isPrefixOf + } hunk ./XMonad/Prompt/Window.hs 27 -import Data.List hunk ./XMonad/Prompt/Window.hs 91 - compList m s = return . filter (isPrefixOf s) . map fst . M.toList $ m + compList m s = return . filter (searchPredicate c s) . map fst . M.toList $ m hunk ./XMonad/Actions/Search.hs 47 + openstreetmap, hunk ./XMonad/Actions/Search.hs 124 +* 'openstreetmap' -- OpenStreetMap free wiki world map. + hunk ./XMonad/Actions/Search.hs 282 - images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, wiktionary, + images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, hunk ./XMonad/Actions/Search.hs 284 -amazon = searchEngine "amazon" "http://www.amazon.com/exec/obidos/external-search?index=all&keyword=" -alpha = searchEngine "alpha" "http://www.wolframalpha.com/input/?i=" -codesearch = searchEngine "codesearch" "http://www.google.com/codesearch?q=" -deb = searchEngine "deb" "http://packages.debian.org/" -debbts = searchEngine "debbts" "http://bugs.debian.org/" -debpts = searchEngine "debpts" "http://packages.qa.debian.org/" -dictionary = searchEngine "dict" "http://dictionary.reference.com/browse/" -google = searchEngine "google" "http://www.google.com/search?num=100&q=" -hackage = searchEngine "hackage" "http://hackage.haskell.org/package/" -hoogle = searchEngine "hoogle" "http://www.haskell.org/hoogle/?q=" -images = searchEngine "images" "http://images.google.fr/images?q=" -imdb = searchEngine "imdb" "http://www.imdb.com/find?s=all&q=" -isohunt = searchEngine "isohunt" "http://isohunt.com/torrents/?ihq=" -lucky = searchEngine "lucky" "http://www.google.com/search?btnI&q=" -maps = searchEngine "maps" "http://maps.google.com/maps?q=" -mathworld = searchEngine "mathworld" "http://mathworld.wolfram.com/search/?query=" -scholar = searchEngine "scholar" "http://scholar.google.com/scholar?q=" -thesaurus = searchEngine "thesaurus" "http://thesaurus.reference.com/search?q=" -wikipedia = searchEngine "wiki" "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=" -wiktionary = searchEngine "wikt" "http://en.wiktionary.org/wiki/Special:Search?go=Go&search=" -youtube = searchEngine "youtube" "http://www.youtube.com/results?search_type=search_videos&search_query=" -wayback = searchEngineF "wayback" ("http://web.archive.org/web/*/"++) +amazon = searchEngine "amazon" "http://www.amazon.com/exec/obidos/external-search?index=all&keyword=" +alpha = searchEngine "alpha" "http://www.wolframalpha.com/input/?i=" +codesearch = searchEngine "codesearch" "http://www.google.com/codesearch?q=" +deb = searchEngine "deb" "http://packages.debian.org/" +debbts = searchEngine "debbts" "http://bugs.debian.org/" +debpts = searchEngine "debpts" "http://packages.qa.debian.org/" +dictionary = searchEngine "dict" "http://dictionary.reference.com/browse/" +google = searchEngine "google" "http://www.google.com/search?num=100&q=" +hackage = searchEngine "hackage" "http://hackage.haskell.org/package/" +hoogle = searchEngine "hoogle" "http://www.haskell.org/hoogle/?q=" +images = searchEngine "images" "http://images.google.fr/images?q=" +imdb = searchEngine "imdb" "http://www.imdb.com/find?s=all&q=" +isohunt = searchEngine "isohunt" "http://isohunt.com/torrents/?ihq=" +lucky = searchEngine "lucky" "http://www.google.com/search?btnI&q=" +maps = searchEngine "maps" "http://maps.google.com/maps?q=" +mathworld = searchEngine "mathworld" "http://mathworld.wolfram.com/search/?query=" +openstreetmap = searchEngine "openstreetmap" "http://gazetteer.openstreetmap.org/namefinder/?find=" +scholar = searchEngine "scholar" "http://scholar.google.com/scholar?q=" +thesaurus = searchEngine "thesaurus" "http://thesaurus.reference.com/search?q=" +wikipedia = searchEngine "wiki" "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=" +wiktionary = searchEngine "wikt" "http://en.wiktionary.org/wiki/Special:Search?go=Go&search=" +youtube = searchEngine "youtube" "http://www.youtube.com/results?search_type=search_videos&search_query=" +wayback = searchEngineF "wayback" ("http://web.archive.org/web/*/"++) hunk ./XMonad/Actions/Search.hs 309 -multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, wiktionary, (prefixAware google)] +multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, (prefixAware google)] hunk ./XMonad/Layout/MouseResizableTile.hs 1 -{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} hunk ./XMonad/Layout/MouseResizableTile.hs 28 +import Control.Applicative((<$>)) hunk ./XMonad/Layout/MouseResizableTile.hs 104 -instance LayoutClass MouseResizableTile a where +instance LayoutClass MouseResizableTile Window where hunk ./XMonad/Layout/MouseResizableTile.hs 115 - newDraggers <- mapM (createDragger sr . adjustForMirror (isMirrored state)) preparedDraggers - return (zip wins rects', Just $ state { draggers = newDraggers, - focusPos = length l, - numWindows = length wins }) + (draggerWrs, newDraggers) <- unzip <$> mapM + (createDragger sr . adjustForMirror (isMirrored state)) + preparedDraggers + return (zip wins rects' ++ draggerWrs, Just $ state { draggers = newDraggers, + focusPos = length l, + numWindows = length wins }) hunk ./XMonad/Layout/MouseResizableTile.hs 233 -createDragger :: Rectangle -> DraggerWithRect -> X DraggerWithWin +createDragger :: Rectangle -> DraggerWithRect -> X ((Window, Rectangle), DraggerWithWin) hunk ./XMonad/Layout/MouseResizableTile.hs 235 - draggerWin <- createInputWindow draggerCursor $ sanitizeRectangle sr draggerRect - io . flip lowerWindow draggerWin =<< asks display - return (draggerWin, draggerInfo) + let draggerRect' = sanitizeRectangle sr draggerRect + draggerWin <- createInputWindow draggerCursor draggerRect' + return ((draggerWin, draggerRect'), (draggerWin, draggerInfo)) hunk ./XMonad/Util/NamedActions.hs 45 -import XMonad(KeySym, KeyMask, X, Layout, Message, - XConfig(keys, layoutHook, modMask, terminal, workspaces, XConfig), - io, spawn, whenJust, ChangeLayout(NextLayout), IncMasterN(..), - Resize(..), kill, refresh, screenWorkspace, sendMessage, setLayout, - windows, withFocused, controlMask, mod1Mask, mod2Mask, mod3Mask, - mod4Mask, mod5Mask, shiftMask, xK_1, xK_9, xK_Return, xK_Tab, xK_c, - xK_comma, xK_e, xK_h, xK_j, xK_k, xK_l, xK_m, xK_n, xK_p, - xK_period, xK_q, xK_r, xK_space, xK_t, xK_w, keysymToString) -import System.Posix.Process(executeFile, forkProcess) +import XMonad +import System.Posix.Process(executeFile) hunk ./XMonad/Util/NamedActions.hs 208 - forkProcess $ executeFile "xmessage" True ["-default", "okay", unlines $ showKm x] Nothing + xfork $ executeFile "xmessage" True ["-default", "okay", unlines $ showKm x] Nothing hunk ./XMonad/Util/Run.hs 35 -import System.Posix.Process (executeFile, forkProcess, createSession) +import System.Posix.Process (executeFile, createSession) hunk ./XMonad/Util/Run.hs 70 - forkProcess $ do + xfork $ do hunk ./XMonad/Util/Run.hs 110 -safeSpawn prog args = liftIO (try (forkProcess $ executeFile prog True args Nothing) >> return ()) +safeSpawn prog args = liftIO (try (xfork $ executeFile prog True args Nothing) >> return ()) hunk ./XMonad/Util/Run.hs 138 - forkProcess $ do + xfork $ do hunk ./XMonad/Util/Timer.hs 26 -import System.Posix.Process (forkProcess) hunk ./XMonad/Util/Timer.hs 38 - forkProcess $ do + xfork $ do hunk ./XMonad/Util/Run.hs 35 -import System.Posix.Process (executeFile, createSession) +import System.Posix.Process (executeFile) hunk ./XMonad/Util/Run.hs 139 - createSession - uninstallSignalHandlers hunk ./XMonad/Actions/MouseResize.hs 111 +brCursorBottomRightCorner :: Glyph +brCursorBottomRightCorner = 14 + hunk ./XMonad/Actions/MouseResize.hs 120 + + cursor <- io $ createFontCursor d brCursorBottomRightCorner + io $ defineCursor d tw cursor + io $ freeCursor d cursor + hunk ./XMonad/Actions/MouseResize.hs 111 -brCursorBottomRightCorner :: Glyph -brCursorBottomRightCorner = 14 - hunk ./XMonad/Actions/MouseResize.hs 118 - cursor <- io $ createFontCursor d brCursorBottomRightCorner + cursor <- io $ createFontCursor d xC_bottom_right_corner hunk ./XMonad/Util/Loggers.hs 119 -battery = logCmd "/usr/bin/acpi | sed -r 's/.*?: (.*%).*/\\1/; s/discharging, ([0-9]+%)/\\1-/; s/charging, ([0-9]+%)/\\1+/; s/charged, //'" +battery = logCmd "/usr/bin/acpi | sed -r 's/.*?: (.*%).*/\\1/; s/[dD]ischarging, ([0-9]+%)/\\1-/; s/[cC]harging, ([0-9]+%)/\\1+/; s/[cC]harged, //'" hunk ./XMonad/Prompt/Shell.hs 102 - let ds = split ':' p + let ds = filter (/= "") $ split ':' p addfile ./XMonad/Actions/WorkspaceNames.hs hunk ./XMonad/Actions/WorkspaceNames.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.WorkspaceNames +-- Copyright : (c) Tomas Janousek +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Tomas Janousek +-- Stability : experimental +-- Portability : unportable +-- +-- Provides bindings to rename workspaces, show these names in DynamicLog and +-- swap workspaces along with their names. These names survive restart. +-- Together with "XMonad.Layout.WorkspaceDir" this provides for a fully +-- dynamic topic space workflow. +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE DeriveDataTypeable #-} + +module XMonad.Actions.WorkspaceNames ( + -- * Usage + -- $usage + + -- * Workspace naming + renameWorkspace, + workspaceNamesPP, + getWorkspaceNames, + setWorkspaceName, + setCurrentWorkspaceName, + + -- * Workspace swapping + swapTo, + swapTo', + swapWithCurrent, + ) where + +import XMonad +import qualified XMonad.StackSet as W +import qualified XMonad.Util.ExtensibleState as XS + +import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..)) +import qualified XMonad.Actions.SwapWorkspaces as Swap +import XMonad.Hooks.DynamicLog (PP(..)) +import XMonad.Prompt (showXPrompt, mkXPrompt, XPrompt, XPConfig) +import XMonad.Util.WorkspaceCompare (getSortByIndex) + +import qualified Data.Map as M +import Data.Maybe (fromMaybe) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Actions.WorkspaceNames +-- +-- Then add keybindings like the following: +-- +-- > , ((modm .|. shiftMask, xK_r ), renameWorkspace defaultXPConfig) +-- +-- and apply workspaceNamesPP to your DynamicLog pretty-printer: +-- +-- > myLogHook = +-- > workspaceNamesPP xmobarPP >>= dynamicLogString >>= xmonadPropLog +-- +-- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s +-- functionality, which may be used this way: +-- +-- > , ((modMask .|. shiftMask, xK_Left ), swapTo Prev) +-- > , ((modMask .|. shiftMask, xK_Right ), swapTo Next) +-- +-- > [((modm .|. controlMask, k), swapWithCurrent i) +-- > | (i, k) <- zip workspaces [xK_1 ..]] +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + + + +-- | Workspace names container. +newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String) + deriving (Typeable, Read, Show) + +instance ExtensionClass WorkspaceNames where + initialValue = WorkspaceNames M.empty + extensionType = PersistentExtension + +-- | Returns a function that maps workspace tag @\"t\"@ to @\"t:name\"@ for +-- workspaces with a name, and to @\"t\"@ otherwise. +getWorkspaceNames :: X (WorkspaceId -> String) +getWorkspaceNames = do + WorkspaceNames m <- XS.get + return $ \wks -> case M.lookup wks m of + Nothing -> wks + Just s -> wks ++ ":" ++ s + +-- | Sets the name of a workspace. Empty string makes the workspace unnamed +-- again. +setWorkspaceName :: WorkspaceId -> String -> X () +setWorkspaceName w name = do + WorkspaceNames m <- XS.get + XS.put $ WorkspaceNames $ if null name then M.delete w m else M.insert w name m + refresh + +-- | Sets the name of the current workspace. See 'setWorkspaceName'. +setCurrentWorkspaceName :: String -> X () +setCurrentWorkspaceName name = do + current <- gets (W.currentTag . windowset) + setWorkspaceName current name + +data Wor = Wor String +instance XPrompt Wor where + showXPrompt (Wor x) = x + +-- | Prompt for a new name for the current workspace and set it. +renameWorkspace :: XPConfig -> X () +renameWorkspace conf = do + mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName + where pr = Wor "Workspace name: " + +-- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to show +-- workspace names as well. +workspaceNamesPP :: PP -> X PP +workspaceNamesPP pp = do + names <- getWorkspaceNames + return $ + pp { + ppCurrent = ppCurrent pp . names, + ppVisible = ppVisible pp . names, + ppHidden = ppHidden pp . names, + ppHiddenNoWindows = ppHiddenNoWindows pp . names, + ppUrgent = ppUrgent pp . names + } + +-- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names. +swapTo :: Direction1D -> X () +swapTo dir = swapTo' dir AnyWS + +-- | Swap with the previous or next workspace of the given type. +swapTo' :: Direction1D -> WSType -> X () +swapTo' dir which = findWorkspace getSortByIndex dir which 1 >>= swapWithCurrent + +-- | See 'XMonad.Actions.SwapWorkspaces.swapWithCurrent'. This is almost the +-- same with names. +swapWithCurrent :: WorkspaceId -> X () +swapWithCurrent t = do + current <- gets (W.currentTag . windowset) + swapNames t current + windows $ Swap.swapWorkspaces t current + +-- | Swap names of the two workspaces. +swapNames :: WorkspaceId -> WorkspaceId -> X () +swapNames w1 w2 = do + WorkspaceNames m <- XS.get + let getname w = fromMaybe "" $ M.lookup w m + set w name m' = if null name then M.delete w m' else M.insert w name m' + XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m hunk ./xmonad-contrib.cabal 112 + XMonad.Actions.WorkspaceNames addfile ./XMonad/Actions/DynamicWorkspaceGroups.hs hunk ./XMonad/Actions/DynamicWorkspaceGroups.hs 1 - +{-# LANGUAGE DeriveDataTypeable #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.DynamicWorkspaceGroups +-- Copyright : (c) Brent Yorgey 2009 +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : experimental +-- Portability : unportable +-- +-- Dynamically manage \"workspace groups\", sets of workspaces being +-- used together for some common task or purpose, to allow switching +-- between workspace groups in a single action. Note that this only +-- makes sense for multi-head setups. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.DynamicWorkspaceGroups + ( -- * Usage + -- $usage + + WSGroupId + + , addWSGroup + , addCurrentWSGroup + , forgetWSGroup + , viewWSGroup + + , promptWSGroupView + , promptWSGroupAdd + , promptWSGroupForget + ) where + +import Data.List (find) +import Control.Arrow ((&&&)) +import qualified Data.Map as M + +import XMonad +import qualified XMonad.StackSet as W + +import XMonad.Prompt +import qualified XMonad.Util.ExtensibleState as XS + +-- $usage +-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: +-- +-- > import XMonad.Actions.DynamicWorkspaceGroups +-- +-- Then add keybindings like the following (this example uses +-- "XMonad.Util.EZConfig"-style keybindings, but this is not necessary): +-- +-- > , ("M-y n", promptWSGroupAdd myXPConfig "Name this group: ") +-- > , ("M-y g", promptWSGroupView myXPConfig "Go to group: ") +-- > , ("M-y d", promptWSGroupForget myXPConfig "Forget group: ") +-- + +type WSGroup = [(ScreenId,WorkspaceId)] + +type WSGroupId = String + +data WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup } + deriving (Typeable, Read, Show) + +withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage +withWSG f = WSG . f . unWSG + +instance ExtensionClass WSGroupStorage where + initialValue = WSG $ M.empty + extensionType = PersistentExtension + +-- | Add a new workspace group with the given name. +addWSGroup :: WSGroupId -> [WorkspaceId] -> X () +addWSGroup name wids = withWindowSet $ \w -> do + let wss = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w + wmap = mapM (strength . (flip lookup wss &&& id)) wids + case wmap of + Just ps -> XS.modify . withWSG . M.insert name $ ps + Nothing -> return () + where strength (ma, b) = ma >>= \a -> return (a,b) + +-- | Give a name to the current workspace group. +addCurrentWSGroup :: WSGroupId -> X () +addCurrentWSGroup name = withWindowSet $ \w -> + addWSGroup name $ map (W.tag . W.workspace) (W.current w : W.visible w) + +-- | Delete the named workspace group from the list of workspace +-- groups. Note that this has no effect on the workspaces involved; +-- it simply forgets the given name. +forgetWSGroup :: WSGroupId -> X () +forgetWSGroup = XS.modify . withWSG . M.delete + +-- | View the workspace group with the given name. +viewWSGroup :: WSGroupId -> X () +viewWSGroup name = do + WSG m <- XS.get + case M.lookup name m of + Just grp -> mapM_ (uncurry viewWS) grp + Nothing -> return () + +-- | View the given workspace on the given screen. +viewWS :: ScreenId -> WorkspaceId -> X () +viewWS sid wid = do + mw <- findScreenWS sid + case mw of + Just w -> do + windows $ W.view w + windows $ W.greedyView wid + Nothing -> return () + +-- | Find the workspace which is currently on the given screen. +findScreenWS :: ScreenId -> X (Maybe WorkspaceId) +findScreenWS sid = withWindowSet $ + return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens + +data WSGPrompt = WSGPrompt String + +instance XPrompt WSGPrompt where + showXPrompt (WSGPrompt s) = s + +-- | Prompt for a workspace group to view. +promptWSGroupView :: XPConfig -> String -> X () +promptWSGroupView xp s = do + gs <- fmap (M.keys . unWSG) XS.get + mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) viewWSGroup + +-- | Prompt for a name for the current workspace group. +promptWSGroupAdd :: XPConfig -> String -> X () +promptWSGroupAdd xp s = + mkXPrompt (WSGPrompt s) xp (const $ return []) addCurrentWSGroup + +-- | Prompt for a workspace group to forget. +promptWSGroupForget :: XPConfig -> String -> X () +promptWSGroupForget xp s = do + gs <- fmap (M.keys . unWSG) XS.get + mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) forgetWSGroup hunk ./xmonad-contrib.cabal 77 + XMonad.Actions.DynamicWorkspaceGroups hunk ./XMonad/Actions/CycleWS.hs 68 + , doTo hunk ./XMonad/Actions/CycleWS.hs 248 -moveTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . greedyView +moveTo dir t = doTo dir t getSortByIndex (windows . greedyView) hunk ./XMonad/Actions/CycleWS.hs 253 -shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift +shiftTo dir t = doTo dir t getSortByIndex (windows . shift) + +-- | Using the given sort, find the next workspace in the given +-- direction of the given type, and perform the given action on it. +doTo :: Direction1D -> WSType -> X WorkspaceSort -> (WorkspaceId -> X ()) -> X () +doTo dir t srt act = findWorkspace srt dir t 1 >>= act addfile ./XMonad/Actions/DynamicWorkspaceOrder.hs hunk ./XMonad/Actions/DynamicWorkspaceOrder.hs 1 - +{-# LANGUAGE DeriveDataTypeable #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.DynamicWorkspaceOrder +-- Copyright : (c) Brent Yorgey 2009 +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : experimental +-- Portability : unportable +-- +-- Remember a dynamically updateable ordering on workspaces, together +-- with tools for using this ordering with "XMonad.Actions.CycleWS" +-- and "XMonad.Hooks.DynamicLog". +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.DynamicWorkspaceOrder + ( -- * Usage + -- $usage + + getWsCompareByOrder + , getSortByOrder + , swapWith + + , moveTo + , moveToGreedy + , shiftTo + + ) where + +import XMonad +import qualified XMonad.StackSet as W +import qualified XMonad.Util.ExtensibleState as XS + +import XMonad.Util.WorkspaceCompare (WorkspaceCompare, WorkspaceSort, mkWsSort) +import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), doTo) + +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Maybe (fromJust, fromMaybe) +import Data.Ord (comparing) +import Data.Typeable + +-- $usage +-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: +-- +-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO +-- +-- Then add keybindings to swap the order of workspaces (these +-- examples use "XMonad.Util.EZConfig" emacs-style keybindings): +-- +-- > , ("M-C-", DO.swapWith Next NonEmptyWS) +-- > , ("M-C-", DO.swapWith Prev NonEmptyWS) +-- +-- See "XMonad.Actions.CycleWS" for information on the possible +-- arguments to 'swapWith'. +-- +-- However, by itself this will do nothing; 'swapWith' does not change +-- the actual workspaces in any way. It simply keeps track of an +-- auxiliary ordering on workspaces. Anything which cares about the +-- order of workspaces must be updated to use the auxiliary ordering. +-- +-- To change the order in which workspaces are displayed by +-- "XMonad.Hooks.DynamicLog", use 'getSortByOrder' in your +-- 'XMonad.Hooks.DynamicLog.ppSort' field, for example: +-- +-- > ... dynamicLogWithPP $ byorgeyPP { +-- > ... +-- > , ppSort = DO.getSortByOrder +-- > ... +-- > } +-- +-- To use workspace cycling commands like those from +-- "XMonad.Actions.CycleWS", use the versions of 'moveTo', +-- 'moveToGreedy', and 'shiftTo' exported by this module. For example: +-- +-- > , ("M-S-", DO.shiftTo Next HiddenNonEmptyWS) +-- > , ("M-S-", DO.shiftTo Prev HiddenNonEmptyWS) +-- > , ("M-", DO.moveTo Next HiddenNonEmptyWS) +-- > , ("M-", DO.moveTo Prev HiddenNonEmptyWS) +-- +-- For slight variations on these, use the source for examples and +-- tweak as desired. + +-- | Extensible state storage for the workspace order. +data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) } + deriving (Typeable, Read, Show) + +instance ExtensionClass WSOrderStorage where + initialValue = WSO Nothing + extensionType = PersistentExtension + +-- | Lift a Map function to a function on WSOrderStorage. +withWSO :: (M.Map WorkspaceId Int -> M.Map WorkspaceId Int) + -> (WSOrderStorage -> WSOrderStorage) +withWSO f = WSO . fmap f . unWSO + +-- | Update the ordering storage: initialize if it doesn't yet exist; +-- add newly created workspaces at the end as necessary. +updateOrder :: X () +updateOrder = do + WSO mm <- XS.get + case mm of + Nothing -> do + -- initialize using ordering of workspaces from the user's config + ws <- asks (workspaces . config) + XS.put . WSO . Just . M.fromList $ zip ws [0..] + Just m -> do + -- check for new workspaces and add them at the end + curWs <- gets (S.fromList . map W.tag . W.workspaces . windowset) + let mappedWs = M.keysSet m + newWs = curWs `S.difference` mappedWs + nextIndex = 1 + maximum (-1 : M.elems m) + newWsIxs = zip (S.toAscList newWs) [nextIndex..] + XS.modify . withWSO . M.union . M.fromList $ newWsIxs + +-- | A comparison function which orders workspaces according to the +-- stored dynamic ordering. +getWsCompareByOrder :: X WorkspaceCompare +getWsCompareByOrder = do + updateOrder + -- after the call to updateOrder we are guaranteed that the dynamic + -- workspace order is initialized and contains all existing + -- workspaces. + WSO (Just m) <- XS.get + return $ comparing (fromMaybe 1000 . flip M.lookup m) + +-- | Sort workspaces according to the stored dynamic ordering. +getSortByOrder :: X WorkspaceSort +getSortByOrder = mkWsSort getWsCompareByOrder + +-- | Swap the current workspace with another workspace in the stored +-- dynamic order. +swapWith :: Direction1D -> WSType -> X () +swapWith dir which = findWorkspace getSortByOrder dir which 1 >>= swapWithCurrent + +-- | Swap the given workspace with the current one. +swapWithCurrent :: WorkspaceId -> X () +swapWithCurrent w = do + cur <- gets (W.currentTag . windowset) + swapOrder w cur + +-- | Swap the two given workspaces in the dynamic order. +swapOrder :: WorkspaceId -> WorkspaceId -> X () +swapOrder w1 w2 = do + io $ print (w1,w2) + WSO (Just m) <- XS.get + let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2] + XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1)) + windows id -- force a status bar update + +-- | View the next workspace of the given type in the given direction, +-- where \"next\" is determined using the dynamic workspace order. +moveTo :: Direction1D -> WSType -> X () +moveTo dir t = doTo dir t getSortByOrder (windows . W.view) + +-- | Same as 'moveTo', but using 'greedyView' instead of 'view'. +moveToGreedy :: Direction1D -> WSType -> X () +moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView) + +-- | Shift the currently focused window to the next workspace of the +-- given type in the given direction, using the dynamic workspace order. +shiftTo :: Direction1D -> WSType -> X () +shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift) hunk ./xmonad-contrib.cabal 78 + XMonad.Actions.DynamicWorkspaceOrder hunk ./XMonad/Layout/BorderResize.hs 66 -brCursorRightSide :: Glyph -brCursorRightSide = 96 -brCursorLeftSide :: Glyph -brCursorLeftSide = 70 -brCursorTopSide :: Glyph -brCursorTopSide = 138 -brCursorBottomSide :: Glyph -brCursorBottomSide = 16 - hunk ./XMonad/Layout/BorderResize.hs 149 - [((Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht), brCursorRightSide , RightSideBorder), - ((Rectangle (x - brBorderOffset) y brBorderSize ht) , brCursorLeftSide , LeftSideBorder), - ((Rectangle x (y - brBorderOffset) wh brBorderSize) , brCursorTopSide , TopSideBorder), - ((Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize), brCursorBottomSide , BottomSideBorder) + [((Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht), xC_right_side , RightSideBorder), + ((Rectangle (x - brBorderOffset) y brBorderSize ht) , xC_left_side , LeftSideBorder), + ((Rectangle x (y - brBorderOffset) wh brBorderSize) , xC_top_side , TopSideBorder), + ((Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize), xC_bottom_side, BottomSideBorder) hunk ./XMonad/Layout/MouseResizableTile.hs 93 -mrtHDoubleArrow :: Glyph -mrtHDoubleArrow = 108 -mrtVDoubleArrow :: Glyph -mrtVDoubleArrow = 116 hunk ./XMonad/Layout/MouseResizableTile.hs 154 - draggerCursor' = if (draggerCursor == mrtHDoubleArrow) - then mrtVDoubleArrow - else mrtHDoubleArrow + draggerCursor' = if (draggerCursor == xC_sb_h_double_arrow) + then xC_sb_v_double_arrow + else xC_sb_h_double_arrow hunk ./XMonad/Layout/MouseResizableTile.hs 216 - nextDragger = (draggerRect, mrtVDoubleArrow, draggerInfo) + nextDragger = (draggerRect, xC_sb_v_double_arrow, draggerInfo) hunk ./XMonad/Layout/MouseResizableTile.hs 221 -splitHorizontallyBy f (Rectangle sx sy sw sh) = ((leftHalf, rightHalf), (draggerRect, mrtHDoubleArrow, draggerInfo)) +splitHorizontallyBy f (Rectangle sx sy sw sh) = ((leftHalf, rightHalf), (draggerRect, xC_sb_h_double_arrow, draggerInfo)) hunk ./XMonad/Layout/Minimize.hs 29 +import qualified Data.Map as M hunk ./XMonad/Layout/Minimize.hs 65 -data Minimize a = Minimize [Window] deriving ( Read, Show ) +data Minimize a = Minimize [Window] (M.Map Window W.RationalRect) deriving ( Read, Show ) hunk ./XMonad/Layout/Minimize.hs 67 -minimize = ModifiedLayout $ Minimize [] +minimize = ModifiedLayout $ Minimize [] (M.empty) hunk ./XMonad/Layout/Minimize.hs 76 - modifierDescription (Minimize _) = "Minimize" + modifierDescription (Minimize _ _) = "Minimize" hunk ./XMonad/Layout/Minimize.hs 78 - modifyLayout (Minimize minimized) wksp rect = do + modifyLayout (Minimize minimized _) wksp rect = do hunk ./XMonad/Layout/Minimize.hs 83 - handleMess (Minimize minimized) m + handleMess (Minimize minimized unfloated) m hunk ./XMonad/Layout/Minimize.hs 88 - return $ Just $ Minimize (w:minimized) + ws <- gets windowset + case M.lookup w (W.floating ws) of + Nothing -> return $ Just $ Minimize (w:minimized) unfloated + Just r -> do + (windows . W.sink) w + return $ Just $ Minimize (w:minimized) (M.insert w r unfloated) + hunk ./XMonad/Layout/Minimize.hs 97 - return $ Just $ Minimize (minimized \\ [w]) + case M.lookup w unfloated of + Nothing -> return $ Just $ Minimize (minimized \\ [w]) unfloated + Just r -> do + (windows . (W.float w)) r + return $ Just $ Minimize (minimized \\ [w]) (M.delete w unfloated) hunk ./XMonad/Layout/Minimize.hs 104 - then do + then case M.lookup (head minimized) unfloated of + Nothing -> do hunk ./XMonad/Layout/Minimize.hs 107 - return $ Just $ Minimize (tail minimized) + return $ Just $ Minimize (tail minimized) unfloated + Just r -> do + let w = head minimized + (windows . (W.float w)) r + focus w + return $ Just $ Minimize (tail minimized) (M.delete w unfloated) hunk ./XMonad/Layout/Minimize.hs 67 -minimize = ModifiedLayout $ Minimize [] (M.empty) +minimize = ModifiedLayout $ Minimize [] M.empty hunk ./XMonad/Layout/Minimize.hs 76 - modifierDescription (Minimize _ _) = "Minimize" + modifierDescription _ = "Minimize" hunk ./XMonad/Layout/Minimize.hs 84 - | Just (MinimizeWin w) <- fromMessage m = - if not (w `elem` minimized) - then do + | Just (MinimizeWin w) <- fromMessage m, not (w `elem` minimized) = do hunk ./XMonad/Layout/Minimize.hs 92 - - else return Nothing hunk ./XMonad/Prompt.hs 62 + , HistoryMatches + , initMatches + , historyUpMatching hunk ./XMonad/Prompt.hs 86 +import Data.IORef hunk ./XMonad/Prompt.hs 883 + +newtype HistoryMatches = HistoryMatches (IORef ([String],[String])) + +-- | Initializes a new HistoryMatches structure to be passed +-- to historyUpMatching +initMatches :: (Functor m, MonadIO m) => m HistoryMatches +initMatches = HistoryMatches <$> liftIO (newIORef ([],[])) + +-- | Retrieve the next history element that starts with +-- the current input. Pass it an IORef containing two empty lists +-- when creating the prompt. Example: +-- +-- > .. +-- > ((modMask,xK_p), shellPrompt . myPrompt =<< initMatches) +-- > .. +-- > myPrompt ref = defaultPrompt +-- > { promptKeymap = M.union [((0,xK_Up), historyMatching ref)] (promptKeymap defaultPrompt) +-- > , .. } +-- +historyUpMatching :: HistoryMatches -> XP () +historyUpMatching hm@(HistoryMatches ref) = do + (completed,completions) <- io $ readIORef ref + input <- getInput + if input `elem` completed + then case completions of + (c:cs) -> do + modify (setCommand c) + modify $ \s -> s { offset = length c } + io $ writeIORef ref (c:completed,cs) + _ -> return () + else do -- the user typed something new, recompute completions + io . writeIORef ref . ((,) [input]) . filterMatching input =<< gets commandHistory + historyUpMatching hm + where filterMatching :: String -> W.Stack String -> [String] + filterMatching prefix = + filter (prefix `isPrefixOf`) . tail . cycle . nub . W.integrate hunk ./XMonad/Layout/Decoration.hs 365 -showDecos = showWindows . catMaybes . map fst +showDecos = showWindows . catMaybes . map fst . filter (isJust . snd) hunk ./XMonad/Config/Bluetile.hs 121 - , ((modMask' .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit bluetile - , ((modMask' , xK_q ), spawn "bluetile --restart") -- %! Restart bluetile + , ((modMask' .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit + , ((modMask' , xK_q ), restart "xmonad" True) -- %! Restart hunk ./XMonad/Layout/Accordion.hs 45 - ups = W.up ws + ups = reverse $ W.up ws hunk ./XMonad/Layout/Tabbed.hs 84 --- > import XMonad.Layout.DecorationMadness +-- > import XMonad.Layout.Tabbed hunk ./XMonad/Config/Azerty.hs 41 -azertyConfig = defaultConfig { keys = \c -> azertyKeys c `M.union` keys defaultConfig c } +azertyConfig = defaultConfig { keys = azertyKeys <+> keys defaultConfig } hunk ./XMonad/Config/Desktop.hs 173 - , keys = \c -> desktopKeys c `M.union` keys defaultConfig c } + , keys = desktopKeys <+> keys defaultConfig } hunk ./XMonad/Config/Gnome.hs 44 - , keys = \c -> gnomeKeys c `M.union` keys desktopConfig c + , keys = gnomeKeys <+> keys desktopConfig hunk ./XMonad/Config/Kde.hs 43 - , keys = \c -> kdeKeys c `M.union` keys desktopConfig c } + , keys = kdeKeys <+> keys desktopConfig } hunk ./XMonad/Config/Kde.hs 47 - , keys = \c -> kde4Keys c `M.union` keys desktopConfig c } + , keys = kde4Keys <+> keys desktopConfig } hunk ./XMonad/Config/Xfce.hs 39 - , keys = \c -> xfceKeys c `M.union` keys desktopConfig c } + , keys = xfceKeys <+> keys desktopConfig } hunk ./XMonad/Actions/CycleWindows.hs 229 --- Generic list rotations +-- Generic list rotations such that @rotUp [1..4]@ is equivalent to +-- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are +-- @id@ for null or singleton lists. hunk ./XMonad/Actions/CycleWindows.hs 233 -rotUp l = tail l ++ [head l] +rotUp l = drop 1 l ++ take 1 l hunk ./XMonad/Actions/CycleWindows.hs 235 -rotDown l = last l : init l +rotDown = reverse . rotUp . reverse hunk ./XMonad/Config/Bluetile.hs 52 +import XMonad.Hooks.ManageHelpers hunk ./XMonad/Config/Bluetile.hs 183 + , isFullscreen --> doFullFloat hunk ./XMonad/Config/Bluetile.hs 208 + `mappend` fullscreenEventHook hunk ./XMonad/Config/Bluetile.hs 215 - focusFollowsMouse = False, - focusedBorderColor = "#ff5500", + focusFollowsMouse = False, + focusedBorderColor = "#000000", hunk ./XMonad/Prompt.hs 65 + , historyDownMatching hunk ./XMonad/Prompt.hs 885 -newtype HistoryMatches = HistoryMatches (IORef ([String],[String])) +newtype HistoryMatches = HistoryMatches (IORef ([String],Maybe (W.Stack String))) hunk ./XMonad/Prompt.hs 890 -initMatches = HistoryMatches <$> liftIO (newIORef ([],[])) +initMatches = HistoryMatches <$> liftIO (newIORef ([],Nothing)) + +historyNextMatching :: HistoryMatches -> (W.Stack String -> W.Stack String) -> XP () +historyNextMatching hm@(HistoryMatches ref) next = do + (completed,completions) <- io $ readIORef ref + input <- getInput + if input `elem` completed + then case completions of + Just cs -> do + let cmd = W.focus cs + modify $ setCommand cmd + modify $ \s -> s { offset = length cmd } + io $ writeIORef ref (cmd:completed,Just $ next cs) + Nothing -> return () + else do -- the user typed something new, recompute completions + io . writeIORef ref . ((,) [input]) . filterMatching input =<< gets commandHistory + historyNextMatching hm next + where filterMatching :: String -> W.Stack String -> Maybe (W.Stack String) + filterMatching prefix = W.filter (prefix `isPrefixOf`) . next hunk ./XMonad/Prompt.hs 911 --- the current input. Pass it an IORef containing two empty lists +-- the current input. Pass it the result of initMatches hunk ./XMonad/Prompt.hs 918 --- > { promptKeymap = M.union [((0,xK_Up), historyMatching ref)] (promptKeymap defaultPrompt) +-- > { promptKeymap = M.union [((0,xK_Up), historyMatching ref) +-- > ,((0,xK_Down), historyMatching ref)] +-- > (promptKeymap defaultPrompt) hunk ./XMonad/Prompt.hs 923 -historyUpMatching :: HistoryMatches -> XP () -historyUpMatching hm@(HistoryMatches ref) = do - (completed,completions) <- io $ readIORef ref - input <- getInput - if input `elem` completed - then case completions of - (c:cs) -> do - modify (setCommand c) - modify $ \s -> s { offset = length c } - io $ writeIORef ref (c:completed,cs) - _ -> return () - else do -- the user typed something new, recompute completions - io . writeIORef ref . ((,) [input]) . filterMatching input =<< gets commandHistory - historyUpMatching hm - where filterMatching :: String -> W.Stack String -> [String] - filterMatching prefix = - filter (prefix `isPrefixOf`) . tail . cycle . nub . W.integrate - +historyUpMatching, historyDownMatching :: HistoryMatches -> XP () +historyUpMatching hm = historyNextMatching hm W.focusUp' +historyDownMatching hm = historyNextMatching hm W.focusDown' hunk ./XMonad/Prompt.hs 918 --- > { promptKeymap = M.union [((0,xK_Up), historyMatching ref) --- > ,((0,xK_Down), historyMatching ref)] +-- > { promptKeymap = M.union [((0,xK_Up), historyUpMatching ref) +-- > ,((0,xK_Down), historyDownMatching ref)] hunk ./XMonad/Actions/CopyWindow.hs 29 -import Control.Monad hunk ./XMonad/Actions/DynamicWorkspaceOrder.hs 44 -import Data.Typeable hunk ./XMonad/Actions/MouseResize.hs 26 -import Control.Monad -import Data.Maybe - hunk ./XMonad/Actions/MouseResize.hs 28 -import XMonad.Layout.LayoutModifier hunk ./XMonad/Actions/OnScreen.hs 29 -import XMonad.Core hunk ./XMonad/Actions/PhysicalScreens.hs 27 -import qualified Graphics.X11.Xlib as X hunk ./XMonad/Actions/SwapWorkspaces.hs 28 -import XMonad.Util.Types hunk ./XMonad/Actions/TagWindows.hs 28 -import Data.List (nub,concat,sortBy) +import Data.List (nub,sortBy) hunk ./XMonad/Actions/TopicSpace.hs 47 -import Control.Monad ((=<<),liftM2,when,unless,replicateM_) +import Control.Monad (liftM2,when,unless,replicateM_) hunk ./XMonad/Actions/TopicSpace.hs 50 -import XMonad.Operations hunk ./XMonad/Actions/UpdateFocus.hs 24 -import Graphics.X11.Xlib.Extras hunk ./XMonad/Actions/Warp.hs 25 -import Data.Ratio hunk ./XMonad/Actions/WindowNavigation.hs 55 -import Graphics.X11.Xlib hunk ./XMonad/Actions/WithAll.hs 21 -import XMonad.Core -import XMonad.Operations hunk ./XMonad/Config/Bluetile.hs 29 -import XMonad.Layout hiding ( (|||) ) hunk ./XMonad/Config/Desktop.hs 57 -import XMonad.Config (defaultConfig) hunk ./XMonad/Config/Droundy.hs 13 -import XMonad.Config ( defaultConfig ) hunk ./XMonad/Config/Sjanssen.hs 9 -import XMonad.Config (defaultConfig) hunk ./XMonad/Hooks/ManageDocks.hs 33 -import Control.Monad hunk ./XMonad/Hooks/Place.hs 45 -import Data.Maybe (maybe, fromMaybe, catMaybes) +import Data.Maybe (fromMaybe, catMaybes) hunk ./XMonad/Hooks/Script.hs 29 -import Control.Monad.Trans hunk ./XMonad/Hooks/ServerMode.hs 67 -import Data.List hunk ./XMonad/Hooks/XPropManage.hs 21 -import Data.List (concat) hunk ./XMonad/Hooks/XPropManage.hs 26 -import XMonad.ManageHook ((-->)) hunk ./XMonad/Layout/ComboP.hs 30 -import XMonad.StackSet ( integrate, Workspace (..), Stack(..) ) +import XMonad.StackSet ( Workspace (..), Stack(..) ) hunk ./XMonad/Layout/DecorationAddons.hs 32 -import XMonad.Util.XUtils (fi) hunk ./XMonad/Layout/DecorationMadness.hs 97 -import XMonad.Layout.ResizeScreen hunk ./XMonad/Layout/Dishes.hs 24 -import Data.List hunk ./XMonad/Layout/IM.hs 32 -import Data.List -import XMonad.Layout (splitHorizontallyBy) hunk ./XMonad/Layout/IndependentScreens.hs 29 -import Control.Monad.Instances hunk ./XMonad/Layout/LayoutBuilder.hs 31 -import XMonad.Layout hunk ./XMonad/Layout/LayoutBuilder.hs 32 -import Graphics.X11.Xlib hunk ./XMonad/Layout/LayoutBuilder.hs 33 -import Control.Monad hunk ./XMonad/Layout/LayoutHints.hs 35 -import Control.Monad(Monad(return), mapM, join) +import Control.Monad(join) hunk ./XMonad/Layout/LimitWindows.hs 32 -import XMonad.Layout (IncMasterN (..)) hunk ./XMonad/Layout/NoBorders.hs 36 -import Control.Monad hunk ./XMonad/Layout/SubLayouts.hs 54 -import Control.Monad(Monad(return), Functor(..), - MonadPlus(mplus), (=<<), sequence, foldM, guard, when, join) -import Data.Function((.), ($), flip, id, on) -import Data.List((++), foldr, filter, map, concatMap, elem, - notElem, null, nubBy, (\\), find) -import Data.Maybe(Maybe(..), isNothing, maybe, fromMaybe, listToMaybe, - mapMaybe) +import Control.Monad(MonadPlus(mplus), foldM, guard, when, join) +import Data.Function(on) +import Data.List(nubBy, (\\), find) +import Data.Maybe(isNothing, fromMaybe, listToMaybe, mapMaybe) hunk ./XMonad/Layout/Tabbed.hs 31 -import Data.Maybe hunk ./XMonad/Layout/WindowArranger.hs 35 -import Data.Maybe hunk ./XMonad/Prompt/RunOrRaise.hs 29 -import Data.Maybe hunk ./XMonad/Prompt/Shell.hs 33 -import System.IO hunk ./XMonad/Prompt/Ssh.hs 29 -import Data.List hunk ./XMonad/Prompt/Theme.hs 23 -import Data.List hunk ./XMonad/Util/Dzen.hs 41 -import Data.List hunk ./XMonad/Util/NamedActions.hs 48 -import Data.Bits(Bits((.&.), complement, (.|.))) -import Data.Function((.), const, ($), flip, id) -import Data.List((++), filter, zip, map, concatMap, null, unlines, - groupBy) +import Data.Bits(Bits((.&.), complement)) +import Data.List (groupBy) hunk ./XMonad/Util/NamedActions.hs 56 -import qualified XMonad hunk ./XMonad/Util/NamedScratchpad.hs 30 -import XMonad.Core -import XMonad.ManageHook (composeAll,doFloat) hunk ./XMonad/Util/NamedScratchpad.hs 34 -import Data.Maybe (maybe,listToMaybe) +import Data.Maybe (listToMaybe) hunk ./XMonad/Util/Paste.hs 32 -import Graphics.X11.Xlib.Misc (stringToKeysym) hunk ./XMonad/Util/PositionStore.hs 30 -import Graphics.X11.Xlib -import Graphics.X11.Types -import Data.Typeable hunk ./XMonad/Util/Scratchpad.hs 27 -import XMonad.Core hunk ./XMonad/Util/XSelection.hs 26 -import Control.Monad(Monad (return, (>>)), Functor(..), liftM, join) +import Control.Monad (liftM, join) hunk ./xmonad-contrib.cabal 53 - ghc-options: -fwarn-tabs -Wall + + if true + ghc-options: -fwarn-tabs -Wall + hunk ./xmonad-contrib.cabal 62 + if impl(ghc >= 6.12.1) + ghc-options: -fno-warn-warnings-deprecations -fno-warn-unused-do-bind + hunk ./XMonad/Prompt.hs 92 -import Control.Exception hiding (handle) +import Control.Exception.Extensible hiding (handle) hunk ./XMonad/Prompt.hs 643 - `catch` \_ -> return [] + `catch` \(SomeException _) -> return [] hunk ./XMonad/Prompt.hs 761 -readHistory = catch readHist (const (return emptyHistory)) +readHistory = readHist `catch` \(SomeException _) -> return emptyHistory hunk ./XMonad/Prompt.hs 771 - catch (writeFile path (show hist)) $ const $ hPutStrLn stderr "error in writing" + writeFile path (show hist) `catch` \(SomeException _) -> hPutStrLn stderr "error in writing" hunk ./XMonad/Prompt/AppendFile.hs 32 -import Control.Exception +import Control.Exception.Extensible (bracket) hunk ./XMonad/Prompt/Man.hs 34 -import qualified Control.Exception as E +import qualified Control.Exception.Extensible as E hunk ./XMonad/Prompt/Man.hs 65 - paths <- getCommandOutput "manpath -g 2>/dev/null" `E.catch` \_ -> return [] + paths <- getCommandOutput "manpath -g 2>/dev/null" `E.catch` + \(E.SomeException _) -> return [] hunk ./XMonad/Util/NamedWindows.hs 27 -import Control.Exception ( bracket, catch ) +import Control.Exception.Extensible ( bracket, catch, SomeException(..) ) hunk ./XMonad/Util/NamedWindows.hs 53 - `catch` \_ -> getTextProperty d w wM_NAME + `catch` \(SomeException _) -> getTextProperty d w wM_NAME hunk ./XMonad/Util/NamedWindows.hs 57 - io $ getIt `catch` \_ -> ((`NW` w) . resName) `fmap` getClassHint d w + io $ getIt `catch` \(SomeException _) -> ((`NW` w) . resName) `fmap` getClassHint d w hunk ./XMonad/Util/Run.hs 36 +import System.Posix.Types (ProcessID) hunk ./XMonad/Util/Run.hs 38 -import Control.Exception (try) -- use OldException with base 4 +import Control.Exception.Extensible (try,SomeException) hunk ./XMonad/Util/Run.hs 111 -safeSpawn prog args = liftIO (try (xfork $ executeFile prog True args Nothing) >> return ()) +safeSpawn prog args = liftIO $ do + try $ xfork $ executeFile prog True args Nothing :: IO (Either SomeException ProcessID) + return () hunk ./XMonad/Util/XSelection.hs 25 -import Control.Exception as E (catch) +import Control.Exception.Extensible as E (catch,SomeException(..)) hunk ./XMonad/Util/XSelection.hs 69 - (\_ -> internAtom dpy "COMPOUND_TEXT" False)) - (\_ -> internAtom dpy "sTring" False) + (\(E.SomeException _) -> internAtom dpy "COMPOUND_TEXT" False)) + (\(E.SomeException _) -> internAtom dpy "sTring" False) hunk ./xmonad-contrib.cabal 43 - build-depends: base >= 3 && < 4, containers, directory, process, random, old-time, old-locale + build-depends: base >= 3 && < 5, + containers, + directory, + extensible-exceptions, + old-locale, + old-time, + process, + random hunk ./xmonad-contrib.cabal 70 - ghc-options: -fno-warn-warnings-deprecations -fno-warn-unused-do-bind + ghc-options: -fno-warn-unused-do-bind hunk ./XMonad/Prompt.hs 70 -import XMonad hiding (config, numlockMask, cleanMask) -import qualified XMonad as X (numlockMask) +import XMonad hiding (config, cleanMask) +import qualified XMonad as X (numberlockMask) hunk ./XMonad/Prompt.hs 287 - numlock <- gets $ X.numlockMask + numlock <- gets $ X.numberlockMask hunk ./XMonad/Prompt.hs 924 -historyUpMatching hm = historyNextMatching hm W.focusUp' -historyDownMatching hm = historyNextMatching hm W.focusDown' +historyUpMatching hm = historyNextMatching hm W.focusDown' +historyDownMatching hm = historyNextMatching hm W.focusUp' hunk ./XMonad/Prompt.hs 226 -greenXPConfig = defaultXPConfig { fgColor = "green", bgColor = "black" } +greenXPConfig = defaultXPConfig { fgColor = "green", bgColor = "black", promptBorderWidth = 0 } hunk ./XMonad/Hooks/DynamicLog.hs 273 - extras <- sequence $ map (flip catchX (return Nothing)) $ ppExtras pp + extras <- mapM (flip catchX (return Nothing)) $ ppExtras pp hunk ./XMonad/Hooks/DynamicLog.hs 340 - | otherwise = (take (n - length end) xs) ++ end + | otherwise = take (n - length end) xs ++ end hunk ./XMonad/Hooks/DynamicLog.hs 479 - (\ x -> case x of - "TilePrime Horizontal" -> " TTT " - "TilePrime Vertical" -> " []= " - "Hinted Full" -> " [ ] " - _ -> pad x + (\ x -> pad $ case x of + "TilePrime Horizontal" -> "TTT" + "TilePrime Vertical" -> "[]=" + "Hinted Full" -> "[ ]" + _ -> x hunk ./XMonad/Hooks/DynamicLog.hs 518 - hunk ./XMonad/Layout/IndependentScreens.hs 23 - marshall, unmarshall + marshallPP, + marshall, unmarshall, unmarshallS, unmarshallW, + marshallWindowSpace, unmarshallWindowSpace hunk ./XMonad/Layout/IndependentScreens.hs 34 -import XMonad.StackSet hiding (workspaces) +import XMonad.StackSet hiding (filter, workspaces) +import XMonad.Hooks.DynamicLog hunk ./XMonad/Layout/IndependentScreens.hs 75 -unmarshall :: PhysicalWorkspace -> (ScreenId, VirtualWorkspace) -unmarshall = ((S . read) *** drop 1) . break (=='_') +unmarshall :: PhysicalWorkspace -> (ScreenId, VirtualWorkspace) +unmarshallS :: PhysicalWorkspace -> ScreenId +unmarshallW :: PhysicalWorkspace -> VirtualWorkspace hunk ./XMonad/Layout/IndependentScreens.hs 79 --- ^ You shouldn't need to use @marshall@ and @unmarshall@ very much. --- They simply convert between the physical and virtual worlds. For --- example, you might want to use them as part of a status bar --- configuration. The function @snd . unmarshall@ would discard the --- screen information from an otherwise unsightly workspace name. +-- ^ You shouldn't need to use @marshall@ or the various @unmarshall@ functions +-- very much. They simply convert between the physical and virtual worlds. +-- For example, you might want to use them as part of a status bar +-- configuration. The function @unmarshallW@ would discard the screen +-- information from an otherwise unsightly workspace name. + +unmarshall = ((S . read) *** drop 1) . break (=='_') +unmarshallS = fst . unmarshall +unmarshallW = snd . unmarshall hunk ./XMonad/Layout/IndependentScreens.hs 112 + +-- TODO: documentation from here down +-- TODO: note somewhere that "marshall" functions go from convenient +-- to inconvenient, and "unmarshall" functions go from +-- inconvenient to convenient +marshallPP :: ScreenId -> PP -> PP +marshallPP s pp = pp { + ppCurrent = ppCurrent pp . snd . unmarshall, + ppVisible = ppVisible pp . snd . unmarshall, + ppHidden = ppHidden pp . snd . unmarshall, + ppHiddenNoWindows = ppHiddenNoWindows pp . snd . unmarshall, + ppUrgent = ppUrgent pp . snd . unmarshall, + ppSort = fmap (marshallSort s) (ppSort pp) + } + +marshallSort :: ScreenId -> ([WindowSpace] -> [WindowSpace]) -> ([WindowSpace] -> [WindowSpace]) +marshallSort s vSort = pScreens . vSort . vScreens where + onScreen ws = unmarshallS (tag ws) == s + vScreens = map unmarshallWindowSpace . filter onScreen + pScreens = map (marshallWindowSpace s) + +marshallWindowSpace :: ScreenId -> WindowSpace -> WindowSpace +unmarshallWindowSpace :: WindowSpace -> WindowSpace + +marshallWindowSpace s ws = ws { tag = marshall s (tag ws) } +unmarshallWindowSpace ws = ws { tag = unmarshallW (tag ws) } hunk ./XMonad/Layout/IndependentScreens.hs 22 - countScreens, hunk ./XMonad/Layout/IndependentScreens.hs 23 + countScreens, + -- * Converting between virtual and physical workspaces + -- $converting hunk ./XMonad/Layout/IndependentScreens.hs 74 +-- $converting +-- You shouldn't need to use the functions below very much. They are used +-- internally. However, in some cases, they may be useful, and so are exported +-- just in case. In general, the \"marshall\" functions convert the convenient +-- form (like \"web\") you would like to use in your configuration file to the +-- inconvenient form (like \"2_web\") that xmonad uses internally. Similarly, +-- the \"unmarshall\" functions convert in the other direction. + hunk ./XMonad/Layout/IndependentScreens.hs 89 --- ^ You shouldn't need to use @marshall@ or the various @unmarshall@ functions --- very much. They simply convert between the physical and virtual worlds. --- For example, you might want to use them as part of a status bar --- configuration. The function @unmarshallW@ would discard the screen --- information from an otherwise unsightly workspace name. - hunk ./XMonad/Layout/IndependentScreens.hs 117 --- TODO: documentation from here down --- TODO: note somewhere that "marshall" functions go from convenient --- to inconvenient, and "unmarshall" functions go from --- inconvenient to convenient +-- | This turns a naive pretty-printer into one that is aware of the +-- independent screens. That is, you can write your pretty printer to behave +-- the way you want on virtual workspaces; this function will convert that +-- pretty-printer into one that first filters out physical workspaces on other +-- screens, then converts all the physical workspaces on this screen to their +-- virtual names. +-- +-- For example, if you have handles @hLeft@ and @hRight@ for bars on the left and right screens, respectively, and @pp@ is a pretty-printer function that takes a handle, you could write +-- +-- > logHook = let log screen handle = dynamicLogWithPP . marshallPP screen . pp $ handle +-- > in log 0 hLeft >> log 1 hRight hunk ./XMonad/Layout/IndependentScreens.hs 144 +-- | Convert the tag of the 'WindowSpace' from a 'VirtualWorkspace' to a 'PhysicalWorkspace'. hunk ./XMonad/Layout/IndependentScreens.hs 146 +-- | Convert the tag of the 'WindowSpace' from a 'PhysicalWorkspace' to a 'VirtualWorkspace'. addfile ./XMonad/Hooks/ScreenCorners.hs hunk ./XMonad/Hooks/ScreenCorners.hs 1 +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.ScreenCorners +-- Copyright : (c) 2009 Nils Schweinsberg +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Nils Schweinsberg +-- Stability : unstable +-- Portability : unportable +-- +-- Run @X ()@ actions by touching the edge of your screen the your mouse. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.ScreenCorners + ( + -- * Usage + -- $usage + -- * Event hook + screenCornerEventHook + , ScreenCorner (..) + + -- * X11 input methods + , defaultEventInput + , adjustEventInput + ) where + +import Data.Monoid +import Foreign.C.Types + +import XMonad +import XMonad.Actions.UpdateFocus (adjustEventInput) + +data ScreenCorner = SCUpperLeft + | SCUpperRight + | SCLowerLeft + | SCLowerRight + +inCorner :: ScreenCorner -> X () -> Display -> CInt -> CInt -> X () +inCorner corner xF dpy ix iy = do + + let + screen = defaultScreen dpy + xMax = displayWidth dpy screen - 1 + yMax = displayHeight dpy screen - 1 + pos = case (ix,iy, corner) of + (0,0, SCUpperLeft) -> Just () + (x,0, SCUpperRight) | x == xMax -> Just () + (0,y, SCLowerLeft) | y == yMax -> Just () + (x,y, SCLowerRight) | x == xMax && y == yMax -> Just () + _ -> Nothing + + case pos of + Just _ -> do + -- Ignore any MotionEvents + defaultEventInput + -- Run our X () + xF + -- Handle MotionEvents again + adjustEventInput + + _ -> return () + +-- | The event hook manager for @ScreenCorners@. +screenCornerEventHook :: Event -> [(ScreenCorner, X ())] -> X All +screenCornerEventHook MotionEvent { ev_event_display = dpy, ev_x = ix, ev_y = iy } lis = do + + mapM_ (\(c,x) -> inCorner c x dpy ix iy) lis + return $ All True + +screenCornerEventHook _ _ = return $ All True + + +-- | Use the default input methods +defaultEventInput :: X () +defaultEventInput = withDisplay $ \dpy -> do + rootw <- asks theRoot + io $ selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask + .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask + .|. buttonPressMask + + +-- $usage +-- +-- This extension adds KDE-like screen corners to XMonad. By moving your cursor +-- into one of your screen corners you can trigger an @X ()@ action, for +-- example "XMonad.Actions.GridSelect".gotoSelected or +-- "XMonad.Actions.CycleWS".nextWS etc. +-- +-- To use it, import it on top of your @xmonad.hs@: +-- +-- > import XMonad.Hooks.ScreenCorners +-- +-- Then add @adjustEventInput@ to your startup hook: +-- +-- > myStartupHook = do +-- > ... +-- > adjustEventInput +-- +-- And put your custom ScreenCorners to your event hook: +-- +-- > myEventHook e = do +-- > ... +-- > screenCornerEventHook e [ (SCUpperRight, goToSelected defaultGSConfig { gs_cellwidth = 200 }) +-- > , (SCLowerRight, nextWS) +-- > , (SCLowerLeft, prevWS) +-- > ] hunk ./xmonad-contrib.cabal 149 + XMonad.Hooks.ScreenCorners hunk ./XMonad/Actions/UpdateFocus.hs 47 - Just foc <- withWindowSet $ return . W.peek + foc <- withWindowSet $ return . W.peek hunk ./XMonad/Actions/UpdateFocus.hs 50 - when (foc /= w) $ focus w + when (foc /= Just w) $ focus w hunk ./XMonad/Hooks/ScreenCorners.hs 47 - (0,0, SCUpperLeft) -> Just () - (x,0, SCUpperRight) | x == xMax -> Just () - (0,y, SCLowerLeft) | y == yMax -> Just () - (x,y, SCLowerRight) | x == xMax && y == yMax -> Just () + (0,0, SCUpperLeft) -> Just (50, 50) + (x,0, SCUpperRight) | x == xMax -> Just (x - 50, 50) + (0,y, SCLowerLeft) | y == yMax -> Just (50, y - 50) + (x,y, SCLowerRight) | x == xMax && y == yMax -> Just (x - 50, y - 50) hunk ./XMonad/Hooks/ScreenCorners.hs 54 - Just _ -> do + Just (x,y) -> do hunk ./XMonad/Hooks/ScreenCorners.hs 57 + -- move the mouse cursor so we avoid an unwanted loop + rootw <- asks theRoot + io $ warpPointer dpy none rootw 0 0 0 0 (fromIntegral x) (fromIntegral y) hunk ./XMonad/Hooks/ScreenCorners.hs 1 +{-# LANGUAGE DeriveDataTypeable #-} hunk ./XMonad/Hooks/ScreenCorners.hs 20 - -- * Event hook - screenCornerEventHook - , ScreenCorner (..) hunk ./XMonad/Hooks/ScreenCorners.hs 21 - -- * X11 input methods - , defaultEventInput - , adjustEventInput + -- * Adding screen corners + ScreenCorner (..) + , addScreenCorner + , addScreenCorners + + -- * Event hook + , screenCornerEventHook hunk ./XMonad/Hooks/ScreenCorners.hs 31 -import Foreign.C.Types - +import Data.List (find) hunk ./XMonad/Hooks/ScreenCorners.hs 33 -import XMonad.Actions.UpdateFocus (adjustEventInput) + +import qualified Data.Map as M +import qualified XMonad.Util.ExtensibleState as XS hunk ./XMonad/Hooks/ScreenCorners.hs 41 + deriving (Eq, Ord, Show) + + + +-------------------------------------------------------------------------------- +-- ExtensibleState modifications +-------------------------------------------------------------------------------- + +newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ())) + deriving Typeable + +instance ExtensionClass ScreenCornerState where + initialValue = ScreenCornerState M.empty + +-- | Add one single @X ()@ action to a screen corner +addScreenCorner :: ScreenCorner -> X () -> X () +addScreenCorner corner xF = do + + ScreenCornerState m <- XS.get + (win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of + + Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions + Nothing -> flip (,) xF `fmap` createWindowAt corner hunk ./XMonad/Hooks/ScreenCorners.hs 65 -inCorner :: ScreenCorner -> X () -> Display -> CInt -> CInt -> X () -inCorner corner xF dpy ix iy = do + XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m' + +-- | Add a list of @(ScreenCorner, X ())@ tuples +addScreenCorners :: [ (ScreenCorner, X ()) ] -> X () +addScreenCorners = mapM_ (\(corner, xF) -> addScreenCorner corner xF) + + +-------------------------------------------------------------------------------- +-- Xlib functions +-------------------------------------------------------------------------------- + +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral + +-- "Translate" a ScreenCorner to real (x,y) Positions +createWindowAt :: ScreenCorner -> X Window +createWindowAt SCUpperLeft = createWindowAt' 0 0 +createWindowAt SCUpperRight = withDisplay $ \dpy -> + let w = displayWidth dpy (defaultScreen dpy) - 1 + in createWindowAt' (fi w) 0 + +createWindowAt SCLowerLeft = withDisplay $ \dpy -> + let h = displayHeight dpy (defaultScreen dpy) - 1 + in createWindowAt' 0 (fi h) + +createWindowAt SCLowerRight = withDisplay $ \dpy -> + let w = displayWidth dpy (defaultScreen dpy) - 1 + h = displayHeight dpy (defaultScreen dpy) - 1 + in createWindowAt' (fi w) (fi h) + +-- Create a new X window at a (x,y) Position +createWindowAt' :: Position -> Position -> X Window +createWindowAt' x y = withDisplay $ \dpy -> io $ do + + rootw <- rootWindow dpy (defaultScreen dpy) hunk ./XMonad/Hooks/ScreenCorners.hs 102 - screen = defaultScreen dpy - xMax = displayWidth dpy screen - 1 - yMax = displayHeight dpy screen - 1 - pos = case (ix,iy, corner) of - (0,0, SCUpperLeft) -> Just (50, 50) - (x,0, SCUpperRight) | x == xMax -> Just (x - 50, 50) - (0,y, SCLowerLeft) | y == yMax -> Just (50, y - 50) - (x,y, SCLowerRight) | x == xMax && y == yMax -> Just (x - 50, y - 50) - _ -> Nothing + visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy + attrmask = cWOverrideRedirect + + w <- allocaSetWindowAttributes $ \attributes -> do + + set_override_redirect attributes True + createWindow dpy -- display + rootw -- parent window + x -- x + y -- y + 1 -- width + 1 -- height + 0 -- border width + 0 -- depth + inputOnly -- class + visual -- visual + attrmask -- valuemask + attributes -- attributes + + -- we only need mouse entry events + selectInput dpy w enterWindowMask + mapWindow dpy w + sync dpy False + return w hunk ./XMonad/Hooks/ScreenCorners.hs 127 - case pos of - Just (x,y) -> do - -- Ignore any MotionEvents - defaultEventInput - -- move the mouse cursor so we avoid an unwanted loop - rootw <- asks theRoot - io $ warpPointer dpy none rootw 0 0 0 0 (fromIntegral x) (fromIntegral y) - -- Run our X () - xF - -- Handle MotionEvents again - adjustEventInput hunk ./XMonad/Hooks/ScreenCorners.hs 128 - _ -> return () +-------------------------------------------------------------------------------- +-- Event hook +-------------------------------------------------------------------------------- hunk ./XMonad/Hooks/ScreenCorners.hs 132 --- | The event hook manager for @ScreenCorners@. -screenCornerEventHook :: Event -> [(ScreenCorner, X ())] -> X All -screenCornerEventHook MotionEvent { ev_event_display = dpy, ev_x = ix, ev_y = iy } lis = do +-- | Handle screen corner events +screenCornerEventHook :: Event -> X All +screenCornerEventHook CrossingEvent { ev_window = win } = do hunk ./XMonad/Hooks/ScreenCorners.hs 136 - mapM_ (\(c,x) -> inCorner c x dpy ix iy) lis - return $ All True + ScreenCornerState m <- XS.get hunk ./XMonad/Hooks/ScreenCorners.hs 138 -screenCornerEventHook _ _ = return $ All True + case M.lookup win m of + Just (_, xF) -> xF + Nothing -> return () hunk ./XMonad/Hooks/ScreenCorners.hs 142 + return (All True) hunk ./XMonad/Hooks/ScreenCorners.hs 144 --- | Use the default input methods -defaultEventInput :: X () -defaultEventInput = withDisplay $ \dpy -> do - rootw <- asks theRoot - io $ selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask - .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask - .|. buttonPressMask +screenCornerEventHook _ = return (All True) hunk ./XMonad/Hooks/ScreenCorners.hs 147 +-------------------------------------------------------------------------------- hunk ./XMonad/Hooks/ScreenCorners.hs 159 --- Then add @adjustEventInput@ to your startup hook: +-- Then add your screen corners in our startup hook: hunk ./XMonad/Hooks/ScreenCorners.hs 163 --- > adjustEventInput +-- > addScreenCorner SCUpperRight (goToSelected defaultGSConfig { gs_cellwidth = 200}) +-- > addScreenCorners [ (SCLowerRight, nextWS) +-- > , (SCLowerLeft, prevWS) +-- > ] hunk ./XMonad/Hooks/ScreenCorners.hs 168 --- And put your custom ScreenCorners to your event hook: +-- Then wait for screen corner events in your event hook: hunk ./XMonad/Hooks/ScreenCorners.hs 172 --- > screenCornerEventHook e [ (SCUpperRight, goToSelected defaultGSConfig { gs_cellwidth = 200 }) --- > , (SCLowerRight, nextWS) --- > , (SCLowerLeft, prevWS) --- > ] +-- > screenCornerEventHook e hunk ./XMonad/Hooks/ScreenCorners.hs 12 --- Run @X ()@ actions by touching the edge of your screen the your mouse. +-- Run @X ()@ actions by touching the edge of your screen with your mouse. hunk ./XMonad/Hooks/ScreenCorners.hs 152 --- example "XMonad.Actions.GridSelect".gotoSelected or --- "XMonad.Actions.CycleWS".nextWS etc. +-- example @"XMonad.Actions.GridSelect".goToSelected@ or +-- @"XMonad.Actions.CycleWS".nextWS@ etc. hunk ./XMonad/Hooks/ScreenCorners.hs 168 --- Then wait for screen corner events in your event hook: +-- And finally wait for screen corner events in your event hook: hunk ./XMonad/Hooks/ScreenCorners.hs 33 +import XMonad.Util.XUtils (fi) hunk ./XMonad/Hooks/ScreenCorners.hs 77 -fi :: (Integral a, Num b) => a -> b -fi = fromIntegral - hunk ./XMonad/Actions/PhysicalScreens.hs 22 + , onNextNeighbour + , onPrevNeighbour hunk ./XMonad/Actions/PhysicalScreens.hs 29 -import Graphics.X11.Xinerama - -import Data.List (sortBy) +import Data.List (sortBy,findIndex) hunk ./XMonad/Actions/PhysicalScreens.hs 46 +> , ((modMask, xK_a), onPrevNeighbour W.view) +> , ((modMask, xK_o), onNextNeighbour W.view) +> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour W.shift) +> , ((modMask .|. shiftMask, xK_o), onNextNeighbour W.shift) + hunk ./XMonad/Actions/PhysicalScreens.hs 68 -getScreen (P i) = withDisplay $ \dpy -> do - screens <- io $ getScreenInfo dpy - if i >= length screens - then return Nothing - else let ss = sortBy (cmpScreen `on` fst) $ zip screens [0..] - in return $ Just $ snd $ ss !! i +getScreen (P i) = do w <- gets windowset + let screens = W.current w : W.visible w + if i<0 || i >= length screens + then return Nothing + else let ss = sortBy (cmpScreen `on` (screenRect . W.screenDetail)) screens + in return $ Just $ W.screen $ ss !! i hunk ./XMonad/Actions/PhysicalScreens.hs 92 -cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2) +cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2) + + +-- | Get ScreenId for neighbours of the current screen based on position offset. +getNeighbour :: Int -> X ScreenId +getNeighbour d = do w <- gets windowset + let ss = map W.screen $ sortBy (cmpScreen `on` (screenRect . W.screenDetail)) $ W.current w : W.visible w + curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss + pos = (curPos + d) `mod` length ss + return $ ss !! pos + +neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X () +neighbourWindows d f = do s <- getNeighbour d + w <- screenWorkspace s + whenJust w $ windows . f + +-- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter. +onNextNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X () +onNextNeighbour = neighbourWindows 1 + +-- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter. +onPrevNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X () +onPrevNeighbour = neighbourWindows (-1) + hunk ./XMonad/Layout/LayoutScreens.hs 19 - layoutScreens, fixedLayout + layoutScreens, layoutSplitScreen, fixedLayout hunk ./XMonad/Layout/LayoutScreens.hs 58 +-- | Modify all screens. hunk ./XMonad/Layout/LayoutScreens.hs 71 +-- | Modify current screen. +layoutSplitScreen :: LayoutClass l Int => Int -> l Int -> X () +layoutSplitScreen nscr _ | nscr < 1 = trace $ "Can't layoutSplitScreen with only " ++ show nscr ++ " screens." +layoutSplitScreen nscr l = + do rect <- gets $ screenRect . W.screenDetail . W.current . windowset + (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rect + windows $ \ws@(W.StackSet { W.current = c, W.visible = vs, W.hidden = hs }) -> + let (x:xs, ys) = splitAt nscr $ W.workspace c : hs + s:ss = map snd wss + in ws { W.current = W.Screen x (W.screen c) (SD s) + , W.visible = (zipWith3 W.Screen xs [(W.screen c+1) ..] $ map SD ss) ++ + map (\v -> if W.screen v>W.screen c then v{W.screen = W.screen v + fromIntegral (nscr-1)} else v) vs + , W.hidden = ys } + hunk ./XMonad/Util/Dmenu.hs 20 - dmenu, dmenuXinerama, dmenuMap, menu, menuMap + dmenu, dmenuXinerama, dmenuMap, menu, menuArgs, menuMap, menuMapArgs hunk ./XMonad/Util/Dmenu.hs 41 + menuArgs "dmenu" ["-xs", show (curscreen+1)] opts hunk ./XMonad/Util/Dmenu.hs 43 +-- | Run dmenu to select an option from a list. hunk ./XMonad/Util/Dmenu.hs 47 +-- | like 'dmenu' but also takes the command to run. hunk ./XMonad/Util/Dmenu.hs 49 -menu menuCmd opts = runProcessWithInput menuCmd [] (unlines opts) +menu menuCmd opts = menuArgs menuCmd [] opts hunk ./XMonad/Util/Dmenu.hs 51 +-- | Like 'menu' but also takes a list of command line arguments. +menuArgs :: String -> [String] -> [String] -> X String +menuArgs menuCmd args opts = runProcessWithInput menuCmd args (unlines opts) + +-- | Like 'dmenuMap' but also takes the command to run. hunk ./XMonad/Util/Dmenu.hs 57 -menuMap menuCmd selectionMap = do +menuMap menuCmd selectionMap = menuMapArgs menuCmd [] selectionMap + +-- | Like 'menuMap' but also takes a list of command line arguments. +menuMapArgs :: String -> [String] -> M.Map String a -> X (Maybe a) +menuMapArgs menuCmd args selectionMap = do hunk ./XMonad/Util/Dmenu.hs 65 - menuFunction = menu menuCmd + menuFunction = menuArgs menuCmd args hunk ./XMonad/Util/Dmenu.hs 67 +-- | Run dmenu to select an entry from a map based on the key. hunk ./XMonad/Util/WorkspaceCompare.hs 11 +----------------------------------------------------------------------------- hunk ./XMonad/Util/WorkspaceCompare.hs 17 + , getXineramaPhysicalWsCompare hunk ./XMonad/Util/WorkspaceCompare.hs 22 + , getSortByXineramaPhysicalRule hunk ./XMonad/Util/WorkspaceCompare.hs 63 -getXineramaWsCompare = do +getXineramaWsCompare = getXineramaWsCompare' False + +-- | A comparison function like 'getXineramaWsCompare', but uses physical locations for screens. +getXineramaPhysicalWsCompare :: X WorkspaceCompare +getXineramaPhysicalWsCompare = getXineramaWsCompare' True + +getXineramaWsCompare' :: Bool -> X WorkspaceCompare +getXineramaWsCompare' phy = do hunk ./XMonad/Util/WorkspaceCompare.hs 73 - (True, True) -> comparing (tagToSid (onScreen w)) a b + (True, True) -> cmpPosition phy w a b hunk ./XMonad/Util/WorkspaceCompare.hs 81 + cmpPosition False w a b = comparing (tagToSid $ onScreen w) a b + cmpPosition True w a b = comparing (rect.(tagToSid $ onScreen w)) a b + where rect i = let (Rectangle x y _ _) = screens !! fromIntegral i in (y,x) + screens = map (screenRect . S.screenDetail) $ sortBy (comparing S.screen) $ S.current w : S.visible w hunk ./XMonad/Util/WorkspaceCompare.hs 109 +-- | Like 'getSortByXineramaRule', but uses physical locations for screens. +getSortByXineramaPhysicalRule :: X WorkspaceSort +getSortByXineramaPhysicalRule = mkWsSort getXineramaPhysicalWsCompare + addfile ./XMonad/Layout/Drawer.hs hunk ./XMonad/Layout/Drawer.hs 1 +{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Drawer +-- Copyright : (c) 2009 Max Rabkin +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : max.rabkin@gmail.com +-- Stability : unstable +-- Portability : unportable +-- +-- A layout modifier that puts some windows in a "drawer" which retracts and +-- expands depending on whether any window in it has focus. +-- +-- Useful for music players, tool palettes, etc. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.Drawer + ( -- * Usage + -- $usage + + -- * Drawers + simpleDrawer + , drawer + + -- * Placing drawers + -- The drawer can be placed on any side of the screen with these functions + , onLeft, onTop, onRight, onBottom + ) where + +import XMonad +import XMonad.Layout.LayoutModifier +import XMonad.Util.WindowProperties +import XMonad.StackSet as S +import XMonad.Layout.Reflect + +-- $usage +-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: +-- +-- @ +-- import XMonad.Layout.Drawer +-- import "XMonad.Util.WindowProperties" +-- +-- myLayout = drawer \``onTop'\` (Tall 1 0.03 0.5) ||| Full ||| RandomOtherLayout... +-- where +-- drawer = 'simpleDrawer' 0.01 0.3 (ClassName \"Rhythmbox\" \`Or\` ClassName \"Xchat\") +-- main = xmonad defaultConfig { layoutHook = myLayout } +-- @ +-- +-- This will place the Rhythmbox and Xchat windows in at the top of the screen. +-- See "XMonad.Util.WindowProperties" for more information on selecting windows. + +data Drawer l a = Drawer Rational Rational Property (l a) + deriving (Read, Show) + +-- | filter : filterM :: partition : partitionM +partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a]) +partitionM _ [] = return ([], []) +partitionM f (x:xs) = do + b <- f x + (ys, zs) <- partitionM f xs + return $ if b + then (x:ys, zs) + else (ys, x:zs) + +instance (LayoutClass l Window, Read (l Window)) => LayoutModifier (Drawer l) Window where + modifyLayout (Drawer rs rb p l) ws rect = + case stack ws of + Nothing -> runLayout ws rect + Just stk@(Stack { up=up_, down=down_, S.focus=w }) -> do + (upD, upM) <- partitionM (hasProperty p) up_ + (downD, downM) <- partitionM (hasProperty p) down_ + b <- hasProperty p w + + let (rectD, stackD, stackM) = if b + then ( rectB + , Just $ stk { up=upD, down=downD } + , mkStack upM downM ) + else ( rectS + , mkStack upD downD + , Just $ stk { up=upM, down=downM } ) + + (winsD, _) <- runLayout (ws { layout=l , stack=stackD }) rectD + (winsM, u') <- runLayout (ws { stack=stackM }) rectM + return (winsD ++ winsM, u') + where + mkStack [] [] = Nothing + mkStack xs (y:ys) = Just (Stack { up=xs, S.focus=y, down=ys }) + mkStack (x:xs) ys = Just (Stack { up=xs, S.focus=x, down=ys }) + + rectB = rect { rect_width=round $ fromIntegral (rect_width rect) * rb } + rectS = rectB { rect_x=round $ (rs - rb) * fromIntegral (rect_width rect) } + rectM = rect { rect_x=rect_x rect + round (fromIntegral (rect_width rect) * rs) + , rect_width=rect_width rect - round (fromIntegral (rect_width rect) * rs) } + +type Reflected l = ModifiedLayout Reflect l + +-- | Construct a drawer with a simple layout of the windows inside +simpleDrawer :: Rational -- ^ The portion of the screen taken up by the drawer when closed + -> Rational -- ^ The portion of the screen taken up by the drawer when open + -> Property -- ^ Which windows to put in the drawer + -> Drawer Tall a +simpleDrawer rs rb p = Drawer rs rb p vertical + where + vertical = Tall 0 0 0 + +-- Export a synonym for the constructor as a Haddock workaround +-- | Construct a drawer with an arbitrary layout for windows inside +drawer :: Rational -- ^ The portion of the screen taken up by the drawer when closed + -> Rational -- ^ The portion of the screen taken up by the drawer when open + -> Property -- ^ Which windows to put in the drawer + -> (l a) -- ^ The layout of windows in the drawer + -> Drawer l a +drawer = Drawer + +onLeft :: Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a +onLeft = ModifiedLayout + +onRight :: Drawer l a -> l' a -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a +onRight d = reflectHoriz . onLeft d . reflectHoriz + +onTop :: Drawer l a -> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a +onTop d = Mirror . onLeft d . Mirror + +onBottom :: Drawer l a -> l' a -> Reflected (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a +onBottom d = reflectVert . onTop d . reflectVert hunk ./XMonad/Layout/Reflect.hs 21 - REFLECTX(..), REFLECTY(..) + REFLECTX(..), REFLECTY(..), + Reflect hunk ./xmonad-contrib.cabal 173 + XMonad.Layout.Drawer hunk ./XMonad/Layout/Drawer.hs 30 + + , module XMonad.Util.WindowProperties hunk ./XMonad/Layout/Drawer.hs 43 --- @ --- import XMonad.Layout.Drawer --- import "XMonad.Util.WindowProperties" +-- > import XMonad.Layout.Drawer hunk ./XMonad/Layout/Drawer.hs 45 --- myLayout = drawer \``onTop'\` (Tall 1 0.03 0.5) ||| Full ||| RandomOtherLayout... --- where --- drawer = 'simpleDrawer' 0.01 0.3 (ClassName \"Rhythmbox\" \`Or\` ClassName \"Xchat\") --- main = xmonad defaultConfig { layoutHook = myLayout } --- @ +-- > myLayout = drawer `onTop` (Tall 1 0.03 0.5) ||| Full ||| RandomOtherLayout... +-- > where +-- > drawer = simpleDrawer 0.01 0.3 (ClassName "Rhythmbox" `Or` ClassName "Xchat") +-- > +-- > main = xmonad defaultConfig { layoutHook = myLayout } hunk ./XMonad/Layout/Drawer.hs 51 --- This will place the Rhythmbox and Xchat windows in at the top of the screen. --- See "XMonad.Util.WindowProperties" for more information on selecting windows. +-- This will place the Rhythmbox and Xchat windows in at the top of the screen +-- only when using the 'Tall' layout. See "XMonad.Util.WindowProperties" for +-- more information on selecting windows. hunk ./XMonad/Layout/Drawer.hs 76 + focusedWindow <- gets (fmap S.focus . stack . workspace . current . windowset) hunk ./XMonad/Layout/Drawer.hs 78 - let (rectD, stackD, stackM) = if b - then ( rectB - , Just $ stk { up=upD, down=downD } - , mkStack upM downM ) - else ( rectS - , mkStack upD downD - , Just $ stk { up=upM, down=downM } ) + let rectD = if b && Just w == focusedWindow then rectB else rectS hunk ./XMonad/Layout/Drawer.hs 80 - (winsD, _) <- runLayout (ws { layout=l , stack=stackD }) rectD + let (stackD, stackM) = if b + then ( Just $ stk { up=upD, down=downD } + , mkStack upM downM ) + else ( mkStack upD downD + , Just $ stk { up=upM, down=downM } ) + + (winsD, _) <- runLayout (ws { layout=l, stack=stackD }) rectD hunk ./XMonad/Layout/Drawer.hs 95 - rectS = rectB { rect_x=round $ (rs - rb) * fromIntegral (rect_width rect) } + rectS = rectB { rect_x=rect_x rectB - (round $ (rb - rs) * fromIntegral (rect_width rect)) } hunk ./XMonad/Actions/DynamicWorkspaces.hs 156 --- whose entries will never be removed. +-- whose entries will never be removed. hunk ./XMonad/Layout/Column.hs 64 - + hunk ./XMonad/Layout/Column.hs 66 -xn n (Rectangle _ _ _ h) q k = if q==1 then +xn n (Rectangle _ _ _ h) q k = if q==1 then hunk ./XMonad/Layout/DecorationAddons.hs 90 - let targetWksp = maybeWksp >>= \wksp -> + let targetWksp = maybeWksp >>= \wksp -> hunk ./XMonad/Layout/LayoutCombinators.hs 216 --- | +-- | hunk ./XMonad/Layout/LimitWindows.hs 141 - + hunk ./XMonad/Layout/MessageControl.hs 44 --- a message, but you'd want to be able to send it to the inner layout +-- a message, but you'd want to be able to send it to the inner layout hunk ./XMonad/Layout/MessageControl.hs 63 --- > unEscape $ mastered 0.01 0.5 +-- > unEscape $ mastered 0.01 0.5 hunk ./XMonad/Layout/MessageControl.hs 124 -ignore :: (Message m, LayoutClass l w) +ignore :: (Message m, LayoutClass l w) hunk ./XMonad/Prompt/Directory.hs 7 --- Maintainer : +-- Maintainer : hunk ./XMonad/Prompt/Layout.hs 7 --- Maintainer : +-- Maintainer : hunk ./XMonad/Prompt/Workspace.hs 7 --- Maintainer : +-- Maintainer : hunk ./XMonad/Util/Replace.hs 22 - + hunk ./XMonad/Util/Replace.hs 55 --- +-- move ./xmonad-contrib.cabal ./xmonad-contrib-bluetilebranch.cabal hunk ./xmonad-contrib-bluetilebranch.cabal 1 -name: xmonad-contrib -version: 0.9.1 +name: xmonad-contrib-bluetilebranch +version: 0.9.1.4 hunk ./xmonad-contrib-bluetilebranch.cabal 5 -description: - Third party tiling algorithms, configurations and scripts to xmonad, - a tiling window manager for X. - . - For an introduction to building, configuring and using xmonad - extensions, see "XMonad.Doc". In particular: - . - "XMonad.Doc.Configuring", a guide to configuring xmonad - . - "XMonad.Doc.Extending", using the contributed extensions library - . - "XMonad.Doc.Developing", introduction to xmonad internals and writing - your own extensions. - . +description: This is a modified version of xmonad-contrib used by Bluetile. hunk ./xmonad-contrib-bluetilebranch.cabal 10 -maintainer: spencerjanssen@gmail.com +maintainer: jan.vornberger@informatik.uni-oldenburg.de hunk ./xmonad-contrib-bluetilebranch.cabal 46 - build-depends: mtl, unix, X11>=1.5.0.0 && < 1.6, xmonad>=0.9.1, xmonad<0.10, utf8-string + build-depends: mtl, unix, X11>=1.5.0.0 && < 1.6, xmonad-bluetilebranch>=0.9.1, xmonad-bluetilebranch<0.10, utf8-string hunk ./xmonad-contrib-bluetilebranch.cabal 62 + exposed: False