Personal tools

Xmonad/Config archive/Mntnoe's xmonad.hs

From HaskellWiki

< Xmonad | Config archive(Difference between revisions)
Jump to: navigation, search
m
m
 
(4 intermediate revisions by 2 users not shown)
Line 1: Line 1:
== Installation ==
+
You download the whole configuration (icons inclusive) from my [http://www.mntnoe.com/2010/05/xmonad-config-may-2010 blog].
 
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 [http://code.google.com/p/xmonad/issues/detail?id=230 issue 230].
 
 
Alternatively you may download the files from my blog at [http://www.mntnoe.com/?p=52 mntnoe.com].
 
   
 
== xmonad.hs ==
 
== xmonad.hs ==
Line 8: Line 8:
 
-- |
 
-- |
 
-- Module : xmonad
 
-- Module : xmonad
-- Copyright : (c) Mads N Noe 2009
+
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mntnoe (@) gmail.com
+
-- Maintainer : mail (@) madsnoe.dk
 
-- License : as-is
 
-- License : as-is
 
--
 
--
Line 15: Line 15:
 
--
 
--
 
-- Highlights:
 
-- Highlights:
-- * labeled pager addon for DynamicLog
+
-- * pager with icons for DynamicLog
-- * fast navigation between workspaces
+
-- * per application configuration
-- * application specific border colors
+
-- * minimize windows
-- * 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
+
-- Requires xmonad 0.9. Note that this work is not finished.
-- for a line in Core.hs containing runProces \"ghc\" [\"--make\",
+
-- There are still lot of things I want to behave differently,
-- \"xmonad.hs\" ...] and remove the \"-i\" entry from the list. This switch
+
-- and I need to do some cleanup here and there.
-- 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.
+
-- Still, I hope you can get inspired by some of my ideas. Enjoy :-)
-- Until then, I hope you can get inspired by some of my ideas. Enjoy :-)
 
 
--
 
--
 
-------------------------------------------------------------------------- }}}
 
-------------------------------------------------------------------------- }}}
Line 30: Line 30:
   
 
-- Haskell modules
 
-- Haskell modules
import Data.Char (toLower)
+
import Control.Monad (when, liftM)
  +
import Data.IORef (IORef)
 
import Data.List
 
import Data.List
 
import Data.Maybe (isJust)
 
import Data.Maybe (isJust)
 
import qualified Data.Map as M
 
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.IO (Handle)
import System.Posix.Files (fileExist)
 
   
 
-- XMonad modules
 
-- XMonad modules
import XMonad.Actions.CycleWS
 
import XMonad.Actions.Submap
 
import XMonad.Actions.SwapWorkspaces
 
import XMonad.Actions.WindowGo
 
 
import XMonad hiding ( (|||) )
 
import XMonad hiding ( (|||) )
import XMonad.Hooks.DynamicHooks
+
import XMonad.Actions.CycleSelectedLayouts
import XMonad.Hooks.DynamicLog hiding (dzen)
+
import XMonad.Actions.CycleWS
  +
import XMonad.Actions.FloatKeys
  +
import XMonad.Actions.FloatSnap
  +
import XMonad.Actions.SwapWorkspaces (swapWithCurrent)
  +
import XMonad.Hooks.DynamicLog
  +
import XMonad.Hooks.EwmhDesktops
 
import XMonad.Hooks.ManageDocks
 
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
+
import XMonad.Hooks.ManageHelpers (doCenterFloat)
  +
import XMonad.Hooks.Place
  +
import XMonad.Hooks.RestoreMinimized
  +
import XMonad.Hooks.ServerMode
 
import XMonad.Hooks.UrgencyHook
 
import XMonad.Hooks.UrgencyHook
import XMonad.Layout.IM (withIM, Property(..) )
 
 
import XMonad.Layout.LayoutCombinators
 
import XMonad.Layout.LayoutCombinators
import XMonad.Layout.MultiToggle
 
 
import XMonad.Layout.Named
 
import XMonad.Layout.Named
 
import XMonad.Layout.NoBorders
 
import XMonad.Layout.NoBorders
 
import XMonad.Layout.Reflect
 
import XMonad.Layout.Reflect
 
import XMonad.Layout.ResizableTile
 
import XMonad.Layout.ResizableTile
import XMonad.Layout.SimplestFloat
 
import XMonad.Prompt
 
 
import qualified XMonad.StackSet as W
 
import qualified XMonad.StackSet as W
import XMonad.Util.NamedWindows (getName)
 
 
import XMonad.Util.Run (hPutStrLn)
 
import XMonad.Util.Run (hPutStrLn)
 
import XMonad.Util.WorkspaceCompare (getSortByTag)
 
import XMonad.Util.WorkspaceCompare (getSortByTag)
   
-- My modules
+
-- Custom modules
  +
import App
 
import BorderColors
 
import BorderColors
  +
import Commands
  +
import DMenu
  +
import Panel
  +
import Config
  +
import IM
 
import Layout
 
import Layout
import Util
+
import MyApps
import DMenu
 
import Dzen
 
import ScratchpadPrime
 
import ServerMode
 
 
import Pager
 
import Pager
  +
import Utils
  +
import Workspace
 
-- }}}
 
-- }}}
   
Line 75: Line 69:
 
main :: IO ()
 
main :: IO ()
 
main = do
 
main = do
dynamicHooks <- initDynamicHooks
+
host <- getHost
host <- getHost
+
pipes <- spawnPanels
logPipe <- spawnDzenWithPipe host xpc
+
xmonad $ withUrgencyHook NoUrgencyHook $ ewmh $ myXConfig host pipes
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
 
]
 
 
 
-- }}}
 
-- }}}
   
Line 84: Line 78:
 
-- | Layout to show initially, and when issuing the according keybinding. My
 
-- | Layout to show initially, and when issuing the according keybinding. My
 
-- desktop is widescreen, but not my laptop.
 
-- desktop is widescreen, but not my laptop.
defaultLayout Desktop = "Tall"
+
defaultLayout Laptop = "Tall"
defaultLayout Laptop = "Wide"
+
defaultLayout Netbook = "Wide"
   
gimpLayout Desktop = "GIMP_md"
+
cycledLayouts Laptop = ["Mirror", defaultLayout Laptop]
gimpLayout Laptop = "GIMP_ml"
+
cycledLayouts Netbook = ["Accordion", "Tall", defaultLayout Netbook]
  +
  +
myWorkspaces = map show [1..8] ++ [hiddenWorkspaceTag, summonWorkspaceTag]
   
 
-- Colors
 
-- Colors
myNormalBorderColor = "#dddddd"
+
myNormalBorderColor = defaultBG
myFocusedBorderColor = "#3939ff"
+
myFocusedBorderColor = "#3939ff"
masterBorderColor = "#ff1010"
+
masterBorderColor = "#ff1010"
floatBorderColor = "#10c010"
+
floatBorderColor = "#10c010"
dzenBG = myNormalBorderColor
 
dzenFG = "#000000"
 
dzenActiveBG = "#a0a0a0"
 
dzenActiveFG = "#000000"
 
dzenUrgentFG = "#00ff00"
 
dzenUrgentBG = "#ffff00"
 
   
-- | Settings for both dzen and dmenu.
+
myPlacement = withGaps (22, 0, 0, 0) $ smart (0.5,0.5)
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 host pipes = XConfig
myXConfig logPipe dynamicHooks host = XConfig
+
{ terminal = "xterm" -- unused
{ terminal = "xterm"
 
 
, focusFollowsMouse = True
 
, focusFollowsMouse = True
 
, borderWidth = 3
 
, borderWidth = 3
, modMask = mod5Mask
+
, modMask = mod5Mask -- unused
 
, numlockMask = mod2Mask
 
, numlockMask = mod2Mask
, workspaces = map show [1..9]
+
, workspaces = myWorkspaces
 
, normalBorderColor = myNormalBorderColor
 
, normalBorderColor = myNormalBorderColor
 
, focusedBorderColor = myFocusedBorderColor
 
, focusedBorderColor = myFocusedBorderColor
, keys = myKeys dynamicHooks host
+
, keys = myKeys host
 
, mouseBindings = myMouseBindings
 
, mouseBindings = myMouseBindings
, layoutHook = myLayoutHook host
+
, handleEventHook = myHandleEventHook
, manageHook = myManageHook <+> dynamicMasterHook dynamicHooks
+
, layoutHook = myLayoutHook
, logHook = myLogHook logPipe
+
, manageHook = myManageHook host
  +
, logHook = myLogHook host pipes
 
, startupHook = myStartupHook host
 
, startupHook = myStartupHook host
 
}
 
}
Line 121: Line 115:
 
-- keyboard layout. The keys are placed in the right side of the keyboard,
 
-- keyboard layout. The keys are placed in the right side of the keyboard,
 
-- using right alt as the modifier.
 
-- using right alt as the modifier.
myKeys :: h -> Host -> c -> M.Map (KeyMask, KeySym) (X ())
+
myKeys host _ = M.fromList $
myKeys dynamicHooks host conf =
 
let m1 = mod5Mask
 
m2 = mod5Mask .|. shiftMask
 
m3 = mod5Mask .|. mod1Mask
 
