REF add documentation

This commit is contained in:
Nathan Dwarshuis 2020-04-01 22:06:00 -04:00
parent 16bea08957
commit 9115da9b87
16 changed files with 203 additions and 66 deletions

View File

@ -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

View File

@ -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"]

View File

@ -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

View File

@ -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 = '~'

View File

@ -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

View File

@ -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

View File

@ -1,5 +1,8 @@
{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- | High-level interface for managing XMonad's DBus
module XMonad.Internal.DBus.Control
( Client
, startXMonadService

View File

@ -150,6 +150,7 @@ bodyGetBrightness :: [Variant] -> Maybe Brightness
bodyGetBrightness [b] = fromVariant b :: Maybe Brightness
bodyGetBrightness _ = Nothing
--------------------------------------------------------------------------------
-- | Exported haskell API
exportIntelBacklight :: Client -> IO ()

View File

@ -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

View File

@ -1,5 +1,8 @@
{-# LANGUAGE LambdaCase #-}
--------------------------------------------------------------------------------
-- | Functions for managing processes
module XMonad.Internal.Process
( waitUntilExit
, killPID

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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