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