about summary refs log tree commit diff
path: root/src/XMonad/Custom/Bindings.hs
blob: 9192f7e21d21dfa056e03d79c69e9c5d6829524d (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Custom.Bindings
-- Copyright   :  (c) azahi 2018
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  azahi@teknik.io
-- Stability   :  unstable
-- Portability :  unportable
--
-----------------------------------------------------------------------------

module XMonad.Custom.Bindings
    ( showKeyBindings
    , modMask'
    , keyBindings
    , mouseBindings'
    ) where

import           Control.Monad
import qualified Data.Map                            as M
import           System.Exit
import           System.IO
import           XMonad
import qualified XMonad.Actions.ConstrainedResize    as C
import           XMonad.Actions.CopyWindow
import           XMonad.Actions.CycleWS
import           XMonad.Actions.DynamicProjects
import           XMonad.Actions.DynamicWorkspaces
import qualified XMonad.Actions.FlexibleManipulate   as F
import           XMonad.Actions.FloatSnap
import           XMonad.Actions.FloatSnapSpaced
import           XMonad.Actions.MessageFeedback
import           XMonad.Actions.Navigation2D
import           XMonad.Actions.PerConditionKeys
import           XMonad.Actions.Promote
import           XMonad.Actions.Volume
import           XMonad.Actions.WithAll
import           XMonad.Custom.Layout
import qualified XMonad.Custom.Misc                  as CM
import           XMonad.Custom.Scratchpads
import           XMonad.Custom.Theme
import           XMonad.Hooks.DynamicLog
import           XMonad.Hooks.UrgencyHook
import           XMonad.Layout.BinarySpacePartition
import           XMonad.Layout.Hidden
import           XMonad.Layout.MultiToggle
import           XMonad.Layout.MultiToggle.Instances
import           XMonad.Layout.Reflect
import           XMonad.Layout.ResizableTile
import           XMonad.Layout.SubLayouts
import           XMonad.Prompt.ConfirmPrompt
import           XMonad.Prompt.Pass
import           XMonad.Prompt.Shell
import           XMonad.Prompt.Window
import           XMonad.Prompt.Workspace
import qualified XMonad.StackSet                     as S
import           XMonad.Util.EZConfig
import           XMonad.Util.NamedActions
import           XMonad.Util.NamedScratchpad
import           XMonad.Util.Run
import           XMonad.Util.WorkspaceCompare
import           XMonad.Util.XSelection

showKeyBindings :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
showKeyBindings a = addName "Show Keybindings" $ io $ do
    p <- spawnPipe "/usr/bin/zenity --text-info" -- TOOD Find an application that doesn't rely on any toolkits
    hPutStr p $ unlines $ showKm a
    hClose p
    return ()

modMask' :: KeyMask
modMask' = mod4Mask

directions :: [Direction2D]
directions = [D, U, L, R]

arrowKeys, directionKeys, wsKeys :: [String]
arrowKeys     = [ "<D>" , "<U>" , "<L>" , "<R>" ]
directionKeys = [  "j"  ,  "k"  ,  "h"  ,  "l"  ]
wsKeys        = map show [1..9 :: Int]

zipM  :: [a] -> String -> [[a]] -> [t] -> (t ->       X ()) ->       [([a], NamedAction)]
zipM  m nm ks as f   = zipWith (\k d -> (m ++ k, addName nm $ f d))   ks as
zipM' :: [a] -> String -> [[a]] -> [t] -> (t -> t1 -> X ()) -> t1 -> [([a], NamedAction)]
zipM' m nm ks as f b = zipWith (\k d -> (m ++ k, addName nm $ f d b)) ks as

tryMessageR_ :: (Message a, Message b) => a -> b -> X ()
tryMessageR_ x y = sequence_ [tryMessage_ x y, refresh]

xSelectionNotify :: MonadIO m => m ()
xSelectionNotify = join $ io
    $ (unsafeSpawn . (\x -> CM.notify CM.customApplications ++ " Clipboard " ++ wrap "\"\\\"" "\"\\\"" x)) <$> getSelection

toggleCopyToAll :: X ()
toggleCopyToAll = wsContainingCopies >>= \x -> case x of
                                                   [] -> windows copyToAll
                                                   _  -> killAllOtherCopies

getSortByIndexNonSP :: X ([WindowSpace] -> [WindowSpace])
getSortByIndexNonSP = (. namedScratchpadFilterOutWorkspace) <$> getSortByIndex

nextNonEmptyWS, prevNonEmptyWS :: X ()
nextNonEmptyWS = findWorkspace getSortByIndexNonSP Next HiddenNonEmptyWS 1 >>= \t -> windows . S.view $ t
prevNonEmptyWS = findWorkspace getSortByIndexNonSP Prev HiddenNonEmptyWS 1 >>= \t -> windows . S.view $ t

toggleFloat :: Window -> X ()
toggleFloat w = windows (\s -> if M.member w (S.floating s)
                               then S.sink w s
                                  else S.float w (S.RationalRect (1/2 - 1/4) (1/2 - 1/4) (1/2) (1/2)) s)

keyBindings :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
keyBindings c =
    let subKeys s ks = subtitle s:mkNamedKeymap c ks
    in
    subKeys "System"
    [ ("M-q"   , addName "Restart XMonad"             $ spawn "/usr/bin/xmonad --restart")
    , ("M-C-q" , addName "Recompile & restart XMonad" $ spawn "/usr/bin/xmonad --recompile && /usr/bin/xmonad --restart")
    , ("M-S-q" , addName "Quit XMonad"                $ confirmPrompt hotPromptTheme "Quit XMonad?" $ io exitSuccess)
    , ("M-x"   , addName "Shell prompt"               $ shellPrompt promptTheme)
    , ("M-o"   , addName "Goto W prompt"              $ windowPrompt promptTheme Goto allWindows)
    , ("M-S-o" , addName "Bring W prompt"             $ windowPrompt promptTheme Bring allWindows)
    ]
    ^++^
    subKeys "Actions"
    [ ("M-C-g"             , addName "Cancel"                                    $ return ())
    , ("<XF86ScreenSaver>" , addName "Lock screen"                               $ spawn "~/.xmonad/bin/\
                                                                                         \screenlock.sh")
    , ("M-S-c"             , addName "Print clipboard content"                     xSelectionNotify)
    , ("M-<Print>"         , addName "Take a screenshot of the current WS, \
                                     \upload it and copy link to the buffer"     $ spawn "~/.xmonad/bin/\
                                                                                         \xshot-upload.sh")
    , ("M-S-<Print>"       , addName "Take a screenshot of the selected area, \
                                     \upload it and copy link to the buffer"     $ spawn "~/.xmonad/bin/\
                                                                                         \xshot-select-upload.sh")
    , ("M-<Insert>"        , addName "Start recording screen as webm"            $ spawn "~/.xmonad/bin/\
                                                                                         \xcast.sh --webm")
    , ("M-S-<Insert>"      , addName "Start recording screen as gif"             $ spawn "~/.xmonad/bin/\
                                                                                         \xcast.sh --gif")
    , ("M-C-<Insert>"      , addName "Stop recording"                            $ spawn "/usr/bin/pkill ffmpeg")
    , ("M-C-c"             , addName "Toggle compton on/off"                     $ spawn "~/.xmonad/bin/\
                                                                                         \toggle-compton.sh")
    , ("M-C-r"             , addName "Toggle redshift on/off"                    $ spawn "~/.xmonad/bin/\
                                                                                         \toggle-redshift.sh")
    , ("M-C-p"             , addName "Toggle touchpad on/off"                    $ spawn "~/.xmonad/bin/\
                                                                                             \toggle-touchpad.sh")
    , ("M-C-t"             , addName "Toggle trackpoint on/off"                  $ spawn "~/.xmonad/bin/\
                                                                                         \toggle-trackpoint.sh")
    ]
    ^++^
    subKeys "Volume & Music"
    [ ("<XF86AudioMute>"        , addName "ALSA: Mute"         $ void   toggleMute)
    , ("<XF86AudioLowerVolume>" , addName "ALSA: Lower volume" $ void $ lowerVolume 5)
    , ("<XF86AudioRaiseVolume>" , addName "ALSA: Raise volume" $ void $ raiseVolume 5)
    , ("<XF86AudioPlay>"        , addName "MPD: Play/pause"    $ spawn "~/.xmonad/bin/mpc-play-pause.sh")
    , ("<XF86AudioStop>"        , addName "MPD: Stop"          $ spawn "/usr/bin/mpc --no-status stop")
    , ("<XF86AudioPrev>"        , addName "MPD: Previos track" $ spawn "/usr/bin/mpc --no-status prev")
    , ("<XF86AudioNext>"        , addName "MPD: Next track"    $ spawn "/usr/bin/mpc --no-status next")
    ]
    ^++^
    subKeys "Spawnables"
    [ ("M-<Return>" , addName "Terminal"         $ spawn (CM.term CM.customApplications))
    , ("M-b"        , addName "Browser"          $ spawn (CM.browser CM.customApplications))
    , ("M-S-p"      , addName "Pass prompt"      $ passPrompt promptTheme)
    , ("M-c"        , addName "NSP Console"      $ namedScratchpadAction scratchpads "console")
    , ("M-m"        , addName "NSP Music"        $ namedScratchpadAction scratchpads "music")
    , ("M-t"        , addName "NSP Top"          $ namedScratchpadAction scratchpads "top")
    , ("M-v"        , addName "NSP Volume"       $ namedScratchpadAction scratchpads "volume")
    ]
    ^++^
    subKeys "Windows"
    ( [ ("M-d"   , addName "Kill W"                     kill)
      , ("M-S-d" , addName "Kill all W on WS"         $ confirmPrompt hotPromptTheme "Kill all" killAll)
      , ("M-C-d" , addName "Duplicate W to all WS"      toggleCopyToAll)
      , ("M-a"   , addName "Hide W"                   $ withFocused hideWindow) -- FIXME This is so broken
      , ("M-S-a" , addName "Restore hidden W"           popOldestHiddenWindow)
      , ("M-p"   , addName "Promote W"                  promote)
      , ("M-s"   , addName "Merge W from sublayout"   $ withFocused $ sendMessage . MergeAll)
      , ("M-S-s" , addName "Unmerge W from sublayout" $ withFocused $ sendMessage . UnMerge)
      , ("M-u"   , addName "Focus urgent W"             focusUrgent)
      , ("M-e"   , addName "Focus master W"           $ windows S.focusMaster)
      , ("M-'"   , addName "Navigate tabbed W -> D"   $ bindOn LD [ ("Tabs" , windows S.focusDown)
                                                                    , (""     , onGroup S.focusDown')
                                                                    ])
      , ("M-;"   , addName "Navigate tabbed W -> U"   $ bindOn LD [ ("Tabs" , windows S.focusUp)
                                                                    , (""     , onGroup S.focusUp')
                                                                    ])
      , ("M-S-'" , addName "Swap tabbed W -> D"       $ windows S.swapDown)
      , ("M-S-;" , addName "Swap tabbed W -> U"       $ windows S.swapUp)
      ]
      ++ zipM' "M-"   "Navigate W"             directionKeys directions windowGo   True -- TODO W moving
      ++ zipM' "M-S-" "Swap W"                 directionKeys directions windowSwap True
      ++ zipM  "M-C-" "Merge W with sublayout" directionKeys directions (sendMessage . pullGroup)
      ++ zipM' "M-"   "Navigate screen"        arrowKeys directions screenGo       True
      ++ zipM' "M-S-" "Move W to screen"       arrowKeys directions windowToScreen True
      ++ zipM' "M-C-" "Swap W to screen"       arrowKeys directions screenSwap     True
    )
    ^++^
    subKeys "Workspaces & Projects"
    ( [ ("M-w"   , addName "Switch to project"     $ switchProjectPrompt  promptTheme)
      , ("M-S-w" , addName "Shift to project"      $ shiftToProjectPrompt promptTheme)
      , ("M-,"   , addName "Next non-empty WS"       nextNonEmptyWS)
      , ("M-."   , addName "Previous non-empty WS"   prevNonEmptyWS)
      , ("M-i"   , addName "Toggle last WS"        $ toggleWS' ["NSP"])
      , ("M-`"   , addName "WS prompt"             $ workspacePrompt promptTheme $ windows . S.shift)
      ]
      ++ zipM "M-"     "View WS"      wsKeys [0 ..] (withNthWorkspace S.greedyView)
      ++ zipM "M-S-"   "Move W to WS" wsKeys [0 ..] (withNthWorkspace S.shift)
      ++ zipM "M-C-S-" "Copy W to WS" wsKeys [0 ..] (withNthWorkspace copy)
    )
    ^++^
    subKeys "Layout Management"
    [ ("M-<Tab>"   , addName "Cycle layouts"            $ sendMessage NextLayout)
    , ("M-C-<Tab>" , addName "Cycle sublayouts"         $ toSubl NextLayout)
    , ("M-S-<Tab>" , addName "Reset layout"             $ setLayout $ XMonad.layoutHook c)
    , ("M-y"       , addName "Toggle float/tile on W"   $ withFocused toggleFloat)
    , ("M-S-y"     , addName "Tile all floating W"        sinkAll)
    , ("M-S-,"     , addName "Decrease maximum W count" $ sendMessage $ IncMasterN (-1))
    , ("M-S-."     , addName "Increase maximum W count" $ sendMessage $ IncMasterN 1)
    , ("M-r"       , addName "Rotate/reflect W"         $ tryMessageR_ Rotate (Toggle REFLECTX))
    , ("M-S-r"     , addName "Reflect W"                $ sendMessage $ Toggle REFLECTX)
    , ("M-f"       , addName "Toggle fullscreen layout" $ sequence_ [ withFocused $ windows . S.sink
                                                                    , sendMessage $ Toggle NBFULL
                                                                    ])
    , ("M-S-g"     , addName "Toggle gapped layout"     $ sendMessage $ Toggle GAPS) -- FIXME Breaks merged tabbed layout
    ]
    ^++^
    subKeys "Resize"
    [ ("M-["     , addName "Expand L" $ tryMessageR_ (ExpandTowards L) Shrink)
    , ("M-]"     , addName "Expand R" $ tryMessageR_ (ExpandTowards R) Expand)
    , ("M-S-["   , addName "Expand U" $ tryMessageR_ (ExpandTowards U) MirrorShrink)
    , ("M-S-]"   , addName "Expand D" $ tryMessageR_ (ExpandTowards D) MirrorExpand)
    , ("M-C-["   , addName "Shrink L" $ tryMessageR_ (ShrinkFrom    R) Shrink)
    , ("M-C-]"   , addName "Shrink R" $ tryMessageR_ (ShrinkFrom    L) Expand)
    , ("M-S-C-[" , addName "Shrink U" $ tryMessageR_ (ShrinkFrom    D) MirrorShrink)
    , ("M-S-C-]" , addName "Shrink D" $ tryMessageR_ (ShrinkFrom    U) MirrorExpand)
    ]

mouseBindings' :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
mouseBindings' XConfig {XMonad.modMask = m} = M.fromList
    [ ((m,               button1), \w -> focus w
                                         >> F.mouseWindow F.position w
                                         >> ifClick (snapSpacedMagicMove gapBase  (Just 50) (Just 50) w)
                                         >> windows S.shiftMaster
      )
    , ((m .|. shiftMask, button1), \w -> focus w
                                         >> C.mouseResizeWindow w True
                                         >> ifClick (snapMagicResize [L, R, U, D] (Just 50) (Just 50) w)
                                         >> windows S.shiftMaster
      )
    , ((m,               button3), \w -> focus w
                                         >> F.mouseWindow F.linear w
                                         >> ifClick (snapMagicResize [L, R]       (Just 50) (Just 50) w)
                                         >> windows S.shiftMaster
      )
    , ((m .|. shiftMask, button3), \w -> focus w
                                         >> C.mouseResizeWindow w True
                                         >> ifClick (snapMagicResize [U, D]       (Just 50) (Just 50) w)
                                         >> windows S.shiftMaster
      )
    ]

Consider giving Nix/NixOS a try! <3