Difference between revisions of "Xmonad/Config archive/Mntnoe's xmonad.hs"
< Xmonad | Config archive
Jump to navigation
Jump to search
m |
m |
||
| Line 636: | Line 636: | ||
let y = case mh of |
let y = case mh of |
||
Nothing -> 0 |
Nothing -> 0 |
||
| − | Just h -> h - ( |
+ | Just h -> h - (fromIntegral $ height xpc) in |
intercalate " " |
intercalate " " |
||
[ "dzen2" |
[ "dzen2" |
||
Revision as of 10:40, 12 February 2010
Installation
To use these modules, you must reenable support for user modules in your xmonad source. Put the modules you want in ~/.xmonad, and follow the instructions in xmonad.hs. Note that a solution is under development, placing user modules in ~/.xmonad/lib, thus solving the issue with case insensitive systems, see issue 230.
Alternatively you may download the files from my blog at mntnoe.com.
xmonad.hs
{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, MultiParamTypeClasses #-}
-------------------------------------------------------------------------- {{{
-- |
-- Module : xmonad
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- Modular xmonad config.
--
-- Highlights:
-- * labeled pager addon for DynamicLog
-- * fast navigation between workspaces
-- * application specific border colors
-- * modified Scratchpad using GNU Screen
-- * host specific settings (layouts and widgets)
--
-- You need to patch your xmonad source for the modules to work. Simply look
-- for a line in Core.hs containing runProces \"ghc\" [\"--make\",
-- \"xmonad.hs\" ...] and remove the \"-i\" entry from the list. This switch
-- was unfortunately added to fix a bug on case insensitive file systems.
--
-- I will try to make some darcs patches for xmonad-contrib if I get time.
-- Until then, I hope you can get inspired by some of my ideas. Enjoy :-)
--
-------------------------------------------------------------------------- }}}
-- IMPORTS {{{
-- Haskell modules
import Data.Char (toLower)
import Data.List
import Data.Maybe (isJust)
import qualified Data.Map as M
import System.Cmd (system)
import System.Environment (getEnv)
import System.Exit (exitWith, ExitCode(..) )
import System.IO (Handle)
import System.Posix.Files (fileExist)
-- XMonad modules
import XMonad.Actions.CycleWS
import XMonad.Actions.Submap
import XMonad.Actions.SwapWorkspaces
import XMonad.Actions.WindowGo
import XMonad hiding ( (|||) )
import XMonad.Hooks.DynamicHooks
import XMonad.Hooks.DynamicLog hiding (dzen)
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.UrgencyHook
import XMonad.Layout.IM (withIM, Property(..) )
import XMonad.Layout.LayoutCombinators
import XMonad.Layout.MultiToggle
import XMonad.Layout.Named
import XMonad.Layout.NoBorders
import XMonad.Layout.Reflect
import XMonad.Layout.ResizableTile
import XMonad.Layout.SimplestFloat
import XMonad.Prompt
import qualified XMonad.StackSet as W
import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Run (hPutStrLn)
import XMonad.Util.WorkspaceCompare (getSortByTag)
-- My modules
import BorderColors
import Layout
import Util
import DMenu
import Dzen
import ScratchpadPrime
import ServerMode
import Pager
-- }}}
-- MAIN {{{
main :: IO ()
main = do
dynamicHooks <- initDynamicHooks
host <- getHost
logPipe <- spawnDzenWithPipe host xpc
homedir <- getEnv "HOME"
spawnDzenWithConky xpc $ homedir ++ "/.conkyrc-dzen"
xmonad $ withUrgencyHook NoUrgencyHook $ myXConfig logPipe dynamicHooks host
-- }}}
-- QUERIES {{{
q_bc31 = appName =? "RDO001GL.EXE"
q_conky = className =? "Conky"
q_eclipse = className =? "Eclipse"
q_eclipse_spl = title =? "." <&&> className =? ""
q_emacs = className =? "Emacs" <||> fmap (isPrefixOf "emacs:") title
q_firefox = className =? "Iceweasel" <||> className =? "Firefox"
q_firefox_fl = q_firefox <&&> fmap (/="Navigator") appName
q_gvim = className =? "Gvim"
q_log = appName =? "xterm-log"
q_mocp = appName =? "xterm-mocp"
q_mplayer = className =? "MPlayer"
q_mutt = appName =? "xterm-mutt"
q_ooo = className =? "OpenOffice.org 3.0"
q_ref = className =? "Xpdf" <||> className =? "XDvi" <||> className =? "Acroread"
q_scratchpad = appName =? "xterm-scratchpad"
q_screen = appName =? "xterm-screen"
q_ssh_askpass = className =? "Ssh-askpass-fullscreen"
q_tmpWins = q_log <||> q_mocp
q_thunar = className =? "Thunar"
q_vim = (fmap (isPrefixOf "vim:") title <&&> q_xterms) <||> appName =? "xterm-vim" -- title is not set immediately
q_vlc = title =? "VLC media player"
q_xchat = className =? "Xchat"
q_xmessage = className =? "Xmessage"
q_xterm = appName =? "xterm"
q_xterm_float = appName =? "xterm-float"
q_xterm_su = q_xterms <&&> ( fmap (\t -> (isPrefixOf "root:" t) || (isInfixOf "emerge:" t)) title )
q_xterms = className =? "XTerm"
-- | Map windows to symbols for the pager. Symbols for floating windows are in
-- lower case.
windowLabelMap :: [(String, Query Bool)]
windowLabelMap =
map whenFloat tiledWindows ++ tiledWindows
++
map whenFloat generalQueries ++ generalQueries
where
whenFloat (l, q) = (map toLower l, isFloat <&&> q)
tiledWindows =
[ ("D", q_eclipse <||> q_eclipse_spl)
, ("V", q_vim <||> q_gvim)
, ("E", q_emacs)
, ("F", q_thunar)
, ("I", q_xchat)
, ("L", q_log)
, ("M", q_mocp <||> q_mplayer)
, ("@", q_mutt)
, ("O", q_ooo)
, ("R", q_ref)
, ("S", q_xterm_su)
, ("W", q_firefox)
]
generalQueries =
[ ("T", q_xterms)
, ("X", return True) -- catchall
]
-- }}}
-- SETTINGS {{{
-- | Layout to show initially, and when issuing the according keybinding. My
-- desktop is widescreen, but not my laptop.
defaultLayout Desktop = "Tall"
defaultLayout Laptop = "Wide"
gimpLayout Desktop = "GIMP_md"
gimpLayout Laptop = "GIMP_ml"
-- Colors
myNormalBorderColor = "#dddddd"
myFocusedBorderColor = "#3939ff"
masterBorderColor = "#ff1010"
floatBorderColor = "#10c010"
dzenBG = myNormalBorderColor
dzenFG = "#000000"
dzenActiveBG = "#a0a0a0"
dzenActiveFG = "#000000"
dzenUrgentFG = "#00ff00"
dzenUrgentBG = "#ffff00"
-- | Settings for both dzen and dmenu.
xpc :: XPConfig
xpc = XPC
{ font = "-misc-fixed-*-*-*-*-13-*-*-*-*-*-*-*"
, bgColor = dzenBG
, fgColor = dzenFG
, bgHLight = dzenActiveBG
, fgHLight = dzenActiveFG
, borderColor = dzenBG
, promptBorderWidth = 0
, position = Bottom
, height = 15
, historySize = 0
, defaultText = []
, autoComplete = Nothing
}
-- myXConfig :: Handle -> IORef DynamicHooks -> Host -> XConfig l
myXConfig logPipe dynamicHooks host = XConfig
{ terminal = "xterm"
, focusFollowsMouse = True
, borderWidth = 3
, modMask = mod5Mask
, numlockMask = mod2Mask
, workspaces = map show [1..9]
, normalBorderColor = myNormalBorderColor
, focusedBorderColor = myFocusedBorderColor
, keys = myKeys dynamicHooks host
, mouseBindings = myMouseBindings
, layoutHook = myLayoutHook host
, manageHook = myManageHook <+> dynamicMasterHook dynamicHooks
, logHook = myLogHook logPipe
, startupHook = myStartupHook host
}
-- }}}
-- KEYS/MOUSE {{{
-- | The keybindings are optimized for the Colemak (<http://colemak.com>)
-- keyboard layout. The keys are placed in the right side of the keyboard,
-- using right alt as the modifier.
myKeys :: h -> Host -> c -> M.Map (KeyMask, KeySym) (X ())
myKeys dynamicHooks host conf =
let m1 = mod5Mask
m2 = mod5Mask .|. shiftMask
m3 = mod5Mask .|. mod1Mask
in M.fromList $
-- APPLICATIONS
[ ((m1, xK_x), submap $ M.fromList
[ ((m1, xK_v), runOrRaiseNext "xvim" (q_vim))
, ((0 , xK_v), spawn "xvim")
, ((m1, xK_c), runOrRaiseNext "emacs" (q_emacs))
, ((0 , xK_c), spawn "emacs")
, ((m1, xK_b), spawn "firefox")
, ((m1, xK_l), reqEmptyWS (q_log) $ spawn $ xterm "xterm-log" "mtail -f /var/log/messages ~/.xsession-errors")
, ((m1, xK_e), reqEmptyWS (q_mutt) $ spawn $ xterm "xterm-mutt" "mutt")
, ((m1, xK_m), reqEmptyWS (q_mocp) $ spawn $ xterm "xterm-mocp" "mocp")
, ((0 , xK_w), submap $ M.fromList -- control some system services like networking
[ ((0 , xK_w), spawn $ xterm "xterm-float" "sleepdo 1 svc -w")
, ((0 , xK_e), spawn $ xterm "xterm-float" "sleepdo 1 svc -e")
, ((0 , xK_d), spawn $ xterm "xterm-float" "sleepdo 1 svc -d")
, ((0 , xK_a), spawn $ xterm "xterm-float" "sleepdo 1 svc -a")
, ((0 , xK_l), spawn $ xterm "xterm-float" "sleepdo 1 svc -l")
] )
] )
-- enhance clipboard functionality in xterm
, ((m1, xK_z), spawn "xclip -selection primary -o | xclip -selection clipboard -i")
, ((m1, xK_c), spawn "xterm")
, ((m1, xK_Return), scratchpad' q_scratchpad $ xterm "xterm-scratchpad" "screen -dRRS scratchpad")
, ((m1, xK_b), runOrRaiseNext "firefox" (q_firefox))
, ((m1, xK_slash), spawn $ dmenuRun xpc)
, ((m1, xK_v), submap $ M.fromList
-- LAYOUT SWITCHING
[ ((m1, xK_v), sendMessage $ JumpToLayout $ defaultLayout host)
, ((m2, xK_v), (broadcastMessage $ JumpToLayout $ defaultLayout host) >> refresh)
, ((m1, xK_a), sendMessage $ JumpToLayout "Accordion")
, ((m1, xK_r), sendMessage $ JumpToLayout "R_Tall")
, ((m1, xK_s), sendMessage $ JumpToLayout "Wide")
, ((m1, xK_t), sendMessage $ JumpToLayout "Tall")
, ((m1, xK_f), sendMessage $ JumpToLayout "Float")
, ((m1, xK_d), sendMessage $ JumpToLayout $ gimpLayout host)
-- MISC
, ((m1, xK_u), sendMessage $ ToggleStruts)
, ((m1, xK_b), withFocused $ windows . W.sink)
])
, ((m1, xK_m), sendMessage $ Toggle FULL)
-- WINDOW HANDLING
, ((m1, xK_n), windows W.focusDown)
, ((m1, xK_e), windows W.focusUp)
, ((m1, xK_h), swapOrRaise)
, ((m2, xK_h), swapOrLower)
, ((m2, xK_k), killAndReturn q_tmpWins)
-- LAYOUT MESSAGES
, ((m1, xK_Left), sendMessage Shrink)
, ((m1, xK_Right), sendMessage Expand)
, ((m1, xK_Up), sendMessage MirrorShrink)
, ((m1, xK_Down), sendMessage MirrorExpand)
-- SESSION
, ((m2, xK_BackSpace), io (system "touch ~/.exit_flag" >> exitHook >> exitWith ExitSuccess))
, ((m1, xK_BackSpace), io exitHook >> restart "xmonad" True)
-- WORKSPACES
-- I have swapped Y and J in my modified Colemak keyboard layout.
, ((m1, xK_y), doWithWS W.greedyView Prev EmptyWS)
, ((m2, xK_y), doWithWS shiftView Prev EmptyWS)
, ((m3, xK_y), doWithWS swapWithCurrent Prev EmptyWS)
, ((m1, xK_l), doWithWS W.greedyView Prev NonEmptyWS)
, ((m2, xK_l), doWithWS shiftView Prev NonEmptyWS)
, ((m3, xK_l), doWithWS swapWithCurrent Prev NonEmptyWS)
, ((m1, xK_u), doWithWS W.greedyView Next NonEmptyWS)
, ((m2, xK_u), doWithWS shiftView Next NonEmptyWS)
, ((m3, xK_u), doWithWS swapWithCurrent Next NonEmptyWS)
, ((m1, xK_j), doWithWS W.greedyView Next EmptyWS)
, ((m2, xK_j), doWithWS shiftView Next EmptyWS)
, ((m3, xK_j), doWithWS swapWithCurrent Next EmptyWS)
, ((m1, xK_i), doWithWS shiftView Next EmptyWS)
, ((m1, xK_0), toggleWS)
-- I use <5-;> <5-o> <5-'> and <5-{> for international characters.
]
++ zip (zip (repeat m1) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..])
++ zip (zip (repeat m2) [xK_1..xK_9]) (map (withNthWorkspace shiftView) [0..])
++ zip (zip (repeat m3) [xK_1..xK_9]) (map (withNthWorkspace swapWithCurrent) [0..])
-- MOUSE
myMouseBindings :: XConfig t -> M.Map (KeyMask, Button) (Window -> X ())
myMouseBindings conf = M.fromList $
[ ((mod5Mask, button1), focusAnd $ mouseMoveWindow)
, ((mod5Mask, button3), focusAnd $ mouseResizeWindow)
, ((0, 8), focusAnd $ mouseMoveWindow)
]
where
-- | Focus and raise the window before performing a mouse operation.
focusAnd job w = focus w >> windows W.swapMaster >> job w
-- }}}
-- LAYOUTHOOK {{{
-- | Cross host layoutHook. Hosts have different default layouts, different
-- ratios, and keybindings may switch to different layouts.
myLayoutHook host =
eventHook ServerMode $
avoidStruts $
(smartBorders $
(mkToggle (single FULL) $
tall (r host) |||
rtall (r host) |||
wide (r host) |||
MyAccordion
) |||
gimp_ml |||
gimp_md
) |||
(mkToggle (single FULL) $
named "Float" simplestFloat
)
where
wide r =
named "Wide" $
Mirror $
ResizableTall nmaster delta r []
rtall r =
named "R_Tall" $
ResizableTall nmaster delta r []
tall r =
named "Tall" $
reflectHoriz $
ResizableTall nmaster delta r []
nmaster = 1
delta = 3/40
r Desktop = 4/7
r Laptop = 2/3
gimp_md =
named "GIMP_md" $
withIM 0.10 (Role "gimp-toolbox") $
reflectHoriz $
withIM 0.15 (Role "gimp-dock") $
Full
gimp_ml =
named "GIMP_ml" $
withIM 0.25 (Role "gimp-toolbox") $
Full
data MyTransformers = FULL
deriving (Read, Show, Eq, Typeable)
instance Transformer MyTransformers Window where
transform FULL _ k = k $ named "Full" Full
-- }}}
-- MANAGEHOOK {{{
myManageHook :: ManageHook
myManageHook = composeAll
[ q_xmessage --> doCenterFloat
, q_conky --> doIgnore
, q_ssh_askpass --> doFullFloat
, q_firefox_fl --> doCenterFloat
, q_eclipse_spl --> doCenterFloat
, q_vlc --> doCenterFloat
, q_scratchpad --> doCenterFloat
, q_xterm_float --> doCenterFloat
, q_bc31 --> doCenterFloat
-- Most often, I don't want terminals to steal the current window's
-- position. However, only do this to terminals, as focus is not restored
-- to the original window when doing this.
, (q_xterm <||> q_screen) --> doF W.swapDown
, manageDocks
]
-- }}}
-- STARTUP/EXIT HOOK {{{
myStartupHook :: Host -> X ()
myStartupHook host = do
broadcastMessage $ JumpToLayout $ defaultLayout host
refresh
exitHook :: IO ()
exitHook = do
-- Make sure the panels gets reloaded with xmonad.
system "killall conky-cli"
system "killall hbar"
return ()
-- }}}
-- LOGHOOK {{{
myLogHook :: Handle -> X ()
myLogHook logPipe = do
-- I found it least confusing when coloring the master window only. This
-- makes it easy to tell which window has focus, without moving your eyes
-- to the border of the screen, as the coloring is based on the window
-- position.
colorWhen isMaster masterBorderColor
-- Make it easy to distinguish between floating and non-floating windows.
-- Sometimes I accidently makes a window floating without moving it out of
-- its position.
colorWhen isFloat floatBorderColor
dynamicLogString myDynamicLog >>= io . hPutStrLn logPipe
myDynamicLog :: PP
myDynamicLog = defaultPP
{ ppCurrent = dzenColor dzenActiveFG dzenActiveBG . pad
-- ppHidden overwrites colors of ppUrgent
, ppHidden = pad
, ppHiddenNoWindows = dzenColor dzenActiveBG dzenBG . pad
, ppUrgent = dzenColor dzenUrgentFG dzenUrgentBG
, ppWsSep = ""
, ppSep = " "
, ppLayout = dzenColor dzenActiveFG dzenActiveBG . pad
, ppTitle = dzenColor dzenFG dzenBG . pad
, ppSort = getSortByTag
, ppOrder = order
, ppExtras = [ labeledPager myDynamicLog windowLabelMap ]
}
where
order (_:l:t:ws:_) = ws:l:t:[]
order xs = ["Error in order list: " ++ show xs]
-- }}}
-- vim: set ft=haskell fdm=marker fdl=0 fdc=4:
BorderColors.hs
{-# LANGUAGE FlexibleContexts #-}
------------------------------------------------------------------------------
-- |
-- Module : BorderColors
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- Application specific border colors for XMonad. You can color any kind of
-- windows, but I found it least confusing when coloring the master window
-- only. This makes it easy to tell which window has focus, without moving
-- your eyes to the border of the screen, breaking your work flow.
--
------------------------------------------------------------------------------
module BorderColors (colorWhen) where
-- Haskell modules
import Control.Monad (when)
-- XMonad modules
import XMonad
-- | Set the border color when the query is satisfied. Should be added to the
-- ManageHook.
colorWhen :: Query Bool -> String -> X ()
colorWhen q cl = withFocused $ \w -> runQuery q w >>= flip when (setWindowBorder' cl w)
-- | Give set the border color of a window to the given HTML color code.
setWindowBorder' ::(MonadReader XConf m, MonadIO m) => String -> Window -> m ()
setWindowBorder' c w = do
XConf { display = d } <- ask
~(Just pc) <- io $ initColor d c
io $ setWindowBorder d w pc
DMenu.hs
------------------------------------------------------------------------------
-- |
-- Module : DMenu
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- DMenu helper functions.
--
------------------------------------------------------------------------------
module DMenu where
-- Haskell modules
import Data.List (intercalate)
-- XMonad modules
import XMonad.Prompt
-- | Run command in path.
dmenuRun xpc = intercalate " " $ "dmenu_run" : dmenuArgs xpc "Run:"
-- | DMenu options based on an XPC.
dmenuArgs xpc prompt =
[ "-b"
, "-fn" , font xpc
, "-nb" , bgColor xpc
, "-nf" , fgColor xpc
, "-sb" , bgHLight xpc
, "-sf" , fgHLight xpc
, "-p" , prompt
]
Dzen.hs
------------------------------------------------------------------------------
-- |
-- Module : Dzen
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- Functions for spawning dzen instances.
--
------------------------------------------------------------------------------
module Dzen (
spawnDzenWithPipe,
spawnDzenWithConky,
dzen
) where
-- Haskell modules
import Control.Monad
import Data.List
import Foreign.C.Types (CInt)
import GHC.IOBase (Handle)
import System.Cmd
import System.Environment (getEnv)
import System.Posix.Files(fileExist)
-- XMonad modules
import Control.Monad
import Graphics.X11.Xlib.Display
import XMonad (spawn)
import XMonad.Prompt
import XMonad.Util.Run(spawnPipe)
-- My modules
import Util (Host (Desktop, Laptop))
-- | Spawn two dzen instances at the top of the screen, reading input
-- from xmonad and hbar respectively.
spawnDzenWithPipe :: Host -> XPConfig -> IO Handle
spawnDzenWithPipe host xpc = do
(sw, sh) <- getScreenDim
let w = 300
system $ hbar host ++ dzen xpc
Nothing -- put dzen at the top of the screen
(sw - w) -- horizontal position
w -- horizontal width
'r' -- text align
actions ++ " &"
spawnPipe $ dzen xpc
Nothing -- put dzen at the top of the screen
0 -- horizontal position
(sw - w) -- horizontal width
'l' -- text align
actions
where
-- Show battery info only on the laptop.
hbar Desktop = "hbar -cmt | "
hbar Laptop = "hbar -cmbt | "
-- Mouse clicking cycles between populated workspaces. xmcli is my
-- ServerMode client.
actions = "button3=exec:xmcli 2;button1=exec:xmcli 3"
-- | Spawn a dzen instance at the bottom of the screen using conky for input.
spawnDzenWithConky :: XPConfig -> FilePath -> IO ()
spawnDzenWithConky xpc conkyrc = do
(sw, sh) <- getScreenDim
let dest = dzen xpc
(Just sh) -- put dzen at the bottom of the screen
0 -- horizontal position
sw -- horizontal width
'c' -- text align
"" -- no actions
fileExist conkyrc >>= (flip when $ do_ $ system $ dzenWithConky conkyrc dest)
where
do_ x = x >> return ()
dzenWithConky conkyrc dest = intercalate " " ["conky-cli -c", conkyrc, "|", dest, "&"]
-- | Return a string that launches dzen with the given configuration.
dzen :: Num a => XPConfig -- ^ prompt style configuration
-> Maybe a -- ^ Nothing: put dzen at the top of the screen
-- Just h: put dzen at the bottom of the screen with height h
-> a -- ^ horizontal position
-> a -- ^ horizontal width
-> Char -- ^ text align
-> String -- ^ actions
-> String
dzen xpc mh x w ta e =
let y = case mh of
Nothing -> 0
Just h -> h - (fromIntegral $ height xpc) in
intercalate " "
[ "dzen2"
, "-x" , show x
, "-w" , show w
, "-y" , show y
, "-h" , show $ height xpc
, "-fn" , quote $ font xpc
, "-bg" , quote $ bgColor xpc
, "-fg" , quote $ fgColor xpc
, "-ta" , [ta]
, "-e" , quote e
]
where
quote x = "'" ++ x ++ "'"
-- | Return the dimensions of the (primary?) screen.
getScreenDim :: IO (CInt, CInt)
getScreenDim = do
d <- openDisplay ""
let s = defaultScreen d
w = displayWidth d s
h = displayHeight d s
closeDisplay d
return (w, h)
Layout.hs
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
------------------------------------------------------------------------------
-- |
-- Module : Layout
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- Custom layout algorithms.
--
------------------------------------------------------------------------------
module Layout (
MyAccordion(..)
) where
-- XMonad modules
import XMonad
import qualified XMonad.StackSet as W
-- Hacked Accordion layout. Useful for LaTeX editing, where you switch between
-- an editor window and a preview window. Only the ratios are modified. This
-- hack does not space windows evenly when the workspace contains more than two
-- windows, but fixing it would require a rewrite. Accordion originally by
-- <glasser (@) mit.edu>.
data MyAccordion a = MyAccordion deriving ( Read, Show )
instance LayoutClass MyAccordion 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/3) sc
(center, bottom) = splitVerticallyBy (1/2) allButTop
(allButBottom, _) = splitVerticallyBy (2/3) 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 []
description _ = "Accordion"
Obsolete.hs
------------------------------------------------------------------------------
-- |
-- Module : Obsolete
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- Functions not used anymore, but might be useful later.
--
------------------------------------------------------------------------------
module Obsolete (
) where
-- Haskell modules
import Data.Char (toLower, toUpper)
import qualified Data.Map as M
-- XMonad modules
import XMonad
import XMonad.Prompt
import qualified XMonad.StackSet as W
import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Run (runProcessWithInput)
-- My modules
import DMenu (dmenuArgs)
-- DMENU FUNCTIONS
-- | Spawn dmenu with the given prompt and completion list. Return what the
-- user typed (which might not be an item in the list).
dmenu :: XPConfig -> String -> [String] -> X String
dmenu xpc prompt opts = io $ runProcessWithInput "dmenu" (dmenuArgs xpc prompt) (unlines opts)
-- | Like 'dzen', but look up the return value in a map.
dmenuMap :: XPConfig -> String -> M.Map String a -> X (Maybe a)
dmenuMap xpc prompt selectionMap = do
selection <- (dmenu xpc prompt) (M.keys selectionMap)
return $ M.lookup selection selectionMap
-- | Prompt for a window and focus it.
gotoMenu :: XPConfig -> X ()
gotoMenu xpc = actionMenu xpc "Window:" W.focusWindow
-- | Prompt for a window and perform an 'WindowSet' operation on it.
actionMenu :: XPConfig -> String -> (Window -> WindowSet -> WindowSet) -> X()
actionMenu xpc prompt action = windowMap >>= (dmenuMap xpc prompt) >>= flip whenJust (windows . action)
-- | Map from a formatted name to the corresponding 'Window' for use in a prompt.
windowMap :: X (M.Map String Window)
windowMap = do
ws <- gets windowset
M.fromList `fmap` concat `fmap` mapM keyValuePairs (W.workspaces ws)
where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws)
keyValuePair ws w = flip (,) w `fmap` formatWindowName ws w
-- | Return a formatted string representation of a 'Window'.
formatWindowName :: WindowSpace -> Window -> X String
formatWindowName ws w = do
name <- fmap (take 15 . map toLower . show) $ getName w
return $ name ++ " [" ++ [head $ W.tag ws] ++ "]"
-- FOCUS SLAVES
-- Cycle focus between \"slave windows\" in an XMonad workspace. I found it
-- more confusing than helpful, though.
-- | Focus the previous window which is not the master window. Wrap around the
-- end.
focusUpSlave :: WindowSet -> WindowSet
focusUpSlave = W.modify' focusUpSlave'
where
focusUpSlave' :: W.Stack a -> W.Stack a
focusUpSlave' (W.Stack t (l:[]) rs) = W.Stack x xs [] where (x:xs) = reverse (l:t:rs)
focusUpSlave' (W.Stack t (l:ls) rs) = W.Stack l ls (t:rs)
focusUpSlave' (W.Stack t [] rs) = W.Stack x xs [] where (x:xs) = reverse (t:rs)
-- | Focus the next window which is not the master window. Wrap around the
-- end.
focusDownSlave :: WindowSet -> WindowSet
focusDownSlave = W.modify' focusDownSlave'
where
focusDownSlave' s@(W.Stack _ [] []) = s
focusDownSlave' (W.Stack t ls (r:rs)) = W.Stack r (t:ls) rs
focusDownSlave' (W.Stack t ls []) = W.Stack x [m] xs where (m:x:xs) = reverse (t:ls)
-- | Swap position with the previous window which is not the master window.
-- Wrap around the end.
swapUpSlave :: WindowSet -> WindowSet
swapUpSlave = W.modify' swapUpSlave'
where
swapUpSlave' (W.Stack t (l:[]) rs) = W.Stack t (reverse (l:rs)) []
swapUpSlave' (W.Stack t (l:ls) rs) = W.Stack t ls (l:rs)
swapUpSlave' (W.Stack t [] rs) = W.Stack t (reverse rs) []
-- | Swap position with the next window which is not the master window. Wrap
-- around the end.
swapDownSlave :: WindowSet -> WindowSet
swapDownSlave = W.modify' swapDownSlave'
where
swapDownSlave' s@(W.Stack _ [] []) = s
swapDownSlave' (W.Stack t ls (r:rs)) = W.Stack t (r:ls) rs
swapDownSlave' (W.Stack t ls@(_:_) []) = W.Stack t [x] xs where (x:xs) = (reverse ls)
Pager.hs
------------------------------------------------------------------------------
-- |
-- Module : Pager
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- A pager for DynamicLog showing a symbol for each window on each workspace.
--
------------------------------------------------------------------------------
module Pager (
-- * Usage
-- $usage
labeledPager
) where
-- XMonad modules
import XMonad
import Data.Maybe ( isJust, fromMaybe )
import qualified Data.Map as M
import Data.Map ( (!) )
import Data.List
import qualified XMonad.StackSet as W
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.UrgencyHook
-- My modules
import Util
-- $usage
--
-- The simplest way to use this module is to add something like this in your
-- @~\/.xmonad\/xmonad.hs@. Note that you need to patch your xmonad source to
-- allow support for user modules (see my @xmonad.hs@).
--
-- > import XMonad.Hooks.DynamicLog
-- > import Pager
-- >
-- > main = xmonad $ defaultConfig {
-- > ...
-- > logHook = myDynamicLog
-- > ...
-- > }
-- >
-- > myDynamicLog :: PP
-- > myDynamicLog = defaultPP
-- > { ppOrder = order
-- > , ppExtras = [ labeledPager myDynamicLog windowLabelMap ]
-- > }
-- > where
-- > order (_:l:t:ws:_) = ws:l:t:[]
-- > order xs = ["Error in order list: " ++ show xs]
--
-- You also need a way to assign symbols to your windows. Here is a simple
-- example using single letter symbols, but you also use dzen icons.
--
-- > -- | Map windows to symbols for the pager. Symbols for floating windows are in
-- > -- lower case.
-- > windowLabelMap :: [(String, Query Bool)]
-- > windowLabelMap =
-- > map whenFloat tiledWindows ++ tiledWindows
-- > ++
-- > map whenFloat generalQueries ++ generalQueries
-- > where
-- >
-- > whenFloat (l, q) = (map toLower l, isFloat <&&> q)
-- >
-- > tiledWindows =
-- > [ ("V", className =? "Gvim")
-- > , ("E", className =? "Emacs")
-- > , ("W", className =? "Firefox")
-- > ]
-- >
-- > generalQueries =
-- > [ ("T", appName =? "xterm")
-- > , ("X", return True) -- catchall
-- > ]
-- | The 'DynamicLog' logger to add to 'ppExtras' using the given pretty
-- printer and window label map.
labeledPager :: PP -> [(String, Query Bool)] -> X (Maybe String)
labeledPager pp lm = do
s <- gets windowset
urgents <- readUrgents
sort' <- ppSort pp
wl <- queryWindows s lm
return $ Just $ pprWindowSet' sort' urgents wl pp s
-- | like 'pprWindowSet', but append to each workspace the outcome of
-- 'printWindows'.
pprWindowSet' :: ([W.Workspace String l Window] -> [W.Workspace String l Window])
-- ^ sorting function
-> [Window] -- ^ urgent windows
-> M.Map Window String -- ^ window to symbol map
-> PP -- ^ pretty-Printer
-> W.StackSet String l Window sid sd -- ^ stack set
-> String
pprWindowSet' sort' urgents wl pp s
= sepBy (ppWsSep pp) . map fmt . sort' $
map W.workspace (W.current s : W.visible s) ++ W.hidden s
where this = W.tag (W.workspace (W.current s))
visibles = map (W.tag . W.workspace) (W.visible s)
fmt ws = printer pp (W.tag ws ++ printWindows wl (W.integrate' $ W.stack ws))
where printer | W.tag ws == this = ppCurrent
| W.tag ws `elem` visibles = ppVisible
| any (\x -> maybe False (== W.tag ws) (W.findTag x s)) urgents
= \ppC -> ppUrgent ppC . ppHidden ppC
| isJust (W.stack ws) = ppHidden
| otherwise = ppHiddenNoWindows
-- | Output a list of strings, ignoring empty ones and separating the
-- rest with the given separator.
sepBy :: String -- ^ separator
-> [String] -- ^ fields to output
-> String
sepBy sep = concat . intersperse sep . filter (not . null)
-- | Print a concatenated string of symbols for a list of windows.
printWindows :: M.Map Window String -- ^ window to symbol map
-> [Window] -- ^ windows on the workspace
-> String
printWindows wl ws = pad $ concatMap (\w -> fromMaybe "" $ M.lookup w wl) ws
where
pad "" = ""
pad xs = ":"++xs
-- | Query each window in the 'WindowSet' and assign a symbol to it in a map.
queryWindows :: WindowSet -> [(String, Query Bool)] -> X (M.Map Window String)
queryWindows ws lm = do
mapM (qw lm) (W.allWindows ws) >>= return . M.fromList
where
qw :: [(String, Query Bool)] -> Window -> X (Window, String)
qw [] w = return (w, "?")
qw ((l, q):lqs) w = runQuery q w >>= if_ (return (w, l)) (qw lqs w)
ScratchpadPrime.hs
------------------------------------------------------------------------------
-- |
-- Module : ScratchpadPrime
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- A modified scatchpad which uses GNU Screen to detach the window rather than
-- putting it on a hidden workspace. This makes cycling between workspaces
-- easy, as there is no need for a dummy workspace to store the terminal when
-- hidden.
--
------------------------------------------------------------------------------
module ScratchpadPrime (
scratchpad'
) where
-- Haskell modules
import Control.Monad
-- XMonad modules
import XMonad
import qualified XMonad.StackSet as W
-- | A modified scatchpad which uses GNU Screen to detach the
-- window rather than putting it on a hidden workspace.
scratchpad' :: Query Bool -> String -> X ()
scratchpad' q cmd = withWindowSet $ \s -> do
filterCurrent <- filterM (runQuery $ q)
$ (maybe [] W.integrate
. W.stack
. W.workspace
. W.current) s
case filterCurrent of
(x:_) -> kill' x
[] -> do
filterAll <- filterM (runQuery $ q) $ W.allWindows s
case filterAll of
(x:_) -> windows (W.shiftWin (W.currentTag s) x)
-- no need to 'sleep 0.2' here, as window isn't resized
[] -> spawn cmd
-- | As 'kill', but kill a given window (rather than killing the focused window).
kill' :: Window ->X ()
kill' w = withDisplay $ \d -> do
wmdelt <- atom_WM_DELETE_WINDOW ; wmprot <- atom_WM_PROTOCOLS
protocols <- io $ getWMProtocols d w
io $ if wmdelt `elem` protocols
then allocaXEvent $ \ev -> do
setEventType ev clientMessage
setClientMessageEvent ev w wmprot 32 wmdelt 0
sendEvent d w False noEventMask ev
else killClient d w >> return ()
ServerMode.hs
------------------------------------------------------------------------------
-- |
-- Module : ServerMode
-- Copyright : (c) Mads N Noe 2009
-- (c) Andrea Rossato and David Roundy 2007
-- Maintainer : mntnoe (@) gmail.com
-- License : BSD-style (see xmonad\/LICENSE)
--
-- Modification of XMonad.Hooks.ServerMode with custom actions.
--
------------------------------------------------------------------------------
module ServerMode (
ServerMode (..)
, eventHook
) where
-- Haskell modules
import Control.Monad (when)
import Data.List
import Data.Maybe
import System.IO
import qualified Data.Map as M
-- XMonad modules
import XMonad
import XMonad.Actions.Commands hiding (runCommand')
import XMonad.Hooks.EventHook
import XMonad.Actions.CycleWS
import qualified XMonad.StackSet as W
-- My modules
import Util
-- | Custom commands.
commands :: X [(String, X ())]
commands = do
return $
[ ("prev-empty-ws" , doWithWS W.greedyView Prev EmptyWS)
, ("prev-nonempty-ws" , doWithWS W.greedyView Prev NonEmptyWS)
, ("next-nonempty-ws" , doWithWS W.greedyView Next NonEmptyWS)
, ("next-empty-ws" , doWithWS W.greedyView Next EmptyWS)
]
data ServerMode = ServerMode deriving ( Show, Read )
instance EventHook ServerMode where
handleEvent _ (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
d <- asks display
a <- io $ internAtom d "XMONAD_COMMAND" False
when (mt == a && dt /= []) $ do
cl <- commands
let listOfCommands = zipWith (++) (map show ([1..] :: [Int])) . map ((++) " - " . fst)
case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of
Just (c,_) -> runCommand' c
Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
handleEvent _ _ = return ()
-- | 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 commands
fromMaybe (return ()) (M.lookup c m)
Util.hs
------------------------------------------------------------------------------
-- |
-- Module : Util
-- Copyright : (c) Mads N Noe 2009
-- Maintainer : mntnoe (@) gmail.com
-- License : as-is
--
-- Utility functions for XMonad.
--
------------------------------------------------------------------------------
module Util where
-- Haskell modules
import Control.Monad (unless, when)
import Control.Monad.Trans (lift)
import Data.List
import qualified Data.Map as M
import Data.Monoid (Endo(Endo))
import System.Posix.Unistd(getSystemID, nodeName)
import System.IO.Error (isDoesNotExistError)
-- XMonad modules
import XMonad
import XMonad.Actions.CycleWS
import XMonad.Actions.WindowGo
import qualified XMonad.StackSet as W
import XMonad.Util.WorkspaceCompare (getSortByTag)
-- | Perform k x if x return a 'Just' value.
(?+) :: (Monad m) => m (Maybe a) -> (a -> m ()) -> m ()
x ?+ k = x >>= maybe (return ()) k
infixr 1 ?+
-- | Helper function for use with monads.
if_ :: t -> t -> Bool -> t
if_ t f c = if c
then t
else f
-- | Return a string that launches xterm with the given 'title', 'appName' and
-- command to execute.
xterm :: String -> String -> String
xterm a e = concat ["xterm -wf -title '", e, "' -name '", a, "' -e '", e, "'"]
-- | Shift a window to a workspace and switch to that workspace in one
-- operation.
shiftView :: WorkspaceId -> WindowSet -> WindowSet
shiftView ws w = W.greedyView ws $ W.shift ws w
-- | Perform a workspace transformation on the next workspace in 'WSDirection'
-- of type 'WSType'.
doWithWS :: (String -> (WindowSet -> WindowSet)) -> WSDirection -> WSType -> X ()
doWithWS f dir wstype = do
i <- findWorkspace getSortByTag dir wstype 1
windows $ f i
-- | Is the current workspace empty?
isCurrentWsEmpty :: X Bool
isCurrentWsEmpty = withWindowSet $ \s -> do
let l = W.integrate' $ W.stack $ W.workspace $ W.current s
return $ null l
-- | Modify the 'WindowSet' with a non-pure function. Counterpart to 'doF'.
doX :: (Window -> X (WindowSet -> WindowSet)) -> ManageHook
doX f = ask >>= Query . lift . fmap Endo . f
-- | Ensure that a window always starts on an empty workspace. If a window
-- satisfying the query exists, focus it. Otherwise run the specified
-- command, swithing to an empty workspace if the current one is not empty.
reqEmptyWS :: Query Bool -> X () -> X ()
reqEmptyWS q f = do
raiseNextMaybe (reqEmptyWS' >> f) q
where
reqEmptyWS' = do
empty <- isCurrentWsEmpty
i <- findWorkspace getSortByTag Next EmptyWS 1
unless empty $ windows $ W.greedyView i
-- | Kill the focused window. If the window satisfies the query, return to the
-- previously displayed workspace.
killAndReturn q = withFocused $ \w -> do
qr <- runQuery q w
kill
when qr toggleWS
-- | Perform a 'WindowSet' transformation on the workspace with the given
-- index.
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace job wnum = nthWorkspaceTag wnum ?+ windows . job
where
nthWorkspaceTag :: Int -> X (Maybe String)
nthWorkspaceTag wnum = do
sort <- getSortByTag
ws <- gets (map W.tag . sort . W.workspaces . windowset)
case drop wnum ws of
(w:_) -> return $ Just w
[] -> return Nothing
-- | Is the focused window the \"master window\" of the current workspace?
isMaster :: Query Bool
isMaster = ask >>= (\w -> liftX $ withWindowSet $ \ws -> return $ Just w == master ws)
where
master :: WindowSet -> Maybe Window
master ws =
case W.integrate' $ W.stack $ W.workspace $ W.current ws of
[] -> Nothing
(x:xs) -> Just x
-- | Is the focused window a floating window?
isFloat :: Query Bool
isFloat = ask >>= (\w -> liftX $ withWindowSet $ \ws -> return $ M.member w $ W.floating ws)
-- | Swap the focused window with the last window in the stack.
swapBottom :: W.StackSet i l a s sd -> W.StackSet i l a s sd
swapBottom = W.modify' $ \c -> case c of
W.Stack _ _ [] -> c -- already bottom.
W.Stack t ls rs -> W.Stack t (xs ++ x : ls) [] where (x:xs) = reverse rs
-- | Swap the focused window with the following window, or if the window is
-- floating, lower it to the bottom.
swapOrLower :: X ()
swapOrLower = withFocused $ \w ->
runQuery isFloat w >>= if_ (windows swapBottom) (windows W.swapDown)
-- | Swap the focused window with the preceding window, or if the window is
-- floating, raise it to the top.
swapOrRaise :: X ()
swapOrRaise = withFocused $ \w ->
runQuery isFloat w >>= if_ (windows W.swapMaster) (windows W.swapUp)
-- | Determine the host.
getHost = do
host <- getSystemID
case nodeName host of
"mntnoe-desktop" -> return Desktop
"mntnoe-laptop" -> return Laptop
_ -> return Desktop
-- | For use in cross host configutions.
data Host = Desktop | Laptop deriving Eq