mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
modify mkAbsolutePath
to support environment vars
If you want more general support, comment on PR #744.
This commit is contained in:
parent
40171824cd
commit
64eb4e46ec
@ -184,6 +184,10 @@
|
|||||||
- Added `WindowScreen`, which is a type synonym for the specialized `Screen`
|
- Added `WindowScreen`, which is a type synonym for the specialized `Screen`
|
||||||
type, that results from the `WindowSet` definition in `XMonad.Core`.
|
type, that results from the `WindowSet` definition in `XMonad.Core`.
|
||||||
|
|
||||||
|
- Modified `mkAbsolutePath` to support a leading environment variable, so
|
||||||
|
things like `$HOME/NOTES` work. If you want more general environment
|
||||||
|
variable support, comment on [this PR].
|
||||||
|
|
||||||
* `XMonad.Util.XUtils`
|
* `XMonad.Util.XUtils`
|
||||||
|
|
||||||
- Added `withSimpleWindow`, `showSimpleWindow`, `WindowConfig`, and
|
- Added `withSimpleWindow`, `showSimpleWindow`, `WindowConfig`, and
|
||||||
|
@ -1,5 +1,6 @@
|
|||||||
{-# LANGUAGE BangPatterns #-}
|
{-# LANGUAGE BangPatterns #-}
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
--------------------------------------------------------------------
|
--------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Prelude
|
-- Module : XMonad.Prelude
|
||||||
@ -60,6 +61,8 @@ import Data.List.NonEmpty (NonEmpty ((:|)))
|
|||||||
import Data.Tuple (swap)
|
import Data.Tuple (swap)
|
||||||
import GHC.Stack
|
import GHC.Stack
|
||||||
import System.Directory (getHomeDirectory)
|
import System.Directory (getHomeDirectory)
|
||||||
|
import System.Environment (getEnv)
|
||||||
|
import Control.Exception (SomeException, handle)
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
-- | Short for 'fromIntegral'.
|
-- | Short for 'fromIntegral'.
|
||||||
@ -80,7 +83,7 @@ chunksOf i xs = chunk : chunksOf i rest
|
|||||||
(!?) xs n | n < 0 = Nothing
|
(!?) xs n | n < 0 = Nothing
|
||||||
| otherwise = listToMaybe $ drop n xs
|
| otherwise = listToMaybe $ drop n xs
|
||||||
|
|
||||||
-- | Multivariant composition.
|
-- | Multivariable composition.
|
||||||
--
|
--
|
||||||
-- > f .: g ≡ (f .) . g ≡ \c d -> f (g c d)
|
-- > f .: g ≡ (f .) . g ≡ \c d -> f (g c d)
|
||||||
(.:) :: (a -> b) -> (c -> d -> a) -> c -> d -> b
|
(.:) :: (a -> b) -> (c -> d -> a) -> c -> d -> b
|
||||||
@ -108,14 +111,19 @@ safeGetWindowAttributes w = withDisplay $ \dpy -> io . alloca $ \p ->
|
|||||||
-- * If it starts with @~\/@, replace that with the actual home
|
-- * If it starts with @~\/@, replace that with the actual home
|
||||||
-- * directory.
|
-- * directory.
|
||||||
--
|
--
|
||||||
-- * Otherwise, prepend a @\/@ to the path.
|
-- * If it starts with @$@, read the name of an environment
|
||||||
|
-- * variable and replace it with the contents of that.
|
||||||
|
--
|
||||||
|
-- * Otherwise, prepend the home directory and @\/@ to the path.
|
||||||
mkAbsolutePath :: MonadIO m => FilePath -> m FilePath
|
mkAbsolutePath :: MonadIO m => FilePath -> m FilePath
|
||||||
mkAbsolutePath ps = do
|
mkAbsolutePath ps = do
|
||||||
home <- liftIO getHomeDirectory
|
home <- io getHomeDirectory
|
||||||
pure $ case ps of
|
case ps of
|
||||||
'/' : _ -> ps
|
'/' : _ -> pure ps
|
||||||
'~' : '/' : _ -> home <> drop 1 ps
|
'~' : '/' : _ -> pure (home <> drop 1 ps)
|
||||||
_ -> home <> ('/' : ps)
|
'$' : _ -> let (v,ps') = span (`elem` ("_"<>['A'..'Z']<>['a'..'z']<>['0'..'9'])) (drop 1 ps)
|
||||||
|
in io ((\(_ :: SomeException) -> pure "") `handle` getEnv v) Exports.<&> (<> ps')
|
||||||
|
_ -> pure (home <> ('/' : ps))
|
||||||
{-# SPECIALISE mkAbsolutePath :: FilePath -> IO FilePath #-}
|
{-# SPECIALISE mkAbsolutePath :: FilePath -> IO FilePath #-}
|
||||||
{-# SPECIALISE mkAbsolutePath :: FilePath -> X FilePath #-}
|
{-# SPECIALISE mkAbsolutePath :: FilePath -> X FilePath #-}
|
||||||
|
|
||||||
|
Loading…
x
Reference in New Issue
Block a user