REF add documentation
This commit is contained in:
parent
16bea08957
commit
9115da9b87
|
@ -2,6 +2,9 @@
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE MultiWayIf #-}
|
{-# LANGUAGE MultiWayIf #-}
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | XMonad binary
|
||||||
|
|
||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
|
@ -82,7 +85,8 @@ main = do
|
||||||
, focusedBorderColor = T.selectedBordersColor
|
, focusedBorderColor = T.selectedBordersColor
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Multithread setup
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Concurrency configuration
|
||||||
|
|
||||||
data ThreadState = ThreadState
|
data ThreadState = ThreadState
|
||||||
{ client :: Client
|
{ client :: Client
|
||||||
|
@ -96,11 +100,13 @@ runCleanup ts = io $ do
|
||||||
mapM_ killPID $ childPIDs ts
|
mapM_ killPID $ childPIDs ts
|
||||||
stopXMonadService $ client ts
|
stopXMonadService $ client ts
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
-- | Startuphook configuration
|
-- | Startuphook configuration
|
||||||
|
|
||||||
myStartupHook :: X ()
|
myStartupHook :: X ()
|
||||||
myStartupHook = docksStartupHook <+> startupHook def
|
myStartupHook = docksStartupHook <+> startupHook def
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
-- | Workspace configuration
|
-- | Workspace configuration
|
||||||
|
|
||||||
myWorkspaces :: [WorkspaceId]
|
myWorkspaces :: [WorkspaceId]
|
||||||
|
@ -176,6 +182,7 @@ allDWs = [ xsaneDynamicWorkspace
|
||||||
, steamDynamicWorkspace
|
, steamDynamicWorkspace
|
||||||
]
|
]
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
-- | Layout configuration
|
-- | Layout configuration
|
||||||
|
|
||||||
myLayouts = onWorkspace (dwTag wmDynamicWorkspace) vmLayout
|
myLayouts = onWorkspace (dwTag wmDynamicWorkspace) vmLayout
|
||||||
|
@ -205,6 +212,8 @@ myLayouts = onWorkspace (dwTag wmDynamicWorkspace) vmLayout
|
||||||
$ addTopBar
|
$ addTopBar
|
||||||
$ Tall 1 0.025 0.8
|
$ 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
|
data EmptyLayout a = EmptyLayout
|
||||||
deriving (Show, Read)
|
deriving (Show, Read)
|
||||||
|
|
||||||
|
@ -221,12 +230,15 @@ instance Transformer HIDE Window where
|
||||||
runHide :: X ()
|
runHide :: X ()
|
||||||
runHide = sendMessage $ Toggle HIDE
|
runHide = sendMessage $ Toggle HIDE
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
-- | Loghook configuration
|
-- | 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
|
-- The format will be like "[<1> 2 3] 4 5 | LAYOUT (N)" where each digit is the
|
||||||
-- in the brackets is currently visible and the order reflects the
|
-- workspace and LAYOUT is the current layout. Each workspace in the brackets is
|
||||||
-- physical location of each screen. The "<>" is the workspace
|
-- currently visible and the order reflects the physical location of each
|
||||||
-- that currently has focus
|
-- screen. The "<>" is the workspace that currently has focus. N is the number
|
||||||
|
-- of windows on the current workspace.
|
||||||
|
|
||||||
myLoghook :: Handle -> X ()
|
myLoghook :: Handle -> X ()
|
||||||
myLoghook h = withWindowSet $ io . hPutStrLn h . myWindowSetXinerama
|
myLoghook h = withWindowSet $ io . hPutStrLn h . myWindowSetXinerama
|
||||||
|
|
||||||
|
@ -270,6 +282,7 @@ compareXCoord s0 s1 = compare x0 x1
|
||||||
(_, Rectangle x0 _ _ _) = getScreenIdAndRectangle s0
|
(_, Rectangle x0 _ _ _) = getScreenIdAndRectangle s0
|
||||||
(_, Rectangle x1 _ _ _) = getScreenIdAndRectangle s1
|
(_, Rectangle x1 _ _ _) = getScreenIdAndRectangle s1
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
-- | Managehook configuration
|
-- | Managehook configuration
|
||||||
|
|
||||||
myManageHook :: ManageHook
|
myManageHook :: ManageHook
|
||||||
|
@ -293,11 +306,13 @@ manageApps = composeOne $ concatMap dwHook allDWs ++
|
||||||
, (className =? "Zotero" <&&> resource =? "Toplevel") -?> doFloat
|
, (className =? "Zotero" <&&> resource =? "Toplevel") -?> doFloat
|
||||||
]
|
]
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
-- | Eventhook configuration
|
-- | Eventhook configuration
|
||||||
|
|
||||||
myEventHook :: Event -> X All
|
myEventHook :: Event -> X All
|
||||||
myEventHook = xMsgEventHook <+> docksEventHook <+> handleEventHook def
|
myEventHook = xMsgEventHook <+> docksEventHook <+> handleEventHook def
|
||||||
|
|
||||||
|
-- | React to ClientMessage events from concurrent threads
|
||||||
xMsgEventHook :: Event -> X All
|
xMsgEventHook :: Event -> X All
|
||||||
xMsgEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
xMsgEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
||||||
| t == bITMAP = do
|
| t == bITMAP = do
|
||||||
|
@ -308,6 +323,7 @@ xMsgEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
||||||
return (All True)
|
return (All True)
|
||||||
xMsgEventHook _ = return (All True)
|
xMsgEventHook _ = return (All True)
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
-- | Keymap configuration
|
-- | Keymap configuration
|
||||||
|
|
||||||
myModMask :: KeyMask
|
myModMask :: KeyMask
|
||||||
|
|
|
@ -1,3 +1,6 @@
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Dmenu (Rofi) Commands
|
||||||
|
|
||||||
module XMonad.Internal.Command.DMenu
|
module XMonad.Internal.Command.DMenu
|
||||||
( runCmdMenu
|
( runCmdMenu
|
||||||
, runAppMenu
|
, runAppMenu
|
||||||
|
@ -25,17 +28,18 @@ import XMonad.StackSet
|
||||||
import XMonad.Util.NamedActions
|
import XMonad.Util.NamedActions
|
||||||
import XMonad.Util.Run
|
import XMonad.Util.Run
|
||||||
|
|
||||||
-- | Focus rofi on the current workspace always
|
--------------------------------------------------------------------------------
|
||||||
-- Apparently xrandr and xinerama order monitors differently, which
|
-- | Fix rofi screen indexing limitations
|
||||||
-- means they have different indices. Since rofi uses the former and
|
--
|
||||||
-- xmonad uses the latter, this function is to figure out the xrandr
|
-- Apparently xrandr and xinerama order monitors differently, which means they
|
||||||
-- screen name based on the xinerama screen that is currently in
|
-- have different indices. Since rofi uses the former and xmonad uses the
|
||||||
-- focus. The steps to do this:
|
-- 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
|
-- 1) get the coordinates of the currently focuses xinerama screen
|
||||||
-- 2) get list of Xrandr outputs and filter which ones are connected
|
-- 2) get list of Xrandr outputs and filter which ones are connected
|
||||||
-- 3) match the coordinates of the xinerama screen with the xrandr
|
-- 3) match the coordinates of the xinerama screen with the xrandr output and
|
||||||
-- output and return the latter's name (eg "DP-0") which can be
|
-- return the latter's name (eg "DP-0") which can be fed to Rofi
|
||||||
-- fed to Rofi
|
|
||||||
getMonitorName :: X (Maybe String)
|
getMonitorName :: X (Maybe String)
|
||||||
getMonitorName = do
|
getMonitorName = do
|
||||||
dpy <- asks display
|
dpy <- asks display
|
||||||
|
@ -68,9 +72,25 @@ getMonitorName = do
|
||||||
getFocusedScreen :: X Rectangle
|
getFocusedScreen :: X Rectangle
|
||||||
getFocusedScreen = withWindowSet $ return . screenRect . screenDetail . current
|
getFocusedScreen = withWindowSet $ return . screenRect . screenDetail . current
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Other internal functions
|
||||||
|
|
||||||
myDmenuCmd :: String
|
myDmenuCmd :: String
|
||||||
myDmenuCmd = "rofi"
|
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 :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
|
||||||
runShowKeys x = addName "Show Keybindings" $ do
|
runShowKeys x = addName "Show Keybindings" $ do
|
||||||
name <- getMonitorName
|
name <- getMonitorName
|
||||||
|
@ -90,16 +110,6 @@ runShowKeys x = addName "Show Keybindings" $ do
|
||||||
, "'#element.selected.normal { background-color: #a200ff; }'"
|
, "'#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 :: X ()
|
||||||
runCmdMenu = spawnDmenuCmd' ["-show", "run"]
|
runCmdMenu = spawnDmenuCmd' ["-show", "run"]
|
||||||
|
|
||||||
|
|
|
@ -1,10 +1,11 @@
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Concurrent module to handle events from acpid
|
||||||
|
|
||||||
module XMonad.Internal.Concurrent.ACPIEvent
|
module XMonad.Internal.Concurrent.ACPIEvent
|
||||||
( ACPIEvent(..)
|
( runPowermon
|
||||||
, isDischarging
|
|
||||||
, runPowermon
|
|
||||||
, handleACPI
|
, handleACPI
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -24,6 +25,12 @@ import XMonad.Core
|
||||||
import XMonad.Internal.Command.Power
|
import XMonad.Internal.Command.Power
|
||||||
import XMonad.Internal.Concurrent.ClientMessage
|
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
|
data ACPIEvent = Power
|
||||||
| Sleep
|
| Sleep
|
||||||
| LidClose
|
| LidClose
|
||||||
|
@ -39,9 +46,11 @@ instance Enum ACPIEvent where
|
||||||
fromEnum Sleep = 1
|
fromEnum Sleep = 1
|
||||||
fromEnum LidClose = 2
|
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 :: ByteString -> Maybe ACPIEvent
|
||||||
parseLine line =
|
parseLine line =
|
||||||
case splitLine line of
|
case splitLine line of
|
||||||
|
@ -54,6 +63,10 @@ parseLine line =
|
||||||
where
|
where
|
||||||
splitLine = C.words . C.reverse . C.dropWhile (== '\n') . C.reverse
|
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 :: IO (Maybe Bool)
|
||||||
isDischarging = do
|
isDischarging = do
|
||||||
status <- try $ readFile "/sys/class/power_supply/BAT0/status"
|
status <- try $ readFile "/sys/class/power_supply/BAT0/status"
|
||||||
|
@ -62,6 +75,11 @@ isDischarging = do
|
||||||
Left _ -> return Nothing
|
Left _ -> return Nothing
|
||||||
Right s -> return $ Just (s == "Discharging")
|
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 :: IO ()
|
||||||
runPowermon = do
|
runPowermon = do
|
||||||
-- TODO barf when the socket doesn't exist
|
-- TODO barf when the socket doesn't exist
|
||||||
|
@ -72,6 +90,8 @@ runPowermon = do
|
||||||
out <- S.read s
|
out <- S.read s
|
||||||
mapM_ sendACPIEvent $ parseLine =<< out
|
mapM_ sendACPIEvent $ parseLine =<< out
|
||||||
|
|
||||||
|
-- | Handle ClientMessage event containing and ACPI event (to be used in
|
||||||
|
-- Xmonad's event hook)
|
||||||
handleACPI :: String -> X ()
|
handleACPI :: String -> X ()
|
||||||
handleACPI tag = do
|
handleACPI tag = do
|
||||||
let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
|
let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
|
||||||
|
|
|
@ -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
|
module XMonad.Internal.Concurrent.ClientMessage
|
||||||
( XMsgType(..)
|
( XMsgType(..)
|
||||||
, sendXMsg
|
, sendXMsg
|
||||||
|
@ -12,7 +29,12 @@ import Graphics.X11.Xlib.Display
|
||||||
import Graphics.X11.Xlib.Event
|
import Graphics.X11.Xlib.Event
|
||||||
import Graphics.X11.Xlib.Extras
|
import Graphics.X11.Xlib.Extras
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Data structure for the ClientMessage
|
||||||
|
--
|
||||||
-- These are the "types" of client messages to send; add more here as needed
|
-- 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
|
data XMsgType = ACPI
|
||||||
| Workspace
|
| Workspace
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
@ -25,6 +47,37 @@ instance Enum XMsgType where
|
||||||
fromEnum ACPI = 0
|
fromEnum ACPI = 0
|
||||||
fromEnum Workspace = 1
|
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 :: XMsgType -> String -> IO ()
|
||||||
sendXMsg xtype tag = do
|
sendXMsg xtype tag = do
|
||||||
dpy <- openDisplay ""
|
dpy <- openDisplay ""
|
||||||
|
@ -44,25 +97,3 @@ sendXMsg xtype tag = do
|
||||||
where
|
where
|
||||||
x = fromIntegral $ fromEnum xtype
|
x = fromIntegral $ fromEnum xtype
|
||||||
t = str2digit $ tag ++ [garbageDelim]
|
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 = '~'
|
|
||||||
|
|
|
@ -66,7 +66,6 @@ import XMonad.ManageHook
|
||||||
import XMonad.Operations
|
import XMonad.Operations
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Dynamic Workspace datatype
|
-- | Dynamic Workspace datatype
|
||||||
-- This hold all the data needed to tie an app to a particular dynamic workspace
|
-- This hold all the data needed to tie an app to a particular dynamic workspace
|
||||||
|
@ -177,15 +176,13 @@ spawnOrSwitch tag cmd = do
|
||||||
-- | Managehook
|
-- | Managehook
|
||||||
-- Move windows to new workspace if they are part of a dynamic workspace
|
-- Move windows to new workspace if they are part of a dynamic workspace
|
||||||
|
|
||||||
viewShift
|
viewShift :: WorkspaceId -> ManageHook
|
||||||
:: WorkspaceId -> ManageHook
|
|
||||||
viewShift = doF . liftM2 (.) W.view W.shift
|
viewShift = doF . liftM2 (.) W.view W.shift
|
||||||
|
|
||||||
appendViewShift
|
appendViewShift :: String -> ManageHook
|
||||||
:: String -> ManageHook
|
|
||||||
appendViewShift tag = liftX (appendWorkspace tag) >> viewShift tag
|
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 :: ManageHook
|
||||||
doSink = doF $ \s -> case W.stack $ W.workspace $ W.current s of
|
doSink = doF $ \s -> case W.stack $ W.workspace $ W.current s of
|
||||||
Just s' -> W.sink (W.focus s') s
|
Just s' -> W.sink (W.focus s') s
|
||||||
|
|
|
@ -1,5 +1,8 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Common internal DBus functions
|
||||||
|
|
||||||
module XMonad.Internal.DBus.Common
|
module XMonad.Internal.DBus.Common
|
||||||
( callMethod
|
( callMethod
|
||||||
, addMatchCallback
|
, addMatchCallback
|
||||||
|
@ -10,16 +13,18 @@ import DBus.Client
|
||||||
|
|
||||||
-- TODO export the bus name (org.xmonad)
|
-- 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 :: MethodCall -> IO (Maybe [Variant])
|
||||||
callMethod mc = do
|
callMethod mc = do
|
||||||
client <- connectSession
|
client <- connectSession
|
||||||
-- TODO handle clienterrors here
|
-- TODO handle clienterrors here
|
||||||
reply <- call client mc { methodCallDestination = Just "org.xmonad" }
|
reply <- call client mc { methodCallDestination = Just "org.xmonad" }
|
||||||
|
-- TODO not all methods warrent that we wait for a reply?
|
||||||
return $ case reply of
|
return $ case reply of
|
||||||
Left _ -> Nothing
|
Left _ -> Nothing
|
||||||
Right ret -> Just $ methodReturnBody ret
|
Right ret -> Just $ methodReturnBody ret
|
||||||
|
|
||||||
|
-- | Bind a callback to a signal match rule
|
||||||
addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler
|
addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler
|
||||||
addMatchCallback rule cb = do
|
addMatchCallback rule cb = do
|
||||||
client <- connectSession
|
client <- connectSession
|
||||||
|
|
|
@ -1,5 +1,8 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | High-level interface for managing XMonad's DBus
|
||||||
|
|
||||||
module XMonad.Internal.DBus.Control
|
module XMonad.Internal.DBus.Control
|
||||||
( Client
|
( Client
|
||||||
, startXMonadService
|
, startXMonadService
|
||||||
|
|
|
@ -150,6 +150,7 @@ bodyGetBrightness :: [Variant] -> Maybe Brightness
|
||||||
bodyGetBrightness [b] = fromVariant b :: Maybe Brightness
|
bodyGetBrightness [b] = fromVariant b :: Maybe Brightness
|
||||||
bodyGetBrightness _ = Nothing
|
bodyGetBrightness _ = Nothing
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
-- | Exported haskell API
|
-- | Exported haskell API
|
||||||
|
|
||||||
exportIntelBacklight :: Client -> IO ()
|
exportIntelBacklight :: Client -> IO ()
|
||||||
|
|
|
@ -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
|
module XMonad.Internal.Notify
|
||||||
( Note(..)
|
( Note(..)
|
||||||
, Body(..)
|
, Body(..)
|
||||||
|
@ -13,6 +21,9 @@ import DBus.Notify
|
||||||
|
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Some nice default notes
|
||||||
|
|
||||||
defNote :: Note
|
defNote :: Note
|
||||||
defNote = blankNote { summary = "\"xmonad\"" }
|
defNote = blankNote { summary = "\"xmonad\"" }
|
||||||
|
|
||||||
|
@ -24,6 +35,9 @@ defNoteError :: Note
|
||||||
defNoteError = defNote
|
defNoteError = defNote
|
||||||
{ appImage = Just $ Icon "dialog-error-symbolic" }
|
{ appImage = Just $ Icon "dialog-error-symbolic" }
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Format a 'notify-send' command to be send to the shell
|
||||||
|
|
||||||
parseBody :: Body -> Maybe String
|
parseBody :: Body -> Maybe String
|
||||||
parseBody (Text s) = Just s
|
parseBody (Text s) = Just s
|
||||||
parseBody _ = Nothing
|
parseBody _ = Nothing
|
||||||
|
|
|
@ -1,5 +1,8 @@
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Functions for managing processes
|
||||||
|
|
||||||
module XMonad.Internal.Process
|
module XMonad.Internal.Process
|
||||||
( waitUntilExit
|
( waitUntilExit
|
||||||
, killPID
|
, killPID
|
||||||
|
|
|
@ -1,3 +1,6 @@
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Functions for formatting and spawning shell commands
|
||||||
|
|
||||||
module XMonad.Internal.Shell
|
module XMonad.Internal.Shell
|
||||||
( fmtCmd
|
( fmtCmd
|
||||||
, spawnCmd
|
, spawnCmd
|
||||||
|
@ -8,12 +11,18 @@ module XMonad.Internal.Shell
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
|
|
||||||
fmtCmd :: String -> [String] -> String
|
--------------------------------------------------------------------------------
|
||||||
fmtCmd cmd args = unwords $ cmd : args
|
-- | Opening subshell
|
||||||
|
|
||||||
spawnCmd :: String -> [String] -> X ()
|
spawnCmd :: String -> [String] -> X ()
|
||||||
spawnCmd cmd args = spawn $ fmtCmd cmd args
|
spawnCmd cmd args = spawn $ fmtCmd cmd args
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Formatting commands
|
||||||
|
|
||||||
|
fmtCmd :: String -> [String] -> String
|
||||||
|
fmtCmd cmd args = unwords $ cmd : args
|
||||||
|
|
||||||
(#!&&) :: String -> String -> String
|
(#!&&) :: String -> String -> String
|
||||||
cmdA #!&& cmdB = cmdA ++ " && " ++ cmdB
|
cmdA #!&& cmdB = cmdA ++ " && " ++ cmdB
|
||||||
|
|
||||||
|
|
|
@ -1,3 +1,6 @@
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Theme for XMonad and Xmobar
|
||||||
|
|
||||||
module XMonad.Internal.Theme
|
module XMonad.Internal.Theme
|
||||||
( baseColor
|
( baseColor
|
||||||
, bgColor
|
, bgColor
|
||||||
|
@ -22,7 +25,6 @@ module XMonad.Internal.Theme
|
||||||
, promptTheme
|
, promptTheme
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.Colour
|
import Data.Colour
|
||||||
import Data.Colour.SRGB
|
import Data.Colour.SRGB
|
||||||
|
@ -31,7 +33,8 @@ import Data.List
|
||||||
import qualified XMonad.Layout.Decoration as D
|
import qualified XMonad.Layout.Decoration as D
|
||||||
import qualified XMonad.Prompt as P
|
import qualified XMonad.Prompt as P
|
||||||
|
|
||||||
-- Colors
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Colors - vocabulary roughly based on GTK themes
|
||||||
|
|
||||||
baseColor :: String
|
baseColor :: String
|
||||||
baseColor = "#f7f7f7"
|
baseColor = "#f7f7f7"
|
||||||
|
@ -69,7 +72,8 @@ backdropTextColor = blend' 0.95 fgColor backdropBaseColor
|
||||||
backdropFgColor :: String
|
backdropFgColor :: String
|
||||||
backdropFgColor = blend' 0.75 fgColor bgColor
|
backdropFgColor = blend' 0.75 fgColor bgColor
|
||||||
|
|
||||||
-- Color functions
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Color functions
|
||||||
|
|
||||||
blend' :: Float -> String -> String -> String
|
blend' :: Float -> String -> String -> String
|
||||||
blend' wt c0 c1 = sRGB24show $ blend wt (sRGB24read c0) (sRGB24read c1)
|
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' :: Float -> String -> String
|
||||||
darken' wt = sRGB24show . darken wt . sRGB24read
|
darken' wt = sRGB24show . darken wt . sRGB24read
|
||||||
|
|
||||||
-- Fonts
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Fonts
|
||||||
|
|
||||||
data Slant = Roman
|
data Slant = Roman
|
||||||
| Italic
|
| Italic
|
||||||
|
@ -130,7 +135,8 @@ font = ThemeFont
|
||||||
, pixelsize = Nothing
|
, pixelsize = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
-- Complete themes
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Complete themes
|
||||||
|
|
||||||
tabbedTheme :: D.Theme
|
tabbedTheme :: D.Theme
|
||||||
tabbedTheme = D.def
|
tabbedTheme = D.def
|
||||||
|
|
|
@ -1,6 +1,11 @@
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Bluetooth plugin
|
||||||
|
--
|
||||||
|
-- Use the bluez interface on DBus to check status
|
||||||
|
|
||||||
module Xmobar.Plugins.Bluetooth (Bluetooth(..)) where
|
module Xmobar.Plugins.Bluetooth (Bluetooth(..)) where
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
|
|
|
@ -1,5 +1,11 @@
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# 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
|
module Xmobar.Plugins.IntelBacklight (IntelBacklight(..)) where
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
|
|
|
@ -1,5 +1,11 @@
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# 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
|
module Xmobar.Plugins.Screensaver (Screensaver(..)) where
|
||||||
|
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
|
|
|
@ -1,6 +1,11 @@
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | VPN plugin
|
||||||
|
--
|
||||||
|
-- Use the NetworkManger interface on DBus to check status
|
||||||
|
|
||||||
module Xmobar.Plugins.VPN (VPN(..)) where
|
module Xmobar.Plugins.VPN (VPN(..)) where
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
|
|
Loading…
Reference in New Issue