diff options
author | Michal Minar <miminar@redhat.com> | 2015-07-19 11:25:22 +0200 |
---|---|---|
committer | Michal Minar <miminar@redhat.com> | 2015-07-19 11:25:22 +0200 |
commit | 5b8d5d261850f6bdbfd3eb6f030aacb287b8ad27 (patch) | |
tree | 7f1a3dd685a3e9fd70cbf92476437dd2babdad2c /src/XMonad | |
download | xminad-5b8d5d261850f6bdbfd3eb6f030aacb287b8ad27.tar.gz xminad-5b8d5d261850f6bdbfd3eb6f030aacb287b8ad27.tar.xz xminad-5b8d5d261850f6bdbfd3eb6f030aacb287b8ad27.zip |
Initial commit
Signed-off-by: Michal Minar <miminar@redhat.com>
Diffstat (limited to 'src/XMonad')
-rw-r--r-- | src/XMonad/Layout/TopicDir.hs | 65 |
1 files changed, 65 insertions, 0 deletions
diff --git a/src/XMonad/Layout/TopicDir.hs b/src/XMonad/Layout/TopicDir.hs new file mode 100644 index 0000000..e1af18e --- /dev/null +++ b/src/XMonad/Layout/TopicDir.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} + +module XMonad.Layout.TopicDir ( + -- * Usage + -- $usage + topicDir, + changeDir, + TopicDir, + ) where + +import qualified Data.Map as M +import Control.Exception +import System.Directory (setCurrentDirectory, getCurrentDirectory) + +import XMonad hiding (focus) +import XMonad.Util.Run (runProcessWithInput) +import XMonad.Prompt (XPConfig) +import XMonad.Prompt.Directory (directoryPrompt) +import XMonad.Layout.LayoutModifier +import XMonad.StackSet (tag, currentTag) + +econst :: Monad m => a -> IOException -> m a +econst = const . return + +data Chdir = Chdir String deriving ( Typeable ) +instance Message Chdir + +data TopicDir a = TopicDir (M.Map WorkspaceId String, String) + deriving (Read, Show) + +instance LayoutModifier TopicDir Window where + modifyLayout (TopicDir (tds, d)) w r = do + tc <- gets (currentTag.windowset) + case mdir tc of + (Just dir) -> scd dir + Nothing -> return () + runLayout w r + where + mdir :: WorkspaceId -> Maybe String + mdir tc | tc == tag w && d == "" = M.lookup tc tds + | tc == tag w = Just d + | otherwise = Nothing + + + handleMess (TopicDir (dds, _)) m + | Just (Chdir wd) <- fromMessage m = do + wd' <- cleanDir wd + return $ Just $ TopicDir (dds, wd') + | otherwise = return Nothing + +topicDir :: LayoutClass l a => M.Map WorkspaceId String + -> l a -> ModifiedLayout TopicDir l a +topicDir m = ModifiedLayout (TopicDir (m, "")) + +cleanDir :: String -> X String +cleanDir x = scd x >> io getCurrentDirectory + +scd :: String -> X () +scd x = do + x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` econst x) + catchIO $ setCurrentDirectory x' + +changeDir :: XPConfig -> X () +changeDir c = directoryPrompt c "Set working directory: " (sendMessage . Chdir) + |