tv xmonad: get font and screen info from env
This commit is contained in:
parent
bd2aef1cd2
commit
59a447ac04
@ -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
|
|
@ -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
|
|
@ -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,17 +220,15 @@ 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 ()
|
forkFile
|
||||||
xdeny =
|
{-pkg-}"xterm"
|
||||||
forkFile
|
[ "-fn", font
|
||||||
{-pkg-}"xterm"
|
, "-geometry", "300x100"
|
||||||
[ "-fn", myFont
|
, "-name", "AlertFloat"
|
||||||
, "-geometry", "300x100"
|
, "-bg", "#E4002B"
|
||||||
, "-name", "AlertFloat"
|
, "-e", "sleep", "0.05"
|
||||||
, "-bg", "#E4002B"
|
]
|
||||||
, "-e", "sleep", "0.05"
|
Nothing
|
||||||
]
|
|
||||||
Nothing
|
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user