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
|
{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Custom.Log
-- Copyright : (c) azahi 2018
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : azahi <azahi@teknik.io>
-- Stability : unstable
-- Portability : unportable
--
-- Provides configuration for logging to be used
-- with various status display applications
--
-----------------------------------------------------------------------------
module XMonad.Custom.Log
( logHook
) where
import System.IO
import XMonad hiding (logHook)
import XMonad.Actions.CopyWindow
import XMonad.Custom.Theme
import XMonad.Hooks.CurrentWorkspaceOnTop
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.EwmhDesktops
import XMonad.Util.NamedScratchpad
import XMonad.Util.SpawnNamedPipe
import XMonad.Util.WorkspaceCompare
xmobarFont :: Int -> String -> String
xmobarFont f = wrap (concat ["<fn=", show f, ">"]) "</fn>"
topBarPP :: PP
topBarPP = def
{ ppCurrent = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "="
, ppVisible = xmobarColor white1 "" . wrap "~" "~"
, ppHidden = xmobarColor white1 "" . wrap "-" "-"
, ppHiddenNoWindows = xmobarColor white1 "" . wrap "_" "_"
, ppUrgent = xmobarColor red2 "" . wrap "!" "!"
, ppSep = " / "
, ppWsSep = " "
, ppTitle = xmobarColor white1 "" . shorten 50
, ppTitleSanitize = xmobarStrip
, ppLayout = xmobarColor white1 ""
, ppOrder = id
, ppSort = (namedScratchpadFilterOutWorkspace .) <$> getSortByIndex
, ppExtras = []
}
botBarPP :: PP
botBarPP = topBarPP
{ ppCurrent = const ""
, ppVisible = const ""
, ppHidden = const ""
, ppHiddenNoWindows = const ""
, ppUrgent = const ""
, ppTitle = const ""
, ppLayout = const ""
}
safePrintToPipe :: Maybe Handle -> String -> IO ()
safePrintToPipe = maybe (\_ -> return ()) hPutStrLn
logHook :: X ()
logHook = do
currentWorkspaceOnTop
ewmhDesktopsLogHook
t <- getNamedPipe "xmobarTop"
b <- getNamedPipe "xmobarBot"
c <- wsContainingCopies
let copiesCurrent ws | ws `elem` c = xmobarColor yellow2 "" . xmobarFont 2 . wrap "*" "=" $ ws
| otherwise = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "=" $ ws
let copiesHidden ws | ws `elem` c = xmobarColor yellow1 "" . wrap "*" "-" $ ws
| otherwise = xmobarColor white1 "" . wrap "-" "-" $ ws
let copiesUrgent ws | ws `elem` c = xmobarColor yellow2 "" . wrap "*" "!" $ ws
| otherwise = xmobarColor white2 "" . wrap "!" "!" $ ws
dynamicLogWithPP $ topBarPP
{ ppCurrent = copiesCurrent
, ppHidden = copiesHidden
, ppUrgent = copiesUrgent
, ppOutput = safePrintToPipe t
}
dynamicLogWithPP $ botBarPP
{ ppOutput = safePrintToPipe b
}
|
