REF move DMenu to separate module and clean up main function code
This commit is contained in:
parent
012798c85f
commit
68d83d859f
227
bin/xmonad.hs
227
bin/xmonad.hs
|
@ -3,6 +3,8 @@
|
||||||
|
|
||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
|
import Internal.DMenu
|
||||||
|
|
||||||
import ACPI
|
import ACPI
|
||||||
import DBus.Common
|
import DBus.Common
|
||||||
import DBus.IntelBacklight
|
import DBus.IntelBacklight
|
||||||
|
@ -17,37 +19,27 @@ import WorkspaceMon
|
||||||
import Control.Arrow (first)
|
import Control.Arrow (first)
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
( forM
|
( forM_
|
||||||
, forM_
|
|
||||||
, liftM2
|
, liftM2
|
||||||
, mapM_
|
, mapM_
|
||||||
, void
|
, void
|
||||||
, when
|
, when
|
||||||
)
|
)
|
||||||
|
|
||||||
import Data.List
|
import Data.List (isPrefixOf, sortBy, sortOn)
|
||||||
( find
|
|
||||||
, isPrefixOf
|
|
||||||
, sortBy
|
|
||||||
, sortOn
|
|
||||||
)
|
|
||||||
import qualified Data.Map.Lazy as M
|
import qualified Data.Map.Lazy as M
|
||||||
import Data.Maybe (catMaybes, isJust)
|
import Data.Maybe (isJust)
|
||||||
import Data.Monoid (All (..))
|
import Data.Monoid (All (..))
|
||||||
|
|
||||||
import DBus.Client (Client)
|
|
||||||
|
|
||||||
import Graphics.X11.Types
|
import Graphics.X11.Types
|
||||||
import Graphics.X11.Xlib.Atom
|
import Graphics.X11.Xlib.Atom
|
||||||
import Graphics.X11.Xlib.Extras
|
import Graphics.X11.Xlib.Extras
|
||||||
import Graphics.X11.Xrandr
|
|
||||||
|
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Posix.IO
|
import System.Process
|
||||||
import System.Posix.Process
|
|
||||||
import System.Posix.Types
|
|
||||||
|
|
||||||
import Text.Read (readMaybe)
|
import Text.Read (readMaybe)
|
||||||
|
|
||||||
|
@ -63,36 +55,38 @@ import XMonad.Actions.Warp
|
||||||
import XMonad.Hooks.EwmhDesktops
|
import XMonad.Hooks.EwmhDesktops
|
||||||
import XMonad.Hooks.ManageDocks
|
import XMonad.Hooks.ManageDocks
|
||||||
import XMonad.Hooks.ManageHelpers
|
import XMonad.Hooks.ManageHelpers
|
||||||
-- import XMonad.Layout.LayoutCombinators hiding ((|||))
|
|
||||||
-- import XMonad.Layout.Master
|
|
||||||
import XMonad.Layout.NoBorders
|
import XMonad.Layout.NoBorders
|
||||||
import XMonad.Layout.NoFrillsDecoration
|
import XMonad.Layout.NoFrillsDecoration
|
||||||
import XMonad.Layout.PerWorkspace
|
import XMonad.Layout.PerWorkspace
|
||||||
import XMonad.Layout.Renamed
|
import XMonad.Layout.Renamed
|
||||||
-- import XMonad.Layout.Simplest
|
|
||||||
import XMonad.Layout.Tabbed
|
import XMonad.Layout.Tabbed
|
||||||
import XMonad.Prompt
|
import XMonad.Prompt
|
||||||
import XMonad.Prompt.ConfirmPrompt
|
import XMonad.Prompt.ConfirmPrompt
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
import XMonad.Util.EZConfig
|
import XMonad.Util.EZConfig
|
||||||
import XMonad.Util.NamedActions
|
import XMonad.Util.NamedActions
|
||||||
import XMonad.Util.Run
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
dbClient <- startXMonadService
|
cl <- startXMonadService
|
||||||
(barPID, h) <- spawnPipe' "xmobar"
|
(p, h) <- spawnPipe' "xmobar"
|
||||||
_ <- forkIO runPowermon
|
_ <- forkIO runPowermon
|
||||||
_ <- forkIO runWorkspaceMon'
|
_ <- forkIO $ runWorkspaceMon matchPatterns
|
||||||
|
let ts = ThreadState
|
||||||
|
{ client = cl
|
||||||
|
, childPIDs = [p]
|
||||||
|
, childHandles = [h]
|
||||||
|
}
|
||||||
launch
|
launch
|
||||||
$ ewmh
|
$ ewmh
|
||||||
$ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (mkKeys [barPID] dbClient)
|
$ addKeymap ts
|
||||||
$ def { terminal = myTerm
|
$ def { terminal = myTerm
|
||||||
, modMask = myModMask
|
, modMask = myModMask
|
||||||
, layoutHook = myLayouts
|
, layoutHook = myLayouts
|
||||||
, manageHook = myManageHook <+> manageDocks <+> manageHook def
|
, manageHook = myManageHook
|
||||||
, handleEventHook = myEventHook <+> docksEventHook <+> handleEventHook def
|
, handleEventHook = myEventHook
|
||||||
, startupHook = docksStartupHook <+> startupHook def
|
, startupHook = myStartupHook
|
||||||
, workspaces = myWorkspaces
|
, workspaces = myWorkspaces
|
||||||
, logHook = myLoghook h
|
, logHook = myLoghook h
|
||||||
, clickJustFocuses = False
|
, clickJustFocuses = False
|
||||||
|
@ -101,25 +95,22 @@ main = do
|
||||||
, focusedBorderColor = T.selectedBordersColor
|
, focusedBorderColor = T.selectedBordersColor
|
||||||
}
|
}
|
||||||
|
|
||||||
runWorkspaceMon' :: IO ()
|
myStartupHook :: X ()
|
||||||
runWorkspaceMon' = runWorkspaceMon
|
myStartupHook = docksStartupHook <+> startupHook def
|
||||||
$ fromList [ (myGimpClass, myGimpWorkspace)
|
|
||||||
|
data ThreadState = ThreadState
|
||||||
|
{ client :: Client
|
||||||
|
, childPIDs :: [Pid]
|
||||||
|
, childHandles :: [Handle]
|
||||||
|
}
|
||||||
|
|
||||||
|
matchPatterns :: M.Map String String
|
||||||
|
matchPatterns = fromList
|
||||||
|
[ (myGimpClass, myGimpWorkspace)
|
||||||
, (myVMClass, myVMWorkspace)
|
, (myVMClass, myVMWorkspace)
|
||||||
, (myXSaneClass, myXSaneWorkspace)
|
, (myXSaneClass, myXSaneWorkspace)
|
||||||
]
|
]
|
||||||
|
|
||||||
spawnPipe' :: MonadIO m => String -> m (ProcessID, Handle)
|
|
||||||
spawnPipe' x = io $ do
|
|
||||||
(rd, wr) <- createPipe
|
|
||||||
setFdOption wr CloseOnExec True
|
|
||||||
h <- fdToHandle wr
|
|
||||||
hSetBuffering h LineBuffering
|
|
||||||
p <- xfork $ do
|
|
||||||
_ <- dupTo rd stdInput
|
|
||||||
executeFile "/bin/sh" False ["-c", x] Nothing
|
|
||||||
closeFd rd
|
|
||||||
return (p, h)
|
|
||||||
|
|
||||||
myWorkspaces :: [String]
|
myWorkspaces :: [String]
|
||||||
myWorkspaces = map show [1..10 :: Int]
|
myWorkspaces = map show [1..10 :: Int]
|
||||||
|
|
||||||
|
@ -201,7 +192,10 @@ moveBottom :: W.StackSet i l a s sd -> W.StackSet i l a s sd
|
||||||
moveBottom = W.modify' $ \(W.Stack f t b) -> W.Stack f (reverse b ++ t) []
|
moveBottom = W.modify' $ \(W.Stack f t b) -> W.Stack f (reverse b ++ t) []
|
||||||
|
|
||||||
myManageHook :: ManageHook
|
myManageHook :: ManageHook
|
||||||
myManageHook = composeOne
|
myManageHook = manageApps <+> manageDocks <+> manageHook def
|
||||||
|
|
||||||
|
manageApps :: ManageHook
|
||||||
|
manageApps = composeOne
|
||||||
[ isDialog -?> doCenterFloat
|
[ isDialog -?> doCenterFloat
|
||||||
-- VM window
|
-- VM window
|
||||||
, className =? myVMClass -?> appendViewShift myVMWorkspace
|
, className =? myVMClass -?> appendViewShift myVMWorkspace
|
||||||
|
@ -228,7 +222,10 @@ myManageHook = composeOne
|
||||||
]
|
]
|
||||||
|
|
||||||
myEventHook :: Event -> X All
|
myEventHook :: Event -> X All
|
||||||
myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
myEventHook = monitorEventHook <+> docksEventHook <+> handleEventHook def
|
||||||
|
|
||||||
|
monitorEventHook :: Event -> X All
|
||||||
|
monitorEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
||||||
| t == bITMAP = do
|
| t == bITMAP = do
|
||||||
let (xtype, tag) = splitXMsg d
|
let (xtype, tag) = splitXMsg d
|
||||||
case xtype of
|
case xtype of
|
||||||
|
@ -242,7 +239,7 @@ myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
||||||
status <- io isDischarging
|
status <- io isDischarging
|
||||||
forM_ status $ \s -> runScreenLock >> when s runSuspend
|
forM_ status $ \s -> runScreenLock >> when s runSuspend
|
||||||
return (All True)
|
return (All True)
|
||||||
myEventHook _ = return (All True)
|
monitorEventHook _ = return (All True)
|
||||||
|
|
||||||
data PowerPrompt = PowerPrompt
|
data PowerPrompt = PowerPrompt
|
||||||
|
|
||||||
|
@ -335,85 +332,6 @@ runTerm = spawn myTerm
|
||||||
runCalc :: X ()
|
runCalc :: X ()
|
||||||
runCalc = spawnCmd myTerm ["-e", "R"]
|
runCalc = spawnCmd myTerm ["-e", "R"]
|
||||||
|
|
||||||
myDmenuCmd :: String
|
|
||||||
myDmenuCmd = "rofi"
|
|
||||||
|
|
||||||
-- | 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:
|
|
||||||
-- 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
|
|
||||||
getMonitorName :: X (Maybe String)
|
|
||||||
getMonitorName = do
|
|
||||||
dpy <- asks display
|
|
||||||
root <- asks theRoot
|
|
||||||
-- these are the focused screen coordinates according to xinerama
|
|
||||||
(sx, sy) <- getCoords
|
|
||||||
io $ do
|
|
||||||
res <- xrrGetScreenResourcesCurrent dpy root
|
|
||||||
outputs <- forM res $ \res' ->
|
|
||||||
forM (xrr_sr_outputs res') $ \output -> do
|
|
||||||
oi <- xrrGetOutputInfo dpy res' output
|
|
||||||
case oi of
|
|
||||||
-- connection: 0 == connected, 1 == disconnected
|
|
||||||
Just XRROutputInfo { xrr_oi_connection = 0
|
|
||||||
, xrr_oi_name = name
|
|
||||||
, xrr_oi_crtc = crtc
|
|
||||||
} -> do
|
|
||||||
ci <- xrrGetCrtcInfo dpy res' crtc
|
|
||||||
return $ (\ci' -> Just (name, xrr_ci_x ci', xrr_ci_y ci'))
|
|
||||||
=<< ci
|
|
||||||
_ -> return Nothing
|
|
||||||
return $ (\(name, _, _) -> Just name)
|
|
||||||
=<< find (\(_, x, y) -> x == sx && y == sy) . catMaybes
|
|
||||||
=<< outputs
|
|
||||||
where
|
|
||||||
getCoords = do
|
|
||||||
(Rectangle x y _ _) <- getFocusedScreen
|
|
||||||
return (fromIntegral x, fromIntegral y)
|
|
||||||
|
|
||||||
getFocusedScreen :: X Rectangle
|
|
||||||
getFocusedScreen = withWindowSet $ return . screenRect . W.screenDetail . W.current
|
|
||||||
|
|
||||||
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"]
|
|
||||||
|
|
||||||
runAppMenu :: X ()
|
|
||||||
runAppMenu = spawnDmenuCmd' ["-show", "drun"]
|
|
||||||
|
|
||||||
runClipMenu :: X ()
|
|
||||||
runClipMenu = spawnDmenuCmd'
|
|
||||||
[ "-modi", "\"clipboard:greenclip print\""
|
|
||||||
, "-show", "clipboard"
|
|
||||||
, "-run-command", "'{cmd}'"
|
|
||||||
, "-theme-str", "'#element.selected.normal { background-color: #00c44e; }'"
|
|
||||||
]
|
|
||||||
|
|
||||||
runWinMenu :: X ()
|
|
||||||
runWinMenu = spawnDmenuCmd' ["-show", "window"]
|
|
||||||
|
|
||||||
runNetMenu :: X ()
|
|
||||||
runNetMenu = spawnDmenuCmd "networkmanager_dmenu" []
|
|
||||||
|
|
||||||
runDevMenu :: X ()
|
|
||||||
runDevMenu = spawnDmenuCmd "rofi-devices" []
|
|
||||||
|
|
||||||
runBrowser :: X ()
|
runBrowser :: X ()
|
||||||
runBrowser = spawn "brave"
|
runBrowser = spawn "brave"
|
||||||
|
|
||||||
|
@ -447,10 +365,10 @@ runScreenCapture = runFlameshot "screen"
|
||||||
runDesktopCapture :: X ()
|
runDesktopCapture :: X ()
|
||||||
runDesktopCapture = runFlameshot "full"
|
runDesktopCapture = runFlameshot "full"
|
||||||
|
|
||||||
runCleanup :: [ProcessID] -> Client -> X ()
|
runCleanup :: ThreadState -> X ()
|
||||||
runCleanup ps client = io $ do
|
runCleanup ts = io $ do
|
||||||
mapM_ killPID ps
|
mapM_ killPID $ childPIDs ts
|
||||||
stopXMonadService client
|
stopXMonadService $ client ts
|
||||||
|
|
||||||
runRestart :: X ()
|
runRestart :: X ()
|
||||||
runRestart = restart "xmonad" True
|
runRestart = restart "xmonad" True
|
||||||
|
@ -516,26 +434,6 @@ runToggleDPMS = io $ void callToggle
|
||||||
|
|
||||||
-- keybindings
|
-- keybindings
|
||||||
|
|
||||||
showKeybindings :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
|
|
||||||
showKeybindings x = addName "Show Keybindings" $ do
|
|
||||||
name <- getMonitorName
|
|
||||||
case name of
|
|
||||||
Just n -> do
|
|
||||||
h <- spawnPipe $ cmd n
|
|
||||||
io $ hPutStr h (unlines $ showKm x)
|
|
||||||
io $ hClose h
|
|
||||||
return ()
|
|
||||||
Nothing -> io $ putStrLn "fail"
|
|
||||||
where cmd name = fmtCmd myDmenuCmd
|
|
||||||
[ "-dmenu"
|
|
||||||
, "-m"
|
|
||||||
, name
|
|
||||||
, "-p"
|
|
||||||
, "commands"
|
|
||||||
, "-theme-str"
|
|
||||||
, "'#element.selected.normal { background-color: #a200ff; }'"
|
|
||||||
]
|
|
||||||
|
|
||||||
myVMWorkspace :: String
|
myVMWorkspace :: String
|
||||||
myVMWorkspace = "VM"
|
myVMWorkspace = "VM"
|
||||||
|
|
||||||
|
@ -578,18 +476,12 @@ runXSane = spawnOrSwitch myXSaneWorkspace $ spawnCmd "xsane" []
|
||||||
myModMask :: KeyMask
|
myModMask :: KeyMask
|
||||||
myModMask = mod4Mask
|
myModMask = mod4Mask
|
||||||
|
|
||||||
mkNamedSubmap
|
addKeymap :: ThreadState -> XConfig l -> XConfig l
|
||||||
:: XConfig l
|
addKeymap ts = addDescrKeys' ((myModMask, xK_F1), runShowKeys) (mkKeys ts)
|
||||||
-> String
|
|
||||||
-> [(String, String, X ())]
|
|
||||||
-> [((KeyMask, KeySym), NamedAction)]
|
|
||||||
mkNamedSubmap c sectionName bindings =
|
|
||||||
(subtitle sectionName:) $ mkNamedKeymap c
|
|
||||||
$ map (\(key, name, cmd) -> (key, addName name cmd)) bindings
|
|
||||||
|
|
||||||
mkKeys :: [ProcessID] -> Client -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
|
mkKeys :: ThreadState -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
|
||||||
mkKeys hs client c =
|
mkKeys ts c =
|
||||||
mkNamedSubmap c "Window Layouts"
|
mkNamedSubmap "Window Layouts"
|
||||||
[ ("M-j", "focus down", windows W.focusDown)
|
[ ("M-j", "focus down", windows W.focusDown)
|
||||||
, ("M-k", "focus up", windows W.focusUp)
|
, ("M-k", "focus up", windows W.focusUp)
|
||||||
, ("M-m", "focus master", windows W.focusMaster)
|
, ("M-m", "focus master", windows W.focusMaster)
|
||||||
|
@ -605,7 +497,7 @@ mkKeys hs client c =
|
||||||
, ("M-S-=", "add master window", sendMessage $ IncMasterN 1)
|
, ("M-S-=", "add master window", sendMessage $ IncMasterN 1)
|
||||||
] ++
|
] ++
|
||||||
|
|
||||||
mkNamedSubmap c "Workspaces"
|
mkNamedSubmap "Workspaces"
|
||||||
-- ASSUME standard workspaces only use numbers 0-9 (otherwise we won't get
|
-- ASSUME standard workspaces only use numbers 0-9 (otherwise we won't get
|
||||||
-- valid keysyms)
|
-- valid keysyms)
|
||||||
([ (mods ++ n, msg ++ n, f n) | n <- myWorkspaces
|
([ (mods ++ n, msg ++ n, f n) | n <- myWorkspaces
|
||||||
|
@ -621,7 +513,7 @@ mkKeys hs client c =
|
||||||
, ("M-M1-h", "move down workspace", moveTo Prev HiddenNonEmptyWS)
|
, ("M-M1-h", "move down workspace", moveTo Prev HiddenNonEmptyWS)
|
||||||
]) ++
|
]) ++
|
||||||
|
|
||||||
mkNamedSubmap c "Screens"
|
mkNamedSubmap "Screens"
|
||||||
[ ("M-l", "move up screen", nextScreen)
|
[ ("M-l", "move up screen", nextScreen)
|
||||||
, ("M-h", "move down screen", prevScreen)
|
, ("M-h", "move down screen", prevScreen)
|
||||||
, ("M-C-l", "follow client up screen", shiftNextScreen >> nextScreen)
|
, ("M-C-l", "follow client up screen", shiftNextScreen >> nextScreen)
|
||||||
|
@ -630,7 +522,7 @@ mkKeys hs client c =
|
||||||
, ("M-S-h", "shift workspace down screen", swapPrevScreen >> prevScreen)
|
, ("M-S-h", "shift workspace down screen", swapPrevScreen >> prevScreen)
|
||||||
] ++
|
] ++
|
||||||
|
|
||||||
mkNamedSubmap c "Actions"
|
mkNamedSubmap "Actions"
|
||||||
[ ("M-q", "close window", kill1)
|
[ ("M-q", "close window", kill1)
|
||||||
, ("M-r", "run program", runCmdMenu)
|
, ("M-r", "run program", runCmdMenu)
|
||||||
, ("M-<Space>", "warp pointer", warpToWindow 0.5 0.5)
|
, ("M-<Space>", "warp pointer", warpToWindow 0.5 0.5)
|
||||||
|
@ -640,7 +532,7 @@ mkKeys hs client c =
|
||||||
-- , ("M-C-S-s", "capture focused window", spawn myWindowCap)
|
-- , ("M-C-S-s", "capture focused window", spawn myWindowCap)
|
||||||
] ++
|
] ++
|
||||||
|
|
||||||
mkNamedSubmap c "Launchers"
|
mkNamedSubmap "Launchers"
|
||||||
[ ("<XF86Search>", "select/launch app", runAppMenu)
|
[ ("<XF86Search>", "select/launch app", runAppMenu)
|
||||||
, ("M-g", "launch clipboard manager", runClipMenu)
|
, ("M-g", "launch clipboard manager", runClipMenu)
|
||||||
, ("M-a", "launch network selector", runNetMenu)
|
, ("M-a", "launch network selector", runNetMenu)
|
||||||
|
@ -656,7 +548,7 @@ mkKeys hs client c =
|
||||||
, ("M-C-x", "launch XSane", runXSane)
|
, ("M-C-x", "launch XSane", runXSane)
|
||||||
] ++
|
] ++
|
||||||
|
|
||||||
mkNamedSubmap c "Multimedia"
|
mkNamedSubmap "Multimedia"
|
||||||
[ ("<XF86AudioPlay>", "toggle play/pause", runTogglePlay)
|
[ ("<XF86AudioPlay>", "toggle play/pause", runTogglePlay)
|
||||||
, ("<XF86AudioPrev>", "previous track", runPrevTrack)
|
, ("<XF86AudioPrev>", "previous track", runPrevTrack)
|
||||||
, ("<XF86AudioNext>", "next track", runNextTrack)
|
, ("<XF86AudioNext>", "next track", runNextTrack)
|
||||||
|
@ -668,14 +560,14 @@ mkKeys hs client c =
|
||||||
|
|
||||||
-- dummy map for dunst commands (defined separately but this makes them show
|
-- dummy map for dunst commands (defined separately but this makes them show
|
||||||
-- up in the help menu)
|
-- up in the help menu)
|
||||||
mkNamedSubmap c "Dunst"
|
mkNamedSubmap "Dunst"
|
||||||
[ ("M-`", "dunst history", return ())
|
[ ("M-`", "dunst history", return ())
|
||||||
, ("M-S-`", "dunst close", return ())
|
, ("M-S-`", "dunst close", return ())
|
||||||
, ("M-M1-`", "dunst context menu", return ())
|
, ("M-M1-`", "dunst context menu", return ())
|
||||||
, ("M-C-`", "dunst close all", return ())
|
, ("M-C-`", "dunst close all", return ())
|
||||||
] ++
|
] ++
|
||||||
|
|
||||||
mkNamedSubmap c "System"
|
mkNamedSubmap "System"
|
||||||
[ ("M-.", "backlight up", runIncBacklight)
|
[ ("M-.", "backlight up", runIncBacklight)
|
||||||
, ("M-,", "backlight down", runDecBacklight)
|
, ("M-,", "backlight down", runDecBacklight)
|
||||||
, ("M-M1-,", "backlight min", runMinBacklight)
|
, ("M-M1-,", "backlight min", runMinBacklight)
|
||||||
|
@ -684,9 +576,12 @@ mkKeys hs client c =
|
||||||
, ("M-<Home>", "quit xmonad", runQuitPrompt)
|
, ("M-<Home>", "quit xmonad", runQuitPrompt)
|
||||||
, ("M-<Delete>", "lock screen", runScreenLock)
|
, ("M-<Delete>", "lock screen", runScreenLock)
|
||||||
-- M-<F1> reserved for showing the keymap
|
-- M-<F1> reserved for showing the keymap
|
||||||
, ("M-<F2>", "restart xmonad", runCleanup hs client >> runRestart)
|
, ("M-<F2>", "restart xmonad", runCleanup ts >> runRestart)
|
||||||
, ("M-<F3>", "recompile xmonad", runRecompile)
|
, ("M-<F3>", "recompile xmonad", runRecompile)
|
||||||
, ("M-<F10>", "toggle bluetooth", runToggleBluetooth)
|
, ("M-<F10>", "toggle bluetooth", runToggleBluetooth)
|
||||||
, ("M-<F11>", "toggle screensaver", runToggleDPMS)
|
, ("M-<F11>", "toggle screensaver", runToggleDPMS)
|
||||||
, ("M-<F12>", "switch gpu", runOptimusPrompt)
|
, ("M-<F12>", "switch gpu", runOptimusPrompt)
|
||||||
]
|
]
|
||||||
|
where
|
||||||
|
mkNamedSubmap header bindings = (subtitle header:) $ mkNamedKeymap c
|
||||||
|
$ map (\(key, name, cmd) -> (key, addName name cmd)) bindings
|
||||||
|
|
|
@ -1,6 +1,10 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module DBus.Common where
|
module DBus.Common
|
||||||
|
( Client
|
||||||
|
, startXMonadService
|
||||||
|
, stopXMonadService)
|
||||||
|
where
|
||||||
|
|
||||||
import DBus.IntelBacklight
|
import DBus.IntelBacklight
|
||||||
import DBus.Screensaver
|
import DBus.Screensaver
|
||||||
|
|
|
@ -0,0 +1,119 @@
|
||||||
|
module Internal.DMenu where
|
||||||
|
|
||||||
|
import Shell
|
||||||
|
|
||||||
|
import Control.Monad.Reader
|
||||||
|
|
||||||
|
import Data.List
|
||||||
|
import Data.Maybe
|
||||||
|
|
||||||
|
import Graphics.X11.Types
|
||||||
|
import Graphics.X11.Xlib
|
||||||
|
import Graphics.X11.Xrandr
|
||||||
|
|
||||||
|
import System.IO
|
||||||
|
|
||||||
|
import XMonad.Core
|
||||||
|
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:
|
||||||
|
-- 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
|
||||||
|
getMonitorName :: X (Maybe String)
|
||||||
|
getMonitorName = do
|
||||||
|
dpy <- asks display
|
||||||
|
root <- asks theRoot
|
||||||
|
-- these are the focused screen coordinates according to xinerama
|
||||||
|
(sx, sy) <- getCoords
|
||||||
|
io $ do
|
||||||
|
res <- xrrGetScreenResourcesCurrent dpy root
|
||||||
|
outputs <- forM res $ \res' ->
|
||||||
|
forM (xrr_sr_outputs res') $ \output -> do
|
||||||
|
oi <- xrrGetOutputInfo dpy res' output
|
||||||
|
case oi of
|
||||||
|
-- connection: 0 == connected, 1 == disconnected
|
||||||
|
Just XRROutputInfo { xrr_oi_connection = 0
|
||||||
|
, xrr_oi_name = name
|
||||||
|
, xrr_oi_crtc = crtc
|
||||||
|
} -> do
|
||||||
|
ci <- xrrGetCrtcInfo dpy res' crtc
|
||||||
|
return $ (\ci' -> Just (name, xrr_ci_x ci', xrr_ci_y ci'))
|
||||||
|
=<< ci
|
||||||
|
_ -> return Nothing
|
||||||
|
return $ (\(name, _, _) -> Just name)
|
||||||
|
=<< find (\(_, x, y) -> x == sx && y == sy) . catMaybes
|
||||||
|
=<< outputs
|
||||||
|
where
|
||||||
|
getCoords = do
|
||||||
|
(Rectangle x y _ _) <- getFocusedScreen
|
||||||
|
return (fromIntegral x, fromIntegral y)
|
||||||
|
|
||||||
|
getFocusedScreen :: X Rectangle
|
||||||
|
getFocusedScreen = withWindowSet $ return . screenRect . screenDetail . current
|
||||||
|
|
||||||
|
myDmenuCmd :: String
|
||||||
|
myDmenuCmd = "rofi"
|
||||||
|
|
||||||
|
runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
|
||||||
|
runShowKeys x = addName "Show Keybindings" $ do
|
||||||
|
name <- getMonitorName
|
||||||
|
case name of
|
||||||
|
Just n -> do
|
||||||
|
h <- spawnPipe $ cmd n
|
||||||
|
io $ hPutStr h (unlines $ showKm x)
|
||||||
|
io $ hClose h
|
||||||
|
return ()
|
||||||
|
-- TODO put better error message here
|
||||||
|
Nothing -> io $ putStrLn "fail"
|
||||||
|
where cmd name = fmtCmd myDmenuCmd
|
||||||
|
[ "-dmenu"
|
||||||
|
, "-m"
|
||||||
|
, name
|
||||||
|
, "-p"
|
||||||
|
, "commands"
|
||||||
|
, "-theme-str"
|
||||||
|
, "'#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"]
|
||||||
|
|
||||||
|
runAppMenu :: X ()
|
||||||
|
runAppMenu = spawnDmenuCmd' ["-show", "drun"]
|
||||||
|
|
||||||
|
runClipMenu :: X ()
|
||||||
|
runClipMenu = spawnDmenuCmd'
|
||||||
|
[ "-modi", "\"clipboard:greenclip print\""
|
||||||
|
, "-show", "clipboard"
|
||||||
|
, "-run-command", "'{cmd}'"
|
||||||
|
, "-theme-str", "'#element.selected.normal { background-color: #00c44e; }'"
|
||||||
|
]
|
||||||
|
|
||||||
|
runWinMenu :: X ()
|
||||||
|
runWinMenu = spawnDmenuCmd' ["-show", "window"]
|
||||||
|
|
||||||
|
runNetMenu :: X ()
|
||||||
|
runNetMenu = spawnDmenuCmd "networkmanager_dmenu" []
|
||||||
|
|
||||||
|
runDevMenu :: X ()
|
||||||
|
runDevMenu = spawnDmenuCmd "rofi-devices" []
|
|
@ -5,18 +5,24 @@ module Process where
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.Exit
|
import System.Exit
|
||||||
|
import System.IO
|
||||||
|
import System.Posix.IO
|
||||||
|
import System.Posix.Process
|
||||||
import System.Posix.Signals
|
import System.Posix.Signals
|
||||||
import System.Posix.Types
|
import System.Posix.Types
|
||||||
import System.Process (waitForProcess)
|
import System.Process hiding (createPipe)
|
||||||
import System.Process.Internals
|
import System.Process.Internals
|
||||||
( ProcessHandle__ (ClosedHandle, OpenHandle)
|
( ProcessHandle__ (ClosedHandle, OpenHandle)
|
||||||
, mkProcessHandle
|
, mkProcessHandle
|
||||||
, withProcessHandle
|
, withProcessHandle
|
||||||
)
|
)
|
||||||
|
|
||||||
|
import XMonad.Core
|
||||||
|
|
||||||
-- | Block until a PID has exited (in any form)
|
-- | Block until a PID has exited (in any form)
|
||||||
-- ASSUMPTION on linux PIDs will always increase until they overflow, in which
|
-- ASSUMPTION on linux PIDs will always increase until they overflow, in which
|
||||||
-- case they will start to recycle. Barring any fork bombs, this code should
|
-- case they will start to recycle. Barring any fork bombs, this code should
|
||||||
|
@ -42,3 +48,15 @@ killPID pid = do
|
||||||
OpenHandle _ -> signalProcess sigTERM pid
|
OpenHandle _ -> signalProcess sigTERM pid
|
||||||
ClosedHandle _ -> return ()
|
ClosedHandle _ -> return ()
|
||||||
_ -> return () -- this should never happen
|
_ -> return () -- this should never happen
|
||||||
|
|
||||||
|
spawnPipe' :: MonadIO m => String -> m (ProcessID, Handle)
|
||||||
|
spawnPipe' x = liftIO $ do
|
||||||
|
(rd, wr) <- createPipe
|
||||||
|
setFdOption wr CloseOnExec True
|
||||||
|
h <- fdToHandle wr
|
||||||
|
hSetBuffering h LineBuffering
|
||||||
|
p <- xfork $ do
|
||||||
|
_ <- dupTo rd stdInput
|
||||||
|
executeFile "/bin/sh" False ["-c", x] Nothing
|
||||||
|
closeFd rd
|
||||||
|
return (p, h)
|
||||||
|
|
|
@ -11,6 +11,7 @@ library
|
||||||
, Notify
|
, Notify
|
||||||
, Shell
|
, Shell
|
||||||
, WorkspaceMon
|
, WorkspaceMon
|
||||||
|
, Internal.DMenu
|
||||||
, DBus.Common
|
, DBus.Common
|
||||||
, DBus.IntelBacklight
|
, DBus.IntelBacklight
|
||||||
, DBus.Internal
|
, DBus.Internal
|
||||||
|
@ -46,8 +47,8 @@ executable xmonad
|
||||||
build-depends: X11 >= 1.9.1
|
build-depends: X11 >= 1.9.1
|
||||||
, base
|
, base
|
||||||
, containers >= 0.6.0.1
|
, containers >= 0.6.0.1
|
||||||
, dbus >= 1.2.7
|
|
||||||
, directory >= 1.3.3.0
|
, directory >= 1.3.3.0
|
||||||
|
, process >= 1.6.5.0
|
||||||
, my-xmonad
|
, my-xmonad
|
||||||
, unix >= 2.7.2.2
|
, unix >= 2.7.2.2
|
||||||
, xmonad >= 0.13
|
, xmonad >= 0.13
|
||||||
|
|
Loading…
Reference in New Issue