1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
module Rahm.Desktop.XMobarLog (XMobarLog, spawnXMobar, xMobarLogHook) where
import Control.Monad (forM_, unless)
import Control.Monad.Writer (execWriter, tell)
import Data.Char (isAsciiLower, isAsciiUpper, isDigit, isSpace)
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Maybe (isJust)
import Rahm.Desktop.Layout.Draw (drawLayout)
import Rahm.Desktop.Logger
( LogLevel (Debug, Error, Fatal, Trace, Warn),
getLogLevel,
logs,
)
import qualified Rahm.Desktop.StackSet as S
( Workspace (tag),
peek,
)
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 Text.Printf (printf)
import XMonad (X)
import qualified XMonad as X (XState (windowset), gets, io)
import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Run (runProcessWithInput, spawnPipe)
newtype XMobarLog = XMobarLog Handle
-- The log hook for XMobar. This is a custom log hook that does not use any
-- of the Xmonad dynamic log libraries.
--
-- This is because the given dynamic log libraries don't handle unicode properly
-- and this has been causing issues. It is also more flexible and frankly easier
-- to just DIY.
spawnXMobar :: IO XMobarLog
spawnXMobar = do
pipe <- spawnPipe "xmobar"
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 :: IO (XMobarLog -> X ())
xMobarLogHook = do
unameRef <- newIORef Nothing
-- (_, uname, _) <- readProcessWithExitCode "/usr/bin/uname" ["-r"] ""
-- putStrLn $ "Uname " ++ uname
return $ \(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
uname <- getUname unameRef
let pendingBufferSize = max 10 $ length uname
let (pendingBufferColor, pendingBuffer') =
if null pendingBuffer''
then ("#a0a0a0", uname)
else ("#f0a0a0,#202020", pendingBuffer'')
let pendingBuffer =
take pendingBufferSize $
reverse
( take pendingBufferSize (reverse pendingBuffer')
)
++ repeat ' '
let wss = getPopulatedWorkspaces winset
let log = trunc 80 $
execWriter $ do
tell $ printf "<fc=%s><fn=3> " pendingBufferColor
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> "
tell "<fc=#888888>| </fc>"
tell "<fc=#ff8888><fn=3>"
tell title
tell "</fn></fc>"
logs Trace "XMobar: %s" log
X.io $ hPutStrLn xmproc log
where
toAction [ch]
| isAsciiUpper ch
|| isAsciiLower ch
|| isDigit ch =
printf "<action=`xdotool key 'Hyper_L+g' '%s'` button=1><action=`xdotool key 'Hyper_L+Shift_L+g' '%s'` button=3>%s</action></action>" [ch] [ch] [ch]
toAction ch = ch
toTheaterAction [ch]
| isAsciiUpper ch
|| isAsciiLower ch
|| isDigit ch =
printf "<action=`xdotool key 'Hyper_L+Shift_L+g' '%s'` button=1>%s</action>" [ch] [ch]
toTheaterAction ch = ch
toChangeLayoutAction :: String -> String
toChangeLayoutAction =
printf
"<action=`xdotool key Hyper_L+space n` button=1>\
\<action=`xdotool key p` button=3>%s</action></action>"
logLevelToXMobar Trace = "<fn=3><fc=#88ffff>[Trace]</fc></fn> "
logLevelToXMobar Debug = "<fn=3><fc=#ff88ff>[Debug]</fc></fn> "
logLevelToXMobar Warn = "<fn=3><fc=#ffff88>[Warn] </fc></fn> "
logLevelToXMobar Error = "<fn=3><fc=#ff8888>[Error]</fc></fn> "
logLevelToXMobar Fatal = "<fn=3><fc=#888888>[Fatal]</fc></fn> "
logLevelToXMobar _ = ""
getUname ref = X.io $ do
s <- readIORef ref
case s of
Nothing -> do
uname' <- runProcessWithInput "uname" ["-r"] ""
let uname = dropWhile isSpace (reverse $ dropWhile isSpace $ reverse uname')
writeIORef ref $ Just uname
return uname
Just uname -> return uname
-- Truncate an XMobar string to the provided number of _visible_ characters.
-- This is to keep long window titles from overrunning the whole bar.
trunc :: Int -> String -> String
trunc amt str = reverse $ trunc' False amt str []
where
trunc' _ _ [] acc = acc
trunc' ignore amt (a : as) acc =
case a of
'<' -> trunc' True amt as (a : acc)
'>' -> trunc' False amt as (a : acc)
_ ->
if ignore
then trunc' True amt as (a : acc)
else case amt of
0 -> trunc' False 0 as acc
3 -> trunc' False 0 as ("..." ++ acc)
_ -> trunc' False (amt - 1) as (a : acc)
|
