tv xmonad: get font and screen info from env

This commit is contained in:
tv 2023-01-11 15:17:10 +01:00
parent bd2aef1cd2
commit 59a447ac04
4 changed files with 28 additions and 62 deletions

View File

@ -1,24 +0,0 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module Build where
import XMonad (Dimension)
import THEnv.JSON (getCompileEnvJSONExp)
myFont :: String
myFont =
"-schumacher-*-*-*-*-*-*-*-*-*-*-*-iso10646-*"
myScreenWidth :: Dimension
myScreenWidth =
$(getCompileEnvJSONExp (id @Dimension) "XMONAD_BUILD_SCREEN_WIDTH")
myTermFontWidth :: Dimension
myTermFontWidth =
$(getCompileEnvJSONExp (id @Dimension) "XMONAD_BUILD_TERM_FONT_WIDTH")
myTermPadding :: Dimension
myTermPadding =
2

View File

@ -1,18 +0,0 @@
{-# LANGUAGE ScopedTypeVariables #-}
module THEnv.JSON where
import Data.Aeson (eitherDecode,FromJSON)
import Data.ByteString.Lazy.Char8 (pack)
import Language.Haskell.TH.Syntax (Exp,Lift(lift),Q)
import THEnv (getCompileEnv)
import Control.Monad
getCompileEnvJSON :: (FromJSON a) => String -> Q a
getCompileEnvJSON name =
either error (id :: a -> a) . eitherDecode . pack <$> getCompileEnv name
getCompileEnvJSONExp ::
forall proxy a. (FromJSON a, Lift a) => proxy a -> String -> Q Exp
getCompileEnvJSONExp _ =
(lift :: a -> Q Exp) <=< getCompileEnvJSON

View File

@ -7,7 +7,10 @@ import System.Exit (exitFailure)
import Control.Exception import Control.Exception
import Control.Monad.Extra (whenJustM) import Control.Monad.Extra (whenJustM)
import qualified Data.Aeson
import qualified Data.ByteString.Char8
import qualified Data.List import qualified Data.List
import qualified Data.Maybe
import Graphics.X11.ExtraTypes.XF86 import Graphics.X11.ExtraTypes.XF86
import Text.Read (readEither) import Text.Read (readEither)
import XMonad import XMonad
@ -40,8 +43,6 @@ import XMonad.Actions.PerWorkspaceKeys (chooseAction)
import Shutdown (shutdown, newShutdownEventHandler) import Shutdown (shutdown, newShutdownEventHandler)
import Build (myFont, myScreenWidth, myTermFontWidth, myTermPadding)
main :: IO () main :: IO ()
main = getArgs >>= \case main = getArgs >>= \case
@ -53,9 +54,19 @@ main = getArgs >>= \case
(=??) :: Query a -> (a -> Bool) -> Query Bool (=??) :: Query a -> (a -> Bool) -> Query Bool
(=??) x p = fmap p x (=??) x p = fmap p x
readEnv :: Data.Aeson.FromJSON b => String -> IO b
readEnv name =
Data.Maybe.fromJust
. Data.Aeson.decodeStrict'
. Data.ByteString.Char8.pack
<$> getEnv name
mainNoArgs :: IO () mainNoArgs :: IO ()
mainNoArgs = do mainNoArgs = do
myScreenWidth <- readEnv "XMONAD_SCREEN_WIDTH" :: IO Dimension
myTermFont <- getEnv "XMONAD_TERM_FONT"
myTermFontWidth <- readEnv "XMONAD_TERM_FONT_WIDTH" :: IO Dimension
myTermPadding <- readEnv "XMONAD_TERM_PADDING" :: IO Dimension
workspaces0 <- getWorkspaces0 workspaces0 <- getWorkspaces0
handleShutdownEvent <- newShutdownEventHandler handleShutdownEvent <- newShutdownEventHandler
let let
@ -72,7 +83,7 @@ mainNoArgs = do
$ def $ def
{ terminal = {-pkg:rxvt_unicode-}"urxvtc" { terminal = {-pkg:rxvt_unicode-}"urxvtc"
, modMask = mod4Mask , modMask = mod4Mask
, keys = myKeys , keys = myKeys myTermFont
, workspaces = workspaces0 , workspaces = workspaces0
, layoutHook = , layoutHook =
smartBorders $ smartBorders $
@ -133,8 +144,8 @@ spawnRootTerm =
Nothing Nothing
myKeys :: XConfig Layout -> Map (KeyMask, KeySym) (X ()) myKeys :: String -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
myKeys conf = Map.fromList $ myKeys font conf = Map.fromList $
[ ((_4 , xK_Escape ), forkFile {-pkg-}"slock" [] Nothing) [ ((_4 , xK_Escape ), forkFile {-pkg-}"slock" [] Nothing)
, ((_4S , xK_c ), kill) , ((_4S , xK_c ), kill)
@ -209,14 +220,12 @@ myKeys conf = Map.fromList $
resetLayout = setLayout $ XMonad.layoutHook conf resetLayout = setLayout $ XMonad.layoutHook conf
promptXPConfig = promptXPConfig =
def { XMonad.Prompt.font = myFont } def { XMonad.Prompt.font = font }
xdeny =
xdeny :: X ()
xdeny =
forkFile forkFile
{-pkg-}"xterm" {-pkg-}"xterm"
[ "-fn", myFont [ "-fn", font
, "-geometry", "300x100" , "-geometry", "300x100"
, "-name", "AlertFloat" , "-name", "AlertFloat"
, "-bg", "#E4002B" , "-bg", "#E4002B"

View File

@ -23,7 +23,6 @@ executable xmonad
xmonad, xmonad,
xmonad-contrib xmonad-contrib
other-modules: other-modules:
Shutdown, Shutdown
THEnv.JSON
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -O2 -Wall -threaded ghc-options: -O2 -Wall -threaded