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 () --- impor