tv xmonad: print stuff to stderr everywhere
This commit is contained in:
parent
057c4836c1
commit
00d03622d1
|
@ -9,6 +9,7 @@ module Main where
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Text.Read (readEither)
|
import Text.Read (readEither)
|
||||||
import XMonad
|
import XMonad
|
||||||
|
import System.IO (hPutStrLn, stderr)
|
||||||
import System.Environment (getArgs, withArgs, getEnv, getEnvironment)
|
import System.Environment (getArgs, withArgs, getEnv, getEnvironment)
|
||||||
import System.Posix.Process (executeFile)
|
import System.Posix.Process (executeFile)
|
||||||
import XMonad.Prompt (defaultXPConfig)
|
import XMonad.Prompt (defaultXPConfig)
|
||||||
|
@ -36,7 +37,6 @@ import XMonad.Layout.PerWorkspace (onWorkspace)
|
||||||
--import XMonad.Actions.Submap
|
--import XMonad.Actions.Submap
|
||||||
import Util.Pager
|
import Util.Pager
|
||||||
import Util.Rhombus
|
import Util.Rhombus
|
||||||
import Util.Debunk
|
|
||||||
import Util.Shutdown
|
import Util.Shutdown
|
||||||
|
|
||||||
|
|
||||||
|
@ -88,10 +88,10 @@ xmonad' conf = do
|
||||||
path <- getEnv "XMONAD_STATE"
|
path <- getEnv "XMONAD_STATE"
|
||||||
try (readFile path) >>= \case
|
try (readFile path) >>= \case
|
||||||
Right content -> do
|
Right content -> do
|
||||||
putStrLn ("resuming from " ++ path)
|
hPutStrLn stderr ("resuming from " ++ path)
|
||||||
withArgs ("--resume" : lines content) (xmonad conf)
|
withArgs ("--resume" : lines content) (xmonad conf)
|
||||||
Left e -> do
|
Left e -> do
|
||||||
putStrLn (displaySomeException e)
|
hPutStrLn stderr (displaySomeException e)
|
||||||
xmonad conf
|
xmonad conf
|
||||||
|
|
||||||
getWorkspaces0 :: IO [String]
|
getWorkspaces0 :: IO [String]
|
||||||
|
@ -104,7 +104,7 @@ getWorkspaces0 =
|
||||||
Left e -> warn e
|
Left e -> warn e
|
||||||
Right y -> return y
|
Right y -> return y
|
||||||
where
|
where
|
||||||
warn msg = putStrLn ("getWorkspaces0: " ++ msg) >> return []
|
warn msg = hPutStrLn stderr ("getWorkspaces0: " ++ msg) >> return []
|
||||||
|
|
||||||
displaySomeException :: SomeException -> String
|
displaySomeException :: SomeException -> String
|
||||||
displaySomeException = displayException
|
displaySomeException = displayException
|
||||||
|
@ -135,7 +135,7 @@ myKeys conf = Map.fromList $
|
||||||
, ((0 , xK_Menu ), gets windowset >>= allWorkspaceNames >>= pager pagerConfig (windows . W.view) )
|
, ((0 , xK_Menu ), gets windowset >>= allWorkspaceNames >>= pager pagerConfig (windows . W.view) )
|
||||||
, ((_S , xK_Menu ), gets windowset >>= allWorkspaceNames >>= pager pagerConfig (windows . W.shift) )
|
, ((_S , xK_Menu ), gets windowset >>= allWorkspaceNames >>= pager pagerConfig (windows . W.shift) )
|
||||||
, ((_C , xK_Menu ), toggleWS)
|
, ((_C , xK_Menu ), toggleWS)
|
||||||
, ((_4 , xK_Menu ), rhombus horseConfig (liftIO . printToErrors) ["Correct", "Horse", "Battery", "Staple", "Stuhl", "Tisch"] )
|
, ((_4 , xK_Menu ), rhombus horseConfig (liftIO . hPutStrLn stderr) ["Correct", "Horse", "Battery", "Staple", "Stuhl", "Tisch"] )
|
||||||
|
|
||||||
-- %! Rotate through the available layout algorithms
|
-- %! Rotate through the available layout algorithms
|
||||||
, ((_4 , xK_space ), sendMessage NextLayout)
|
, ((_4 , xK_space ), sendMessage NextLayout)
|
||||||
|
|
|
@ -1,16 +0,0 @@
|
||||||
module Util.Debunk
|
|
||||||
( printToErrors
|
|
||||||
) where
|
|
||||||
|
|
||||||
import XMonad
|
|
||||||
import System.FilePath ( (</>) )
|
|
||||||
import Control.Exception ( bracket )
|
|
||||||
import System.IO ( hPrint, stderr, openFile, hClose, IOMode( AppendMode ) )
|
|
||||||
|
|
||||||
|
|
||||||
printToErrors x = do
|
|
||||||
dir <- getXMonadDir
|
|
||||||
let base = dir </> "xmonad"
|
|
||||||
err = base ++ ".errors"
|
|
||||||
bracket (openFile err AppendMode) hClose $ \h -> hPrint h x
|
|
||||||
|
|
|
@ -18,7 +18,6 @@ import XMonad.Util.Font
|
||||||
import XMonad.Util.Image ( drawIcon )
|
import XMonad.Util.Image ( drawIcon )
|
||||||
import XMonad.Util.XUtils
|
import XMonad.Util.XUtils
|
||||||
|
|
||||||
import Util.Debunk
|
|
||||||
import Util.Submap
|
import Util.Submap
|
||||||
import Util.XUtils
|
import Util.XUtils
|
||||||
import Util.Font
|
import Util.Font
|
||||||
|
|
Loading…
Reference in a new issue