in M.fromList $
 
   
-- APPLICATIONS
+
makeKeys apps
[ ((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
+
[ ((i , xK_comma), runCommand)
, ((m1, xK_z), spawn "xclip -selection primary -o | xclip -selection clipboard -i")
+
, ((i , xK_slash), dmenuRun)
  +
, ((u , xK_h), hideSummonWindows apps)
   
, ((m1, xK_c), spawn "xterm")
+
-- See https://addons.mozilla.org/en-US/firefox/addon/61262.
, ((m1, xK_Return), scratchpad' q_scratchpad $ xterm "xterm-scratchpad" "screen -dRRS scratchpad")
+
, ((is, xK_f), spawn "firefox -unfocus")
, ((m1, xK_b), runOrRaiseNext "firefox" (q_firefox))
 
   
, ((m1, xK_slash), spawn $ dmenuRun xpc)
+
-- Enhance clipboard functionality in xterm (otherwise, xterm easily
  +
-- "forgets" the selection). Also, xclip will remember the selection
  +
-- even if the host app exits.
  +
, ((i , xK_z), spawn "xclip -selection primary -o | xclip -selection clipboard -i")
   
, ((m1, xK_v), submap $ M.fromList
 
   
-- LAYOUT SWITCHING
+
-- FLOATING WINDOWS
[ ((m1, xK_v), sendMessage $ JumpToLayout $ defaultLayout host)
+
, ((u , xK_p), placeFocused $ myPlacement)
, ((m2, xK_v), (broadcastMessage $ JumpToLayout $ defaultLayout host) >> refresh)
+
, ((u , xK_b), withFocused $ windows . W.sink)
, ((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
 
-- WINDOW HANDLING
, ((m1, xK_n), windows W.focusDown)
+
, ((i , xK_j), windows W.focusDown >> warpToWindow')
, ((m1, xK_e), windows W.focusUp)
+
, ((i , xK_k), windows W.focusUp >> warpToWindow')
, ((m1, xK_h), swapOrRaise)
+
, ((is, xK_j), windows W.swapMaster)
, ((m2, xK_h), swapOrLower)
+
, ((i , xK_h), swapOrRaise)
  +
, ((is, xK_h), swapOrLower)
   
, ((m2, xK_k), killAndReturn q_tmpWins)
+
, ((i , xK_s), windows $ hideFocused)
  +
, ((i , xK_r), windows $ restoreLast)
  +
  +
, ((is, xK_n), kill)
  +
, ((mod1Mask, xK_F4), kill)
   
 
-- LAYOUT MESSAGES
 
-- LAYOUT MESSAGES
, ((m1, xK_Left), sendMessage Shrink)
+
, ((i , xK_space), cycleThroughLayouts $ cycledLayouts host)
, ((m1, xK_Right), sendMessage Expand)
+
, ((is, xK_space), sendMessage $ JumpToLayout $ defaultLayout host)
, ((m1, xK_Up), sendMessage MirrorShrink)
+
, ((m1, xK_Down), sendMessage MirrorExpand)
+
, ((u , xK_n), sendMessage $ JumpToLayout "NoBorders")
  +
, ((u , xK_u), sendMessage $ ToggleStruts)
  +
  +
, ((im, xK_Right), sendMessage Shrink)
  +
, ((im, xK_Left), sendMessage Expand)
  +
, ((im, xK_Down), sendMessage MirrorShrink)
  +
, ((im, xK_Up), sendMessage MirrorExpand)
  +
  +
, ((i , xK_Left), withFocused $ keysMoveWindow (-300, 0))
  +
, ((i , xK_Right), withFocused $ keysMoveWindow ( 300, 0))
  +
, ((i , xK_Up), withFocused $ keysMoveWindow ( 0, -200))
  +
, ((i , xK_Down), withFocused $ keysMoveWindow ( 0, 200))
  +
, ((is, xK_Left), withFocused $ snapMove L Nothing)
  +
, ((is, xK_Right), withFocused $ snapMove R Nothing)
  +
, ((is, xK_Up), withFocused $ snapMove U Nothing)
  +
, ((is, xK_Down), withFocused $ snapMove D Nothing)
  +
   
 
-- SESSION
 
-- SESSION
, ((m2, xK_BackSpace), io (system "touch ~/.exit_flag" >> exitHook >> exitWith ExitSuccess))
+
, ((i , xK_Delete), spawn "gnome-session-save --shutdown-dialog")
, ((m1, xK_BackSpace), io exitHook >> restart "xmonad" True)
+
, ((is, xK_BackSpace), spawn "gnome-session-save --logout")
  +
, ((i , xK_BackSpace), killPanels >> restart "xmonad" True)
   
 
-- WORKSPACES
 
-- WORKSPACES
-- I have swapped Y and J in my modified Colemak keyboard layout.
+
-- Note that I have swapped Y and J in my modified Colemak keyboard layout.
, ((m1, xK_y), doWithWS W.greedyView Prev EmptyWS)
+
, ((i , xK_y), doWithWS W.greedyView Prev EmptyWS)
, ((m2, xK_y), doWithWS shiftView Prev EmptyWS)
+
, ((is, xK_y), doWithWS shiftView Prev EmptyWS)
, ((m3, xK_y), doWithWS swapWithCurrent Prev EmptyWS)
+
, ((im, 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)
+
, ((i , xK_u), doWithWS W.greedyView Prev NonEmptyWS)
, ((m1, xK_0), toggleWS)
+
, ((is, xK_u), doWithWS shiftView Prev NonEmptyWS)
  +
, ((im, xK_u), doWithWS swapWithCurrent Prev NonEmptyWS)
   
-- I use <5-;> <5-o> <5-'> and <5-{> for international characters.
+
, ((i , xK_i), doWithWS W.greedyView Next NonEmptyWS)
  +
, ((is, xK_i), doWithWS shiftView Next NonEmptyWS)
  +
, ((im, xK_I), doWithWS swapWithCurrent Next NonEmptyWS)
   
]
+
, ((i , xK_o), doWithWS W.greedyView Next EmptyWS)
++ zip (zip (repeat m1) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..])
+
, ((is, xK_o), doWithWS shiftView Next EmptyWS)
++ zip (zip (repeat m2) [xK_1..xK_9]) (map (withNthWorkspace shiftView) [0..])
+
, ((im, xK_o), doWithWS swapWithCurrent Next EmptyWS)
++ zip (zip (repeat m3) [xK_1..xK_9]) (map (withNthWorkspace swapWithCurrent) [0..])
+
  +
, ((i , xK_l), doWithWS shiftView Next EmptyWS)
  +
, ((is, xK_l), doWithWS W.shift Next EmptyWS)
  +
  +
, ((i , xK_7), swapNextScreen')
  +
, ((i , xK_8), toggleWS)
  +
, ((i , xK_9), screenWorkspace 0 >>= flip whenJust (windows . W.view) >> warpToWindow')
  +
, ((is, xK_9), screenWorkspace 0 >>= flip whenJust (windows . shiftViewUngreedy) >> warpToWindow')
  +
, ((i , xK_0), screenWorkspace 1 >>= flip whenJust (windows . W.view) >> warpToWindow')
  +
, ((is, xK_0), screenWorkspace 1 >>= flip whenJust (windows . shiftViewUngreedy) >> warpToWindow')
  +
]
   
 
-- MOUSE
 
-- MOUSE
myMouseBindings :: XConfig t -> M.Map (KeyMask, Button) (Window -> X ())
+
myMouseBindings _ = M.fromList $
myMouseBindings conf = M.fromList $
+
[ ((mod5Mask, button1), focusAnd mouseMoveWindow $ snapMagicMove (Just 50) (Just 50))
[ ((mod5Mask, button1), focusAnd $ mouseMoveWindow)
+
, ((mod5Mask .|. shiftMask, button1), focusAnd mouseMoveWindow $ snapMagicResize [L,R,U,D] (Just 50) (Just 50))
, ((mod5Mask, button3), focusAnd $ mouseResizeWindow)
+
, ((mod5Mask, button3), focusAnd mouseResizeWindow $ snapMagicResize [R,D] (Just 50) (Just 50))
, ((0, 8), focusAnd $ mouseMoveWindow)
+
 
]
 
]
 
where
 
where
   
 
-- | Focus and raise the window before performing a mouse operation.
 
-- | Focus and raise the window before performing a mouse operation.
focusAnd job w = focus w >> windows W.swapMaster >> job w
+
focusAnd job1 job2 w = focus w >> windows W.swapMaster >> job1 w >> job2 w
 
-- }}}
 
-- }}}
   
 
-- LAYOUTHOOK {{{
 
-- LAYOUTHOOK {{{
   
-- | Cross host layoutHook. Hosts have different default layouts, different
+
myLayoutHook
-- ratios, and keybindings may switch to different layouts.
+
= avoidStruts
myLayoutHook host =
+
$ smartBorders
eventHook ServerMode $
+
$ withIM (1/5) (Role "gimp-toolbox")
avoidStruts $
+
( (named "Wide" $ Mirror $ ResizableTall 1 (3/40) (2/3) [])
(smartBorders $
+
||| (named "Tall" $ reflectHoriz $ ResizableTall 1 (3/40) (4/7) [])
(mkToggle (single FULL) $
+
||| (named "Mirror" $ ResizableTall 1 (3/40) (4/7) [])
tall (r host) |||
+
||| (twoAccordion)
rtall (r host) |||
+
||| (named "NoBorders" $ noBorders Full)
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 {{{
 
-- 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
+
myManageHook xs = composeAll
-- position. However, only do this to terminals, as focus is not restored
+
[ floats --> doCenterFloat
-- to the original window when doing this.
+
, className =? "MPlayer" --> doFloat
, (q_xterm <||> q_screen) --> doF W.swapDown
+
, ignores --> doIgnore
  +
, appManageHook apps
 
, manageDocks
 
, manageDocks
 
]
 
]
  +
where
  +
floats = foldr1 (<||>)
  +
[ checkDialog
  +
, title =? "." <&&> ( className =? "" <||> appName =? "." )
  +
, title =? "VLC media player"
  +
, className =? "Nautilus" <&&> fmap (not . isSuffixOf " - File Browser") title
  +
, className =? "Firefox" <&&> fmap (/="Navigator") appName
  +
, flip fmap className $ flip elem
  +
[ "Gnome_swallow"
  +
, "Gdmsetup"
  +
, "Xmessage"
  +
, "Zenity"
  +
]
  +
]
  +
  +
ignores = foldr1 (<||>)
  +
[ className =? "Gnome-typing-monitor"
  +
]
 
-- }}}
 
-- }}}
   
-- STARTUP/EXIT HOOK {{{
+
-- HANDLEEVENTHOOK {{{
  +
myHandleEventHook = do
  +
restoreMinimizedEventHook
  +
serverModeEventHook' smCommands
  +
-- }}}
  +
  +
-- STARTUP HOOK {{{
 
myStartupHook :: Host -> X ()
 
myStartupHook :: Host -> X ()
 
myStartupHook host = do
 
myStartupHook host = do
broadcastMessage $ JumpToLayout $ defaultLayout host
+
broadcastMessage $ JumpToLayout $ defaultLayout $ host
 
refresh
 
refresh
 
exitHook :: IO ()
 
exitHook = do
 
-- Make sure the panels gets reloaded with xmonad.
 
system "killall conky-cli"
 
system "killall hbar"
 
return ()
 
 
-- }}}
 
-- }}}
   
 
-- LOGHOOK {{{
 
-- LOGHOOK {{{
myLogHook :: Handle -> X ()
+
myLogHook :: Host -> [Handle] -> X ()
myLogHook logPipe = do
+
myLogHook host pipes = do
 
-- I found it least confusing when coloring the master window only. This
 
-- 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
 
-- makes it easy to tell which window has focus, without moving your eyes
Line 296: Line 244:
 
colorWhen isFloat floatBorderColor
 
colorWhen isFloat floatBorderColor
   
dynamicLogString myDynamicLog >>= io . hPutStrLn logPipe
+
mapM_ (\pipe -> dynamicLogString (myPP host) >>= io . hPutStrLn pipe) pipes
   
myDynamicLog :: PP
+
-- TODO: refactor
myDynamicLog = defaultPP
+
myPP host = defaultPP
{ ppCurrent = dzenColor dzenActiveFG dzenActiveBG . pad
+
{ ppCurrent = highlight
  +
, ppVisible = pad 2
 
-- ppHidden overwrites colors of ppUrgent
 
-- ppHidden overwrites colors of ppUrgent
, ppHidden = pad
+
, ppHidden = pad 6
, ppHiddenNoWindows = dzenColor dzenActiveBG dzenBG . pad
+
, ppHiddenNoWindows = pad 2
, ppUrgent = dzenColor dzenUrgentFG dzenUrgentBG
+
, ppUrgent = pad 6 . ((dzenColor "#01ce02" "#fcfb03") (adjust " ! ")++) -- temporary solution
  +
, ppTitle = pad 2
  +
, ppLayout = ifNonDefault host (highlight . adjust)
 
, ppWsSep = ""
 
, ppWsSep = ""
 
, ppSep = " "
 
, ppSep = " "
, ppLayout = dzenColor dzenActiveFG dzenActiveBG . pad
 
, ppTitle = dzenColor dzenFG dzenBG . pad
 
 
, ppSort = getSortByTag
 
, ppSort = getSortByTag
 
, ppOrder = order
 
, ppOrder = order
, ppExtras = [ labeledPager myDynamicLog windowLabelMap ]
+
, ppExtras = [ labeledPager $ myPP host
  +
]
 
}
 
}
 
where
 
where
order (_:l:t:ws:_) = ws:l:t:[]
 
order xs = ["Error in order list: " ++ show xs]
 
   
  +
-- Ignore the original workspace list and use labeledPager instead.
  +
order (_:l:t:ws:[]) = (" " ++ ws):l:adjust t:[]
  +
order xs = ["Error in order list: " ++ show xs]
  +
  +
-- Hide the layout label when default layout is used.
  +
ifNonDefault host f s
  +
| s == defaultLayout host = ""
  +
| otherwise = f s
  +
  +
highlight x = leftIcon ++ dzenColor hilightFG hilightBG x ++ rightIcon
  +
  +
-- Called every time a text string is shown, making the font appear vertically
  +
-- aligned with the icons.
  +
adjust x = "^p(;+2)" ++ x ++ "^p()"
  +
  +
pad w x = concat ["^p(", show w, ")", x, "^p(", show w, ")"]
 
-- }}}
 
-- }}}
   
-- vim: set ft=haskell fdm=marker fdl=0 fdc=4:
+
-- vim: set ft=haskell fdm=marker fdl=1 fdc=4:
  +
</haskell>
  +
  +
== lib/App.hs ==
  +
<haskell>
  +
-------------------------------------------------------------------------- {{{
  +
-- |
  +
-- Module : App
  +
-- Copyright : (c) Mads N Noe 2010
  +
-- Maintainer : mail (@) madsnoe.dk
  +
-- License : as-is
  +
--
  +
-- Per application configuration. See MyApps for use.
  +
--
  +
-------------------------------------------------------------------------- }}}
  +
  +
module App
  +
( App (..)
  +
, AppType (..)
  +
, nullApp
  +
, raiseApp
  +
, jumpToOrRestore
  +
, hideSummonWindows
  +
, summonWindow
  +
, hideFocused
  +
, restoreLast
  +
, appManageHook
  +
, makeKeys
  +
) where
  +
  +
-- Haskell modules
  +
import Control.Monad (filterM)
  +
import Data.Maybe
  +
import Data.List
  +
  +
-- XMonad modules
  +
import XMonad
  +
import XMonad.Actions.WindowGo
  +
import XMonad.Core
  +
import XMonad.ManageHook (composeAll)
  +
import qualified XMonad.StackSet as W
  +
  +
-- Custom modules
  +
import Config
  +
import Utils
  +
  +
  +
-- | Holds WM related configuration for a given application.
  +
data App = App
  +
{ cmd :: X () -- ^ Command used to launch the application.
  +
, appType :: AppType -- ^ See AppType.
  +
, query :: Query Bool -- ^ Used to identify the windows owned by the application.
  +
, key :: (ButtonMask, KeySym) -- ^ Key binding to launch the application. (0,0) if no key
  +
-- binding is associated.
  +
, icon :: String -- ^ Relative path to the XPM icon used by the Pager module.
  +
, hook :: Maybe ManageHook -- ^ Application ManageHook.
  +
}
  +
  +
  +
-- | Used when toggling between applications of type Summon.
  +
-- As they are floating, it makes sense to only show one
  +
-- at a time.
  +
instance Eq App where
  +
(==) App { appType = Summon a _ }
  +
App { appType = Summon b _ } = a == b
  +
_ == _ = False
  +
  +
  +
data AppType = OpenNew -- ^ Open a new instance of the application each time.
  +
| JumpTo -- ^ Jump to the workspace containing the application.
  +
| Summon -- ^ Summon the application to the current workspace.
  +
-- They are typically floating, and used for
  +
-- "transient" tasks.
  +
String -- Identifier.
  +
[App] -- Applications to replace when toggling.
  +
  +
  +
-- | Default to these settings when entries are omitted.
  +
nullApp = App
  +
{ cmd = return ()
  +
, appType = OpenNew
  +
, query = return False
  +
, key = (0, 0)
  +
, icon = defaultIcon
  +
, hook = Nothing
  +
}
  +
  +
  +
-- Focus an application. How this happens is specified by the application's AppType.
  +
raiseApp App
  +
{ appType = OpenNew
  +
, cmd = c
  +
} = c
  +
raiseApp App
  +
{ appType = JumpTo
  +
, query = q
  +
, cmd = c
  +
} = jumpToOrRestore c q
  +
raiseApp app@App
  +
{ appType = Summon _ apps
  +
, query = q
  +
} = summonWindow (filterSummonedApps apps) app
  +
  +
  +
-- | Raise a window as follows.
  +
-- If there exists a matching window
  +
-- * that is hidden, shift it to the current workspace.
  +
-- * on the current workspace, hide it.
  +
-- * on another workspace, jump to it.
  +
-- Otherwise launch the application.
  +
-- TODO: This behavior made it impossible to cycle between two windows,
  +
-- as we now hide the current window instead of jumping to the next.
  +
-- I'll have to rethink this one eventually, but as I seldomly need
  +
-- to cycle between windows of the same app, it is not a big
  +
-- problem at the moment.
  +
jumpToOrRestore c q = flip (ifWindows q) c $ \ws -> withWindowSet $ \s -> dispatch ws s
  +
where
  +
  +
dispatch ws s =
  +
case hidden of
  +
[] -> jumpToOrHide
  +
hws -> shiftToCurrent hws
  +
where
  +
  +
hidden = filter (\w -> fromMaybe "" (W.findTag w s) == hiddenWorkspaceTag) ws
  +
  +
shiftToCurrent hws = mapM_ (windows . W.shiftWin (W.currentTag s)) hws
  +
  +
cws = maybe [] W.integrate $ W.stack $ W.workspace $ W.current s
  +
  +
jumpToOrHide =
  +
case cws `intersect` ws of
  +
[] -> jumpTo $ W.peek s
  +
iws -> mapM_ (windows . W.shiftWin hiddenWorkspaceTag) iws
  +
  +
jumpTo (Just w) | w `elem` ws =
  +
let (_:y:_) = dropWhile (/=w) $ cycle ws -- cannot fail to match
  +
in windows $ W.focusWindow y
  +
jumpTo _ = windows . W.focusWindow . head $ ws
  +
  +
  +
-- | Hide all windows on the current workspace of the AppType Summon.
  +
hideSummonWindows :: [App] -> X ()
  +
hideSummonWindows apps = withWindowSet $ \s -> do
  +
let ws = (maybe [] W.integrate . W.stack . W.workspace . W.current) s
  +
sWinsQuery = foldr1 (<||>) $ map query $ filterSummonedApps apps
  +
sWins <- filterM (runQuery sWinsQuery) ws
  +
mapM_ (windows . W.shiftWin summonWorkspaceTag) sWins
  +
  +
  +
-- | Shift the specified app to the current workspace or hide it.
  +
summonWindow :: [App] -- ^ Apps of type Summon to replace.
  +
-> App -- ^ App to summon.
  +
-> X ()
  +
summonWindow apps app = withWindowSet $ \s -> do
  +
let ws = (maybe [] W.integrate . W.stack . W.workspace . W.current) s
  +
q = query app
  +
o = foldr1 (<||>) $ map query $ filter (app/=) apps
  +
  +
matchingWins <- filterM (runQuery q) ws
  +
otherWins <- filterM (runQuery o) ws
  +
  +
case matchingWins of
  +
(x:_) -> do
  +
hideSummonWindows apps
  +
[] -> do
  +
mapM_ (windows . W.shiftWin summonWorkspaceTag) otherWins
  +
  +
filterAll <- filterM (runQuery (query app)) (W.allWindows s)
  +
case filterAll of
  +
(x:_) -> windows $ W.shiftWin (W.currentTag s) x
  +
[] -> cmd app
  +
  +
  +
-- | Hide the focused window. A hidden window is placed on a workspace that is
  +
-- treated specially by all other workspace handling commands used.
  +
hideFocused :: WindowSet -> WindowSet
  +
hideFocused = W.shift hiddenWorkspaceTag
  +
  +
  +
-- | Restore the window that was hidden most recently, like pushing and pulling
  +
-- from a stack.
  +
restoreLast :: WindowSet -> WindowSet
  +
restoreLast s = maybe s (flip (W.shiftWin $ W.currentTag s) s) $ getHidden s
  +
where
  +
getHidden s
  +
= listToMaybe
  +
$ maybe [] (W.integrate' . W.stack)
  +
$ listToMaybe
  +
$ filter (\wsp -> W.tag wsp == hiddenWorkspaceTag)
  +
$ W.workspaces s
  +
  +
  +
-- | Run all the hooks associated with the applications.
  +
appManageHook :: [App] -> ManageHook
  +
appManageHook = composeAll . fmap makeQueriedHook . filter hasHook
  +
where
  +
hasHook app = isJust $ hook app
  +
makeQueriedHook app@App
  +
{ query = q
  +
, hook = Just h
  +
} = q --> h
  +
makeQueriedHook _ = idHook -- never reached
  +
  +
  +
-- | Generate the keybinding list from a list of Apps.
  +
makeKeys :: [App] -> [((ButtonMask, KeySym), X ())]
  +
makeKeys apps = map makeKey $ filter hasKey apps
  +
where
  +
makeKey app = (key app, raiseApp app)
  +
hasKey app = key app /= (0, 0)
  +
  +
  +
filterSummonedApps = filter (isSummonedApp . appType)
  +
where
  +
isSummonedApp (Summon _ _) = True
  +
isSummonedApp _ = False
 
</haskell>
 
</haskell>
   
== BorderColors.hs ==
+
== lib/BorderColors.hs ==
 
<haskell>
 
<haskell>
 
{-# LANGUAGE FlexibleContexts #-}
 
{-# LANGUAGE FlexibleContexts #-}
   
------------------------------------------------------------------------------
+
-------------------------------------------------------------------------- {{{
 
-- |
 
-- |
 
-- Module : BorderColors
 
-- Module : BorderColors
-- Copyright : (c) Mads N Noe 2009
+
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mntnoe (@) gmail.com
+
-- Maintainer : mail (@) madsnoe.dk
 
-- License : as-is
 
-- License : as-is
 
--
 
--
Line 338: Line 298:
 
-- your eyes to the border of the screen, breaking your work flow.
 
-- your eyes to the border of the screen, breaking your work flow.
 
--
 
--
------------------------------------------------------------------------------
+
-------------------------------------------------------------------------- }}}
   
 
module BorderColors (colorWhen) where
 
module BorderColors (colorWhen) where
Line 359: Line 319:
 
~(Just pc) <- io $ initColor d c
 
~(Just pc) <- io $ initColor d c
 
io $ setWindowBorder d w pc
 
io $ setWindowBorder d w pc
  +
 
</haskell>
 
</haskell>
   
== DMenu.hs ==
+
== lib/Commands.hs ==
 
<haskell>
 
<haskell>
------------------------------------------------------------------------------
+
-------------------------------------------------------------------------- {{{
 
-- |
 
-- |
-- Module : DMenu
+
-- Module : Commands
-- Copyright : (c) Mads N Noe 2009
+
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mntnoe (@) gmail.com
+
-- Maintainer : mail (@) madsnoe.dk
 
-- License : as-is
 
-- License : as-is
 
--
 
--
-- DMenu helper functions.
+
-- Settings for XMonad.Actions.Commands.
 
--
 
--
------------------------------------------------------------------------------
+
-------------------------------------------------------------------------- }}}
   
module DMenu where
+
module Commands where
   
 
-- Haskell modules
 
-- Haskell modules
import Data.List (intercalate)
+
import qualified Data.Map as M
  +
import Data.IORef (IORef)
  +
import Data.List
  +
import Data.Maybe
  +
import System.Exit (exitWith, ExitCode(..) )
   
 
-- XMonad modules
 
-- XMonad modules
import XMonad.Prompt
+
import XMonad
  +
import XMonad.Actions.Commands hiding (workspaceCommands)
  +
import XMonad.Actions.WindowGo
  +
import qualified XMonad.StackSet as W
   
-- | Run command in path.
+
-- Custom modules
dmenuRun xpc = intercalate " " $ "dmenu_run" : dmenuArgs xpc "Run:"
+
import App
  +
import Config
  +
import DMenu
  +
  +
-- | Given a list of command\/action pairs, prompt the user to choose a
  +
-- command and return the corresponding action.
  +
-- runCommand :: [(String, X ())] -> X ()
  +
runCommand = do
  +
let m = commandMap $ dmenuCommands
  +
choice <- dmenu (M.keys m)
  +
fromMaybe (return ()) (M.lookup choice m)
  +
  +
-- | Commands for DMenu.
  +
dmenuCommands :: [(String, X ())]
  +
dmenuCommands =
  +
[ ("view-summon" , windows $ W.view summonWorkspaceTag)
  +
, ("view-hidden" , windows $ W.view hiddenWorkspaceTag)
  +
-- , ("restart" , restart "xmonad" True)
  +
, ("restart-no-resume" , restart "xmonad" False)
  +
, ("refresh" , refresh)
  +
, ("quit" , io $ exitWith ExitSuccess)
  +
]
  +
  +
  +
-- | Commands for ServerMode.
  +
-- TODO: integrate with dzen.
  +
smCommands :: X [(String, X ())]
  +
smCommands = do
  +
wsCmds <- workspaceCommands
  +
return $ take 10 (cycle wsCmds) ++ otherCommands
  +
where
  +
  +
otherCommands =
  +
[ ("focus-vim" , raiseNext q_vims)
  +
]
  +
  +
q_vims = className =? "Gvim" <||> (className =? "XTerm" <&&> fmap (isPrefixOf "vim:") title)
  +
  +
-- | Generate a list of commands to switch to.
  +
workspaceCommands :: X [(String, X ())]
  +
workspaceCommands = do
  +
ws <- asks $ workspaces . config
  +
return $ map makeEntry ws
  +
where
  +
makeEntry w = ("view-" ++ w, windows $ W.view w)
  +
  +
-- -- | 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-")]
  +
-- ]
   
-- | 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
 
]
 
 
</haskell>
 
</haskell>
   
== Dzen.hs ==
+
== lib/Config.hs ==
 
<haskell>
 
<haskell>
------------------------------------------------------------------------------
+
-------------------------------------------------------------------------- {{{
 
-- |
 
-- |
-- Module : Dzen
+
-- Module : Config
-- Copyright : (c) Mads N Noe 2009
+
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mntnoe (@) gmail.com
+
-- Maintainer : mail (@) madsnoe.dk
 
-- License : as-is
 
-- License : as-is
 
--
 
--
-- Functions for spawning dzen instances.
+
-- Static module configuration which I am too lazy to pass around.
--
+
--
------------------------------------------------------------------------------
+
-------------------------------------------------------------------------- }}}
   
module Dzen (
+
module Config where
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
 
-- XMonad modules
import Control.Monad
+
import XMonad
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
+
-- GUI
-- 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
+
font = "Consolas-9:rgba=rgb"
-- Show battery info only on the laptop.
+
defaultBG = "#dbdbdb"
hbar Desktop = "hbar -cmt | "
+
defaultFG = "#000000"
hbar Laptop = "hbar -cmbt | "
+
hilightBG = "#5e8eba"
  +
hilightFG = "#ffffff"
   
-- 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.
+
-- PANEL
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
+
wTrayer = 100
do_ x = x >> return ()
+
wConky = 140
  +
wHbar = 280 -- width of piped dzen
  +
height = "18"
   
dzenWithConky conkyrc dest = intercalate " " ["conky-cli -c", conkyrc, "|", dest, "&"]
+
hbar = "hbar -cmbdt | "
  +
conkyrc = "/home/mntnoe/.conkyrc-dzen"
   
-- | Return a string that launches dzen with the given configuration.
+
-- KEYS
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 - (fromInteger $ toInteger $ 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.
+
i = mod5Mask -- (I)SO_LEVEL5_SHIFT
getScreenDim :: IO (CInt, CInt)
+
u = mod4Mask -- S(U)PER
getScreenDim = do
+
s = shiftMask
d <- openDisplay ""
+
m = mod1Mask
let s = defaultScreen d
+
c = controlMask
w = displayWidth d s
+
is = i .|. s
h = displayHeight d s
+
im = i .|. m
closeDisplay d
+
ic = i .|. c
return (w, h)
+
us = u .|. s
  +
  +
-- APP
  +
  +
-- | Workspace containing "hidden" windows. Treated specially by workspace handling commands.
  +
hiddenWorkspaceTag :: String
  +
hiddenWorkspaceTag = "H"
  +
  +
-- | Workspace containing "summoned" windows. Treated specially by workspace handling commands.
  +
summonWorkspaceTag :: String
  +
summonWorkspaceTag = "S"
  +
  +
  +
-- ICONS
  +
  +
-- | The icons located here are simply 16x16 XPM icons from hicolor, gnome and gnome-colors.
  +
-- TODO: refactor
  +
  +
iconPath = "/home/mntnoe/.xmonad/icons/default/"
  +
hilightIconPath = "/home/mntnoe/.xmonad/icons/hilight/"
  +
grayIconPath = "/home/mntnoe/.xmonad/icons/gray/"
  +
  +
defaultIcon = "apps/application-default-icon.xpm"
  +
  +
defaultSepIcon = "^i(/home/mntnoe/.xmonad/icons/default-sep.xpm)"
  +
hilightSepIcon = "^i(/home/mntnoe/.xmonad/icons/hilight-sep.xpm)"
  +
leftIcon = "^i(/home/mntnoe/.xmonad/icons/left.xpm)"
  +
rightIcon = "^i(/home/mntnoe/.xmonad/icons/right.xpm)"
 
</haskell>
 
</haskell>
   
== Layout.hs ==
+
== lib/DMenu.hs ==
  +
<haskell>
  +
-------------------------------------------------------------------------- {{{
  +
-- |
  +
-- Module : DMenu
  +
-- Copyright : (c) Mads N Noe 2010
  +
-- Maintainer : mail (@) madsnoe.dk
  +
-- License : as-is
  +
--
  +
-- DMenu helper functions.
  +
--
  +
-------------------------------------------------------------------------- }}}
  +
  +
module DMenu (dmenu, dmenuRun) where
  +
  +
-- Haskell modules
  +
import Data.List (intercalate)
  +
  +
-- XMonad modules
  +
import XMonad
  +
import XMonad.Util.Run
  +
  +
-- Custom modules
  +
import Config
  +
import Utils
  +
  +
dmenu :: [String] -> X (String)
  +
dmenu opts = run "dmenu" (dmenuArgs "Select:") opts
  +
  +
  +
-- | Run command in path.
  +
dmenuRun :: X ()
  +
dmenuRun = do_ $ safeSpawn "dmenu_run" $ dmenuArgs "Run:"
  +
  +
dmenuArgs :: String -> [String]
  +
dmenuArgs prompt =
  +
[ "-b"
  +
, "-fn" , font
  +
, "-nb" , defaultBG
  +
, "-nf" , defaultFG
  +
, "-sb" , hilightBG
  +
, "-sf" , hilightFG
  +
, "-p" , prompt
  +
]
  +
  +
run :: String -> [String] -> [String] -> X String
  +
run cmd args opts = io $ runProcessWithInput cmd args (unlines opts)
  +
</haskell>
  +
  +
== lib/IM.hs ==
  +
Skipped, as it is based on Xmonad.Layout.IM and only contains small
  +
modifications.
  +
  +
== lib/Layout.hs ==
 
<haskell>
 
<haskell>
 
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
 
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
Line 456: Line 402:
 
-- |
 
-- |
 
-- Module : Layout
 
-- Module : Layout
-- Copyright : (c) Mads N Noe 2009
+
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mntnoe (@) gmail.com
+
-- Maintainer : mail (@) madsnoe.dk
 
-- License : as-is
 
-- License : as-is
 
--
 
--
Line 465: Line 411:
   
 
module Layout (
 
module Layout (
MyAccordion(..)
+
twoAccordion
 
) where
 
) where
   
Line 471: Line 417:
 
import XMonad
 
import XMonad
 
import qualified XMonad.StackSet as W
 
import qualified XMonad.StackSet as W
  +
import XMonad.Layout.LimitWindows
  +
   
 
-- Hacked Accordion layout. Useful for LaTeX editing, where you switch between
 
-- Hacked Accordion layout. Useful for LaTeX editing, where you switch between
-- an editor window and a preview window. Only the ratios are modified. This
+
-- an editor window and a preview window. Accordion originally by
-- 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>.
 
-- <glasser (@) mit.edu>.
data MyAccordion a = MyAccordion deriving ( Read, Show )
+
twoAccordion = limitSlice 2 TwoAccordion
  +
  +
  +
data TwoAccordion a = TwoAccordion deriving ( Read, Show )
   
instance LayoutClass MyAccordion Window where
+
instance LayoutClass TwoAccordion Window where
 
pureLayout _ sc ws = zip ups tops ++ [(W.focus ws, mainPane)] ++ zip dns bottoms
 
pureLayout _ sc ws = zip ups tops ++ [(W.focus ws, mainPane)] ++ zip dns bottoms
 
where
 
where
Line 494: Line 442:
 
</haskell>
 
</haskell>
   
== Obsolete.hs ==
+
== lib/MyApps.hs ==
 
<haskell>
 
<haskell>
------------------------------------------------------------------------------
+
-------------------------------------------------------------------------- {{{
 
-- |
 
-- |
-- Module : Obsolete
+
-- Module : MyApps
-- Copyright : (c) Mads N Noe 2009
+
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mntnoe (@) gmail.com
+
-- Maintainer : mail (@) madsnoe.dk
 
-- License : as-is
 
-- License : as-is
 
--
 
--
-- Functions not used anymore, but might be useful later.
+
-- Per application configuration. See App.
 
--
 
--
------------------------------------------------------------------------------
+
-------------------------------------------------------------------------- }}}
   
module Obsolete (
+
module MyApps (apps) where
) where
 
   
 
-- Haskell modules
 
-- Haskell modules
import Data.Char (toLower, toUpper)
+
import Data.List
import qualified Data.Map as M
 
   
 
-- XMonad modules
 
-- XMonad modules
 
import XMonad
 
import XMonad
import XMonad.Prompt
+
import XMonad.Hooks.ManageHelpers (doRectFloat, doCenterFloat)
import qualified XMonad.StackSet as W
+
import XMonad.StackSet (RationalRect (RationalRect))
import XMonad.Util.NamedWindows (getName)
 
import XMonad.Util.Run (runProcessWithInput)
 
   
-- My modules
+
-- Custom modules
import DMenu (dmenuArgs)
+
import App
  +
import Config
  +
import Utils
   
-- DMENU FUNCTIONS
 
   
-- | Spawn dmenu with the given prompt and completion list. Return what the
+
apps =
-- 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.
+
-- Firefox
dmenuMap :: XPConfig -> String -> M.Map String a -> X (Maybe a)
+
[ nullApp
dmenuMap xpc prompt selectionMap = do
+
{ cmd = spawn "firefox"
selection <- (dmenu xpc prompt) (M.keys selectionMap)
+
, appType = JumpTo
return $ M.lookup selection selectionMap
+
, key = (i, xK_f)
  +
, query = className =? "Firefox"
  +
, icon = "apps/firefox.xpm"
  +
}
   
-- | Prompt for a window and focus it.
+
-- XTerm (new)
gotoMenu :: XPConfig -> X ()
+
, nullApp
gotoMenu xpc = actionMenu xpc "Window:" W.focusWindow
+
{ cmd = spawn "xterm"
  +
, appType = OpenNew
  +
, key = (i, xK_x)
  +
}
   
-- | Prompt for a window and perform an 'WindowSet' operation on it.
+
-- XTerm (jump)
actionMenu :: XPConfig -> String -> (Window -> WindowSet -> WindowSet) -> X()
+
, nullApp
actionMenu xpc prompt action = windowMap >>= (dmenuMap xpc prompt) >>= flip whenJust (windows . action)
+
{ cmd = spawn "xterm"
  +
, appType = JumpTo
  +
, key = (i, xK_c)
  +
, query = fmap (/="xterm-scratchpad") appName
  +
<&&>
  +
terminalWithTitle (\t -> not (isPrefixOf "root:" t)
  +
&& not (isInfixOf "emerge" t)
  +
&& not (isPrefixOf "vim:" t))
  +
, icon = "apps/utilities-terminal.xpm"
  +
}
   
-- | Map from a formatted name to the corresponding 'Window' for use in a prompt.
+
-- XTerm (superuser)
windowMap :: X (M.Map String Window)
+
, nullApp
windowMap = do
+
{ query = terminalWithTitle (\t -> isPrefixOf "root:" t
ws <- gets windowset
+
|| isInfixOf "emerge" t)
M.fromList `fmap` concat `fmap` mapM keyValuePairs (W.workspaces ws)
+
, icon = "apps/gksu-root-terminal.xpm"
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'.
+
-- Vim
formatWindowName :: WindowSpace -> Window -> X String
+
, nullApp
formatWindowName ws w = do
+
{ cmd = spawn "xvim"
name <- fmap (take 15 . map toLower . show) $ getName w
+
, appType = JumpTo
return $ name ++ " [" ++ [head $ W.tag ws] ++ "]"
+
, key = (i, xK_v)
  +
, query = ( className =? "XTerm" <&&> fmap (isPrefixOf "vim:" ) title) <||> className =? "Gvim"
  +
, icon = "apps/vim.xpm"
  +
}
   
  +
-- Scratchpad
  +
, nullApp
  +
{ cmd = spawn $ xterm "xterm-scratchpad" "screen -dRRS scratchpad"
  +
, appType = Summon "scratchpad" apps
  +
, key = (i, xK_Return)
  +
, query = appName =? "xterm-scratchpad"
  +
, hook = Just doCenterFloat
  +
, icon = "apps/utilities-terminal.xpm"
  +
}
   
-- FOCUS SLAVES
+
-- Emacs
  +
, nullApp
  +
{ cmd = spawn "emacs"
  +
, appType = JumpTo
  +
, key = (i, xK_e)
  +
, query = className =? "Emacs" <||> fmap (isPrefixOf "emacs:") title
  +
, icon = "apps/emacs.xpm"
  +
}
   
-- Cycle focus between \"slave windows\" in an XMonad workspace. I found it
+
-- Gmail
-- more confusing than helpful, though.
+
, nullApp
  +
{ cmd = spawn "prism gmail"
  +
, appType = Summon "gmail" apps
  +
, key = (u, xK_j)
  +
, query = q_prism <&&> fmap ("Gmail" `isPrefixOf`) title
  +
, hook = Just prismFloat
  +
, icon = "apps/gmail.xpm"
  +
}
   
-- | Focus the previous window which is not the master window. Wrap around the
+
-- Google Calendar
-- end.
+
, nullApp
focusUpSlave :: WindowSet -> WindowSet
+
{ cmd = spawn "prism google.calendar"
focusUpSlave = W.modify' focusUpSlave'
+
, appType = Summon "gcal" apps
where
+
, key = (u, xK_k)
focusUpSlave' :: W.Stack a -> W.Stack a
+
, query = q_prism <&&> fmap (\ x -> isPrefixOf "madsnoe.dk Calendar" x
focusUpSlave' (W.Stack t (l:[]) rs) = W.Stack x xs [] where (x:xs) = reverse (l:t:rs)
+
|| isPrefixOf "Google Calendar" x) title
focusUpSlave' (W.Stack t (l:ls) rs) = W.Stack l ls (t:rs)
+
, hook = Just prismFloat
focusUpSlave' (W.Stack t [] rs) = W.Stack x xs [] where (x:xs) = reverse (t:rs)
+
, icon = "apps/google-calendar.xpm"
  +
}
   
-- | Focus the next window which is not the master window. Wrap around the
+
-- Remember The Milk
-- end.
+
, nullApp
focusDownSlave :: WindowSet -> WindowSet
+
{ cmd = spawn "prism remember.the.milk"
focusDownSlave = W.modify' focusDownSlave'
+
, appType = Summon "rtm" apps
where
+
, key = (u, xK_l)
focusDownSlave' s@(W.Stack _ [] []) = s
+
, query = q_prism <&&> fmap (isPrefixOf "Remember The Milk") title
focusDownSlave' (W.Stack t ls (r:rs)) = W.Stack r (t:ls) rs
+
, hook = Just prismFloat
focusDownSlave' (W.Stack t ls []) = W.Stack x [m] xs where (m:x:xs) = reverse (t:ls)
+
, icon = "apps/rtm.xpm"
  +
}
   
-- | Swap position with the previous window which is not the master window.
+
-- Ordbogen.com
-- Wrap around the end.
+
, nullApp
swapUpSlave :: WindowSet -> WindowSet
+
{ cmd = spawn "prism ordbogen.com"
swapUpSlave = W.modify' swapUpSlave'
+
, appType = Summon "ordbogen" apps
where
+
, key = (u, xK_semicolon)
swapUpSlave' (W.Stack t (l:[]) rs) = W.Stack t (reverse (l:rs)) []
+
, query = let prefix x = isPrefixOf "ordbogen" x || isPrefixOf "Ordbogen" x
swapUpSlave' (W.Stack t (l:ls) rs) = W.Stack t ls (l:rs)
+
in q_prism <&&> fmap prefix title
swapUpSlave' (W.Stack t [] rs) = W.Stack t (reverse rs) []
+
, hook = Just $ doCenterFloat' (4/10) (5/6)
  +
, icon = "apps/ordbogen.xpm"
  +
}
   
-- | Swap position with the next window which is not the master window. Wrap
+
-- Nautilus
-- around the end.
+
, nullApp
swapDownSlave :: WindowSet -> WindowSet
+
{ cmd = spawn "nautilus ~"
swapDownSlave = W.modify' swapDownSlave'
+
, appType = JumpTo
where
+
, key = (i, xK_d)
swapDownSlave' s@(W.Stack _ [] []) = s
+
, query = className =? "Nautilus"
swapDownSlave' (W.Stack t ls (r:rs)) = W.Stack t (r:ls) rs
+
, icon = "apps/file-manager.xpm"
swapDownSlave' (W.Stack t ls@(_:_) []) = W.Stack t [x] xs where (x:xs) = (reverse ls)
+
}
  +
  +
-- Eclipse
  +
, nullApp
  +
{ cmd = spawn "eclipse"
  +
, appType = JumpTo
  +
, key = (u, xK_g)
  +
, query = let eclipse = className =? "Eclipse"
  +
splash = title =? "." <&&> ( className =? "" <||> appName =? "." )
  +
in eclipse <||> splash
  +
, icon = "apps/eclipse.xpm"
  +
}
  +
  +
-- XDvi
  +
, nullApp
  +
{ query = className =? "XDvi"
  +
, icon = "apps/adobe.pdf.xpm"
  +
}
  +
  +
-- Xpdf
  +
, nullApp
  +
{ query = className =? "Xpdf"
  +
, icon = "apps/adobe.pdf.xpm"
  +
}
  +
  +
-- Evince
  +
, nullApp
  +
{ query = className =? "Evince"
  +
, icon = "apps/evince.xpm"
  +
}
  +
  +
-- Acroread
  +
, nullApp
  +
{ query = className =? "Acroread"
  +
, icon = "apps/adobe-reader.xpm"
  +
}
  +
  +
-- MPlayer
  +
, nullApp
  +
{ query = className =? "MPlayer"
  +
, icon = "apps/gnome-mplayer.xpm"
  +
}
  +
  +
-- VLC
  +
, nullApp
  +
{ query = title =? "VLC media player"
  +
, icon = "apps/vlc.xpm"
  +
}
  +
  +
-- Gimp
  +
, nullApp
  +
{ query = className =? "Gimp"
  +
, icon = "apps/gimp.xpm"
  +
}
  +
  +
-- OpenOffice
  +
, nullApp
  +
{ query = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Writer") title
  +
, icon = "apps/ooo-writer.xpm"
  +
}
  +
  +
-- OpenOffice
  +
, nullApp
  +
{ query = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Calc") title
  +
, icon = "apps/ooo-calc.xpm"
  +
}
  +
  +
-- OpenOffice
  +
, nullApp
  +
{ query = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Base") title
  +
, icon = "apps/ooo-base.xpm"
  +
}
  +
  +
-- OpenOffice
  +
, nullApp
  +
{ query = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Draw") title
  +
, icon = "apps/ooo-draw.xpm"
  +
}
  +
  +
-- OpenOffice
  +
, nullApp
  +
{ query = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Impress") title
  +
, icon = "apps/ooo-impress.xpm"
  +
}
  +
  +
-- OpenOffice
  +
, nullApp
  +
{ query = className =? "OpenOffice.org 3.2"
  +
, icon = "apps/ooo-gulls.xpm"
  +
}
  +
  +
-- VirtualBox
  +
, nullApp
  +
{ query = className =? "VirtualBox"
  +
, icon = "apps/vmware.xpm"
  +
}
  +
  +
-- XChat
  +
, nullApp
  +
{ query = className =? "Xchat"
  +
, icon = "apps/xchat-gnome.xpm"
  +
}
  +
  +
  +
-- Gnucash
  +
, nullApp
  +
{ appType = JumpTo
  +
, query = className =? "Gnucash"
  +
, icon = "apps/gnucash-icon.xpm"
  +
}
  +
  +
  +
-- Audacity
  +
, nullApp
  +
{ cmd = spawn "audacity"
  +
, appType = JumpTo
  +
, query = className =? "Audacity"
  +
, icon = "apps/audacity.xpm"
  +
}
  +
  +
  +
-- Gnome-session
  +
, nullApp
  +
  +
{ query = className =? "Gnome-session"
  +
, icon = "apps/gnome-shutdown.xpm"
  +
}
  +
  +
  +
-- Rhythmbox
  +
, nullApp
  +
{ query = className =? "Rhythmbox"
  +
, icon = "apps/rhythmbox.xpm"
  +
}
  +
  +
  +
-- MARK --
  +
  +
]
  +
  +
  +
-- Auxiliary functions
  +
  +
terminalWithTitle p = className =? "XTerm" <&&> fmap p title
  +
  +
q_typing_mon = className =? "Gnome-typing-monitor"
  +
q_nautilus_f = className =? "Nautilus" <&&> fmap (not . isSuffixOf " - File Browser") title
  +
q_eclipse_spl = title =? "." <&&> ( className =? "" <||> appName =? "." )
  +
q_prism = className =? "Prism"
  +
q_xterms = className =? "XTerm"
  +
  +
prismFloat = doCenterFloat' (8/10) (5/6)
  +
doCenterFloat' w h = doRectFloat $ RationalRect ((1 - w)/2) ((1 - h)/2) w h
 
</haskell>
 
</haskell>
   
== Pager.hs ==
+
== lib/Pager.hs ==
 
<haskell>
 
<haskell>
 
------------------------------------------------------------------------------
 
------------------------------------------------------------------------------
 
-- |
 
-- |
 
-- Module : Pager
 
-- Module : Pager
-- Copyright : (c) Mads N Noe 2009
+
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mntnoe (@) gmail.com
+
-- Maintainer : mail (@) madsnoe.dk
 
-- License : as-is
 
-- License : as-is
 
--
 
--
-- A pager for DynamicLog showing a symbol for each window on each workspace.
+
-- A pager for DynamicLog showing an for each window on each workspace.
  +
-- TODO: Gets slow when there are many windows. Optimize! Not a problem
  +
-- for casual use however.
 
--
 
--
 
------------------------------------------------------------------------------
 
------------------------------------------------------------------------------
   
 
module Pager (
 
module Pager (
-- * Usage
 
-- $usage
 
 
 
labeledPager
 
labeledPager
 
) where
 
) where
Line 617: Line 570:
 
-- XMonad modules
 
-- XMonad modules
 
import XMonad
 
import XMonad
  +
import Data.Char (toLower)
 
import Data.Maybe ( isJust, fromMaybe )
 
import Data.Maybe ( isJust, fromMaybe )
 
import qualified Data.Map as M
 
import qualified Data.Map as M
Line 625: Line 579:
 
import XMonad.Hooks.UrgencyHook
 
import XMonad.Hooks.UrgencyHook
   
-- My modules
+
-- Custom modules
import Util
+
import App
+
import Config
-- $usage
+
import MyApps
--
+
import Utils
-- 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
 
-- | The 'DynamicLog' logger to add to 'ppExtras' using the given pretty
 
-- printer and window label map.
 
-- printer and window label map.
labeledPager :: PP -> [(String, Query Bool)] -> X (Maybe String)
+
labeledPager :: PP -> X (Maybe String)
labeledPager pp lm = do
+
labeledPager pp = do
 
s <- gets windowset
 
s <- gets windowset
 
urgents <- readUrgents
 
urgents <- readUrgents
 
sort' <- ppSort pp
 
sort' <- ppSort pp
wl <- queryWindows s lm
+
wl <- queryWindows s windowLabelMap
 
return $ Just $ pprWindowSet' sort' urgents wl pp s
 
return $ Just $ pprWindowSet' sort' urgents wl pp s
   
Line 653: Line 607:
 
= sepBy (ppWsSep pp) . map fmt . sort' $
 
= sepBy (ppWsSep pp) . map fmt . sort' $
 
map W.workspace (W.current s : W.visible s) ++ W.hidden s
 
map W.workspace (W.current s : W.visible s) ++ W.hidden s
where this = W.tag (W.workspace (W.current s))
+
where
visibles = map (W.tag . W.workspace) (W.visible s)
+
this = W.tag (W.workspace (W.current s))
  +
visibles = map (W.tag . W.workspace) (W.visible s)
  +
  +
fmt ws = (printer ws) pp $ print path ws
  +
where
  +
path
  +
| W.tag ws == this = hilightIconPath
  +
| W.tag ws == summonWorkspaceTag = grayIconPath
  +
| W.tag ws == hiddenWorkspaceTag = grayIconPath
  +
| otherwise = iconPath
  +
  +
printer ws
  +
| 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
   
fmt ws = printer pp (W.tag ws ++ printWindows wl (W.integrate' $ W.stack ws))
+
print path ws = printWindows path 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
 
-- | Output a list of strings, ignoring empty ones and separating the
Line 666: Line 620:
   
 
-- | Print a concatenated string of symbols for a list of windows.
 
-- | Print a concatenated string of symbols for a list of windows.
printWindows :: M.Map Window String -- ^ window to symbol map
+
printWindows :: String -- ^ icon path
  +
-> M.Map Window String -- ^ window to symbol map
 
-> [Window] -- ^ windows on the workspace
 
-> [Window] -- ^ windows on the workspace
 
-> String
 
-> String
printWindows wl ws = pad $ concatMap (\w -> fromMaybe "" $ M.lookup w wl) ws
+
printWindows path wl ws = handleEmpty $ intercalate (icon path "sep.xpm") $ map (\w -> icon path $ fromMaybe defaultIcon (M.lookup w wl)) ws
 
where
 
where
pad "" = ""
+
pad xs = ":"++xs
+
icon path i = "^i(" ++ path ++ i ++ ")"
  +
  +
handleEmpty "" = "^ro(6x6)"
  +
handleEmpty xs = xs
   
 
-- | Query each window in the 'WindowSet' and assign a symbol to it in a map.
 
-- | Query each window in the 'WindowSet' and assign a symbol to it in a map.
Line 680: Line 634:
 
where
 
where
 
qw :: [(String, Query Bool)] -> Window -> X (Window, String)
 
qw :: [(String, Query Bool)] -> Window -> X (Window, String)
qw [] w = return (w, "?")
+
qw [] w = return (w, defaultIcon)
 
qw ((l, q):lqs) w = runQuery q w >>= if_ (return (w, l)) (qw lqs w)
 
qw ((l, q):lqs) w = runQuery q w >>= if_ (return (w, l)) (qw lqs w)
  +
  +
  +
-- | Map windows to symbols for the pager. Symbols for floating windows are in
  +
-- lower case.
  +
windowLabelMap :: [(String, Query Bool)]
  +
windowLabelMap =
  +
map whenFloat windows ++ windows
  +
where
  +
  +
whenFloat (l, q) = (map toLower l, isFloat <&&> q)
  +
  +
windows = zip (map icon apps) (map query apps)
 
</haskell>
 
</haskell>
   
== ScratchpadPrime.hs ==
+
== lib/Panel.hs ==
 
<haskell>
 
<haskell>
 
------------------------------------------------------------------------------
 
------------------------------------------------------------------------------
 
-- |
 
-- |
-- Module : ScratchpadPrime
+
-- Module : Dzen
-- Copyright : (c) Mads N Noe 2009
+
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mntnoe (@) gmail.com
+
-- Maintainer : mail (@) madsnoe.dk
 
-- License : as-is
 
-- License : as-is
--
+
--
-- A modified scatchpad which uses GNU Screen to detach the window rather than
+
-- Functions for spawning dzen instances.
-- 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 (
+
module Panel
scratchpad'
+
( spawnPanels
) where
+
, killPanels
  +
, getScreenCount
  +
) where
   
 
-- Haskell modules
 
-- Haskell modules
 
import Control.Monad
 
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
 
-- XMonad modules
  +
import Control.Monad
  +
import Graphics.X11.Xlib
  +
import Graphics.X11.Xinerama
 
import XMonad
 
import XMonad
import qualified XMonad.StackSet as W
+
import XMonad.Util.Run(spawnPipe)
   
-- | A modified scatchpad which uses GNU Screen to detach the
+
-- Custom modules
-- window rather than putting it on a hidden workspace.
+
import Config
scratchpad' :: Query Bool -> String -> X ()
+
import Utils
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).
+
-- | Run before each restart of xmonad to ensure that there
kill' :: Window ->X ()
+
-- will only be the expected panel instances running.
kill' w = withDisplay $ \d -> do
+
killPanels :: X ()
wmdelt <- atom_WM_DELETE_WINDOW ; wmprot <- atom_WM_PROTOCOLS
+
killPanels = do
  +
spawn' "killall conky-cli"
  +
spawn' "killall hbar"
  +
spawn' "killall trayer"
  +
return ()
   
protocols <- io $ getWMProtocols d w
+
-- | Spawn the applications that make the upper panel.
io $ if wmdelt `elem` protocols
+
spawnPanels :: IO ([Handle])
then allocaXEvent $ \ev -> do
+
spawnPanels = do
setEventType ev clientMessage
+
count <- getScreenCount'
setClientMessageEvent ev w wmprot 32 wmdelt 0
+
pipes <- mapM (spawnDzenOnScreen count) [0..count-1]
sendEvent d w False noEventMask ev
+
spawnTrayer
else killClient d w >> return ()
+
return pipes
</haskell>
 
   
== ServerMode.hs ==
+
spawnTrayer = spawn' $ intercalate " "
<haskell>
+
[ "trayer"
------------------------------------------------------------------------------
+
, "--edge" , "top"
-- |
+
, "--align" , "right"
-- Module : ServerMode
+
, "--widthtype" , "pixel"
-- Copyright : (c) Mads N Noe 2009
+
, "--width" , show wTrayer
-- (c) Andrea Rossato and David Roundy 2007
+
, "--heighttype" , "pixel"
-- Maintainer : mntnoe (@) gmail.com
+
, "--height" , height
-- License : BSD-style (see xmonad\/LICENSE)
+
, "--margin" , show $ wHbar + wConky
--
+
, "--transparent" , "true"
-- Modification of XMonad.Hooks.ServerMode with custom actions.
+
, "--alpha" , "0"
--
+
, "--tint" , convert $ defaultBG
------------------------------------------------------------------------------
+
, "--SetDockType" , "true"
  +
, "--SetPartialStrut" , "true"
  +
, "--expand" , "true"
  +
]
  +
where
  +
convert ('#':xs) = '0':'x':xs
  +
convert xs = xs
   
module ServerMode (
+
-- | spawn' two dzen instances at the top of the screen, reading input
ServerMode (..)
+
-- from xmonad and hbar respectively.
, eventHook
+
spawnDzenOnScreen count screen = do
) where
 
   
-- Haskell modules
+
-- Unfortunately, only one instance of trayer is allowed.
import Control.Monad (when)
+
let wTrayerMaybe = if screen == count - 1 then wTrayer else 0
import Data.List
 
import Data.Maybe
 
import System.IO
 
import qualified Data.Map as M
 
   
-- XMonad modules
+
(sx, sy, sw, sh) <- getScreenDim screen
import XMonad
+
pipes <- spawnPipe $ dzen
import XMonad.Actions.Commands hiding (runCommand')
+
sy -- vertical position
import XMonad.Hooks.EventHook
+
sx -- horizontal position
import XMonad.Actions.CycleWS
+
(sw - wHbar - wTrayerMaybe - wConky) -- horizontal width
import qualified XMonad.StackSet as W
+
'l' -- text align
  +
"" -- no actions
  +
spawnDzenWithConky $ dzen
  +
sy -- vertical position
  +
(sx + sw - wHbar - wConky) -- horizontal position
  +
wConky -- horizontal width
  +
'r' -- text align
  +
"" -- no actions
  +
spawn' $ hbar ++ dzen
  +
sy -- vertical position
  +
(sx + sw - wHbar) -- horizontal position
  +
wHbar -- horizontal width
  +
'r' -- text align
  +
"" -- no actions
  +
return pipes
   
-- My modules
+
where
import Util
+
spawnDzenWithConky dest =
  +
fileExist conkyrc >>=
  +
(flip when $ do_ $ spawn' $ dzenWithConky conkyrc dest)
   
-- | Custom commands.
+
dzenWithConky conkyrc dest = intercalate " " ["conky-cli -c", conkyrc, "|", dest]
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
+
-- | Return a string that launches dzen with the given configuration.
handleEvent _ (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
+
dzen :: Num a => a -- ^ vertical position
d <- asks display
+
-> a -- ^ horizontal position
a <- io $ internAtom d "XMONAD_COMMAND" False
+
-> a -- ^ horizontal width
when (mt == a && dt /= []) $ do
+
-> Char -- ^ text align
cl <- commands
+
-> String -- ^ actions
let listOfCommands = zipWith (++) (map show ([1..] :: [Int])) . map ((++) " - " . fst)
+
-> String
case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of
+
dzen y x w ta e =
Just (c,_) -> runCommand' c
+
intercalate " "
Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
+
[ "dzen2"
handleEvent _ _ = return ()
+
, "-x" , show x
  +
, "-w" , show w
  +
, "-y" , show y
  +
, "-h" , height
  +
, "-fn" , quote font
  +
, "-bg" , quote defaultBG
  +
, "-fg" , quote defaultFG
  +
, "-ta" , [ta]
  +
, "-e" , quote e
  +
]
  +
  +
-- | Get the number of available screens.
  +
getScreenCount :: Num a => X a
  +
getScreenCount = io getScreenCount'
  +
  +
getScreenCount' :: Num a => IO a
  +
getScreenCount' = do
  +
d <- openDisplay ""
  +
screens <- getScreenInfo d
  +
return $ fromIntegral $ length screens
  +
  +
-- | Return the dimensions (x, y, width, height) of screen n.
  +
getScreenDim :: Num a => Int -> IO (a, a, a, a)
  +
getScreenDim n = do
  +
d <- openDisplay ""
  +
screens <- getScreenInfo d
  +
closeDisplay d
  +
let rn = screens!!(min (abs n) (length screens - 1))
  +
case screens of
  +
[] -> return $ (0, 0, 1024, 768) -- fallback
  +
[r] -> return $ (fromIntegral $ rect_x r , fromIntegral $ rect_y r , fromIntegral $ rect_width r , fromIntegral $ rect_height r )
  +
otherwise -> return $ (fromIntegral $ rect_x rn, fromIntegral $ rect_y rn, fromIntegral $ rect_width rn, fromIntegral $ rect_height rn)
   
-- | Given the name of a command from 'defaultCommands', return the
+
-- | Run the command in the background, ensuring that the
-- corresponding action (or the null action if the command is not
+
-- value returned is always 0. This is to avoid making
-- found).
+
-- spawn break a sequence of commands due to a return
runCommand' :: String -> X ()
+
-- value indicating that an error has occured.
runCommand' c = do
+
spawn' x = spawn $ x ++ "&"
m <- fmap commandMap commands
 
fromMaybe (return ()) (M.lookup c m)
 
 
</haskell>
 
</haskell>
   
== Util.hs ==
+
== lib/Utils.hs ==
 
<haskell>
 
<haskell>
 
------------------------------------------------------------------------------
 
------------------------------------------------------------------------------
 
-- |
 
-- |
-- Module : Util
+
-- Module : Utils
-- Copyright : (c) Mads N Noe 2009
+
-- Copyright : (c) Mads N Noe 2010
-- Maintainer : mntnoe (@) gmail.com
+
-- Maintainer : mail (@) madsnoe.dk
 
-- License : as-is
 
-- License : as-is
 
--
 
--
Line 792: Line 766:
 
------------------------------------------------------------------------------
 
------------------------------------------------------------------------------
   
module Util where
+
module Utils where
   
 
-- Haskell modules
 
-- Haskell modules
import Control.Monad (unless, when)
+
import Control.Concurrent.MVar
  +
import Control.Monad (unless, when, liftM)
 
import Control.Monad.Trans (lift)
 
import Control.Monad.Trans (lift)
 
import Data.List
 
import Data.List
import qualified Data.Map as M
 
 
import Data.Monoid (Endo(Endo))
 
import Data.Monoid (Endo(Endo))
import System.Posix.Unistd(getSystemID, nodeName)
 
 
import System.IO.Error (isDoesNotExistError)
 
import System.IO.Error (isDoesNotExistError)
  +
import System.IO.Unsafe (unsafePerformIO)
  +
import System.Posix.Unistd(getSystemID, nodeName)
  +
import qualified Data.Map as M
   
 
-- XMonad modules
 
-- XMonad modules
 
import XMonad
 
import XMonad
 
import XMonad.Actions.CycleWS
 
import XMonad.Actions.CycleWS
  +
import XMonad.Actions.Warp (warpToWindow)
 
import XMonad.Actions.WindowGo
 
import XMonad.Actions.WindowGo
  +
import XMonad.Hooks.DynamicHooks (oneShotHook)
  +
import XMonad.Hooks.FloatNext
  +
import XMonad.Layout.IndependentScreens
 
import qualified XMonad.StackSet as W
 
import qualified XMonad.StackSet as W
import XMonad.Util.WorkspaceCompare (getSortByTag)
+
  +
-- Other moduls
  +
import Graphics.X11.Xinerama
  +
import Graphics.X11.Xlib.Extras
  +
  +
  +
-- GENERAL
   
 
-- | Perform k x if x return a 'Just' value.
 
-- | Perform k x if x return a 'Just' value.
 
(?+) :: (Monad m) => m (Maybe a) -> (a -> m ()) -> m ()
 
(?+) :: (Monad m) => m (Maybe a) -> (a -> m ()) -> m ()
 
x ?+ k = x >>= maybe (return ()) k
 
x ?+ k = x >>= maybe (return ()) k
infixr 1 ?+
+
infixl 1 ?+
   
 
-- | Helper function for use with monads.
 
-- | Helper function for use with monads.
Line 821: Line 800:
 
else f
 
else f
   
-- | Return a string that launches xterm with the given 'title', 'appName' and
+
-- | Change type to "m ()"
-- command to execute.
+
do_ :: (Monad m) => m a -> m ()
xterm :: String -> String -> String
+
do_ x = x >> return ()
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
+
quote :: String -> String
-- operation.
+
quote x = "'" ++ x ++ "'"
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?
+
-- WINDOW ACTIONS
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'.
+
-- | Swap the focused window with the last window in the stack.
doX :: (Window -> X (WindowSet -> WindowSet)) -> ManageHook
+
swapBottom :: W.StackSet i l a s sd -> W.StackSet i l a s sd
doX f = ask >>= Query . lift . fmap Endo . f
+
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
   
-- | Ensure that a window always starts on an empty workspace. If a window
+
-- | Swap the focused window with the following window, or if the window is
-- satisfying the query exists, focus it. Otherwise run the specified
+
-- floating, lower it to the bottom.
-- command, swithing to an empty workspace if the current one is not empty.
+
swapOrLower :: X ()
reqEmptyWS :: Query Bool -> X () -> X ()
+
swapOrLower = withFocused $ \w ->
reqEmptyWS q f = do
+
runQuery isFloat w >>= if_ (windows swapBottom) (windows W.swapDown)
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
+
-- | Swap the focused window with the preceding window, or if the window is
-- previously displayed workspace.
+
-- floating, raise it to the top.
killAndReturn q = withFocused $ \w -> do
+
swapOrRaise :: X ()
qr <- runQuery q w
+
swapOrRaise = withFocused $ \w ->
kill
+
runQuery isFloat w >>= if_ (windows W.swapMaster) (windows W.swapUp)
when qr toggleWS
 
   
-- | Perform a 'WindowSet' transformation on the workspace with the given
+
-- spawnOnThisWS :: GHC.IOBase.IORef XMonad.Hooks.DynamicHooks.DynamicHooks-> Query Bool-> String-> X ()
-- index.
+
spawnOnThisWS dhr q cmd = withWindowSet $ \ws -> do
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
+
oneShotHook dhr q $ doF $ W.shift $ W.currentTag ws
withNthWorkspace job wnum = nthWorkspaceTag wnum ?+ windows . job
+
spawn cmd
where
+
nthWorkspaceTag :: Int -> X (Maybe String)
+
-- | Warp the mouse pointer to the focused window only if the workspace has
nthWorkspaceTag wnum = do
+
-- no floating windows to steal the focus.
sort <- getSortByTag
+
warpToWindow' = withWindowSet $ \ws -> do
ws <- gets (map W.tag . sort . W.workspaces . windowset)
+
let floats = M.keys $ W.floating ws
case drop wnum ws of
+
visible = W.integrate' $ W.stack $ W.workspace $ W.current ws
(w:_) -> return $ Just w
+
vf = floats `intersect` visible
[] -> return Nothing
+
when (null vf) $ warpToWindow (1/2) (1/2)
  +
  +
  +
-- QUERIES ETC
   
 
-- | Is the focused window the \"master window\" of the current workspace?
 
-- | Is the focused window the \"master window\" of the current workspace?
Line 880: Line 853:
 
isFloat = ask >>= (\w -> liftX $ withWindowSet $ \ws -> return $ M.member w $ W.floating ws)
 
isFloat = ask >>= (\w -> liftX $ withWindowSet $ \ws -> return $ M.member w $ W.floating ws)
   
-- | Swap the focused window with the last window in the stack.
+
-- | Helper to read a property
swapBottom :: W.StackSet i l a s sd -> W.StackSet i l a s sd
+
-- getProp :: Atom -> Window -> X (Maybe [CLong])
swapBottom = W.modify' $ \c -> case c of
+
getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w
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
+
-- | Check if window is DIALOG window
-- floating, lower it to the bottom.
+
checkDialog :: Query Bool
swapOrLower :: X ()
+
checkDialog = ask >>= \w -> liftX $ do
swapOrLower = withFocused $ \w ->
+
a <- getAtom "_NET_WM_WINDOW_TYPE"
runQuery isFloat w >>= if_ (windows swapBottom) (windows W.swapDown)
+
dialog <- getAtom "_NET_WM_WINDOW_TYPE_DIALOG"
  +
mbr <- getProp a w
  +
case mbr of
  +
Just [r] -> return $ elem (fromIntegral r) [dialog]
  +
_ -> return False
   
-- | Swap the focused window with the preceding window, or if the window is
+
-- | Determine the number of physical screens.
-- floating, raise it to the top.
+
countScreens :: (MonadIO m, Integral i) => m i
swapOrRaise :: X ()
+
countScreens = liftM genericLength . liftIO $ openDisplay "" >>= getScreenInfo
swapOrRaise = withFocused $ \w ->
+
runQuery isFloat w >>= if_ (windows W.swapMaster) (windows W.swapUp)
+
  +
-- HOST
  +
  +
-- | For use in cross host configutions.
  +
data Host = Laptop | Netbook deriving Eq
   
 
-- | Determine the host.
 
-- | Determine the host.
Line 900: Line 873:
 
host <- getSystemID
 
host <- getSystemID
 
case nodeName host of
 
case nodeName host of
"mntnoe-desktop" -> return Desktop
 
 
"mntnoe-laptop" -> return Laptop
 
"mntnoe-laptop" -> return Laptop
_ -> return Desktop
+
"mntnoe-netbook" -> return Netbook
  +
_ -> return Laptop
   
-- | For use in cross host configutions.
+
data Host = Desktop | Laptop deriving Eq
+
-- MISC
  +
  +
-- | 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, "'"]
 
</haskell>
 
</haskell>
   
[[Category:XMonad configuration]]
+
== lib/Workspace.hs ==
  +
<haskell>
  +
------------------------------------------------------------------------------
  +
-- |
  +
-- Module : Workspace
  +
-- Copyright : (c) Mads N Noe 2010
  +
-- Maintainer : mail (@) madsnoe.dk
  +
-- License : as-is
  +
--
  +
-- Workspace actions.
  +
--
  +
------------------------------------------------------------------------------
  +
  +
module Workspace where
  +
  +
-- Haskell modules
  +
import Data.Maybe ( isNothing, isJust )
  +
  +
-- XMonad modules
  +
import XMonad
  +
import XMonad.Actions.CycleWS
  +
import XMonad.Util.WorkspaceCompare (getSortByTag)
  +
import qualified XMonad.StackSet as W
  +
  +
-- Custom modules
  +
import App
  +
import Config
  +
import Utils
  +
  +
-- | Shift a window to a workspace and switch to that workspace in one
  +
-- operation.
  +
shiftView :: WorkspaceId -> WindowSet -> WindowSet
  +
shiftView id ws = shiftView' id ws
  +
where
  +
shiftView' id ws = W.greedyView id $ W.shift id ws
  +
  +
shiftViewUngreedy id ws = shiftView' id ws
  +
where
  +
shiftView' id ws = W.view id $ W.shift id ws
  +
  +
-- | Perform a workspace transformation on the next workspace in 'WSDirection'
  +
-- of type 'WSType'.
  +
doWithWS :: (String -> (WindowSet -> WindowSet)) -> Direction1D -> WSType -> X ()
  +
doWithWS f dir wstype = do
  +
i <- findWorkspace getSortByTag dir (WSIs pred) 1
  +
windows $ f i
  +
where
  +
pred = do
  +
hidden <- isHidden
  +
return $ (\ws -> notSummon ws && notHidden ws && isWsType ws && hidden ws)
  +
  +
notSummon ws = W.tag ws /= (summonWorkspaceTag)
  +
notHidden ws = W.tag ws /= (hiddenWorkspaceTag)
  +
  +
isWsType ws = wsTypeToPred wstype ws
  +
  +
wsTypeToPred EmptyWS = isNothing . W.stack
  +
wsTypeToPred NonEmptyWS = isJust . W.stack
  +
wsTypeToPred _ = const False
  +
  +
isHidden = do
  +
hs <- gets (map W.tag . W.hidden . windowset)
  +
return (\ws -> W.tag ws `elem` hs)
  +
  +
-- | Swap workspace contents with next screen and focus it. Useful when you work on
  +
-- a laptop with an external screen and keyboard, and want to switch between them.
  +
swapNextScreen' :: X ()
  +
swapNextScreen' = do
  +
ws <- gets windowset
  +
screenWorkspace (nextScreen ws) ?+ windows . swap (W.currentTag ws)
  +
  +
where
  +
  +
nextScreen ws = (W.screen (W.current ws) + 1)
  +
`mod`
  +
fromIntegral (length (W.screens ws))
  +
  +
swap f t = W.view f . W.greedyView t
  +
</haskell>

Latest revision as of 23:26, 26 November 2011

You download the whole configuration (icons inclusive) from my blog.

Contents

[edit] 1 xmonad.hs

{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, MultiParamTypeClasses #-}
 
-------------------------------------------------------------------------- {{{
-- |
-- Module      :  xmonad
-- Copyright   :  (c) Mads N Noe 2010
-- Maintainer  :  mail (@) madsnoe.dk
-- License     :  as-is
-- 
-- Modular xmonad config.
-- 
-- Highlights:
--   * pager with icons for DynamicLog
--   * per application configuration
--   * minimize windows
-- 
-- Requires xmonad 0.9. Note that this work is not finished.
-- There are still lot of things I want to behave differently,
-- and I need to do some cleanup here and there.
-- 
-- Still, I hope you can get inspired by some of my ideas. Enjoy :-)
-- 
-------------------------------------------------------------------------- }}}
 
-- IMPORTS {{{
 
-- Haskell modules
import Control.Monad (when, liftM)
import Data.IORef (IORef)
import Data.List
import Data.Maybe (isJust)
import qualified Data.Map as M
import System.IO (Handle)
 
-- XMonad modules
import XMonad hiding ( (|||) )
import XMonad.Actions.CycleSelectedLayouts
import XMonad.Actions.CycleWS
import XMonad.Actions.FloatKeys
import XMonad.Actions.FloatSnap
import XMonad.Actions.SwapWorkspaces (swapWithCurrent)
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers (doCenterFloat)
import XMonad.Hooks.Place
import XMonad.Hooks.RestoreMinimized
import XMonad.Hooks.ServerMode
import XMonad.Hooks.UrgencyHook
import XMonad.Layout.LayoutCombinators
import XMonad.Layout.Named
import XMonad.Layout.NoBorders
import XMonad.Layout.Reflect
import XMonad.Layout.ResizableTile
import qualified XMonad.StackSet as W
import XMonad.Util.Run (hPutStrLn)
import XMonad.Util.WorkspaceCompare (getSortByTag)
 
-- Custom modules
import App
import BorderColors
import Commands
import DMenu
import Panel
import Config
import IM
import Layout
import MyApps
import Pager
import Utils
import Workspace
-- }}}
 
-- MAIN {{{
main ::  IO ()
main = do 
    host <- getHost
    pipes  <- spawnPanels
    xmonad $ withUrgencyHook NoUrgencyHook $ ewmh $ myXConfig host pipes
-- }}}
 
-- SETTINGS {{{
 
-- | Layout to show initially, and when issuing the according keybinding.  My
--   desktop is widescreen, but not my laptop.
defaultLayout Laptop  = "Tall"
defaultLayout Netbook = "Wide"
 
cycledLayouts Laptop  = ["Mirror",            defaultLayout Laptop]
cycledLayouts Netbook = ["Accordion", "Tall", defaultLayout Netbook]
 
myWorkspaces = map show [1..8] ++ [hiddenWorkspaceTag, summonWorkspaceTag]
 
-- Colors
myNormalBorderColor  = defaultBG
myFocusedBorderColor = "#3939ff"
masterBorderColor    = "#ff1010"
floatBorderColor     = "#10c010"
 
myPlacement = withGaps (22, 0, 0, 0) $ smart (0.5,0.5)
 
myXConfig host pipes = XConfig
    { terminal            = "xterm" -- unused
    , focusFollowsMouse   = True
    , borderWidth         = 3
    , modMask             = mod5Mask -- unused
    , numlockMask         = mod2Mask
    , workspaces          = myWorkspaces
    , normalBorderColor   = myNormalBorderColor
    , focusedBorderColor  = myFocusedBorderColor
    , keys                = myKeys        host
    , mouseBindings       = myMouseBindings
    , handleEventHook     = myHandleEventHook
    , layoutHook          = myLayoutHook
    , manageHook          = myManageHook  host
    , logHook             = myLogHook     host pipes
    , 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 host _ = M.fromList $
 
    makeKeys apps
    ++
 
    [ ((i , xK_comma), runCommand)
    , ((i , xK_slash), dmenuRun)
    , ((u , xK_h),     hideSummonWindows apps)
 
    -- See https://addons.mozilla.org/en-US/firefox/addon/61262.
    , ((is, xK_f),     spawn "firefox -unfocus")
 
    -- Enhance clipboard functionality in xterm (otherwise, xterm easily
    -- "forgets" the selection). Also, xclip will remember the selection
    -- even if the host app exits.
    , ((i , xK_z), spawn "xclip -selection primary -o | xclip -selection clipboard -i")
 
 
    -- FLOATING WINDOWS
    , ((u , xK_p), placeFocused $ myPlacement)
    , ((u , xK_b), withFocused $ windows . W.sink)
 
 
    -- WINDOW HANDLING
    , ((i , xK_j), windows W.focusDown >> warpToWindow')
    , ((i , xK_k), windows W.focusUp   >> warpToWindow')
    , ((is, xK_j), windows W.swapMaster)
    , ((i , xK_h), swapOrRaise)
    , ((is, xK_h), swapOrLower)
 
    , ((i , xK_s), windows $ hideFocused)
    , ((i , xK_r), windows $ restoreLast)
 
    , ((is, xK_n), kill)
    , ((mod1Mask,  xK_F4), kill)
 
    -- LAYOUT MESSAGES
    , ((i , xK_space), cycleThroughLayouts $ cycledLayouts host)
    , ((is, xK_space), sendMessage $ JumpToLayout $ defaultLayout host)
 
    , ((u , xK_n),     sendMessage $ JumpToLayout "NoBorders")
    , ((u , xK_u),     sendMessage $ ToggleStruts)
 
    , ((im, xK_Right), sendMessage Shrink)
    , ((im, xK_Left),  sendMessage Expand)
    , ((im, xK_Down),  sendMessage MirrorShrink)
    , ((im, xK_Up),    sendMessage MirrorExpand)
 
    , ((i , xK_Left),  withFocused $ keysMoveWindow (-300,    0))
    , ((i , xK_Right), withFocused $ keysMoveWindow ( 300,    0))
    , ((i , xK_Up),    withFocused $ keysMoveWindow (   0, -200))
    , ((i , xK_Down),  withFocused $ keysMoveWindow (   0,  200))
    , ((is, xK_Left),  withFocused $ snapMove L Nothing)
    , ((is, xK_Right), withFocused $ snapMove R Nothing)
    , ((is, xK_Up),    withFocused $ snapMove U Nothing)
    , ((is, xK_Down),  withFocused $ snapMove D Nothing)
 
 
    -- SESSION
    , ((i , xK_Delete),    spawn "gnome-session-save --shutdown-dialog")
    , ((is, xK_BackSpace), spawn "gnome-session-save --logout")
    , ((i , xK_BackSpace), killPanels >> restart "xmonad" True)
 
    -- WORKSPACES
    -- Note that I have swapped Y and J in my modified Colemak keyboard layout.
    , ((i , xK_y), doWithWS W.greedyView    Prev EmptyWS)
    , ((is, xK_y), doWithWS shiftView       Prev EmptyWS)
    , ((im, xK_y), doWithWS swapWithCurrent Prev EmptyWS)
 
    , ((i , xK_u), doWithWS W.greedyView    Prev NonEmptyWS)
    , ((is, xK_u), doWithWS shiftView       Prev NonEmptyWS)
    , ((im, xK_u), doWithWS swapWithCurrent Prev NonEmptyWS)
 
    , ((i , xK_i), doWithWS W.greedyView    Next NonEmptyWS)
    , ((is, xK_i), doWithWS shiftView       Next NonEmptyWS)
    , ((im, xK_I), doWithWS swapWithCurrent Next NonEmptyWS)
 
    , ((i , xK_o), doWithWS W.greedyView    Next EmptyWS)
    , ((is, xK_o), doWithWS shiftView       Next EmptyWS)
    , ((im, xK_o), doWithWS swapWithCurrent Next EmptyWS)
 
    , ((i , xK_l), doWithWS shiftView       Next EmptyWS)
    , ((is, xK_l), doWithWS W.shift         Next EmptyWS)
 
    , ((i , xK_7), swapNextScreen')
    , ((i , xK_8), toggleWS)
    , ((i , xK_9), screenWorkspace 0 >>= flip whenJust (windows . W.view)            >> warpToWindow')
    , ((is, xK_9), screenWorkspace 0 >>= flip whenJust (windows . shiftViewUngreedy) >> warpToWindow')
    , ((i , xK_0), screenWorkspace 1 >>= flip whenJust (windows . W.view)            >> warpToWindow')
    , ((is, xK_0), screenWorkspace 1 >>= flip whenJust (windows . shiftViewUngreedy) >> warpToWindow')
    ]
 
-- MOUSE
myMouseBindings _ = M.fromList $
    [ ((mod5Mask,               button1), focusAnd   mouseMoveWindow   $ snapMagicMove (Just 50) (Just 50))
    , ((mod5Mask .|. shiftMask, button1), focusAnd   mouseMoveWindow   $ snapMagicResize [L,R,U,D] (Just 50) (Just 50))
    , ((mod5Mask,               button3), focusAnd   mouseResizeWindow $ snapMagicResize [R,D] (Just 50) (Just 50))
 
    ]
  where
 
    -- | Focus and raise the window before performing a mouse operation.
    focusAnd job1 job2 w = focus w >> windows W.swapMaster >> job1 w >> job2 w
-- }}}
 
-- LAYOUTHOOK {{{
 
myLayoutHook  
    = avoidStruts
    $ smartBorders
    $ withIM (1/5) (Role "gimp-toolbox")
    (   (named "Wide"   $ Mirror       $ ResizableTall 1 (3/40) (2/3) [])
    ||| (named "Tall"   $ reflectHoriz $ ResizableTall 1 (3/40) (4/7) [])
    ||| (named "Mirror"                $ ResizableTall 1 (3/40) (4/7) [])
    ||| (twoAccordion)
    ||| (named "NoBorders" $ noBorders Full)
    )
 
-- }}}
 
-- MANAGEHOOK {{{
 
myManageHook xs = composeAll
    [ floats                 --> doCenterFloat
    , className =? "MPlayer" --> doFloat
    , ignores                --> doIgnore
    , appManageHook apps
    , manageDocks
    ]
  where
    floats = foldr1 (<||>)
        [ checkDialog
        , title     =? "." <&&> ( className =? "" <||> appName =? "." ) 
        , title     =? "VLC media player"
        , className =? "Nautilus" <&&> fmap (not . isSuffixOf " - File Browser") title
        , className =? "Firefox" <&&> fmap (/="Navigator") appName 
        , flip fmap className $ flip elem
            [ "Gnome_swallow"
            , "Gdmsetup"
            , "Xmessage"
            , "Zenity"
            ]
        ]
 
    ignores = foldr1 (<||>)
        [ className =? "Gnome-typing-monitor"
        ]
-- }}}
 
-- HANDLEEVENTHOOK {{{
myHandleEventHook = do
    restoreMinimizedEventHook
    serverModeEventHook' smCommands
-- }}}
 
-- STARTUP HOOK {{{
myStartupHook :: Host -> X ()
myStartupHook host = do
    broadcastMessage $ JumpToLayout $ defaultLayout $ host
    refresh
-- }}}
 
-- LOGHOOK {{{
myLogHook :: Host -> [Handle] -> X ()
myLogHook host pipes = 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
 
    mapM_ (\pipe -> dynamicLogString (myPP host) >>= io . hPutStrLn pipe) pipes
 
-- TODO: refactor
myPP host = defaultPP 
    { ppCurrent         = highlight
    , ppVisible         = pad 2
    -- ppHidden overwrites colors of ppUrgent
    , ppHidden          = pad 6
    , ppHiddenNoWindows = pad 2
    , ppUrgent          = pad 6 . ((dzenColor "#01ce02" "#fcfb03") (adjust " ! ")++) -- temporary solution
    , ppTitle           = pad 2
    , ppLayout          = ifNonDefault host (highlight . adjust)
    , ppWsSep           = ""
    , ppSep             = " "
    , ppSort            = getSortByTag
    , ppOrder           = order
    , ppExtras          = [ labeledPager $ myPP host
                          ]
    } 
  where
 
    -- Ignore the original workspace list and use labeledPager instead.
    order (_:l:t:ws:[]) = (" " ++ ws):l:adjust t:[]
    order xs            = ["Error in order list: " ++ show xs]
 
    -- Hide the layout label when default layout is used.
    ifNonDefault host f s 
        | s == defaultLayout host = ""
        | otherwise               = f s
 
    highlight x = leftIcon ++ dzenColor hilightFG hilightBG x ++ rightIcon
 
    -- Called every time a text string is shown, making the font appear vertically 
    -- aligned with the icons.
    adjust x = "^p(;+2)" ++ x ++ "^p()"
 
    pad w x  = concat ["^p(", show w, ")", x, "^p(", show w, ")"]
-- }}}
 
-- vim: set ft=haskell fdm=marker fdl=1 fdc=4:

[edit] 2 lib/App.hs

-------------------------------------------------------------------------- {{{
-- |
-- Module      :  App
-- Copyright   :  (c) Mads N Noe 2010
-- Maintainer  :  mail (@) madsnoe.dk
-- License     :  as-is
-- 
-- Per application configuration. See MyApps for use.
-- 
-------------------------------------------------------------------------- }}}
 
module App
     ( App (..)
     , AppType (..)
     , nullApp
     , raiseApp
     , jumpToOrRestore
     , hideSummonWindows
     , summonWindow
     , hideFocused
     , restoreLast
     , appManageHook
     , makeKeys
     ) where
 
-- Haskell modules
import Control.Monad (filterM)
import Data.Maybe 
import Data.List
 
-- XMonad modules
import XMonad
import XMonad.Actions.WindowGo
import XMonad.Core
import XMonad.ManageHook (composeAll)
import qualified XMonad.StackSet as W
 
-- Custom modules
import Config
import Utils
 
 
-- | Holds WM related configuration for a given application.
data App = App
    { cmd     :: X ()                 -- ^ Command used to launch the application.
    , appType :: AppType              -- ^ See AppType.
    , query   :: Query Bool           -- ^ Used to identify the windows owned by the application.
    , key     :: (ButtonMask, KeySym) -- ^ Key binding to launch the application. (0,0) if no key
                                      --   binding is associated.
    , icon    :: String               -- ^ Relative path to the XPM icon used by the Pager module.
    , hook    :: Maybe ManageHook     -- ^ Application ManageHook.
    }
 
 
-- | Used when toggling between applications of type Summon.
--   As they are floating, it makes sense to only show one
--   at a time.
instance Eq App where
    (==) App { appType = Summon a _ } 
         App { appType = Summon b _ } = a == b
    _ == _ = False
 
 
data AppType = OpenNew -- ^ Open a new instance of the application each time.
             | JumpTo  -- ^ Jump to the workspace containing the application.
             | Summon  -- ^ Summon the application to the current workspace.
                       --   They are typically floating, and used for 
                       --   "transient" tasks.
                     String -- Identifier.
                     [App]  -- Applications to replace when toggling.
 
 
-- | Default to these settings when entries are omitted.
nullApp = App
    { cmd     = return ()
    , appType = OpenNew
    , query   = return False
    , key     = (0, 0)
    , icon    = defaultIcon
    , hook    = Nothing
    }
 
 
-- Focus an application. How this happens is specified by the application's AppType.
raiseApp App 
    { appType = OpenNew
    , cmd     = c
    }         = c
raiseApp App 
    { appType = JumpTo
    , query   = q
    , cmd     = c
    }         = jumpToOrRestore c q
raiseApp app@App 
    { appType = Summon _ apps
    , query   = q
    }         = summonWindow (filterSummonedApps apps) app
 
 
-- | Raise a window as follows. 
--   If there exists a matching window
--     * that is hidden, shift it to the current workspace.
--     * on the current workspace, hide it.
--     * on another workspace, jump to it.
--   Otherwise launch the application.
--   TODO: This behavior made it impossible to cycle between two windows,
--         as we now hide the current window instead of jumping to the next.
--         I'll have to rethink this one eventually, but as I seldomly need 
--         to cycle between windows of the same app, it is not a big
--         problem at the moment.
jumpToOrRestore c q = flip (ifWindows q) c $ \ws -> withWindowSet $ \s -> dispatch ws s
  where
 
    dispatch ws s = 
        case hidden of
             [] -> jumpToOrHide
             hws -> shiftToCurrent hws
      where
 
        hidden = filter (\w -> fromMaybe "" (W.findTag w s) == hiddenWorkspaceTag) ws
 
        shiftToCurrent hws = mapM_ (windows . W.shiftWin (W.currentTag s)) hws
 
        cws = maybe [] W.integrate $ W.stack $ W.workspace $ W.current s
 
        jumpToOrHide = 
            case cws `intersect` ws of
                 []  -> jumpTo $ W.peek s
                 iws -> mapM_ (windows . W.shiftWin hiddenWorkspaceTag) iws
 
        jumpTo (Just w) | w `elem` ws =
            let (_:y:_) = dropWhile (/=w) $ cycle ws -- cannot fail to match
            in  windows $ W.focusWindow y
        jumpTo _ = windows . W.focusWindow . head $ ws
 
 
-- | Hide all windows on the current workspace of the AppType Summon.
hideSummonWindows :: [App] ->  X ()
hideSummonWindows apps = withWindowSet $ \s -> do
    let ws = (maybe [] W.integrate . W.stack . W.workspace . W.current) s
        sWinsQuery = foldr1 (<||>) $ map query $ filterSummonedApps apps
    sWins <- filterM (runQuery sWinsQuery) ws
    mapM_ (windows . W.shiftWin summonWorkspaceTag) sWins
 
 
-- | Shift the specified app to the current workspace or hide it. 
summonWindow :: [App] -- ^ Apps of type Summon to replace.
             -> App   -- ^ App to summon.
             -> X ()
summonWindow apps app = withWindowSet $ \s -> do
    let ws = (maybe [] W.integrate . W.stack . W.workspace . W.current) s
        q = query app
        o = foldr1 (<||>) $ map query $ filter (app/=) apps
 
    matchingWins <- filterM (runQuery q) ws
    otherWins    <- filterM (runQuery o) ws
 
    case matchingWins of
        (x:_) -> do
            hideSummonWindows apps
        [] -> do
            mapM_ (windows . W.shiftWin summonWorkspaceTag) otherWins
 
            filterAll <- filterM (runQuery (query app)) (W.allWindows s)
            case filterAll of
                (x:_) -> windows $ W.shiftWin (W.currentTag s) x
                []    -> cmd app
 
 
-- | Hide the focused window. A hidden window is placed on a workspace that is
--   treated specially by all other workspace handling commands used.
hideFocused :: WindowSet -> WindowSet
hideFocused = W.shift hiddenWorkspaceTag
 
 
-- | Restore the window that was hidden most recently, like pushing and pulling
--   from a stack.
restoreLast :: WindowSet -> WindowSet
restoreLast s = maybe s (flip (W.shiftWin $ W.currentTag s) s) $ getHidden s
  where
    getHidden s 
        = listToMaybe
        $ maybe [] (W.integrate' . W.stack) 
        $ listToMaybe 
        $ filter (\wsp -> W.tag wsp == hiddenWorkspaceTag) 
        $ W.workspaces s
 
 
-- | Run all the hooks associated with the applications.
appManageHook :: [App] -> ManageHook
appManageHook = composeAll . fmap makeQueriedHook . filter hasHook
  where
    hasHook app = isJust $ hook app
    makeQueriedHook app@App 
        { query = q
        , hook  = Just h
        }       = q --> h
    makeQueriedHook _ = idHook -- never reached
 
 
-- | Generate the keybinding list from a list of Apps.
makeKeys :: [App] -> [((ButtonMask, KeySym), X ())]
makeKeys apps = map makeKey $ filter hasKey apps 
  where
    makeKey app = (key app, raiseApp app)
    hasKey app = key app /= (0, 0)
 
 
filterSummonedApps = filter (isSummonedApp . appType)
  where
    isSummonedApp (Summon _ _) = True
    isSummonedApp _            = False

[edit] 3 lib/BorderColors.hs

{-# LANGUAGE FlexibleContexts #-}
 
-------------------------------------------------------------------------- {{{
-- |
-- Module      :  BorderColors 
-- Copyright   :  (c) Mads N Noe 2010
-- Maintainer  :  mail (@) madsnoe.dk
-- 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

[edit] 4 lib/Commands.hs

-------------------------------------------------------------------------- {{{
-- |
-- Module      :  Commands
-- Copyright   :  (c) Mads N Noe 2010
-- Maintainer  :  mail (@) madsnoe.dk
-- License     :  as-is
-- 
-- Settings for XMonad.Actions.Commands. 
-- 
-------------------------------------------------------------------------- }}}
 
module Commands where 
 
-- Haskell modules
import qualified Data.Map as M
import Data.IORef (IORef)
import Data.List
import Data.Maybe
import System.Exit (exitWith, ExitCode(..) )
 
-- XMonad modules
import XMonad
import XMonad.Actions.Commands hiding (workspaceCommands)
import XMonad.Actions.WindowGo
import qualified XMonad.StackSet as W
 
-- Custom modules
import App
import Config
import DMenu
 
-- | Given a list of command\/action pairs, prompt the user to choose a
--   command and return the corresponding action.
-- runCommand :: [(String, X ())] -> X ()
runCommand = do
  let m = commandMap $ dmenuCommands
  choice <- dmenu (M.keys m)
  fromMaybe (return ()) (M.lookup choice m)
 
-- | Commands for DMenu.
dmenuCommands :: [(String, X ())]
dmenuCommands = 
        [ ("view-summon"        , windows $ W.view summonWorkspaceTag)
        , ("view-hidden"        , windows $ W.view hiddenWorkspaceTag)
        -- , ("restart"           , restart "xmonad" True)
        , ("restart-no-resume" , restart "xmonad" False)
        , ("refresh"           , refresh)
        , ("quit"              , io $ exitWith ExitSuccess)
        ]
 
 
-- | Commands for ServerMode.
--   TODO: integrate with dzen.
smCommands :: X [(String, X ())]
smCommands = do
    wsCmds <- workspaceCommands
    return $ take 10 (cycle wsCmds) ++ otherCommands
  where
 
    otherCommands = 
        [ ("focus-vim" , raiseNext q_vims)
        ]
 
    q_vims = className =? "Gvim" <||> (className =? "XTerm" <&&> fmap (isPrefixOf "vim:") title)
 
-- | Generate a list of commands to switch to.
workspaceCommands :: X [(String, X ())]
workspaceCommands = do
    ws <- asks $ workspaces . config
    return $ map makeEntry ws
  where
    makeEntry w = ("view-" ++ w, windows $ W.view w)
 
-- -- | 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-")]
--                  ]

[edit] 5 lib/Config.hs

-------------------------------------------------------------------------- {{{
-- |
-- Module      :  Config
-- Copyright   :  (c) Mads N Noe 2010
-- Maintainer  :  mail (@) madsnoe.dk
-- License     :  as-is
-- 
-- Static module configuration which I am too lazy to pass around.
--
-------------------------------------------------------------------------- }}}
 
module Config where
 
-- XMonad modules
import XMonad
 
 
-- GUI
 
font         = "Consolas-9:rgba=rgb"
defaultBG    = "#dbdbdb"
defaultFG    = "#000000"
hilightBG    = "#5e8eba"
hilightFG    = "#ffffff"
 
 
-- PANEL
 
wTrayer = 100
wConky  = 140
wHbar   = 280 -- width of piped dzen
height  = "18"
 
hbar    =  "hbar -cmbdt | "
conkyrc = "/home/mntnoe/.conkyrc-dzen"
 
-- KEYS
 
i  = mod5Mask -- (I)SO_LEVEL5_SHIFT
u  = mod4Mask -- S(U)PER
s  = shiftMask
m  = mod1Mask
c  = controlMask
is = i .|. s
im = i .|. m
ic = i .|. c
us = u .|. s
 
-- APP
 
-- | Workspace containing "hidden" windows. Treated specially by workspace handling commands.
hiddenWorkspaceTag :: String
hiddenWorkspaceTag = "H"
 
-- | Workspace containing "summoned" windows. Treated specially by workspace handling commands.
summonWorkspaceTag :: String
summonWorkspaceTag = "S"
 
 
-- ICONS
 
-- | The icons located here are simply 16x16 XPM icons from hicolor, gnome and gnome-colors.
--   TODO: refactor
 
iconPath          = "/home/mntnoe/.xmonad/icons/default/"
hilightIconPath   = "/home/mntnoe/.xmonad/icons/hilight/"
grayIconPath      = "/home/mntnoe/.xmonad/icons/gray/"
 
defaultIcon       = "apps/application-default-icon.xpm"
 
defaultSepIcon    = "^i(/home/mntnoe/.xmonad/icons/default-sep.xpm)"
hilightSepIcon    = "^i(/home/mntnoe/.xmonad/icons/hilight-sep.xpm)"
leftIcon          = "^i(/home/mntnoe/.xmonad/icons/left.xpm)"
rightIcon         = "^i(/home/mntnoe/.xmonad/icons/right.xpm)"

[edit] 6 lib/DMenu.hs

-------------------------------------------------------------------------- {{{
-- |
-- Module      :  DMenu 
-- Copyright   :  (c) Mads N Noe 2010
-- Maintainer  :  mail (@) madsnoe.dk
-- License     :  as-is
-- 
-- DMenu helper functions.
-- 
-------------------------------------------------------------------------- }}}
 
module DMenu (dmenu, dmenuRun) where
 
-- Haskell modules
import Data.List (intercalate)
 
-- XMonad modules
import XMonad
import XMonad.Util.Run
 
-- Custom modules
import Config
import Utils
 
dmenu :: [String] -> X (String)
dmenu opts = run "dmenu" (dmenuArgs "Select:") opts
 
 
-- | Run command in path.
dmenuRun :: X ()
dmenuRun = do_ $ safeSpawn "dmenu_run" $ dmenuArgs "Run:"
 
dmenuArgs :: String -> [String]
dmenuArgs prompt =
    [ "-b"
    , "-fn" , font
    , "-nb" , defaultBG
    , "-nf" , defaultFG
    , "-sb" , hilightBG
    , "-sf" , hilightFG
    , "-p"  , prompt
    ]
 
run :: String -> [String] -> [String] -> X String
run cmd args opts = io $ runProcessWithInput cmd args (unlines opts)

[edit] 7 lib/IM.hs

Skipped, as it is based on Xmonad.Layout.IM and only contains small modifications.

[edit] 8 lib/Layout.hs

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
 
------------------------------------------------------------------------------
-- |
-- Module      :  Layout 
-- Copyright   :  (c) Mads N Noe 2010
-- Maintainer  :  mail (@) madsnoe.dk
-- License     :  as-is
-- 
-- Custom layout algorithms. 
-- 
------------------------------------------------------------------------------
 
module Layout (
    twoAccordion
    ) where
 
-- XMonad modules
import XMonad
import qualified XMonad.StackSet as W
import XMonad.Layout.LimitWindows
 
 
-- Hacked Accordion layout.  Useful for LaTeX editing, where you switch between
-- an editor window and a preview window.  Accordion originally by
-- <glasser (@) mit.edu>.  
twoAccordion = limitSlice 2 TwoAccordion
 
 
data TwoAccordion a = TwoAccordion deriving ( Read, Show )
 
instance LayoutClass TwoAccordion 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"

[edit] 9 lib/MyApps.hs

-------------------------------------------------------------------------- {{{
-- |
-- Module      :  MyApps
-- Copyright   :  (c) Mads N Noe 2010
-- Maintainer  :  mail (@) madsnoe.dk
-- License     :  as-is
-- 
-- Per application configuration. See App.
-- 
-------------------------------------------------------------------------- }}}
 
module MyApps (apps) where
 
-- Haskell modules
import Data.List
 
-- XMonad modules
import XMonad
import XMonad.Hooks.ManageHelpers (doRectFloat, doCenterFloat)
import XMonad.StackSet (RationalRect (RationalRect))
 
-- Custom modules
import App
import Config
import Utils
 
 
apps =
 
    -- Firefox 
    [ nullApp
      { cmd     = spawn "firefox"
      , appType = JumpTo
      , key     = (i, xK_f)
      , query   = className =? "Firefox"
      , icon    = "apps/firefox.xpm"
      }
 
    -- XTerm (new)
    , nullApp
      { cmd     = spawn "xterm"
      , appType = OpenNew
      , key     = (i, xK_x)
      }
 
    -- XTerm (jump)
    , nullApp
      { cmd     = spawn "xterm"
      , appType = JumpTo
      , key     = (i, xK_c)
      , query   = fmap (/="xterm-scratchpad") appName
                  <&&>
                  terminalWithTitle (\t -> not (isPrefixOf "root:" t)
                                        && not (isInfixOf  "emerge" t)
                                        && not (isPrefixOf "vim:" t))
      , icon    = "apps/utilities-terminal.xpm"
      }
 
    -- XTerm (superuser)
    , nullApp
      { query   = terminalWithTitle (\t -> isPrefixOf "root:" t 
                                        || isInfixOf "emerge" t)
      , icon    = "apps/gksu-root-terminal.xpm"
      }
 
    -- Vim
    , nullApp
      { cmd     = spawn "xvim"
      , appType = JumpTo
      , key     = (i, xK_v)
      , query   = ( className =? "XTerm" <&&> fmap (isPrefixOf "vim:" ) title) <||> className =? "Gvim"
      , icon    = "apps/vim.xpm"
      }
 
    -- Scratchpad
    , nullApp
      { cmd     = spawn $ xterm "xterm-scratchpad" "screen -dRRS scratchpad"
      , appType = Summon "scratchpad" apps
      , key     = (i, xK_Return)
      , query   = appName =? "xterm-scratchpad"
      , hook    = Just doCenterFloat
      , icon    = "apps/utilities-terminal.xpm"
      }
 
    -- Emacs
    , nullApp
      { cmd     = spawn "emacs"
      , appType = JumpTo
      , key     = (i, xK_e)
      , query   = className =? "Emacs" <||> fmap (isPrefixOf "emacs:") title
      , icon    = "apps/emacs.xpm"
      }
 
    -- Gmail
    , nullApp
      { cmd     = spawn "prism gmail"
      , appType = Summon "gmail" apps
      , key     = (u, xK_j)
      , query   = q_prism <&&> fmap ("Gmail" `isPrefixOf`) title
      , hook    = Just prismFloat
      , icon    = "apps/gmail.xpm"
      }
 
    -- Google Calendar
    , nullApp
      { cmd     = spawn "prism google.calendar"
      , appType = Summon "gcal" apps
      , key     = (u, xK_k)
      , query   = q_prism <&&> fmap (\ x -> isPrefixOf "madsnoe.dk Calendar" x 
                                         || isPrefixOf "Google Calendar" x) title
      , hook    = Just prismFloat
      , icon    = "apps/google-calendar.xpm"
      }
 
    -- Remember The Milk
    , nullApp
      { cmd     = spawn "prism remember.the.milk"
      , appType = Summon "rtm" apps
      , key     = (u, xK_l)
      , query   = q_prism <&&> fmap (isPrefixOf "Remember The Milk") title
      , hook    = Just prismFloat
      , icon    = "apps/rtm.xpm"
      }
 
    -- Ordbogen.com
    , nullApp
      { cmd     = spawn "prism ordbogen.com"
      , appType = Summon "ordbogen" apps
      , key     = (u, xK_semicolon)
      , query   = let prefix x = isPrefixOf "ordbogen" x || isPrefixOf "Ordbogen" x
                  in  q_prism <&&> fmap prefix title
      , hook    = Just $ doCenterFloat' (4/10) (5/6)
      , icon    = "apps/ordbogen.xpm"
      }
 
    -- Nautilus
    , nullApp
      { cmd     = spawn "nautilus ~"
      , appType = JumpTo
      , key     = (i, xK_d)
      , query   = className =? "Nautilus"
      , icon    = "apps/file-manager.xpm"
      }
 
    -- Eclipse
    , nullApp
      { cmd     = spawn "eclipse"
      , appType = JumpTo
      , key     = (u, xK_g)
      , query   = let eclipse = className =? "Eclipse" 
                      splash  = title =? "." <&&> ( className =? "" <||> appName =? "." ) 
                  in  eclipse <||> splash
      , icon    = "apps/eclipse.xpm"
      }
 
    -- XDvi
    , nullApp
      { query   = className =? "XDvi"
      , icon    = "apps/adobe.pdf.xpm"
      }
 
    -- Xpdf
    , nullApp
      { query   = className =? "Xpdf"
      , icon    = "apps/adobe.pdf.xpm"
      }
 
    -- Evince
    , nullApp
      { query   = className =? "Evince"
      , icon    = "apps/evince.xpm"
      }
 
    -- Acroread
    , nullApp
      { query   = className =? "Acroread"
      , icon    = "apps/adobe-reader.xpm"
      }
 
    -- MPlayer
    , nullApp
      { query   = className =? "MPlayer"
      , icon    = "apps/gnome-mplayer.xpm"
      }
 
    -- VLC
    , nullApp
      { query   = title =? "VLC media player"
      , icon    = "apps/vlc.xpm"
      }
 
    -- Gimp
    , nullApp
    { query     = className =? "Gimp"
    , icon      = "apps/gimp.xpm"
    }
 
    -- OpenOffice
    , nullApp
      { query   = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Writer") title
      , icon    = "apps/ooo-writer.xpm"
      }
 
    -- OpenOffice
    , nullApp
      { query   = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Calc") title
      , icon    = "apps/ooo-calc.xpm"
      }
 
    -- OpenOffice
    , nullApp
      { query   = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Base") title
      , icon    = "apps/ooo-base.xpm"
      }
 
    -- OpenOffice
    , nullApp
      { query   = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Draw") title
      , icon    = "apps/ooo-draw.xpm"
      }
 
    -- OpenOffice
    , nullApp
      { query   = className =? "OpenOffice.org 3.2" <&&> fmap (isSuffixOf "OpenOffice.org Impress") title
      , icon    = "apps/ooo-impress.xpm"
      }
 
    -- OpenOffice
    , nullApp
      { query   = className =? "OpenOffice.org 3.2"
      , icon    = "apps/ooo-gulls.xpm"
      }
 
    -- VirtualBox
    , nullApp
      { query   = className =? "VirtualBox"
      , icon    = "apps/vmware.xpm"
      }
 
    -- XChat
    , nullApp
      { query   = className =? "Xchat"
      , icon    = "apps/xchat-gnome.xpm"
      }
 
 
    -- Gnucash
    , nullApp
      { appType = JumpTo
      , query   = className =? "Gnucash"
      , icon    = "apps/gnucash-icon.xpm"
      }
 
 
    -- Audacity
    , nullApp
      { cmd     = spawn "audacity"
      , appType = JumpTo
      , query   = className =? "Audacity"
      , icon    = "apps/audacity.xpm"
      }
 
 
    -- Gnome-session
    , nullApp
 
      { query   = className =? "Gnome-session"
      , icon    = "apps/gnome-shutdown.xpm"
      }
 
 
    -- Rhythmbox
    , nullApp
      { query   = className =? "Rhythmbox"
      , icon    = "apps/rhythmbox.xpm"
      }
 
 
-- MARK --
 
    ]
 
 
-- Auxiliary functions
 
terminalWithTitle p = className =? "XTerm" <&&> fmap p title
 
q_typing_mon  = className =? "Gnome-typing-monitor"
q_nautilus_f  = className =? "Nautilus" <&&> fmap (not . isSuffixOf " - File Browser") title
q_eclipse_spl = title     =? "." <&&> ( className =? "" <||> appName =? "." )
q_prism       = className =? "Prism"
q_xterms      = className =? "XTerm"
 
prismFloat         = doCenterFloat' (8/10) (5/6)
doCenterFloat' w h = doRectFloat $ RationalRect ((1 - w)/2) ((1 - h)/2) w h

[edit] 10 lib/Pager.hs

------------------------------------------------------------------------------
-- |
-- Module      :  Pager 
-- Copyright   :  (c) Mads N Noe 2010
-- Maintainer  :  mail (@) madsnoe.dk
-- License     :  as-is
-- 
-- A pager for DynamicLog showing an for each window on each workspace.
-- TODO: Gets slow when there are many windows. Optimize! Not a problem
--       for casual use however.
-- 
------------------------------------------------------------------------------
 
module Pager (
    labeledPager
  ) where
 
-- XMonad modules
import XMonad
import Data.Char (toLower)
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
 
-- Custom modules
import App
import Config
import MyApps
import Utils
 
-- | The 'DynamicLog' logger to add to 'ppExtras' using the given pretty
--   printer and window label map.
labeledPager :: PP -> X (Maybe String)
labeledPager pp = do
    s       <- gets windowset
    urgents <- readUrgents
    sort'   <- ppSort pp
    wl      <- queryWindows s windowLabelMap
    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 ws) pp $ print path ws
      where
        path
            | W.tag ws == this               = hilightIconPath
            | W.tag ws == summonWorkspaceTag = grayIconPath
            | W.tag ws == hiddenWorkspaceTag = grayIconPath
            | otherwise                      = iconPath
 
    printer ws
        | 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
 
    print path ws = printWindows path wl (W.integrate' $ W.stack ws)
 
-- | 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 :: String              -- ^ icon path
             -> M.Map Window String -- ^ window to symbol map
             -> [Window]            -- ^ windows on the workspace
             -> String
printWindows path wl ws = handleEmpty $ intercalate (icon path "sep.xpm") $ map (\w -> icon path $ fromMaybe defaultIcon (M.lookup w wl)) ws
  where
 
    icon path i = "^i(" ++ path ++ i ++ ")"
 
    handleEmpty "" = "^ro(6x6)"
    handleEmpty 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, defaultIcon)
    qw ((l, q):lqs) w = runQuery q w >>= if_ (return (w, l)) (qw lqs w)
 
 
-- | Map windows to symbols for the pager.  Symbols for floating windows are in
--   lower case.
windowLabelMap :: [(String, Query Bool)]
windowLabelMap =
    map whenFloat windows ++ windows
  where
 
    whenFloat (l, q) = (map toLower l, isFloat <&&> q)
 
    windows = zip (map icon apps) (map query apps)

[edit] 11 lib/Panel.hs

------------------------------------------------------------------------------
-- |
-- Module      :  Dzen
-- Copyright   :  (c) Mads N Noe 2010
-- Maintainer  :  mail (@) madsnoe.dk
-- License     :  as-is
--
-- Functions for spawning dzen instances.
--
------------------------------------------------------------------------------
 
module Panel
    ( spawnPanels
    , killPanels
    , getScreenCount
    ) 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
import Graphics.X11.Xinerama
import XMonad
import XMonad.Util.Run(spawnPipe)
 
-- Custom modules
import Config
import Utils
 
-- | Run before each restart of xmonad to ensure that there
--   will only be the expected panel instances running.
killPanels :: X ()
killPanels = do
    spawn' "killall conky-cli"
    spawn' "killall hbar"
    spawn' "killall trayer"
    return ()
 
-- | Spawn the applications that make the upper panel.
spawnPanels :: IO ([Handle])
spawnPanels = do
    count <- getScreenCount'
    pipes <- mapM (spawnDzenOnScreen count) [0..count-1]
    spawnTrayer
    return pipes
 
spawnTrayer = spawn' $ intercalate " "
    [ "trayer"
    , "--edge"            , "top"
    , "--align"           , "right"
    , "--widthtype"       , "pixel"
    , "--width"           , show wTrayer
    , "--heighttype"      , "pixel"
    , "--height"          , height
    , "--margin"          , show $ wHbar + wConky
    , "--transparent"     , "true"
    , "--alpha"           , "0"
    , "--tint"            , convert $ defaultBG
    , "--SetDockType"     , "true"
    , "--SetPartialStrut" , "true"
    , "--expand"          , "true"
    ]
  where
    convert ('#':xs) = '0':'x':xs
    convert xs = xs
 
-- | spawn' two dzen instances at the top of the screen, reading input
--   from xmonad and hbar respectively.
spawnDzenOnScreen count screen = do
 
    -- Unfortunately, only one instance of trayer is allowed.
    let wTrayerMaybe = if screen == count - 1 then wTrayer else 0
 
    (sx, sy, sw, sh) <- getScreenDim screen
    pipes <- spawnPipe $ dzen
        sy              -- vertical position
        sx              -- horizontal position
        (sw - wHbar - wTrayerMaybe - wConky) -- horizontal width
        'l'             -- text align
        ""              -- no actions
    spawnDzenWithConky $ dzen
            sy          -- vertical position
            (sx + sw - wHbar - wConky)  -- horizontal position
            wConky      -- horizontal width
            'r'         -- text align
            ""          -- no actions
    spawn' $ hbar ++ dzen
        sy              -- vertical position
        (sx + sw - wHbar)  -- horizontal position
        wHbar              -- horizontal width
        'r'             -- text align
        ""              -- no actions
    return pipes
 
  where
    spawnDzenWithConky dest =
        fileExist conkyrc >>=
            (flip when $ do_ $ spawn' $ dzenWithConky conkyrc dest)
 
    dzenWithConky conkyrc dest = intercalate " " ["conky-cli -c", conkyrc, "|", dest]
 
 
-- | Return a string that launches dzen with the given configuration.
dzen :: Num a => a           -- ^ vertical position
              -> a           -- ^ horizontal position
              -> a           -- ^ horizontal width
              -> Char        -- ^ text align
              -> String      -- ^ actions
              -> String
dzen y x w ta e =
        intercalate " "
            [ "dzen2"
            , "-x"  , show x
            , "-w"  , show w
            , "-y"  , show y
            , "-h"  , height
            , "-fn" , quote font
            , "-bg" , quote defaultBG
            , "-fg" , quote defaultFG
            , "-ta" , [ta]
            , "-e"  , quote e
            ]
 
-- | Get the number of available screens.
getScreenCount :: Num a => X a
getScreenCount = io getScreenCount'
 
getScreenCount' :: Num a => IO a
getScreenCount' = do
    d <- openDisplay ""
    screens  <- getScreenInfo d
    return $ fromIntegral $ length screens
 
-- | Return the dimensions (x, y, width, height) of screen n.
getScreenDim :: Num a => Int -> IO (a, a, a, a)
getScreenDim n = do
    d <- openDisplay ""
    screens  <- getScreenInfo d
    closeDisplay d
    let rn = screens!!(min (abs n) (length screens - 1))
    case screens of
        []        -> return $ (0, 0, 1024, 768) -- fallback
        [r]       -> return $ (fromIntegral $ rect_x r , fromIntegral $ rect_y r , fromIntegral $ rect_width r , fromIntegral $ rect_height r )
        otherwise -> return $ (fromIntegral $ rect_x rn, fromIntegral $ rect_y rn, fromIntegral $ rect_width rn, fromIntegral $ rect_height rn)
 
-- | Run the command in the background, ensuring that the
--   value returned is always 0. This is to avoid making
--   spawn break a sequence of commands due to a return
--   value indicating that an error has occured.
spawn' x = spawn $ x ++ "&"

[edit] 12 lib/Utils.hs

------------------------------------------------------------------------------
-- |
-- Module      :  Utils
-- Copyright   :  (c) Mads N Noe 2010
-- Maintainer  :  mail (@) madsnoe.dk
-- License     :  as-is
-- 
-- Utility functions for XMonad.
-- 
------------------------------------------------------------------------------
 
module Utils where
 
-- Haskell modules
import Control.Concurrent.MVar
import Control.Monad (unless, when, liftM)
import Control.Monad.Trans (lift)
import Data.List
import Data.Monoid (Endo(Endo))
import System.IO.Error (isDoesNotExistError)
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Unistd(getSystemID, nodeName)
import qualified Data.Map as M
 
-- XMonad modules
import XMonad
import XMonad.Actions.CycleWS
import XMonad.Actions.Warp (warpToWindow)
import XMonad.Actions.WindowGo
import XMonad.Hooks.DynamicHooks (oneShotHook)
import XMonad.Hooks.FloatNext
import XMonad.Layout.IndependentScreens
import qualified XMonad.StackSet as W
 
-- Other moduls
import Graphics.X11.Xinerama
import Graphics.X11.Xlib.Extras
 
 
-- GENERAL
 
-- | Perform k x if x return a 'Just' value.
(?+) :: (Monad m) => m (Maybe a) -> (a -> m ()) -> m ()
x ?+ k = x >>= maybe (return ()) k
infixl 1 ?+
 
-- | Helper function for use with monads.
if_ :: t -> t -> Bool -> t
if_ t f c = if c 
                  then t
                  else f
 
-- | Change type to "m ()"
do_ :: (Monad m) => m a -> m ()
do_ x = x >> return ()
 
quote :: String -> String
quote x = "'" ++ x ++ "'"
 
 
-- WINDOW ACTIONS
 
-- | 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)
 
-- spawnOnThisWS :: GHC.IOBase.IORef XMonad.Hooks.DynamicHooks.DynamicHooks-> Query Bool-> String-> X ()
spawnOnThisWS dhr q cmd = withWindowSet $ \ws -> do
    oneShotHook dhr q $ doF $ W.shift $ W.currentTag ws
    spawn cmd
 
-- | Warp the mouse pointer to the focused window only if the workspace has
--   no floating windows to steal the focus.
warpToWindow' = withWindowSet $ \ws -> do
    let floats  = M.keys $ W.floating ws
        visible = W.integrate' $ W.stack $ W.workspace $ W.current ws
        vf      = floats `intersect` visible
    when (null vf) $ warpToWindow (1/2) (1/2)
 
 
-- QUERIES ETC
 
-- | 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)
 
-- | Helper to read a property
-- getProp :: Atom -> Window -> X (Maybe [CLong])
getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w
 
-- | Check if window is DIALOG window
checkDialog :: Query Bool
checkDialog = ask >>= \w -> liftX $ do
                a <- getAtom "_NET_WM_WINDOW_TYPE"
                dialog <- getAtom "_NET_WM_WINDOW_TYPE_DIALOG"
                mbr <- getProp a w
                case mbr of
                  Just [r] -> return $ elem (fromIntegral r) [dialog]
                  _ -> return False
 
-- | Determine the number of physical screens.
countScreens :: (MonadIO m, Integral i) => m i
countScreens = liftM genericLength . liftIO $ openDisplay "" >>= getScreenInfo
 
 
-- HOST
 
-- | For use in cross host configutions.
data Host = Laptop | Netbook deriving Eq
 
-- | Determine the host.
getHost = do 
    host <- getSystemID
    case nodeName host of
         "mntnoe-laptop"  -> return Laptop
         "mntnoe-netbook" -> return Netbook
         _                -> return Laptop
 
 
-- MISC
 
-- | 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, "'"]

[edit] 13 lib/Workspace.hs

------------------------------------------------------------------------------
-- |
-- Module      :  Workspace 
-- Copyright   :  (c) Mads N Noe 2010
-- Maintainer  :  mail (@) madsnoe.dk
-- License     :  as-is
-- 
-- Workspace actions.
-- 
------------------------------------------------------------------------------
 
module Workspace where
 
-- Haskell modules
import Data.Maybe ( isNothing, isJust )
 
-- XMonad modules
import XMonad
import XMonad.Actions.CycleWS
import XMonad.Util.WorkspaceCompare (getSortByTag)
import qualified XMonad.StackSet as W
 
-- Custom modules
import App
import Config
import Utils
 
-- | Shift a window to a workspace and switch to that workspace in one
--   operation.
shiftView :: WorkspaceId -> WindowSet -> WindowSet
shiftView id ws = shiftView' id ws
  where
    shiftView' id ws = W.greedyView id $ W.shift id ws
 
shiftViewUngreedy id ws = shiftView' id ws
  where
    shiftView' id ws = W.view id $ W.shift id ws
 
-- | Perform a workspace transformation on the next workspace in 'WSDirection'
--   of type 'WSType'.
doWithWS :: (String -> (WindowSet -> WindowSet)) -> Direction1D -> WSType -> X ()
doWithWS f dir wstype = do
    i <- findWorkspace getSortByTag dir (WSIs pred) 1
    windows $ f i
  where
    pred = do
        hidden <- isHidden
        return $ (\ws -> notSummon ws && notHidden ws && isWsType ws && hidden ws)
 
    notSummon ws = W.tag ws /= (summonWorkspaceTag)
    notHidden ws = W.tag ws /= (hiddenWorkspaceTag)
 
    isWsType ws = wsTypeToPred wstype ws
 
    wsTypeToPred EmptyWS    = isNothing . W.stack
    wsTypeToPred NonEmptyWS = isJust . W.stack
    wsTypeToPred _          = const False
 
    isHidden = do
        hs <- gets (map W.tag . W.hidden . windowset)
        return (\ws -> W.tag ws `elem` hs)
 
-- | Swap workspace contents with next screen and focus it. Useful when you work on
--   a laptop with an external screen and keyboard, and want to switch between them.
swapNextScreen' :: X ()
swapNextScreen' = do 
    ws <- gets windowset
    screenWorkspace (nextScreen ws) ?+ windows . swap (W.currentTag ws)
 
  where
 
    nextScreen ws = (W.screen (W.current ws) + 1) 
                    `mod` 
                    fromIntegral (length (W.screens ws))
 
    swap f t = W.view f . W.greedyView t