diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +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. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,28 @@ +3rd party xmonad extensions and contributions. + +Build and install through Cabal as for other Haskell packages: + + runhaskell Setup configure --user --prefix=$HOME + runhaskell Setup build + runhaskell Setup install --user + +(You may want to remove the --user flag when installing as root.) + +scripts/ contains further external programs useful with xmonad. + +Haskell code contributed to this repo should live under the +appropriate subdivision of the 'XMonad.' namespace (currently includes +Actions, Config, Hooks, Layout, Prompt, and Util). For example, to use +the Mosaic layout, one would import: + + XMonad.Layout.Mosaic + +------------------------------------------------------------------------ + +Code submitted to the contrib repo is licensed under the same license as +xmonad itself, with copyright held by the authors. + +------------------------------------------------------------------------ + +Documentation for the extensions and configuration system is available +in Haddock form in the XMonad.Doc module and submodules. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/XMonad/Actions/Commands.hs b/XMonad/Actions/Commands.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/Commands.hs @@ -0,0 +1,120 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.Commands +-- Copyright : (c) David Glasser 2007 +-- License : BSD3 +-- +-- 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 XMonad.Actions module. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.Commands ( + -- * Usage + -- $usage + commandMap, + runCommand, + runCommand', + workspaceCommands, + screenCommands, + defaultCommands + ) where + +import XMonad +import XMonad.StackSet hiding (workspaces) +import XMonad.Util.Dmenu (dmenu) + +import qualified Data.Map as M +import System.Exit +import Data.Maybe + +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.Commands +-- +-- Then add a keybinding to the runCommand action: +-- +-- > , ((modMask x .|. controlMask, xK_y), runCommand commands) +-- +-- and define the list of commands you want to use: +-- +-- > commands :: [(String, X ())] +-- > commands = defaultCommands +-- +-- Whatever key you bound to will now cause a popup menu of internal +-- xmonad commands to appear. You can change the commands by +-- changing the contents of the list 'commands'. (If you like it +-- enough, you may even want to get rid of many of your other key +-- bindings!) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a +-- list of pairs. +commandMap :: [(String, X ())] -> M.Map String (X ()) +commandMap c = M.fromList c + +-- | Generate a list of commands to switch to\/send windows to workspaces. +workspaceCommands :: X [(String, X ())] +workspaceCommands = asks (workspaces . config) >>= \spaces -> return + [((m ++ show i), windows $ f i) + | i <- spaces + , (f, m) <- [(view, "view"), (shift, "shift")] ] + +-- | Generate a list of commands dealing with multiple screens. +screenCommands :: [(String, X ())] +screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f)) + | sc <- [0, 1]::[Int] -- TODO: adapt to screen changes + , (f, m) <- [(view, "screen"), (shift, "screen-to-")] + ] + +-- | A nice pre-defined list of commands. +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 ) + ] + +-- | Given a list of command\/action pairs, prompt the user to choose a +-- command and return the corresponding action. +runCommand :: [(String, X ())] -> X () +runCommand cl = do + let m = commandMap cl + choice <- dmenu (M.keys m) + fromMaybe (return ()) (M.lookup choice m) + +-- | Given the name of a command from 'defaultCommands', return the +-- corresponding action (or the null action if the command is not +-- found). +runCommand' :: String -> X () +runCommand' c = do + m <- fmap commandMap defaultCommands + fromMaybe (return ()) (M.lookup c m) diff --git a/XMonad/Actions/ConstrainedResize.hs b/XMonad/Actions/ConstrainedResize.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/ConstrainedResize.hs @@ -0,0 +1,57 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.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, say, holding shift while you resize). +-- +-- Useful for making a nice circular XClock window. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.ConstrainedResize ( + -- * Usage + -- $usage + XMonad.Actions.ConstrainedResize.mouseResizeWindow +) where + +import XMonad + +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import qualified XMonad.Actions.ConstrainedResize as Sqr +-- +-- Then add something like the following to your mouse bindings: +-- +-- > , ((modMask x, button3), (\w -> focus w >> Sqr.mouseResizeWindow w False)) +-- > , ((modMask x .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True )) +-- +-- The line without the shiftMask replaces the standard mouse resize +-- function call, so it's not completely necessary but seems neater +-- this way. +-- +-- For detailed instructions on editing your mouse bindings, see +-- "XMonad.Doc.Extending#Editing_mouse_bindings". + +-- | 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) diff --git a/XMonad/Actions/CopyWindow.hs b/XMonad/Actions/CopyWindow.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/CopyWindow.hs @@ -0,0 +1,85 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.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 XMonad.Actions.CopyWindow ( + -- * Usage + -- $usage + copy, copyWindow, kill1 + ) where + +import Prelude hiding ( filter ) +import qualified Data.List as L +import XMonad hiding (modify) +import XMonad.StackSet + +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Actions.CopyWindow +-- +-- Then add something like this to your keybindings: +-- +-- > -- 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 x, k), windows $ f i) +-- > | (i, k) <- zip (workspaces x) [xK_1 ..] +-- > , (f, m) <- [(W.view, 0), (W.shift, shiftMask), (copy, shiftMask .|. controlMask)]] +-- +-- To use the above key bindings you need also to import +-- "XMonad.StackSet": +-- +-- > import qualified XMonad.StackSet as W +-- +-- 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 x .|. shiftMask, xK_c ), kill1) -- @@ Close the focused window +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | copy. Copy the focussed window to a new workspace. +copy :: WorkspaceId -> WindowSet -> WindowSet +copy n s | Just w <- peek s = copyWindow w n s + | otherwise = s + +-- | copyWindow. Copy a window to a new workspace +copyWindow :: Window -> WorkspaceId -> WindowSet -> WindowSet +copyWindow w n = copy' + where copy' s = if n `tagMember` s + then view (tag (workspace (current s))) $ insertUp' w $ view n s + else s + insertUp' a s = modify (Just $ Stack a [] []) + (\(Stack t l r) -> if a `elem` t:l++r + then Just $ Stack t l r + else Just $ Stack a (L.delete a l) (L.delete a (t:r))) s + + +-- | Remove the focused 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 + where delete'' w = modify Nothing (filter (/= w)) diff --git a/XMonad/Actions/CycleWS.hs b/XMonad/Actions/CycleWS.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/CycleWS.hs @@ -0,0 +1,94 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.CycleWS +-- Copyright : (c) Joachim Breitner , +-- Nelson Elhage (`toggleWS' function) +-- 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 XMonad.Actions.CycleWS ( + -- * Usage + -- $usage + nextWS, + prevWS, + shiftToNext, + shiftToPrev, + toggleWS, + ) where + +import Data.List ( sortBy, findIndex ) +import Data.Maybe ( fromMaybe ) +import Data.Ord ( comparing ) + +import XMonad hiding (workspaces) +import qualified XMonad (workspaces) +import XMonad.StackSet hiding (filter) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Actions.CycleWS +-- +-- > , ((modMask x, xK_Right), nextWS) +-- > , ((modMask x, xK_Left), prevWS) +-- > , ((modMask x .|. shiftMask, xK_Right), shiftToNext) +-- > , ((modMask x .|. shiftMask, xK_Left), shiftToPrev) +-- > , ((modMask x, xK_t), toggleWS) +-- +-- If you want to follow the moved window, you can use both actions: +-- +-- > , ((modMask x .|. shiftMask, xK_Right), shiftToNext >> nextWS) +-- > , ((modMask x .|. shiftMask, xK_Left), shiftToPrev >> prevWS) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + + +-- | Switch to next workspace +nextWS :: X () +nextWS = switchWorkspace 1 + +-- | Switch to previous workspace +prevWS :: X () +prevWS = switchWorkspace (-1) + +-- | Move focused window to next workspace +shiftToNext :: X () +shiftToNext = shiftBy 1 + +-- | Move focused window to previous workspace +shiftToPrev :: X () +shiftToPrev = shiftBy (-1) + +-- | Toggle to the workspace displayed previously +toggleWS :: X () +toggleWS = windows $ view =<< tag . head . hidden + +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 + spaces <- asks (XMonad.workspaces . config) + let orderedWs = sortBy (comparing (wsIndex spaces)) (workspaces ws) + let now = fromMaybe 0 $ findWsIndex (workspace (current ws)) orderedWs + let next = orderedWs !! ((now + d) `mod` length orderedWs) + return $ tag next + +wsIndex :: [WorkspaceId] -> WindowSpace -> Maybe Int +wsIndex spaces ws = findIndex (== tag ws) spaces + +findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int +findWsIndex ws wss = findIndex ((== tag ws) . tag) wss diff --git a/XMonad/Actions/DeManage.hs b/XMonad/Actions/DeManage.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/DeManage.hs @@ -0,0 +1,56 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.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 +-- 'XMonad.Core.XConfig.defaultGaps' +-- +-- * Launch the panel +-- +-- * Give the panel window focus, then press @mod-d@ (or whatever key +-- you have bound 'demanage' to) +-- +-- * Convince the panel to move\/resize to the correct location. Changing the +-- panel's position setting several times seems to work. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.DeManage ( + -- * Usage + -- $usage + demanage + ) where + +import qualified XMonad.StackSet as W +import XMonad + +-- $usage +-- To use demanage, add this import to your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.DeManage +-- +-- And add a keybinding, such as: +-- +-- > , ((modMask x, xK_d ), withFocused demanage) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Stop managing the currently focused window. +demanage :: Window -> X () +demanage w = do + -- use modify to defeat automatic 'unmanage' calls. + modify (\s -> s { windowset = W.delete w (windowset s) }) + refresh diff --git a/XMonad/Actions/DwmPromote.hs b/XMonad/Actions/DwmPromote.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/DwmPromote.hs @@ -0,0 +1,49 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.DwmPromote +-- Copyright : (c) Miikka Koskinen 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : arcatan@kapsi.fi +-- Stability : unstable +-- Portability : unportable +-- +-- Dwm-like swap function for xmonad. +-- +-- Swaps focused window with the master window. If focus is in the +-- master, swap it with the next window in the stack. Focus stays in the +-- master. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.DwmPromote ( + -- * Usage + -- $usage + dwmpromote + ) where + +import XMonad +import XMonad.StackSet + +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.DwmPromote +-- +-- then add a keybinding or substitute 'dwmpromote' in place of promote: +-- +-- > , ((modMask x, xK_Return), dwmpromote) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Swap the focused window with the master window. If focus is in +-- the master, swap it with the next window in the stack. Focus +-- stays in the master. +dwmpromote :: X () +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 diff --git a/XMonad/Actions/DynamicWorkspaces.hs b/XMonad/Actions/DynamicWorkspaces.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/DynamicWorkspaces.hs @@ -0,0 +1,127 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.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 XMonad.Actions.DynamicWorkspaces ( + -- * Usage + -- $usage + addWorkspace, removeWorkspace, + withWorkspace, + selectWorkspace, renameWorkspace, + toNthWorkspace, withNthWorkspace + ) where + +import Data.List ( sort ) + +import XMonad hiding (workspaces) +import XMonad.StackSet hiding (filter, modify, delete) +import XMonad.Prompt.Workspace +import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) ) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Actions.DynamicWorkspaces +-- +-- Then add keybindings like the following: +-- +-- > , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace) +-- > , ((modMask x .|. shiftMask, xK_v ), selectWorkspace defaultXPConfig) +-- > , ((modMask x, xK_m ), withWorkspace defaultXPConfig (windows . W.shift)) +-- > , ((modMask x .|. shiftMask, xK_m ), withWorkspace defaultXPConfig (windows . copy)) +-- > , ((modMask x .|. shiftMask, xK_r ), renameWorkspace defaultXPConfig) +-- +-- > -- mod-[1..9] %! Switch to workspace N +-- > -- mod-shift-[1..9] %! Move client to workspace N +-- > ++ +-- > zip (zip (repeat (modMask x)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..]) +-- > ++ +-- > zip (zip (repeat (modMask x .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..]) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + + +data Wor = Wor String + +instance XPrompt Wor where + showXPrompt (Wor x) = x + +mkCompl :: [String] -> String -> IO [String] +mkCompl l s = return $ filter (\x -> take (length s) x == s) l + +withWorkspace :: XPConfig -> (String -> X ()) -> X () +withWorkspace c job = do ws <- gets (workspaces . windowset) + let ts = sort $ map tag ws + job' t | t `elem` ts = job t + | otherwise = addHiddenWorkspace t >> job t + mkXPrompt (Wor "") c (mkCompl ts) job' + +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 + +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 () + +selectWorkspace :: XPConfig -> X () +selectWorkspace conf = workspacePrompt conf $ \w -> + do s <- gets windowset + if tagMember w s + then windows $ greedyView w + else addWorkspace w + +-- | Add a new workspace with the given name. +addWorkspace :: String -> X () +addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag) + +addHiddenWorkspace :: String -> X () +addHiddenWorkspace newtag = do l <- asks (layoutHook . config) + windows (addHiddenWorkspace' newtag l) + +-- | Remove the current workspace if it contains no windows. +removeWorkspace :: X () +removeWorkspace = do s <- gets windowset + case s of + StackSet { current = Screen { workspace = torem } + , hidden = (w:_) } + -> do windows $ view (tag w) + windows (removeWorkspace' (tag torem)) + _ -> return () + +addHiddenWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd +addHiddenWorkspace' newtag l s@(StackSet { hidden = ws }) = s { hidden = Workspace newtag l Nothing:ws } + +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 }) + , hidden = (w:ws) }) + | tag w == torem = s { current = scr { workspace = wc { stack = meld (stack w) (stack wc) } } + , 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) +removeWorkspace' _ s = s diff --git a/XMonad/Actions/FindEmptyWorkspace.hs b/XMonad/Actions/FindEmptyWorkspace.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/FindEmptyWorkspace.hs @@ -0,0 +1,67 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.FindEmptyWorkspace +-- Copyright : (c) Miikka Koskinen 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : arcatan@kapsi.fi +-- Stability : unstable +-- Portability : unportable +-- +-- Find an empty workspace. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.FindEmptyWorkspace ( + -- * Usage + -- $usage + viewEmptyWorkspace, tagToEmptyWorkspace + ) where + +import Data.List +import Data.Maybe ( isNothing ) + +import XMonad +import XMonad.StackSet + +-- $usage +-- +-- To use, import this module into your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.FindEmptyWorkspace +-- +-- and add the desired keybindings, for example: +-- +-- > , ((modMask x, xK_m ), viewEmptyWorkspace) +-- > , ((modMask x .|. shiftMask, xK_m ), tagToEmptyWorkspace) +-- +-- Now you can jump to an empty workspace with @mod-m@. @Mod-shift-m@ +-- will tag the current window to an empty workspace and view it. +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | 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 l a s sd -> Maybe (Workspace i l a) +findEmptyWorkspace = find (isNothing . stack) . allWorkspaces + where + allWorkspaces ss = (workspace . current) ss : + (map workspace . visible) ss ++ hidden ss + +withEmptyWorkspace :: (WorkspaceId -> X ()) -> X () +withEmptyWorkspace f = do + ws <- gets windowset + whenJust (findEmptyWorkspace ws) (f . tag) + +-- | Find and view an empty workspace. Do nothing if all workspaces are +-- in use. +viewEmptyWorkspace :: X () +viewEmptyWorkspace = withEmptyWorkspace (windows . view) + +-- | Tag current window to an empty workspace and view it. Do nothing if +-- all workspaces are in use. +tagToEmptyWorkspace :: X () +tagToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ view w . shift w diff --git a/XMonad/Actions/FlexibleManipulate.hs b/XMonad/Actions/FlexibleManipulate.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/FlexibleManipulate.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.FlexibleManipulate +-- Copyright : (c) Michael Sloan +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Move and resize floating windows without warping the mouse. +-- +----------------------------------------------------------------------------- + +-- Based on the FlexibleResize code by Lukas Mai (mauke). + +module XMonad.Actions.FlexibleManipulate ( + -- * Usage + -- $usage + mouseWindow, discrete, linear, resize, position +) where + +import XMonad + +-- $usage +-- First, add this import to your @~\/.xmonad\/xmonad.hs@: +-- +-- > import qualified XMonad.Actions.FlexibleManipulate as Flex +-- +-- Now set up the desired mouse binding, for example: +-- +-- > , ((modMask x, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w)) +-- +-- * Flex.'linear' indicates that positions between the edges and the +-- middle indicate a combination scale\/position. +-- +-- * Flex.'discrete' indicates that there are discrete pick +-- regions. (The window is divided by thirds for each axis.) +-- +-- * Flex.'resize' performs only a resize of the window, based on which +-- quadrant the mouse is in. +-- +-- * Flex.'position' is similar to the built-in +-- 'XMonad.Operations.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. +-- +-- For detailed instructions on editing your mouse bindings, see +-- "XMonad.Doc.Extending#Editing_mouse_bindings". + +discrete, linear, resize, position :: Double -> Double + +-- | Manipulate the window based on discrete pick regions; the window +-- is divided into regions by thirds along each axis. +discrete x | x < 0.33 = 0 + | x > 0.66 = 1 + | otherwise = 0.5 + +-- | Scale\/reposition the window by factors obtained from the mouse +-- position by linear interpolation. Dragging precisely on a corner +-- resizes that corner; dragging precisely in the middle moves the +-- window without resizing; anything else is an interpolation +-- between the two. +linear = id + +-- | Only resize the window, based on the window quadrant the mouse is in. +resize x = if x < 0.5 then 0 else 1 + +-- | Only reposition the window. +position = const 0.5 + +-- | Given an interpolation function, implement an appropriate window +-- manipulation action. +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 -> io $ 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 :: Double -> Integer) (nbr - ntl) + moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth + return ()) + (float w) + + 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 diff --git a/XMonad/Actions/FlexibleResize.hs b/XMonad/Actions/FlexibleResize.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/FlexibleResize.hs @@ -0,0 +1,67 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.FlexibleResize +-- Copyright : (c) Lukas Mai +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Resize floating windows from any corner. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.FlexibleResize ( + -- * Usage + -- $usage + XMonad.Actions.FlexibleResize.mouseResizeWindow +) where + +import XMonad +import Foreign.C.Types + +-- $usage +-- To use, first import this module into your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import qualified XMonad.Actions.FlexibleResize as Flex +-- +-- Then add an appropriate mouse binding: +-- +-- > , ((modMask x, button3), (\w -> focus w >> Flex.mouseResizeWindow w)) +-- +-- For detailed instructions on editing your mouse bindings, see +-- "XMonad.Doc.Extending#Editing_mouse_bindings". + +-- | Resize a floating window from whichever corner the mouse is +-- closest to. +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' <- io $ getWindowAttributes d w + let [px, py] = map (fromIntegral . ($ wa')) [wa_x, wa_y] + io $ moveResizeWindow d w (fx px (fromIntegral ex)) + (fy py (fromIntegral ey)) + `uncurry` applySizeHints sh (gx $ fromIntegral ex, gy $ fromIntegral 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 -> Position) + mkSel b k p = + if b + then (0, csnd, ((k + p) -) . fromIntegral) + else (k, cfst, subtract p . fromIntegral) diff --git a/XMonad/Actions/FloatKeys.hs b/XMonad/Actions/FloatKeys.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/FloatKeys.hs @@ -0,0 +1,121 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.FloatKeys +-- Copyright : (c) Karsten Schoelzel +-- License : BSD +-- +-- Maintainer : Karsten Schoelzel +-- Stability : unstable +-- Portability : unportable +-- +-- Move and resize floating windows. +----------------------------------------------------------------------------- + +module XMonad.Actions.FloatKeys ( + -- * Usage + -- $usage + keysMoveWindow, + keysMoveWindowTo, + keysResizeWindow, + keysAbsResizeWindow) where + +import XMonad + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.FloatKeys +-- +-- Then add appropriate key bindings, for example: +-- +-- > , ((modMask x, xK_d ), withFocused (keysResizeWindow (-10,-10) (1,1))) +-- > , ((modMask x, xK_s ), withFocused (keysResizeWindow (10,10) (1,1))) +-- > , ((modMask x .|. shiftMask, xK_d ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752))) +-- > , ((modMask x .|. shiftMask, xK_s ), withFocused (keysAbsResizeWindow (10,10) (1024,752))) +-- > , ((modMask x, xK_a ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2))) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the +-- right and @dy@ pixels down. +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 (x, y) (gx, gy)@ moves the window relative +-- point @(gx, gy)@ to the point @(x,y)@, where @(gx,gy)@ gives a +-- position relative to the window border, i.e. @gx = 0@ is the left +-- border, @gx = 1@ is the right border, @gy = 0@ is the top border, and +-- @gy = 1@ the bottom border. +-- +-- For example, on a 1024x768 screen: +-- +-- > keysMoveWindowTo (512,384) (1%2, 1%2) -- center the window on screen +-- > keysMoveWindowTo (1024,0) (1, 0) -- put window in the top right corner +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 (dx, dy) (gx, gy)@ changes the width by @dx@ +-- and the height by @dy@, leaving the window-relative point @(gx, +-- gy)@ fixed. +-- +-- For example: +-- +-- > keysResizeWindow (10, 0) (0, 0) -- make the window 10 pixels larger to the right +-- > keysResizeWindow (10, 0) (0, 1%2) -- does the same, unless sizeHints are applied +-- > keysResizeWindow (10, 10) (1%2, 1%2) -- add 5 pixels on each side +-- > keysResizeWindow (-10, -10) (0, 1) -- shrink the window in direction of the bottom-left corner +keysResizeWindow :: D -> G -> Window -> X () +keysResizeWindow = keysMoveResize keysResizeWindow' + +-- | @keysAbsResizeWindow (dx, dy) (ax, ay)@ changes the width by @dx@ +-- and the height by @dy@, leaving the screen absolute point @(ax, +-- ay)@ fixed. +-- +-- For example: +-- +-- > keysAbsResizeWindow (10, 10) (0, 0) -- enlarge the window; if it is not in the top-left corner it will also be moved down and to the right. +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 + nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w + ny :: Rational + ny = 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 + diff --git a/XMonad/Actions/FocusNth.hs b/XMonad/Actions/FocusNth.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/FocusNth.hs @@ -0,0 +1,49 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.FocusNth +-- Copyright : (c) Karsten Schoelzel +-- License : BSD +-- +-- Maintainer : Karsten Schoelzel +-- Stability : unstable +-- Portability : unportable +-- +-- Focus the nth window of the current workspace. +----------------------------------------------------------------------------- + +module XMonad.Actions.FocusNth ( + -- * Usage + -- $usage + focusNth) where + +import XMonad.StackSet +import XMonad + +-- $usage +-- Add the import to your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.FocusNth +-- +-- Then add appropriate keybindings, for example: +-- +-- > -- mod4-[1..9] @@ Switch to window N +-- > ++ [((modMask x, k), focusNth i) +-- > | (i, k) <- zip [0 .. 8] [xK_1 ..]] +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Give focus to the nth window of the current workspace. +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) + + diff --git a/XMonad/Actions/MouseGestures.hs b/XMonad/Actions/MouseGestures.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/MouseGestures.hs @@ -0,0 +1,125 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.MouseGestures +-- Copyright : (c) Lukas Mai +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Support for simple mouse gestures. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.MouseGestures ( + -- * Usage + -- $usage + Direction(..), + mouseGesture +) where + +import XMonad + +import Data.IORef +import qualified Data.Map as M +import Data.Map (Map) +import Control.Monad + +import System.IO + +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.Commands +-- > import qualified XMonad.StackSet as W +-- +-- then add an appropriate mouse binding: +-- +-- > , ((modMask x .|. shiftMask, button3), mouseGesture gestures) +-- +-- where @gestures@ is a 'Data.Map.Map' from gestures to actions on +-- windows, for example: +-- +-- > 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. +-- +-- For detailed instructions on editing your mouse bindings, see +-- "XMonad.Doc.Extending#Editing_mouse_bindings". + +-- | The four cardinal screen directions. A \"gesture\" is a sequence of +-- directions. +data Direction = L | U | R | D + deriving (Eq, Ord, Show, Read, Enum, Bounded) + +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 + +-- | Given a 'Data.Map.Map' from lists of directions to actions with +-- windows, figure out which one the user is performing, and return +-- the corresponding action. +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' diff --git a/XMonad/Actions/RotSlaves.hs b/XMonad/Actions/RotSlaves.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/RotSlaves.hs @@ -0,0 +1,62 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.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 XMonad.Actions.RotSlaves ( + -- $usage + rotSlaves', rotSlavesUp, rotSlavesDown, + rotAll', rotAllUp, rotAllDown + ) where + +import XMonad.StackSet +import XMonad + +-- $usage +-- +-- To use this module, import it with: +-- +-- > import XMonad.Actions.RotSlaves +-- +-- and add whatever keybindings you would like, for example: +-- +-- > , ((modMask x .|. shiftMask, xK_Tab ), rotSlavesUp) +-- +-- This operation will rotate all windows except the master window, +-- while the focus stays where it is. It is useful together with the +-- TwoPane layout (see "XMonad.Layout.TwoPane"). +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Rotate the windows in the current stack, excluding the first one +-- (master). +rotSlavesUp,rotSlavesDown :: X () +rotSlavesUp = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l])) +rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l))) + +-- | The actual rotation, as a pure function on the window stack. +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)) + +-- | Rotate all 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))) + +-- | The actual rotation, as a pure function on the window stack. +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)) diff --git a/XMonad/Actions/RotView.hs b/XMonad/Actions/RotView.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/RotView.hs @@ -0,0 +1,56 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.RotView +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- Provides bindings to cycle through non-empty workspaces. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.RotView ( + -- * Usage + -- $usage + rotView + ) where + +import Data.List ( sortBy, find ) +import Data.Maybe ( isJust ) +import Data.Ord ( comparing ) + +import XMonad +import XMonad.StackSet hiding (filter) + +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.RotView +-- +-- Then add appropriate key bindings, such as: +-- +-- > , ((modMask x .|. shiftMask, xK_Right), rotView True) +-- > , ((modMask x .|. shiftMask, xK_Left), rotView False) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Cycle through non-empty workspaces. True --> cycle in the forward +-- direction. Note that workspaces cycle in order by tag, so if your +-- workspaces are not in tag-order, the cycling might seem wonky. +rotView :: Bool -> X () +rotView forward = do + ws <- gets windowset + let currentTag = tag . workspace . current $ ws + sortWs = sortBy (comparing tag) + isNotEmpty = isJust . stack + sorted = sortWs (hidden ws) + pivoted = let (a,b) = span ((< currentTag) . tag) sorted in b ++ a + pivoted' | forward = pivoted + | otherwise = reverse pivoted + nextws = find isNotEmpty pivoted' + whenJust nextws (windows . view . tag) diff --git a/XMonad/Actions/SimpleDate.hs b/XMonad/Actions/SimpleDate.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/SimpleDate.hs @@ -0,0 +1,40 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.SimpleDate +-- 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. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.SimpleDate ( + -- * Usage + -- $usage + date + ) where + +import XMonad.Core +import XMonad.Util.Run + +-- $usage +-- To use, import this module into @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.SimpleDate +-- +-- and add a keybinding, for example: +-- +-- > , ((modMask x, xK_d ), date) +-- +-- In this example, a popup date menu will now be bound to @mod-d@. +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +date :: X () +date = unsafeSpawn "(date; sleep 10) | dzen2" diff --git a/XMonad/Actions/SinkAll.hs b/XMonad/Actions/SinkAll.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/SinkAll.hs @@ -0,0 +1,40 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Xmonad.Actions.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 XMonad.Actions.SinkAll ( + -- * Usage + -- $usage + sinkAll) where + +import XMonad +import XMonad.StackSet + +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.SinkAll +-- +-- then add a keybinding; for example: +-- +-- , ((modMask x .|. shiftMask, xK_t), sinkAll) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Un-float all floating windows on the current workspace. +sinkAll :: X () +sinkAll = withAll sink + +-- | Apply a function to all windows on current workspace. +withAll :: (Window -> WindowSet -> WindowSet) -> X () +withAll f = windows $ \ws -> let all' = integrate' . stack . workspace . current $ ws + in foldr f ws all' diff --git a/XMonad/Actions/Submap.hs b/XMonad/Actions/Submap.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/Submap.hs @@ -0,0 +1,76 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.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 key bindings. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.Submap ( + -- * Usage + -- $usage + submap + ) where + +import XMonad hiding (keys) +import qualified Data.Map as M +import Control.Monad.Fix (fix) + +{- $usage + + + + +First, import this module into your @~\/.xmonad\/xmonad.hs@: + +> import XMonad.Actions.Submap + +Allows you to create a sub-mapping of keys. Example: + +> , ((modMask x, 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. + +For detailed instructions on editing your key bindings, see +"XMonad.Doc.Extending#Editing_key_bindings". + +-} + +-- | Given a 'Data.Map.Map' from key bindings to X () actions, return +-- an action which waits for a user keypress and executes the +-- corresponding action, or does nothing if the key is not found in +-- the map. +submap :: M.Map (KeyMask, KeySym) (X ()) -> X () +submap keys = do + XConf { theRoot = root, display = d } <- ask + + io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime + + (m, s) <- 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 (m, keysym) + + io $ ungrabKeyboard d currentTime + + m' <- cleanMask m + whenJust (M.lookup (m', s) keys) id diff --git a/XMonad/Actions/SwapWorkspaces.hs b/XMonad/Actions/SwapWorkspaces.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/SwapWorkspaces.hs @@ -0,0 +1,54 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.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. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.SwapWorkspaces ( + -- * Usage + -- $usage + swapWithCurrent, + swapWorkspaces + ) where + +import XMonad.StackSet + + +-- $usage +-- Add this import to your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.SwapWorkspaces +-- +-- Then throw something like this in your keys definition: +-- +-- > ++ +-- > [((modMask x .|. controlMask, k), windows $ swapWithCurrent i) +-- > | (i, k) <- zip workspaces [xK_1 ..]] +-- +-- After installing this update, if you're on workspace 1, hitting mod-ctrl-5 +-- will swap workspaces 1 and 5. +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Swaps the currently focused workspace with the given workspace tag, via +-- @swapWorkspaces@. +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 + +-- | Takes two workspace tags and an existing XMonad.StackSet and returns a new +-- one with the two corresponding workspaces' tags swapped. +swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd +swapWorkspaces t1 t2 = mapWorkspace swap + where swap w = if tag w == t1 then w { tag = t2 } + else if tag w == t2 then w { tag = t1 } + else w diff --git a/XMonad/Actions/TagWindows.hs b/XMonad/Actions/TagWindows.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/TagWindows.hs @@ -0,0 +1,201 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.TagWindows +-- Copyright : (c) Karsten Schoelzel +-- License : BSD +-- +-- Maintainer : Karsten Schoelzel +-- Stability : unstable +-- Portability : unportable +-- +-- Functions for tagging windows and selecting them by tags. +----------------------------------------------------------------------------- + +module XMonad.Actions.TagWindows ( + -- * Usage + -- $usage + addTag, delTag, unTag, + setTags, getTags, hasTag, + withTaggedP, withTaggedGlobalP, withFocusedP, + withTagged , withTaggedGlobal , + focusUpTagged, focusUpTaggedGlobal, + focusDownTagged, focusDownTaggedGlobal, + shiftHere, shiftToScreen, + tagPrompt, + tagDelPrompt + ) where + +import Data.List (nub,concat,sortBy) +import Control.Monad + +import XMonad.StackSet hiding (filter) + +import XMonad.Prompt +import XMonad hiding (workspaces) + +-- $usage +-- +-- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.TagWindows +-- > import XMonad.Prompt -- to use tagPrompt +-- +-- and add keybindings such as the following: +-- +-- > , ((modMask x, xK_f ), withFocused (addTag "abc")) +-- > , ((modMask x .|. controlMask, xK_f ), withFocused (delTag "abc")) +-- > , ((modMask x .|. shiftMask, xK_f ), withTaggedGlobal "abc" sink) +-- > , ((modMask x, xK_d ), withTaggedP "abc" (shiftWin "2")) +-- > , ((modMask x .|. shiftMask, xK_d ), withTaggedGlobalP "abc" shiftHere) +-- > , ((modMask x .|. controlMask, xK_d ), focusUpTaggedGlobal "abc") +-- > , ((modMask x, xK_g ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s))) +-- > , ((modMask x .|. controlMask, xK_g ), tagDelPrompt defaultXPConfig) +-- > , ((modMask x .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float)) +-- > , ((modWinMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedP s (shiftWin "2"))) +-- > , ((modWinMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere)) +-- > , ((modWinMask .|. controlMask, xK_g ), tagPrompt defaultXPConfig (\s -> focusUpTaggedGlobal s)) +-- +-- NOTE: Tags are saved as space separated strings and split with +-- 'unwords'. Thus if you add a tag \"a b\" the window will have +-- the tags \"a\" and \"b\" but not \"a b\". +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | 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`) `fmap` 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 diff --git a/XMonad/Actions/Warp.hs b/XMonad/Actions/Warp.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/Warp.hs @@ -0,0 +1,71 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.Warp +-- Copyright : (c) daniel@wagner-home.com +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : daniel@wagner-home.com +-- Stability : unstable +-- Portability : unportable +-- +-- Warp the pointer to a given window or screen. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.Warp ( + -- * Usage + -- $usage + warpToScreen, + warpToWindow + ) where + +import Data.Ratio +import Data.List +import XMonad +import XMonad.StackSet as W + +{- $usage +You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: + +> import XMonad.Actions.Warp + +then add appropriate keybindings to warp the pointer; for example: + +> , ((modMask x, 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 x .|. 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. +-} + +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +fraction :: (Integral a, Integral b) => Rational -> a -> b +fraction f x = floor (f * fromIntegral x) + +warp :: Window -> Position -> Position -> X () +warp w x y = withDisplay $ \d -> io $ warpPointer d none w 0 0 0 0 x y + +-- | Warp the pointer to a given position relative to the currently +-- focused window. Top left = (0,0), bottom right = (1,1). +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)) + +-- | Warp the pointer to the given position (top left = (0,0), bottom +-- right = (1,1)) on the given screen. +warpToScreen :: ScreenId -> Rational -> Rational -> X () +warpToScreen n h v = do + 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)) diff --git a/XMonad/Actions/WindowBringer.hs b/XMonad/Actions/WindowBringer.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/WindowBringer.hs @@ -0,0 +1,81 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.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. +-- That is to say, it pops up a dmenu with window names, in case you forgot +-- where you left your XChat. +-- +----------------------------------------------------------------------------- + +module XMonad.Actions.WindowBringer ( + -- * Usage + -- $usage + gotoMenu, bringMenu, windowMapWith + ) where + +import Data.Char (toLower) +import qualified Data.Map as M + +import qualified XMonad.StackSet as W +import XMonad +import qualified XMonad as X +import XMonad.Util.Dmenu (dmenuMap) +import XMonad.Util.NamedWindows (getName) + +-- $usage +-- +-- Import the module into your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Actions.WindowBringer +-- +-- and define appropriate key bindings: +-- +-- > , ((modMask x .|. shiftMask, xK_g ), gotoMenu) +-- > , ((modMask x .|. shiftMask, xK_b ), bringMenu) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + + +-- | Pops open a dmenu with window titles. Choose one, and you will be +-- taken to the corresponding workspace. +gotoMenu :: X () +gotoMenu = workspaceMap >>= actionMenu (windows . W.greedyView) + where workspaceMap = windowMapWith (W.tag . fst) + +-- | 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. +windowMapWith :: ((X.WindowSpace, Window) -> a) -> X (M.Map String a) +windowMapWith value = do -- TODO: extract the pure, creamy center. + 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 (,) (value (ws, w)) `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 ++ "]" diff --git a/XMonad/Actions/WmiiActions.hs b/XMonad/Actions/WmiiActions.hs new file mode 100644 --- /dev/null +++ b/XMonad/Actions/WmiiActions.hs @@ -0,0 +1,106 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.WmiiActions +-- Copyright : (c) Juraj Hercek +-- License : BSD3 +-- +-- Maintainer : Juraj Hercek +-- Stability : unstable +-- Portability : unportable +-- +-- Provides \"actions\" as in the Wmii window manager +-- (). It also provides a slightly better +-- interface for running dmenu on xinerama screens. If you want to use +-- xinerama functions, you have to apply the following patch (see the +-- "XMonad.Util.Dmenu" module): +-- . Don't +-- forget to recompile dmenu afterwards ;-). +----------------------------------------------------------------------------- + +module XMonad.Actions.WmiiActions ( + -- * Usage + -- $usage + wmiiActions + , wmiiActionsXinerama + , executables + , executablesXinerama + ) where + +import XMonad +import XMonad.Util.Dmenu (dmenu, dmenuXinerama) +import XMonad.Util.Run (runProcessWithInput) + +import Control.Monad (filterM, liftM, liftM2) +import System.Directory (getDirectoryContents, doesFileExist, getPermissions, executable) + +-- $usage +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Actions.WmiiActions +-- +-- and add something like the following to your key bindings: +-- +-- > ,((modMask x, xK_a), wmiiActions "/home/joe/.wmii-3.5/") +-- +-- or, if you are using xinerama, you can use +-- +-- > ,((modMask x, xK_a), wmiiActionsXinerama "/home/joe/.wmii-3.5/") +-- +-- However, make sure you also have the xinerama build of dmenu (for more +-- information see the "XMonad.Util.Dmenu" extension). +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | The 'wmiiActions' function takes the file path as a first argument and +-- executes dmenu with all the executables found in the provided path. +wmiiActions :: FilePath -> X () +wmiiActions path = + wmiiActionsDmenu path dmenu + +-- | The 'wmiiActionsXinerama' does the same as 'wmiiActions', but it shows +-- dmenu only on the currently focused workspace. +wmiiActionsXinerama :: FilePath -> X () +wmiiActionsXinerama path = + wmiiActionsDmenu path dmenuXinerama + +wmiiActionsDmenu :: FilePath -> ([String] -> X String) -> X () +wmiiActionsDmenu path dmenuBrand = + let path' = path ++ "/" in + getExecutableFileList path' >>= dmenuBrand >>= spawn . (path' ++) + +getExecutableFileList :: FilePath -> X [String] +getExecutableFileList path = + io $ getDirectoryContents path >>= + filterM (\x -> let x' = path ++ x in + liftM2 (&&) + (doesFileExist x') + (liftM executable (getPermissions x'))) + +{- +getExecutableFileList :: FilePath -> X [String] +getExecutableFileList path = + io $ getDirectoryContents path >>= + filterM (doesFileExist . (path ++)) >>= + filterM (liftM executable . getPermissions . (path ++)) +-} + +-- | The 'executables' function runs the dmenu_path script, providing list of +-- executable files accessible from the $PATH variable. +executables :: X () +executables = executablesDmenu dmenu + +-- | The 'executablesXinerama' function does the same as the +-- 'executables' function, but on the workspace which currently has focus. +executablesXinerama :: X () +executablesXinerama = executablesDmenu dmenuXinerama + +executablesDmenu :: ([String] -> X String) -> X () +executablesDmenu dmenuBrand = + getExecutablesList >>= dmenuBrand >>= spawn + +getExecutablesList :: X [String] +getExecutablesList = + io $ liftM lines $ runProcessWithInput "dmenu_path" [] "" + diff --git a/XMonad/Config/Arossato.hs b/XMonad/Config/Arossato.hs new file mode 100644 --- /dev/null +++ b/XMonad/Config/Arossato.hs @@ -0,0 +1,163 @@ +{-# OPTIONS_GHC -fglasgow-exts -fno-warn-missing-signatures #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Config.Arossato +-- Copyright : (c) Andrea Rossato 2007 +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : stable +-- Portability : portable +-- +-- This module specifies my xmonad defaults. +-- +------------------------------------------------------------------------ + +module XMonad.Config.Arossato + ( -- * Usage + -- $usage + arossatoConfig + , arossatoTabbedConfig + ) where + +import qualified Data.Map as M + +import XMonad +import XMonad.ManageHook +import qualified XMonad.StackSet as W + +import XMonad.Actions.CycleWS +import XMonad.Hooks.DynamicLog +import XMonad.Layout.Accordion +import XMonad.Layout.Magnifier +import XMonad.Layout.NoBorders +import XMonad.Layout.Tabbed +import XMonad.Prompt +import XMonad.Prompt.Shell +import XMonad.Prompt.Ssh +import XMonad.Prompt.Window +import XMonad.Prompt.XMonad + +-- $usage +-- The simplest way to use this configuration module is to use an +-- @~\/.xmonad\/xmonad.hs@ like this: +-- +-- > module Main (main) where +-- > +-- > import XMonad +-- > import XMonad.Config.Arossato (arossatoConfig) +-- > +-- > main :: IO () +-- > main = xmonad arossatoConfig +-- +-- +-- You can use this module also as a starting point for writing your +-- own configuration module from scratch. Save it as your +-- @~\/.xmonad\/xmonad.hs@ and: +-- +-- 1. Change the module name from +-- +-- > module XMonad.Config.Arossato +-- > ( -- * Usage +-- > -- $usage +-- > arossatoConfig +-- > , arossatoTabbedConfig +-- > ) where +-- +-- to +-- +-- > module Main where +-- +-- 2. Add a line like: +-- +-- > main = xmonad arossatoConfig +-- +-- 3. Start playing with the configuration options...;) + +-- | My configuration for the Tabbed Layout. Basically this is the +-- Ion3 clean style. +arossatoTabbedConfig :: TConf +arossatoTabbedConfig = + defaultTConf { activeColor = "#8a999e" + , inactiveColor = "#545d75" + , activeBorderColor = "white" + , inactiveBorderColor = "grey" + , activeTextColor = "white" + , inactiveTextColor = "grey" + , tabSize = 15 + } + +arossatoConfig = defaultConfig + { workspaces = ["home","var","dev","mail","web","doc"] ++ + map show [7 .. 9 :: Int] + , logHook = dynamicLogXmobar + , manageHook = newManageHook + , layoutHook = noBorders mytab ||| + magnifier tiled ||| + noBorders Full ||| + tiled ||| + Mirror tiled ||| + Accordion + , terminal = "urxvt +sb" + , normalBorderColor = "white" + , focusedBorderColor = "black" + , keys = newKeys + , defaultGaps = [(15,0,0,0)] + } + where + -- layouts + mytab = tabbed shrinkText arossatoTabbedConfig + tiled = Tall 1 (3/100) (1/2) + + -- manageHook + myManageHook = composeAll [ resource =? "realplay.bin" --> doFloat + , resource =? "win" --> doF (W.shift "doc") -- xpdf + , resource =? "firefox-bin" --> doF (W.shift "web") + ] + newManageHook = myManageHook <+> manageHook defaultConfig + + -- key bindings stuff + defKeys = keys defaultConfig + delKeys x = foldr M.delete (defKeys x) (toRemove x) + newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x) + -- remove some of the default key bindings + toRemove x = + [ (modMask x , xK_j) + , (modMask x , xK_k) + , (modMask x , xK_p) + , (modMask x .|. shiftMask, xK_p) + , (modMask x .|. shiftMask, xK_q) + , (modMask x , xK_q) + ] ++ + -- I want modMask .|. shiftMask 1-9 to be free! + [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]] + -- These are my personal key bindings + toAdd x = + [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) + , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) + , ((modMask x , xK_F4 ), sshPrompt defaultXPConfig ) + , ((modMask x , xK_F5 ), windowPromptGoto defaultXPConfig ) + , ((modMask x , xK_F6 ), windowPromptBring defaultXPConfig ) + , ((modMask x , xK_comma ), prevWS ) + , ((modMask x , xK_period), nextWS ) + , ((modMask x , xK_Right ), windows W.focusDown ) + , ((modMask x , xK_Left ), windows W.focusUp ) + -- other stuff: launch some useful utilities + , ((modMask x , xK_F2 ), spawn "urxvt -fg white -bg black +sb" ) + , ((modMask x .|. shiftMask, xK_F4 ), spawn "~/bin/dict.sh" ) + , ((modMask x .|. shiftMask, xK_F5 ), spawn "~/bin/urlOpen.sh" ) + , ((modMask x .|. shiftMask, xK_t ), spawn "~/bin/teaTime.sh" ) + , ((modMask x , xK_c ), kill ) + , ((modMask x .|. shiftMask, xK_comma ), sendMessage (IncMasterN 1 ) ) + , ((modMask x .|. shiftMask, xK_period), sendMessage (IncMasterN (-1)) ) + -- commands fo the Magnifier layout + , ((modMask x .|. controlMask , xK_plus ), sendMessage MagnifyMore) + , ((modMask x .|. controlMask , xK_minus), sendMessage MagnifyLess) + , ((modMask x .|. controlMask , xK_o ), sendMessage ToggleOff ) + , ((modMask x .|. controlMask .|. shiftMask, xK_o ), sendMessage ToggleOn ) + ] ++ + -- Use modMask .|. shiftMask .|. controlMask 1-9 instead + [( (m .|. modMask x, k), windows $ f i) + | (i, k) <- zip (workspaces x) [xK_1 .. xK_9] + , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)] + ] diff --git a/XMonad/Config/Dons.hs b/XMonad/Config/Dons.hs new file mode 100644 --- /dev/null +++ b/XMonad/Config/Dons.hs @@ -0,0 +1,24 @@ +-------------------------------------------------------------------- +-- | +-- Module : XMonad.Config.Dons +-- Copyright : (c) Galois, Inc. 2007 +-- License : BSD3 +-- +-- Maintainer: Don Stewart +-- +-- An example, simple configuration file. +-- +-------------------------------------------------------------------- + +module XMonad.Config.Dons where + +import XMonad +import XMonad.Hooks.DynamicLog + +donsMain :: IO () +donsMain = dzen $ \conf -> xmonad $ conf + { borderWidth = 2 + , terminal = "term" + , normalBorderColor = "#cccccc" + , focusedBorderColor = "#cd8b00" } + diff --git a/XMonad/Config/Droundy.hs b/XMonad/Config/Droundy.hs new file mode 100644 --- /dev/null +++ b/XMonad/Config/Droundy.hs @@ -0,0 +1,188 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures -fglasgow-exts -fno-warn-orphans #-} +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) Spencer Janssen 2007 +-- License : BSD3-style (see LICENSE) +-- +------------------------------------------------------------------------ + +module XMonad.Config.Droundy ( config, mytab ) where + +--import Control.Monad.State ( modify ) + +import XMonad hiding (keys, config, (|||)) +import qualified XMonad (keys) +import XMonad.Config ( defaultConfig ) + +--import XMonad.Core ( windowset ) +import qualified XMonad.StackSet as W +import qualified Data.Map as M +import System.Exit + +-- % Extension-provided imports + +import XMonad.Layout.Tabbed +import XMonad.Layout.Combo +import XMonad.Layout.Mosaic +import XMonad.Layout.Named +import XMonad.Layout.LayoutCombinators +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.Layout +import XMonad.Prompt.Shell + +import XMonad.Actions.CopyWindow +import XMonad.Actions.DynamicWorkspaces +import XMonad.Actions.RotView + +--import XMonad.Hooks.ManageDocks +--import XMonad.Hooks.UrgencyHook + +myXPConfig :: XPConfig +myXPConfig = defaultXPConfig {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*" + ,height=22} + + +------------------------------------------------------------------------ +-- Key bindings: + +-- | The xmonad key bindings. Add, modify or remove key bindings here. +-- +-- (The comment formatting character is used when generating the manpage) +-- +keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) +keys x = M.fromList $ + -- launching and killing programs + [ ((modMask x .|. shiftMask, xK_c ), kill1) -- %! Close the focused window + + , ((modMask x, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms + , ((modMask x .|. shiftMask, xK_space ), setLayout $ layoutHook x) -- %! Reset the layouts on the current workspace to default + + -- move focus up or down the window stack + , ((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 .|. 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 + + -- floating layer support + , ((modMask x, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling + + -- quit, or restart + , ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad + , ((modMask x , xK_Escape), broadcastMessage ReleaseResources >> restart (Just "xmonad") True) -- %! Restart xmonad + + , ((modMask x .|. shiftMask, xK_z ), + layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768])) + , ((modMask x .|. shiftMask .|. controlMask, xK_z), + layoutScreens 1 (fixedLayout [Rectangle 0 0 1440 900])) + , ((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) + + , ((0, xK_F2 ), spawn "gnome-terminal") -- %! Launch gnome-terminal + , ((0, xK_F3 ), shellPrompt myXPConfig) -- %! Launch program + , ((0, xK_F11 ), spawn "ksnapshot") -- %! Take snapshot + , ((modMask x .|. shiftMask, xK_x ), changeDir myXPConfig) + , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace) + , ((modMask x .|. shiftMask, xK_v ), selectWorkspace myXPConfig) + , ((modMask x, xK_m ), withWorkspace myXPConfig (windows . W.shift)) + , ((modMask x .|. shiftMask, xK_m ), withWorkspace myXPConfig (windows . copy)) + , ((modMask x .|. shiftMask, xK_r), renameWorkspace myXPConfig) + , ((modMask x, xK_l ), layoutPrompt myXPConfig) + , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout) + +-- keybindings for Mosaic: + , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow)) + , ((controlMask .|. modMask x .|. shiftMask, xK_l), withFocused (sendMessage . wideWindow)) + , ((modMask x .|. shiftMask, xK_h ), withFocused (sendMessage . shrinkWindow)) + , ((modMask x .|. shiftMask, xK_l ), withFocused (sendMessage . expandWindow)) + , ((modMask x .|. shiftMask, xK_s ), withFocused (sendMessage . squareWindow)) + , ((modMask x .|. shiftMask, xK_o ), withFocused (sendMessage . myclearWindow)) + , ((controlMask .|. modMask x .|. shiftMask, xK_o ), withFocused (sendMessage . flexibleWindow)) + + ] + + ++ + zip (zip (repeat $ modMask x) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..]) + ++ + zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..]) + +config = -- withUrgencyHook FocusUrgencyHook $ + defaultConfig + { borderWidth = 1 -- Width of the window border in pixels. + , XMonad.workspaces = ["1:mutt","2:iceweasel"] + , layoutHook = workspaceDir "~" $ windowNavigation $ + toggleLayouts (noBorders Full) $ -- avoidStruts $ + Named "tabbed" (noBorders mytab) ||| + Named "xclock" (mytab ****//* combineTwo Square mytab mytab) ||| + Named "widescreen" ((mytab *||* mytab) + ****//* combineTwo Square mytab mytab) -- ||| + --mosaic 0.25 0.5 + , 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 + } + +mytab = tabbed CustomShrink defaultTConf + +instance Shrinker CustomShrink where + shrinkIt shr s | Just s' <- dropFromHead " " s = shrinkIt shr s' + shrinkIt shr s | Just s' <- dropFromTail " " s = shrinkIt shr s' + shrinkIt shr s | Just s' <- dropFromTail "- Iceweasel" s = shrinkIt shr s' + shrinkIt shr s | Just s' <- dropFromTail "- KPDF" s = shrinkIt shr s' + shrinkIt shr s | Just s' <- dropFromHead "file://" s = shrinkIt shr s' + shrinkIt shr s | Just s' <- dropFromHead "http://" s = shrinkIt shr s' + shrinkIt _ s | n > 9 = s : map cut [2..(halfn-3)] ++ shrinkIt shrinkText s + where n = length s + halfn = n `div` 2 + rs = reverse s + cut x = take (halfn - x) s ++ "..." ++ reverse (take (halfn-x) rs) + shrinkIt _ s = shrinkIt shrinkText s + +dropFromTail :: String -> String -> Maybe String +dropFromTail t s | drop (length s - length t) s == t = Just $ take (length s - length t) s + | otherwise = Nothing + +dropFromHead :: String -> String -> Maybe String +dropFromHead h s | take (length h) s == h = Just $ drop (length h) s + | otherwise = Nothing + +{- +data FocusUrgencyHook = FocusUrgencyHook deriving (Read, Show) + +instance UrgencyHook FocusUrgencyHook Window where + urgencyHook _ w = modify copyAndFocus + where copyAndFocus s + | Just w == W.peek (windowset s) = s + | has w $ W.stack $ W.workspace $ W.current $ windowset s = + s { windowset = until ((Just w ==) . W.peek) + W.focusUp $ windowset s } + | otherwise = + let t = W.tag $ W.workspace $ W.current $ windowset s + in s { windowset = until ((Just w ==) . W.peek) + W.focusUp $ copyWindow w t $ windowset s } + has _ Nothing = False + has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr) + +-} diff --git a/XMonad/Config/Sjanssen.hs b/XMonad/Config/Sjanssen.hs new file mode 100644 --- /dev/null +++ b/XMonad/Config/Sjanssen.hs @@ -0,0 +1,51 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +module XMonad.Config.Sjanssen (sjanssenConfig) where + +import XMonad hiding (Tall(..)) +import qualified XMonad.StackSet as W +import XMonad.Actions.CopyWindow +import XMonad.Layout.Tabbed +import XMonad.Layout.HintedTile +import XMonad.Config (defaultConfig) +import XMonad.Layout.NoBorders +import XMonad.Hooks.DynamicLog +import XMonad.Hooks.ManageDocks +import XMonad.Prompt +import XMonad.Prompt.Shell +import XMonad.Util.Run (spawnPipe) + +import qualified Data.Map as M +import System.IO (hPutStrLn) + +sjanssenConfig = do + xmobar <- spawnPipe "xmobar" + return $ defaultConfig + { terminal = "urxvt" + , workspaces = ["irc", "web"] ++ map show [3 .. 7 :: Int] ++ ["mail", "im"] + , logHook = dynamicLogWithPP $ sjanssenPP { ppOutput = hPutStrLn xmobar } + , modMask = mod4Mask + , 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)) ] + , keys = \c -> mykeys c `M.union` keys defaultConfig c + , layoutHook = avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTConf) + , manageHook = manageHook defaultConfig <+> manageDocks + } + where + tiled = HintedTile 1 0.03 0.5 + + mykeys (XConfig {modMask = modm, workspaces = ws}) = M.fromList $ + [((modm, xK_p ), shellPrompt myPromptConfig) + ,((modm .|. shiftMask, xK_c ), kill1) + ,((modm .|. shiftMask .|. controlMask, xK_c ), kill) + ,((modm .|. shiftMask, xK_0 ), windows $ \w -> foldr copy w ws) + ,((modm, xK_b ), sendMessage ToggleStruts) + ] + + myFont = "xft:Bitstream Vera Sans Mono:pixelsize=10" + myTConf = defaultTConf { fontName = myFont } + myPromptConfig = defaultXPConfig + { position = Top + , font = myFont + , promptBorderWidth = 0 } diff --git a/XMonad/Doc.hs b/XMonad/Doc.hs new file mode 100644 --- /dev/null +++ b/XMonad/Doc.hs @@ -0,0 +1,86 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Doc +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : portable +-- +-- This is the main documentation module for the xmonad-contrib +-- library. It provides a brief overview of xmonad and a link to +-- documentation for configuring and extending xmonad. +-- +-- A link to documentation describing xmonad internals is also provided. +-- This module is mainly intended for those wanting to contribute code, +-- or for those who are curious to know what's going on behind the scenes. +----------------------------------------------------------------------------- + +module XMonad.Doc + ( + -- * Overview + -- $overview + + -- * Configuring xmonad + -- $configuring + + -- * Extending xmonad with the xmonad-contrib library + -- $extending + + -- * Developing xmonad: an brief code commentary + -- $developing + + ) where + +import XMonad.Doc.Configuring () +import XMonad.Doc.Extending () +import XMonad.Doc.Developing () + +-------------------------------------------------------------------------------- +-- +-- Overview +-- +-------------------------------------------------------------------------------- + +{- $overview +#Overview# + +xmonad is a tiling window manager for X. The xmonad-contrib library +collects third party tiling algorithms, hooks, configurations, +scripts, and other extensions to xmonad. The source for this library +is available from via darcs: + +> darcs get http://code.haskell.org/XMonadContrib + +Each stable release of xmonad is accompanied by a stable release of +the contrib library, which you should use if (and only if) you're +using a stable release of xmonad. You can find the most recent +(Oct. 2007) tarball here: + + +-} + +{- $configuring + +"XMonad.Doc.Configuring" documents the process of configuring +xmonad. A brief tutorial will guide you through the basic +configuration steps. + +-} + +{- $extending + +"XMonad.Doc.Extending" is dedicated to the xmonad-contrib library +itself. You will find an overview of extensions available in the +library and instructions for using them. + +-} + +{- $developing + +"XMonad.Doc.Developing" consists of a brief description of the xmonad +internals. It is mainly intended for contributors and provides a +brief code commentary with links to the source documentation. + +-} diff --git a/XMonad/Doc/Configuring.hs b/XMonad/Doc/Configuring.hs new file mode 100644 --- /dev/null +++ b/XMonad/Doc/Configuring.hs @@ -0,0 +1,150 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Doc.Configuring +-- Copyright : (C) 2007 Don Stewart and Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : portable +-- +-- This is a brief tutorial that will teach you how to create a +-- basic xmonad configuration. +-- +-- For more detailed instructions on extending xmonad with the +-- xmonad-contrib library, see "XMonad.Doc.Extending". +-- +----------------------------------------------------------------------------- + +module XMonad.Doc.Configuring + ( + -- * Configuring xmonad + -- $configure + + -- * A simple example + -- $example + + -- * Checking whether your xmonad.hs is correct + -- $check + + -- * Loading your configuration + -- $load + + ) where + +-------------------------------------------------------------------------------- +-- +-- Configuring Xmonad +-- +-------------------------------------------------------------------------------- + +{- $configure +#Configuring_xmonad# +xmonad can be configured by creating and editing the Haskell file: + +> ~/.xmonad/xmonad.hs + +If this file does not exist, xmonad will simply use default settings; +if it does exist, xmonad will use whatever settings you specify. Note +that this file can contain arbitrary Haskell code, which means that +you have quite a lot of flexibility in configuring xmonad. + +NOTE for users of previous versions (< 0.5) of xmonad: this is a major +change in the way xmonad is configured. Prior to version 0.5, +configuring xmonad required editing an xmonad source file called +Config.hs, recompiling xmonad, and then restarting. From version 0.5 +onwards, however, all you have to do is edit xmonad.hs and restart +with @mod-q@; xmonad does the recompiling itself. The format of the +configuration file has also changed; it is now simpler and much +shorter, only requiring you to list those settings which are different +from the defaults. + +-} + +{- $example +#A_simple_example# + +Here is a basic example, which starts with the default xmonad +configuration and overrides the border width, default terminal, and +some colours: + +> -- +> -- An example, simple ~/.xmonad/xmonad.hs file. +> -- It overrides a few basic settings, reusing all the other defaults. +> -- +> +> import XMonad +> +> main = xmonad $ defaultConfig +> { borderWidth = 2 +> , terminal = "urxvt" +> , normalBorderColor = "#cccccc" +> , focusedBorderColor = "#cd8b00" } + +This will run \'xmonad\', the window manager, with your settings +passed as arguments. + +Overriding default settings like this (using \"record update +syntax\"), will yield the shortest config file, as you only have to +describe values that differ from the defaults. + +An alternative is to inline the entire default config file from +xmonad, and edit values you wish to change. This is requires more +work, but some users may find this easier. You can find the defaults +in the "XMonad.Config" module of the core xmonad library. + +However, note that (unlike previous versions of xmonad) you should not +edit Config.hs itself. + +To see what fields can be customized beyond the ones in the example +above, the definition of the 'XMonad.Core.XConfig' data structure can +be found in "XMonad.Core". + +-} + +{- $check +#Checking_whether_your_xmonad.hs_is_correct# + +After changing your configuration, it is a good idea to check that it +is syntactically and type correct. You can do this easily by loading +your configuration file in the Haskell interpreter: + +> $ ghci ~/.xmonad/xmonad.hs +> GHCi, version 6.8.1: http://www.haskell.org/ghc/ :? for help +> Loading package base ... linking ... done. +> Ok, modules loaded: Main. +> +> Prelude Main> :t main +> main :: IO () + +Ok, looks good. + +Note, however, that if you skip this step and try restarting xmonad +with errors in your xmonad.hs, it's not the end of the world; xmonad +will simply display a window showing the errors and continue with the +previous configuration settings. + +-} + +{- $load +#Loading_your_configuration# + +To get xmonad to use your new settings, type @mod-q@. xmonad will +attempt to compile this file, and run it. If everything goes well, +xmonad will seamlessly restart itself with the new settings, keeping +all your windows, layouts, etc. intact. (If you change anything +related to your layouts, you may need to hit @mod-shift-space@ after +restarting to see the changes take effect.) If something goes wrong, +the previous (default) settings will be used. Note this requires that +GHC and xmonad are in your @$PATH@. If GHC isn't in your path, you can +still compile @xmonad.hs@ yourself: + +> $ cd ~/.xmonad +> $ /path/to/ghc --make xmonad.hs +> $ ls +> xmonad xmonad.hi xmonad.hs xmonad.o + +When you hit @mod-q@, this newly compiled xmonad will be used. + +-} + diff --git a/XMonad/Doc/Developing.hs b/XMonad/Doc/Developing.hs new file mode 100644 --- /dev/null +++ b/XMonad/Doc/Developing.hs @@ -0,0 +1,270 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Doc.Developing +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : portable +-- +-- This module documents the xmonad internals. It is intended for +-- advanced users who are curious about the xmonad source code and +-- want an brief overview. This document may also be helpful for the +-- beginner\/intermediate Haskell programmer who is motivated to write +-- an xmonad extension as a way to deepen her understanding of this +-- powerful functional language; however, there is not space here to +-- go into much detail. A more comprehensive document introducing +-- beginner\/intermediate Haskell programmers to the xmonad source is +-- planned for the xmonad users' wiki +-- (). +-- +-- If you write an extension module and think it may be useful for +-- others, consider releasing it. Coding guidelines and licensing +-- policies are covered at the end of this document, and must be +-- followed if you want your code to be included in the official +-- repositories. +-- +----------------------------------------------------------------------------- + +module XMonad.Doc.Developing + ( + -- * Writing new extensions + -- $writing + + -- * Libraries for writing window managers + -- $xmonad-libs + + -- * xmonad internals + -- $internals + + -- ** The @main@ entry point + -- $main + + -- ** The X monad and the internal state + -- $internalState + + -- ** Event handling and messages + -- $events + + -- ** The 'LayoutClass' + -- $layoutClass + + -- * Coding style + -- $style + + -- * Licensing policy + -- $license + ) where + +-------------------------------------------------------------------------------- +-- +-- Writing Extensions +-- +-------------------------------------------------------------------------------- + +{- $writing +-} + +{- $xmonad-libs + +Starting with version 0.5, xmonad and xmonad-contrib are packaged and +distributed as libraries, instead of components which must be compiled +by the user into a binary (as they were prior to version 0.5). This +way of distributing xmonad has many advantages, since it allows +packaging by GNU\/Linux distributions while still allowing the user to +customize the window manager to fit her needs. + +Basically, xmonad and the xmonad-contrib libraries let users write +their own window manager in just a few lines of code. While +@~\/.xmonad\/xmonad.hs@ at first seems to be simply a configuration +file, it is actually a complete Haskell program which uses the xmonad +and xmonad-contrib libraries to create a custom window manager. + +This makes it possible not only to edit the default xmonad +configuration, as we have seen in the "XMonad.Doc.Extending" document, +but to use the Haskell programming language to extend the window +manager you are writing in any way you see fit. + +-} + +{- $internals +-} + +{- $main +#The_main_entry_point# + +xmonad installs a binary, @xmonad@, which must be executed by the +Xsession starting script. This binary, whose code can be read in +@Main.hs@ of the xmonad source tree, will use 'XMonad.Core.recompile' +to run @ghc@ in order to build a binary from @~\/.xmonad\/xmonad.hs@. +If this compilation process fails, for any reason, a default @main@ +entry point will be used, which calls the 'XMonad.Main.xmonad' +function with a default configuration. + +Thus, the real @main@ entry point, the one that even the users' custom +window manager application in @~\/.xmonad\/xmonad.hs@ must call, is +the 'XMonad.Main.xmonad' function. This function takes a configuration +as its only argument, whose type ('XMonad.Core.XConfig') +is defined in "XMonad.Core". + +'XMonad.Main.xmonad' takes care of opening the connection with the X +server, initializing the state (or deserializing it when restarted) +and the configuration, and calling the event handler +('XMonad.Main.handle') that goes into an infinite loop (using +'Prelude.forever') waiting for events and acting accordingly. + +-} + +{- $internalState + +The event loop which calls 'XMonad.Main.handle' to react to events is +run within the 'XMonad.Core.X' monad, which is a +'Control.Monad.State.StateT' transformer over 'IO', encapsulated +within a 'Control.Monad.Reader.ReaderT' transformer. The +'Control.Monad.State.StateT' transformer encapsulates the +(read\/writable) state of the window manager (of type +'XMonad.Core.XState'), whereas the 'Control.Monad.Reader.ReaderT' +transformer encapsulates the (read-only) configuration (of type +'XMonad.Core.XConf'). + +Thanks to GHC's newtype deriving feature, the instance of the +'Control.Monad.State.MonadState' class parametrized over +'XMonad.Core.XState' and the instance of the +'Control.Monad.Reader.MonadReader' class parametrized over +'XMonad.Core.XConf' are automatically derived for the 'XMonad.Core.X' +monad. This way we can use 'Control.Monad.State.get', +'Control.Monad.State.gets' and 'Control.Monad.State.modify' for the +'XMonad.Core.XState', and 'Control.Monad.Reader.ask' and +'Control.Monad.Reader.asks' for reading the 'XMonad.Core.XConf'. + +'XMonad.Core.XState' is where all the sensitive information about +window management is stored. The most important field of the +'XMonad.Core.XState' is the 'XMonad.Core.windowset', whose type +('XMonad.Core.WindowSet') is a synonym for a +'XMonad.StackSet.StackSet' parametrized over a +'XMonad.Core.WorkspaceID' (a 'String'), a layout type wrapped inside +the 'XMonad.Layout.Layout' existential data type, the +'Graphics.X11.Types.Window' type, the 'XMonad.Core.ScreenID' and the +'XMonad.Core.ScreenDetail's. + +What a 'XMonad.StackSet.StackSet' is and how it can be manipulated +with pure functions is described in the Haddock documentation of the +"XMonad.StackSet" module. + +The 'XMonad.StackSet.StackSet' ('XMonad.Core.WindowSet') has four +fields: + +* 'XMonad.StackSet.current', for the current, focused workspace. This + is a 'XMonad.StackSet.Screen', which is composed of a + 'XMonad.StackSet.Workspace' together with the screen information (for + Xinerama support). + +* 'XMonad.StackSet.visible', a list of 'XMonad.StackSet.Screen's for + the other visible (with Xinerama) workspaces. For non-Xinerama + setups, this list is always empty. + +* 'XMonad.StackSet.hidden', the list of non-visible + 'XMonad.StackSet.Workspace's. + +* 'XMonad.StackSet.floating', a map from floating + 'Graphics.X11.Types.Window's to 'XMonad.StackSet.RationalRect's + specifying their geometry. + +The 'XMonad.StackSet.Workspace' type is made of a +'XMonad.StackSet.tag', a 'XMonad.StackSet.layout' and +a (possibly empty) 'XMonad.StackSet.stack' of windows. + +"XMonad.StackSet" (which should usually be imported qualified, to +avoid name clashes with Prelude functions such as 'Prelude.delete' and +'Prelude.filter') provides many pure functions to manipulate the +'XMonad.StackSet.StackSet'. These functions are most commonlyq used as +an argument to 'XMonad.Operations.windows', which takes a pure +function to manipulate the 'XMonad.Core.WindowSet' and does all the +needed operations to refresh the screen and save the modified +'XMonad.Core.XState'. + +During each 'XMonad.Operations.windows' call, the +'XMonad.StackSet.layout' field of the 'XMonad.StackSet.current' and +'XMonad.StackSet.visible' 'XMonad.StackSet.Workspace's are used to +physically arrange the 'XMonad.StackSet.stack' of windows on each +workspace. + +The possibility of manipulating the 'XMonad.StackSet.StackSet' +('XMonad.Core.WindowSet') with pure functions makes it possible to +test all the properties of those functions with QuickCheck, providing +greater reliability of the core code. Every change to the +"XMonad.StackSet" module must be accompanied by appropriate QuickCheck +properties before being applied. + +-} + +{- $events + +Event handling is the core activity of xmonad. Events generated by +the X server are most important, but there may also be events +generated by layouts or the user. + +"XMonad.Core" defines a class that generalizes the concept of events, +'XMonad.Core.Message', constrained to types with a +'Data.Typeable.Typeable' instance definition (which can be +automatically derived by ghc). 'XMonad.Core.Message's are wrapped +within an existential type 'XMonad.Core.SomeMessage'. The +'Data.Typeable.Typeable' constraint allows for the definition of a +'XMonad.Core.fromMessage' function that can unwrap the message with +'Data.Typeable.cast'. X Events are instances of this class, along +with any messages used by xmonad itself or by extension modules. + +Using the 'Data.Typeable.Typeable' class for any kind of +'XMonad.Core.Message's and events allows us to define polymorphic functions +for processing messages or unhandled events. + +This is precisely what happens with X events: xmonad passes them to +'XMonad.Main.handle'. If the main event handling function doesn't have +anything to do with the event, the event is sent to all visible +layouts by 'XMonad.Operations.broadcastMessage'. + +This messaging system allows the user to create new message types, +simply declare an instance of the 'Data.Typeable.Typeable' and use +'XMonad.Operations.sendMessage' to send commands to layouts. + +And, finally, layouts may handle X events and other messages within the +same function... miracles of polymorphism. + +-} + +{- $layoutClass +#The_LayoutClass# +to do +-} + +{- $style + +These are the coding guidelines for contributing to xmonad and the +xmonad contributed extensions. + +* Comment every top level function (particularly exported funtions), and + provide a type signature. + +* Use Haddock syntax in the comments. + +* Follow the coding style of the other modules. + +* Code should be compilable with -Wall -Werror. There should be no warnings. + +* Partial functions should be avoided: the window manager should not + crash, so do not call 'error' or 'undefined'. + +* Tabs are /illegal/. Use 4 spaces for indenting. + +* Any pure function added to the core should have QuickCheck properties + precisely defining its behaviour. + +-} + +{- $license + +New modules should identify the author, and be submitted under the +same license as xmonad (BSD3 license or freer). + +-} diff --git a/XMonad/Doc/Extending.hs b/XMonad/Doc/Extending.hs new file mode 100644 --- /dev/null +++ b/XMonad/Doc/Extending.hs @@ -0,0 +1,872 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Doc.Extending +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : portable +-- +-- This module documents the xmonad-contrib library and +-- how to use it to extend the capabilities of xmonad. +-- +-- Reading this document should not require a deep knowledge of +-- Haskell; the examples are intended to be useful and understandable +-- for those users who do not know Haskell and don't want to have to +-- learn it just to configure xmonad. You should be able to get by +-- just fine by ignoring anything you don't understand and using the +-- provided examples as templates. However, relevant Haskell features +-- are discussed when appropriate, so this document will hopefully be +-- useful for more advanced Haskell users as well. +-- +-- Those wishing to be totally hardcore and develop their own xmonad +-- extensions (it's easier than it sounds, we promise!) should read +-- the documentation in "XMonad.Doc.Developing". +-- +-- More configuration examples may be found on the Haskell wiki: +-- +-- +-- +----------------------------------------------------------------------------- + +module XMonad.Doc.Extending + ( + -- * The xmonad-contrib library + -- $library + + -- ** Actions + -- $actions + + -- ** Configurations + -- $configs + + -- ** Hooks + -- $hooks + + -- ** Layouts + -- $layouts + + -- ** Prompts + -- $prompts + + -- ** Utilities + -- $utils + + -- * Extending xmonad + -- $extending + + -- ** Editing key bindings + -- $keys + + -- *** Adding key bindings + -- $keyAdding + + -- *** Removing key bindings + -- $keyDel + + -- *** Adding and removing key bindings + -- $keyAddDel + + -- ** Editing mouse bindings + -- $mouse + + -- ** Editing the layout hook + -- $layoutHook + + -- ** Editing the manage hook + -- $manageHook + + -- ** The log hook and external status bars + -- $logHook + ) where + +-------------------------------------------------------------------------------- +-- +-- The XmonadContrib Library +-- +-------------------------------------------------------------------------------- + +{- $library + +The xmonad-contrib (xmc) library is a set of extension modules +contributed by xmonad hackers and users, which provide additional +xmonad features. Examples include various layout modes (tabbed, +spiral, three-column...), prompts, program launchers, the ability to +manipulate windows and workspaces in various ways, alternate +navigation modes, and much more. There are also \"meta-modules\" +which make it easier to write new modules and extensions. + +This is a concise yet complete overview of the xmonad-contrib modules. +For more information about any particular module, just click on its +name to view its Haddock documentation; each module should come with +extensive documentation. If you find a module that could be better +documented, or has incorrect documentation, please report it as a bug +()! + +-} + +{- $actions + +In the @XMonad.Actions@ namespace you can find modules exporting +various functions that are usually intended to be bound to key +combinations or mouse actions, in order to provide functionality +beyond the standard keybindings provided by xmonad. + +See "XMonad.Doc.Extending#Editing_key_bindings" for instructions on how to +edit your key bindings. + +* "XMonad.Actions.Commands": running internal xmonad actions + interactively. + +* "XMonad.Actions.ConstrainedResize": an aspect-ratio-constrained + window resizing mode. + +* "XMonad.Actions.CopyWindow": duplicating windows on multiple + workspaces. + +* "XMonad.Actions.CycleWS": move between workspaces. + +* "XMonad.Actions.DeManage": cease management of a window without + unmapping it. + +* "XMonad.Actions.DwmPromote": dwm-like master window swapping. + +* "XMonad.Actions.DynamicWorkspaces": add and delete workspaces. + +* "XMonad.Actions.FindEmptyWorkspace": find an empty workspace. + +* "XMonad.Actions.FlexibleManipulate": move\/resize windows without + warping the mouse. + +* "XMonad.Actions.FlexibleResize": resize windows from any corner. + +* "XMonad.Actions.FloatKeys": move\/resize floating windows with + keybindings. + +* "XMonad.Actions.FocusNth": focus the nth window on the screen. + +* "XMonad.Actions.MouseGestures": bind mouse gestures to actions. + +* "XMonad.Actions.RotSlaves": rotate non-master windows. + +* "XMonad.Actions.RotView": cycle through non-empty workspaces. + +* "XMonad.Actions.SimpleDate": display the date in a popup menu. + +* "XMonad.Actions.SinkAll": sink all floating windows. + +* "XMonad.Actions.Submap": create key submaps, i.e. the ability to + bind actions to key sequences rather than being limited to single + key combinations. + +* "XMonad.Actions.SwapWorkspaces": swap workspace tags. + +* "XMonad.Actions.TagWindows": tag windows and select by tag. + +* "XMonad.Actions.Warp": warp the pointer. + +* "XMonad.Actions.WindowBringer": bring windows to you, and you to + windows. + +* "XMonad.Actions.WmiiActions": wmii-style actions. + +-} + +{- $configs + +In the @XMonad.Config@ namespace you can find modules exporting the +configurations used by some of the xmonad and xmonad-contrib +developers. You can look at them for examples while creating your own +configuration; you can also simply import them and use them as your +own configuration, possibly with some modifications. + +* "XMonad.Config.Arossato" + +* "XMonad.Config.Dons" + +* "XMonad.Config.Droundy" + +* "XMonad.Config.Sjanssen" + +-} + +{- $hooks + +In the @XMonad.Hooks@ namespace you can find modules exporting +hooks. Hooks are actions that xmonad performs when certain events +occur. The two most important hooks are: + +* 'XMonad.Core.manageHook': this hook is called when a new window + xmonad must take care of is created. This is a very powerful hook, + since it lets us examine the new window's properties and act + accordingly. For instance, we can configure xmonad to put windows + belonging to a given application in the float layer, not to manage + dock applications, or open them in a given workspace. See + "XMonad.Doc.Extending#Editing_the_manage_hook" for more information on + customizing 'XMonad.Core.manageHook'. + +* 'XMonad.Core.logHook': this hook is called when the stack of windows + managed by xmonad has been changed, by calling the + 'XMonad.Operations.windows' function. For instance + "XMonad.Hooks.DynamicLog" will produce a string (whose format can be + configured) to be printed to the standard output. This can be used + to display some information about the xmonad state in a status bar. + See "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" for more + information. + +Here is a list of the modules found in @XMonad.Hooks@: + +* "XMonad.Hooks.DynamicLog": for use with 'XMonad.Core.logHook'; send + information about xmonad's state to standard output, suitable for + putting in a status bar of some sort. See + "XMonad.Doc.Extending#The_log_hook_and_external_status_bars". + +* "XMonad.Hooks.EwmhDesktops": support for pagers in panel applications. + +* "XMonad.Hooks.ManageDocks": handle DOCK and STRUT windows appropriately. + +* "XMonad.Hooks.SetWMName": set the WM name. Useful when e.g. running + Java GUI programs. + +* "XMonad.Hooks.UrgencyHook": configure an action to occur when a window + sets the urgent flag. + +* "XMonad.Hooks.XPropManage": match on XProperties in your + 'XMonad.Core.manageHook'. + +-} + +{- $layouts + +In the @XMonad.Layout@ namespace you can find modules exporting +contributed tiling algorithms, such as a tabbed layout, a circle, a spiral, +three columns, and so on. + +You will also find modules which provide facilities for combining +different layouts, such as "XMonad.Layout.Combo", or +"XMonad.Layout.LayoutCombinators". + +Layouts can be also modified with layout modifiers. A general +interface for writing layout modifiers is implemented in +"XMonad.Layout.LayoutModifier". + +For more information on using those modules for customizing your +'XMonad.Core.layoutHook' see "XMonad.Doc.Extending#Editing_the_layout_hook". + +* "XMonad.Layout.Accordion": put non-focused windows in ribbons at the + top and bottom of the screen. + +* "XMonad.Layout.Circle": an elliptical, overlapping layout. + +* "XMonad.Layout.Combo": combine multiple layouts into one. + +* "XMonad.Layout.Dishes": stack extra windows underneath the master windows. + +* "XMonad.Layout.DragPane": split the screen into two windows with a + draggable divider. + +* "XMonad.Layout.Grid": put windows in a square grid. + +* "XMonad.Layout.LayoutCombinators": general layout combining. + +* "XMonad.Layout.LayoutHints": make layouts respect window size hints. + +* "XMonad.Layout.LayoutModifier": a general framework for creating + layout \"modifiers\"; useful for creating new layout modules. + +* "XMonad.Layout.LayoutScreens": divide the screen into multiple + virtual \"screens\". + +* "XMonad.Layout.MagicFocus": automagically put the focused window in + the master area. + +* "XMonad.Layout.Magnifier": increase the size of the focused window + +* "XMonad.Layout.Maximize": temporarily maximize the focused window. + +* "XMonad.Layout.Mosaic": tries to give each window a + user-configurable relative area + +* "XMonad.Layout.MosaicAlt": give each window a specified relative + amount of screen space. + +* "XMonad.Layout.MultiToggle": dynamically apply and unapply layout + transformers. + +* "XMonad.Layout.Named": change the names of layouts (as reported by + e.g. "XMonad.Hooks.DynamicLog"). + +* "XMonad.Layout.NoBorders": display windows without borders. + +* "XMonad.Layout.PerWorkspace": configure layouts on a per-workspace basis. + +* "XMonad.Layout.ResizableTile": tiled layout allowing you to change + width and height of windows. + +* "XMonad.Layout.Roledex": a \"completely pointless layout which acts + like Microsoft's Flip 3D\". + +* "XMonad.Layout.Spiral": Fibonacci spiral layout. + +* "XMonad.Layout.Square": split the screen into a square area plus the rest. + +* "XMonad.Layout.Tabbed": a tabbed layout. + +* "XMonad.Layout.ThreeColumns": a layout with three columns instead of two. + +* "XMonad.Layout.TilePrime": fill gaps created by resize hints. + +* "XMonad.Layout.ToggleLayouts": toggle between two layouts. + +* "XMonad.Layout.TwoPane": split the screen horizontally and show two + windows. + +* "XMonad.Layout.WindowNavigation": navigate around a workspace + directionally instead of using mod-j\/k. + +* "XMonad.Layout.WorkspaceDir": set the current working directory in a + workspace. + +-} + +{- $prompts + +In the @XMonad.Prompt@ name space you can find modules providing +graphical prompts for getting user input and using it to perform +various actions. + +The "XMonad.Prompt" provides a library for easily writing new prompt +modules. + +These are the available prompts: + +* "XMonad.Prompt.Directory" + +* "XMonad.Prompt.Layout" + +* "XMonad.Prompt.Man" + +* "XMonad.Prompt.Shell" + +* "XMonad.Prompt.Ssh" + +* "XMonad.Prompt.Window" + +* "XMonad.Prompt.Workspace" + +* "XMonad.Prompt.XMonad" + +Usually a prompt is called by some key binding. See +"XMonad.Doc.Extending#Editing_key_bindings", which includes examples +of adding some prompts. + +-} + +{- $utils + +In the @XMonad.Util@ namespace you can find modules exporting various +utility functions that are used by the other modules of the +xmonad-contrib library. + +There are also utilities for helping in configuring xmonad or using +external utilities. + +A non complete list with a brief description: + +* "XMonad.Util.Anneal": The goal is to bring the system, from an + arbitrary initial state, to a state with the minimum possible + energy. + +* "XMonad.Util.CustomKeys" or "XMonad.Util.EZConfig" can be used to + configure key bindings (see "XMonad.Doc.Extending#Editing_key_bindings"); + +* "XMonad.Util.Dzen" "XMonad.Util.Dmenu" provide useful functions for + running dzen as a xmonad status bar and dmenu as a program launcher; + +* "XMonad.Util.XSelection" provide utilities for using the mouse + selection; + +* "XMonad.Util.XUtils" and "XMonad.Util.Font" are libraries for + accessing Xlib and XFT function in a convenient way. + +-} + +-------------------------------------------------------------------------------- +-- +-- Extending Xmonad +-- +-------------------------------------------------------------------------------- + +{- $extending +#Extending_xmonad# + +Since the @xmonad.hs@ file is just another Haskell module, you may +import and use any Haskell code or libraries you wish, such as +extensions from the xmonad-contrib library, or other code you write +yourself. + +-} + +{- $keys +#Editing_key_bindings# + +Editing key bindings means changing the 'XMonad.Core.XConfig.keys' +field of the 'XMonad.Core.XConfig' record used by xmonad. For +example, you could write: + +> main = xmonad $ defaultConfig { keys = myKeys } + +and provide an appropriate definition of @myKeys@, such as: + +> myKeys x = +> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) +> ] + +This particular definition also requires importing "Graphics.X11.Xlib" +(for the symbols such as @xK_F12@), "XMonad.Prompt", +"XMonad.Prompt.Shell", and "XMonad.Prompt.XMonad": + +> import Graphics.X11.Xlib +> import ... -- and so on + +Usually, rather than completely redefining the key bindings, as we did +above, we want to simply add some new bindings and\/or remove existing +ones. + +-} + +{- $keyAdding +#Adding_key_bindings# + +Adding key bindings can be done in different ways. The type signature +of 'XMonad.Core.XConfig.keys' is: + +> keys :: XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()) + +In order to add new key bindings, you need to first create an +appropriate 'Data.Map.Map' from a list of key bindings using +'Data.Map.fromList'. This 'Data.Map.Map' of new key bindings then +needs to be joined to a 'Data.Map.Map' of existing bindings using +'Data.Map.union'. + +Since we are going to need some of the functions of the "Data.Map" +module, before starting we must first import this modules: + +> import qualified Data.Map as M + + +For instance, if you have defined some additional key bindings like +these: + +> myKeys x = +> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) +> ] + +then you can create a new key bindings map by joining the default one +with yours: + +> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) + +Finally, you can use @newKeys@ in the 'XMonad.Core.XConfig.keys' field +of the configuration: + +> main = xmonad $ defaultConfig { keys = newKeys } + +All together, your @~\/.xmonad\/xmonad.hs@ would now look like this: + + +> module Main (main) where +> +> import XMonad +> +> import qualified Data.Map as M +> import Graphics.X11.Xlib +> import XMonad.Prompt +> import XMonad.Prompt.Shell +> import XMonad.Prompt.XMonad +> +> main :: IO () +> main = xmonad $ defaultConfig { keys = newKeys } +> +> newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x)) +> +> myKeys x = +> [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig) +> , ((modMask x, xK_F3 ), shellPrompt defaultXPConfig) +> ] + + +There are other ways of defining @newKeys@; for instance, +you could define it like this: + +> newKeys x = foldr (uncurry M.insert) (keys defaultConfig x) (myKeys x) + +However, the simplest way to add new key bindings is to use some +utilities provided by the xmonad-contrib library. For instance, +"XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" both provide +useful functions for editing your key bindings. Look, for instance, at +'XMonad.Util.EZConfig.additionalKeys'. + + -} + +{- $keyDel +#Removing_key_bindings# + +Removing key bindings requires modifying the 'Data.Map.Map' which +stores the key bindings. This can be done with 'Data.Map.difference' +or with 'Data.Map.delete'. + +For example, suppose you want to get rid of @mod-q@ and @mod-shift-q@ +(you just want to leave xmonad running forever). To do this you need +to define @newKeys@ as a 'Data.Map.difference' between the default +map and the map of the key bindings you want to remove. Like so: + +> newKeys x = M.difference (keys defaultConfig x) (M.fromList $ keysToRemove x) +> +> keysToRemove :: XConfig Layout -> [((KeyMask, KeySym),X ())] +> keysToRemove x = +> [ ((modMask x , xK_q ), return ()) +> , ((modMask x .|. shiftMask, xK_q ), return ()) +> ] + +As you can see, it doesn't matter what actions we associate with the +keys listed in @keysToRemove@, so we just use @return ()@ (the +\"null\" action). + +It is also possible to simply define a list of keys we want to unbind +and then use 'Data.Map.delete' to remove them. In that case we would +write something like: + +> newKeys x = foldr M.delete (keys defaultConfig x) (keysToRemove x) +> +> keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)] +> keysToRemove x = +> [ (modMask x , xK_q ) +> , (modMask x .|. shiftMask, xK_q ) +> ] + +Another even simpler possibility is the use of some of the utilities +provided by the xmonad-contrib library. Look, for instance, at +'XMonad.Util.EZConfig.removeKeys'. + +-} + +{- $keyAddDel +#Adding_and_removing_key_bindings# + +Adding and removing key bindings requires simply combining the steps +for removing and adding. Here is an example from +"XMonad.Config.Arossato": + +> defKeys = keys defaultConfig +> delKeys x = foldr M.delete (defKeys x) (toRemove x) +> newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x) +> -- remove some of the default key bindings +> toRemove x = +> [ (modMask x , xK_j ) +> , (modMask x , xK_k ) +> , (modMask x , xK_p ) +> , (modMask x .|. shiftMask, xK_p ) +> , (modMask x .|. shiftMask, xK_q ) +> , (modMask x , xK_q ) +> ] ++ +> -- I want modMask .|. shiftMask 1-9 to be free! +> [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]] +> -- These are my personal key bindings +> toAdd x = +> [ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig ) +> , ((modMask x , xK_F3 ), shellPrompt defaultXPConfig ) +> ] ++ +> -- Use modMask .|. shiftMask .|. controlMask 1-9 instead +> [( (m .|. modMask x, k), windows $ f i) +> | (i, k) <- zip (workspaces x) [xK_1 .. xK_9] +> , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)] +> ] + +You can achieve the same result using the "XMonad.Util.CustomKeys" +module; take a look at the 'XMonad.Util.CustomKeys.customKeys' +function in particular. + +-} + +{- $mouse +#Editing_mouse_bindings# + +Most of the previous discussion of key bindings applies to mouse +bindings as well. For example, you could configure button4 to close +the window you click on like so: + +> import qualified Data.Map as M +> +> myMouse x = [ (0, button4), (\w -> focus w >> kill) ] +> +> newMouse x = M.union (mouseBindings defaultConfig x) (M.fromList (myMouse x)) +> +> main = xmonad $ defaultConfig { ..., mouseBindings = newMouse, ... } + +Overriding or deleting mouse bindings works similarly. You can also +configure mouse bindings much more easily using the +'XMonad.Util.EZConfig.additionalMouseBindings' and +'XMonad.Util.EZConfig.removeMouseBindings' functions from the +"XMonad.Util.EZConfig" module. + +-} + +{- $layoutHook +#Editing_the_layout_hook# + +When you start an application that opens a new window, when you change +the focused window, or move it to another workspace, or change that +workspace's layout, xmonad will use the 'XMonad.Core.layoutHook' for +reordering the visible windows on the visible workspace(s). + +Since different layouts may be attached to different workspaces, and +you can change them, xmonad needs to know which one to use. In this +sense the layoutHook may be thought as the list of layouts that +xmonad will use for laying out windows on the screen(s). + +The problem is that the layout subsystem is implemented with an +advanced feature of the Haskell programming language: type classes. +This allows us to very easily write new layouts, combine or modify +existing layouts, create layouts with internal state, etc. See +"XMonad.Doc.Extending#The_LayoutClass" for more information. This +means that we cannot simply have a list of layouts as we used to have +before the 0.5 release: a list requires every member to belong to the +same type! + +Instead the combination of layouts to be used by xmonad is created +with a specific layout combinator: 'XMonad.Layout.|||'. + +Suppose we want a list with the 'XMonad.Layout.Full', +'XMonad.Layout.Tabbed.tabbed' and +'XMonad.Layout.Accordion.Accordion' layouts. First we import, in our +@~\/.xmonad\/xmonad.hs@, all the needed modules: + +> import XMonad +> import XMonad.Layouts +> +> import XMonad.Layout.Tabbed +> import XMonad.Layout.Accordion + +Then we create the combination of layouts we need: + +> mylayoutHook = Full ||| tabbed shrinkText defaultTConf ||| Accordion + + +Now, all we need to do is change the 'XMonad.Core.layoutHook' +field of the 'XMonad.Core.XConfig' record, like so: + +> main = xmonad $ defaultConfig { layoutHook = mylayoutHook } + +Thanks to the new combinator, we can apply a layout modifier to a +whole combination of layouts, instead of applying it to each one. For +example, suppose we want to use the +'XMonad.Layout.NoBorders.noBorders' layout modifier, from the +"XMonad.Layout.NoBorders" module (which must be imported): + +> mylayoutHook = noBorders (Full ||| tabbed shrinkText defaultTConf ||| Accordion) + +If we want only the tabbed layout without borders, then we may write: + +> mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion + +Our @~\/.xmonad\/xmonad.hs@ will now look like this: + +> import XMonad.Layouts +> +> import XMonad.Layout.Tabbed +> import XMonad.Layout.Accordion +> import XMonad.Layout.NoBorders +> +> mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion +> +> main = xmonad $ defaultConfig { layoutHook = mylayoutHook } + +That's it! + +-} + +{- $manageHook +#Editing_the_manage_hook# + +The 'XMonad.Core.manageHook' is a very powerful tool for customizing +the behavior of xmonad with regard to new windows. Whenever a new +window is created, xmonad calls the 'XMonad.Core.manageHook', which +can thus be used to perform certain actions on the new window, such as +placing it in a specific workspace, ignoring it, or placing it in the +float layer. + +The default 'XMonad.Core.manageHook' causes xmonad to float MPlayer +and Gimp, and to ignore gnome-panel, desktop_window, kicker, and +kdesktop. + +The "XMonad.ManageHook" module provides some simple combinators that +can be used to alter the 'XMonad.Core.manageHook' by replacing or adding +to the default actions. + +Let's start by analyzing the default 'XMonad.Config.manageHook', defined +in "XMonad.Config": + + +> manageHook :: ManageHook +> manageHook = composeAll +> [ className =? "MPlayer" --> doFloat +> , className =? "Gimp" --> doFloat +> , resource =? "desktop_window" --> doIgnore +> , resource =? "kdesktop" --> doIgnore ] + +'XMonad.ManageHook.composeAll' can be used to compose a list of +different 'XMonad.Config.ManageHook's. In this example we have a list +of 'XMonad.Config.ManageHook's formed by the following commands: the +Mplayer's and the Gimp's windows, whose 'XMonad.ManageHook.className' +are, respectively \"Mplayer\" and \"Gimp\", are to be placed in the +float layer with the 'XMonad.ManageHook.doFloat' function; the windows +whose resource names are respectively \"desktop_window\" and +\kdesktop\" are to be ignored with the 'XMonad.ManageHook.doIgnore' +function. + +This is another example of 'XMonad.Config.manageHook', taken from +"XMonad.Config.Arossato": + +> myManageHook = composeAll [ resource =? "realplay.bin" --> doFloat +> , resource =? "win" --> doF (W.shift "doc") -- xpdf +> , resource =? "firefox-bin" --> doF (W.shift "web") +> ] +> newManageHook = myManageHook <+> manageHook defaultConfig + + +Again we use 'XMonad.ManageHook.composeAll' to compose a list of +different 'XMonad.Config.ManageHook's. The first one will put +RealPlayer on the float layer, the second one will put the xpdf +windows in the workspace named \"doc\", with 'XMonad.ManageHook.doF' +and 'XMonad.StackSet.shift' functions, and the third one will put all +firefox windows on the workspace called "web". Then we use the +'XMonad.ManageHook.<+>' combinator to compose @myManageHook@ with the +default 'XMonad.Config.manageHook' to form @newManageHook@. + +Each 'XMonad.Config.ManageHook' has the form: + +> property =? match --> action + +Where @property@ can be: + +* 'XMonad.ManageHook.title': the window's title + +* 'XMonad.ManageHook.resource': the resource name + +* 'XMonad.ManageHook.className': the resource class name. + +(You can retrieve the needed information using the X utility named +@xprop@; for example, to find the resource class name, you can type + +> xprop | grep WM_CLASS + +at a prompt, then click on the window whose resource class you want to +know.) + +@match@ is the string that will match the property value (for instance +the one you retrieved with @xprop@). + +An @action@ can be: + +* 'XMonad.ManageHook.doFloat': to place the window in the float layer; + +* 'XMonad.ManageHook.doIgnore': to ignore the window; + +* 'XMonad.ManageHook.doF': to execute a function with the window as + argument. + +For example, suppose we want to add a 'XMonad.Config.manageHook' to +float RealPlayer, which usually has a 'XMonad.ManageHook.resource' +name of \"realplay.bin\". + +First we need to import "XMonad.ManageHook": + +> import XMonad.ManageHook + +Then we create our own 'XMonad.Config.manageHook': + +> myManageHook = resource =? "realplay.bin" --> doFloat + +We can now use the 'XMonad.ManageHook.<+>' combinator to add our +'XMonad.Config.manageHook' to the default one: + +> newManageHook = myManageHook <+> manageHook defaultConfig + +(Of course, if we wanted to completely replace the default +'XMonad.Config.manageHook', this step would not be necessary.) Now, +all we need to do is change the 'XMonad.Core.manageHook' field of the +'XMonad.Core.XConfig' record, like so: + +> main = xmonad defaultConfig { ..., manageHook = newManageHook, ... } + +And we are done. + +Obviously, we may wish to add more then one +'XMonad.Config.manageHook'. In this case we can use a list of hooks, +compose them all with 'XMonad.ManageHook.composeAll', and add the +composed to the default one. + +For instance, if we want RealPlayer to float and thunderbird always +opened in the workspace named "mail", we can do so like this: + +> myManageHook = composeAll [ resource =? "realplay.bin" --> doFloat +> , resource =? "thunderbird-bin" --> doF (W.shift "mail") +> ] + +Remember to import the module that defines the 'XMonad.StackSet.shift' +function, "XMonad.StackSet", like this: + +> import qualified XMonad.StackSet as W + +And then we can add @myManageHook@ to the default one to create +@newManageHook@ as we did in the previous example. + +One more thing to note about this system is that if +a window matches multiple rules in a 'XMonad.Config.manageHook', /all/ +of the corresponding actions will be run (in the order in which they +are defined). This is a change from versions before 0.5, when only +the first rule that matched was run. + +-} + +{- $logHook +#The_log_hook_and_external_status_bars# + +When the stack of the windows managed by xmonad changes for any +reason, xmonad will call 'XMonad.Core.logHook', which can be used to +output some information about the internal state of xmonad, such as the +layout that is presently in use, the workspace we are in, the focused +window's title, and so on. + +Extracting information about the internal xmonad state can be somewhat +difficult if you are not familiar with the source code. Therefore, +it's usually easiest to use a module that has been designed +specifically for logging some of the most interesting information +about the internal state of xmonad: "XMonad.Hooks.DynamicLog". This +module can be used with an external status bar to print the produced +logs in a convenient way; the most commonly used status bars are dzen +and xmobar. + +By default the 'XMonad.Core.logHook' doesn't produce anything. To +enable it you need first to import "XMonad.Hooks.DynamicLog": + +> import XMonad.Hooks.DynamicLog + +Then you just need to update the 'XMonad.Core.logHook' field of the +'XMonad.Core.XConfig' record with one of the provided functions. For +example: + +> main = xmonad defaultConfig { logHook = dynamicLog } + +More interesting configurations are also possible; see the +"XMonad.Hooks.DynamicLog" module for more possibilities. + +You may now enjoy your extended xmonad experience. + +Have fun! + +-} diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs new file mode 100644 --- /dev/null +++ b/XMonad/Hooks/DynamicLog.hs @@ -0,0 +1,254 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.DynamicLog +-- Copyright : (c) Don Stewart +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Don Stewart +-- Stability : unstable +-- Portability : unportable +-- +-- DynamicLog +-- +-- Log events in: +-- +-- > 1 2 [3] 4 8 +-- +-- format. Suitable to pipe into dzen. +-- +----------------------------------------------------------------------------- + +module XMonad.Hooks.DynamicLog ( + -- * Usage + -- $usage + dynamicLog, + dynamicLogDzen, + dynamicLogXmobar, + dynamicLogWithPP, + dynamicLogXinerama, + dzen, + + pprWindowSet, + pprWindowSetXinerama, + + PP(..), defaultPP, dzenPP, sjanssenPP, + wrap, pad, shorten, + xmobarColor, dzenColor, dzenEscape, + makeSimpleDzenConfig + ) where + +-- +-- Useful imports +-- +import XMonad +import Data.Maybe ( isJust ) +import Data.List +import Data.Ord ( comparing ) +import qualified XMonad.StackSet as S +import Data.Monoid +import System.IO +import XMonad.Util.NamedWindows +import XMonad.Util.Run + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad +-- > import XMonad.Hooks.DynamicLog +-- > main = xmonad defaultConfig { logHook = dynamicLog } + +-- | An example xmonad config that spawns a new dzen toolbar and uses the default +-- dynamic log output +makeSimpleDzenConfig :: IO (XConfig (Choose Tall (Choose (Mirror Tall) Full))) +makeSimpleDzenConfig = do + h <- spawnPipe "dzen2" + return defaultConfig + { defaultGaps = [(18,0,0,0)] + , logHook = dynamicLogWithPP dzenPP + { ppOutput = hPutStrLn h } } + +-- | +-- +-- Run xmonad with a dzen status bar set to some nice defaults. Output +-- is taken from the dynamicLogWithPP hook. +-- +-- > main = dzen xmonad +-- +-- The intent is that the above config file should provide a nice status +-- bar with minimal effort. +-- +dzen :: (XConfig (Choose Tall (Choose (Mirror Tall) Full)) -> IO ()) -> IO () +dzen f = do + h <- spawnPipe ("dzen2" ++ " " ++ flags) + f $ defaultConfig + { defaultGaps = [(15,0,0,0)] -- for fixed + , logHook = dynamicLogWithPP dzenPP + { ppOutput = hPutStrLn h } } + where + fg = "'#a8a3f7'" -- n.b quoting + bg = "'#3f3c6d'" + flags = "-e '' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg + +-- | +-- An example log hook, print a status bar output to stdout, in the form: +-- +-- > 1 2 [3] 4 7 : full : title +-- +-- That is, the currently populated workspaces, the current +-- workspace layout, and the title of the focused window. +-- +dynamicLog :: X () +dynamicLog = dynamicLogWithPP defaultPP + +-- | +-- A log function that uses the 'PP' hooks to customize output. +dynamicLogWithPP :: PP -> X () +dynamicLogWithPP pp = do + spaces <- asks (workspaces . config) + -- layout description + ld <- withWindowSet $ return . description . S.layout . S.workspace . S.current + -- workspace list + ws <- withWindowSet $ return . pprWindowSet spaces pp + -- window title + wt <- withWindowSet $ maybe (return "") (fmap show . getName) . S.peek + + io . ppOutput pp . sepBy (ppSep pp) . ppOrder pp $ + [ ws + , ppLayout pp ld + , ppTitle pp wt + ] + +-- | 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 + + +pprWindowSet :: [String] -> PP -> WindowSet -> String +pprWindowSet spaces pp s = sepBy (ppWsSep pp) $ map fmt $ sortBy cmp + (map S.workspace (S.current s : S.visible s) ++ S.hidden s) + where f Nothing Nothing = EQ + f (Just _) Nothing = LT + f Nothing (Just _) = GT + f (Just x) (Just y) = compare x y + + wsIndex = flip elemIndex spaces . S.tag + + cmp a b = f (wsIndex a) (wsIndex b) `mappend` compare (S.tag a) (S.tag b) + + this = S.tag (S.workspace (S.current s)) + visibles = map (S.tag . S.workspace) (S.visible s) + + fmt w = printer pp (S.tag w) + where printer | S.tag w == this = ppCurrent + | S.tag w `elem` visibles = ppVisible + | isJust (S.stack w) = ppHidden + | otherwise = ppHiddenNoWindows + +-- | +-- 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 . pprWindowSetXinerama + +pprWindowSetXinerama :: WindowSet -> String +pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen + where onscreen = map (S.tag . S.workspace) + . sortBy (comparing S.screen) $ S.current ws : S.visible ws + offscreen = map S.tag . filter (isJust . S.stack) + . sortBy (comparing S.tag) $ S.hidden ws + +wrap :: String -> String -> String -> String +wrap _ _ "" = "" +wrap l r m = l ++ m ++ r + +pad :: String -> String +pad = wrap " " " " + +shorten :: Int -> String -> String +shorten n xs | length xs < n = xs + | otherwise = (take (n - length end) xs) ++ end + where + end = "..." + +sepBy :: String -> [String] -> String +sepBy sep = concat . intersperse sep . filter (not . null) + +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()") + +-- | Escape any dzen metacharacters. +dzenEscape :: String -> String +dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x]) + +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, ppWsSep :: String + , ppTitle :: String -> String + , ppLayout :: String -> String + , ppOrder :: [String] -> [String] + , ppOutput :: String -> IO () + } + +-- | The default pretty printing options, as seen in dynamicLog +defaultPP :: PP +defaultPP = PP { ppCurrent = wrap "[" "]" + , ppVisible = wrap "<" ">" + , ppHidden = id + , ppHiddenNoWindows = const "" + , ppSep = " : " + , ppWsSep = " " + , ppTitle = shorten 80 + , ppLayout = id + , ppOrder = id + , ppOutput = putStrLn + } + +-- | 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 + } + +-- | 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" "" . shorten 80 + } + +-- | These are good defaults to be used with the xmobar status bar +dynamicLogXmobar :: X () +dynamicLogXmobar = + dynamicLogWithPP defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" + , ppTitle = xmobarColor "green" "" . shorten 40 + , ppVisible = wrap "(" ")" + } diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs new file mode 100644 --- /dev/null +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -0,0 +1,130 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.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 XMonad.Hooks.EwmhDesktops ( + -- * Usage + -- $usage + ewmhDesktopsLogHook + ) where + +import Data.List (elemIndex, sortBy) +import Data.Ord (comparing) +import Data.Maybe (fromMaybe) + +import XMonad +import Control.Monad +import qualified XMonad.StackSet as W + +import XMonad.Hooks.SetWMName + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad +-- > import XMonad.Hooks.EwmhDesktops +-- > +-- > myLogHook :: X () +-- > myLogHook = do ewmhDesktopsLogHook +-- > return () +-- > +-- > main = xmonad defaultConfig { logHook = myLogHook } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" + +-- | +-- Notifies pagers and window lists, such as those in the gnome-panel +-- of the current state of workspaces and windows. +ewmhDesktopsLogHook :: X () +ewmhDesktopsLogHook = withWindowSet $ \s -> do + -- Bad hack because xmonad forgets the original order of things, it seems + -- see http://code.google.com/p/xmonad/issues/detail?id=53 + let ws = sortBy (comparing W.tag) $ W.workspaces s + let wins = W.allWindows s + + setSupported + + -- Number of Workspaces + setNumberOfDesktops (length ws) + + -- 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 + + 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 + a <- getAtom "_NET_CURRENT_DESKTOP" + c <- getAtom "CARDINAL" + r <- asks theRoot + io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i] + +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' + +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 (fmap fromIntegral wins) + a' <- getAtom "_NET_CLIENT_LIST_STACKING" + io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral 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] + +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 (fmap fromIntegral supp) + + setWMName "xmonad" + + diff --git a/XMonad/Hooks/ManageDocks.hs b/XMonad/Hooks/ManageDocks.hs new file mode 100644 --- /dev/null +++ b/XMonad/Hooks/ManageDocks.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-} +{-# OPTIONS -fglasgow-exts #-} +-- deriving Typeable +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.ManageDocks +-- Copyright : (c) Joachim Breitner +-- License : BSD +-- +-- Maintainer : Joachim Breitner +-- Stability : unstable +-- Portability : unportable +-- +-- This module provides tools to automatically manage 'dock' type programs, +-- such as gnome-panel, kicker, dzen, and xmobar. + +module XMonad.Hooks.ManageDocks ( + -- * Usage + -- $usage + manageDocks, AvoidStruts, avoidStruts, ToggleStruts(ToggleStruts) + ) where + + +----------------------------------------------------------------------------- +import XMonad +import Foreign.C.Types (CLong) +import Data.Maybe (catMaybes) +-- $usage +-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.ManageDocks +-- +-- The first component is a 'ManageHook' which recognizes these windows. To +-- enable it: +-- +-- > manageHook = ... <+> manageDocks +-- +-- The second component is a layout modifier that prevents windows from +-- overlapping these dock windows. It is intended to replace xmonad's +-- so-called "gap" support. First, you must add it to your list of layouts: +-- +-- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...) +-- +-- 'AvoidStruts' also supports toggling the dock gap, add a keybinding similar +-- to: +-- +-- > ,((modMask, xK_b ), sendMessage ToggleStruts) +-- + +-- | +-- 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. +manageDocks :: ManageHook +manageDocks = checkDock --> doIgnore + +-- | +-- Checks if a window is a DOCK window +checkDock :: Query Bool +checkDock = ask >>= \w -> liftX $ do + 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 + +-- | +-- 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 [CLong]) +getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w + +-- | +-- Goes through the list of windows and find the gap so that all STRUT +-- settings are satisfied. +calcGap :: X Rectangle +calcGap = withDisplay $ \dpy -> do + rootw <- asks theRoot + -- We don't keep track of dock like windows, so we find all of them here + (_,_,wins) <- io $ queryTree dpy rootw + struts <- catMaybes `fmap` mapM getStrut wins + + -- we grab the window attributes of the root window rather than checking + -- the width of the screen because xlib caches this info and it tends to + -- be incorrect after RAndR + wa <- io $ getWindowAttributes dpy rootw + return $ reduceScreen (foldl max4 (0,0,0,0) struts) + $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa) + +-- | +-- Piecewise maximum of a 4-tuple of Ints +max4 :: (Int, Int, Int, Int) -> (Int, Int, Int, Int) -> (Int, Int, Int, Int) +max4 (a1,a2,a3,a4) (b1,b2,b3,b4) = (max a1 b1, max a2 b2, max a3 b3, max a4 b4) + +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral + +-- | Given strut values and the screen rectangle, compute a reduced screen +-- rectangle. +reduceScreen :: (Int, Int, Int, Int) -> Rectangle -> Rectangle +reduceScreen (t, b, l, r) (Rectangle rx ry rw rh) + = Rectangle (rx + fi l) (ry + fi t) (rw - fi r) (rh - fi b) + +r2c :: Rectangle -> (Position, Position, Position, Position) +r2c (Rectangle x y w h) = (x, y, x + fi w, y + fi h) + +c2r :: (Position, Position, Position, Position) -> Rectangle +c2r (x1, y1, x2, y2) = Rectangle x1 y1 (fi $ x2 - x1) (fi $ y2 - y1) + +-- | Given a bounding rectangle 's' and another rectangle 'r', compute a +-- rectangle 'r' that fits inside 's'. +fitRect :: Rectangle -> Rectangle -> Rectangle +fitRect s r + = c2r (max sx1 rx1, max sy1 ry1, min sx2 rx2, min sy2 ry2) + where + (sx1, sy1, sx2, sy2) = r2c s + (rx1, ry1, rx2, ry2) = r2c r + +-- | Adjust layout automagically. +avoidStruts :: LayoutClass l a => l a -> AvoidStruts l a +avoidStruts = AvoidStruts True + +data AvoidStruts l a = AvoidStruts Bool (l a) deriving ( Read, Show ) + +data ToggleStruts = ToggleStruts deriving (Read,Show,Typeable) +instance Message ToggleStruts + +instance LayoutClass l a => LayoutClass (AvoidStruts l) a where + doLayout (AvoidStruts True lo) r s = + do rect <- fmap (flip fitRect r) calcGap + (wrs,mlo') <- doLayout lo rect s + return (wrs, AvoidStruts True `fmap` mlo') + doLayout (AvoidStruts False lo) r s = do (wrs,mlo') <- doLayout lo r s + return (wrs, AvoidStruts False `fmap` mlo') + handleMessage (AvoidStruts b l) m + | Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (not b) l + | otherwise = do ml' <- handleMessage l m + return (AvoidStruts b `fmap` ml') + description (AvoidStruts _ l) = description l diff --git a/XMonad/Hooks/SetWMName.hs b/XMonad/Hooks/SetWMName.hs new file mode 100644 --- /dev/null +++ b/XMonad/Hooks/SetWMName.hs @@ -0,0 +1,112 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.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 x .|. 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 "http:\/\/bugs.sun.com\/bugdatabase\/view_bug.do?bug_id=6429775" 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 absolutely bogus values. +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". +----------------------------------------------------------------------------- + +module XMonad.Hooks.SetWMName ( + setWMName) where + +import Control.Monad (join) +import Data.Char (ord) +import Data.List (nub) +import Data.Maybe (fromJust, listToMaybe, maybeToList) +import Foreign.C.Types (CChar) + +import Foreign.Marshal.Alloc (alloca) + +import XMonad + +-- | 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 [fromIntegral 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 (latin1StringToCCharList 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 $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList) + where + netSupportingWMCheckAtom :: X Atom + netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK" + + latin1StringToCCharList :: String -> [CChar] + latin1StringToCCharList 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 (fmap fromIntegral 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 diff --git a/XMonad/Hooks/UrgencyHook.hs b/XMonad/Hooks/UrgencyHook.hs new file mode 100644 --- /dev/null +++ b/XMonad/Hooks/UrgencyHook.hs @@ -0,0 +1,187 @@ +{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.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 XMonad.Hooks.UrgencyHook ( + -- * Usage + -- $usage + withUrgencyHook, + focusUrgent, + readUrgents, withUrgents, + urgencyLayoutHook, + NoUrgencyHook(..), StdoutUrgencyHook(..), + dzenUrgencyHook, DzenUrgencyHook(..), + UrgencyHook(urgencyHook), + seconds + ) where + +import XMonad +import qualified XMonad.StackSet as W + +import XMonad.Layout.LayoutModifier hiding (hook) +import XMonad.Util.Dzen (dzenWithArgs, seconds) +import XMonad.Util.NamedWindows (getName) + +import Control.Monad (when) +import Data.Bits (testBit, clearBit) +import Data.IORef +import Data.List ((\\), delete) +import Data.Maybe (listToMaybe) +import qualified Data.Set as S +import Foreign (unsafePerformIO) + +-- $usage +-- To wire this up, first add: +-- +-- > import XMonad.Hooks.UrgencyHook +-- +-- to your import list in your config file. Now, choose an urgency hook. If +-- you're just interested in displaying the urgency state in your custom +-- logHook, then choose NoUrgencyHook. Otherwise, you may use the provided +-- 'dzenUrgencyHook', or write your own. +-- +-- Enable your urgency hook by wrapping your config record in a call to +-- 'withUrgencyHook'. For example: +-- +-- > main = xmonad $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] } +-- > $ defaultConfig +-- +-- If you want to modify your logHook to print out information about urgent windows, +-- the functions 'readUrgents' and 'withUrgents' are there to help you with that. +-- No example for you. + +-- | This is the preferred method of enabling an urgency hook. It will prepend +-- an action to your logHook that removes visible windows from the list of urgent +-- windows. If you don't like that behavior, you may use 'urgencyLayoutHook' instead. +withUrgencyHook :: (LayoutClass l Window, UrgencyHook h Window) => + h -> XConfig l -> XConfig (ModifiedLayout (WithUrgencyHook h) l) +withUrgencyHook hook conf = conf { layoutHook = urgencyLayoutHook hook $ layoutHook conf + , logHook = removeVisiblesFromUrgents >> logHook conf + } + +-- | The logHook action used by 'withUrgencyHook'. +removeVisiblesFromUrgents :: X () +removeVisiblesFromUrgents = do + visibles <- gets mapped + adjustUrgents (\\ (S.toList visibles)) + +-- | 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 + +-- | Stores the global set of all urgent windows, across workspaces. Not exported -- use +-- 'readUrgents' or 'withUrgents' instead. +{-# NOINLINE urgents #-} +urgents :: IORef [Window] +urgents = unsafePerformIO (newIORef []) +-- (Hey, I don't like it any more than you do.) + +-- | X action that returns a list of currently urgent windows. You might use +-- it, or 'withUrgents', in your custom logHook, to display the workspaces that +-- contain urgent windows. +readUrgents :: X [Window] +readUrgents = io $ readIORef urgents + +-- | An HOF version of 'readUrgents', for those who prefer that sort of thing. +withUrgents :: ([Window] -> X a) -> X a +withUrgents f = readUrgents >>= f + +data WithUrgencyHook h a = WithUrgencyHook h deriving (Read, Show) + +-- The Non-ICCCM Manifesto: +-- Note: Some non-standard choices have been made in this implementation to +-- account for the fact that things are different in a tiling window manager: +-- 1. Several clients (e.g. Xchat2, rxvt-unicode) set the urgency flag +-- 9 or 10 times in a row. This would, in turn, trigger urgencyHook repeatedly. +-- so in order to prevent that, we immediately clear the urgency flag. +-- 2. In normal window managers, windows may overlap, so clients wait for focus to +-- be set before urgency is cleared. In a tiling WM, it's sufficient to be able +-- see the window, since we know that means you can see it completely. +-- 3. The urgentOnBell setting in rxvt-unicode sets urgency even when the window +-- has focus, and won't clear until it loses and regains focus. This is stupid. +-- In order to account for these quirks, we clear the urgency bit immediately upon +-- receiving notification (thus suppressing the repeated notifications) and track +-- the list of urgent windows ourselves, allowing us to clear urgency when a window +-- is visible, and not to set urgency if a window is visible. +-- If you have a better idea, please, let us know! +instance UrgencyHook h Window => LayoutModifier (WithUrgencyHook h) Window where + handleMess (WithUrgencyHook hook) mess + | Just PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } <- fromMessage mess = do + when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do + wmh@WMHints { wmh_flags = flags } <- io $ getWMHints dpy w + when (testBit flags urgencyHintBit) $ do + -- Call the urgencyHook. + userCode $ urgencyHook hook w + -- Clear the bit to prevent repeated notifications, as described above. + io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit } + -- Add to list of urgents. + adjustUrgents (\ws -> if elem w ws then ws else w : ws) + -- Call logHook after IORef has been modified. + userCode =<< asks (logHook . config) + return Nothing + | Just DestroyWindowEvent {ev_window = w} <- fromMessage mess = do + adjustUrgents (delete w) + return Nothing + | otherwise = + return Nothing + +adjustUrgents :: ([Window] -> [Window]) -> X () +adjustUrgents f = io $ modifyIORef urgents f + +urgencyLayoutHook :: (UrgencyHook h Window, LayoutClass l Window) => + h -> l Window -> ModifiedLayout (WithUrgencyHook h) l Window +urgencyLayoutHook hook = ModifiedLayout $ WithUrgencyHook hook + +-------------------------------------------------------------------------------- +-- Urgency Hooks + +-- | The class definition, and some pre-defined instances. + +class (Read h, Show h) => UrgencyHook h a where + urgencyHook :: h -> a -> X () + +data NoUrgencyHook = NoUrgencyHook deriving (Read, Show) + +instance UrgencyHook NoUrgencyHook Window where + urgencyHook _ _ = return () + +data DzenUrgencyHook = DzenUrgencyHook { duration :: Int, args :: [String] } + deriving (Read, Show) + +instance UrgencyHook DzenUrgencyHook Window where + urgencyHook DzenUrgencyHook { duration = d, args = a } w = do + visibles <- gets mapped + name <- getName w + ws <- gets windowset + whenJust (W.findTag w ws) (flash name visibles) + where flash name visibles index = + when (not $ S.member w visibles) $ + dzenWithArgs (show name ++ " requests your attention on workspace " ++ index) a d + +-- | Flashes when a window requests your attention and you can't see it. Configurable +-- duration and args to dzen. +dzenUrgencyHook :: DzenUrgencyHook +dzenUrgencyHook = DzenUrgencyHook { duration = (5 `seconds`), args = [] } + +-- For debugging purposes, really. +data StdoutUrgencyHook = StdoutUrgencyHook deriving (Read, Show) + +instance UrgencyHook StdoutUrgencyHook Window where + urgencyHook _ w = io $ putStrLn $ "Urgent: " ++ show w diff --git a/XMonad/Hooks/XPropManage.hs b/XMonad/Hooks/XPropManage.hs new file mode 100644 --- /dev/null +++ b/XMonad/Hooks/XPropManage.hs @@ -0,0 +1,90 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.XPropManage +-- Copyright : (c) Karsten Schoelzel +-- License : BSD +-- +-- Maintainer : Karsten Schoelzel +-- Stability : unstable +-- Portability : unportable +-- +-- A ManageHook matching on XProperties. +----------------------------------------------------------------------------- + +module XMonad.Hooks.XPropManage ( + -- * Usage + -- $usage + xPropManageHook, XPropMatch, pmX, pmP + ) where + +import Data.Char (chr) +import Data.List (concat) +import Data.Monoid (mconcat, Endo(..)) + +import Control.Monad.Trans (lift) + +import XMonad +import XMonad.ManageHook ((-->)) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.XPropManage +-- > import qualified XMonad.StackSet as W +-- > import XMonad.Actions.TagWindows +-- > import Data.List +-- +-- > 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] -> ManageHook +xPropManageHook tms = mconcat $ map propToHook tms + where + propToHook (ms, f) = fmap and (mapM mkQuery ms) --> mkHook f + mkQuery (a, tf) = fmap tf (getQuery a) + mkHook func = ask >>= Query . lift . fmap Endo . func + +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) + +getQuery :: Atom -> Query [String] +getQuery p = ask >>= \w -> Query . lift $ withDisplay $ \d -> getProp d w p + +splitAtNull :: String -> [String] +splitAtNull s = case dropWhile (== (chr 0)) s of + "" -> [] + s' -> w : splitAtNull s'' + where (w, s'') = break (== (chr 0)) s' diff --git a/XMonad/Layout/Accordion.hs b/XMonad/Layout/Accordion.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/Accordion.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Accordion +-- Copyright : (c) glasser@mit.edu +-- License : BSD +-- +-- Maintainer : glasser@mit.edu +-- Stability : unstable +-- Portability : unportable +-- +-- LayoutClass that puts non-focused windows in ribbons at the top and bottom +-- of the screen. +----------------------------------------------------------------------------- + +module XMonad.Layout.Accordion ( + -- * Usage + -- $usage + Accordion(Accordion)) where + +import XMonad +import qualified XMonad.StackSet as W +import Data.Ratio + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Accordion +-- +-- Then edit your @layoutHook@ by adding the Accordion layout: +-- +-- > myLayouts = Accordion ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +data Accordion a = Accordion deriving ( Read, Show ) + +instance LayoutClass Accordion Window where + pureLayout _ sc ws = zip ups tops ++ [(W.focus ws, mainPane)] ++ zip dns bottoms + where + ups = W.up ws + dns = W.down ws + (top, allButTop) = splitVerticallyBy (1%8 :: Ratio Int) sc + (center, bottom) = splitVerticallyBy (6%7 :: Ratio Int) allButTop + (allButBottom, _) = splitVerticallyBy (7%8 :: Ratio Int) 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 [] diff --git a/XMonad/Layout/Circle.hs b/XMonad/Layout/Circle.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/Circle.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.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 XMonad.Layout.Circle ( + -- * Usage + -- $usage + Circle (..) + ) where -- actually it's an ellipse + +import Data.List +import XMonad +import XMonad.StackSet (integrate, peek) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Circle +-- +-- Then edit your @layoutHook@ by adding the Circle layout: +-- +-- > myLayouts = Circle ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +data Circle a = Circle deriving ( Read, Show ) + +instance LayoutClass Circle Window where + doLayout Circle r s = do layout <- raiseFocus $ circleLayout r $ integrate s + return (layout, Nothing) + +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) ..] + +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 + +center :: Rectangle -> Rectangle +center (Rectangle sx sy sw sh) = Rectangle x y w h + where s = sqrt 2 :: Double + w = round (fromIntegral sw / s) + h = round (fromIntegral sh / s) + 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 + diff --git a/XMonad/Layout/Combo.hs b/XMonad/Layout/Combo.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/Combo.hs @@ -0,0 +1,145 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, + UndecidableInstances, PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Combo +-- Copyright : (c) David Roundy +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- A layout that combines multiple layouts. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.Combo ( + -- * Usage + -- $usage + combineTwo, + CombineTwo + ) where + +import Data.List ( delete, intersect, (\\) ) +import Data.Maybe ( isJust ) +import XMonad hiding (focus) +import XMonad.StackSet ( integrate, Stack(..) ) +import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) ) +import qualified XMonad.StackSet as W ( differentiate ) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Combo +-- +-- and add something like +-- +-- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) +-- +-- to your layouts. +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- combineTwo is a new simple layout combinator. It allows the +-- combination of two layouts using a third to split the screen +-- between the two, but has the advantage of allowing you to +-- dynamically adjust the layout, in terms of the number of windows in +-- each sublayout. To do this, use "XMonad.Layout.WindowNavigation", +-- and add the following key bindings (or something similar): +-- +-- > , ((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) +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". +-- +-- 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 separately, and this is ugly. If you don't like this, +-- lobby for hierarchical stacks in core xmonad or go reimplement the core of +-- xmonad yourself. + +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 ReleaseResources) + l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources) + super' <- maybe super id `fmap` + handleMessage super (SomeMessage ReleaseResources) + return ([], Just $ C2 [] [] super' l1' l2') + arrange [w] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources) + l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources) + super' <- maybe super id `fmap` + handleMessage super (SomeMessage ReleaseResources) + return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2') + 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 + + +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 + +broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l 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 = handleMessage l a `catchX` return Nothing diff --git a/XMonad/Layout/Dishes.hs b/XMonad/Layout/Dishes.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/Dishes.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.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 XMonad.Layout.Dishes ( + -- * Usage + -- $usage + Dishes (..) + ) where + +import Data.List +import XMonad +import XMonad.StackSet (integrate) +import Control.Monad (ap) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Dishes +-- +-- Then edit your @layoutHook@ by adding the Dishes layout: +-- +-- > myLayouts = Dishes 2 (1/6) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +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 + pureMessage (Dishes nmaster h) m = 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 diff --git a/XMonad/Layout/DragPane.hs b/XMonad/Layout/DragPane.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/DragPane.hs @@ -0,0 +1,136 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.DragPane +-- Copyright : (c) Spencer Janssen +-- David Roundy , +-- Andrea Rossato +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Andrea Rossato +-- 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 XMonad.Layout.DragPane ( + -- * Usage + -- $usage + dragPane + , DragPane, DragType (..) + ) where + +import XMonad +import Data.Unique + +import qualified XMonad.StackSet as W +import XMonad.Util.Invisible +import XMonad.Util.XUtils + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.DragPane +-- +-- Then edit your @layoutHook@ by adding the DragPane layout: +-- +-- > myLayouts = dragPane Horizontal 0.1 0.5 ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +halfHandleWidth :: Integral a => a +halfHandleWidth = 1 + +handleColor :: String +handleColor = "#000000" + +dragPane :: DragType -> Double -> Double -> DragPane a +dragPane t x y = DragPane (I Nothing) t x y + +data DragPane a = + DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double + deriving ( Show, Read ) + +data DragType = Horizontal | Vertical deriving ( Show, Read ) + +instance LayoutClass DragPane a where + doLayout d@(DragPane _ Vertical _ _) = doLay id d + doLayout d@(DragPane _ Horizontal _ _) = doLay mirrorRect d + handleMessage = handleMess + +data SetFrac = SetFrac Int Double deriving ( Show, Read, Eq, Typeable ) +instance Message SetFrac + +handleMess :: DragPane a -> SomeMessage -> X (Maybe (DragPane a)) +handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x + | Just e <- fromMessage x :: Maybe Event = do handleEvent d e + return Nothing + | Just Hide <- fromMessage x = do hideWindow win + return $ Just (DragPane mb ty delta split) + | Just ReleaseResources <- fromMessage x = do deleteWindow win + return $ Just (DragPane (I 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 a -> Event -> X () +handleEvent (DragPane (I (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_x r))/(fromIntegral $ rect_width r) + sendMessage (SetFrac ident frac)) + (return ()) +handleEvent _ _ = return () + +doLay :: (Rectangle -> Rectangle) -> DragPane a -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a)) +doLay mirror (DragPane mw ty delta split) r s = do + 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 + I (Just (w,_,ident)) -> do + w' <- deleteWindow w >> newDragWin handr + return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split) + I Nothing -> do + w <- newDragWin handr + i <- io $ newUnique + return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split) + else return (wrs, Nothing) + + +newDragWin :: Rectangle -> X Window +newDragWin r = do + let mask = Just $ exposureMask .|. buttonPressMask + w <- createNewWindow r mask handleColor + showWindow w + return w diff --git a/XMonad/Layout/Grid.hs b/XMonad/Layout/Grid.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/Grid.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Grid +-- Copyright : (c) Lukas Mai +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- A simple layout that attempts to put all windows in a square grid. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.Grid ( + -- * Usage + -- $usage + Grid(..) +) where + +import XMonad +import XMonad.StackSet + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Grid +-- +-- Then edit your @layoutHook@ by adding the Grid layout: +-- +-- > myLayouts = Grid ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +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] diff --git a/XMonad/Layout/HintedTile.hs b/XMonad/Layout/HintedTile.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/HintedTile.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.HintedTile +-- Copyright : (c) Peter De Wachter +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Peter De Wachter +-- Andrea Rossato +-- Stability : unstable +-- Portability : unportable +-- +-- A gapless tiled layout that attempts to obey window size hints, +-- rather than simply ignoring them. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.HintedTile ( + -- * Usage + -- $usage + HintedTile(..), Orientation(..)) where + +import XMonad hiding (Tall(..)) +import qualified XMonad.StackSet as W +import Control.Applicative ((<$>)) +import Control.Monad + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.HintedTile +-- +-- Then edit your @layoutHook@ by adding the HintedTile layout: +-- +-- > myLayouts = HintedTile 1 0.1 0.5 Tall ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +data HintedTile a = HintedTile + { nmaster :: Int + , delta, frac :: Rational + , orientation :: Orientation + } deriving ( Show, Read ) + +data Orientation = Wide | Tall deriving ( Show, Read ) + +instance LayoutClass HintedTile Window where + doLayout (HintedTile { orientation = o, nmaster = nm, frac = f }) r w' = do + bhs <- mapM getHints w + let (masters, slaves) = splitAt nm bhs + return (zip w (tiler masters slaves), Nothing) + where + w = W.integrate w' + tiler masters slaves + | null masters || null slaves = divide o (masters ++ slaves) r + | otherwise = split o f r (divide o masters) (divide o slaves) + + 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 } + + description l = show (orientation l) + +adjBorder :: Dimension -> Dimension -> D -> D +adjBorder n b (w, h) = (w + n * 2 * b, h + n * 2 * b) + +-- | Transform a function on dimensions into one without regard for borders +hintsUnderBorder :: (Dimension, SizeHints) -> D -> D +hintsUnderBorder (bW, h) = adjBorder bW 1 . applySizeHints h . adjBorder bW (-1) + +getHints :: Window -> X (Dimension, SizeHints) +getHints w = withDisplay $ \d -> io $ liftM2 (,) + (fromIntegral . wa_border_width <$> getWindowAttributes d w) + (getWMNormalHints d w) + +-- Divide the screen vertically (horizontally) into n subrectangles +divide :: Orientation -> [(Dimension, SizeHints)] -> Rectangle -> [Rectangle] +divide _ [] _ = [] +divide Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : + (divide Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h))) + where (w, h) = hintsUnderBorder bh (sw, sh `div` fromIntegral (1 + (length bhs))) + +divide Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) : + (divide Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) + where + (w, h) = hintsUnderBorder bh (sw `div` fromIntegral (1 + (length bhs)), sh) + +-- Split the screen into two rectangles, using a rational to specify the ratio +split :: Orientation -> Rational -> Rectangle -> (Rectangle -> [Rectangle]) + -> (Rectangle -> [Rectangle]) -> [Rectangle] +split Tall 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 + +split Wide 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) diff --git a/XMonad/Layout/LayoutCombinators.hs b/XMonad/Layout/LayoutCombinators.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/LayoutCombinators.hs @@ -0,0 +1,216 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.LayoutCombinators +-- Copyright : (c) David Roundy +-- License : BSD +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : portable +-- +-- A module for combining other layouts. +----------------------------------------------------------------------------- + +module XMonad.Layout.LayoutCombinators ( + -- * Usage + -- $usage + + -- * Combinators using DragPane vertical + -- $dpv + (*||*), (**||*),(***||*),(****||*),(***||**),(****||***), + (***||****),(*||****),(**||***),(*||***),(*||**), + + -- * Combinators using DragPane horizontal + -- $dph + (*//*), (**//*),(***//*),(****//*),(***//**),(****//***), + (***//****),(*//****),(**//***),(*//***),(*//**), + + -- * Combinators using Tall (vertical) + -- $tv + (*|*), (**|*),(***|*),(****|*),(***|**),(****|***), + (***|****),(*|****),(**|***),(*|***),(*|**), + + -- * Combinators using Mirror Tall (horizontal) + -- $mth + (*/*), (**/*),(***/*),(****/*),(***/**),(****/***), + (***/****),(*/****),(**/***),(*/***),(*/**), + + -- * A new combinator + -- $nc + (|||), + JumpToLayout(JumpToLayout) + ) where + +import Data.Maybe ( isJust, isNothing ) + +import XMonad hiding ((|||)) +import XMonad.Layout.Combo +import XMonad.Layout.DragPane + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.LayoutCombinators hiding ( (|||) ) +-- +-- Then edit your @layoutHook@ by using the new layout combinators: +-- +-- > myLayouts = (Tall 1 (3/100) (1/2) *//* Full) ||| (Tall 1 (3/100) (1/2) ***||** Full) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, **||***, *||***, *||**, + *//*, **//*, ***//*, ****//*, ***//**, ****//***, ***//****, *//****, **//***, *//***, *//**, + *|* , **|* , ***|* , ****|* , ***|** , ****|*** , ***|**** , *|**** , **|*** , *|*** , *|** , + */* , **/* , ***/* , ****/* , ***/** , ****/*** , ***/**** , */**** , **/*** , */*** , */** + +-- $dpv +-- These combinators combine two layouts using "XMonad.DragPane" in +-- vertical mode. +(*||*),(**||*),(***||*),(****||*), (***||**),(****||***), + (***||****),(*||****),(**||***),(*||***),(*||**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => + l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a + +(*||*) = combineTwo (dragPane Vertical 0.1 (1/2)) +(**||*) = combineTwo (dragPane Vertical 0.1 (2/3)) +(***||*) = combineTwo (dragPane Vertical 0.1 (3/4)) +(****||*) = combineTwo (dragPane Vertical 0.1 (4/5)) +(***||**) = combineTwo (dragPane Vertical 0.1 (3/5)) +(****||***) = combineTwo (dragPane Vertical 0.1 (4/7)) +(***||****) = combineTwo (dragPane Vertical 0.1 (3/7)) +(*||****) = combineTwo (dragPane Vertical 0.1 (1/5)) +(**||***) = combineTwo (dragPane Vertical 0.1 (2/5)) +(*||***) = combineTwo (dragPane Vertical 0.1 (1/4)) +(*||**) = combineTwo (dragPane Vertical 0.1 (1/3)) + +-- $dph +-- These combinators combine two layouts using "XMonad.DragPane" in +-- horizontal mode. +(*//*),(**//*),(***//*),(****//*), (***//**),(****//***), + (***//****),(*//****),(**//***),(*//***),(*//**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => + l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a + +(*//*) = combineTwo (dragPane Horizontal 0.1 (1/2)) +(**//*) = combineTwo (dragPane Horizontal 0.1 (2/3)) +(***//*) = combineTwo (dragPane Horizontal 0.1 (3/4)) +(****//*) = combineTwo (dragPane Horizontal 0.1 (4/5)) +(***//**) = combineTwo (dragPane Horizontal 0.1 (3/5)) +(****//***) = combineTwo (dragPane Horizontal 0.1 (4/7)) +(***//****) = combineTwo (dragPane Horizontal 0.1 (3/7)) +(*//****) = combineTwo (dragPane Horizontal 0.1 (1/5)) +(**//***) = combineTwo (dragPane Horizontal 0.1 (2/5)) +(*//***) = combineTwo (dragPane Horizontal 0.1 (1/4)) +(*//**) = combineTwo (dragPane Horizontal 0.1 (1/3)) + +-- $tv +-- These combinators combine two layouts vertically using Tall. +(*|*),(**|*),(***|*),(****|*), (***|**),(****|***), + (***|****),(*|****),(**|***),(*|***),(*|**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) + => l1 a -> l2 a -> CombineTwo (Tall ()) l1 l2 a +(*|*) = combineTwo (Tall 1 0.1 (1/2)) +(**|*) = combineTwo (Tall 1 0.1 (2/3)) +(***|*) = combineTwo (Tall 1 0.1 (3/4)) +(****|*) = combineTwo (Tall 1 0.1 (4/5)) +(***|**) = combineTwo (Tall 1 0.1 (3/5)) +(****|***) = combineTwo (Tall 1 0.1 (4/7)) +(***|****) = combineTwo (Tall 1 0.1 (3/7)) +(*|****) = combineTwo (Tall 1 0.1 (1/5)) +(**|***) = combineTwo (Tall 1 0.1 (2/5)) +(*|***) = combineTwo (Tall 1 0.1 (1/4)) +(*|**) = combineTwo (Tall 1 0.1 (1/3)) + + +-- $mth +-- These combinators combine two layouts horizontally using Mirror +-- Tall (a wide layout). +(*/*),(**/*),(***/*),(****/*), (***/**),(****/***), + (***/****),(*/****),(**/***),(*/***),(*/**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) + => l1 a -> l2 a -> CombineTwo (Mirror Tall ()) l1 l2 a +(*/*) = combineTwo (Mirror $ Tall 1 0.1 (1/2)) +(**/*) = combineTwo (Mirror $ Tall 1 0.1 (2/3)) +(***/*) = combineTwo (Mirror $ Tall 1 0.1 (3/4)) +(****/*) = combineTwo (Mirror $ Tall 1 0.1 (4/5)) +(***/**) = combineTwo (Mirror $ Tall 1 0.1 (3/5)) +(****/***) = combineTwo (Mirror $ Tall 1 0.1 (4/7)) +(***/****) = combineTwo (Mirror $ Tall 1 0.1 (3/7)) +(*/****) = combineTwo (Mirror $ Tall 1 0.1 (1/5)) +(**/***) = combineTwo (Mirror $ Tall 1 0.1 (2/5)) +(*/***) = combineTwo (Mirror $ Tall 1 0.1 (1/4)) +(*/**) = combineTwo (Mirror $ Tall 1 0.1 (1/3)) + +infixr 5 ||| + +-- $nc +-- A new layout combinator that allows the use of a prompt to change +-- layout. For more information see "Xmonad.Prompt.Layout" +(|||) :: (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 + +data JumpToLayout = JumpToLayout String deriving ( Read, Show, Typeable ) +instance Message JumpToLayout + +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 + handleMessage l@(NewSelect False _ _) m + | Just Wrap <- fromMessage m = fmap Just $ swap l >>= passOn m + handleMessage l@(NewSelect amfirst _ _) m + | Just NextLayoutNoWrap <- fromMessage m = + if amfirst then when' isNothing (passOnM m l) $ + fmap Just $ swap l >>= passOn (SomeMessage Wrap) + else passOnM m l + handleMessage l m + | Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $ + fmap Just $ swap l >>= passOn (SomeMessage Wrap) + handleMessage l@(NewSelect True _ l2) m + | Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just `fmap` swap l + handleMessage l@(NewSelect False l1 _) m + | Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just `fmap` swap l + handleMessage l m + | Just (JumpToLayout _) <- fromMessage m = when' isNothing (passOnM m l) $ + do ml' <- passOnM m $ sw l + case ml' of + Nothing -> return Nothing + Just l' -> Just `fmap` swap (sw l') + 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 l m = passOnM m l + +swap :: (LayoutClass l1 a, LayoutClass l2 a) => NewSelect l1 l2 a -> X (NewSelect l1 l2 a) +swap l = sw `fmap` passOn (SomeMessage Hide) l + +sw :: NewSelect l1 l2 a -> NewSelect l1 l2 a +sw (NewSelect b lt lf) = NewSelect (not b) lt lf + +passOn :: (LayoutClass l1 a, LayoutClass l2 a) => + SomeMessage -> NewSelect l1 l2 a -> X (NewSelect l1 l2 a) +passOn m l = maybe l id `fmap` passOnM m l + +passOnM :: (LayoutClass l1 a, LayoutClass l2 a) => + SomeMessage -> NewSelect l1 l2 a -> X (Maybe (NewSelect l1 l2 a)) +passOnM m (NewSelect True lt lf) = do mlt' <- handleMessage lt m + return $ (\lt' -> NewSelect True lt' lf) `fmap` mlt' +passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m + return $ (\lf' -> NewSelect False lt lf') `fmap` mlf' + +when' :: Monad m => (a -> Bool) -> m a -> m a -> m a +when' f a b = do a1 <- a; if f a1 then b else return a1 + diff --git a/XMonad/Layout/LayoutHints.hs b/XMonad/Layout/LayoutHints.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/LayoutHints.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.LayoutHints +-- Copyright : (c) David Roundy +-- License : BSD +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : portable +-- +-- Make layouts respect size hints. +----------------------------------------------------------------------------- + +module XMonad.Layout.LayoutHints ( + -- * usage + -- $usage + layoutHints, + LayoutHints) where + +import XMonad hiding ( trace ) +import XMonad.Layout.LayoutModifier + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.LayoutHints +-- +-- Then edit your @layoutHook@ by adding the LayoutHints layout modifier +-- to some layout: +-- +-- > myLayouts = layoutHints (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +layoutHints :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHints l a +layoutHints = ModifiedLayout LayoutHints + +-- | Expand a size by the given multiple of the border width. The +-- multiple is most commonly 1 or -1. +adjBorders :: Dimension -> Dimension -> D -> D +adjBorders bW mult (w,h) = (w+2*mult*bW, h+2*mult*bW) + +data LayoutHints a = LayoutHints deriving (Read, Show) + +instance LayoutModifier LayoutHints Window where + modifierDescription _ = "Hinted" + redoLayout _ _ _ xs = do + bW <- asks (borderWidth . config) + xs' <- mapM (applyHint bW) xs + return (xs', Nothing) + where + applyHint bW (w,Rectangle a b c d) = + withDisplay $ \disp -> do + sh <- io $ getWMNormalHints disp w + let (c',d') = adjBorders 1 bW . applySizeHints sh . adjBorders bW (-1) $ (c,d) + return (w, Rectangle a b c' d') diff --git a/XMonad/Layout/LayoutModifier.hs b/XMonad/Layout/LayoutModifier.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/LayoutModifier.hs @@ -0,0 +1,74 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.LayoutModifier +-- Copyright : (c) David Roundy +-- License : BSD +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : portable +-- +-- A module for writing easy Llayouts and layout modifiers +----------------------------------------------------------------------------- + +module XMonad.Layout.LayoutModifier ( + -- * Usage + -- $usage + LayoutModifier(..), ModifiedLayout(..) + ) where + +import XMonad +import XMonad.StackSet ( Stack ) + +-- $usage +-- Use LayoutModifier to help write easy Layouts. +-- +-- LayouModifier defines a class 'LayoutModifier'. Each method as a +-- default implementation. +-- +-- For usage examples you can see "XMonad.Layout.WorkspaceDir", +-- "XMonad.Layout.Magnifier", "XMonad.Layout.NoBorder", + +class (Show (m a), Read (m a)) => LayoutModifier m a where + handleMess :: m a -> SomeMessage -> X (Maybe (m a)) + handleMess m mess | Just Hide <- fromMessage mess = doUnhook + | Just ReleaseResources <- fromMessage mess = doUnhook + | otherwise = return Nothing + where doUnhook = do unhook m; return Nothing + handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage)) + handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess + return (Left `fmap` mm') + redoLayout :: m a -> Rectangle -> Stack a -> [(a, Rectangle)] + -> X ([(a, Rectangle)], Maybe (m a)) + redoLayout m _ _ wrs = do hook m; return (wrs, Nothing) + hook :: m a -> X () + hook _ = return () + unhook :: m a -> X () + unhook _ = return () + modifierDescription :: m a -> String + modifierDescription = const "" + +instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (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'') + handleMessage (ModifiedLayout m l) mess = + do mm' <- handleMessOrMaybeModifyIt m mess + ml' <- case mm' of + Just (Right mess') -> handleMessage l mess' + _ -> handleMessage l mess + return $ case mm' of + Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml' + _ -> (ModifiedLayout m) `fmap` ml' + description (ModifiedLayout m l) = modifierDescription m <> description l + where "" <> x = x + x <> y = x ++ " " ++ y + +data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show ) diff --git a/XMonad/Layout/LayoutScreens.hs b/XMonad/Layout/LayoutScreens.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/LayoutScreens.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.LayoutScreens +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.LayoutScreens ( + -- * Usage + -- $usage + layoutScreens, fixedLayout + ) where + +import XMonad +import qualified XMonad.StackSet as W + +-- $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 +-- screen and long for greater flexibility (e.g. being able to see your +-- email window at all times, a crude mimic of sticky windows). +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Layout.LayoutScreens +-- +-- Then add some keybindings; for example: +-- +-- > , ((modMask .|. shiftMask, xK_space), layoutScreens 2 (TwoPane 0.5 0.5)) +-- > , ((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 XMonad.Layout.LayoutScreens +-- +-- > , ((modMask .|. shiftMask, xK_space), +-- > layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768])) +-- > , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen) +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +layoutScreens :: LayoutClass l Int => Int -> l 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] } + 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 + gaps = map (statusGap . W.screenDetail) $ v:vs + (s:ss, g:gg) = (map snd wss, take nscr $ gaps ++ repeat (head gaps)) + in ws { W.current = W.Screen x 0 (SD s g) + , W.visible = zipWith3 W.Screen xs [1 ..] $ zipWith SD ss gg + , 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) + +data FixedLayout a = FixedLayout [Rectangle] deriving (Read,Show) + +instance LayoutClass FixedLayout a where + doLayout (FixedLayout rs) _ s = return (zip (W.integrate s) rs, Nothing) + +fixedLayout :: [Rectangle] -> FixedLayout a +fixedLayout = FixedLayout diff --git a/XMonad/Layout/MagicFocus.hs b/XMonad/Layout/MagicFocus.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/MagicFocus.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.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 XMonad.Layout.MagicFocus + (-- * Usage + -- $usage + MagicFocus(MagicFocus) + ) where + +import XMonad +import XMonad.StackSet + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.MagicFocus +-- +-- Then edit your @layoutHook@ by adding the MagicFocus layout +-- modifier: +-- +-- > myLayouts = MagicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +data MagicFocus l a = MagicFocus (l a) deriving ( Show , Read ) + +instance (LayoutClass l Window) => LayoutClass (MagicFocus l) Window where + doLayout = magicFocus + +magicFocus :: LayoutClass l Window => MagicFocus l Window -> Rectangle + -> Stack Window -> X ([(Window, Rectangle)], Maybe (MagicFocus l Window)) +magicFocus (MagicFocus l) r s = + withWindowSet $ \wset -> do + (ws,nl) <- doLayout l r (swap s $ peek wset) + case nl of + Nothing -> return (ws, Nothing) + Just l' -> return (ws, Just $ MagicFocus l') + +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 diff --git a/XMonad/Layout/Magnifier.hs b/XMonad/Layout/Magnifier.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/Magnifier.hs @@ -0,0 +1,119 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Magnifier +-- Copyright : (c) Peter De Wachter and Andrea Rossato 2007 +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- Screenshot : +-- +-- This is a layout modifier that will make a layout increase the size +-- of the window that has focus. +-- +----------------------------------------------------------------------------- + + +module XMonad.Layout.Magnifier + ( -- * Usage + -- $usage + magnifier, + magnifier', + MagnifyMsg (..) + ) where + +import XMonad +import XMonad.StackSet +import XMonad.Layout.LayoutModifier + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Magnifier +-- +-- Then edit your @layoutHook@ by adding the Magnifier layout modifier +-- to some layout: +-- +-- > myLayouts = magnifier (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- Magnifier supports some commands. To use them add something like +-- this to your key bindings: +-- +-- > , ((modMask x .|. controlMask , xK_plus ), sendMessage MagnifyMore) +-- > , ((modMask x .|. controlMask , xK_minus), sendMessage MagnifyLess) +-- > , ((modMask x .|. controlMask , xK_o ), sendMessage ToggleOff ) +-- > , ((modMask x .|. controlMask .|. shiftMask, xK_o ), sendMessage ToggleOn ) +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +-- | Increase the size of the window that has focus +magnifier :: l a -> ModifiedLayout Magnifier l a +magnifier = ModifiedLayout (Mag 1.5 On All) + +-- | Increase the size of the window that has focus, unless if it is the +-- master window. +magnifier' :: l a -> ModifiedLayout Magnifier l a +magnifier' = ModifiedLayout (Mag 1.5 On NoMaster) + +data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff deriving ( Typeable ) +instance Message MagnifyMsg + +data Magnifier a = Mag Zoom Toggle MagnifyMaster deriving (Read, Show) + +type Zoom = Double + +data Toggle = On | Off deriving (Read, Show) +data MagnifyMaster = All | NoMaster deriving (Read, Show) + +instance LayoutModifier Magnifier Window where + redoLayout (Mag z On All ) = applyMagnifier z + redoLayout (Mag z On NoMaster) = unlessMaster $ applyMagnifier z + redoLayout _ = nothing + where nothing _ _ wrs = return (wrs, Nothing) + + handleMess (Mag z On t) m + | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z + 0.1) On t) + | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z - 0.1) On t) + | Just ToggleOff <- fromMessage m = return . Just $ (Mag (z + 0.1) Off t) + handleMess (Mag z Off t) m + | Just ToggleOn <- fromMessage m = return . Just $ (Mag z On t) + handleMess _ _ = return Nothing + + modifierDescription (Mag _ On All ) = "Magnifier" + modifierDescription (Mag _ On NoMaster) = "Magnifier NoMaster" + modifierDescription (Mag _ Off _ ) = "Magnifier (off)" + +type NewLayout a = Rectangle -> Stack a -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe (Magnifier a)) + +unlessMaster :: NewLayout a -> NewLayout a +unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing) + else mainmod r s wrs + +applyMagnifier :: Double -> Rectangle -> t -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe a) +applyMagnifier z r _ wrs = do focused <- withWindowSet (return . peek) + let mag (w,wr) ws | focused == Just w = ws ++ [(w, shrink r $ magnify z wr)] + | otherwise = (w,wr) : ws + return (reverse $ foldr mag [] wrs, Nothing) + +magnify :: Double -> Rectangle -> Rectangle +magnify zoom (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 + +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') diff --git a/XMonad/Layout/Maximize.hs b/XMonad/Layout/Maximize.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/Maximize.hs @@ -0,0 +1,79 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.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 XMonad.Layout.Maximize ( + -- * Usage + -- $usage + maximize, + maximizeRestore + ) where + +import XMonad +import XMonad.Layout.LayoutModifier +import Data.List ( partition ) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Maximize +-- +-- Then edit your @layoutHook@ by adding the Maximize layout modifier: +-- +-- > myLayouts = maximize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- In the key-bindings, do something like: +-- +-- > , ((modMask x, xK_backslash), withFocused (sendMessage . maximizeRestore)) +-- > ... +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". + +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 diff --git a/XMonad/Layout/Mosaic.hs b/XMonad/Layout/Mosaic.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/Mosaic.hs @@ -0,0 +1,485 @@ +{-# OPTIONS -fglasgow-exts #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.Mosaic +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- This module defines a \"mosaic\" layout, which tries to give each window a +-- user-configurable relative area, while also trying to give them aspect +-- ratios configurable at run-time by the user. +-- +----------------------------------------------------------------------------- +module XMonad.Layout.Mosaic ( + -- * Usage + -- $usage + mosaic, expandWindow, shrinkWindow, squareWindow, myclearWindow, + tallWindow, wideWindow, flexibleWindow, + getName ) where + +import Control.Monad.State ( State, put, get, runState ) +import System.Random ( StdGen, mkStdGen ) +import Data.Maybe ( isJust ) + +import XMonad hiding ( trace ) +import qualified XMonad.StackSet as W +import qualified Data.Map as M +import Data.List ( sort ) +import Data.Typeable ( Typeable ) +import Control.Monad ( mplus ) + +import XMonad.Util.NamedWindows +import XMonad.Util.Anneal + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Mosaic +-- +-- Then edit your @layoutHook@ by adding the Mosaic layout: +-- +-- > myLayouts = mosaic 0.25 0.5 ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- In the key-bindings, do something like: +-- +-- > , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow)) +-- > , ((controlMask .|. modMask x .|. shiftMask, xK_l), withFocused (sendMessage . wideWindow)) +-- > , ((modMask x .|. shiftMask, xK_h ), withFocused (sendMessage . shrinkWindow)) +-- > , ((modMask x .|. shiftMask, xK_l ), withFocused (sendMessage . expandWindow)) +-- > , ((modMask x .|. shiftMask, xK_s ), withFocused (sendMessage . squareWindow)) +-- > , ((modMask x .|. shiftMask, xK_o ), withFocused (sendMessage . myclearWindow)) +-- > , ((controlMask .|. modMask x .|. shiftMask, xK_o ), withFocused (sendMessage . flexibleWindow)) +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data HandleWindow = ExpandWindow Window | ShrinkWindow Window + | SquareWindow Window | ClearWindow Window + | TallWindow Window | WideWindow Window + | FlexibleWindow Window + deriving ( Typeable, Eq ) + +instance Message HandleWindow + +expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: Window -> HandleWindow +expandWindow = ExpandWindow +shrinkWindow = ShrinkWindow +squareWindow = SquareWindow +flexibleWindow = FlexibleWindow +myclearWindow = ClearWindow +tallWindow = TallWindow +wideWindow = WideWindow + +largeNumber :: Int +largeNumber = 50 + +defaultArea :: Double +defaultArea = 1 + +flexibility :: Double +flexibility = 0.1 + +mosaic :: Double -> Double -> MosaicLayout Window +mosaic d t = Mosaic d t M.empty + +data MosaicLayout a = Mosaic Double Double (M.Map Window [WindowHint]) + deriving ( Show, Read ) + +instance LayoutClass MosaicLayout Window where + doLayout (Mosaic _ t h) r st = do all_hints <- add_hints (W.integrate st) h + mosaicL t all_hints r (W.integrate st) + where add_hints [] x = return x + add_hints (w:ws) x = + do z <- withDisplay $ \d -> io $ getWMNormalHints d w + let set_asp = case map4 `fmap` sh_aspect z of + Just ((minx,miny),(maxx,maxy)) + | or [minx < 1, miny < 1, maxx < 1, maxy < 1] -> id + | minx/miny == maxx/maxy -> set_aspect_ratio (minx/miny) w + _ -> id + add_hints ws $ set_MinX z w $ set_MinY z w $ set_MaxX z w $ set_MaxY z w $ set_asp x + map4 :: Integral a => ((a,a),(a,a)) -> ((Double,Double),(Double,Double)) + map4 ((a,b),(c,d)) = ((fromIntegral a,fromIntegral b),(fromIntegral c,fromIntegral d)) + + pureMessage (Mosaic d t h) m = (m1 `fmap` fromMessage m) `mplus` (m2 `fmap` fromMessage m) + where + m1 Shrink = Mosaic d (t/(1+d)) h + m1 Expand = Mosaic d (t*(1+d)) h + m2 (ExpandWindow w) = Mosaic d t (multiply_area (1+d) w h) + m2 (ShrinkWindow w) = Mosaic d t (multiply_area (1/(1+ d)) w h) + m2 (SquareWindow w) = Mosaic d t (set_aspect_ratio 1 w h) + m2 (FlexibleWindow w) = Mosaic d t (make_flexible w h) + m2 (TallWindow w) = Mosaic d t (multiply_aspect (1/(1+d)) w h) + m2 (WideWindow w) = Mosaic d t (multiply_aspect (1+d) w h) + m2 (ClearWindow w) = Mosaic d t (M.delete w h) + + description _ = "mosaic" + +multiply_area :: Double -> Window + -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] +multiply_area a = alterlist f where f [] = [RelArea (defaultArea*a)] + f (RelArea a':xs) = RelArea (a'*a) : xs + f (x:xs) = x : f xs + +set_aspect_ratio :: Double -> Window + -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] +set_aspect_ratio r = alterlist f where f [] = [AspectRatio r] + f (FlexibleAspectRatio _:x) = AspectRatio r:x + f (AspectRatio _:x) = AspectRatio r:x + f (x:xs) = x:f xs + +make_flexible :: Window + -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] +make_flexible = alterlist (map f) where f (AspectRatio r) = FlexibleAspectRatio r + f (FlexibleAspectRatio r) = AspectRatio r + f x = x + +multiply_aspect :: Double -> Window + -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] +multiply_aspect r = alterlist f where f [] = [FlexibleAspectRatio r] + f (AspectRatio r':x) = AspectRatio (r*r'):x + f (FlexibleAspectRatio r':x) = FlexibleAspectRatio (r*r'):x + f (x:xs) = x:f xs + +set_MaxX :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] +set_MaxX h | Just (_,mx) <- sh_max_size h = replaceinmap (isJust . isMaxX) (MaxX $ fromIntegral mx) + | otherwise = const id + +set_MaxY :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] +set_MaxY h | Just (_,mx) <- sh_max_size h = replaceinmap (isJust . isMaxY) (MaxY $ fromIntegral mx) + | otherwise = const id + +isMaxX,isMaxY :: WindowHint -> Maybe Dimension +isMaxX (MaxX x) = Just x +isMaxX _ = Nothing +isMaxY (MaxY x) = Just x +isMaxY _ = Nothing + +set_MinX :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] +set_MinX h | Just (mx,_) <- sh_min_size h = replaceinmap isMinX (MinX $ fromIntegral mx) + | otherwise = const id + where isMinX (MinX _) = True + isMinX _ = False + +set_MinY :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint] +set_MinY h | Just (_,mx) <- sh_min_size h = replaceinmap isMinY (MinY $ fromIntegral mx) + | otherwise = const id + where isMinY (MinY _) = True + isMinY _ = False + +replaceinmap :: Ord a => (a -> Bool) -> a -> Window -> M.Map Window [a] -> M.Map Window [a] +replaceinmap repl v = alterlist f where f [] = [v] + f (x:xs) | repl x = v:xs + | otherwise = x:f xs + +findlist :: Window -> M.Map Window [a] -> [a] +findlist = M.findWithDefault [] + +alterlist :: (Ord a) => ([a] -> [a]) -> Window -> M.Map Window [a] -> M.Map Window [a] +alterlist f k = M.alter f' k + where f' Nothing = f' (Just []) + f' (Just xs) = case f xs of + [] -> Nothing + xs' -> Just xs' + +mosaicL :: Double -> M.Map Window [WindowHint] + -> Rectangle -> [Window] -> X ([(Window, Rectangle)],Maybe (MosaicLayout Window)) +mosaicL _ _ _ [] = return ([], Nothing) +mosaicL f hints origRect origws + = do let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) origws + -- TODO: remove all this dead code + myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws + myv2 = mc_mosaic sortedws Vertical + myh2 = mc_mosaic sortedws Horizontal +-- myv2 = maxL $ runCountDown largeNumber $ +-- sequence $ replicate mediumNumber $ +-- mosaic_splits one_split origRect Vertical sortedws + myh = runCountDown largeNumber $ mosaic_splits even_split origRect Horizontal sortedws +-- myh2 = maxL $ runCountDown largeNumber $ +-- sequence $ replicate mediumNumber $ +-- mosaic_splits one_split origRect Horizontal sortedws + return (map (\(w,r)->(--trace ("rate1:"++ unlines [show nw, + -- show $ rate f meanarea (findlist nw hints) r, + -- show r, + -- show $ area r/meanarea, + -- show $ findlist nw hints]) $ + w,crop' (findlist w hints) r)) $ + flattenMosaic $ the_value $ maxL [myh,myv,myh2,myv2], Nothing) + where mosaic_splits _ _ _ [] = return $ Rated 0 $ M [] + mosaic_splits _ r _ [w] = return $ Rated (rate f meanarea (findlist w hints) r) $ OM (w,r) + mosaic_splits spl r d ws = maxL `fmap` mapCD (spl r d) (init $ allsplits ws) + even_split :: Rectangle -> CutDirection -> [[Window]] + -> State CountDown (Rated Double (Mosaic (Window, Rectangle))) + even_split r d [ws] = even_split r d $ map (:[]) ws + even_split r d wss = + do let areas = map sumareas wss + maxds = map (maxd d) wss + let wsr_s :: [([Window], Rectangle)] + wsr_s = zip wss (partitionR d r maxds areas) + submosaics <- mapM (\(ws',r') -> + mosaic_splits even_split r' (otherDirection d) ws') wsr_s + return $ fmap M $ catRated submosaics + {- + another_mosaic :: [Window] -> CutDirection + -> Rated Double (Mosaic (Window,Rectangle)) + another_mosaic ws d = rate_mosaic ratew $ + rect_mosaic origRect d $ + zipML (example_mosaic ws) (map findarea ws) + -} + mc_mosaic :: [Window] -> CutDirection + -> Rated Double (Mosaic (Window,Rectangle)) + mc_mosaic ws d = fmap (rect_mosaic origRect d) $ + annealMax (zipML (example_mosaic ws) (map findarea ws)) + (the_rating . rate_mosaic ratew . rect_mosaic origRect d ) + changeMosaic + + ratew :: (Window,Rectangle) -> Double + ratew (w,r) = rate f meanarea (findlist w hints) r + example_mosaic :: [Window] -> Mosaic Window + example_mosaic ws = M (map OM ws) + rect_mosaic :: Rectangle -> CutDirection -> Mosaic (a,Double) -> Mosaic (a,Rectangle) + rect_mosaic r _ (OM (w,_)) = OM (w,r) + rect_mosaic r d (M ws) = M $ zipWith (\w' r' -> rect_mosaic r' d' w') ws rs + where areas = map (sum . map snd . flattenMosaic) ws + maxds = repeat 1 + rs = partitionR d r maxds areas + d' = otherDirection d + rate_mosaic :: ((Window,Rectangle) -> Double) + -> Mosaic (Window,Rectangle) -> Rated Double (Mosaic (Window,Rectangle)) + rate_mosaic r m = catRatedM $ fmap (\x -> Rated (r x) x) m +{- + one_split :: Rectangle -> CutDirection -> [[Window]] + -> State CountDown (Rated Double (Mosaic (Window, Rectangle))) + one_split r d [ws] = one_split r d $ map (:[]) ws + one_split r d wss = + do rnd <- mapM (const (fractional resolutionNumber)) [1..length wss] + let wsr_s :: [([Window], Rectangle)] + wsr_s = zip wss (partitionR d r rnd) + submosaics <- mapM (\(ws',r') -> + mosaic_splits even_split r' (otherDirection d) ws') wsr_s + return $ fmap M $ catRated submosaics +-} + partitionR :: CutDirection -> Rectangle -> [Dimension] -> [Double] -> [Rectangle] + partitionR _ _ _ [] = [] + partitionR _ _ [] _ = [] + partitionR _ r _ [_] = [r] + partitionR d r (m:ms) (a:ars) = r1 : partitionR d r2 ms ars + where totarea = sum (a:ars) + totd = fromIntegral $ dimR d r + (r1,r2) = if a/totarea > fromIntegral m / totd + then if a/totarea > 1 - fromIntegral (sum ms) / totd + then split d (1 - fromIntegral (sum ms) / totd) r + else split d (a/totarea) r + else split d (fromIntegral m / totd) r + theareas = hints2area `fmap` hints + sumareas ws = sum $ map findarea ws + maxd Vertical ws = maximum $ map (findhinted isMaxY 3) ws + maxd Horizontal ws = maximum $ map (findhinted isMaxX 3) ws + findarea :: Window -> Double + findarea w = M.findWithDefault 1 w theareas + findhinted fh d w = fh' $ M.findWithDefault [] w hints + where fh' [] = d + fh' (h:hs) | Just x <- fh h = x + | otherwise = fh' hs + meanarea = area origRect / fromIntegral (length origws) + +dimR :: CutDirection -> Rectangle -> Dimension +dimR Vertical (Rectangle _ _ _ h) = h +dimR Horizontal (Rectangle _ _ w _) = w + +maxL :: Ord a => [a] -> a +maxL [] = error "maxL on empty list" +maxL [a] = a +maxL (a:b:c) = maxL (max a b:c) + +catRated :: Floating v => [Rated v a] -> Rated v [a] +catRated xs = Rated (product $ map the_rating xs) (map the_value xs) + +catRatedM :: Floating v => Mosaic (Rated v a) -> Rated v (Mosaic a) +catRatedM (OM (Rated v x)) = Rated v (OM x) +catRatedM (M xs) = case catRated $ map catRatedM xs of Rated v xs' -> Rated v (M xs') + +data CountDown = CD !StdGen !Int + +tries_left :: State CountDown Int +tries_left = do CD _ n <- get + return (max 0 n) + +mapCD :: (a -> State CountDown b) -> [a] -> State CountDown [b] +mapCD f xs = do n <- tries_left + let len = length xs + mapM (run_with_only ((n `div` len)+1) . f) $ take (n+1) xs + +run_with_only :: Int -> State CountDown a -> State CountDown a +run_with_only limit j = + do CD g n <- get + let leftover = n - limit + if leftover < 0 then j + else do put $ CD g limit + x <- j + CD g' n' <- get + put $ CD g' (leftover + n') + return x + +data WindowHint = RelArea Double + | MaxX Dimension + | MaxY Dimension + | MinX Dimension + | MinY Dimension + | AspectRatio Double + | FlexibleAspectRatio Double + deriving ( Show, Read, Eq, Ord ) + +fixedAspect :: [WindowHint] -> Bool +fixedAspect [] = False +fixedAspect (AspectRatio _:_) = True +fixedAspect (_:x) = fixedAspect x + +rate :: Double -> Double -> [WindowHint] -> Rectangle -> Double +rate defaulta meanarea xs rr + | fixedAspect xs = (area (crop xs rr) / meanarea) ** weight + | otherwise = (area rr / meanarea)**(weight-flexibility) + * (area (crop (xs++[FlexibleAspectRatio defaulta]) rr) / meanarea)**flexibility + where weight = hints2area xs + +crop1 :: WindowHint -> Rectangle -> Rectangle +crop1 (FlexibleAspectRatio f) r = cropit f r +crop1 h r = crop1' h r + +crop1' :: WindowHint -> Rectangle -> Rectangle +crop1' (AspectRatio f) r = cropit f r +crop1' (FlexibleAspectRatio f) r = cropit f r +crop1' (MaxX xm) (Rectangle x y w h) | w > xm = Rectangle x y xm h + | otherwise = Rectangle x y w h +crop1' (MaxY xm) (Rectangle x y w h) | h > xm = Rectangle x y w xm + | otherwise = Rectangle x y w h +crop1' _ r = r + +crop :: [WindowHint] -> Rectangle -> Rectangle +crop (h:hs) = crop hs . crop1 h +crop [] = id + +crop' :: [WindowHint] -> Rectangle -> Rectangle +crop' (h:hs) = crop' hs . crop1' h +crop' [] = id + +cropit :: Double -> Rectangle -> Rectangle +cropit f (Rectangle a b w h) | w -/- h > f = Rectangle a b (ceiling $ h -* f) h + | otherwise = Rectangle a b w (ceiling $ w -/ f) + +hints2area :: [WindowHint] -> Double +hints2area [] = defaultArea +hints2area (RelArea r:_) = r +hints2area (_:x) = hints2area x + +area :: Rectangle -> Double +area (Rectangle _ _ w h) = fromIntegral w * fromIntegral h + +(-/-) :: (Integral a, Integral b) => a -> b -> Double +a -/- b = fromIntegral a / fromIntegral b + +(-/) :: (Integral a) => a -> Double -> Double +a -/ b = fromIntegral a / b + +(-*) :: (Integral a) => a -> Double -> Double +a -* b = fromIntegral a * b + +split :: CutDirection -> Double -> Rectangle -> (Rectangle, Rectangle) +split d frac r | frac <= 0 || frac >= 1 = split d 0.5 r +split Vertical frac (Rectangle sx sy sw sh) = (Rectangle sx sy sw h, + Rectangle sx (sy+fromIntegral h) sw (sh-h)) + where h = floor $ fromIntegral sh * frac +split Horizontal frac (Rectangle sx sy sw sh) = (Rectangle sx sy w sh, + Rectangle (sx+fromIntegral w) sy (sw-w) sh) + where w = floor $ fromIntegral sw * frac + +data CutDirection = Vertical | Horizontal +otherDirection :: CutDirection -> CutDirection +otherDirection Vertical = Horizontal +otherDirection Horizontal = Vertical + +data Mosaic a = M [Mosaic a] | OM a + deriving ( Show ) + +instance Functor Mosaic where + fmap f (OM x) = OM (f x) + fmap f (M xs) = M (map (fmap f) xs) + +zipMLwith :: (a -> b -> c) -> Mosaic a -> [b] -> Mosaic c +zipMLwith f (OM x) (y:_) = OM (f x y) +zipMLwith _ (OM _) [] = error "bad zipMLwith" +zipMLwith f (M xxs) yys = makeM $ foo xxs yys + where foo (x:xs) ys = zipMLwith f x (take (lengthM x) ys) : + foo xs (drop (lengthM x) ys) + foo [] _ = [] + +zipML :: Mosaic a -> [b] -> Mosaic (a,b) +zipML = zipMLwith (\a b -> (a,b)) + +lengthM :: Mosaic a -> Int +lengthM (OM _) = 1 +lengthM (M x) = sum $ map lengthM x + +changeMosaic :: Mosaic a -> [Mosaic a] +changeMosaic (OM _) = [] +changeMosaic (M xs) = map makeM (concatenations xs) ++ + map makeM (splits xs) ++ + map M (tryAll changeMosaic xs) + +tryAll :: (a -> [a]) -> [a] -> [[a]] +tryAll _ [] = [] +tryAll f (x:xs) = map (:xs) (f x) ++ map (x:) (tryAll f xs) + +splits :: [Mosaic a] -> [[Mosaic a]] +splits [] = [] +splits (OM x:y) = map (OM x:) $ splits y +splits (M (x:y):z) = (x:makeM y:z) : map (makeM (x:y) :) (splits z) +splits (M []:x) = splits x + +concatenations :: [Mosaic a] -> [[Mosaic a]] +concatenations (x:y:z) = (concatenateMosaic x y:z):(map (x:) $ concatenations (y:z)) +concatenations _ = [] + +concatenateMosaic :: Mosaic a -> Mosaic a -> Mosaic a +concatenateMosaic (OM a) (OM b) = M [OM a, OM b] +concatenateMosaic (OM a) (M b) = M (OM a:b) +concatenateMosaic (M a) (OM b) = M (a++[OM b]) +concatenateMosaic (M a) (M b) = M (a++b) + +makeM :: [Mosaic a] -> Mosaic a +makeM [m] = m +makeM [] = error "makeM []" +makeM ms = M ms + +flattenMosaic :: Mosaic a -> [a] +flattenMosaic (OM a) = [a] +flattenMosaic (M xs) = concatMap flattenMosaic xs + +allsplits :: [a] -> [[[a]]] +allsplits [] = [[[]]] +allsplits [a] = [[[a]]] +allsplits (x:xs) = (map ([x]:) splitsrest) ++ (map (maphead (x:)) splitsrest) + where splitsrest = allsplits' xs + +allsplits' :: [a] -> [[[a]]] +allsplits' [] = [[[]]] +allsplits' [a] = [[[a]]] +allsplits' (x:xs) = (map (maphead (x:)) splitsrest) ++ (map ([x]:) splitsrest) + where splitsrest = allsplits xs + +maphead :: (a->a) -> [a] -> [a] +maphead f (x:xs) = f x : xs +maphead _ [] = [] + +runCountDown :: Int -> State CountDown a -> a +runCountDown n x = fst $ runState x (CD (mkStdGen n) n) diff --git a/XMonad/Layout/MosaicAlt.hs b/XMonad/Layout/MosaicAlt.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/MosaicAlt.hs @@ -0,0 +1,168 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.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 XMonad.Layout.MosaicAlt ( + -- * Usage: + -- $usage + MosaicAlt(..) + , shrinkWindowAlt + , expandWindowAlt + , tallWindowAlt + , wideWindowAlt + , resetAlt + ) where + +import XMonad +import qualified XMonad.StackSet as W +import qualified Data.Map as M +import Data.List ( sortBy ) +import Data.Ratio + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.MosaicAlt +-- > import qualified Data.Map as M +-- +-- Then edit your @layoutHook@ by adding the MosaicAlt layout: +-- +-- > myLayouts = MosaicAlt M.empty ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- In the key-bindings, do something like: +-- +-- > , ((modMask x .|. shiftMask , xK_a ), withFocused (sendMessage . expandWindowAlt)) +-- > , ((modMask x .|. shiftMask , xK_z ), withFocused (sendMessage . shrinkWindowAlt)) +-- > , ((modMask x .|. shiftMask , xK_s ), withFocused (sendMessage . tallWindowAlt)) +-- > , ((modMask x .|. shiftMask , xK_d ), withFocused (sendMessage . wideWindowAlt)) +-- > , ((modMask x .|. controlMask, xK_space), sendMessage resetAlt) +-- > ... +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data HandleWindowAlt = + ShrinkWindowAlt Window + | ExpandWindowAlt Window + | TallWindowAlt Window + | WideWindowAlt Window + | ResetAlt + deriving ( Typeable, Eq ) +instance Message HandleWindowAlt +shrinkWindowAlt, expandWindowAlt :: Window -> HandleWindowAlt +tallWindowAlt, wideWindowAlt :: Window -> HandleWindowAlt +shrinkWindowAlt = ShrinkWindowAlt +expandWindowAlt = ExpandWindowAlt +tallWindowAlt = TallWindowAlt +wideWindowAlt = WideWindowAlt +resetAlt :: HandleWindowAlt +resetAlt = ResetAlt + +data Param = Param { area, aspect :: Rational } deriving ( Show, Read ) +type Params = M.Map Window Param +data MosaicAlt a = MosaicAlt Params deriving ( Show, Read ) + +instance LayoutClass MosaicAlt Window where + description _ = "MosaicAlt" + doLayout (MosaicAlt params) rect stack = + return (arrange rect stack params', Just $ MosaicAlt params') + where + 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 + + 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) + Just ResetAlt -> Just $ MosaicAlt M.empty + _ -> Nothing + +-- 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 + +-- Layout algorithm entry point. +arrange :: Rectangle -> W.Stack Window -> Params -> [(Window, Rectangle)] +arrange rect stack params = r + where + (_, r) = findSplits 3 rect tree params + tree = makeTree (sortBy areaCompare wins) params + wins = reverse (W.up stack) ++ W.focus stack : W.down stack + areaCompare a b = or1 b `compare` or1 a + or1 w = maybe 1 area $ M.lookup w params + +-- Recursively group windows into a binary tree. Aim to balance the tree +-- according to the total requested area in each branch. +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 + +-- Split a list of windows in half by area. +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) + where + (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) + +-- 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 + +-- vim: sw=4:et diff --git a/XMonad/Layout/MultiToggle.hs b/XMonad/Layout/MultiToggle.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/MultiToggle.hs @@ -0,0 +1,230 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.MultiToggle +-- Copyright : (c) Lukas Mai +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Dynamically apply and unapply transformers to your window layout. This can +-- be used to rotate your window layout by 90 degrees, or to make the +-- currently focused window occupy the whole screen (\"zoom in\") then undo +-- the transformation (\"zoom out\"). + + +module XMonad.Layout.MultiToggle ( + -- * Usage + -- $usage + Transformer(..), + Toggle(..), + (??), + EOT(..), + mkToggle +) where + +import XMonad + +import Control.Arrow +import Data.Typeable +import Data.Maybe + +-- $usage +-- The basic idea is to have a base layout and a set of layout transformers, +-- of which at most one is active at any time. Enabling another transformer +-- first disables any currently active transformer; i.e. it works like a +-- group of radio buttons. +-- +-- A side effect of this meta-layout is that layout transformers no longer +-- receive any messages; any message not handled by SwitchTrans itself will +-- undo the current layout transformer, pass the message on to the base +-- layout, then reapply the transformer. +-- +-- To use this module, you first have to define the transformers that you +-- want to be handled by @MultiToggle@. For example, if the transformer is +-- 'XMonad.Layout.Mirror': +-- +-- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable) +-- > instance Transformer MIRROR Window where +-- > transform _ x k = k (Mirror x) +-- +-- @MIRROR@ can be any identifier (it has to start with an uppercase letter, +-- of course); I've chosen an all-uppercase version of the transforming +-- function's name here. You need to put @{-\# OPTIONS_GHC -fglasgow-exts \#-}@ +-- at the beginning of your file to be able to derive "Data.Typeable". +-- +-- Somewhere else in your file you probably have a definition of @layout@; +-- the default looks like this: +-- +-- > layout = tiled ||| Mirror tiled ||| Full +-- +-- After changing this to +-- +-- > layout = mkToggle (MIRROR ?? EOT) (tiled ||| Full) +-- +-- you can now dynamically apply the 'XMonad.Layout.Mirror' transformation: +-- +-- > ... +-- > , ((modMask, xK_x ), sendMessage $ Toggle MIRROR) +-- > ... +-- +-- (That should be part of your key bindings.) When you press @mod-x@, the +-- active layout is mirrored. Another @mod-x@ and it's back to normal. +-- +-- It's also possible to stack @MultiToggle@s. Let's define a few more +-- transformers ('XMonad.Layout.NoBorders.noBorders' is in +-- "XMonad.Layout.NoBorders"): +-- +-- > data NOBORDERS = NOBORDERS deriving (Read, Show, Eq, Typeable) +-- > instance Transformer NOBORDERS Window where +-- > transform _ x k = k (noBorders x) +-- > +-- > data FULL = FULL deriving (Read, Show, Eq, Typeable) +-- > instance Transformer FULL Window where +-- > transform _ x k = k Full +-- +-- @ +-- layout = id +-- . 'XMonad.Layout.NoBorders.smartBorders' +-- . mkToggle (NOBORDERS ?? FULL ?? EOT) +-- . mkToggle (MIRROR ?? EOT) +-- $ tiled ||| 'XMonad.Layout.Grid.Grid' ||| 'XMonad.Layout.Circle.Circle' +-- @ +-- +-- By binding a key to @(sendMessage $ Toggle FULL)@ you can temporarily +-- maximize windows, in addition to being able to rotate layouts and remove +-- window borders. + +-- | A class to identify custom transformers (and look up transforming +-- functions by type). +class (Eq t, Typeable t) => Transformer t a | t -> a where + transform :: (LayoutClass l a) => t -> l a -> (forall l'. (LayoutClass l' a) => l' a -> b) -> b + +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 + +transform' :: (Transformer t a) => t -> EL a -> EL a +transform' t el = el `unEL` \l -> transform t l EL + +-- | Toggle the specified layout transformer. +data Toggle a = forall t. (Transformer 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 + +-- | Construct a @MultiToggle@ layout from a transformer table and a base +-- layout. +mkToggle :: (LayoutClass l a) => ts -> l a -> MultiToggle ts l a +mkToggle ts l = MultiToggle l (EL l) Nothing id ts + +-- | Marks the end of a transformer list. +data EOT = EOT deriving (Read, Show) +data HCons a b = HCons a b deriving (Read, Show) + +infixr 0 ?? +-- | Prepend an element to a heterogeneous list. Used to build transformer +-- tables for 'mkToggle'. +(??) :: (HList b w) => a -> b -> HCons a b +(??) = HCons + +class HList c a where + find :: (Transformer t a) => c -> t -> Maybe Int + resolve :: c -> Int -> b -> (forall t. (Transformer t a) => t -> b) -> b + +instance HList EOT w where + find EOT _ = Nothing + resolve EOT _ d _ = d + +instance (Transformer 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' } diff --git a/XMonad/Layout/Named.hs b/XMonad/Layout/Named.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/Named.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Named +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- A module for assigning a name to a given layout. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.Named ( + -- * Usage + -- $usage + Named(Named) + ) where + +import XMonad + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Named +-- +-- Then edit your @layoutHook@ by adding the Named layout modifier +-- to some layout: +-- +-- > myLayouts = Named "real big" Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +data Named l a = Named String (l a) deriving ( Read, Show ) + +instance (LayoutClass l a) => LayoutClass (Named l) a where + doLayout (Named n l) r s = do (ws, ml') <- doLayout l r s + return (ws, Named n `fmap` ml') + handleMessage (Named n l) mess = do ml' <- handleMessage l mess + return $ Named n `fmap` ml' + description (Named n _) = n diff --git a/XMonad/Layout/NoBorders.hs b/XMonad/Layout/NoBorders.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/NoBorders.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.NoBorders +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- 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. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.NoBorders ( + -- * Usage + -- $usage + noBorders, + smartBorders, + withBorder + ) where + +import XMonad +import XMonad.Layout.LayoutModifier +import qualified XMonad.StackSet as W +import Data.List ((\\)) + +-- $usage +-- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file: +-- +-- > import XMonad.Layout.NoBorders +-- +-- and modify the layouts to call noBorders on the layouts you want to lack +-- borders: +-- +-- > layoutHook = ... ||| noBorders Full ||| ... +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +-- todo, use an InvisibleList. +data WithBorder a = WithBorder Dimension [a] deriving ( Read, Show ) + +instance LayoutModifier WithBorder Window where + unhook (WithBorder _ s) = asks (borderWidth . config) >>= setBorders s + + redoLayout (WithBorder n s) _ _ wrs = do + asks (borderWidth . config) >>= setBorders (s \\ ws) + setBorders ws n + return (wrs, Just $ WithBorder n ws) + where + ws = map fst wrs + +noBorders :: LayoutClass l Window => l Window -> ModifiedLayout WithBorder l Window +noBorders = ModifiedLayout $ WithBorder 0 [] + +withBorder :: LayoutClass l a => Dimension -> l a -> ModifiedLayout WithBorder l a +withBorder b = ModifiedLayout $ WithBorder b [] + +setBorders :: [Window] -> Dimension -> X () +setBorders ws bw = withDisplay $ \d -> mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws + +data SmartBorder a = SmartBorder [a] deriving (Read, Show) + +instance LayoutModifier SmartBorder Window where + unhook (SmartBorder s) = asks (borderWidth . config) >>= setBorders s + + redoLayout (SmartBorder s) _ _ wrs = do + ss <- gets (W.screens . windowset) + + if singleton ws && singleton ss + then do + asks (borderWidth . config) >>= setBorders (s \\ ws) + setBorders ws 0 + return (wrs, Just $ SmartBorder ws) + else do + asks (borderWidth . config) >>= setBorders s + return (wrs, Just $ SmartBorder []) + where + ws = map fst wrs + singleton = null . drop 1 + +-- +-- | You can cleverly set no borders on a range of layouts, using a +-- layoutHook like so: +-- +-- > layoutHook = smartBorders $ tiled ||| Mirror tiled ||| ... +-- +smartBorders :: LayoutClass l a => l a -> ModifiedLayout SmartBorder l a +smartBorders = ModifiedLayout (SmartBorder []) diff --git a/XMonad/Layout/PerWorkspace.hs b/XMonad/Layout/PerWorkspace.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/PerWorkspace.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.PerWorkspace +-- Copyright : (c) Brent Yorgey +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Configure layouts on a per-workspace basis. NOTE that this module +-- does not (yet) work in conjunction with multiple screens! =( +----------------------------------------------------------------------------- + +module XMonad.Layout.PerWorkspace ( + -- * Usage + -- $usage + + onWorkspace, onWorkspaces + ) where + +import XMonad +import qualified XMonad.StackSet as W + +import Data.Maybe (fromMaybe) + +-- $usage +-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: +-- +-- > import XMonad.Layout.PerWorkspace +-- +-- and modifying your layoutHook as follows (for example): +-- +-- > layoutHook = onWorkspace "foo" l1 $ -- layout l1 will be used on workspace "foo". +-- > onWorkspaces ["bar","6"] l2 $ -- layout l2 will be used on workspaces "bar" and "6". +-- > l3 -- layout l3 will be used on all other workspaces. +-- +-- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated layouts, +-- e.g. @(Full ||| smartBorders $ tabbed shrinkText defaultTConf ||| ...)@ +-- +-- In another scenario, suppose you wanted to have layouts A, B, and C +-- available on all workspaces, except that on workspace foo you want +-- layout D instead of C. You could do that as follows: +-- +-- > layoutHook = A ||| B ||| onWorkspace "foo" D C +-- +-- NOTE that this module does not (yet) work in conjunction with +-- multiple screens. =( + +-- | Specify one layout to use on a particular workspace, and another +-- to use on all others. The second layout can be another call to +-- 'onWorkspace', and so on. +onWorkspace :: (LayoutClass l1 a, LayoutClass l2 a) + => WorkspaceId -- ^ the tag of the workspace to match + -> (l1 a) -- ^ layout to use on the matched workspace + -> (l2 a) -- ^ layout to use everywhere else + -> PerWorkspace l1 l2 a +onWorkspace wsId l1 l2 = PerWorkspace [wsId] Nothing l1 l2 + +-- | Specify one layout to use on a particular set of workspaces, and +-- another to use on all other workspaces. +onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a) + => [WorkspaceId] -- ^ tags of workspaces to match + -> (l1 a) -- ^ layout to use on matched workspaces + -> (l2 a) -- ^ layout to use everywhere else + -> PerWorkspace l1 l2 a +onWorkspaces wsIds l1 l2 = PerWorkspace wsIds Nothing l1 l2 + +-- | Structure for representing a workspace-specific layout along with +-- a layout for all other workspaces. We store the tags of workspaces +-- to be matched, and the two layouts. Since layouts are stored\/tracked +-- per workspace, once we figure out whether we're on a matched workspace, +-- we can cache that information using a (Maybe Bool). This is necessary +-- to be able to correctly implement the 'description' method of +-- LayoutClass, since a call to description is not able to query the +-- WM state to find out which workspace it was called in. +data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId] + (Maybe Bool) + (l1 a) + (l2 a) + deriving (Read, Show) + +instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (PerWorkspace l1 l2) a where + + -- do layout with l1, then return a modified PerWorkspace caching + -- the fact that we're in the matched workspace. + doLayout p@(PerWorkspace _ (Just True) lt _) r s = do + (wrs, mlt') <- doLayout lt r s + return (wrs, Just $ mkNewPerWorkspaceT p mlt') + + -- do layout with l1, then return a modified PerWorkspace caching + -- the fact that we're not in the matched workspace. + doLayout p@(PerWorkspace _ (Just False) _ lf) r s = do + (wrs, mlf') <- doLayout lf r s + return (wrs, Just $ mkNewPerWorkspaceF p mlf') + + -- figure out which layout to use based on the current workspace. + doLayout (PerWorkspace wsIds Nothing l1 l2) r s = do + t <- getCurrentTag + doLayout (PerWorkspace wsIds (Just $ t `elem` wsIds) l1 l2) r s + + -- handle messages; same drill as doLayout. + handleMessage p@(PerWorkspace _ (Just True) lt _) m = do + mlt' <- handleMessage lt m + return . Just $ mkNewPerWorkspaceT p mlt' + + handleMessage p@(PerWorkspace _ (Just False) _ lf) m = do + mlf' <- handleMessage lf m + return . Just $ mkNewPerWorkspaceF p mlf' + + handleMessage (PerWorkspace _ Nothing _ _) _ = return Nothing + + description (PerWorkspace _ (Just True ) l1 _) = description l1 + description (PerWorkspace _ (Just False) _ l2) = description l2 + + -- description's result is not in the X monad, so we have to wait + -- until a doLayout for the information about which workspace + -- we're in to get cached. + description _ = "PerWorkspace" + +-- | Construct new PerWorkspace values with possibly modified layouts. +mkNewPerWorkspaceT :: PerWorkspace l1 l2 a -> Maybe (l1 a) -> + PerWorkspace l1 l2 a +mkNewPerWorkspaceT (PerWorkspace wsIds b lt lf) mlt' = + (\lt' -> PerWorkspace wsIds b lt' lf) $ fromMaybe lt mlt' + +mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) -> + PerWorkspace l1 l2 a +mkNewPerWorkspaceF (PerWorkspace wsIds b lt lf) mlf' = + (\lf' -> PerWorkspace wsIds b lt lf') $ fromMaybe lf mlf' + +-- | Get the tag of the currently active workspace. Note that this +-- is only guaranteed to be the same workspace for which doLayout +-- was called if there is only one screen. +getCurrentTag :: X WorkspaceId +getCurrentTag = gets windowset >>= return . W.tag . W.workspace . W.current diff --git a/XMonad/Layout/ResizableTile.hs b/XMonad/Layout/ResizableTile.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/ResizableTile.hs @@ -0,0 +1,98 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.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 XMonad.Layout.ResizableTile ( + -- * Usage + -- $usage + ResizableTall(..), MirrorResize(..) + ) where + +import XMonad hiding (splitVertically, splitHorizontallyBy) +import qualified XMonad.StackSet as W +import Control.Monad + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.ResizableTile +-- +-- Then edit your @layoutHook@ by adding the ResizableTile layout: +-- +-- > myLayouts = ResizableTall 1 (3/100) (1/2) [] ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- You may also want to add the following key bindings: +-- +-- > , ((modMask x, xK_a), sendMessage MirrorShrink) +-- > , ((modMask x, xK_z), sendMessage MirrorExpand) +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data MirrorResize = MirrorShrink | MirrorExpand deriving Typeable +instance Message MirrorResize + +data ResizableTall a = ResizableTall Int Rational Rational [Rational] deriving (Show, Read) +instance LayoutClass ResizableTall a where + doLayout (ResizableTall nmaster _ frac mfrac) r = + return . (\x->(x,Nothing)) . + ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate + handleMessage (ResizableTall nmaster delta frac mfrac) m = + do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset + case ms of + Nothing -> return Nothing + Just s -> return $ msum [fmap resize (fromMessage m) + ,fmap (\x -> mresize x s) (fromMessage m) + ,fmap incmastern (fromMessage m)] + where resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac + resize Expand = ResizableTall 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 + pos = if n == (nmaster-1) || n == (total-1) then n-1 else n + mfrac' = modifymfrac (mfrac ++ repeat 1) d pos + in ResizableTall nmaster delta frac $ take total mfrac' + modifymfrac [] _ _ = [] + modifymfrac (f:fx) d n | n == 0 = f+d : fx + | otherwise = f : modifymfrac fx d (n-1) + incmastern (IncMasterN d) = ResizableTall (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 diff --git a/XMonad/Layout/Roledex.hs b/XMonad/Layout/Roledex.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/Roledex.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Roledex +-- Copyright : (c) tim.thelion@gmail.com +-- License : BSD +-- +-- Maintainer : tim.thelion@gmail.com +-- Stability : unstable +-- Portability : unportable +-- +-- Screenshot : +-- +-- This is a completely pointless layout which acts like Microsoft's Flip 3D +----------------------------------------------------------------------------- + +module XMonad.Layout.Roledex ( + -- * Usage + -- $usage + Roledex(Roledex)) where + +import XMonad +import qualified XMonad.StackSet as W +import Data.Ratio + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Roledex +-- +-- Then edit your @layoutHook@ by adding the Roledex layout: +-- +-- > myLayouts = Roledex ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +data Roledex a = Roledex deriving ( Show, Read ) + +instance LayoutClass Roledex Window where + doLayout _ = roledexLayout + +roledexLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Roledex 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 :: Ratio Int) $ fst (splitVerticallyBy (2%3 :: Ratio Int) 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' :: Integral a => a -> a -> a +div' _ 0 = 0 +div' n o = div n o diff --git a/XMonad/Layout/Spiral.hs b/XMonad/Layout/Spiral.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/Spiral.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Spiral +-- Copyright : (c) Joe Thornber +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Joe Thornber +-- Stability : stable +-- Portability : portable +-- +-- Spiral adds a spiral tiling layout +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.Spiral ( + -- * Usage + -- $usage + spiral + , spiralWithDir + , Rotation (..) + , Direction (..) + ) where + +import Data.Ratio +import XMonad +import XMonad.StackSet ( integrate ) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Spiral +-- > import Data.Ratio +-- +-- Then edit your @layoutHook@ by adding the Spiral layout: +-- +-- > myLayouts = spiral (1 % 1) ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +fibs :: [Integer] +fibs = 1 : 1 : zipWith (+) fibs (tail fibs) + +mkRatios :: [Integer] -> [Rational] +mkRatios (x1:x2:xs) = (x1 % x2) : mkRatios (x2:xs) +mkRatios _ = [] + +data Rotation = CW | CCW deriving (Read, Show) +data Direction = East | South | West | North deriving (Eq, Enum, Read, Show) + +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..] + +spiral :: Rational -> SpiralWithDir a +spiral = spiralWithDir East CW + +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 + description _ = "Spiral" + +-- This will produce one more rectangle than there are splits details +divideRects :: [(Rational, Direction)] -> Rectangle -> [Rectangle] +divideRects [] r = [r] +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) + +divideRect :: Rational -> Direction -> Rectangle -> (Rectangle, Rectangle) +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) + +chop :: Rational -> Integer -> (Integer, Integer) +chop rat n = let f = ((fromIntegral n) * (numerator rat)) `div` (denominator rat) in + (f, n - f) diff --git a/XMonad/Layout/Square.hs b/XMonad/Layout/Square.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/Square.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Square +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- A layout that splits the screen into a square area and the rest of the +-- screen. +-- This is probably only ever useful in combination with +-- "XMonad.Layout.Combo". +-- It sticks one window in a square region, and makes the rest +-- of the windows live with what's left (in a full-screen sense). +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.Square ( + -- * Usage + -- $usage + Square(..) ) where + +import XMonad +import XMonad.StackSet ( integrate ) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: +-- +-- > import XMonad.Layout.Square +-- +-- An example layout using square together with "XMonad.Layout.Combo" +-- to make the very last area square: +-- +-- > , 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)] + +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data Square a = Square deriving ( Read, Show ) + +instance LayoutClass 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 + +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) diff --git a/XMonad/Layout/Tabbed.hs b/XMonad/Layout/Tabbed.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/Tabbed.hs @@ -0,0 +1,228 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.Tabbed +-- Copyright : (c) 2007 David Roundy, Andrea Rossato +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : droundy@darcs.net, andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A tabbed layout for the Xmonad Window Manager +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.Tabbed ( + -- * Usage: + -- $usage + tabbed + , shrinkText, CustomShrink(CustomShrink) + , TConf (..), defaultTConf + , Shrinker(..) + ) where + +import Data.Maybe +import Data.List + +import XMonad +import qualified XMonad.StackSet as W + +import XMonad.Util.NamedWindows +import XMonad.Util.Invisible +import XMonad.Util.XUtils +import XMonad.Util.Font + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.Tabbed +-- +-- Then edit your @layoutHook@ by adding the Tabbed layout: +-- +-- > myLayouts = tabbed shrinkText defaultTConf ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- You can also edit the default configuration options. +-- +-- > myTabConfig = defaultTConf { inactiveBorderColor = "#FF0000" +-- > , activeTextColor = "#00FF00"} +-- +-- and +-- +-- > mylayout = tabbed shrinkText myTabConfig ||| Full ||| etc.. + +tabbed :: Shrinker s => s -> TConf -> Tabbed s a +tabbed s t = Tabbed (I Nothing) s t + +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 + , font :: XMonadFont + } + +data Tabbed s a = + Tabbed (Invisible Maybe TabState) s TConf + deriving (Show, Read) + +instance Shrinker s => LayoutClass (Tabbed s) Window where + doLayout (Tabbed ist ishr conf) = doLay ist ishr conf + handleMessage = handleMess + description _ = "Tabbed" + +doLay :: Shrinker s => Invisible Maybe TabState -> s -> TConf + -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed s Window)) +doLay ist ishr c sc (W.Stack w [] []) = do + whenIJust ist $ \st -> mapM_ deleteWindow (map fst $ tabsWindows st) + return ([(w,sc)], Just $ Tabbed (I Nothing) ishr c) +doLay ist ishr c sc@(Rectangle _ _ wid _) s@(W.Stack w _ _) = do + let ws = W.integrate s + width = wid `div` fromIntegral (length ws) + -- initialize state + st <- case ist of + (I Nothing ) -> initState c sc ws + (I (Just ts)) -> if map snd (tabsWindows ts) == ws && scr ts == sc + then return ts + else do mapM_ deleteWindow (map fst $ tabsWindows ts) + tws <- createTabs c sc ws + return (ts {scr = sc, tabsWindows = zip tws ws}) + mapM_ showWindow $ map fst $ tabsWindows st + mapM_ (updateTab ishr c (font st) width) $ tabsWindows st + return ([(w,shrink c sc)], Just (Tabbed (I (Just st)) ishr c)) + +handleMess :: Shrinker s => Tabbed s Window -> SomeMessage -> X (Maybe (Tabbed s Window)) +handleMess (Tabbed (I (Just st@(TabState {tabsWindows = tws}))) ishr conf) m + | Just e <- fromMessage m :: Maybe Event = handleEvent ishr conf st e >> return Nothing + | Just Hide == fromMessage m = mapM_ hideWindow (map fst tws) >> return Nothing + | Just ReleaseResources == fromMessage m = do mapM_ deleteWindow $ map fst tws + releaseXMF (font st) + return $ Just $ Tabbed (I Nothing) ishr conf +handleMess _ _ = return Nothing + +handleEvent :: Shrinker s => s -> TConf -> TabState -> Event -> X () +-- button press +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs}) + (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t}) + | t == buttonPress, tl <- map fst tws, thisw `elem` tl || thisbw `elem` tl = do + case lookup thisw tws of + Just x -> do focus x + updateTab ishr conf fs width (thisw, x) + Nothing -> return () + where + width = rect_width screen`div` fromIntegral (length tws) + +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs}) + (AnyEvent {ev_window = thisw, ev_event_type = t }) +-- expose + | thisw `elem` (map fst tws) && t == expose = do + updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws) + where + width = rect_width screen`div` fromIntegral (length tws) + +-- propertyNotify +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs}) + (PropertyEvent {ev_window = thisw}) + | thisw `elem` (map snd tws) = do + let tabwin = (fst $ fromJust $ find ((== thisw) . snd) tws, thisw) + updateTab ishr conf fs width tabwin + where width = rect_width screen `div` fromIntegral (length tws) +-- expose +handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs}) + (ExposeEvent {ev_window = thisw}) + | thisw `elem` (map fst tws) = do + updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws) + where width = rect_width screen `div` fromIntegral (length tws) +handleEvent _ _ _ _ = return () + +initState :: TConf -> Rectangle -> [Window] -> X TabState +initState conf sc ws = do + fs <- initXMF (fontName conf) + tws <- createTabs conf sc ws + return $ TabState (zip tws ws) sc fs + +createTabs :: TConf -> Rectangle -> [Window] -> X [Window] +createTabs _ _ [] = return [] +createTabs c (Rectangle x y wh ht) owl@(ow:ows) = do + let wid = wh `div` (fromIntegral $ length owl) + height = fromIntegral $ tabSize c + mask = Just (exposureMask .|. buttonPressMask) + d <- asks display + w <- createNewWindow (Rectangle x y wid height) mask (inactiveColor c) + io $ restackWindows d $ w : [ow] + ws <- createTabs c (Rectangle (x + fromIntegral wid) y (wh - wid) ht) ows + return (w:ws) + +updateTab :: Shrinker s => s -> TConf -> XMonadFont -> Dimension -> (Window,Window) -> X () +updateTab ishr c fs wh (tabw,ow) = do + nw <- getName ow + let ht = fromIntegral $ tabSize c :: Dimension + focusColor win ic ac = (maybe ic (\focusw -> if focusw == win + then ac else ic) . W.peek) + `fmap` gets windowset + (bc',borderc',tc') <- focusColor ow + (inactiveColor c, inactiveBorderColor c, inactiveTextColor c) + (activeColor c, activeBorderColor c, activeTextColor c) + dpy <- asks display + let s = shrinkIt ishr + name <- shrinkWhile s (\n -> do + size <- io $ textWidthXMF dpy fs n + return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw) + paintAndWrite tabw fs wh ht 1 bc' borderc' tc' bc' AlignCenter name + +shrink :: TConf -> Rectangle -> Rectangle +shrink c (Rectangle x y w h) = + Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c)) + +shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String +shrinkWhile sh p x = sw $ sh x + where sw [n] = return n + sw [] = return "" + sw (n:ns) = do + cond <- p n + if cond + then sw ns + else return n + +data CustomShrink = CustomShrink +instance Show CustomShrink where show _ = "" +instance Read CustomShrink where readsPrec _ s = [(CustomShrink,s)] + +class (Read s, Show s) => Shrinker s where + shrinkIt :: s -> String -> [String] + +data DefaultShrinker = DefaultShrinker +instance Show DefaultShrinker where show _ = "" +instance Read DefaultShrinker where readsPrec _ s = [(DefaultShrinker,s)] +instance Shrinker DefaultShrinker where + shrinkIt _ "" = [""] + shrinkIt s cs = cs : shrinkIt s (init cs) + +shrinkText :: DefaultShrinker +shrinkText = DefaultShrinker diff --git a/XMonad/Layout/ThreeColumns.hs b/XMonad/Layout/ThreeColumns.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/ThreeColumns.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.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 XMonad.Layout.ThreeColumns ( + -- * Usage + -- $usage + ThreeCol(..) + ) where + +import XMonad +import qualified XMonad.StackSet as W + +import Data.Ratio + +import Control.Monad + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.ThreeColumns +-- +-- Then edit your @layoutHook@ by adding the ThreeCol layout: +-- +-- > myLayouts = ThreeCol 1 (3/100) (1/2) False ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- Use @True@ as the last argument to get a wide layout. +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +data ThreeCol a = ThreeCol Int Rational Rational deriving (Show,Read) + +instance LayoutClass ThreeCol a where + doLayout (ThreeCol nmaster _ frac) r = + return . (\x->(x,Nothing)) . + ap zip (tile3 frac r nmaster . length) . W.integrate + handleMessage (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" + +-- | tile3. Compute window positions using 3 panes +tile3 :: Rational -> Rectangle -> Int -> Int -> [Rectangle] +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 + where (r1, r2, r3) = split3HorizontallyBy f r + (s1, s2) = splitHorizontallyBy f r + nslave = (n - nmaster) + nmid = ceiling (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 = ceiling $ fromIntegral sw * (2/3) * f + midw = ceiling ( (sw - leftw) % 2 ) + rightw = sw - leftw - midw diff --git a/XMonad/Layout/ToggleLayouts.hs b/XMonad/Layout/ToggleLayouts.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/ToggleLayouts.hs @@ -0,0 +1,95 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.ToggleLayouts +-- Copyright : (c) David Roundy +-- License : BSD +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : portable +-- +-- A module to toggle between two layouts. +----------------------------------------------------------------------------- + +module XMonad.Layout.ToggleLayouts ( + -- * Usage + -- $usage + toggleLayouts, ToggleLayout(..) + ) where + +import XMonad + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.ToggleLayouts +-- +-- Then edit your @layoutHook@ by adding the ToggleLayouts layout: +-- +-- > myLayouts = toggleLayouts Full (Tall 1 (3/100) (1/2)) ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- To toggle between layouts add a key binding like +-- +-- > , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout) +-- +-- or a key binding like +-- +-- > , ((modMask x .|. controlMask, xK_space), sendMessage (Toggle "Full")) +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data ToggleLayouts lt lf a = ToggleLayouts Bool (lt a) (lf a) deriving (Read,Show) +data ToggleLayout = ToggleLayout | Toggle String 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 + | 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 + | 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' + | Just (Toggle d) <- fromMessage m, + d == description lt || d == description lf = + 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' diff --git a/XMonad/Layout/TwoPane.hs b/XMonad/Layout/TwoPane.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/TwoPane.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.TwoPane +-- Copyright : (c) Spencer Janssen +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Spencer Janssen +-- Stability : unstable +-- Portability : unportable +-- +-- 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 XMonad.Layout.TwoPane ( + -- * Usage + -- $usage + TwoPane (..) + ) where + +import XMonad hiding (focus) +import XMonad.StackSet ( focus, up, down) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.TwoPane +-- +-- Then edit your @layoutHook@ by adding the TwoPane layout: +-- +-- > myLayouts = TwoPane (3/100) (1/2) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +data TwoPane a = + TwoPane Rational Rational + deriving ( Show, Read ) + +instance LayoutClass 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 + + handleMessage (TwoPane delta split) x = + return $ case fromMessage x of + Just Shrink -> Just (TwoPane delta (split - delta)) + Just Expand -> Just (TwoPane delta (split + delta)) + _ -> Nothing + diff --git a/XMonad/Layout/WindowNavigation.hs b/XMonad/Layout/WindowNavigation.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/WindowNavigation.hs @@ -0,0 +1,218 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.WindowNavigation +-- 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 XMonad.Layout.WindowNavigation ( + -- * Usage + -- $usage + windowNavigation, configurableNavigation, + Navigate(..), Direction(..), + MoveWindowToWindow(..), + navigateColor, navigateBrightness, + noNavigateBorders, defaultWNConfig + ) where + +import Data.List ( nub, sortBy, (\\) ) +import XMonad hiding (Point) +import qualified XMonad.StackSet as W +import XMonad.Layout.LayoutModifier +import XMonad.Util.Invisible +import XMonad.Util.XUtils + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.WindowNavigation +-- +-- Then edit your @layoutHook@ by adding the WindowNavigation layout modifier +-- to some layout: +-- +-- > myLayouts = windowNavigation (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- In keybindings: +-- +-- > , ((modMask x, xK_Right), sendMessage $ Go R) +-- > , ((modMask x, xK_Left ), sendMessage $ Go L) +-- > , ((modMask x, xK_Up ), sendMessage $ Go U) +-- > , ((modMask x, xK_Down ), sendMessage $ Go D) +-- > , ((modMask x .|. controlMask, xK_Right), sendMessage $ Swap R) +-- > , ((modMask x .|. controlMask, xK_Left ), sendMessage $ Swap L) +-- > , ((modMask x .|. controlMask, xK_Up ), sendMessage $ Swap U) +-- > , ((modMask x .|. controlMask, xK_Down ), sendMessage $ Swap D) +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". + + +data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( Read, Show, Typeable ) +instance Typeable a => Message (MoveWindowToWindow a) + +data Navigate = Go Direction | Swap Direction | Move Direction deriving ( Read, Show, Typeable ) +data Direction = U | D | R | L deriving ( Read, Show, Eq ) +instance Message Navigate + +data WNConfig = + WNC { brightness :: Maybe Double -- Indicates a fraction of the focus color. + , upColor :: String + , downColor :: String + , leftColor :: String + , rightColor :: String + } deriving (Show, Read) + +noNavigateBorders :: WNConfig +noNavigateBorders = + defaultWNConfig {brightness = Just 0} + +navigateColor :: String -> WNConfig +navigateColor 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 } + +defaultWNConfig :: WNConfig +defaultWNConfig = WNC (Just 0.5) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF" + +data NavigationState a = NS Point [(a,Rectangle)] + +data WindowNavigation a = WindowNavigation WNConfig (Invisible Maybe (NavigationState a)) deriving ( Read, Show ) + +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)) + +instance LayoutModifier WindowNavigation Window where + redoLayout (WindowNavigation conf (I state)) rscr s wrs = + do XConf { normalBorder = nbc, focusedBorder = fbc, display = dpy } <- ask + [uc,dc,lc,rc] <- + case brightness conf of + Just frac -> do myc <- averagePixels fbc nbc frac + return [myc,myc,myc,myc] + Nothing -> mapM (stringToPixel dpy) [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 + wrs' = filter ((/=w) . fst) wrs + wnavigable = nub $ concatMap + (\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] + wothers = case state of Just (NS _ wo) -> map fst wo + _ -> [] + mapM_ (sc nbc) (wothers \\ map fst wnavigable) + mapM_ (\(win,c) -> sc c win) wnavigablec + return (wrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable) + + handleMessOrMaybeModifyIt (WindowNavigation conf (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 modify focusWindowHere + return $ Just $ Left $ WindowNavigation conf $ I $ Just $ + NS (centerd d pt r) wrs + where focusWindowHere :: XState -> XState + focusWindowHere s + | Just w == W.peek (windowset s) = s + | has w $ W.stack $ W.workspace $ W.current $ windowset s = + s { windowset = until ((Just w ==) . W.peek) + W.focusUp $ windowset s } + | otherwise = s + has _ Nothing = False + has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr) + + | 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 + | 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 + | Just Hide <- fromMessage m = + do XConf { normalBorder = nbc } <- ask + mapM_ (sc nbc . fst) wrs + return $ Just $ Left $ WindowNavigation conf $ I $ Just $ NS pt [] + | Just ReleaseResources <- fromMessage m = + handleMessOrMaybeModifyIt (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide) + handleMessOrMaybeModifyIt _ _ = return Nothing + +truncHead :: [a] -> [a] +truncHead (x:_) = [x] +truncHead [] = [] + +sc :: Pixel -> Window -> X () +sc c win = withDisplay $ \dpy -> io $ setWindowBorder dpy win c + +center :: Rectangle -> Point +center (Rectangle x y w h) = P (fromIntegral x + fromIntegral w/2) (fromIntegral y + fromIntegral h/2) + +centerd :: Direction -> Point -> Rectangle -> Point +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 :: Direction -> Point -> Rectangle -> Bool +inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + y < fromIntegral yr + fromIntegral h +inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + y > fromIntegral yr +inr R (P a x) (Rectangle b l _ w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + a < fromIntegral b +inr L (P a x) (Rectangle b l c w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && + a > fromIntegral b + fromIntegral c + +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 + +sortby :: Direction -> [(a,Rectangle)] -> [(a,Rectangle)] +sortby U = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y' y) +sortby D = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y y') +sortby R = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x x') +sortby L = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x' x) + +data Point = P Double Double diff --git a/XMonad/Layout/WorkspaceDir.hs b/XMonad/Layout/WorkspaceDir.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/WorkspaceDir.hs @@ -0,0 +1,88 @@ +{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.WorkspaceDir +-- Copyright : (c) 2007 David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- WorkspaceDir is an extension to set the current directory in a workspace. +-- +-- Actually, it sets the current directory in a layout, since there's no way I +-- know of to attach a behavior to a workspace. This means that any terminals +-- (or other programs) pulled up in that workspace (with that layout) will +-- execute in that working directory. Sort of handy, I think. +-- +-- Note this extension requires the 'directory' package to be installed. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.WorkspaceDir ( + -- * Usage + -- $usage + workspaceDir, + changeDir + ) where + +import System.Directory ( setCurrentDirectory, getCurrentDirectory ) + +import XMonad +import XMonad.Util.Run ( runProcessWithInput ) +import XMonad.Prompt ( XPConfig ) +import XMonad.Prompt.Directory ( directoryPrompt ) +import XMonad.Layout.LayoutModifier + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.WorkspaceDir +-- +-- Then edit your @layoutHook@ by adding the Workspace layout modifier +-- to some layout: +-- +-- > myLayouts = workspaceDir "~" (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" +-- +-- WorkspaceDir provides also a prompt. To use it you need to import +-- "XMonad.Prompt" and add something like this to your key bindings: +-- +-- > , ((modMask x .|. shiftMask, xK_x ), changeDir defaultXPConfig) +-- +-- For detailed instruction on editing the key binding see: +-- +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data Chdir = Chdir String deriving ( Typeable ) +instance Message Chdir + +data WorkspaceDir a = WorkspaceDir String deriving ( Read, Show ) + +instance LayoutModifier WorkspaceDir a where + hook (WorkspaceDir s) = scd s + handleMess (WorkspaceDir _) m + | Just (Chdir wd) <- fromMessage m = do wd' <- cleanDir wd + return $ Just $ WorkspaceDir wd' + | otherwise = return Nothing + +workspaceDir :: LayoutClass l a => String -> l a + -> ModifiedLayout WorkspaceDir l a +workspaceDir s = ModifiedLayout (WorkspaceDir s) + +cleanDir :: String -> X String +cleanDir x = scd x >> io getCurrentDirectory + +scd :: String -> X () +scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` \_ -> return x) + catchIO $ setCurrentDirectory x' + +changeDir :: XPConfig -> X () +changeDir c = directoryPrompt c "Set working directory: " (sendMessage . Chdir) diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs new file mode 100644 --- /dev/null +++ b/XMonad/Prompt.hs @@ -0,0 +1,701 @@ +{-# LANGUAGE ExistentialQuantification #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt +-- 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 XMonad.Prompt ( + -- * Usage + -- $usage + mkXPrompt + , mkXPromptWithReturn + , defaultXPConfig + , mkComplFunFromList + , XPType (..) + , XPPosition (..) + , XPConfig (..) + , XPrompt (..) + , ComplFunction + -- * X Utilities + -- $xutils + , mkUnmanagedWindow + , fillDrawable + -- * Other Utilities + -- $utils + , getLastWord + , skipLastWord + , splitInSubListsAt + , breakAtSpace + , newIndex + , newCommand + , uniqSort + ) where + +import XMonad hiding (config, io) +import qualified XMonad.StackSet as W +import XMonad.Util.Font +import XMonad.Util.XSelection (getSelection) + +import Control.Arrow ((&&&)) +import Control.Monad.Reader +import Control.Monad.State +import Control.Applicative ((<$>)) +import Data.Char +import Data.Maybe +import Data.List +import Data.Set (fromList, toList) +import System.Environment (getEnv) +import System.IO +import System.Posix.Files + +-- $usage +-- For usage examples see "XMonad.Prompt.Shell", +-- "XMonad.Prompt.XMonad" or "XMonad.Prompt.Ssh" +-- +-- TODO: +-- +-- * scrolling the completions that don't fit in the window (?) + +type XP = StateT XPState IO + +data XPState = + XPS { dpy :: Display + , rootw :: Window + , win :: Window + , screen :: Rectangle + , complWin :: Maybe Window + , complWinDim :: Maybe ComplWindowDim + , completionFunction :: String -> IO [String] + , gcon :: GC + , fontS :: XMonadFont + , xptype :: XPType + , command :: String + , offset :: Int + , history :: [History] + , config :: XPConfig + } + +data XPConfig = + XPC { font :: String -- ^ Font + , bgColor :: String -- ^ Background color + , fgColor :: String -- ^ Font color + , fgHLight :: String -- ^ Font color of a highlighted completion entry + , bgHLight :: String -- ^ Background 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 + } 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 + +-- | 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: " +class XPrompt t where + showXPrompt :: t -> String + +data XPPosition = Top + | Bottom + deriving (Show,Read) + +defaultXPConfig :: XPConfig +defaultXPConfig = + XPC { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + , bgColor = "#333333" + , fgColor = "#FFFFFF" + , fgHLight = "#000000" + , bgHLight = "#BBBBBB" + , borderColor = "#FFFFFF" + , promptBorderWidth = 1 + , position = Bottom + , height = 18 + , historySize = 256 + } + +type ComplFunction = String -> IO [String] + +initState :: XPrompt p => Display -> Window -> Window -> Rectangle -> ComplFunction + -> GC -> XMonadFont -> p -> [History] -> XPConfig -> XPState +initState d rw w s compl gc fonts pt h c = + XPS d rw w s Nothing Nothing compl gc fonts (XPT pt) "" 0 h c + +-- | Same as 'mkXPrompt', except that the action function can have +-- type @String -> X a@, for any @a@, and the final action returned +-- by 'mkXPromptWithReturn' will have type @X (Maybe a)@. @Nothing@ +-- is yielded if the user cancels the prompt (by e.g. hitting Esc or +-- Ctrl-G). For an example of use, see the 'XMonad.Prompt.Input' +-- module. +mkXPromptWithReturn :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X a) -> X (Maybe a) +mkXPromptWithReturn t conf compl action = do + c <- ask + let d = display c + rw = theRoot c + s <- gets $ screenRect . W.screenDetail . W.current . windowset + w <- liftIO $ createWin d rw conf s + liftIO $ selectInput d w $ exposureMask .|. keyPressMask + gc <- liftIO $ createGC d w + liftIO $ setGraphicsExposures d gc False + (hist,h) <- liftIO $ readHistory + fs <- initXMF (font conf) + let st = initState d rw w s compl gc fs (XPT t) hist conf + st' <- liftIO $ execStateT runXP st + + releaseXMF fs + liftIO $ freeGC d gc + liftIO $ hClose h + if (command st' /= "") + then do + let htw = take (historySize conf) (history st') + liftIO $ writeHistory htw + Just <$> action (command st') + else + return Nothing + +-- | Creates a prompt given: +-- +-- * a prompt type, instance of the 'XPrompt' class. +-- +-- * a prompt configuration ('defaultXPConfig' can be used as a +-- starting point) +-- +-- * a completion function ('mkComplFunFromList' can be used to +-- create a completions function given a list of possible completions) +-- +-- * an action to be run: the action must take a string and return 'XMonad.X' () +mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X () +mkXPrompt t conf compl action = mkXPromptWithReturn t conf compl action >> return () + +runXP :: XP () +runXP = do + st <- get + let (d,w) = (dpy &&& win) st + status <- io $ grabKeyboard d w True grabModeAsync grabModeAsync currentTime + when (status == grabSuccess) $ do + updateWindows + eventLoop handle + io $ ungrabKeyboard d currentTime + io $ destroyWindow d w + destroyComplWin + io $ sync d False + +type KeyStroke = (KeySym, String) + +eventLoop :: (KeyStroke -> Event -> XP ()) -> XP () +eventLoop action = do + d <- gets dpy + (keysym,string,event) <- io $ + allocaXEvent $ \e -> do + maskEvent d (exposureMask .|. keyPressMask) e + ev <- getEvent e + (ks,s) <- if ev_event_type ev == keyPress + then lookupString $ asKeyEvent e + else return (Nothing, "") + return (ks,s,ev) + action (fromMaybe xK_VoidSymbol keysym,string) event + +-- Main event handler +handle :: KeyStroke -> Event -> XP () +handle k@(ks,_) e@(KeyEvent {ev_event_type = t}) + | t == keyPress && ks == xK_Tab = do + c <- getCompletions + completionHandle c k e +handle ks (KeyEvent {ev_event_type = t, ev_state = m}) + | t == keyPress = keyPressHandle m ks +handle _ (ExposeEvent {ev_window = w}) = do + st <- get + when (win st == w) updateWindows + eventLoop handle +handle _ _ = eventLoop handle + +-- completion event handler +completionHandle :: [String] -> KeyStroke -> Event -> XP () +completionHandle c (ks,_) (KeyEvent {ev_event_type = t}) + | t == keyPress && ks == xK_Tab = do + st <- get + case c of + [] -> do updateWindows + eventLoop handle + l -> do let new_command = newCommand (command st) l + modify $ \s -> s { command = new_command, offset = length new_command } + redrawWindows c + eventLoop (completionHandle c) +-- key release + | t == keyRelease && ks == xK_Tab = eventLoop (completionHandle c) +-- other keys +completionHandle _ ks (KeyEvent {ev_event_type = t, ev_state = m}) + | t == keyPress = keyPressHandle m ks +-- some other event: go back to main loop +completionHandle _ k e = handle k e + +-- | Given a completion and a list of possible completions, returns the +-- index of the next completion in the list +newIndex :: String -> [String] -> Int +newIndex com cl = + case elemIndex (getLastWord com) cl of + Just i -> if i >= length cl - 1 then 0 else i + 1 + Nothing -> 0 + +-- | Given a completion and a list of possible completions, returns the +-- the next completion in the list +newCommand :: String -> [String] -> String +newCommand com cl = + skipLastWord com ++ (cl !! (newIndex com cl)) + +-- KeyPresses + +data Direction = Prev | Next deriving (Eq,Show,Read) + +keyPressHandle :: KeyMask -> KeyStroke -> XP () +-- commands: ctrl + ... todo +keyPressHandle mask (ks,_) + | mask == controlMask = + -- control sequences + case () of + _ | ks == xK_u -> killBefore >> go + | ks == xK_k -> killAfter >> go + | ks == xK_a -> startOfLine >> go + | ks == xK_e -> endOfLine >> go + | ks == xK_y -> pasteString >> go + | ks == xK_Delete -> killWord Next >> go + | ks == xK_BackSpace -> killWord Prev >> go + | ks == xK_g || ks == xK_c -> quit + | otherwise -> eventLoop handle -- unhandled control sequence + | ks == xK_Return = historyPush >> return () + | ks == xK_BackSpace = deleteString Prev >> go + | ks == xK_Delete = deleteString Next >> go + | ks == xK_Left = moveCursor Prev >> go + | ks == xK_Right = moveCursor Next >> go + | ks == xK_Up = moveHistory Prev >> go + | ks == xK_Down = moveHistory Next >> go + | ks == xK_Home = startOfLine >> go + | ks == xK_End = endOfLine >> go + | ks == xK_Escape = quit + where + go = updateWindows >> eventLoop handle + quit = flushString >> return () -- quit and discard everything +-- insert a character +keyPressHandle _ (_,s) + | s == "" = eventLoop handle + | otherwise = do insertString s + updateWindows + eventLoop handle + +-- KeyPress and State + +-- | 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) } + +-- | Kill the next\/previous word +killWord :: Direction -> XP () +killWord d = do + XPS { command = c, offset = o } <- get + let (f,ss) = splitAt o c + delNextWord w = + case w of + ' ':x -> x + word -> snd . break isSpace $ word + delPrevWord = reverse . delNextWord . reverse + (ncom,noff) = + case d of + Next -> (f ++ delNextWord ss, o) + Prev -> (delPrevWord f ++ ss, length $ delPrevWord f) -- laziness!! + modify $ \s -> s { command = ncom, offset = noff} + +-- | 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 } + +-- | Flush the command string and reset the offset +flushString :: XP () +flushString = do + 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 + +-- | Insert the current X selection string at the cursor position. +pasteString :: XP () +pasteString = join $ io $ liftM insertString $ getSelection + +-- | 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) + +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} + +-- X Stuff + +updateWindows :: XP () +updateWindows = do + d <- gets dpy + drawWin + c <- getCompletions + case c of + [] -> destroyComplWin >> return () + l -> redrawComplWin l + io $ sync d False + +redrawWindows :: [String] -> XP () +redrawWindows c = do + d <- gets dpy + drawWin + case c of + [] -> return () + l -> redrawComplWin l + 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 + +drawWin :: XP () +drawWin = do + st <- get + let (c,(d,(w,gc))) = (config &&& dpy &&& win &&& gcon) st + scr = defaultScreenOfDisplay d + wh = widthOfScreen scr + ht = height c + bw = promptBorderWidth c + 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 + io $ copyArea d p w gc 0 0 wh ht 0 0 + io $ freePixmap d p + +printPrompt :: Drawable -> XP () +printPrompt drw = do + st <- get + let (gc,(c,(d,fs))) = (gcon &&& config &&& dpy &&& fontS) st + (prt,(com,off)) = (show . xptype &&& command &&& offset) st + str = prt ++ com + -- break the string in 3 parts: 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 <- io $ textWidthXMF (dpy st) fs f + psl <- io $ textWidthXMF (dpy st) fs p + (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) fs str + let y = fi $ ((ht - fi (asc + desc)) `div` 2) + fi asc + x = (asc + desc) `div` 2 + + let draw = printStringXMF d drw fs gc + -- print the first part + draw (fgColor c) (bgColor c) x y f + -- reverse the colors and print the "cursor" ;-) + draw (bgColor c) (fgColor c) (x + fromIntegral fsl) y p + -- reverse the colors and print the rest of the string + draw (fgColor c) (bgColor c) (x + fromIntegral (fsl + psl)) y ss + +-- Completions + +getCompletions :: XP [String] +getCompletions = do + s <- get + io $ (completionFunction s) (getLastWord $ command s) + `catch` \_ -> return [] + +setComplWin :: Window -> ComplWindowDim -> XP () +setComplWin w wi = + modify (\s -> s { complWin = Just w, complWinDim = Just wi }) + +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 }) + Nothing -> return () + +type ComplWindowDim = (Position,Position,Dimension,Dimension,Columns,Rows) +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,(scr,fs)) = (config &&& screen &&& fontS) st + wh = rect_width scr + ht = height c + + tws <- mapM (textWidthXMF (dpy st) fs) compl + let max_compl_len = fromIntegral ((fi ht `div` 2) + maximum tws) + columns = max 1 $ wh `div` (fi max_compl_len) + rem_height = rect_height scr - ht + (rows,r) = (length compl) `divMod` fi columns + needed_rows = max 1 (rows + if r == 0 then 0 else 1) + 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)) + (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) fs $ head compl + let yp = fi $ (ht + fi (asc - desc)) `div` 2 + xp = (asc + desc) `div` 2 + yy = map fi . take (fi actual_rows) $ [yp,(yp + ht)..] + xx = take (fi columns) [xp,(xp + max_compl_len)..] + + return (rect_x scr + x, rect_y scr + 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 = promptBorderWidth c + gc = gcon st + bgcolor <- io $ initColor d (bgColor 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 c) (bgColor c) xx yy ac + io $ copyArea d p w gc 0 0 wh ht 0 0 + io $ freePixmap d p + +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 + +printComplList :: Display -> Drawable -> GC -> String -> String + -> [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 -> String -> String + -> Position -> [Position] -> [String] -> XP () +printComplColumn _ _ _ _ _ _ _ [] = return () +printComplColumn _ _ _ _ _ _ [] _ = return () +printComplColumn d drw gc fc bc x (y:yy) (s:ss) = do + printComplString d drw gc fc bc x y s + printComplColumn d drw gc fc bc x yy ss + +printComplString :: Display -> Drawable -> GC -> String -> String + -> Position -> Position -> String -> XP () +printComplString d drw gc fc bc x y s = do + st <- get + if s == getLastWord (command st) + then printStringXMF d drw (fontS st) gc + (fgHLight $ config st) (bgHLight $ config st) x y s + else printStringXMF d drw (fontS st) gc fc bc x y s + +-- 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 = nub $ 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],Handle) +readHistory = do + home <- getEnv "HOME" + let path = home ++ "/.xmonad_history" + f <- fileExist path + if f then do h <- openFile path ReadMode + str <- hGetContents h + case (reads str) of + [(hist,_)] -> return (hist,h) + [] -> return ([],h) + _ -> return ([],h) + else do h <- openFile path WriteMode + return ([],h) + +writeHistory :: [History] -> IO () +writeHistory hist = do + home <- getEnv "HOME" + let path = home ++ "/.xmonad_history" + catch (writeFile path (show hist)) (\_ -> do putStrLn "error in writing"; return ()) + +-- $xutils + +-- | Fills a 'Drawable' with a rectangle and a border +fillDrawable :: Display -> Drawable -> GC -> Pixel -> Pixel + -> Dimension -> Dimension -> Dimension -> IO () +fillDrawable d drw gc border bgcolor bw wh ht = do + -- we start with the border + setForeground d gc border + fillRectangle d drw gc 0 0 wh ht + -- here foreground means 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 + +-- $utils + +-- | This function takes a list of possible completions and returns a +-- completions function to be used with 'mkXPrompt' +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 for fromIntegral +fi :: (Num b, Integral a) => a -> b +fi = fromIntegral + +-- | Given a maximum length, splits a list into sublists +splitInSubListsAt :: Int -> [a] -> [[a]] +splitInSubListsAt _ [] = [] +splitInSubListsAt i x = f : splitInSubListsAt i rest + where (f,rest) = splitAt i x + +-- | Gets the last word of a string or the whole string if formed by +-- only one word +getLastWord :: String -> String +getLastWord = reverse . fst . breakAtSpace . reverse + +-- | Skips the last word of the string, if the string is composed by +-- more then one word. Otherwise returns the string. +skipLastWord :: String -> String +skipLastWord = reverse . snd . breakAtSpace . reverse + +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 + +-- | Sort a list and remove duplicates. +uniqSort :: Ord a => [a] -> [a] +uniqSort = toList . fromList diff --git a/XMonad/Prompt/AppendFile.hs b/XMonad/Prompt/AppendFile.hs new file mode 100644 --- /dev/null +++ b/XMonad/Prompt/AppendFile.hs @@ -0,0 +1,66 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.AppendFile +-- Copyright : (c) 2007 Brent Yorgey +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- A prompt for appending a single line of text to a file. Useful for +-- keeping a file of notes, things to remember for later, and so on--- +-- using a keybinding, you can write things down just about as quickly +-- as you think of them, so it doesn't have to interrupt whatever else +-- you're doing. +-- +-- Who knows, it might be useful for other purposes as well! +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.AppendFile ( + -- * Usage + -- $usage + + appendFilePrompt + ) where + +import XMonad.Core +import XMonad.Prompt + +import System.IO +import Control.Exception + +-- $usage +-- +-- You can use this module by importing it, along with +-- "XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file: +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.AppendFile +-- +-- and adding an appropriate keybinding, for example: +-- +-- > , ((modMask x .|. controlMask, xK_n), appendFilePrompt defaultXPConfig "/home/me/NOTES") +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data AppendFile = AppendFile FilePath + +instance XPrompt AppendFile where + showXPrompt (AppendFile fn) = "Add to " ++ fn ++ ": " + +-- | Given an XPrompt configuration and a file path, prompt the user +-- for a line of text, and append it to the given file. +appendFilePrompt :: XPConfig -> FilePath -> X () +appendFilePrompt c fn = mkXPrompt (AppendFile fn) + c + (const (return [])) + (doAppend fn) + +-- | Append a string to a file. +doAppend :: FilePath -> String -> X () +doAppend fn s = io $ bracket (openFile fn AppendMode) + hClose + (flip hPutStrLn s) diff --git a/XMonad/Prompt/Directory.hs b/XMonad/Prompt/Directory.hs new file mode 100644 --- /dev/null +++ b/XMonad/Prompt/Directory.hs @@ -0,0 +1,43 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Directory +-- Copyright : (C) 2007 Andrea Rossato, David Roundy +-- License : BSD3 +-- +-- Maintainer : droundy@darcs.net +-- Stability : unstable +-- Portability : unportable +-- +-- A directory prompt for XMonad +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.Directory ( + -- * Usage + -- $usage + directoryPrompt + ) where + +import XMonad +import XMonad.Prompt +import XMonad.Util.Run ( runProcessWithInput ) + +-- $usage +-- For an example usage see "XMonad.Layout.WorkspaceDir" + +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 :: String -> Bool +notboring ('.':'.':_) = True +notboring ('.':_) = False +notboring _ = True diff --git a/XMonad/Prompt/Email.hs b/XMonad/Prompt/Email.hs new file mode 100644 --- /dev/null +++ b/XMonad/Prompt/Email.hs @@ -0,0 +1,63 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Email +-- Copyright : (c) 2007 Brent Yorgey +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- A prompt for sending quick, one-line emails, via the standard GNU +-- \'mail\' utility (which must be in your $PATH). This module is +-- intended mostly as an example of using "XMonad.Prompt.Input" to +-- build an action requiring user input. +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.Email ( + -- * Usage + -- $usage + emailPrompt + ) where + +import XMonad.Core +import XMonad.Util.Run +import XMonad.Prompt +import XMonad.Prompt.Input + +-- $usage +-- +-- You can use this module by importing it, along with +-- "XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file: +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.Email +-- +-- and adding an appropriate keybinding, for example: +-- +-- > , ((modMask x .|. controlMask, xK_e), emailPrompt defaultXPConfig addresses) +-- +-- where @addresses@ is a list of email addresses that should +-- autocomplete, for example: +-- +-- > addresses = ["me@me.com", "mr@big.com", "tom.jones@foo.bar"] +-- +-- You can still send email to any address, but sending to these +-- addresses will be faster since you only have to type a few +-- characters and then hit \'tab\'. +-- +-- For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings". + + +-- | Prompt the user for a recipient, subject, and body, and send an +-- email via the GNU \'mail\' utility. The second argument is a list +-- of addresses for autocompletion. +emailPrompt :: XPConfig -> [String] -> X () +emailPrompt c addrs = + inputPromptWithCompl c "To" (mkComplFunFromList addrs) ?+ \to -> + inputPrompt c "Subject" ?+ \subj -> + inputPrompt c "Body" ?+ \body -> + io $ runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n") + >> return () diff --git a/XMonad/Prompt/Input.hs b/XMonad/Prompt/Input.hs new file mode 100644 --- /dev/null +++ b/XMonad/Prompt/Input.hs @@ -0,0 +1,114 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Input +-- Copyright : (c) 2007 Brent Yorgey +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- A generic framework for prompting the user for input and passing it +-- along to some other action. +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.Input ( + -- * Usage + -- $usage + inputPrompt, + inputPromptWithCompl, + (?+) + ) where + +import XMonad.Core +import XMonad.Prompt + +-- $usage +-- +-- To use this module, import it along with "XMonad.Prompt": +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.Input +-- +-- This module provides no useful functionality in isolation, but +-- is intended for use in building other actions which require user +-- input. +-- +-- For example, suppose Mr. Big wants a way to easily fire his +-- employees. We'll assume that he already has a function +-- +-- > fireEmployee :: String -> X () +-- +-- which takes as input the name of an employee, and fires them. He +-- just wants a convenient way to provide the input for this function +-- from within xmonad. Here is where the "XMonad.Prompt.Input" module +-- comes into play. He can use the 'inputPrompt' function to create a +-- prompt, and the '?+' operator to compose the prompt with the +-- @fireEmployee@ action, like so: +-- +-- > firingPrompt :: X () +-- > firingPrompt = inputPrompt defaultXPConfig \"Fire\" ?+ fireEmployee +-- +-- If @employees@ contains a list of all his employees, he could also +-- create an autocompleting version, like this: +-- +-- > firingPrompt' = inputPromptWithCompl defaultXPConfig \"Fire\" +-- > (mkComplFunFromList employees) ?+ fireEmployee +-- +-- Now all he has to do is add a keybinding to @firingPrompt@ (or +-- @firingPrompt'@), such as +-- +-- > , ((modMask x .|. controlMask, xK_f), firingPrompt) +-- +-- Now when Mr. Big hits mod-ctrl-f, a prompt will pop up saying +-- \"Fire: \", waiting for him to type the name of someone to fire. +-- If he thinks better of it after hitting mod-ctrl-f and cancels the +-- prompt (e.g. by hitting Esc), the @fireEmployee@ action will not be +-- invoked. +-- +-- (For detailed instructions on editing your key bindings, see +-- "XMonad.Doc.Extending#Editing_key_bindings".) +-- +-- "XMonad.Prompt.Input" is also intended to ease the process of +-- developing other modules which require user input. For an example +-- of a module developed using this functionality, see +-- "XMonad.Prompt.Email", which prompts the user for a recipient, +-- subject, and one-line body, and sends a quick email. + +data InputPrompt = InputPrompt String + +instance XPrompt InputPrompt where + showXPrompt (InputPrompt s) = s ++ ": " + +-- | Given a prompt configuration and some prompt text, create an X +-- action which pops up a prompt waiting for user input, and returns +-- whatever they type. Note that the type of the action is @X +-- (Maybe String)@, which reflects the fact that the user might +-- cancel the prompt (resulting in @Nothing@), or enter an input +-- string @s@ (resulting in @Just s@). +inputPrompt :: XPConfig -> String -> X (Maybe String) +inputPrompt c p = inputPromptWithCompl c p (const (return [])) + +-- | The same as 'inputPrompt', but with a completion function. The +-- type @ComplFunction@ is @String -> IO [String]@, as defined in +-- "XMonad.Prompt". The 'mkComplFunFromList' utility function, also +-- defined in "XMonad.Prompt", is useful for creating such a +-- function from a known list of possibilities. +inputPromptWithCompl :: XPConfig -> String -> ComplFunction -> X (Maybe String) +inputPromptWithCompl c p compl = mkXPromptWithReturn (InputPrompt p) c compl return + + +infixr 1 ?+ + +-- | A combinator for hooking up an input prompt action to a function +-- which can take the result of the input prompt and produce another +-- action. If the user cancels the input prompt, the +-- second function will not be run. +-- +-- The astute student of types will note that this is actually a +-- very general combinator and has nothing in particular to do +-- with input prompts. If you find a more general use for it and +-- want to move it to a different module, be my guest. +(?+) :: (Monad m) => m (Maybe a) -> (a -> m ()) -> m () +x ?+ k = x >>= maybe (return ()) k diff --git a/XMonad/Prompt/Layout.hs b/XMonad/Prompt/Layout.hs new file mode 100644 --- /dev/null +++ b/XMonad/Prompt/Layout.hs @@ -0,0 +1,56 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Layout +-- Copyright : (C) 2007 Andrea Rossato, David Roundy +-- License : BSD3 +-- +-- Maintainer : droundy@darcs.net +-- Stability : unstable +-- Portability : unportable +-- +-- A layout-selection prompt for XMonad +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.Layout ( + -- * Usage + -- $usage + layoutPrompt + ) where + +import Data.List ( sort, nub ) +import XMonad hiding ( workspaces ) +import XMonad.Prompt +import XMonad.StackSet ( workspaces, layout ) +import XMonad.Layout.LayoutCombinators ( JumpToLayout(..) ) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.Layout +-- +-- > , ((modMask x .|. shiftMask, xK_m ), layoutPrompt defaultXPConfig) +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". +-- +-- WARNING: This prompt won't display all possible layouts, because the +-- code to enable this was rejected from xmonad core. It only displays +-- layouts that are actually in use. Also, you can only select layouts if +-- you are using NewSelect, rather than the Select defined in xmonad core +-- (which doesn't have this feature). So all in all, this module is really +-- more a proof-of-principle than something you can actually use +-- productively. + +data Wor = Wor String + +instance XPrompt Wor where + showXPrompt (Wor x) = x + +layoutPrompt :: XPConfig -> X () +layoutPrompt c = do ls <- gets (map (description . layout) . workspaces . windowset) + mkXPrompt (Wor "") c (mkCompl $ sort $ nub ls) (sendMessage . JumpToLayout) + +mkCompl :: [String] -> String -> IO [String] +mkCompl l s = return $ filter (\x -> take (length s) x == s) l diff --git a/XMonad/Prompt/Man.hs b/XMonad/Prompt/Man.hs new file mode 100644 --- /dev/null +++ b/XMonad/Prompt/Man.hs @@ -0,0 +1,105 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Man +-- Copyright : (c) 2007 Valery V. Vorotyntsev +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Valery V. Vorotyntsev +-- Portability : non-portable (uses "manpath" and "bash") +-- +-- A manual page prompt for XMonad window manager. +-- +-- TODO +-- +-- * narrow completions by section number, if the one is specified +-- (like @\/etc\/bash_completion@ does) +-- +-- * write QuickCheck properties +----------------------------------------------------------------------------- + +module XMonad.Prompt.Man ( + -- * Usage + -- $usage + manPrompt + , getCommandOutput + ) where + +import XMonad +import XMonad.Prompt +import XMonad.Util.Run +import XMonad.Prompt.Shell (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 + +-- $usage +-- 1. In your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.Man +-- +-- 2. In your keybindings add something like: +-- +-- > , ((modMask x, xK_F1), manPrompt defaultXPConfig) +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +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 $ runInTerm . (++) "man " + +manCompl :: String -> IO [String] +manCompl str | '/' `elem` str = do + -- XXX It may be better to use readline instead of bash's compgen... + lines `fmap` getCommandOutput ("bash -c 'compgen -A file " ++ str ++ "'") + | otherwise = do + mp <- getCommandOutput "manpath -g 2>/dev/null" `E.catch` \_ -> return [] + 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 + +-- | Run a command using shell and return its output. +-- +-- XXX merge with 'XMonad.Util.Run.runProcessWithInput'? +-- +-- * update documentation of the latter (there is no 'Maybe' in result) +-- +-- * ask \"gurus\" whether @evaluate (length ...)@ approach is +-- better\/more idiomatic +getCommandOutput :: String -> IO String +getCommandOutput s = do + (pin, pout, perr, ph) <- runInteractiveCommand s + hClose pin + output <- hGetContents pout + E.evaluate (length 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 diff --git a/XMonad/Prompt/Shell.hs b/XMonad/Prompt/Shell.hs new file mode 100644 --- /dev/null +++ b/XMonad/Prompt/Shell.hs @@ -0,0 +1,124 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Shell +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A shell prompt for XMonad +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.Shell( + -- * Usage + -- $usage + shellPrompt + , getShellCompl + , split + , prompt + , safePrompt + ) where + +import System.Environment +import Control.Monad +import Data.List +import System.Directory +import System.IO +import XMonad.Util.Run +import XMonad hiding (config) +import XMonad.Prompt + +-- $usage +-- 1. In your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.Shell +-- +-- 2. In your keybindings add something like: +-- +-- > , ((modMask x .|. controlMask, xK_x), shellPrompt defaultXPConfig) +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data Shell = Shell + +instance XPrompt Shell where + showXPrompt Shell = "Run: " + +shellPrompt :: XPConfig -> X () +shellPrompt c = do + cmds <- io $ getCommands + mkXPrompt Shell c (getShellCompl cmds) spawn + +-- | 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 + +getShellCompl :: [String] -> String -> IO [String] +getShellCompl cmds s | s == "" || last s == ' ' = return [] + | otherwise = do + f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file " ++ s ++ "\n") + return . map escape . uniqSort $ f ++ commandCompletionFunction cmds s + +commandCompletionFunction :: [String] -> String -> [String] +commandCompletionFunction cmds str | '/' `elem` str = [] + | otherwise = filter (isPrefixOf str) cmds + +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 + +isExecutable :: FilePath ->IO Bool +isExecutable f = do + fe <- doesFileExist f + if fe + then fmap executable $ getPermissions f + else return False + +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 + +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 "\\@\"'#?$*()[]{};" diff --git a/XMonad/Prompt/Ssh.hs b/XMonad/Prompt/Ssh.hs new file mode 100644 --- /dev/null +++ b/XMonad/Prompt/Ssh.hs @@ -0,0 +1,105 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Ssh +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A ssh prompt for XMonad +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.Ssh( + -- * Usage + -- $usage + sshPrompt + ) where + +import XMonad +import XMonad.Util.Run +import XMonad.Prompt + +import System.Directory +import System.Environment + +import Control.Monad +import Data.List +import Data.Maybe + +-- $usage +-- 1. In your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.Ssh +-- +-- 2. In your keybindings add something like: +-- +-- > , ((modMask x .|. controlMask, xK_s), sshPrompt defaultXPConfig) +-- +-- Keep in mind, that if you want to use the completion you have to +-- disable the "HashKnownHosts" option in your ssh_config +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +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 = runInTerm ("ssh " ++ s) + +sshComplList :: IO [String] +sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal + +sshComplListLocal :: IO [String] +sshComplListLocal = do + h <- getEnv "HOME" + 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 + f <- doesFileExist kh + if f then sshComplListFile' kh + else return [] + +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 diff --git a/XMonad/Prompt/Window.hs b/XMonad/Prompt/Window.hs new file mode 100644 --- /dev/null +++ b/XMonad/Prompt/Window.hs @@ -0,0 +1,85 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Window +-- 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 XMonad.Prompt.Window + ( + -- * Usage + -- $usage + windowPromptGoto, + windowPromptBring + ) where + +import qualified Data.Map as M +import Data.List + +import qualified XMonad.StackSet as W +import XMonad +import XMonad.Prompt +import XMonad.Actions.WindowBringer + +-- $usage +-- WindowPrompt brings windows to you and you to windows. +-- That is to say, it pops up a prompt with window names, in case you forgot +-- where you left your XChat. +-- +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.Window +-- +-- and in the keys definition: +-- +-- > , ((modMask x .|. shiftMask, xK_g ), windowPromptGoto defaultXPConfig) +-- > , ((modMask x .|. shiftMask, xK_b ), windowPromptBring defaultXPConfig) +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +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 diff --git a/XMonad/Prompt/Workspace.hs b/XMonad/Prompt/Workspace.hs new file mode 100644 --- /dev/null +++ b/XMonad/Prompt/Workspace.hs @@ -0,0 +1,48 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Workspace +-- Copyright : (C) 2007 Andrea Rossato, David Roundy +-- License : BSD3 +-- +-- Maintainer : droundy@darcs.net +-- Stability : unstable +-- Portability : unportable +-- +-- A workspace prompt for XMonad +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.Workspace ( + -- * Usage + -- $usage + workspacePrompt + ) where + +import Data.List ( sort ) +import XMonad hiding ( workspaces ) +import XMonad.Prompt +import XMonad.StackSet ( workspaces, tag ) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.Workspace +-- +-- > , ((modMask x .|. shiftMask, xK_m ), workspacePrompt defaultXPConfig (windows . W.shift)) +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +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 diff --git a/XMonad/Prompt/XMonad.hs b/XMonad/Prompt/XMonad.hs new file mode 100644 --- /dev/null +++ b/XMonad/Prompt/XMonad.hs @@ -0,0 +1,51 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.XMonad +-- Copyright : (C) 2007 Andrea Rossato +-- License : BSD3 +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A prompt for running XMonad commands +-- +----------------------------------------------------------------------------- + +module XMonad.Prompt.XMonad ( + -- * Usage + -- $usage + xmonadPrompt, + xmonadPromptC + ) where + +import XMonad +import XMonad.Prompt +import XMonad.Actions.Commands (defaultCommands, runCommand') + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Prompt +-- > import XMonad.Prompt.XMonad +-- +-- in your keybindings add: +-- +-- > , ((modMask x .|. controlMask, xK_x), xmonadPrompt defaultXPConfig) +-- +-- For detailed instruction on editing the key binding see +-- "XMonad.Doc.Extending#Editing_key_bindings". + +data XMonad = XMonad + +instance XPrompt XMonad where + showXPrompt XMonad = "XMonad: " + +xmonadPrompt :: XPConfig -> X () +xmonadPrompt c = do + cmds <- defaultCommands + mkXPrompt XMonad c (mkComplFunFromList (map fst cmds)) runCommand' + +-- | An xmonad prompt with a custom command list +xmonadPromptC :: [(String, X ())] -> XPConfig -> X () +xmonadPromptC commands c = mkXPrompt XMonad c (mkComplFunFromList (map fst commands)) runCommand' diff --git a/XMonad/Util/Anneal.hs b/XMonad/Util/Anneal.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/Anneal.hs @@ -0,0 +1,93 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Anneal +-- Copyright : (c) David Roundy +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- Requires the 'random' package +-- +----------------------------------------------------------------------------- + +module XMonad.Util.Anneal (-- * Usage + -- $usage + Rated(Rated), the_value, the_rating + , anneal, annealMax ) where + +import System.Random ( StdGen, Random, mkStdGen, randomR ) +import Control.Monad.State ( State, runState, put, get, gets, modify ) + +-- $usage +-- See "XMonad.Layout.Mosaic" for an usage example. + +data Rated a b = Rated !a !b + deriving ( Show ) +instance Functor (Rated a) where + f `fmap` (Rated v a) = Rated v (f a) + +the_value :: Rated a b -> b +the_value (Rated _ b) = b +the_rating :: Rated a b -> a +the_rating (Rated a _) = a + +instance Eq a => Eq (Rated a b) where + (Rated a _) == (Rated a' _) = a == a' +instance Ord a => Ord (Rated a b) where + compare (Rated a _) (Rated a' _) = compare a a' + +anneal :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a +anneal st r sel = runAnneal st r (do_anneal sel) + +annealMax :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a +annealMax st r sel = runAnneal st (negate . r) (do_anneal sel) + +do_anneal :: (a -> [a]) -> State (Anneal a) (Rated Double a) +do_anneal sel = do sequence_ $ replicate 100 da + gets best + where da = do select_metropolis sel + modify $ \s -> s { temperature = temperature s *0.99 } + +data Anneal a = A { g :: StdGen + , best :: Rated Double a + , current :: Rated Double a + , rate :: a -> Rated Double a + , temperature :: Double } + +runAnneal :: a -> (a -> Double) -> State (Anneal a) b -> b +runAnneal start r x = fst $ runState x (A { g = mkStdGen 137 + , best = Rated (r start) start + , current = Rated (r start) start + , rate = \xx -> Rated (r xx) xx + , temperature = 1.0 }) + +select_metropolis :: (a -> [a]) -> State (Anneal a) () +select_metropolis x = do c <- gets current + a <- select $ x $ the_value c + metropolis a + +metropolis :: a -> State (Anneal a) () +metropolis x = do r <- gets rate + c <- gets current + t <- gets temperature + let rx = r x + boltz = exp $ (the_rating c - the_rating rx) / t + if rx < c then do modify $ \s -> s { current = rx, best = rx } + else do p <- getOne (0,1) + if p < boltz + then modify $ \s -> s { current = rx } + else return () + +select :: [a] -> State (Anneal a) a +select [] = the_value `fmap` gets best +select [x] = return x +select xs = do n <- getOne (0,length xs - 1) + return (xs !! n) + +getOne :: (Random a) => (a,a) -> State (Anneal x) a +getOne bounds = do s <- get + (x,g') <- return $ randomR bounds (g s) + put $ s { g = g' } + return x diff --git a/XMonad/Util/CustomKeys.hs b/XMonad/Util/CustomKeys.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/CustomKeys.hs @@ -0,0 +1,87 @@ +-------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.CustomKeys +-- Copyright : (c) 2007 Valery V. Vorotyntsev +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Valery V. Vorotynsev +-- +-- Customized key bindings. +-- +-- (See also "XMonad.Util.EZConfig" in xmonad-contrib.) +-------------------------------------------------------------------- + +module XMonad.Util.CustomKeys ( + -- * Usage + -- $usage + customKeys + , customKeysFrom + ) where + +import XMonad +import Control.Monad.Reader + +import qualified Data.Map as M + +-- $usage +-- +-- 1. In @~\/.xmonad\/xmonad.hs@ add: +-- +-- > import XMonad.Util.CustomKeys +-- +-- 2. Set key bindings with 'customKeys': +-- +-- > main = xmonad defaultConfig { keys = customKeys delkeys inskeys } +-- > where +-- > delkeys :: XConfig l -> [(KeyMask, KeySym)] +-- > delkeys XConfig {modMask = modm} = +-- > -- we're preferring Futurama to Xinerama here +-- > [ (modm .|. m, k) | (m, k) <- zip [0, shiftMask] [xK_w, xK_e, xK_r] ] +-- > +-- > inskeys :: XConfig l -> [((KeyMask, KeySym), X ())] +-- > inskeys conf@(XConfig {modMask = modm}) = +-- > [ ((mod1Mask, xK_F2 ), spawn $ terminal conf) +-- > , ((modm .|. controlMask, xK_F11 ), spawn "xscreensaver-command -lock") +-- > , ((mod1Mask, xK_Down), spawn "amixer set Master 1-") +-- > , ((mod1Mask, xK_Up ), spawn "amixer set Master 1+") +-- > ] +-- +-- 0 (/hidden feature/). You can always replace bindings map +-- entirely. No need to import "CustomKeys" this time: +-- +-- > import XMonad +-- > import System.Exit +-- > import qualified Data.Map as M +-- > +-- > main = xmonad defaultConfig { +-- > keys = \_ -> M.fromList [ +-- > -- Let me out of here! I want my KDE back! Help! Help! +-- > ( (0, xK_Escape), io (exitWith ExitSuccess) ) ] } + +-- | Customize 'XMonad.Config.defaultConfig' -- delete needless +-- shortcuts and insert those you will use. +customKeys :: (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ shortcuts to delete + -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ key bindings to insert + -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) +customKeys = customKeysFrom defaultConfig + +-- | General variant of 'customKeys': customize key bindings of +-- third-party configuration. +customKeysFrom :: XConfig l -- ^ original configuration + -> (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ shortcuts to delete + -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ key bindings to insert + -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) +customKeysFrom conf = (runReader .) . customize conf + +customize :: XConfig l + -> (XConfig Layout -> [(KeyMask, KeySym)]) + -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) + -> Reader (XConfig Layout) (M.Map (KeyMask, KeySym) (X ())) +customize conf ds is = Reader (keys conf) >>= delete ds >>= insert is + +delete :: (MonadReader r m, Ord a) => (r -> [a]) -> M.Map a b -> m (M.Map a b) +delete dels kmap = asks dels >>= return . foldr M.delete kmap + +insert :: (MonadReader r m, Ord a) => + (r -> [(a, b)]) -> M.Map a b -> m (M.Map a b) +insert ins kmap = asks ins >>= return . foldr (uncurry M.insert) kmap diff --git a/XMonad/Util/Dmenu.hs b/XMonad/Util/Dmenu.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/Dmenu.hs @@ -0,0 +1,48 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Dmenu +-- Copyright : (c) Spencer Janssen +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Spencer Janssen +-- Stability : unstable +-- Portability : unportable +-- +-- A convenient binding to dmenu. +-- +-- Requires the process-1.0 package +-- +----------------------------------------------------------------------------- + +module XMonad.Util.Dmenu ( + -- * Usage + -- $usage + dmenu, dmenuXinerama, dmenuMap + ) where + +import XMonad +import qualified XMonad.StackSet as W +import qualified Data.Map as M +import XMonad.Util.Run + +-- $usage +-- You can use this module with the following in your Config.hs file: +-- +-- > import XMonad.Util.Dmenu + +-- %import XMonad.Util.Dmenu + +-- | Starts dmenu on the current screen. Requires this patch to dmenu: +-- +dmenuXinerama :: [String] -> X String +dmenuXinerama opts = do + curscreen <- (fromIntegral . W.screen . W.current) `fmap` gets windowset :: X Int + io $ runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts) + +dmenu :: [String] -> X String +dmenu opts = io $ runProcessWithInput "dmenu" [] (unlines opts) + +dmenuMap :: M.Map String a -> X (Maybe a) +dmenuMap selectionMap = do + selection <- dmenu (M.keys selectionMap) + return $ M.lookup selection selectionMap diff --git a/XMonad/Util/Dzen.hs b/XMonad/Util/Dzen.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/Dzen.hs @@ -0,0 +1,44 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Dzen +-- Copyright : (c) glasser@mit.edu +-- License : BSD +-- +-- Maintainer : glasser@mit.edu +-- Stability : unstable +-- Portability : unportable +-- +-- Handy wrapper for dzen. Requires dzen >= 0.2.4. +-- +----------------------------------------------------------------------------- + +module XMonad.Util.Dzen (dzen, dzenWithArgs, dzenScreen, + seconds) where + +import XMonad +import XMonad.Util.Run (runProcessWithInputAndWait, seconds) + +-- | @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 + +-- | @dzen str args timeout@ pipes @str@ to dzen2 for @timeout@ seconds, passing @args@ to dzen. +-- Example usage: +-- +-- > dzenWithArgs "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 + +-- | @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 + toXineramaArg n = show ( ((fromIntegral n)+1)::Int ) diff --git a/XMonad/Util/EZConfig.hs b/XMonad/Util/EZConfig.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/EZConfig.hs @@ -0,0 +1,61 @@ +-------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.EZConfig +-- Copyright : Devin Mullins +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Devin Mullins +-- +-- Useful helper functions for amending the defaultConfig. +-- +-- (See also "XMonad.Util.CustomKeys" in xmonad-contrib.) +-- +-------------------------------------------------------------------- + +module XMonad.Util.EZConfig ( + additionalKeys, removeKeys, + additionalMouseBindings, removeMouseBindings + ) where +-- TODO: write tests + +import XMonad + +import qualified Data.Map as M + +-- | +-- Add or override keybindings from the existing set. Example use: +-- +-- > main = xmonad $ defaultConfig { terminal = "urxvt" } +-- > `additionalKeys` +-- > [ ((mod1Mask, xK_m ), spawn "echo 'Hi, mom!' | dzen2 -p 4") +-- > , ((mod1Mask, xK_BackSpace), withFocused hide) -- N.B. this is an absurd thing to do +-- > ] +-- +-- This overrides the previous definition of mod-m. +-- +-- Note that, unlike in xmonad 0.4 and previous, you can't use modMask to refer +-- to the modMask you configured earlier. You must specify mod1Mask (or +-- whichever), or add your own @myModMask = mod1Mask@ line. +additionalKeys :: XConfig a -> [((ButtonMask, KeySym), X ())] -> XConfig a +additionalKeys conf keysList = + conf { keys = \cnf -> M.union (M.fromList keysList) (keys conf cnf) } + +-- | +-- Remove standard keybindings you're not using. Example use: +-- +-- > main = xmonad $ defaultConfig { terminal = "urxvt" } +-- > `removeKeys` [(mod1Mask .|. shiftMask, n) | n <- [xK_1 .. xK_9]] +removeKeys :: XConfig a -> [(ButtonMask, KeySym)] -> XConfig a +removeKeys conf keyList = + conf { keys = \cnf -> keys conf cnf `M.difference` M.fromList (zip keyList $ return ()) } + +-- | Like additionalKeys, but for mouseBindings. +additionalMouseBindings :: XConfig a -> [((ButtonMask, Button), Window -> X ())] -> XConfig a +additionalMouseBindings conf mouseBindingsList = + conf { mouseBindings = \cnf -> M.union (M.fromList mouseBindingsList) (mouseBindings conf cnf) } + +-- | Like removeKeys, but for mouseBindings. +removeMouseBindings :: XConfig a -> [(ButtonMask, Button)] -> XConfig a +removeMouseBindings conf mouseBindingList = + conf { mouseBindings = \cnf -> mouseBindings conf cnf `M.difference` + M.fromList (zip mouseBindingList $ return ()) } diff --git a/XMonad/Util/Font.cpphs b/XMonad/Util/Font.cpphs new file mode 100644 --- /dev/null +++ b/XMonad/Util/Font.cpphs @@ -0,0 +1,154 @@ +---------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Font +-- Copyright : (c) 2007 Andrea Rossato and Spencer Janssen +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- A module for abstracting a font facility over Core fonts and Xft +-- +----------------------------------------------------------------------------- + +module XMonad.Util.Font ( + -- * Usage: + -- $usage + XMonadFont(..) + , initXMF + , releaseXMF + , initCoreFont + , releaseCoreFont + , Align (..) + , stringPosition + , textWidthXMF + , textExtentsXMF + , printStringXMF + , stringToPixel + ) where + + +import XMonad +import Foreign + +#ifdef XFT +import Data.List +import Graphics.X11.Xft +import Graphics.X11.Xrender +#endif + +-- Hide the Core Font/Xft switching here +data XMonadFont = Core FontStruct +#ifdef XFT + | Xft XftFont +#endif + +-- $usage +-- See "Xmonad.Layout.Tabbed" or "XMonad.Prompt" for usage examples + +-- | Get the Pixel value for a named color: if an invalid name is +-- given the black pixel will be returned. +stringToPixel :: MonadIO m => Display -> String -> m Pixel +stringToPixel d s = liftIO $ catch getIt fallBack + where getIt = initColor d s + fallBack = const $ return $ blackPixel d (defaultScreen d) + + +-- | Given a fontname returns the font structure. If the font name is +-- not valid the default font will be loaded and returned. +initCoreFont :: String -> X FontStruct +initCoreFont s = do + d <- asks display + io $ catch (getIt d) (fallBack d) + where getIt d = loadQueryFont d s + fallBack d = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" + +releaseCoreFont :: FontStruct -> X () +releaseCoreFont fs = do + d <- asks display + io $ freeFont d fs + +-- | When initXMF gets a font name that starts with 'xft:' it switchs to the Xft backend +-- Example: 'xft: Sans-10' +initXMF :: String -> X XMonadFont +initXMF s = +#ifdef XFT + if xftPrefix `isPrefixOf` s then + do + dpy <- asks display + xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s) + return (Xft xftdraw) + else +#endif + (initCoreFont s >>= (return . Core)) +#ifdef XFT + where xftPrefix = "xft:" +#endif + +releaseXMF :: XMonadFont -> X () +releaseXMF (Core fs) = releaseCoreFont fs +#ifdef XFT +releaseXMF (Xft xftfont) = do + dpy <- asks display + io $ xftFontClose dpy xftfont +#endif + +textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int +textWidthXMF _ (Core fs) s = return $ fi $ textWidth fs s +#ifdef XFT +textWidthXMF dpy (Xft xftdraw) s = liftIO $ do + gi <- xftTextExtents dpy xftdraw s + return $ xglyphinfo_width gi +#endif + +textExtentsXMF :: MonadIO m => Display -> XMonadFont -> String -> m (FontDirection,Int32,Int32,CharStruct) +textExtentsXMF _ (Core fs) s = return $ textExtents fs s +#ifdef XFT +textExtentsXMF _ (Xft xftfont) _ = liftIO $ do + ascent <- xftfont_ascent xftfont + descent <- xftfont_descent xftfont + return (error "Font direction touched", fi ascent, fi descent, error "Font overall size touched") +#endif + +-- | String position +data Align = AlignCenter | AlignRight | AlignLeft + +-- | Return the string x and y 'Position' in a 'Rectangle', given a +-- 'FontStruct' and the 'Align'ment +stringPosition :: XMonadFont -> Rectangle -> Align -> String -> X (Position,Position) +stringPosition fs (Rectangle _ _ w h) al s = do + dpy <- asks display + width <- io $ textWidthXMF dpy fs s + (_,a,d,_) <- io $ textExtentsXMF dpy fs s + let y = fi $ ((h - fi (a + d)) `div` 2) + fi a; + x = case al of + AlignCenter -> fi (w `div` 2) - fi (width `div` 2) + AlignLeft -> 1 + AlignRight -> fi (w - (fi width + 1)); + return (x,y) + + +printStringXMF :: MonadIO m => Display -> Drawable -> XMonadFont -> GC -> String -> String + -> Position -> Position -> String -> m () +printStringXMF d p (Core fs) gc fc bc x y s = liftIO $ do + setFont d gc $ fontFromFontStruct fs + [fc',bc'] <- mapM (stringToPixel d) [fc,bc] + setForeground d gc fc' + setBackground d gc bc' + drawImageString d p gc x y s + +#ifdef XFT +printStringXMF dpy drw (Xft font) _ fc _ x y s = do + let screen = defaultScreenOfDisplay dpy; + colormap = defaultColormapOfScreen screen; + visual = defaultVisualOfScreen screen; + liftIO $ withXftDraw dpy drw visual colormap $ + \draw -> withXftColorName dpy visual colormap fc $ + \color -> xftDrawString draw color font x y s +#endif + + +-- | Short-hand for 'fromIntegral' +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral diff --git a/XMonad/Util/Invisible.hs b/XMonad/Util/Invisible.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/Invisible.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.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 XMonad.Util.Invisible ( + -- * Usage: + -- $usage + Invisible (..) + , whenIJust + , fromIMaybe + ) where + +-- $usage +-- 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. + +newtype Invisible m a = I (m a) deriving (Monad, Functor) + +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 _ = "" + +whenIJust :: (Monad m) => Invisible Maybe a -> (a -> m ()) -> m () +whenIJust (I (Just x)) f = f x +whenIJust (I Nothing) _ = return () + +fromIMaybe :: a -> Invisible Maybe a -> a +fromIMaybe _ (I (Just x)) = x +fromIMaybe a (I Nothing) = a diff --git a/XMonad/Util/NamedWindows.hs b/XMonad/Util/NamedWindows.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/NamedWindows.hs @@ -0,0 +1,52 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.NamedWindows +-- Copyright : (c) David Roundy +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : David Roundy +-- Stability : unstable +-- Portability : unportable +-- +-- This module allows you to associate the X titles of windows with +-- them. +-- +----------------------------------------------------------------------------- + +module XMonad.Util.NamedWindows ( + -- * Usage + -- $usage + NamedWindow, + getName, + withNamedWindow, + unName + ) where + +import qualified XMonad.StackSet as W ( peek ) + + +import XMonad + +-- $usage +-- See "XMonad.Layout.Tabbed" for an example of its use. + + +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' +instance Show NamedWindow where + show (NW n _) = n + +getName :: Window -> X NamedWindow +getName w = asks display >>= \d -> do s <- io $ getClassHint d w + n <- maybe (resName s) id `fmap` io (fetchName d w) + return $ NW n w + +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 diff --git a/XMonad/Util/Run.hs b/XMonad/Util/Run.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/Run.hs @@ -0,0 +1,144 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.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 "XMonad.Util.Dmenu" (by +-- Spencer Janssen), "XMonad.Util.Dzen" (by glasser\@mit.edu) and +-- XMonad.Util.RunInXTerm (by Andrea Rossato). +-- +----------------------------------------------------------------------------- + +module XMonad.Util.Run ( + -- * Usage + -- $usage + runProcessWithInput, + runProcessWithInputAndWait, + safeSpawn, + unsafeSpawn, + runInTerm, + safeRunInTerm, + seconds, + spawnPipe + ) where + +import System.Posix.IO +import System.Posix.Process (createSession, forkProcess, executeFile, + getProcessStatus) +import Control.Concurrent (threadDelay) +import Control.Exception (try) +import System.Exit (ExitCode(ExitSuccess), exitWith) +import System.IO +import System.Process (runInteractiveProcess, waitForProcess) +import XMonad +import Control.Monad + +-- $usage +-- For an example usage of 'runInTerm' see "XMonad.Prompt.Ssh" +-- +-- For an example usage of 'runProcessWithInput' see +-- "XMonad.Prompt.DirectoryPrompt", "XMonad.Util.Dmenu", +-- "XMonad.Prompt.ShellPrompt", "XMonad.Actions.WmiiActions", +-- "XMonad.Prompt.WorkspaceDir" +-- +-- For an example usage of 'runProcessWithInputAndWait' see +-- "XMonad.Util.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 + hClose pout + hClose perr + waitForProcess ph + return () + exitWith ExitSuccess + return () + getProcessStatus True False pid + return () + +-- | Multiplies by ONE MILLION, for use with +-- 'runProcessWithInputAndWait'. +-- +-- Use like: +-- +-- > (5.5 `seconds`) +seconds :: Rational -> Int +seconds = fromEnum . (* 1000000) + +-- | 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 :: MonadIO m => FilePath -> String -> m () +safeSpawn prog arg = liftIO (try (forkProcess $ executeFile prog True [arg] Nothing) >> return ()) + +unsafeSpawn :: MonadIO m => String -> m () +unsafeSpawn = spawn + +-- | Run a given program in the preferred terminal emulator. This uses +-- 'safeSpawn'. +safeRunInTerm :: String -> X () +safeRunInTerm command = asks (terminal . config) >>= \t -> safeSpawn t ("-e " ++ command) + +unsafeRunInTerm, runInTerm :: String -> X () +unsafeRunInTerm command = asks (terminal . config) >>= \t -> unsafeSpawn $ t ++ " -e " ++ command +runInTerm = unsafeRunInTerm + +-- | Launch an external application and return a 'Handle' to its standard input. +spawnPipe :: String -> IO Handle +spawnPipe x = do + (rd, wr) <- createPipe + setFdOption wr CloseOnExec True + h <- fdToHandle wr + hSetBuffering h LineBuffering + pid <- forkProcess $ do + forkProcess $ do + dupTo rd stdInput + createSession + executeFile "/bin/sh" False ["-c", x] Nothing + exitWith ExitSuccess + getProcessStatus True False pid + return h diff --git a/XMonad/Util/XSelection.hs b/XMonad/Util/XSelection.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/XSelection.hs @@ -0,0 +1,167 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.XSelection +-- Copyright : (C) 2007 Andrea Rossato, Matthew Sackman +-- License : BSD3 +-- +-- Maintainer : Andrea Rossato , +-- Matthew Sackman +-- Stability : unstable +-- Portability : unportable +-- +-- A module for accessing and manipulating the X Window mouse selection (used in copy and pasting). +-- getSelection and putSelection are adaptations of Hxsel.hs and Hxput.hs from XMonad-utils, available: +-- +-- $ darcs get "http:\/\/gorgias.mine.nu\/repos\/xmonad-utils" +----------------------------------------------------------------------------- + +module XMonad.Util.XSelection ( + -- * Usage + -- $usage + getSelection, + promptSelection, + safePromptSelection, + putSelection) where + +import Control.Concurrent (forkIO) +import Control.Exception as E (catch) +import Control.Monad(Monad (return, (>>)), Functor(..), liftM, join) +import Data.Bits (shiftL, (.&.), (.|.)) +import Data.Char (chr, ord) +import Data.Maybe (fromMaybe) +import Data.Word (Word8) +import XMonad +import XMonad.Util.Run (safeSpawn, unsafeSpawn) + +{- $usage + Add 'import XMonad.Util.XSelection' to the top of Config.hs + Then make use of getSelection or promptSelection as needed; if + one wanted to run Firefox with the selection as an argument (say, + the selection is an URL you just highlighted), then one could add + to the Config.hs a line like thus: + +> , ((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. -} + +-- | Returns a String corresponding to the current mouse selection in X; if there is none, an empty string is returned. Note that this is +-- really only reliable for ASCII text and currently escapes or otherwise mangles more complex UTF-8 characters. +getSelection :: IO String +getSelection = do + dpy <- openDisplay "" + let dflt = defaultScreen dpy + rootw <- rootWindow dpy dflt + win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0 + p <- internAtom dpy "PRIMARY" True + ty <- E.catch + (E.catch + (internAtom dpy "UTF8_STRING" False) + (\_ -> internAtom dpy "COMPOUND_TEXT" False)) + (\_ -> internAtom dpy "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 . map fromIntegral . 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 1 1 0 0 0 + p <- internAtom dpy "PRIMARY" True + ty <- internAtom dpy "UTF8_STRING" False + xSetSelectionOwner dpy p win currentTime + winOwn <- xGetSelectionOwner dpy p + if winOwn == win + then do forkIO ((allocaXEvent $ processEvent dpy ty text) >> destroyWindow dpy win) >> return () + else do putStrLn "Unable to obtain ownership of the selection" >> destroyWindow dpy win + return () + where + processEvent :: Display -> Atom -> [Char] -> XEventPtr -> IO () + processEvent dpy ty txt e = do + nextEvent dpy e + ev <- getEvent e + if ev_event_type ev == selectionRequest + then do print ev + allocaXEvent $ \replyPtr -> do + changeProperty8 (ev_event_display ev) + (ev_requestor ev) + (ev_property ev) + ty + propModeReplace + (map (fromIntegral . ord) txt) + setSelectionNotify replyPtr (ev_requestor ev) (ev_selection ev) + (ev_target ev) (ev_property ev) (ev_time ev) + sendEvent dpy (ev_requestor ev) False noEventMask replyPtr + sync dpy False + else do putStrLn "Unexpected Message Received" + print ev + processEvent dpy ty text e + +{- | 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 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 + +{- | Decode a UTF8 string packed into a list of Word8 values, directly to + String; does not deal with CChar, hence you will want the counter-intuitive 'map fromIntegral'. + UTF-8 decoding for internal use in getSelection. This code is copied from Eric Mertens's utf-string library + (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 diff --git a/XMonad/Util/XUtils.hs b/XMonad/Util/XUtils.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/XUtils.hs @@ -0,0 +1,135 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.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 screen +-- +----------------------------------------------------------------------------- + +module XMonad.Util.XUtils ( + -- * Usage: + -- $usage + averagePixels + , createNewWindow + , showWindow + , hideWindow + , deleteWindow + , paintWindow + , paintAndWrite + , stringToPixel + ) where + + +import Data.Maybe +import XMonad +import XMonad.Util.Font +import Control.Monad + +-- $usage +-- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" for usage +-- examples + +-- | 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 +-- | Create a simple window given a rectangle. If Nothing is given +-- only the exposureMask will be set, otherwise the Just value. +-- Use 'showWindow' to map and hideWindow to unmap. +createNewWindow :: Rectangle -> Maybe EventMask -> String -> X Window +createNewWindow (Rectangle x y w h) m col = do + d <- asks display + rw <- asks theRoot + c <- stringToPixel d col + win <- io $ createSimpleWindow d rw x y w h 0 c c + 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 + -> XMonadFont -- ^ XMonad Font for drawing + -> Dimension -- ^ Window width + -> Dimension -- ^ Window height + -> Dimension -- ^ Border width + -> String -- ^ Window background color + -> String -- ^ Border color + -> String -- ^ String color + -> String -- ^ String background color + -> Align -- ^ String 'Align'ment + -> String -- ^ String to be printed + -> X () +paintAndWrite w fs wh ht bw bc borc ffc fbc al str = do + (x,y) <- stringPosition fs (Rectangle 0 0 wh ht) al str + paintWindow' w (Rectangle x y wh ht) bw bc borc ms + where ms = Just (fs,ffc,fbc,str) + +-- This stuff is not exported + +paintWindow' :: Window -> Rectangle -> Dimension -> String -> String -> Maybe (XMonadFont,String,String,String) -> X () +paintWindow' win (Rectangle x y wh ht) bw color b_color str = do + d <- asks display + p <- io $ createPixmap d win wh ht (defaultDepthOfScreen $ defaultScreenOfDisplay d) + gc <- io $ createGC d p + -- draw + io $ setGraphicsExposures d gc False + [color',b_color'] <- mapM (stringToPixel d) [color,b_color] + -- we start with the border + io $ setForeground d gc b_color' + io $ fillRectangle d p gc 0 0 wh ht + -- and now again + io $ setForeground d gc color' + io $ fillRectangle d p gc (fi bw) (fi bw) ((wh - (bw * 2))) (ht - (bw * 2)) + when (isJust str) $ do + let (xmf,fc,bc,s) = fromJust str + printStringXMF d p xmf gc fc bc x y s + -- copy the pixmap over the window + 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 + +-- | Short-hand for 'fromIntegral' +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral diff --git a/scripts/generate-configs b/scripts/generate-configs new file mode 100644 --- /dev/null +++ b/scripts/generate-configs @@ -0,0 +1,302 @@ +#!/bin/bash + +# generate-configs - 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 [ 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) +# +# 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. +# +# 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 XMonad.Layout.Accordion +# -- %import qualified XMonad.Actions.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 + +# 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_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$' + +# 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 passive data after indent strings have been applied. +INS_PREFIX_DEF="-- " +INS_PREFIX_IMPORT="--import " +INS_PREFIX_KEYBIND="-- " +INS_PREFIX_KEYBINDLIST="-- " +INS_PREFIX_LAYOUT="-- " +INS_PREFIX_MOUSEBIND="-- " + +# 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="" + +# Don't touch these +opt_active=0 +opt_contrib="" +opt_main="" +opt_output="" + +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 + + 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 + + # 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}" + fi + done + 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 ;; + + --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 + 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 diff --git a/scripts/run-xmonad.sh b/scripts/run-xmonad.sh new file mode 100644 --- /dev/null +++ b/scripts/run-xmonad.sh @@ -0,0 +1,41 @@ +#!/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}/bin:$PATH + +# simple xmonad use, no interactive status bar. +# +#clock | dzen2 -ta r -fg $FG -bg $BG -fn $FONT & +#xmonad + +# +# with a pipe talking to an external program +# +PIPE=$HOME/.xmonad-status +rm -f $PIPE +PATH=${PATH}:/sbin mkfifo -m 600 $PIPE +[ -p $PIPE ] || exit + +# launch the external 60 second clock, and launch the workspace status bar +xmonad-clock | dzen2 -e '' -x 300 -w 768 -ta r -fg $FG -bg $BG -fn $FONT & + +# and a workspace status bar +dzen2 -e '' -w 300 -ta l -fg $FG -bg $BG -fn $FONT < $PIPE & + +# go for it +xmonad > $PIPE & + +# wait for xmonad +wait $! + +pkill -HUP dzen2 +pkill -HUP -f xmonad-clock + +wait diff --git a/scripts/xinitrc b/scripts/xinitrc new file mode 100644 --- /dev/null +++ b/scripts/xinitrc @@ -0,0 +1,46 @@ +# .xinitrc + +xrandr -s 0 + +xrdb $HOME/.Xresources +xsetroot -cursor_name left_ptr +xsetroot -solid '#80a0af' + +# 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 + +xset fp+ /usr/local/lib/X11/fonts/terminus +xset fp+ /usr/local/lib/X11/fonts/ghostscript +xset fp+ /usr/X11R6/lib/X11/fonts/TTF/ + +# 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" + +PATH=/home/dons/bin:$PATH + +# launch the external 60 second clock, and launch the workspace status bar +FG='#a8a3f7' +BG='#3f3c6d' +xmonad-clock | dzen2 -e '' -x 400 -w 1200 -ta r -fg $FG -bg $BG & + +xmonad & + +# wait for xmonad +wait $! +pkill -HUP dzen2 +pkill -HUP -f xmonad-clock +wait diff --git a/scripts/xmonad-acpi.c b/scripts/xmonad-acpi.c new file mode 100644 --- /dev/null +++ b/scripts/xmonad-acpi.c @@ -0,0 +1,82 @@ +/* + +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; +} diff --git a/scripts/xmonad-clock.c b/scripts/xmonad-clock.c new file mode 100644 --- /dev/null +++ b/scripts/xmonad-clock.c @@ -0,0 +1,67 @@ +/* + +dwm/xmonad status bar provider. launch from your .xinitrc, and pipe +into dzen2. + +to compile: gcc -Os -s -o xmonad-clock xmonad-clock.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 "SYD %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[3]; + + signal(SIGPIPE, SIG_IGN); + + for(;;) { + getloadavg(load, 3); + + epochtime = time(NULL); + realtime = localtime(&epochtime); + strftime(b, sizeof(b), TIME_FORMAT, realtime); + + setenv("TZ","Australia/Sydney", 1); + pdttime = time(NULL); + pdtrealtime = localtime(&pdttime); + strftime(c, sizeof(c), TIME_FORMAT2, pdtrealtime); + unsetenv("TZ"); + + fprintf(stdout, "%s | %s | %.2f %.2f %.2f | xmonad 0.3 \n", b, c, load[0], load[1], load[2]); + + fflush(stdout); + sleep(REFRESH_RATE); + } + return EXIT_SUCCESS; +} diff --git a/tests/test_SwapWorkspaces.hs b/tests/test_SwapWorkspaces.hs new file mode 100644 --- /dev/null +++ b/tests/test_SwapWorkspaces.hs @@ -0,0 +1,56 @@ +{-# OPTIONS -fglasgow-exts #-} + +import Data.List(find,union) +import Data.Maybe(fromJust) +import Test.QuickCheck + +import StackSet +import Properties(T, NonNegative) +import XMonad.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 diff --git a/tests/test_XPrompt.hs b/tests/test_XPrompt.hs new file mode 100644 --- /dev/null +++ b/tests/test_XPrompt.hs @@ -0,0 +1,75 @@ +{-# OPTIONS -fglasgow-exts #-} +------------------------------------- +-- +-- Tests for XPrompt and ShellPrompt +-- +------------------------------------- + +import Data.Char +import Test.QuickCheck + +import Data.List + +import XMonad.XPrompt +import qualified XMonad.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 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 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 + diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal new file mode 100644 --- /dev/null +++ b/xmonad-contrib.cabal @@ -0,0 +1,137 @@ +name: xmonad-contrib +version: 0.5 +homepage: http://xmonad.org/ +synopsis: Third party extensions for xmonad +description: + Third party tiling algorithms, configurations and scripts to xmonad, + a tiling window manager for X. + . + For an introduction to building, configuring and using xmonad + extensions, see "XMonad.Doc". In particular: + . + "XMonad.Doc.Configuring", a guide to configuring xmonad + . + "XMonad.Doc.Extending", using the contributed extensions library + . + "XMonad.Doc.Developing", introduction to xmonad internals and writing + your own extensions. + . +category: System +license: BSD3 +license-file: LICENSE +author: Spencer Janssen +maintainer: sjanssen@cse.unl.edu +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/test_XPrompt.hs +cabal-version: >= 1.2.1 + +flag small_base + description: Choose the new smaller, split-up base package. + +flag use_xft + description: Use Xft to render text + +library + if flag(small_base) + build-depends: base >= 3, containers, directory, process, random + else + build-depends: base < 3 + + if flag(use_xft) + build-depends: X11-xft >= 0.2 + cpp-options: -DXFT + + build-depends: mtl, unix, X11>=1.4.0, xmonad==0.5 + ghc-options: -Wall -Werror + exposed-modules: XMonad.Doc + XMonad.Doc.Configuring + XMonad.Doc.Extending + XMonad.Doc.Developing + 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.Arossato + XMonad.Config.Droundy + XMonad.Hooks.DynamicLog + XMonad.Hooks.EwmhDesktops + 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.Mosaic + XMonad.Layout.MosaicAlt + XMonad.Layout.MultiToggle + XMonad.Layout.Named + XMonad.Layout.NoBorders + XMonad.Layout.PerWorkspace + XMonad.Layout.ResizableTile + XMonad.Layout.Roledex + XMonad.Layout.Spiral + XMonad.Layout.Square + XMonad.Layout.Tabbed + XMonad.Layout.ThreeColumns + XMonad.Layout.ToggleLayouts + XMonad.Layout.TwoPane + XMonad.Layout.WindowNavigation + XMonad.Layout.WorkspaceDir + XMonad.Prompt.Directory + XMonad.Prompt + XMonad.Prompt.Layout + XMonad.Prompt.Man + XMonad.Prompt.Shell + XMonad.Prompt.Ssh + XMonad.Prompt.Window + XMonad.Prompt.Workspace + XMonad.Prompt.XMonad + XMonad.Prompt.AppendFile + XMonad.Prompt.Input + XMonad.Prompt.Email + XMonad.Util.Anneal + XMonad.Util.CustomKeys + XMonad.Util.Dmenu + XMonad.Util.Dzen + XMonad.Util.EZConfig + XMonad.Util.Font + XMonad.Util.Invisible + XMonad.Util.NamedWindows + XMonad.Util.Run + XMonad.Util.XSelection + XMonad.Util.XUtils