summaryrefslogtreecommitdiff
path: root/accounts/gkleen@sif/xmonad
diff options
context:
space:
mode:
Diffstat (limited to 'accounts/gkleen@sif/xmonad')
-rw-r--r--accounts/gkleen@sif/xmonad/.gitignore4
-rw-r--r--accounts/gkleen@sif/xmonad/default.nix7
-rw-r--r--accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs127
-rw-r--r--accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs94
-rw-r--r--accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs105
-rw-r--r--accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs243
-rw-r--r--accounts/gkleen@sif/xmonad/package.yaml30
-rw-r--r--accounts/gkleen@sif/xmonad/stack.nix17
-rw-r--r--accounts/gkleen@sif/xmonad/stack.yaml10
-rw-r--r--accounts/gkleen@sif/xmonad/xmonad-yggdrasil.nix21
-rw-r--r--accounts/gkleen@sif/xmonad/xmonad.hs898
11 files changed, 1556 insertions, 0 deletions
diff --git a/accounts/gkleen@sif/xmonad/.gitignore b/accounts/gkleen@sif/xmonad/.gitignore
new file mode 100644
index 00000000..c11891cd
--- /dev/null
+++ b/accounts/gkleen@sif/xmonad/.gitignore
@@ -0,0 +1,4 @@
1**/#*#
2**/.stack-work/
3/stack.yaml.lock
4/*.cabal
diff --git a/accounts/gkleen@sif/xmonad/default.nix b/accounts/gkleen@sif/xmonad/default.nix
new file mode 100644
index 00000000..8790c12f
--- /dev/null
+++ b/accounts/gkleen@sif/xmonad/default.nix
@@ -0,0 +1,7 @@
1argumentPackages@{ ... }:
2
3let
4 # defaultPackages = (import ./stackage.nix {});
5 # haskellPackages = defaultPackages // argumentPackages;
6 haskellPackages = argumentPackages;
7in haskellPackages.callPackage ./xmonad-yggdrasil.nix {}
diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs
new file mode 100644
index 00000000..e6accdcc
--- /dev/null
+++ b/accounts/gkleen@sif/xmonad/lib/XMonad/Mpv.hs
@@ -0,0 +1,127 @@
1{-# LANGUAGE DeriveGeneric, OverloadedLists, OverloadedStrings, ViewPatterns, ExistentialQuantification, MultiWayIf #-}
2
3module XMonad.Mpv
4 ( MpvCommand(..), MpvResponse(..), MpvException(..)
5 , mpv
6 , mpvDir
7 , mpvAll, mpvOne
8 , mpvResponse
9 ) where
10
11import Data.Aeson
12
13import Data.Monoid
14
15import Network.Socket hiding (recv)
16import Network.Socket.ByteString
17
18import qualified Data.ByteString as BS
19import qualified Data.ByteString.Char8 as CBS
20import qualified Data.ByteString.Lazy as LBS
21
22import GHC.Generics (Generic)
23import Data.Typeable (Typeable)
24import Data.String (IsString(..))
25
26import Control.Exception
27
28import System.IO.Temp (getCanonicalTemporaryDirectory)
29
30import Control.Monad
31import Control.Exception (bracket)
32import Control.Monad.IO.Class (MonadIO(..))
33
34import System.FilePath
35import System.Directory (getDirectoryContents)
36
37import Data.List
38import Data.Either
39import Data.Maybe
40
41import Debug.Trace
42
43
44data MpvCommand
45 = forall a. ToJSON a => MpvSetProperty String a
46 | MpvGetProperty String
47data MpvResponse
48 = MpvError String
49 | MpvSuccess (Maybe Value)
50 deriving (Read, Show, Generic, Eq)
51data MpvException = MpvException String
52 | MpvNoValue
53 | MpvNoParse String
54 deriving (Generic, Typeable, Read, Show)
55instance Exception MpvException
56
57
58instance ToJSON MpvCommand where
59 toJSON (MpvSetProperty name val) = Array ["set_property", fromString name, toJSON val]
60 toJSON (MpvGetProperty name) = Array ["get_property", fromString name]
61
62instance FromJSON MpvResponse where
63 parseJSON = withObject "response object" $ \obj -> do
64 mval <- obj .:? "data"
65 err <- obj .: "error"
66
67 let ret
68 | err == "success" = MpvSuccess mval
69 | otherwise = MpvError err
70
71 return ret
72
73mpvSocket :: FilePath -> (Socket -> IO a) -> IO a
74mpvSocket sockPath = withSocketsDo . bracket mkSock close
75 where
76 mkSock = do
77 sock <- socket AF_UNIX Stream defaultProtocol
78 connect sock $ SockAddrUnix (traceId sockPath)
79 return sock
80
81mpvResponse :: FromJSON v => MpvResponse -> IO v
82mpvResponse (MpvError str) = throwIO $ MpvException str
83mpvResponse (MpvSuccess Nothing) = throwIO MpvNoValue
84mpvResponse (MpvSuccess (Just v)) = case fromJSON v of
85 Success v' -> return v'
86 Error str -> throwIO $ MpvNoParse str
87
88mpv :: FilePath -> MpvCommand -> IO MpvResponse
89mpv sockPath cmd = mpvSocket sockPath $ \sock -> do
90 let message = (`BS.append` "\n") . LBS.toStrict . encode $ Object [("command", toJSON cmd)]
91 traceIO $ show message
92 sendAll sock message
93 let recvAll = do
94 prefix <- recv sock 4096
95 if
96 | (prefix', rest) <- CBS.break (== '\n') prefix
97 , not (BS.null rest) -> return prefix'
98 | BS.null prefix -> return prefix
99 | otherwise -> BS.append prefix <$> recvAll
100 response <- recvAll
101 traceIO $ show response
102 either (ioError . userError) return . traceShowId $ eitherDecodeStrict' response
103
104mpvDir :: Exception e => FilePath -> (FilePath -> [(FilePath, Either e MpvResponse)] -> Maybe MpvCommand) -> IO [(FilePath, Either e MpvResponse)]
105mpvDir dir step = do
106 socks <- filter (".sock" `isSuffixOf`) <$> getDirectoryContents dir
107 go [] socks
108 where
109 go acc [] = return acc
110 go acc (sock:socks)
111 | Just cmd <- step sock acc = do
112 res <- try $ mpv (dir </> sock) cmd
113 go ((sock, res) : acc) socks
114 | otherwise =
115 go acc socks
116
117mpvAll :: FilePath -> MpvCommand -> IO [MpvResponse]
118mpvAll dir cmd = do
119 results <- map snd <$> (mpvDir dir (\_ _ -> Just cmd) :: IO [(FilePath, Either SomeException MpvResponse)])
120 mapM (either throwIO return) results
121
122mpvOne :: FilePath -> MpvCommand -> IO (Maybe MpvResponse)
123mpvOne dir cmd = listToMaybe . snd . partitionEithers . map snd <$> (mpvDir dir step :: IO [(FilePath, Either SomeException MpvResponse)])
124 where
125 step _ results
126 | any (isRight . snd) results = Nothing
127 | otherwise = Just cmd
diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs
new file mode 100644
index 00000000..1caefae5
--- /dev/null
+++ b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyPass.hs
@@ -0,0 +1,94 @@
1module XMonad.Prompt.MyPass
2 (
3 -- * Usages
4 -- $usages
5 mkPassPrompt
6 ) where
7
8import Control.Monad (liftM)
9import XMonad.Core
10import XMonad.Prompt ( XPrompt
11 , showXPrompt
12 , commandToComplete
13 , nextCompletion
14 , getNextCompletion
15 , XPConfig
16 , mkXPrompt
17 , searchPredicate)
18import System.Directory (getHomeDirectory)
19import System.FilePath (takeExtension, dropExtension, combine)
20import System.Posix.Env (getEnv)
21import XMonad.Util.Run (runProcessWithInput)
22
23-- $usages
24-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
25--
26-- > import XMonad.Prompt.Pass
27--
28-- Then add a keybinding for 'passPrompt', 'passGeneratePrompt' or 'passRemovePrompt':
29--
30-- > , ((modMask x , xK_p) , passPrompt xpconfig)
31-- > , ((modMask x .|. controlMask, xK_p) , passGeneratePrompt xpconfig)
32-- > , ((modMask x .|. controlMask .|. shiftMask, xK_p), passRemovePrompt xpconfig)
33--
34-- For detailed instructions on:
35--
36-- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".
37--
38-- - how to setup the password storage, see <http://git.zx2c4.com/password-store/about/>
39--
40
41type Predicate = String -> String -> Bool
42
43getPassCompl :: [String] -> Predicate -> String -> IO [String]
44getPassCompl compls p s
45 | length s <= minL
46 , all ((> minL) . length) compls = return []
47 | otherwise = do return $ filter (p s) compls
48 where
49 minL = 3
50
51type PromptLabel = String
52
53data Pass = Pass PromptLabel
54
55instance XPrompt Pass where
56 showXPrompt (Pass prompt) = prompt ++ ": "
57 commandToComplete _ c = c
58 nextCompletion _ = getNextCompletion
59
60-- | Default password store folder in $HOME/.password-store
61--
62passwordStoreFolderDefault :: String -> String
63passwordStoreFolderDefault home = combine home ".password-store"
64
65-- | Compute the password store's location.
66-- Use the PASSWORD_STORE_DIR environment variable to set the password store.
67-- If empty, return the password store located in user's home.
68--
69passwordStoreFolder :: IO String
70passwordStoreFolder =
71 getEnv "PASSWORD_STORE_DIR" >>= computePasswordStoreDir
72 where computePasswordStoreDir Nothing = liftM passwordStoreFolderDefault getHomeDirectory
73 computePasswordStoreDir (Just storeDir) = return storeDir
74
75-- | A pass prompt factory
76--
77mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X ()
78mkPassPrompt promptLabel passwordFunction xpconfig = do
79 passwords <- io (passwordStoreFolder >>= getPasswords)
80 mkXPrompt (Pass promptLabel) xpconfig (getPassCompl passwords $ searchPredicate xpconfig) passwordFunction
81
82-- | Retrieve the list of passwords from the password storage 'passwordStoreDir
83getPasswords :: FilePath -> IO [String]
84getPasswords passwordStoreDir = do
85 files <- runProcessWithInput "find" [
86 passwordStoreDir,
87 "-type", "f",
88 "-name", "*.gpg",
89 "-printf", "%P\n"] []
90 return $ map removeGpgExtension $ lines files
91
92removeGpgExtension :: String -> String
93removeGpgExtension file | takeExtension file == ".gpg" = dropExtension file
94 | otherwise = file
diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs
new file mode 100644
index 00000000..c268f87d
--- /dev/null
+++ b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs
@@ -0,0 +1,105 @@
1module XMonad.Prompt.MyShell
2 ( Shell (..)
3 , shellPrompt
4 , prompt
5 , safePrompt
6 , unsafePrompt
7 , getCommands
8 , getShellCompl
9 , split
10 ) where
11
12import Codec.Binary.UTF8.String (encodeString)
13import Control.Exception as E
14import Control.Monad (forM)
15import Data.List (isPrefixOf)
16import System.Directory (doesDirectoryExist, getDirectoryContents)
17import System.Environment (getEnv)
18import System.Posix.Files (getFileStatus, isDirectory)
19
20import XMonad hiding (config)
21import XMonad.Prompt
22import XMonad.Util.Run
23
24econst :: Monad m => a -> IOException -> m a
25econst = const . return
26
27data Shell = Shell String
28
29instance XPrompt Shell where
30 showXPrompt (Shell q) = q
31 completionToCommand _ = escape
32
33shellPrompt :: String -> XPConfig -> X ()
34shellPrompt q c = do
35 cmds <- io getCommands
36 mkXPrompt (Shell q) c (getShellCompl cmds) spawn
37
38{- $spawns
39 See safe and unsafeSpawn in "XMonad.Util.Run".
40 prompt is an alias for safePrompt;
41 safePrompt and unsafePrompt work on the same principles, but will use
42 XPrompt to interactively query the user for input; the appearance is
43 set by passing an XPConfig as the second argument. The first argument
44 is the program to be run with the interactive input.
45 You would use these like this:
46
47 > , ((modm, xK_b), safePrompt "firefox" greenXPConfig)
48 > , ((modm .|. shiftMask, xK_c), prompt ("xterm" ++ " -e") greenXPConfig)
49
50 Note that you want to use safePrompt for Firefox input, as Firefox
51 wants URLs, and unsafePrompt for the XTerm example because this allows
52 you to easily start a terminal executing an arbitrary command, like
53 'top'. -}
54
55prompt, unsafePrompt, safePrompt :: String -> FilePath -> XPConfig -> X ()
56prompt = unsafePrompt
57safePrompt q c config = mkXPrompt (Shell q) config (getShellCompl [c]) run
58 where run = safeSpawn c . return
59unsafePrompt q c config = mkXPrompt (Shell q) config (getShellCompl [c]) run
60 where run a = unsafeSpawn $ c ++ " " ++ a
61
62getShellCompl :: [String] -> String -> IO [String]
63getShellCompl cmds s | s == "" || last s == ' ' = return []
64 | otherwise = do
65 f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file -- "
66 ++ s ++ "\n")
67 files <- case f of
68 [x] -> do fs <- getFileStatus (encodeString x)
69 if isDirectory fs then return [x ++ "/"]
70 else return [x]
71 _ -> return f
72 return . uniqSort $ files ++ commandCompletionFunction cmds s
73
74commandCompletionFunction :: [String] -> String -> [String]
75commandCompletionFunction cmds str | '/' `elem` str = []
76 | otherwise = filter (isPrefixOf str) cmds
77
78getCommands :: IO [String]
79getCommands = do
80 p <- getEnv "PATH" `E.catch` econst []
81 let ds = filter (/= "") $ split ':' p
82 es <- forM ds $ \d -> do
83 exists <- doesDirectoryExist d
84 if exists
85 then getDirectoryContents d
86 else return []
87 return . uniqSort . filter ((/= '.') . head) . concat $ es
88
89split :: Eq a => a -> [a] -> [[a]]
90split _ [] = []
91split e l =
92 f : split e (rest ls)
93 where
94 (f,ls) = span (/=e) l
95 rest s | s == [] = []
96 | otherwise = tail s
97
98escape :: String -> String
99escape [] = ""
100escape (x:xs)
101 | isSpecialChar x = '\\' : x : escape xs
102 | otherwise = x : escape xs
103
104isSpecialChar :: Char -> Bool
105isSpecialChar = flip elem " &\\@\"'#?$*()[]{};"
diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs
new file mode 100644
index 00000000..c85d0f92
--- /dev/null
+++ b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MySsh.hs
@@ -0,0 +1,243 @@
1module XMonad.Prompt.MySsh
2 ( -- * Usage
3 -- $usage
4 sshPrompt,
5 Ssh,
6 Override (..),
7 mkOverride,
8 Conn (..),
9 moshCmd,
10 moshCmd',
11 sshCmd,
12 inTmux,
13 withEnv
14 ) where
15
16import XMonad
17import XMonad.Util.Run
18import XMonad.Prompt
19
20import System.Directory
21import System.Environment
22import qualified Control.Exception as E
23
24import Control.Monad
25import Data.Maybe
26
27import Text.Parsec.String
28import Text.Parsec
29import Data.Char (isSpace)
30
31econst :: Monad m => a -> E.IOException -> m a
32econst = const . return
33
34-- $usage
35-- 1. In your @~\/.xmonad\/xmonad.hs@:
36--
37-- > import XMonad.Prompt
38-- > import XMonad.Prompt.Ssh
39--
40-- 2. In your keybindings add something like:
41--
42-- > , ((modm .|. controlMask, xK_s), sshPrompt defaultXPConfig)
43--
44-- Keep in mind, that if you want to use the completion you have to
45-- disable the "HashKnownHosts" option in your ssh_config
46--
47-- For detailed instruction on editing the key binding see
48-- "XMonad.Doc.Extending#Editing_key_bindings".
49
50data Override = Override
51 { oUser :: Maybe String
52 , oHost :: String
53 , oPort :: Maybe Int
54 , oCommand :: Conn -> String
55 }
56
57mkOverride = Override { oUser = Nothing, oHost = "", oPort = Nothing, oCommand = sshCmd }
58sshCmd c = concat
59 [ "ssh -t "
60 , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else ""
61 , cHost c
62 , if isJust $ cPort c then " -p " ++ (show $ fromJust $ cPort c) else ""
63 , " -- "
64 , cCommand c
65 ]
66moshCmd c = concat
67 [ "mosh "
68 , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else ""
69 , cHost c
70 , if isJust $ cPort c then " --ssh=\"ssh -p " ++ (show $ fromJust $ cPort c) ++ "\"" else ""
71 , " -- "
72 , cCommand c
73 ]
74moshCmd' p c = concat
75 [ "mosh "
76 , "--server=" ++ p ++ " "
77 , if isJust $ cUser c then (fromJust $ cUser c) ++ "@" else ""
78 , cHost c
79 , if isJust $ cPort c then " --ssh=\"ssh -p " ++ (show $ fromJust $ cPort c) ++ "\"" else ""
80 , " -- "
81 , cCommand c
82 ]
83inTmux c
84 | null $ cCommand c = c { cCommand = "tmux new-session" }
85 | otherwise = c { cCommand = "tmux new-session \"" ++ (cCommand c) ++ "\"" }
86withEnv :: [(String, String)] -> Conn -> Conn
87withEnv envs c = c { cCommand = "env" ++ (concat $ map (\(n, v) -> ' ' : (n ++ "=" ++ v)) envs) ++ " " ++ (cCommand c) }
88
89data Conn = Conn
90 { cUser :: Maybe String
91 , cHost :: String
92 , cPort :: Maybe Int
93 , cCommand :: String
94 } deriving (Eq, Show, Read)
95
96data Ssh = Ssh
97
98instance XPrompt Ssh where
99 showXPrompt Ssh = "SSH to: "
100 commandToComplete _ c = c
101 nextCompletion _ = getNextCompletion
102
103toConn :: String -> Maybe Conn
104toConn = toConn' . parse connParser "(unknown)"
105toConn' :: Either ParseError Conn -> Maybe Conn
106toConn' (Left _) = Nothing
107toConn' (Right a) = Just a
108
109connParser :: Parser Conn
110connParser = do
111 spaces
112 user' <- optionMaybe $ try $ do
113 str <- many1 $ satisfy (\c -> (not $ isSpace c) && (c /= '@'))
114 char '@'
115 return str
116 host' <- many1 $ satisfy (not . isSpace)
117 port' <- optionMaybe $ try $ do
118 space
119 string "-p"
120 spaces
121 int <- many1 digit
122 (space >> return ()) <|> eof
123 return $ (read int :: Int)
124 spaces
125 command' <- many anyChar
126 eof
127 return $ Conn
128 { cHost = host'
129 , cUser = user'
130 , cPort = port'
131 , cCommand = command'
132 }
133
134sshPrompt :: [Override] -> XPConfig -> X ()
135sshPrompt o c = do
136 sc <- io sshComplList
137 mkXPrompt Ssh c (mkComplFunFromList sc) $ ssh o
138
139ssh :: [Override] -> String -> X ()
140ssh overrides str = do
141 let cmd = applyOverrides overrides str
142 liftIO $ putStr "SSH Command: "
143 liftIO $ putStrLn cmd
144 runInTerm "" cmd
145
146applyOverrides :: [Override] -> String -> String
147applyOverrides [] str = "ssh " ++ str
148applyOverrides (o:os) str = case (applyOverride o str) of
149 Just str -> str
150 Nothing -> applyOverrides os str
151
152applyOverride :: Override -> String -> Maybe String
153applyOverride o str = let
154 conn = toConn str
155 in
156 if isNothing conn then Nothing else
157 case (fromJust conn) `matches` o of
158 True -> Just $ (oCommand o) (fromJust conn)
159 False -> Nothing
160
161matches :: Conn -> Override -> Bool
162a `matches` b = and
163 [ justBool (cUser a) (oUser b) (==)
164 , (cHost a) == (oHost b)
165 , justBool (cPort a) (oPort b) (==)
166 ]
167
168justBool :: Eq a => Maybe a -> Maybe a -> (a -> a -> Bool) -> Bool
169justBool Nothing _ _ = True
170justBool _ Nothing _ = True
171justBool (Just a) (Just b) match = a `match` b
172
173sshComplList :: IO [String]
174sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal
175
176sshComplListLocal :: IO [String]
177sshComplListLocal = do
178 h <- getEnv "HOME"
179 s1 <- sshComplListFile $ h ++ "/.ssh/known_hosts"
180 s2 <- sshComplListConf $ h ++ "/.ssh/config"
181 return $ s1 ++ s2
182
183sshComplListGlobal :: IO [String]
184sshComplListGlobal = do
185 env <- getEnv "SSH_KNOWN_HOSTS" `E.catch` econst "/nonexistent"
186 fs <- mapM fileExists [ env
187 , "/usr/local/etc/ssh/ssh_known_hosts"
188 , "/usr/local/etc/ssh_known_hosts"
189 , "/etc/ssh/ssh_known_hosts"
190 , "/etc/ssh_known_hosts"
191 ]
192 case catMaybes fs of
193 [] -> return []
194 (f:_) -> sshComplListFile' f
195
196sshComplListFile :: String -> IO [String]
197sshComplListFile kh = do
198 f <- doesFileExist kh
199 if f then sshComplListFile' kh
200 else return []
201
202sshComplListFile' :: String -> IO [String]
203sshComplListFile' kh = do
204 l <- readFile kh
205 return $ map (getWithPort . takeWhile (/= ',') . concat . take 1 . words)
206 $ filter nonComment
207 $ lines l
208
209sshComplListConf :: String -> IO [String]
210sshComplListConf kh = do
211 f <- doesFileExist kh
212 if f then sshComplListConf' kh
213 else return []
214
215sshComplListConf' :: String -> IO [String]
216sshComplListConf' kh = do
217 l <- readFile kh
218 return $ map (!!1)
219 $ filter isHost
220 $ map words
221 $ lines l
222 where
223 isHost ws = take 1 ws == ["Host"] && length ws > 1
224
225fileExists :: String -> IO (Maybe String)
226fileExists kh = do
227 f <- doesFileExist kh
228 if f then return $ Just kh
229 else return Nothing
230
231nonComment :: String -> Bool
232nonComment [] = False
233nonComment ('#':_) = False
234nonComment ('|':_) = False -- hashed, undecodeable
235nonComment _ = True
236
237getWithPort :: String -> String
238getWithPort ('[':str) = host ++ " -p " ++ port
239 where (host,p) = break (==']') str
240 port = case p of
241 ']':':':x -> x
242 _ -> "22"
243getWithPort str = str
diff --git a/accounts/gkleen@sif/xmonad/package.yaml b/accounts/gkleen@sif/xmonad/package.yaml
new file mode 100644
index 00000000..48de1a53
--- /dev/null
+++ b/accounts/gkleen@sif/xmonad/package.yaml
@@ -0,0 +1,30 @@
1name: xmonad-yggdrasil
2
3executables:
4 xmonad:
5 dependencies:
6 - base
7 - xmonad
8 - xmonad-contrib
9 - aeson
10 - bytestring
11 - text
12 - temporary
13 - filepath
14 - directory
15 - network
16 - unix
17 - utf8-string
18 - parsec
19 - process
20 - mtl
21 - X11
22 - transformers
23 - containers
24 - hostname
25 - libnotify
26
27 main: xmonad.hs
28 source-dirs:
29 - .
30 - lib
diff --git a/accounts/gkleen@sif/xmonad/stack.nix b/accounts/gkleen@sif/xmonad/stack.nix
new file mode 100644
index 00000000..17a49e04
--- /dev/null
+++ b/accounts/gkleen@sif/xmonad/stack.nix
@@ -0,0 +1,17 @@
1{ ghc, nixpkgs ? import ./nixpkgs.nix {} }:
2
3let
4 haskellPackages = import ./stackage.nix { inherit nixpkgs; };
5 inherit (nixpkgs {}) pkgs;
6in pkgs.haskell.lib.buildStackProject {
7 inherit ghc;
8 inherit (haskellPackages) stack;
9 name = "stackenv";
10 buildInputs = (with pkgs;
11 [ xorg.libX11 xorg.libXrandr xorg.libXinerama xorg.libXScrnSaver xorg.libXext xorg.libXft
12 cairo
13 glib
14 ]) ++ (with haskellPackages;
15 [
16 ]);
17}
diff --git a/accounts/gkleen@sif/xmonad/stack.yaml b/accounts/gkleen@sif/xmonad/stack.yaml
new file mode 100644
index 00000000..b8ed1147
--- /dev/null
+++ b/accounts/gkleen@sif/xmonad/stack.yaml
@@ -0,0 +1,10 @@
1nix:
2 enable: true
3 shell-file: stack.nix
4
5resolver: lts-13.21
6
7packages:
8 - .
9
10extra-deps: []
diff --git a/accounts/gkleen@sif/xmonad/xmonad-yggdrasil.nix b/accounts/gkleen@sif/xmonad/xmonad-yggdrasil.nix
new file mode 100644
index 00000000..e8786d35
--- /dev/null
+++ b/accounts/gkleen@sif/xmonad/xmonad-yggdrasil.nix
@@ -0,0 +1,21 @@
1{ mkDerivation, aeson, base, bytestring, containers, directory
2, filepath, hostname, hpack, mtl, network, parsec, process, stdenv
3, temporary, transformers, unix, utf8-string, X11, xmonad
4, xmonad-contrib, libnotify
5}:
6mkDerivation {
7 pname = "xmonad-yggdrasil";
8 version = "0.0.0";
9 src = ./.;
10 isLibrary = false;
11 isExecutable = true;
12 libraryToolDepends = [ hpack ];
13 executableHaskellDepends = [
14 aeson base bytestring containers directory filepath hostname mtl
15 network parsec process temporary transformers unix utf8-string X11
16 xmonad xmonad-contrib libnotify
17 ];
18 preConfigure = "hpack";
19 license = "unknown";
20 hydraPlatforms = stdenv.lib.platforms.none;
21}
diff --git a/accounts/gkleen@sif/xmonad/xmonad.hs b/accounts/gkleen@sif/xmonad/xmonad.hs
new file mode 100644
index 00000000..f3a59f34
--- /dev/null
+++ b/accounts/gkleen@sif/xmonad/xmonad.hs
@@ -0,0 +1,898 @@
1{-# LANGUAGE TupleSections, ViewPatterns, OverloadedStrings, FlexibleInstances, UndecidableInstances, MultiWayIf #-}
2
3import XMonad
4import XMonad.Hooks.DynamicLog
5import XMonad.Hooks.ManageDocks
6import XMonad.Util.Run
7import XMonad.Util.Loggers
8import XMonad.Util.EZConfig(additionalKeys)
9import System.IO
10import System.IO.Error
11import System.Environment
12import Data.Map (Map)
13import qualified Data.Map as Map
14import qualified XMonad.StackSet as W
15import System.Exit
16import Control.Monad.State (get)
17-- import XMonad.Layout.Spiral
18import Data.Ratio
19import Data.List
20import Data.Char
21import Data.Maybe (fromMaybe, listToMaybe, maybeToList, catMaybes, isJust)
22import XMonad.Layout.Tabbed
23import XMonad.Prompt
24import XMonad.Prompt.Input
25import XMonad.Util.Scratchpad
26import XMonad.Util.NamedScratchpad
27import Control.Monad (sequence, liftM, liftM2, join, void)
28import XMonad.Util.WorkspaceCompare
29import XMonad.Layout.NoBorders
30import XMonad.Layout.PerWorkspace
31import XMonad.Layout.SimplestFloat
32import XMonad.Layout.Renamed
33import XMonad.Layout.Reflect
34import XMonad.Layout.OnHost
35import XMonad.Layout.Combo
36import XMonad.Layout.ComboP
37import XMonad.Layout.Column
38import XMonad.Layout.TwoPane
39import XMonad.Layout.IfMax
40import XMonad.Layout.LayoutBuilder
41import XMonad.Layout.WindowNavigation
42import XMonad.Layout.Dwindle
43import XMonad.Layout.TrackFloating
44import System.Process
45import System.Directory (removeFile)
46import System.Posix.Files
47import System.FilePath ((</>))
48import Control.Concurrent
49import System.Posix.Process (getProcessID)
50import System.IO.Error
51import System.IO
52import XMonad.Hooks.ManageHelpers hiding (CW)
53import XMonad.Hooks.UrgencyHook as U
54import XMonad.Hooks.EwmhDesktops
55import XMonad.StackSet (RationalRect (..))
56import Control.Monad (when, filterM, (<=<))
57import Graphics.X11.ExtraTypes.XF86
58import XMonad.Util.Cursor
59import XMonad.Actions.Warp
60import XMonad.Actions.FloatKeys
61import XMonad.Util.SpawnOnce
62import System.Directory
63import System.FilePath
64import XMonad.Actions.CopyWindow
65import XMonad.Hooks.ServerMode
66import XMonad.Actions.Commands
67import XMonad.Actions.CycleWS
68import XMonad.Actions.RotSlaves
69import XMonad.Actions.UpdatePointer
70import XMonad.Prompt.Window
71import Data.IORef
72import Data.Monoid
73import Data.String
74import qualified XMonad.Actions.PhysicalScreens as P
75
76import XMonad.Layout.IM
77
78import XMonad.Prompt.MyShell
79import XMonad.Prompt.MyPass
80import XMonad.Prompt.MySsh
81
82import XMonad.Mpv
83
84import Network.HostName
85
86import Control.Applicative ((<$>))
87
88import Libnotify as Notify hiding (appName)
89import qualified Libnotify as Notify (appName)
90import Libnotify (Notification)
91-- import System.Information.Battery
92
93import Data.Int (Int32)
94
95import System.Posix.Process
96import System.Posix.Signals
97import System.Posix.IO as Posix
98import Control.Exception
99
100import System.IO.Unsafe
101
102import Control.Monad.Trans.Class
103import Control.Monad.Trans.Maybe
104
105import Data.Fixed (Micro)
106
107import qualified Data.Text as Text
108import Data.Ord (comparing)
109import Debug.Trace
110
111instance MonadIO m => IsString (m ()) where
112 fromString = spawn
113
114type KeyMap = Map (ButtonMask, KeySym) (X ())
115
116data Host = Host
117 { hName :: HostName
118 , hManageHook :: ManageHook
119 , hWsp :: Integer -> WorkspaceId
120 , hCoWsp :: String -> Maybe WorkspaceId
121 , hKeysMod :: XConfig Layout -> (KeyMap -> KeyMap)
122 , hScreens :: [P.PhysicalScreen]
123 , hKbLayouts :: [(String, Maybe String)]
124 , hCmds :: X [(String, X ())]
125 , hKeyUpKeys :: XConfig Layout -> KeyMap
126 }
127
128defaultHost = Host { hName = "unkown"
129 , hManageHook = composeOne [manageScratchTerm]
130 , hWsp = show
131 , hCoWsp = const Nothing
132 , hKeysMod = const id
133 , hScreens = [0,1..]
134 , hKbLayouts = [ ("us", Just "dvp")
135 , ("us", Nothing)
136 , ("de", Nothing)
137 ]
138 , hCmds = return []
139 , hKeyUpKeys = const Map.empty
140 }
141
142browser :: String
143browser = "env MOZ_USE_XINPUT2=1 firefox"
144
145hostFromName :: HostName -> Host
146hostFromName h@("vali") = defaultHost { hName = h
147 , hManageHook = composeOne $ catMaybes [ Just manageScratchTerm
148 , assign "web" $ className =? ".dwb-wrapped"
149 , assign "web" $ className =? "Chromium"
150 , assign "work" $ className =? "Emacs"
151 , assign "media" $ className =? "mpv"
152 ]
153 , hWsp = hWsp
154 , hCoWsp = hCoWsp
155 , hKeysMod = \conf -> Map.union $ (Map.fromList $ join $ map (spawnBindings conf) [ (xK_d, ["chromium", "chromium $(xclip -o)"])
156 , (xK_e, ["emacsclient -c"])
157 ])
158 `Map.union`
159 ( Map.fromList [ ((XMonad.modMask conf .|. controlMask, xK_Return), scratchpadSpawnActionCustom $ (XMonad.terminal conf) ++ " -name scratchpad -title scratchpad -e tmux new-session -D -s scratch")
160 ] )
161 , hScreens = hScreens defaultHost
162 }
163 where
164 workspaceNames = Map.fromList [ (2, "web")
165 , (3, "work")
166 , (10, "media")
167 ]
168 hWsp = wspFromMap workspaceNames
169 hCoWsp = coWspFromMap workspaceNames
170 assign wsp test = (\wsp -> test -?> doShift wsp) <$> hCoWsp wsp
171hostFromName h
172 | h `elem` ["hel", "sif"] = defaultHost { hName = h
173 , hManageHook = namedScratchpadManageHook scratchpads <+> composeOne (catMaybes
174 [ assign "mpv" $ className =? "mpv"
175 , assign "mpv" $ (className =? "URxvt" <&&> title =? "irssi")
176 , assign "mpv" $ (className =? "URxvt" <&&> resource =? "presentation")
177 , assign "mpv" $ stringProperty "WM_WINDOW_ROLE" =? "presentation"
178 , assign "read" $ stringProperty "WM_WINDOW_ROLE" =? "presenter"
179 , assign "mpv" $ className =? "factorio"
180 , assign "web" $ className =? "chromium-browser"
181 , assign "web" $ className =? "Google-chrome"
182 , assign "work" $ (appName =? "Devtools" <&&> className =? "Firefox")
183 , assign "work" $ className =? "Postman"
184 , assign "web" $ className =? "Firefox"
185 , assign "comm" $ (className =? "URxvt" <&&> resource =? "comm")
186 , assign "comm" $ (className =? "Emacs" <&&> title =? "Mail")
187 , assign "comm" $ className =? "Zulip"
188 , assign "comm" $ className =? "Discord"
189 , assign "media" $ (className =? "URxvt" <&&> resource =? "media")
190 , assign "media" $ (className =? "URxvt" <&&> title =? "streamlink")
191 , assign "media" $ (className =? "URxvt" <&&> title =? "mpv")
192 , assign "monitor" $ (className =? "URxvt" <&&> fmap ("monitor" `isInfixOf`) title)
193 , assign "monitor" $ className =? "Grafana"
194 , Just $ (className =? "URxvt" <&&> resource =? "htop") -?> centerFloat
195 , Just $ (className =? "Scp-dbus-service.py") -?> centerFloat
196 , Just $ (className =? "URxvt" <&&> resource =? "log") -?> centerFloat
197 , assign "work" $ className =? "URxvt"
198 , assign' ["work", "uni"] $ (className =? "Emacs" <&&> appName /=? "Edit_with_Emacs_FRAME")
199 , assign' ["work", "uni"] $ className =? "jetbrains-idea-ce"
200 , assign "read" $ className =? "llpp"
201 , assign "read" $ className =? "Evince"
202 , assign "read" $ fmap ("zathura" `isInfixOf`) title
203 , assign "read" $ className =? "MuPDF"
204 , assign "read" $ className =? "Xournal"
205 , assign "read" $ appName =? "com-trollworks-gcs-app-GCS"
206 , assign "read" $ appName =? "Tux.py"
207 , assign "read" $ className =? "Gnucash"
208 , assign "comm" $ className =? "Skype"
209 , assign "comm" $ className =? "Daily"
210 , assign "comm" $ className =? "Pidgin"
211 , assign "comm" $ className =? "Slack"
212 , Just $ (resource =? "xvkbd") -?> doRectFloat $ RationalRect (1 % 8) (3 % 8) (6 % 8) (4 % 8)
213 , Just $ (stringProperty "_NET_WM_WINDOW_TYPE" =? "_NET_WM_WINDOW_TYPE_DIALOG") -?> doFloat
214 , Just $ (className =? "Dunst") -?> doFloat
215 , Just $ (className =? "Xmessage") -?> doCenterFloat
216 , Just $ (className =? "Nm-openconnect-auth-dialog") -?> centerFloat
217 , Just $ (className =? "Pinentry") -?> doCenterFloat
218 , Just $ (className =? "pinentry") -?> doCenterFloat
219 , Just $ (appName =? "Edit_with_Emacs_FRAME") -?> centerFloat
220 , Just $ (stringProperty "WM_WINDOW_ROLE" =? "GtkFileChooseDialog") -?> centerFloatSmall
221 , Just $ (className =? "Nvidia-settings") -?> doCenterFloat
222 , Just $ fmap ("Minetest" `isInfixOf`) title -?> doIgnore
223 , Just $ fmap ("Automachef" `isInfixOf`) title -?> doIgnore
224 ])
225 , hWsp = hWsp
226 , hCoWsp = hCoWsp
227 , hKeysMod = \conf -> Map.union $ (Map.fromList $ join $ map (spawnBindings conf) [ (xK_e, ["emacsclient -c"])
228 , (xK_d, [fromString browser, fromString $ browser ++ " $(xclip -o)", fromString $ "notmuch-links"])
229 , (xK_f, ["urxvtc -name comm -title Feeds -e mosh odin -- tmux new-session -ADs comm"])
230 , (xK_c, [ inputPrompt xPConfig "dc" ?+ dc ])
231 , (xK_g, ["pidgin"])
232 , (xK_s, ["skype"])
233 -- , (xK_p, [mkPassPrompt "Type password" pwType xPConfig, mkPassPrompt "Show password" pwShow xPConfig, mkPassPrompt "Copy password" pwClip xPConfig])
234 , (xK_w, ["sudo rewacom"])
235 , (xK_y, [ "tmux new-window -dt media /var/media/link.hs $(xclip -o)"
236 , "urxvtc -name media -e tmuxp load /var/media"
237 ])
238 , (xK_l, [ "tmux new-window -dt media mpv $(xclip -o)"
239 , "tmux new-window -dt media streamlink --retry-open 10 $(xclip -o)"
240 ])
241 , (xK_m, [ "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e '(notmuch)'"
242 , "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e '(notmuch-mua-new-mail)'"
243 , "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e \"(browse-url-mail \"$(xclip -o)\")\""
244 ])
245 , (xK_Return, ["keynav start,windowzoom", "keynav start"])
246 , (xK_t, [inputPrompt xPConfig "fuzzytime timer" ?+ fuzzytime, fuzzytime "unset", work_fuzzytime])
247 , (xK_a, [inputPrompt xPConfig "adjmix" ?+ adjmix])
248 , (xK_s, [ inputPromptWithCompl xPConfig "start synergy" synergyCompl ?+ synergyStart
249 , inputPromptWithCompl xPConfig "stop synergy" synergyCompl ?+ synergyStop
250 ])
251 , (xK_h, [ "urxvtc -name htop -e htop"
252 , "urxvtc -name log -e journalctl -xef"
253 ])
254 , (xK_x, [ "autorandr -c"
255 , "autorandr -fl default"
256 ])
257 , (xK_z, [ "zulip -- --force-device-scale-factor=2"
258 ])
259 ])
260 `Map.union`
261 ( Map.fromList [ ((XMonad.modMask conf .|. controlMask, xK_Return), namedScratchpadAction scratchpads "term")
262 , ((XMonad.modMask conf .|. controlMask, xK_a), namedScratchpadAction scratchpads "pavucontrol")
263 , ((XMonad.modMask conf .|. controlMask, xK_w), namedScratchpadAction scratchpads "alarms")
264 , ((XMonad.modMask conf .|. controlMask, xK_b), namedScratchpadAction scratchpads "blueman")
265 , ((XMonad.modMask conf .|. controlMask, xK_p), namedScratchpadAction scratchpads "keepassxc")
266 , ((XMonad.modMask conf .|. controlMask, xK_t), namedScratchpadAction scratchpads "toggl")
267 , ((XMonad.modMask conf .|. controlMask, xK_e), namedScratchpadAction scratchpads "emacs")
268 , ((XMonad.modMask conf .|. controlMask, xK_m), namedScratchpadAction scratchpads "calendar")
269 , ((XMonad.modMask conf .|. controlMask, xK_f), namedScratchpadAction scratchpads "music")
270 , ((XMonad.modMask conf .|. mod1Mask, xK_Up), rotate U)
271 , ((XMonad.modMask conf .|. mod1Mask, xK_Down), rotate D)
272 , ((XMonad.modMask conf .|. mod1Mask, xK_Left), rotate L)
273 , ((XMonad.modMask conf .|. mod1Mask, xK_Right), rotate R)
274 -- , ((XMonad.modMask conf .|. shiftMask, xK_a), startMute "hel")
275 ] )
276 , hKeyUpKeys = \conf -> Map.fromList [ -- ((XMonad.modMask conf .|. shiftMask, xK_a), stopMute "hel")
277 ]
278 , hScreens = hScreens defaultHost
279 , hCmds = return [ ("prev-workspace", prevWS)
280 , ("next-workspace", nextWS)
281 , ("prev-window", rotAllDown)
282 , ("next-window", rotAllUp)
283 , ("banish", banishScreen LowerRight)
284 , ("update-gpg-tty", safeSpawn "gpg-connect-agent" ["UPDATESTARTUPTTY", "/bye"])
285 , ("rescreen", rescreen)
286 , ("repanel", do
287 spawn "nm-applet"
288 spawn "blueman-applet"
289 spawn "pasystray"
290 spawn "kdeconnect-indicator"
291 spawn "dunst -print"
292 spawn "udiskie"
293 spawn "autocutsel -s PRIMARY"
294 spawn "autocutsel -s CLIPBOARD"
295 )
296 , ("pause", mediaMpv $ MpvSetProperty "pause" True)
297 , ("unpause", mediaMpv $ MpvSetProperty "pause" False)
298 , ("exit", io $ exitWith ExitSuccess)
299 ]
300 }
301 where
302 withGdkScale act = void . xfork $ setEnv "GDK_SCALE" "2" >> act
303 workspaceNames = Map.fromList [ (1, "comm")
304 , (2, "web")
305 , (3, "work")
306 , (4, "read")
307 , (5, "monitor")
308 , (6, "uni")
309 , (9, "media")
310 , (10, "mpv")
311 ]
312 scratchpads = [ NS "term" "urxvtc -name scratchpad -title scratchpad -e tmux new-session -AD -s scratch" (resource =? "scratchpad") centerFloat
313 , NS "pavucontrol" "pavucontrol" (resource =? "pavucontrol") centerFloat
314 , NS "alarms" "alarm-clock-applet" (className =? "Alarm-clock-applet" <&&> title =? "Alarms") centerFloat
315 , NS "blueman" "blueman-manager" (className =? ".blueman-manager-wrapped") centerFloat
316 , NS "keepassxc" "keepassxc" (className =? "KeePassXC") centerFloat
317 , NS "toggl" "toggldesktop" (className =? "Toggl Desktop") centerFloat
318 , NS "calendar" "minetime -- --force-device-scale-factor=1.6" (className =? "MineTime") centerFloat
319 , NS "emacs" "emacsclient -c -F \"'(title . \\\"Scratchpad\\\")\"" (className =? "Emacs" <&&> title =? "Scratchpad") centerFloat
320 , NS "music" "google-play-music-desktop-player --force-device-scale-factor=1.6" (className =? "Google Play Music Desktop Player") centerFloat
321 ]
322 centerFloat = customFloating $ RationalRect (1 % 16) (1 % 16) (7 % 8) (7 % 8)
323 centerFloatSmall = customFloating $ RationalRect (1 % 4) (1 % 4) (1 % 2) (1 % 2)
324 hWsp = wspFromMap workspaceNames
325 hCoWsp = coWspFromMap workspaceNames
326 assign wsp test = (\wsp -> test -?> doShift wsp) <$> hCoWsp wsp
327 assign' :: [String] -> Query Bool -> Maybe MaybeManageHook
328 assign' wsps test = do
329 wsIds <- mapM hCoWsp wsps
330 return $ test -?> go wsIds
331 where
332 go :: [WorkspaceId] -> ManageHook
333 go wsps = do
334 visWsps <- liftX $ (\wset -> W.tag . W.workspace <$> W.current wset : W.visible wset) <$> gets windowset
335 case (filter (`elem` visWsps) wsps, wsps) of
336 (wsp : _, _) -> doShift wsp
337 (_, wsp : _) -> doShift wsp
338 ([], []) -> return mempty
339 rotate rot = do
340 safeSpawn "xrandr" ["--output", "eDP-1", "--rotate", xrandrDir]
341 mapM_ rotTouch touchscreens
342 where
343 xrandrDir = case rot of
344 U -> "normal"
345 L -> "left"
346 R -> "right"
347 D -> "inverted"
348 matrix = case rot of
349 U -> [ [ 1, 0, 0]
350 , [ 0, 1, 0]
351 , [ 0, 0, 1]
352 ]
353 L -> [ [ 0, -1, 1]
354 , [ 1, 0, 0]
355 , [ 0, 0, 1]
356 ]
357 R -> [ [ 0, 1, 0]
358 , [-1, 0, 1]
359 , [ 0, 0, 1]
360 ]
361 D -> [ [-1, 0, 1]
362 , [ 0, -1, 1]
363 , [ 0, 0, 1]
364 ]
365 touchscreens = [ "Wacom Co.,Ltd. Pen and multitouch sensor Finger touch"
366 , "Wacom Co.,Ltd. Pen and multitouch sensor Pen stylus"
367 , "Wacom Co.,Ltd. Pen and multitouch sensor Pen eraser"
368 ]
369 rotTouch screen = do
370 safeSpawn "xinput" $ ["set-prop", screen, "Coordinate Transformation Matrix"] ++ map (\n -> show n ++ ",") (concat matrix)
371 safeSpawn "xinput" ["map-to-output", screen, "eDP-1"]
372 withPw f label = io . void . forkProcess $ do
373 uninstallSignalHandlers
374 void $ createSession
375 (dropWhileEnd isSpace -> pw) <- readCreateProcess (proc "pass" ["show", label]) ""
376 void $ f pw
377 pwType :: String -> X ()
378 pwType = withPw $ readCreateProcess (proc "xdotool" ["type", "--clearmodifiers", "--file", "-"])
379 pwClip label = safeSpawn "pass" ["show", "--clip", label]
380 pwShow :: String -> X ()
381 pwShow = withPw $ \pw -> do
382 xmessage <- fromMaybe "xmessage" <$> liftIO (lookupEnv "XMONAD_XMESSAGE")
383 readCreateProcess (proc xmessage ["-file", "-"]) pw
384 fuzzytime str = safeSpawn "fuzzytime" $ "timer" : words str
385 work_fuzzytime = io . void . forkProcess $ do
386 readCreateProcess (proc "worktime" []) "" >>= safeSpawn "fuzzytime" . ("timer" : ) . pure
387 adjmix str = safeSpawn "adjmix" $ words str
388 dc expr = void . xfork $ do
389 result <- readProcess "dc" [] $ expr ++ "f"
390 let
391 (first : rest) = filter (not . null) $ lines result
392 notification = Notify.summary first <> Notify.body (unlines rest) <> Notify.timeout Infinite <> Notify.urgency Normal <> Notify.appName "dc"
393 void $ Notify.display notification
394 synergyCompl = mkComplFunFromList' ["mathw86"]
395 synergyStart host = safeSpawn "systemctl" ["--user", "start", "synergy-rtunnel@" ++ host ++ ".service"]
396 synergyStop host = safeSpawn "systemctl" ["--user", "stop", "synergy-rtunnel@" ++ host ++ ".service"]
397
398hostFromName _ = defaultHost
399
400-- muteRef :: IORef (Maybe (String, Notification))
401-- {-# NOINLINE muteRef #-}
402-- muteRef = unsafePerformIO $ newIORef Nothing
403
404-- startMute, stopMute :: String -> X ()
405-- startMute sink = liftIO $ do
406-- muted <- isJust <$> readIORef muteRef
407-- when (not muted) $ do
408-- let
409-- notification = Notify.summary "Muted" <> Notify.timeout Infinite <> Notify.urgency Normal
410-- level = "0.0dB"
411-- -- level <- runProcessWithInput "ssh" ["bragi", "cat", "/dev/shm/mix/" ++ sink ++ "/level"] ""
412-- -- callProcess "ssh" ["bragi", "adjmix", "-t", sink, "-o", "0"]
413-- hPutStrLn stderr "Mute"
414-- writeIORef muteRef . Just . (level, ) =<< Notify.display notification
415-- stopMute sink = liftIO $ do
416-- let
417-- unmute (Just (level, notification)) = do
418-- hPutStrLn stderr "Unmute"
419-- -- callProcess "ssh" ["bragi", "adjmix", "-t", sink, "-o", level]
420-- Notify.close notification
421-- unmute Nothing = return ()
422-- muted <- isJust <$> readIORef muteRef
423-- when muted . join . atomicModifyIORef muteRef $ (Nothing, ) . unmute
424
425wspFromMap workspaceNames = \i -> case Map.lookup i workspaceNames of
426 Just str -> show i ++ " " ++ str
427 Nothing -> show i
428
429coWspFromMap workspaceNames = \str -> case filter ((== str) . snd) $ Map.toList workspaceNames of
430 [] -> Nothing
431 [(i, _)] -> Just $ wspFromMap workspaceNames i
432 _ -> Nothing
433
434spawnModifiers = [0, controlMask, shiftMask .|. controlMask]
435spawnBindings :: XConfig layout -> (KeySym, [X ()]) -> [((KeyMask, KeySym), X ())]
436spawnBindings conf (k, cmds) = zipWith (\m cmd -> ((modm .|. mod1Mask .|. m, k), cmd)) spawnModifiers cmds
437 where
438 modm = XMonad.modMask conf
439
440manageScratchTerm = (resource =? "scratchpad" <||> resource =? "keysetup") -?> doRectFloat $ RationalRect (1 % 16) (1 % 16) (7 % 8) (7 % 8)
441
442tabbedLayout t = renamed [Replace "Tabbed"] $ reflectHoriz $ t CustomShrink $ tabbedTheme
443tabbedLayoutHoriz t = renamed [Replace "Tabbed Horiz"] $ reflectVert $ t CustomShrink $ tabbedTheme
444tabbedTheme = def
445 { activeColor = "black"
446 , inactiveColor = "black"
447 , urgentColor = "black"
448 , activeBorderColor = "grey"
449 , inactiveBorderColor = "#202020"
450 , urgentBorderColor = "#bb0000"
451 , activeTextColor = "grey"
452 , inactiveTextColor = "grey"
453 , urgentTextColor = "grey"
454 , decoHeight = 32
455 , fontName = "xft:Fira Mono for Powerline:style=Medium:pixelsize=22.5"
456 }
457
458main :: IO ()
459main = do
460 arguments <- either (const []) id <$> tryIOError getArgs
461 case arguments of
462 ["--command", s] -> do
463 d <- openDisplay ""
464 rw <- rootWindow d $ defaultScreen d
465 a <- internAtom d "XMONAD_COMMAND" False
466 m <- internAtom d s False
467 allocaXEvent $ \e -> do
468 setEventType e clientMessage
469 setClientMessageEvent e rw a 32 m currentTime
470 sendEvent d rw False structureNotifyMask e
471 sync d False
472 _ -> do
473 -- batteryMon <- xfork $ monitorBattery Nothing Nothing
474 hostname <- getHostName
475 let
476 host = hostFromName hostname
477 setEnv "HOST" hostname
478 let myConfig = withHostUrgency . ewmh $ docks def
479 { manageHook = hManageHook host
480 , terminal = "urxvtc"
481 , layoutHook = smartBorders . avoidStruts $ windowNavigation layout'
482 , logHook = do
483 dynamicLogString xmobarPP' >>= writeProps
484 updatePointer (99 % 100, 98 % 100) (0, 0)
485 , modMask = mod4Mask
486 , keys = \conf -> hKeysMod host conf $ myKeys' conf host
487 , workspaces = take (length numKeys) $ map wsp [1..]
488 , startupHook = setDefaultCursor xC_left_ptr
489 , normalBorderColor = "#202020"
490 , focusedBorderColor = "grey"
491 , handleEventHook = fullscreenEventHook <+> (serverModeEventHookCmd' $ hCmds host) <+> keyUpEventHook
492 }
493 writeProps str = do
494 let encodeCChar = map $ fromIntegral . fromEnum
495 atoms = [ "_XMONAD_WORKSPACES"
496 , "_XMONAD_LAYOUT"
497 , "_XMONAD_TITLE"
498 ]
499 (flip mapM_) (zip atoms (lines str)) $ \(atom', content) -> do
500 ustring <- getAtom "UTF8_STRING"
501 atom <- getAtom atom'
502 withDisplay $ \dpy -> io $ do
503 root <- rootWindow dpy $ defaultScreen dpy
504 changeProperty8 dpy root atom ustring propModeReplace $ encodeCChar content
505 sync dpy True
506 wsp = hWsp host
507 -- We can´t define per-host layout modifiers because we lack dependent types
508 layout' = onHost "skadhi" ( onWorkspace (wsp 1) (Full ||| withIM (1%5) (Title "Buddy List") tabbedLayout') $
509 onWorkspace (wsp 10) Full $
510 onWorkspace (wsp 2) (Full ||| tabbedLayout') $
511 onWorkspace (wsp 5) tabbedLayout' $
512 onWorkspace (wsp 8) (withIM (1%5) (Title "Friends") tabbedLayout') $
513 defaultLayouts
514 ) $
515 onHost "vali" ( onWorkspace (wsp 2) (Full ||| tabbedLayout' ||| combineTwo (TwoPane 0.01 0.57) Full tabbedLayout') $
516 onWorkspace (wsp 3) workLayouts $
517 defaultLayouts
518 ) $
519 onHost "hel" ( onWorkspace (wsp 1) (withIM (1 % 8) (Title "Buddy List") $ trackFloating tabbedLayout') $
520 onWorkspace (wsp 2) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $
521 onWorkspace (wsp 3) workLayouts $
522 onWorkspace (wsp 6) workLayouts $
523 onWorkspace (wsp 4) (tabbedLayout' ||| tabbedLayoutHoriz' ||| Dwindle R CW 1 (5 % 100)) $
524 onWorkspace (wsp 5) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $
525 onWorkspace (wsp 10) (tabbedLayout''' ||| combineTwoP (TwoPane (1 % 100) (3 % 4)) tabbedLayout''' tabbedLayout''' (ClassName "mpv") ||| Dwindle R CW 1 (5 % 100)) $
526 defaultLayouts
527 ) $
528 onHost "sif" ( onWorkspace (wsp 1) (withIM (1 % 8) (Title "Buddy List") $ trackFloating tabbedLayout') $
529 onWorkspace (wsp 2) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $
530 onWorkspace (wsp 3) workLayouts $
531 onWorkspace (wsp 6) workLayouts $
532 onWorkspace (wsp 4) (tabbedLayout' ||| tabbedLayoutHoriz' ||| Dwindle R CW 1 (5 % 100)) $
533 onWorkspace (wsp 5) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $
534 onWorkspace (wsp 10) (tabbedLayout''' ||| combineTwoP (TwoPane (1 % 100) (3 % 4)) tabbedLayout''' tabbedLayout''' (ClassName "mpv") ||| Dwindle R CW 1 (5 % 100)) $
535 defaultLayouts
536 ) $
537 defaultLayouts
538 -- tabbedLayout''' = renamed [Replace "Tabbed'"] $ IfMax 1 (noBorders Full) (tabbedLayout tabbedBottomAlways)
539 tabbedLayout''' = tabbedLayout tabbedBottom
540 tabbedLayout' = tabbedLayout tabbedBottomAlways
541 tabbedLayoutHoriz' = tabbedLayoutHoriz tabbedLeftAlways
542 defaultLayouts = {- spiralWithDir East CW (1 % 2) -} Dwindle R CW 1 (5 % 100) ||| tabbedLayout' ||| Full
543 -- workLayouts = {- spiralWithDir East CW (1 % 2) -} Dwindle R CW (2 % 1) (5 % 100) ||| tabbedLayout' ||| Full
544 workLayouts = tabbedLayout' ||| (renamed [Replace "Combined"] $ combineTwoP (TwoPane (1 % 100) (1891 % 2560)) tabbedLayout''' (Column 1.6) (ClassName "Postman" `Or` ClassName "Emacs" `Or` ClassName "jetbrains-idea-ce" `Or` (Resource "Devtools" `And` ClassName "Firefox"))) ||| Full ||| Dwindle R CW 1 (5 % 100)
545 sqrtTwo = approxRational (sqrt 2) (1 / 2560)
546 xmobarPP' = xmobarPP { ppTitle = shorten 80
547 , ppSort = (liftM2 (.)) getSortByIndex $ return scratchpadFilterOutWorkspace
548 , ppUrgent = wrap "(" ")" . xmobarColor "red" ""
549 , ppHiddenNoWindows = xmobarColor "#202020" "" . wrap "(" ")"
550 , ppVisible = wrap "(" ")" . xmobarColor "yellow" ""
551 , ppCurrent = wrap "(" ")" . xmobarColor "green" ""
552 , ppHidden = wrap "(" ")"
553 , ppWsSep = " "
554 , ppSep = "\n"
555 }
556 withHostUrgency = case hostname of
557 "hel" -> withUrgencyHookC urgencyHook' $ urgencyConfig { suppressWhen = U.Never, remindWhen = Dont }
558 "sif" -> withUrgencyHookC urgencyHook' $ urgencyConfig { suppressWhen = U.Never, remindWhen = Dont }
559 _ -> id
560 urgencyHook' window = do
561 runQuery ((resource =? "comm" <||> resource =? "Pidgin" <||> className =? "Gajim" <||> className =? "Skype") --> safeSpawn "thinklight" ["Blink", "100"]) window
562 urgencyHook (BorderUrgencyHook { urgencyBorderColor = "#bb0000" }) window
563 shutdown :: SomeException -> IO a
564 shutdown e = do
565 let pids = [ -- batteryMon
566 ]
567 mapM_ (signalProcess sigTERM) pids
568 mapM_ (getProcessStatus False False) pids
569 throw e
570 keyUpEventHook :: Event -> X All
571 keyUpEventHook event = handle event >> return (All True)
572 where
573 handle (KeyEvent { ev_event_type = t, ev_state = m, ev_keycode = code })
574 | t == keyRelease = withDisplay $ \dpy -> do
575 s <- io $ keycodeToKeysym dpy code 0
576 mClean <- cleanMask m
577 ks <- asks $ hKeyUpKeys host . config
578 userCodeDef () $ whenJust (Map.lookup (mClean, s) ks) id
579 | otherwise = return ()
580 handle _ = return ()
581 handle shutdown $ launch myConfig
582
583secs :: Int -> Int
584secs = (* 1000000)
585
586-- monitorBattery :: Maybe BatteryContext -> Maybe Notification -> IO ()
587-- monitorBattery Nothing n = do
588-- ctx <- batteryContextNew
589-- case ctx of
590-- Nothing -> threadDelay (secs 10) >> monitorBattery Nothing n
591-- Just _ -> monitorBattery ctx n
592-- monitorBattery ctx@(Just ctx') n = do
593-- batInfo <- getBatteryInfo ctx'
594-- case batInfo of
595-- Nothing -> threadDelay (secs 1) >> monitorBattery ctx n
596-- Just batInfo -> do
597-- let n'
598-- | batteryState batInfo == BatteryStateDischarging
599-- , timeLeft <= 1200
600-- , timeLeft > 0 = Just $ summary "Discharging" <> hint "value" percentage <> urgency u <> body (duz timeLeft ++ "left")
601-- | otherwise = Nothing
602-- u
603-- | timeLeft <= 600 = Critical
604-- | timeLeft <= 1800 = Normal
605-- | otherwise = Low
606-- timeLeft = batteryTimeToEmpty batInfo
607-- percentage :: Int32
608-- percentage = round $ batteryPercentage batInfo
609-- ts = [("s", 60), ("m", 60), ("h", 24), ("d", 365), ("y", 1)]
610-- duz ms = ss
611-- where (ss, _) = foldl (\(ss, x) (s, y) -> ((if rem x y > 0 then show (rem x y) ++ s ++ " " else "") ++ ss , quot x y)) ("", ms) ts
612-- case n' of
613-- Just n' -> Notify.display (maybe mempty reuse n <> Notify.appName "monitorBattery" <> n') >>= (\n -> threadDelay (secs 2) >> monitorBattery ctx (Just n))
614-- Nothing -> threadDelay (secs 30) >> monitorBattery ctx n
615
616disableTouchpad, disableTrackpoint, enableTrackpoint, enableTouchpad :: X ()
617enableTouchpad = safeSpawn "xinput" ["enable", "SynPS/2 Synaptics TouchPad"]
618disableTouchpad = safeSpawn "xinput" ["disable", "SynPS/2 Synaptics TouchPad"]
619enableTrackpoint = safeSpawn "xinput" ["enable", "TPPS/2 IBM TrackPoint"]
620disableTrackpoint = safeSpawn "xinput" ["disable", "TPPS/2 IBM TrackPoint"]
621
622isDisabled :: String -> X Bool
623isDisabled str = do
624 out <- runProcessWithInput "xinput" ["list", str] ""
625 return $ "disabled" `isInfixOf` out
626
627
628spawnKeychain :: X ()
629spawnKeychain = do
630 home <- liftIO getHomeDirectory
631 let keys = (map ((home </>) . (".ssh/" ++)) ["id", "id-rsa"]) ++ ["6B13AA67"]
632 liftIO (maybe (return ()) (setEnv "SSH_ASKPASS") =<< findAskpass)
633 safeSpawn "keychain" . (["--agents", "gpg,ssh"] ++)=<< liftIO (filterM doesFileExist keys)
634 where
635 findAskpass = filter `liftM` readFile "/etc/zshrc"
636 filter = listToMaybe . catMaybes . map (stripPrefix "export SSH_ASKPASS=") . lines
637
638assimilateKeychain :: X ()
639assimilateKeychain = liftIO $ assimilateKeychain' >> return ()
640assimilateKeychain' = tryIOError $ do
641 -- pid <- getProcessID
642 -- tmpDir <- lookupEnv "TMPDIR"
643 -- let tmpDir' = fromMaybe "/tmp" tmpDir
644 -- tmpFile = tmpDir' </> "xmonad-keychain" ++ (show pid) ++ ".env"
645 env <- runProcessWithInput "sh" ["-c", "eval $(keychain --eval --noask --agents gpg,ssh); env"] "" -- > " ++ tmpFile] ""
646 -- env <- readFile tmpFile
647 let envVars = Map.fromList $ map (\(k, v) -> (k, tail' v)) $ map (span (/= '=')) $ envLines
648 envVars' = Map.filterWithKey (\k _ -> k `elem` transfer) envVars
649 transfer = ["SSH_AUTH_SOCK", "SSH_AGENT_PID", "GPG_AGENT_INFO"]
650 envLines = filter (elem '=') $ lines env :: [String]
651 sequence $ map (\(k, c) -> setEnv k c) $ Map.toList envVars'
652 -- removeFile tmpFile
653 where
654 tail' [] = []
655 tail' (x:xs) = xs
656
657
658numKeys = [xK_parenleft, xK_parenright, xK_braceright, xK_plus, xK_braceleft, xK_bracketright, xK_bracketleft, xK_exclam, xK_equal, xK_asterisk]
659
660instance Shrinker CustomShrink where
661 shrinkIt _ "" = [""]
662 shrinkIt s cs
663 | length cs >= 4 = cs : shrinkIt s ((reverse . drop 4 . reverse $ cs) ++ "...")
664 | otherwise = cs : shrinkIt s (init cs)
665
666xPConfig :: XPConfig
667xPConfig = def
668 { font = "xft:Fira Mono for Powerline:style=Medium:pixelsize=22.5"
669 , height = 32
670 , bgColor = "black"
671 , fgColor = "grey"
672 , fgHLight = "green"
673 , bgHLight = "black"
674 , borderColor = "grey"
675 , searchPredicate = (\needle haystack -> all (`isInfixOf` map toLower haystack) . map (map toLower) $ words needle)
676 , position = Top
677 }
678
679sshOverrides = map (\h -> mkOverride { oHost = h, oCommand = moshCmd . inTmux } )
680 [
681 "odin", "odin.asgard.yggdrasil"
682 , "ymir", "ymir.yggdrasil.li", "ymir.niflheim.yggdrasil"
683 , "surtr", "yggdrasil.li", "surtr.yggdrasil.li", "praseodym.org", "surtr.praseodym.org", "surtr.141.li", "141.li"
684 , "vindler", "vindler.alfheim.yggdrasil"
685 , "ullr"
686 , "heimdallr", "heimdallr.asgard.yggdrasil"
687 , "testworx"
688 ]
689 ++
690 map (\h -> mkOverride { oHost = h, oCommand = moshCmd' "/run/current-system/sw/bin/mosh-server" . withEnv [("TERM", "xterm")] . inTmux} )
691 [ "bragi", "bragi.asgard.yggdrasil"
692 ]
693 ++
694 map (\h -> mkOverride { oHost = h, oCommand = sshCmd . withEnv [("TERM", "xterm")] . inTmux } )
695 [ "remote.cip.ifi.lmu.de"
696 , "uniworx3", "uniworx4", "uniworxdb"
697 ]
698
699backlight :: (Rational -> Rational) -> X ()
700backlight f = void . xfork . liftIO $ do
701 [ _device
702 , _class
703 , read . Text.unpack -> currentBright
704 , _currentPercentage
705 , read . Text.unpack -> maximumBright
706 ] <- Text.splitOn "," . Text.pack <$> readProcess "brightnessctl" ["-m"] ""
707 let current = currentBright % maximumBright
708 new' = f current * fromIntegral maximumBright
709 new :: Integer
710 new | floor new' < 0 = 0
711 | ceiling new' > maximumBright = maximumBright
712 | new' >= maximumBright % 2 = ceiling new'
713 | otherwise = floor new'
714 callProcess "brightnessctl" ["-m", "s", show new]
715
716cycleThrough :: [Rational] -> (Rational -> Rational)
717cycleThrough opts current = fromMaybe currentOpt $ listToMaybe next'
718 where currentOpt = minimumBy (comparing $ abs . subtract current) opts
719 (_, _ : next') = break (== currentOpt) opts
720
721cycleKbLayout :: [(String, Maybe String)] -> X ()
722cycleKbLayout [] = return ()
723cycleKbLayout layouts = liftIO $ do
724 next <- (getNext . extract) `liftM` runProcessWithInput "setxkbmap" ["-query"] ""
725 let
726 args = case next of
727 (l, Just v) -> [l, v]
728 (l, Nothing) -> [l]
729 safeSpawn "setxkbmap" args
730 where
731 extract :: String -> Maybe (String, Maybe String)
732 extract str = listToMaybe $ do
733 ["layout:", l] <- str'
734 [(l, Just v) | ["variant:", v] <- str'] ++ pure (l, Nothing)
735 where
736 str' = map words $ lines str
737 getNext :: Maybe (String, Maybe String) -> (String, Maybe String)
738 getNext = maybe (head layouts) getNext'
739 getNext' x = case elemIndex x layouts of
740 Nothing -> getNext Nothing
741 Just i -> layouts !! ((i + 1) `mod` length layouts)
742
743mpvAll' :: MpvCommand -> IO [MpvResponse]
744mpvAll' = mpvAll "/var/media/.mpv-ipc"
745
746mpvOne' :: MpvCommand -> IO (Maybe MpvResponse)
747mpvOne' = mpvOne "/var/media/.mpv-ipc"
748
749mediaMpv :: MpvCommand -> X ()
750mediaMpv cmd = void . xfork $ print =<< mpvAll' cmd
751
752mediaMpvTogglePause :: X ()
753mediaMpvTogglePause = void . xfork $ do
754 paused <- mapM mpvResponse <=< mpvAll' $ MpvGetProperty "pause"
755 if
756 | and paused -> print <=< mpvAll' $ MpvSetProperty "pause" False
757 | otherwise -> print <=< mpvOne' $ MpvSetProperty "pause" True
758
759myKeys' conf host = Map.fromList $
760 -- launch a terminal
761 [ ((modm, xK_Return), spawn $ (XMonad.terminal conf) ++ " -e tmux")
762 , ((modm .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf)
763
764 -- launch dmenu
765 --, ((modm, xK_d ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"")
766 , ((modm, xK_d ), shellPrompt "Run: " xPConfig)
767 , ((modm .|. shiftMask, xK_d ), prompt "Run in Terminal: " ("urxvtc" ++ " -e") xPConfig)
768 , ((modm, xK_at ), sshPrompt sshOverrides xPConfig)
769
770 -- close focused window
771 , ((modm .|. shiftMask, xK_q ), kill)
772 , ((modm .|. controlMask .|. shiftMask, xK_q ), spawn "xkill")
773
774 -- Rotate through the available layout algorithms
775 , ((modm, xK_space ), sendMessage NextLayout)
776
777 -- Reset the layouts on the current workspace to default
778 , ((modm .|. controlMask, xK_r ), (setLayout $ XMonad.layoutHook conf) >> refresh)
779
780 -- Resize viewed windows to the correct size
781 , ((modm, xK_r ), refresh)
782
783 -- Move focus to the next window
784 , ((modm, xK_t ), windows W.focusDown)
785
786 -- Move focus to the previous window
787 , ((modm, xK_n ), windows W.focusUp )
788
789 -- Move focus to the master window
790 , ((modm, xK_m ), windows W.focusMaster )
791
792 -- Swap the focused window and the master window
793 , ((modm .|. shiftMask, xK_m ), windows W.swapMaster)
794
795 -- Swap the focused window with the next window
796 , ((modm .|. shiftMask, xK_t ), windows W.swapDown )
797
798 -- Swap the focused window with the previous window
799 , ((modm .|. shiftMask, xK_n ), windows W.swapUp )
800
801 -- Swap the focused window with the previous window
802 , ((modm .|. shiftMask .|. controlMask, xK_m), sendMessage SwapWindow)
803
804 , ((modm, xK_Right), sendMessage $ Go R)
805 , ((modm, xK_Left ), sendMessage $ Go L)
806 , ((modm, xK_Up ), sendMessage $ Go U)
807 , ((modm, xK_Down ), sendMessage $ Go D)
808 , ((modm .|. shiftMask , xK_Right), sendMessage $ Move R)
809 , ((modm .|. shiftMask , xK_Left ), sendMessage $ Move L)
810 , ((modm .|. shiftMask , xK_Up ), sendMessage $ Move U)
811 , ((modm .|. shiftMask , xK_Down ), sendMessage $ Move D)
812 -- , ((modm .|. controlMask, xK_Right), withFocused $ keysMoveWindow (10, 0))
813 -- , ((modm .|. controlMask, xK_Left ), withFocused $ keysMoveWindow (-10, 0))
814 -- , ((modm .|. controlMask, xK_Up ), withFocused $ keysMoveWindow (0, -10))
815 -- , ((modm .|. controlMask, xK_Down ), withFocused $ keysMoveWindow (0, 10))
816 -- Shrink the master area
817 , ((modm, xK_h ), sendMessage Shrink)
818
819 -- Expand the master area
820 , ((modm, xK_s ), sendMessage Expand)
821
822 -- Push window back into tiling
823 , ((modm .|. shiftMask, xK_space ), withFocused $ windows . W.sink)
824 , ((modm, xK_BackSpace), focusUrgent)
825 , ((modm .|. shiftMask, xK_BackSpace), clearUrgents)
826
827 -- Increment the number of windows in the master area
828 , ((modm , xK_comma ), sendMessage (IncMasterN 1))
829
830 -- Deincrement the number of windows in the master area
831 , ((modm , xK_period), sendMessage (IncMasterN (-1)))
832
833 , ((0, xF86XK_AudioRaiseVolume), safeSpawn "pulseaudio-ctl" ["up", "2"])
834 , ((0, xF86XK_AudioLowerVolume), safeSpawn "pulseaudio-ctl" ["down", "2"])
835 , ((0, xF86XK_AudioMute), safeSpawn "pulseaudio-ctl" ["mute"])
836 , ((0, xF86XK_AudioPause), mediaMpv $ MpvSetProperty "pause" False)
837 , ((0, {-xF86XK_AudioMicMute-} 269025202), safeSpawn "pulseaudio-ctl" ["mute-input"])
838 , ((0, xF86XK_AudioPlay), mediaMpvTogglePause)
839 , ((modm .|. mod1Mask, xK_space), mediaMpvTogglePause)
840
841 , ((0, xF86XK_MonBrightnessDown), backlight (subtract 5))
842 , ((0, xF86XK_MonBrightnessUp), backlight (+ 5))
843
844 , ((modm , xK_Escape), cycleKbLayout (hKbLayouts host))
845 , ((modm .|. controlMask, xK_Escape), safeSpawn "setxkbmap" $ fst (head $ hKbLayouts host) : maybeToList (snd . head $ hKbLayouts host))
846
847 -- Toggle the status bar gap
848 -- Use this binding with avoidStruts from Hooks.ManageDocks.
849 -- See also the statusBar function from Hooks.DynamicLog.
850 --
851 , ((modm , xK_b ), sendMessage ToggleStruts)
852
853 , ((modm .|. shiftMask, xK_p ), safeSpawn "playerctl" ["-a", "pause"])
854
855 -- Quit xmonad
856 , ((modm .|. shiftMask, xK_e ), io (exitWith ExitSuccess))
857
858 -- Restart xmonad
859 -- , ((modm .|. shiftMask .|. controlMask, xK_r ), void . xfork $ recompile False >>= flip when (safeSpawn "xmonad" ["--restart"]))
860 , ((modm .|. shiftMask, xK_r ), void . liftIO $ executeFile "xmonad" True [] Nothing)
861 , ((modm .|. shiftMask, xK_l ), void . xfork $ do
862 sessId <- getEnv "XDG_SESSION_ID"
863 safeSpawn "loginctl" ["lock-session", sessId]
864 )
865 , ((modm .|. shiftMask, xK_s ), safeSpawn "systemctl" ["suspend"])
866 , ((modm .|. shiftMask, xK_h ), safeSpawn "systemctl" ["hibernate"])
867 , ((modm .|. shiftMask, xK_b ), backlight $ cycleThrough [1, 3 % 4, 1 % 2, 1 % 4, 1 % 10, 1 % 100, 0]
868 )
869 , ((modm .|. shiftMask .|. controlMask, xK_b), backlight $ cycleThrough [0, 1 % 100, 1 % 10, 1 % 4, 1 % 2, 3 % 4, 1]
870 )
871 , ((modm, xK_v ), windows copyToAll) -- @@ Make focused window always visible
872 , ((modm .|. shiftMask, xK_v ), killAllOtherCopies) -- @@ Toggle window state back
873 , ((modm .|. shiftMask, xK_g ), windowPrompt xPConfig Goto wsWindows)
874 , ((modm .|. shiftMask .|. controlMask, xK_g ), windowPrompt xPConfig Bring allWindows)
875 ]
876 ++
877
878 --
879 -- mod-[1..9], Switch to workspace N
880 --
881 -- mod-[1..9], Switch to workspace N
882 -- mod-shift-[1..9], Move client to workspace N
883 --
884 [((m .|. modm, k), windows $ f i)
885 | (i, k) <- zip (XMonad.workspaces conf) $ numKeys
886 , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]
887 ]
888 ++
889 [((m .|. modm .|. controlMask, k), void . runMaybeT $
890 MaybeT (P.getScreen def i) >>= MaybeT . screenWorkspace >>= lift . windows . f
891 )
892 | (i, k) <- zip (hScreens host) [xK_g, xK_c, xK_r, xK_l]
893 , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]
894 ]
895 where
896 modm = XMonad.modMask conf
897
898
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 07:41:30 +0000