diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Main.hs | 3 | ||||
| -rw-r--r-- | src/Rahm/Desktop/XMobarLog.hs | 113 |
2 files changed, 67 insertions, 49 deletions
diff --git a/src/Main.hs b/src/Main.hs index 766716c..1f059aa 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -37,6 +37,7 @@ main = do setEnv "ROFI" menuCommandString xmobar <- spawnXMobar + logHook <- xMobarLogHook (=<<) X.xmonad $ applyKeys $ @@ -86,7 +87,7 @@ main = do ], focusFollowsMouse = False, clickJustFocuses = False, - logHook = xMobarLogHook xmobar + logHook = logHook xmobar } changeHook :: Location -> Location -> X () diff --git a/src/Rahm/Desktop/XMobarLog.hs b/src/Rahm/Desktop/XMobarLog.hs index 05f6f21..7ac8315 100644 --- a/src/Rahm/Desktop/XMobarLog.hs +++ b/src/Rahm/Desktop/XMobarLog.hs @@ -14,6 +14,7 @@ import Rahm.Desktop.Theater (getTheaters) import Rahm.Desktop.Workspaces (WorkspaceState (..), getPopulatedWorkspaces) import Rahm.Desktop.XMobarLog.PendingBuffer (getPendingBuffer) import System.IO (Handle, hPutStrLn, hSetEncoding, utf8) +import System.Process import Text.Printf import XMonad (X) import qualified XMonad as X @@ -35,58 +36,74 @@ spawnXMobar = do hSetEncoding pipe utf8 return (XMobarLog pipe) +-- getUname :: X String +-- getUname = do +-- readProcess + -- XMonad Log Hook meant to be used with the XMonad config logHook. -xMobarLogHook :: XMobarLog -> X () -xMobarLogHook (XMobarLog xmproc) = do - (_, _, layoutXpm) <- drawLayout - - loglevel <- getLogLevel - theaters <- filter (\(j, _, _) -> isJust j) <$> getTheaters - - winset <- X.gets X.windowset - title <- maybe (pure "") (fmap show . getName) . S.peek $ winset - pendingBuffer <- getPendingBuffer - let wss = getPopulatedWorkspaces winset - - let log = trunc 80 $ - execWriter $ do - tell " " - tell (toChangeLayoutAction layoutXpm) - tell " " - tell $ logLevelToXMobar loglevel - - forM_ theaters $ \case - (Just n, _, True) -> do - tell "<fn=1><fc=#ffffff>" - tell $ toTheaterAction n - tell " </fc></fn>" - (Just n, _, False) -> do - tell "<fn=2><fc=#888888>" - tell $ toTheaterAction n +xMobarLogHook :: IO (XMobarLog -> X ()) +xMobarLogHook = do + -- uname <- readProcess "/usr/bin/uname" ["-r"] "" + let uname = "44444" + + return $ \(XMobarLog xmproc) -> do + let pendingBufferFiller = " " + + (_, _, layoutXpm) <- drawLayout + + loglevel <- getLogLevel + theaters <- filter (\(j, _, _) -> isJust j) <$> getTheaters + + winset <- X.gets X.windowset + title <- maybe (pure "") (fmap show . getName) . S.peek $ winset + pendingBuffer'' <- getPendingBuffer + let pendingBuffer' = + if null pendingBuffer'' + then uname + else pendingBuffer'' + let pendingBuffer = take 10 $ reverse (take 10 (reverse pendingBuffer')) ++ repeat ' ' + + let wss = getPopulatedWorkspaces winset + + let log = trunc 80 $ + execWriter $ do + tell " <fc=#a0a0a0><fn=3>" + tell pendingBuffer + tell "</fn></fc> " + + tell " " + tell (toChangeLayoutAction layoutXpm) + tell " " + tell $ logLevelToXMobar loglevel + + forM_ theaters $ \case + (Just n, _, True) -> do + tell "<fn=1><fc=#ffffff>" + tell $ toTheaterAction n + tell " </fc></fn>" + (Just n, _, False) -> do + tell "<fn=2><fc=#888888>" + tell $ toTheaterAction n + tell " </fc></fn>" + _ -> return () + + unless (null theaters) $ do + tell "<fc=#888888>| </fc>" + + forM_ wss $ \(t, ws) -> do + case t of + Current -> tell "<fn=1><fc=#ff8888>" + Visible -> tell "<fn=6><fc=#8888ff>" + Hidden -> tell "<fn=2><fc=#888888>" + tell $ toAction $ S.tag ws tell " </fc></fn>" - _ -> return () - - unless (null theaters) $ do - tell "<fc=#888888>| </fc>" - - forM_ wss $ \(t, ws) -> do - case t of - Current -> tell "<fn=1><fc=#ff8888>" - Visible -> tell "<fn=6><fc=#8888ff>" - Hidden -> tell "<fn=2><fc=#888888>" - tell $ toAction $ S.tag ws - tell " </fc></fn>" - - tell " " - tell pendingBuffer - tell " " - tell " <fc=#ff8888><fn=3>" - tell title - tell "</fn></fc>" + tell " <fc=#ff8888><fn=3>" + tell title + tell "</fn></fc>" - logs Trace "XMobar: %s" log - X.io $ hPutStrLn xmproc log + logs Trace "XMobar: %s" log + X.io $ hPutStrLn xmproc log where toAction [ch] | isAsciiUpper ch |