diff --git a/bin/xmonad.hs b/bin/xmonad.hs index f9b1eaf..67dcec7 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -2,6 +2,9 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiWayIf #-} +-------------------------------------------------------------------------------- +-- | XMonad binary + module Main (main) where import Control.Concurrent @@ -82,7 +85,8 @@ main = do , focusedBorderColor = T.selectedBordersColor } --- | Multithread setup +-------------------------------------------------------------------------------- +-- | Concurrency configuration data ThreadState = ThreadState { client :: Client @@ -96,11 +100,13 @@ runCleanup ts = io $ do mapM_ killPID $ childPIDs ts stopXMonadService $ client ts +-------------------------------------------------------------------------------- -- | Startuphook configuration myStartupHook :: X () myStartupHook = docksStartupHook <+> startupHook def +-------------------------------------------------------------------------------- -- | Workspace configuration myWorkspaces :: [WorkspaceId] @@ -176,6 +182,7 @@ allDWs = [ xsaneDynamicWorkspace , steamDynamicWorkspace ] +-------------------------------------------------------------------------------- -- | Layout configuration myLayouts = onWorkspace (dwTag wmDynamicWorkspace) vmLayout @@ -205,6 +212,8 @@ myLayouts = onWorkspace (dwTag wmDynamicWorkspace) vmLayout $ addTopBar $ Tall 1 0.025 0.8 +-- | Make a new empty layout and add a message to show/hide it. This is useful +-- for quickly showing conky. data EmptyLayout a = EmptyLayout deriving (Show, Read) @@ -221,12 +230,15 @@ instance Transformer HIDE Window where runHide :: X () runHide = sendMessage $ Toggle HIDE +-------------------------------------------------------------------------------- -- | Loghook configuration --- The format will be like "[<1> 2 3] 4 5 | LAYOUT" where each digit --- is the workspace and LAYOUT is the current layout. Each workspace --- in the brackets is currently visible and the order reflects the --- physical location of each screen. The "<>" is the workspace --- that currently has focus +-- +-- The format will be like "[<1> 2 3] 4 5 | LAYOUT (N)" where each digit is the +-- workspace and LAYOUT is the current layout. Each workspace in the brackets is +-- currently visible and the order reflects the physical location of each +-- screen. The "<>" is the workspace that currently has focus. N is the number +-- of windows on the current workspace. + myLoghook :: Handle -> X () myLoghook h = withWindowSet $ io . hPutStrLn h . myWindowSetXinerama @@ -270,6 +282,7 @@ compareXCoord s0 s1 = compare x0 x1 (_, Rectangle x0 _ _ _) = getScreenIdAndRectangle s0 (_, Rectangle x1 _ _ _) = getScreenIdAndRectangle s1 +-------------------------------------------------------------------------------- -- | Managehook configuration myManageHook :: ManageHook @@ -293,11 +306,13 @@ manageApps = composeOne $ concatMap dwHook allDWs ++ , (className =? "Zotero" <&&> resource =? "Toplevel") -?> doFloat ] +-------------------------------------------------------------------------------- -- | Eventhook configuration myEventHook :: Event -> X All myEventHook = xMsgEventHook <+> docksEventHook <+> handleEventHook def +-- | React to ClientMessage events from concurrent threads xMsgEventHook :: Event -> X All xMsgEventHook ClientMessageEvent { ev_message_type = t, ev_data = d } | t == bITMAP = do @@ -308,6 +323,7 @@ xMsgEventHook ClientMessageEvent { ev_message_type = t, ev_data = d } return (All True) xMsgEventHook _ = return (All True) +-------------------------------------------------------------------------------- -- | Keymap configuration myModMask :: KeyMask diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs index a625f6e..c9934a8 100644 --- a/lib/XMonad/Internal/Command/DMenu.hs +++ b/lib/XMonad/Internal/Command/DMenu.hs @@ -1,3 +1,6 @@ +-------------------------------------------------------------------------------- +-- | Dmenu (Rofi) Commands + module XMonad.Internal.Command.DMenu ( runCmdMenu , runAppMenu @@ -25,17 +28,18 @@ import XMonad.StackSet import XMonad.Util.NamedActions import XMonad.Util.Run --- | Focus rofi on the current workspace always --- Apparently xrandr and xinerama order monitors differently, which --- means they have different indices. Since rofi uses the former and --- xmonad uses the latter, this function is to figure out the xrandr --- screen name based on the xinerama screen that is currently in --- focus. The steps to do this: +-------------------------------------------------------------------------------- +-- | Fix rofi screen indexing limitations +-- +-- Apparently xrandr and xinerama order monitors differently, which means they +-- have different indices. Since rofi uses the former and xmonad uses the +-- latter, these functions is to figure out the xrandr screen name based on the +-- xinerama screen that is currently in focus. The steps to do this: -- 1) get the coordinates of the currently focuses xinerama screen -- 2) get list of Xrandr outputs and filter which ones are connected --- 3) match the coordinates of the xinerama screen with the xrandr --- output and return the latter's name (eg "DP-0") which can be --- fed to Rofi +-- 3) match the coordinates of the xinerama screen with the xrandr output and +-- return the latter's name (eg "DP-0") which can be fed to Rofi + getMonitorName :: X (Maybe String) getMonitorName = do dpy <- asks display @@ -68,9 +72,25 @@ getMonitorName = do getFocusedScreen :: X Rectangle getFocusedScreen = withWindowSet $ return . screenRect . screenDetail . current +-------------------------------------------------------------------------------- +-- | Other internal functions + myDmenuCmd :: String myDmenuCmd = "rofi" +spawnDmenuCmd :: String -> [String] -> X () +spawnDmenuCmd cmd args = do + name <- getMonitorName + case name of + Just n -> spawnCmd cmd $ ["-m", n] ++ args + Nothing -> io $ putStrLn "fail" + +spawnDmenuCmd' :: [String] -> X () +spawnDmenuCmd' = spawnDmenuCmd myDmenuCmd + +-------------------------------------------------------------------------------- +-- | Exported Commands + runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction runShowKeys x = addName "Show Keybindings" $ do name <- getMonitorName @@ -90,16 +110,6 @@ runShowKeys x = addName "Show Keybindings" $ do , "'#element.selected.normal { background-color: #a200ff; }'" ] -spawnDmenuCmd :: String -> [String] -> X () -spawnDmenuCmd cmd args = do - name <- getMonitorName - case name of - Just n -> spawnCmd cmd $ ["-m", n] ++ args - Nothing -> io $ putStrLn "fail" - -spawnDmenuCmd' :: [String] -> X () -spawnDmenuCmd' = spawnDmenuCmd myDmenuCmd - runCmdMenu :: X () runCmdMenu = spawnDmenuCmd' ["-show", "run"] diff --git a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs index 90e852e..39d1b6d 100644 --- a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs +++ b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs @@ -1,10 +1,11 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +-------------------------------------------------------------------------------- +-- | Concurrent module to handle events from acpid + module XMonad.Internal.Concurrent.ACPIEvent - ( ACPIEvent(..) - , isDischarging - , runPowermon + ( runPowermon , handleACPI ) where @@ -24,6 +25,12 @@ import XMonad.Core import XMonad.Internal.Command.Power import XMonad.Internal.Concurrent.ClientMessage +-------------------------------------------------------------------------------- +-- | Data structure to hold the ACPI events I care about +-- +-- Enumerate so these can be converted to strings and back when sent in a +-- ClientMessage event to X + data ACPIEvent = Power | Sleep | LidClose @@ -39,9 +46,11 @@ instance Enum ACPIEvent where fromEnum Sleep = 1 fromEnum LidClose = 2 -sendACPIEvent :: ACPIEvent -> IO () -sendACPIEvent = sendXMsg ACPI . show . fromEnum +-------------------------------------------------------------------------------- +-- | Internal functions +-- | Convert a string to an ACPI event (this string is assumed to come from +-- the acpid socket) parseLine :: ByteString -> Maybe ACPIEvent parseLine line = case splitLine line of @@ -54,6 +63,10 @@ parseLine line = where splitLine = C.words . C.reverse . C.dropWhile (== '\n') . C.reverse +-- | Send an ACPIEvent to the X server as a ClientMessage +sendACPIEvent :: ACPIEvent -> IO () +sendACPIEvent = sendXMsg ACPI . show . fromEnum + isDischarging :: IO (Maybe Bool) isDischarging = do status <- try $ readFile "/sys/class/power_supply/BAT0/status" @@ -62,6 +75,11 @@ isDischarging = do Left _ -> return Nothing Right s -> return $ Just (s == "Discharging") +-------------------------------------------------------------------------------- +-- | Exported API + +-- | Spawn a new thread that will listen for ACPI events on the acpid socket +-- and send ClientMessage events when it receives them runPowermon :: IO () runPowermon = do -- TODO barf when the socket doesn't exist @@ -72,6 +90,8 @@ runPowermon = do out <- S.read s mapM_ sendACPIEvent $ parseLine =<< out +-- | Handle ClientMessage event containing and ACPI event (to be used in +-- Xmonad's event hook) handleACPI :: String -> X () handleACPI tag = do let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent diff --git a/lib/XMonad/Internal/Concurrent/ClientMessage.hs b/lib/XMonad/Internal/Concurrent/ClientMessage.hs index 53c6a98..8d2b4bd 100644 --- a/lib/XMonad/Internal/Concurrent/ClientMessage.hs +++ b/lib/XMonad/Internal/Concurrent/ClientMessage.hs @@ -1,3 +1,20 @@ +-------------------------------------------------------------------------------- +-- | Core ClientMessage module to 'achieve' concurrency in XMonad +-- +-- Since XMonad is single threaded, the only way to have multiple threads that +-- listen/react to non-X events is to spawn other threads the run outside of +-- XMonad and send ClientMessages back to it to be intercepted by the event +-- hook. This module has the core plumbing to make this happen. +-- +-- The clientMessages to be sent will have a defined atom (that hopefully won't +-- do anything) and be sent to the root window. It will include two 'fields', +-- the first of which will represent the 'type' of message sent (meaning the +-- type of non-X event that was intercepted) and the second containing the data +-- pertaining to said event. + +-- TODO come up with a better name than 'XMsg' since it sounds vague and too +-- much like something from X even though it isn't + module XMonad.Internal.Concurrent.ClientMessage ( XMsgType(..) , sendXMsg @@ -12,7 +29,12 @@ import Graphics.X11.Xlib.Display import Graphics.X11.Xlib.Event import Graphics.X11.Xlib.Extras +-------------------------------------------------------------------------------- +-- | Data structure for the ClientMessage +-- -- These are the "types" of client messages to send; add more here as needed + +-- TODO is there a way to do this in the libraries that import this one? data XMsgType = ACPI | Workspace deriving (Eq, Show) @@ -25,6 +47,37 @@ instance Enum XMsgType where fromEnum ACPI = 0 fromEnum Workspace = 1 +-------------------------------------------------------------------------------- +-- | Internal functions + +str2digit :: String -> Time +str2digit = fromIntegral + . sum + . map (\(p, n) -> n * 256 ^ p) + . zip [0 :: Int ..] + . map fromEnum + +-- WORKAROUND: setClientMessageEvent seems to put garbage on the end +-- of the data field (which is probably some yucky c problem I don't +-- understand). Easy solution, put something at the end of the tag to +-- separate the tag from the garbage +garbageDelim :: Char +garbageDelim = '~' + +-------------------------------------------------------------------------------- +-- | Exported API + +-- | Given a string from the data field in a ClientMessage event, return the +-- type and payload +splitXMsg :: (Integral a) => [a] -> (XMsgType, String) +splitXMsg msg = (xtype, tag) + where + xtype = toEnum $ fromInteger $ toInteger $ head msg + tag = filterGarbage $ mapToChr $ drop 5 msg + filterGarbage = filter isAlphaNum . takeWhile (/= garbageDelim) + mapToChr = map (chr . fromInteger . toInteger) + +-- | Emit a ClientMessage event to the X server with the given type and payloud sendXMsg :: XMsgType -> String -> IO () sendXMsg xtype tag = do dpy <- openDisplay "" @@ -44,25 +97,3 @@ sendXMsg xtype tag = do where x = fromIntegral $ fromEnum xtype t = str2digit $ tag ++ [garbageDelim] - -str2digit :: String -> Time -str2digit = fromIntegral - . sum - . map (\(p, n) -> n * 256 ^ p) - . zip [0 :: Int ..] - . map fromEnum - -splitXMsg :: (Integral a) => [a] -> (XMsgType, String) -splitXMsg msg = (xtype, tag) - where - xtype = toEnum $ fromInteger $ toInteger $ head msg - tag = filterGarbage $ mapToChr $ drop 5 msg - filterGarbage = filter isAlphaNum . takeWhile (/= garbageDelim) - mapToChr = map (chr . fromInteger . toInteger) - --- WORKAROUND: setClientMessageEvent seems to put garbage on the end --- of the data field (which is probably some yucky c problem I don't --- understand). Easy solution, put something at the end of the tag to --- separate the tag from the garbage -garbageDelim :: Char -garbageDelim = '~' diff --git a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs index 3c6293c..272ef73 100644 --- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs +++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs @@ -66,7 +66,6 @@ import XMonad.ManageHook import XMonad.Operations import qualified XMonad.StackSet as W - -------------------------------------------------------------------------------- -- | Dynamic Workspace datatype -- This hold all the data needed to tie an app to a particular dynamic workspace @@ -177,15 +176,13 @@ spawnOrSwitch tag cmd = do -- | Managehook -- Move windows to new workspace if they are part of a dynamic workspace -viewShift - :: WorkspaceId -> ManageHook +viewShift :: WorkspaceId -> ManageHook viewShift = doF . liftM2 (.) W.view W.shift -appendViewShift - :: String -> ManageHook +appendViewShift :: String -> ManageHook appendViewShift tag = liftX (appendWorkspace tag) >> viewShift tag --- surprisingly this doesn't exist? +-- TODO surprisingly this doesn't exist? We shouldn't need to TBH doSink :: ManageHook doSink = doF $ \s -> case W.stack $ W.workspace $ W.current s of Just s' -> W.sink (W.focus s') s diff --git a/lib/XMonad/Internal/DBus/Common.hs b/lib/XMonad/Internal/DBus/Common.hs index 50633e3..032c6d2 100644 --- a/lib/XMonad/Internal/DBus/Common.hs +++ b/lib/XMonad/Internal/DBus/Common.hs @@ -1,5 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} +-------------------------------------------------------------------------------- +-- | Common internal DBus functions + module XMonad.Internal.DBus.Common ( callMethod , addMatchCallback @@ -10,16 +13,18 @@ import DBus.Client -- TODO export the bus name (org.xmonad) --- TODO not all methods warrent that we wait for a reply? +-- | Call a method and return its result if successful callMethod :: MethodCall -> IO (Maybe [Variant]) callMethod mc = do client <- connectSession -- TODO handle clienterrors here reply <- call client mc { methodCallDestination = Just "org.xmonad" } + -- TODO not all methods warrent that we wait for a reply? return $ case reply of Left _ -> Nothing Right ret -> Just $ methodReturnBody ret +-- | Bind a callback to a signal match rule addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler addMatchCallback rule cb = do client <- connectSession diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs index 2ed8da6..eb48390 100644 --- a/lib/XMonad/Internal/DBus/Control.hs +++ b/lib/XMonad/Internal/DBus/Control.hs @@ -1,5 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} +-------------------------------------------------------------------------------- +-- | High-level interface for managing XMonad's DBus + module XMonad.Internal.DBus.Control ( Client , startXMonadService diff --git a/lib/XMonad/Internal/DBus/IntelBacklight.hs b/lib/XMonad/Internal/DBus/IntelBacklight.hs index 8d4c25b..02d02f7 100644 --- a/lib/XMonad/Internal/DBus/IntelBacklight.hs +++ b/lib/XMonad/Internal/DBus/IntelBacklight.hs @@ -150,6 +150,7 @@ bodyGetBrightness :: [Variant] -> Maybe Brightness bodyGetBrightness [b] = fromVariant b :: Maybe Brightness bodyGetBrightness _ = Nothing +-------------------------------------------------------------------------------- -- | Exported haskell API exportIntelBacklight :: Client -> IO () diff --git a/lib/XMonad/Internal/Notify.hs b/lib/XMonad/Internal/Notify.hs index 000a91b..9fe7b14 100644 --- a/lib/XMonad/Internal/Notify.hs +++ b/lib/XMonad/Internal/Notify.hs @@ -1,3 +1,11 @@ +-------------------------------------------------------------------------------- +-- | Functions for formatting and sending notifications +-- +-- NOTE I use the DBus.Notify lib even though I don't actually use the DBus for +-- notifications (just formation them into 'notify-send' commands and spawn a +-- shell since that works more consistently with my current commands). If I ever +-- decide to switch to using the DBus it will be easy. + module XMonad.Internal.Notify ( Note(..) , Body(..) @@ -13,6 +21,9 @@ import DBus.Notify import XMonad.Internal.Shell +-------------------------------------------------------------------------------- +-- | Some nice default notes + defNote :: Note defNote = blankNote { summary = "\"xmonad\"" } @@ -24,6 +35,9 @@ defNoteError :: Note defNoteError = defNote { appImage = Just $ Icon "dialog-error-symbolic" } +-------------------------------------------------------------------------------- +-- | Format a 'notify-send' command to be send to the shell + parseBody :: Body -> Maybe String parseBody (Text s) = Just s parseBody _ = Nothing diff --git a/lib/XMonad/Internal/Process.hs b/lib/XMonad/Internal/Process.hs index e57fbc9..76f6592 100644 --- a/lib/XMonad/Internal/Process.hs +++ b/lib/XMonad/Internal/Process.hs @@ -1,5 +1,8 @@ {-# LANGUAGE LambdaCase #-} +-------------------------------------------------------------------------------- +-- | Functions for managing processes + module XMonad.Internal.Process ( waitUntilExit , killPID diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs index ec3a94b..279e5f6 100644 --- a/lib/XMonad/Internal/Shell.hs +++ b/lib/XMonad/Internal/Shell.hs @@ -1,3 +1,6 @@ +-------------------------------------------------------------------------------- +-- | Functions for formatting and spawning shell commands + module XMonad.Internal.Shell ( fmtCmd , spawnCmd @@ -8,12 +11,18 @@ module XMonad.Internal.Shell import XMonad -fmtCmd :: String -> [String] -> String -fmtCmd cmd args = unwords $ cmd : args +-------------------------------------------------------------------------------- +-- | Opening subshell spawnCmd :: String -> [String] -> X () spawnCmd cmd args = spawn $ fmtCmd cmd args +-------------------------------------------------------------------------------- +-- | Formatting commands + +fmtCmd :: String -> [String] -> String +fmtCmd cmd args = unwords $ cmd : args + (#!&&) :: String -> String -> String cmdA #!&& cmdB = cmdA ++ " && " ++ cmdB diff --git a/lib/XMonad/Internal/Theme.hs b/lib/XMonad/Internal/Theme.hs index 175e6dd..40c09c8 100644 --- a/lib/XMonad/Internal/Theme.hs +++ b/lib/XMonad/Internal/Theme.hs @@ -1,3 +1,6 @@ +-------------------------------------------------------------------------------- +-- | Theme for XMonad and Xmobar + module XMonad.Internal.Theme ( baseColor , bgColor @@ -22,7 +25,6 @@ module XMonad.Internal.Theme , promptTheme ) where - import Data.Char import Data.Colour import Data.Colour.SRGB @@ -31,7 +33,8 @@ import Data.List import qualified XMonad.Layout.Decoration as D import qualified XMonad.Prompt as P --- Colors +-------------------------------------------------------------------------------- +-- | Colors - vocabulary roughly based on GTK themes baseColor :: String baseColor = "#f7f7f7" @@ -69,7 +72,8 @@ backdropTextColor = blend' 0.95 fgColor backdropBaseColor backdropFgColor :: String backdropFgColor = blend' 0.75 fgColor bgColor --- Color functions +-------------------------------------------------------------------------------- +-- | Color functions blend' :: Float -> String -> String -> String blend' wt c0 c1 = sRGB24show $ blend wt (sRGB24read c0) (sRGB24read c1) @@ -77,7 +81,8 @@ blend' wt c0 c1 = sRGB24show $ blend wt (sRGB24read c0) (sRGB24read c1) darken' :: Float -> String -> String darken' wt = sRGB24show . darken wt . sRGB24read --- Fonts +-------------------------------------------------------------------------------- +-- | Fonts data Slant = Roman | Italic @@ -130,7 +135,8 @@ font = ThemeFont , pixelsize = Nothing } --- Complete themes +-------------------------------------------------------------------------------- +-- | Complete themes tabbedTheme :: D.Theme tabbedTheme = D.def diff --git a/lib/Xmobar/Plugins/Bluetooth.hs b/lib/Xmobar/Plugins/Bluetooth.hs index 95cf5b8..7c5ade7 100644 --- a/lib/Xmobar/Plugins/Bluetooth.hs +++ b/lib/Xmobar/Plugins/Bluetooth.hs @@ -1,6 +1,11 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +-------------------------------------------------------------------------------- +-- | Bluetooth plugin +-- +-- Use the bluez interface on DBus to check status + module Xmobar.Plugins.Bluetooth (Bluetooth(..)) where import DBus diff --git a/lib/Xmobar/Plugins/IntelBacklight.hs b/lib/Xmobar/Plugins/IntelBacklight.hs index 5083474..b4fd7c4 100644 --- a/lib/Xmobar/Plugins/IntelBacklight.hs +++ b/lib/Xmobar/Plugins/IntelBacklight.hs @@ -1,5 +1,11 @@ {-# LANGUAGE LambdaCase #-} +-------------------------------------------------------------------------------- +-- | Intel backlight plugin +-- +-- Use the custom DBus interface exported by the XMonad process so I can react +-- to signals spawned by commands + module Xmobar.Plugins.IntelBacklight (IntelBacklight(..)) where import Control.Concurrent diff --git a/lib/Xmobar/Plugins/Screensaver.hs b/lib/Xmobar/Plugins/Screensaver.hs index 8ffc868..e4c1a6b 100644 --- a/lib/Xmobar/Plugins/Screensaver.hs +++ b/lib/Xmobar/Plugins/Screensaver.hs @@ -1,5 +1,11 @@ {-# LANGUAGE LambdaCase #-} +-------------------------------------------------------------------------------- +-- | Screensaver plugin +-- +-- Use the custom DBus interface exported by the XMonad process so I can react +-- to signals spawned by commands + module Xmobar.Plugins.Screensaver (Screensaver(..)) where import Control.Concurrent diff --git a/lib/Xmobar/Plugins/VPN.hs b/lib/Xmobar/Plugins/VPN.hs index 60195fa..e833693 100644 --- a/lib/Xmobar/Plugins/VPN.hs +++ b/lib/Xmobar/Plugins/VPN.hs @@ -1,6 +1,11 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +-------------------------------------------------------------------------------- +-- | VPN plugin +-- +-- Use the NetworkManger interface on DBus to check status + module Xmobar.Plugins.VPN (VPN(..)) where import DBus