Difference between revisions of "Xmonad/Config archive/adamvo's xmonad.hs"

From HaskellWiki
Jump to navigation Jump to search
(add adamvo's config)
 
(remove xmobarrc: add to a separate page)
Line 1: Line 1:
−  
 
<haskell>
  
<haskell>
 
{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
  
{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
Line 303: Line 302:
 
promptedShift = workspacePrompt defaultXPConfig $ windows . W.shift
  
promptedShift = workspacePrompt defaultXPConfig $ windows . W.shift
 
</haskell>
  
</haskell>
−  
−
XMobarrc:
  
−  
−
<code>
  
−
Config { font = "-*-profont-*-*-*-*-12-*-*-*-*-*-*-*"
  
−
, bgColor = "black"
  
−
, fgColor = "grey"
  
−
, position = Top
  
−
, lowerOnStart = True
  
−
, commands = [ Run Weather "CYKF" ["-t","YKF: <tempC>C","-L","18","-H","25","--normal","green","--high","red","--low","lightblue"] 36000
  
−
, Run Weather "CYYZ" ["-t","YYZ: <tempC>C","-L","18","-H","25","--normal","green","--high","red","--low","lightblue"] 36000
  
−
, Run Network "eth0" ["-L","0","-H","32","--normal","green","--high","red"] 10
  
−
, Run Network "wlan0" ["-L","0","-H","32","--normal","green","--high","red"] 10
  
−
, Run Cpu ["-L","3","-H","50","--normal","green","--high","red"] 10
  
−
, Run Memory ["-t","Mem: <usedratio>%"] 10
  
−
, Run Swap [] 10
  
−
, Run Com "uname" ["-s","-r"] "" 36000
  
−
, Run Date "%a %b %_d %Y %H:%M:%S" "date" 10
  
−
, Run StdinReader
  
−
, Run Battery ["-L","50","-H","75","--high","green","--normal","yellow", "--low", "red"] 10
  
−
, Run Mail [("gmail",".mail/INBOX"),("engmail",".mail/engmail/INBOX"),("xmonad",".mail/lists.xmonad")]
  
−
]
  
−
, sepChar = "%"
  
−
, alignSep = "}{"
  
−
, template = "%StdinReader% }{ <fc=#ff0000>%Mail%</fc> %cpu% | %memory% | %wlan0% | <fc=#ee9a00>%date%</fc> | %battery% "
  
−
}
  
−
</code>
  

Revision as of 21:15, 3 May 2009

{-# OPTIONS_GHC -Wall -fno-warn-missing-signatures #-}
module Main where

import XMonad
import Graphics.X11.ExtraTypes.XF86

import qualified XMonad.StackSet as W
import qualified Data.Map as M

-- Update these with:  ghc -ddump-minimal-imports
import XMonad.Layout.LayoutHints(layoutHints2) -- not in contrib

import Graphics.X11.Xinerama(getScreenInfo)
import Control.Monad(Monad(return, (>>), (>>=)), Functor(..),
                     (=<<), mapM, sequence, zipWithM_)
import Data.List((++), zip, map, concatMap, repeat, zipWith,
                 intercalate, isInfixOf)
import Data.Maybe(catMaybes)
import Data.Ratio((%))
import System.IO(IO, Handle, hPutStrLn)
import Data.Map(M.fromList)
import XMonad.Actions.CycleWS(WSType(NonEmptyWS), WSDirection(..),
                              moveTo, nextWS, prevWS, shiftToNext, shiftToPrev)
import XMonad.Actions.DwmPromote(dwmpromote)
import XMonad.Actions.GridSelect(defaultGSConfig, goToSelected)
import XMonad.Actions.Search(mathworld, wikipedia, multi,
                             promptSearch)
import XMonad.Actions.Submap(submap)
import XMonad.Actions.TopicSpace(Dir, TopicConfig(..), Topic,
                                 (>*>), checkTopicConfig, currentTopicAction, currentTopicDir,
                                 pprWindowSet, switchNthLastFocused, switchTopic)
import XMonad.Hooks.DynamicLog(PP(ppUrgent, ppTitle, ppLayout,
                                  ppVisible, ppHidden, ppCurrent, ppSep),
                               dynamicLogString, defaultPP, xmobarColor, wrap)
import XMonad.Hooks.EwmhDesktops(ewmhDesktopsEventHook,
                                 ewmhDesktopsLogHook)
import XMonad.Hooks.ManageDocks(ToggleStruts(ToggleStruts),
                                avoidStruts, manageDocks)
import XMonad.Hooks.UrgencyHook(NoUrgencyHook(..), withUrgencyHook)
import XMonad.Layout.BoringWindows(boringWindows, focusDown,
                                   focusUp)
import XMonad.Layout.Mosaic(Mosaic(..),
                            Aspect(Wider, Taller, SlopeMod))
import XMonad.Layout.Named(named)
import XMonad.Layout.NoBorders(Ambiguity(Screen), lessBorders, noBorders)
import XMonad.Layout.Simplest(Simplest(..))
import XMonad.Layout.SubLayouts(GroupMsg(UnMergeAll, UnMerge,
                                         MergeAll),
                                defaultSublMap, onGroup, pullGroup, subLayout)
import XMonad.Layout.Tabbed(defaultTheme, addTabs, shrinkText)
import XMonad.Layout.WindowNavigation(Direction(..),
                                      Navigate(Swap, Go), configurableNavigation, navigateColor)
import XMonad.Layout.WorkspaceDir(changeDir, workspaceDir)
import XMonad.Prompt(defaultXPConfig)
import XMonad.Prompt.RunOrRaise(runOrRaisePrompt)
import XMonad.Prompt.Shell(shellPrompt)
import XMonad.Prompt.Ssh(sshPrompt)
import XMonad.Prompt.Window(windowPromptGoto)
import XMonad.Prompt.Workspace(workspacePrompt)
import XMonad.Prompt.XMonad(xmonadPrompt)
import XMonad.Util.EZConfig(additionalKeys)
import XMonad.Util.Run(spawnPipe)

main :: IO ()
main = do
    checkTopicConfig myTopics myTopicConfig
    xmonad . withUrgencyHook NoUrgencyHook . myConfig
        =<< mapM xmobarScreen
        =<< getScreens

myConfig hs = (\x -> additionalKeys x $ myKeys x) $ defaultConfig
    { layoutHook = myLayout
    , focusedBorderColor = "#ff0000"
    , terminal = "urxvt"
    , modMask = mod4Mask
    , logHook = ewmhDesktopsLogHook >> myLogHook hs
    , handleEventHook = ewmhDesktopsEventHook
    , workspaces = myTopics
    , manageHook = manageDocks
        <+> (fmap (isInfixOf "Gran Paradiso") className  --> doShift "web")
    }

-------------------- Layout ----------------------------------
myLayout = workspaceDir "~"
         $ named "M" mosaic ||| named "F" (noBorders Full)
    where
    mosaic = avoidStruts
         $ lessBorders Screen
         $ addTabs shrinkText defaultTheme
         $ configurableNavigation (navigateColor "#ffff00")
         $ boringWindows
         $ subLayout [] (Simplest ||| Tall 1 (1%6) 0.5)
         $ layoutHints2 -- unfinished modifications to layoutHints: ask if you want this
         $ Mosaic [5,4,2,1,1,1]
--------------------------------------------------------------

-------------------- Keys ------------------------------------
myKeys :: XConfig l -> [((KeyMask, KeySym), X ())]
myKeys c@(XConfig { modMask = modm }) =
    [((modm, xK_h), sendMessage . SlopeMod $ zipWith (+) (map (/5) [1..]))
    ,((modm, xK_l), sendMessage . SlopeMod $ (\(x:xs) -> max 1 x:xs) . map (max 0.05) . zipWith subtract (map (/5) [1..]))
    ,((modm .|. shiftMask, xK_h), sendMessage $ SlopeMod init)
    ,((modm .|. shiftMask, xK_l), sendMessage $ SlopeMod (++[1]))

    ,((0, xK_Print), spawn "scrot")
    ,((modm, xK_Return), dwmpromote)
    ,((modm, xK_a), goToSelected defaultGSConfig)

    -- SubLayouts
    ,((modm .|. controlMask, xK_o), withFocused $ sendMessage . UnMerge)
    ,((modm .|. shiftMask .|. controlMask, xK_o), withFocused $ sendMessage . UnMergeAll)
    ,((modm .|. controlMask, xK_m), withFocused $ sendMessage . MergeAll)
    ,((modm .|. controlMask, xK_period), onGroup W.focusDown')
    ,((modm .|. controlMask, xK_comma), onGroup W.focusUp')

    -- Mosaic
    ,((modm, xK_semicolon), sendMessage Taller)
    ,((modm, xK_o), sendMessage Wider)

    -- Submaps
    ,((modm, xK_x), submap . M.fromList $ subMaps)
    ,((modm, xK_s), submap $ defaultSublMap c)

    -- Focus changes
    ,((modm .|. shiftMask, xK_Right), shiftToNext >> nextWS)
    ,((modm .|. shiftMask, xK_Left ), shiftToPrev >> prevWS)
    ,((modm, xK_Right ), moveTo Next NonEmptyWS)
    ,((modm, xK_Left  ), moveTo Prev NonEmptyWS)
    ,((modm, xK_period), moveTo Next NonEmptyWS)
    ,((modm, xK_comma ), moveTo Prev NonEmptyWS)
    ,((modm .|. shiftMask, xK_period), focusDown)
    ,((modm .|. shiftMask, xK_comma ), focusUp)

    ,((modm .|. shiftMask, xK_Return), spawnShell)
    ,((modm .|. shiftMask, xK_a), currentTopicAction myTopicConfig)
    ,((modm, xK_g     ), promptedGoto)
    ,((modm .|. shiftMask, xK_g     ), promptedShift)
    ]
 ++ concatMap (\(m,f) -> lrud (modm .|. m) f)
        [(shiftMask, sendMessage . Swap)
        ,(controlMask,  sendMessage . pullGroup)
        ,(0,  sendMessage . Go)
        ]
 ++ mediaKeys
 ++ [((m .|. modm, key), screenWorkspace sc >>= flip whenJust (windows . f)) |
        (key, sc) <- zip [xK_w, xK_f, xK_p] ([0 .. ]),
        (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
 ++ [ ((modm, k), switchNthLastFocused myTopicConfig i)
    | (i, k) <- zip [1..] [xK_1 .. xK_9]]

-- helper for windowNavigation keys
--    note: with colemak neiu are placed where jkli are with qwerty layout
lrud :: a -> (Direction -> b) -> [((a, KeySym), b)]
lrud m cmd = zip ks cmds
    where
      ks = zip (repeat m) [xK_n,xK_i,xK_u,xK_e]
      cmds = zipWith ($) (repeat cmd) [L,R,U,D]

subMaps :: [((KeyMask, KeySym), X ())]
subMaps = [((0, xK_o), runOrRaisePrompt defaultXPConfig),
           ((0, xK_p), shellPrompt defaultXPConfig),
           ((0, xK_x), xmonadPrompt defaultXPConfig),
           ((0, xK_z), sshPrompt defaultXPConfig),
           ((shiftMask, xK_w), windowPromptGoto defaultXPConfig),
           ((0, xK_w), promptSearch defaultXPConfig wikipedia),
           ((0, xK_s), promptSearch defaultXPConfig multi),
           ((0, xK_m), promptSearch defaultXPConfig mathworld),
           ((0, xK_d), changeDir defaultXPConfig),
           ((0, xK_b), sendMessage ToggleStruts),
           ((0, xK_f), withFocused $ windows . W.sink), ((0, xK_v), refresh),
           ((0, xK_c), asks config >>= spawn . terminal), ((0, xK_k), kill)
           ]

mediaKeys :: [((KeyMask, KeySym), X ())]
mediaKeys = [((0, xF86XK_AudioPlay), spawn "mpc toggle"),
             ((0, xF86XK_AudioStop), spawn "mpc stop"),
             ((0, xF86XK_AudioNext), spawn "mpc next"),
             ((0, xF86XK_AudioPrev), spawn "mpc prev"),
             ((0, xF86XK_AudioMute), spawn "/home/adamvo/bin/ossvol -t"),
             ((shiftMask, xF86XK_AudioMute),        spawn "/home/adamvo/bin/speakers.sh"),
             ((0, xF86XK_AudioLowerVolume),         spawn "/home/adamvo/bin/ossvol -d 1"),
             ((shiftMask, xF86XK_AudioLowerVolume), spawn "/home/adamvo/bin/ossvol -d 0.1"),
             ((0, xF86XK_AudioRaiseVolume),         spawn "/home/adamvo/bin/ossvol -i 1"),
             ((shiftMask, xF86XK_AudioRaiseVolume), spawn "/home/adamvo/bin/ossvol -i 0.1"),
             ((0, xF86XK_Sleep), spawn $ "sudo pm-suspend"),
             ((shiftMask, xF86XK_Sleep), spawn $ "sudo pm-hibernate")]
--------------------------------------------------------------

-------------------- Support for per-screen xmobars ---------
-- Some parts of this will merged into contrib sometime
getScreens :: IO [Int]
getScreens = withDisplay' $ fmap (enumFromTo 0 . pred . length) . getScreenInfo
    where withDisplay' f = do
            x <- openDisplay ""
            res <- f x
            closeDisplay x
            return res

-- | Output to each handle what would be seen when viewing the screen with that
-- index. If the workspace is focused use the first PP, otherwise use the
-- second PP.
multiPP :: PP -> PP -> [Handle] -> X ()
multiPP = multiPP' dynamicLogString

multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
multiPP' dynlStr focusPP unfocusPP handles = do
    state <- get
    let takeLength = zipWith const
        viewWs n = put state { windowset = W.view n $ windowset state }
        focused = W.tag . W.workspace . W.current $ windowset state
        choosePP w = if w == focused then focusPP else unfocusPP
    io . zipWithM_ hPutStrLn handles
            =<< mapM (\w -> viewWs w >> dynlStr (choosePP w)) . catMaybes
            =<< mapM screenWorkspace ([0..] `takeLength` handles)
    put state

mergePPOutputs :: PP -> [PP -> X String] -> X String
mergePPOutputs pp = fmap (intercalate (ppSep pp)) . sequence . map ($ pp)

onlyTitle :: PP -> PP
onlyTitle pp = defaultPP { ppCurrent = const "", ppHidden = const "", ppVisible = const "", ppLayout = ppLayout pp, ppTitle = ppTitle pp }

-- | Requires a recent addition to xmobar (newer than 0.9.2)
xmobarScreen :: Int -> IO Handle
xmobarScreen = spawnPipe . ("xmobar -x " ++) . show

myLogHook hs = multiPP'
    (flip mergePPOutputs [pprWindowSet myTopicConfig,dynamicLogString . onlyTitle])
    myPP { ppTitle = xmobarColor "orange" "" }
    myPP { ppTitle = const "" }
    hs

myPP :: PP
myPP = defaultPP
     { ppCurrent = xmobarColor "white" ""
     , ppSep = " : "
     , ppLayout = xmobarColor "green" ""
     , ppVisible = xmobarColor "white" "" . wrap "(" ")"
     , ppUrgent = xmobarColor "red" "" . ("^"++)}
--------------------------------------------------------------

-------------------- X.Actions.TopicSpace --------------------
myTopics :: [Topic]
myTopics =
  [ "dashboard" -- the first one
  , "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc"
  , "mail", "movie", "music", "talk", "text", "tools", "web", "xmonad"
  , "yi", "documents", "pdf"
  ]

myTopicConfig :: TopicConfig
myTopicConfig = TopicConfig
  { topicDirs = M.fromList $
      [ ("conf", "conf")
      , ("dashboard", "./")
      , ("yi", "wip/dev-haskell/yi")
      , ("darcs", "wip/dev-haskell/darcs")
      , ("haskell", "haskell")
      , ("xmonad", "wip/x11-wm/xmonad")
      , ("tools", "wip/tools")
      , ("movie", "media/movie")
      , ("music", "media/music")
      , ("documents", "doc")
      , ("pdf", "ref")
      ]
  , defaultTopicAction = const $ spawnShell >*> 2
  , defaultTopic = "dashboard"
  , maxTopicHistory = 10
  , topicActions = M.fromList $
      [ ("haskell",    spawnShell >*> 2 >>
                       spawnShellIn "wip/dev-haskell/ghc")
      , ("xmonad",     spawnShellIn "wip/x11-wm/xmonad" >>
                       spawnShellIn "wip/x11-wm/xmonad/contrib" >>
                       spawnShellIn "wip/x11-wm/xmonad/utils" >>
                       spawnShellIn ".xmonad" >>
                       spawnShellIn ".xmonad")
      , ("music",      spawn "urxvt -e ncmpc" >> spawn "urxvt -e ncmpc -h 192.168.1.2")
      , ("mail",       spawn "urxvt -e mutt" >> spawnShell)
      , ("irc",        spawn "urxvt -e ssh aavogt@engage.uwaterloo.ca")
      , ("dashboard",  spawnShell)
      , ("web",        spawn "firefox")
      , ("movie",      spawnShell)
      , ("pdf",        spawn "okular >&| /dev/null")
      ]
  }

-- From the sample config in TopicSpace, these should probably be exported from that module
spawnShell :: X ()
spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn

spawnShellIn :: Dir -> X ()
spawnShellIn dir = asks (terminal . config) >>= \term -> spawn $ "cd " ++ dir ++ " && " ++ term ++ " "

goto :: Topic -> X ()
goto = switchTopic myTopicConfig

promptedGoto :: X ()
promptedGoto = workspacePrompt defaultXPConfig goto

promptedShift :: X ()
promptedShift = workspacePrompt defaultXPConfig  $ windows . W.shift
Retrieved from "https://wiki.haskell.org/index.php?title=Xmonad/Config_archive/adamvo%27s_xmonad.hs&oldid=28096"