{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
import Data.Default
+import qualified Data.Char as Char
import Data.List as List
import Data.Ratio
import System.Exit
-import System.IO
import qualified Data.Map as Map
+import Control.Arrow (first)
-- import XMonad.Actions.DwmPromote
-- import XMonad.Actions.Warp
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
+import XMonad.Hooks.Rescreen
import XMonad.Hooks.SetWMName
+import XMonad.Hooks.StatusBar
import XMonad.Hooks.UrgencyHook
import XMonad.Layout.Fullscreen
import XMonad.Layout.Grid
-import XMonad.Layout.IndependentScreens
import XMonad.Layout.LayoutCombinators
import XMonad.Layout.Magnifier
import XMonad.Layout.MultiToggle
import XMonad.Layout.Spiral
import XMonad.Layout.Tabbed
import XMonad.Layout.ThreeColumns
-import XMonad.Util.Run(spawnPipe)
+import XMonad.Prompt
+import XMonad.Prompt.FuzzyMatch
+import XMonad.Prompt.Pass
+--import XMonad.Operations (unGrab) -- TODO: needs xmonad 0.18
import XMonad.Util.SpawnOnce
import qualified XMonad.StackSet as W
-myKeys
- conf@XConfig{XMonad.modMask} =
- Map.fromList $
- let xK_XF86Backward = 0x1008ff26
- xK_XF86Forward = 0x1008ff27 in
- [
- -- Start a terminal
- ((modMask, xK_Return), spawn $ XMonad.terminal conf)
- -- Launch a program
- , ((modMask, xK_Menu), spawn "exec rofi -show run -no-disable-history -run-command \"bash -c 'systemd-run --user --scope --unit=app-org.rofi.\\$(systemd-escape \\\"{cmd}\\\")-\\$RANDOM -p CollectMode=inactive-or-failed {cmd}'\"")
- -- Browse the filesystem
- , ((modMask, xK_BackSpace), spawn "systemd-run --user -E PATH=\"$PATH\" --unit=app-org.rofi.caja@$RANDOM -p CollectMode=inactive-or-failed caja")
-
- -- Lock the screen
- , ((0, xK_Pause), spawn "systemctl --user start xss-lock.service; xset s activate dpms force off")
-
- -- Take a full screenshot
- , ((0, xK_Print), spawn "cd ~/img/cap && scrot --quality 42 '%Y-%m-%d_%H-%M-%S.png' && caja ~/img/cap")
- -- Take a selective screenshot
- , ((modMask, xK_Print), spawn "select-screenshot")
-
- -- Volume control
- , ((0, 0x1008FF12), spawn "pactl -- set-sink-mute @DEFAULT_SINK@ toggle") -- XF88AudioMute
- , ((0, 0x1008FF11), spawn "pactl -- set-sink-volume @DEFAULT_SINK@ -5%") -- XF86AudioLowerVolume
- , ((0, 0x1008FF13), spawn "pactl -- set-sink-volume @DEFAULT_SINK@ +5%") -- XF86AudioRaiseVolume
- -- Audio previous
- -- , ((0, 0x1008FF16), spawn "")
- -- Play/pause
- -- , ((0, 0x1008FF14), spawn "")
- -- Audio next
- -- , ((0, 0x1008FF17), spawn "")
- -- Eject CD tray
- -- , ((0, 0x1008FF2C), spawn "eject -T")
-
- -- Close focused window.
- , ((modMask, xK_Escape), kill)
- , ((modMask, xK_q), kill)
-
- -- Clipboard
- , ((modMask, xK_c), spawn "clipster --select --primary")
-
- -- Temporarily maximize a window
- , ((modMask, xK_f), sendMessage $ XMonad.Layout.MultiToggle.Toggle FULL)
- -- , ((modMask, xK_f), withFocused (sendMessage . maximizeRestore))
-
- -- Cycle through the available layout algorithms
- , ((modMask, 0x13bd), sendMessage NextLayout) -- oe (²)
- , ((modMask, xK_ampersand), sendMessage $ JumpToLayout "ResizableTall") -- & (1)
- , ((modMask, xK_eacute), sendMessage $ JumpToLayout "Mirror ResizableTall") -- é (2)
- , ((modMask, xK_quotedbl), sendMessage $ JumpToLayout "Tabbed Simplest") -- ' (3)
- , ((modMask, xK_apostrophe), sendMessage $ JumpToLayout "Magnifier Grid") -- " (4)
- , ((modMask, xK_parenleft), sendMessage $ JumpToLayout "Spiral") -- ( (5)
- , ((modMask, xK_minus), sendMessage $ JumpToLayout "Full") -- - (6)
- , ((modMask, xK_egrave), sendMessage $ JumpToLayout "ThreeCol") -- è (7)
-
- -- Reset the layouts on the current workspace to default
- -- , ((modMask .|. shiftMask, xK_space), setLayout $ XMonad.layoutHook conf)
-
- -- Resize viewed windows to the correct size.
- , ((modMask, xK_n), refresh)
-
- -- Move focus between windows
- , ((modMask, xK_Tab), windows W.focusDown)
- , ((modMask .|. shiftMask, xK_Tab), windows W.focusUp)
- , ((modMask, xK_i), windows W.focusUp)
- , ((modMask, xK_k), windows W.focusDown)
-
- -- Move focus to the master window
- , ((modMask, xK_m), windows W.focusMaster)
- -- Swap the focused window and the master window
- , ((modMask, xK_space), windows W.swapMaster)
-
- -- Swap the focused window with the next window.
- --, ((modMask, xK_o), windows W.swapDown >> windows W.focusMaster)
- -- Swap the focused window with the previous window.
- , ((modMask, xK_m), windows W.swapUp >> windows W.focusMaster)
-
- -- Push window back into tiling.
- , ((modMask, xK_t), withFocused $ windows . W.sink)
-
- -- Change the number of windows in the master area
- , ((modMask, xK_Up), sendMessage $ IncMasterN 1)
- , ((modMask, xK_Down), sendMessage $ IncMasterN (-1))
-
- -- Toggle the status bar gap.
- , ((modMask, xK_b), sendMessage ToggleStruts)
-
- -- Quit xmonad
- , ((modMask .|. shiftMask, xK_End), io exitSuccess)
- -- Restart xmonad
- , ((modMask, xK_End), restart "xmonad" True)
-
- -- Workspace management
- -- XF86Back: Switch to previous workspace
- , ((0, xK_XF86Backward), prevWS)
- , ((modMask, xK_j), prevWS)
- -- Switch to next workspace
- , ((0, xK_XF86Forward), nextWS)
- , ((modMask, xK_l), nextWS)
- -- XF86Back: Move the current client to the previous workspace and go there
- , ((modMask, xK_XF86Backward), shiftToPrev >> prevWS)
- , ((modMask .|. shiftMask, xK_j), shiftToPrev >> prevWS)
- -- Move the current client to the next workspace and go there
- , ((modMask, xK_XF86Forward), shiftToNext >> nextWS)
- , ((modMask .|. shiftMask, xK_l), shiftToNext >> nextWS)
- -- Switch to previous workspace
- -- Switch to next workspace
- {-
- -- Move the current client to the previous workspace
- , ((0 .|. shiftMask , xK_XF86Backward), shiftToPrev )
- -- Move the current client to the next workspace
- , ((0 .|. shiftMask , xK_XF86Forward), shiftToNext )
- -}
-
- -- Toggle copying window on all workspaces (sticky window)
- , ((modMask, xK_s), do
- copies <- wsContainingCopies -- NOTE: consider only hidden workspaces
- case copies of
- [] -> windows copyToAll
- _ -> killAllOtherCopies
- )
-
- -- Resize the master area
- , ((modMask, xK_Left), sendMessage Shrink)
- , ((modMask, xK_Right), sendMessage Expand)
- -- Resize windows in ResizableTall mode
- , ((modMask .|. shiftMask, xK_Left), sendMessage MirrorShrink)
- , ((modMask .|. shiftMask, xK_Right), sendMessage MirrorExpand)
- ] ++
-
- -- mod-[F1..F9], Switch to workspace N
- -- mod-shift-[F1..F9], Move client to workspace N
- [ ((m .|. modMask, k), windows $ f i)
- | (i, k) <- zip (workspaces conf) [xK_F1 ..] ++
- zip (workspaces conf) [xK_1 ..]
- , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]
- ] ++
- {- NOTE: with Xinerama
- [((m .|. modMask, k), windows $ onCurrentScreen f i)
- | (i, k) <- zip (workspaces' conf) [xK_F1 ..]
- , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)] ]
- -}
-
- -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3
- -- mod-shift-{w,e,r}, Move client to screen 1, 2, or 3
- [ ((m .|. modMask, key), screenWorkspace sc >>= flip whenJust (windows . f))
- | (key, sc) <- zip [xK_w, xK_e, xK_r] [0 ..]
- , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]
- ] ++
-
- -- mod-shift-[F1..F9], Swap workspace with workspace N
- -- mod-shift-[1..9], Swap workspace with workspace N
- [ ((modMask .|. controlMask, k), windows $ swapWithCurrent i)
- | (i, k) <- zip (workspaces conf) [xK_F1 ..] ++
- zip (workspaces conf) [xK_1 ..]
- ]
- {- NOTE: with Xinerama
- [((modMask .|. controlMask, k), windows $ onCurrentScreen swapWithCurrent i)
- | (i, k) <- zip (workspaces' conf) [xK_F1 ..] ]
- -}
-
-
-myMouseBindings
- XConfig{XMonad.modMask} =
- Map.fromList
- [
- -- mod-button1, Set the window to floating mode and move by dragging
- ((modMask, button1), \w -> focus w >> mouseMoveWindow w)
-
- -- mod-button2, Raise the window to the top of the stack
- , ((modMask, button2), \w -> focus w >> windows W.swapMaster)
-
- -- mod-button3, Set the window to floating mode and resize by dragging
- , ((modMask, button3), \w -> focus w >> mouseResizeWindow w)
-
- , ((modMask, button4), \_ -> windows W.focusUp)
- , ((modMask, button5), \_ -> windows W.focusDown)
-
- -- Cycle through workspaces
- , ((controlMask .|. modMask, button5), nextNonEmptyWS)
- , ((controlMask .|. modMask, button4), prevNonEmptyWS)
- ]
- where
- nextNonEmptyWS _ = moveTo Next (WSIs ((not .) <$> isWindowSpaceVisible))
- prevNonEmptyWS _ = moveTo Prev (WSIs ((not .) <$> isWindowSpaceVisible))
-
-isWindowSpaceVisible :: X (WindowSpace -> Bool)
-isWindowSpaceVisible = do
- vs <- gets (map (W.tag . W.workspace) . W.visible . windowset)
- return (\w -> W.tag w `elem` vs)
-
-defaults xmproc _nScreens = docks $ ewmhFullscreen $ ewmh $
- azertyConfig
- { borderWidth = 1
- , focusFollowsMouse = True
+main = xmonad $
+ withUrgencyHook NoUrgencyHook $
+ -- dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] } $
+ --addAfterRescreenHook myAfterRescreenHook $
+ addRandrChangeHook (spawnExec "autorandr --change") $
+ dynamicSBs barSpawner $
+ docks $
+ setEwmhActivateHook doAskUrgent $
+ ewmhFullscreen $
+ ewmh $
+ azertyConfig
+ { borderWidth = 1
+ , focusFollowsMouse = True
, focusedBorderColor = "#00b10b"
- , handleEventHook = handleEventHook def
- , keys = myKeys
- , layoutHook = smartBorders $
- mkToggle (NOBORDERS ?? FULL ?? EOT) $ -- enable temporarily maximizing a window
- avoidStruts $ -- prevents windows from overlapping dock windows
- let tall = ResizableTall 1 (1%200) (8%13) [] in tall
- ||| Mirror tall
- ||| tabbed shrinkText tabConfig
- ||| magnifiercz (13%10) Grid
- ||| spiral (6%7)
- ||| noBorders (fullscreenFull Full)
- ||| ThreeColMid 1 (1%200) (1%2)
- -- ||| Tall 1 (3/100) (1/2)
- , manageHook = composeAll
- -- [ , isFullscreen --> (doF W.focusDown <+> doFullFloat)
- [ isFullscreen --> doFullFloat
- , manageHook def
- , manageDocks -- NOTE: do not tile dock windows
- , resource =? "desktop_window" --> doIgnore
- , className =? "Gimp" --> doFloat
- , resource =? "gpicview" --> doSink
- , className =? "mpv" --> doFloat
- --, className =? "MPlayer" --> doShift "3:media" -- <+> doFloat
- --, className =? "vlc" --> doShift "3:media"
- , className =? "stalonetray" --> doIgnore
- ]
- , modMask = mod4Mask
- , mouseBindings = myMouseBindings
- , normalBorderColor = "#7C7C7C"
- , startupHook = setWMName "XMonad"
- <+> spawn "wmname XMonad"
- <+> spawn "xrdb -all .Xresources"
- <+> spawn "sleep 1 && xmodmap .Xmodmap"
- <+> spawn "xset r rate 250 25"
- <+> spawn "xset b off"
- <+> spawn "xhost local:root"
- <+> spawn "setxkbmap -option keypad:pointerkeys"
- -- <+> spawnOnce "exec arbtt-capture -r 60"
- -- <+> spawnOnce "exec parcellite"
- -- <+> spawnOnce "exec xautolock"
- -- <+> spawnOnce "exec redshift-gtk -l -45.7800:1.9700 -t 6500:3700"
- <+> spawnOnce "exec nm-applet"
- <+> spawnOnce (List.unwords
- [ "exec stalonetray"
- , "--background '#000000'"
- , "--geometry 5x1-0+0"
- , "--icon-gravity E"
- , "--icon-size 16"
- , "--kludges force_icons_size"
- , "--max-geometry 0x1+0+0"
- , "--skip-taskbar"
- , "--window-strut none"
- ])
- , terminal = "urxvtc"
- , workspaces = {- withScreens nScreens $ -}
- {-["1:work","2:web","3:media"] ++-}
- map show [1::Int .. 9]
- , logHook =
- dynamicLogWithPP xmobarPP
- { ppCurrent = xmobarColor "black" "#CCCCCC"
- , ppHidden = xmobarColor "#CCCCCC" "black"
- , ppHiddenNoWindows = xmobarColor "#606060" "black"
- , ppLayout = \s -> xmobarColor "black" "#606060" $
- case s of
- "ResizableTall" -> " | "
- "Mirror ResizableTall" -> " - "
- "Tabbed Simplest" -> " + "
- "Magnifier Grid" -> " ~ "
- "Spiral" -> " @ "
- "Full" -> " O "
- "ThreeCol" -> " # "
- _ -> s
- , ppOutput = hPutStrLn xmproc
- , ppSep = " "
- , ppTitle = xmobarColor "white" "black" . shorten 100
- , ppUrgent = xmobarColor "yellow" "black"
- , ppWsSep = " "
- }
- >> updatePointer (0.5, 0.5) (0, 0)
+ , handleEventHook = handleEventHook def
+ , keys = \conf@XConfig{XMonad.modMask} ->
+ Map.fromList $
+ let xK_XF86Backward = 0x1008ff26
+ xK_XF86Forward = 0x1008ff27 in
+ [
+ -- Start a terminal
+ ((modMask, xK_Return), spawnExec $ XMonad.terminal conf)
+ -- Launch a program
+ , ((modMask, xK_Menu), spawnCommand)
+ , ((modMask, xK_a), spawnCommand)
+ -- Browse the filesystem
+ , ((modMask, xK_BackSpace), spawnExec "systemd-run --user --unit=app-org.rofi.caja@$RANDOM -p CollectMode=inactive-or-failed caja")
+
+ -- Lock the screen
+ , ((0, xK_Pause), {-unGrab >>-} spawnExec "loginctl lock-session \"$XDG_SESSION_ID\"")
+ , ((modMask, xK_Delete), {-unGrab >>-} spawnExec "loginctl lock-session \"$XDG_SESSION_ID\"")
+
+ -- Take a full screenshot
+ , ((0, xK_Print), spawn "mkdir -p ~/Images/screenshots && scrot --quality 42 ~/Images/screenshots/'%Y-%m-%d_%H-%M-%S.png' && caja ~/Images/screenshots")
+ -- Take a selective screenshot
+ , ((modMask, xK_Print), spawn "select-screenshot")
+
+ -- Volume control
+ , ((0, 0x1008FF12), spawnExec "pactl -- set-sink-mute @DEFAULT_SINK@ toggle") -- XF88AudioMute
+ , ((0, 0x1008FF11), spawnExec "pactl -- set-sink-volume @DEFAULT_SINK@ -5%") -- XF86AudioLowerVolume
+ , ((0, 0x1008FF13), spawnExec "pactl -- set-sink-volume @DEFAULT_SINK@ +5%") -- XF86AudioRaiseVolume
+ -- Audio previous
+ -- , ((0, 0x1008FF16), spawnExec "")
+ -- Play/pause
+ -- , ((0, 0x1008FF14), spawnExec "")
+ -- Audio next
+ -- , ((0, 0x1008FF17), spawnExec "")
+ -- Eject CD tray
+ -- , ((0, 0x1008FF2C), spawnExec "eject -T")
+
+ -- Close focused window.
+ , ((modMask, xK_Escape), kill)
+ , ((modMask, xK_q), kill)
+
+ -- Clipboard
+ , ((modMask, xK_c), spawnExec "clipster --select --primary")
+
+ -- Temporarily maximize a window
+ , ((modMask, xK_f), sendMessage $ XMonad.Layout.MultiToggle.Toggle FULL)
+ -- , ((modMask, xK_f), withFocused (sendMessage . maximizeRestore))
+
+ -- Cycle through the available layout algorithms
+ , ((modMask, 0x13bd), sendMessage NextLayout) -- oe (²)
+ , ((modMask, xK_ampersand), sendMessage $ JumpToLayout "ResizableTall") -- & (1)
+ , ((modMask, xK_eacute), sendMessage $ JumpToLayout "Mirror ResizableTall") -- é (2)
+ , ((modMask, xK_quotedbl), sendMessage $ JumpToLayout "Tabbed Simplest") -- ' (3)
+ , ((modMask, xK_apostrophe), sendMessage $ JumpToLayout "Magnifier Grid") -- " (4)
+ , ((modMask, xK_parenleft), sendMessage $ JumpToLayout "Spiral") -- ( (5)
+ , ((modMask, xK_minus), sendMessage $ JumpToLayout "Full") -- - (6)
+ , ((modMask, xK_egrave), sendMessage $ JumpToLayout "ThreeCol") -- è (7)
+
+ -- Reset the layouts on the current workspace to default
+ -- , ((modMask .|. shiftMask, xK_space), setLayout $ XMonad.layoutHook conf)
+
+ -- Resize viewed windows to the correct size.
+ , ((modMask, xK_n), refresh)
+
+ -- Move focus between windows
+ , ((modMask, xK_Tab), windows W.focusDown)
+ , ((modMask .|. shiftMask, xK_Tab), windows W.focusUp)
+ , ((modMask, xK_i), windows W.focusUp)
+ , ((modMask, xK_k), windows W.focusDown)
+
+ -- Move focus to the master window
+ , ((modMask, xK_m), windows W.focusMaster)
+ -- Swap the focused window and the master window
+ , ((modMask, xK_space), windows W.swapMaster)
+
+ -- Swap the focused window with the next window.
+ --, ((modMask, xK_o), windows W.swapDown >> windows W.focusMaster)
+ -- Swap the focused window with the previous window.
+ , ((modMask, xK_m), windows W.swapUp >> windows W.focusMaster)
+
+ -- Push window back into tiling.
+ , ((modMask, xK_t), withFocused $ windows . W.sink)
+
+ -- Change the number of windows in the master area
+ , ((modMask, xK_Up), sendMessage $ IncMasterN 1)
+ , ((modMask, xK_Down), sendMessage $ IncMasterN (-1))
+
+ -- Toggle the status bar gap.
+ , ((modMask, xK_b), sendMessage ToggleStruts)
+
+ -- Quit xmonad
+ , ((modMask .|. shiftMask, xK_End), io exitSuccess)
+ -- Restart xmonad
+ , ((modMask, xK_End), restart "xmonad" True)
+
+ , ((modMask, xK_p), passPrompt dtXPConfig)
+ , ((modMask .|. controlMask, xK_p), passGeneratePrompt dtXPConfig)
+ , ((modMask .|. controlMask .|. shiftMask, xK_p), passRemovePrompt dtXPConfig)
+
+ -- Workspace management
+ -- XF86Back: Switch to previous workspace
+ , ((0, xK_XF86Backward), prevWS)
+ , ((modMask, xK_j), prevWS)
+ , ((modMask, xK_Page_Up), prevWS)
+ -- Switch to next workspace
+ , ((0, xK_XF86Forward), nextWS)
+ , ((modMask, xK_l), nextWS)
+ , ((modMask, xK_Page_Down), nextWS)
+ -- XF86Back: Move the current client to the previous workspace and go there
+ , ((modMask, xK_XF86Backward), shiftToPrev >> prevWS)
+ , ((modMask .|. shiftMask, xK_j), shiftToPrev >> prevWS)
+ -- Move the current client to the next workspace and go there
+ , ((modMask, xK_XF86Forward), shiftToNext >> nextWS)
+ , ((modMask .|. shiftMask, xK_l), shiftToNext >> nextWS)
+ -- Switch to previous workspace
+ -- Switch to next workspace
+ {-
+ -- Move the current client to the previous workspace
+ , ((0 .|. shiftMask , xK_XF86Backward), shiftToPrev )
+ -- Move the current client to the next workspace
+ , ((0 .|. shiftMask , xK_XF86Forward), shiftToNext )
+ -}
+
+ -- Toggle copying window on all workspaces (sticky window)
+ , ((modMask, xK_s), do
+ copies <- wsContainingCopies -- NOTE: consider only hidden workspaces
+ case copies of
+ [] -> windows copyToAll
+ _ -> killAllOtherCopies
+ )
+
+ -- Resize the master area
+ , ((modMask, xK_Left), sendMessage Shrink)
+ , ((modMask, xK_Right), sendMessage Expand)
+ -- Resize windows in ResizableTall mode
+ , ((modMask .|. shiftMask, xK_Left), sendMessage MirrorShrink)
+ , ((modMask .|. shiftMask, xK_Right), sendMessage MirrorExpand)
+ ] ++
+
+ -- mod-[F1..F9], Switch to workspace N
+ -- mod-shift-[F1..F9], Move client to workspace N
+ [ ((m .|. modMask, k), windows $ f i)
+ | (i, k) <- zip (workspaces conf) [xK_F1 ..] ++
+ zip (workspaces conf) [xK_1 ..]
+ , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]
+ ] ++
+ {- NOTE: with Xinerama
+ [((m .|. modMask, k), windows $ onCurrentScreen f i)
+ | (i, k) <- zip (workspaces' conf) [xK_F1 ..]
+ , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)] ]
+ -}
+
+ -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3
+ -- mod-shift-{w,e,r}, Move client to screen 1, 2, or 3
+ [ ((m .|. modMask, key), screenWorkspace sc >>= flip whenJust (windows . f))
+ | (key, sc) <- zip [xK_w, xK_e, xK_r] [0 ..]
+ , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]
+ ] ++
+
+ -- mod-shift-[F1..F9], Swap workspace with workspace N
+ -- mod-shift-[1..9], Swap workspace with workspace N
+ [ ((modMask .|. controlMask, k), windows $ swapWithCurrent i)
+ | (i, k) <- zip (workspaces conf) [xK_F1 ..] ++
+ zip (workspaces conf) [xK_1 ..]
+ ]
+ {- NOTE: with Xinerama
+ [((modMask .|. controlMask, k), windows $ onCurrentScreen swapWithCurrent i)
+ | (i, k) <- zip (workspaces' conf) [xK_F1 ..] ]
+ -}
+ , layoutHook = smartBorders $
+ mkToggle (NOBORDERS ?? FULL ?? EOT) $ -- enable temporarily maximizing a window
+ avoidStruts $ -- prevents windows from overlapping dock windows
+ let tall = ResizableTall 1 (1%200) (8%13) [] in
+ tabbed shrinkText tabConfig
+ ||| tall
+ ||| Mirror tall
+ ||| magnifiercz (13%10) Grid
+ ||| spiral (6%7)
+ ||| noBorders (fullscreenFull Full)
+ ||| ThreeColMid 1 (1%200) (1%2)
+ -- ||| Tall 1 (3/100) (1/2)
+ , manageHook = composeAll
+ -- [ , isFullscreen --> (doF W.focusDown <+> doFullFloat)
+ [ isFullscreen --> doFullFloat
+ , manageHook def
+ , manageDocks -- NOTE: do not tile dock windows
+ , resource =? "desktop_window" --> doIgnore
+ , className =? "Gimp" --> doFloat
+ , resource =? "gpicview" --> doSink
+ , className =? "mpv" --> doFloat
+ --, className =? "MPlayer" --> doShift "3:media" -- <+> doFloat
+ --, className =? "vlc" --> doShift "3:media"
+ , className =? "trayer" --> doIgnore
+ ]
+ , modMask = mod4Mask
+ , mouseBindings = \XConfig{XMonad.modMask} ->
+ Map.fromList
+ [
+ -- mod-button1, Set the window to floating mode and move by dragging
+ ((modMask, button1), \w -> focus w >> mouseMoveWindow w)
+
+ -- mod-button2, Raise the window to the top of the stack
+ , ((modMask, button2), \w -> focus w >> windows W.swapMaster)
+
+ -- mod-button3, Set the window to floating mode and resize by dragging
+ , ((modMask, button3), \w -> focus w >> mouseResizeWindow w)
+
+ , ((modMask, button4), \_ -> windows W.focusUp)
+ , ((modMask, button5), \_ -> windows W.focusDown)
+
+ -- Cycle through workspaces
+ , ((controlMask .|. modMask, button5), nextNonEmptyWS)
+ , ((controlMask .|. modMask, button4), prevNonEmptyWS)
+ ]
+ , normalBorderColor = "#7C7C7C"
+ , startupHook = setWMName "XMonad"
+ <+> spawnExec "wmname XMonad"
+ <+> spawnExec "xrdb -all .Xresources"
+ <+> spawn "sleep 1 && xmodmap .Xmodmap"
+ <+> spawnExec "xset r rate 250 25"
+ <+> spawnExec "xset b off"
+ <+> spawnExec "xhost local:root"
+ <+> spawnExec "setxkbmap -option keypad:pointerkeys"
+ -- Useful for programs launched by rofi
+ <+> spawnExec "systemctl --user import-environment GNUPGHOME PASSWORD_STORE_DIR PATH"
+ -- <+> spawnOnce "exec arbtt-capture -r 60"
+ -- <+> spawnOnce "exec parcellite"
+ -- <+> spawnOnce "exec xautolock"
+ -- <+> spawnOnce "exec redshift-gtk -l -45.7800:1.9700 -t 6500:3700"
+ <+> spawnOnce "exec nm-applet"
+ , terminal = "urxvtc"
+ , workspaces = {- withScreens nScreens $ -}
+ {-["1:work","2:web","3:media"] ++-}
+ map show [1::Int .. 9]
+ , logHook = updatePointer (0.5, 0.5) (0, 0)
-- >> updatePointer (Relative 0.5 0.5)
}
where
, fontName = "Hack 7"
}
---
--- Run xmonad
---
-main = do
- nScreens <- countScreens
- xmproc <- spawnPipe "exec xmobar ~/.xmonad/xmobar.hs"
- xmonad $
- withUrgencyHook NoUrgencyHook $ -- dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] }
- defaults xmproc (nScreens::Integer)
+spawnCommand = spawnExec "rofi -show run -no-disable-history -run-command \"bash -c 'systemd-run --user --unit=app-org.rofi.\\$(systemd-escape \\\"{cmd}\\\")@\\$RANDOM -p CollectMode=inactive-or-failed {cmd}'\""
+
+barSpawner :: ScreenId -> IO StatusBarConfig
+barSpawner 0 = pure $ topXmobar <> traySB
+--barSpawner 1 = pure $ xmobar1
+barSpawner _ = pure $ topXmobar -- nothing on the rest of the screens
+
+-- Display properties of the root window:
+-- xprop -display $DISPLAY -root
+topXmobar = statusBarPropTo "_XMONAD_XMOBAR0" "xmobar -x 0 ~/.config/xmonad/xmobar0.hs" (pure topPP)
+ where
+ topPP =
+ xmobarPP
+ { ppCurrent = xmobarColor "black" "#CCCCCC"
+ , ppHidden = xmobarColor "#CCCCCC" "black"
+ , ppHiddenNoWindows = xmobarColor "#606060" "black"
+ , ppLayout = \s -> xmobarColor "black" "#606060" $
+ case s of
+ "ResizableTall" -> " | "
+ "Mirror ResizableTall" -> " - "
+ "Tabbed Simplest" -> " + "
+ "Magnifier Grid" -> " ~ "
+ "Spiral" -> " @ "
+ "Full" -> " O "
+ "ThreeCol" -> " # "
+ _ -> s
+ , ppSep = " "
+ , ppTitle = xmobarColor "white" "black" . shorten 50
+ , ppUrgent = xmobarColor "yellow" "black"
+ , ppWsSep = " "
+ }
+
+traySB :: StatusBarConfig
+traySB =
+ statusBarGeneric
+ ( List.unwords
+ [ "trayer"
+ , "--align right"
+ , "--distance 0,0"
+ , "--distancefrom top,right"
+ , "--edge top"
+ , "--expand true"
+ , "--height 16"
+ , "--monitor primary"
+ , "--tint 0x000000"
+ , "--iconspacing 0"
+ , "--transparent true"
+ , "--widthtype request"
+ , "-l"
+ ]
+ )
+ mempty
+
+nextNonEmptyWS _ = moveTo Next (WSIs ((not .) <$> isWindowSpaceVisible))
+prevNonEmptyWS _ = moveTo Prev (WSIs ((not .) <$> isWindowSpaceVisible))
+
+isWindowSpaceVisible :: X (WindowSpace -> Bool)
+isWindowSpaceVisible = do
+ vs <- gets (map (W.tag . W.workspace) . W.visible . windowset)
+ return (\w -> W.tag w `elem` vs)
+
+spawnExec s = spawn $ List.unwords $ [ "exec" ] <> systemdCat <> [ s ]
+systemdCat = [ "systemd-cat" , "--priority=info", "--stderr-priority=warning", "--level-prefix=false" , "--" ]
+
+dtXPConfig :: XPConfig
+dtXPConfig = def
+ { font = "Hack 7"
+ , bgColor = "#282c34"
+ , fgColor = "#bbc2cf"
+ , bgHLight = "#c792ea"
+ , fgHLight = "#000000"
+ , borderColor = "#535974"
+ , promptBorderWidth = 0
+ , promptKeymap = dtXPKeymap
+ , position = Top
+ -- , position = CenteredAt { xpCenterY = 0.3, xpWidth = 0.3 }
+ , height = 23
+ , historySize = 256
+ , historyFilter = id
+ , defaultText = []
+ , autoComplete = Just 100000 -- set Just 100000 for .1 sec
+ , showCompletionOnTab = False
+ -- , searchPredicate = isPrefixOf
+ , searchPredicate = fuzzyMatch
+ , defaultPrompter = id $ List.map Char.toUpper -- change prompt to UPPER
+ -- , defaultPrompter = unwords . map reverse . words -- reverse the prompt
+ -- , defaultPrompter = drop 5 .id (++ "XXXX: ") -- drop first 5 chars of prompt and add XXXX:
+ , alwaysHighlight = True
+ , maxComplRows = Nothing -- set to 'Just 5' for 5 rows
+ }
+
+dtXPKeymap :: Map.Map (KeyMask,KeySym) (XP ())
+dtXPKeymap = Map.fromList $
+ List.map (first $ (,) controlMask) -- control + <key>
+ [ (xK_z, killBefore) -- kill line backwards
+ , (xK_k, killAfter) -- kill line forwards
+ , (xK_a, startOfLine) -- move to the beginning of the line
+ , (xK_e, endOfLine) -- move to the end of the line
+ , (xK_m, deleteString Next) -- delete a character foward
+ , (xK_b, moveCursor Prev) -- move cursor forward
+ , (xK_f, moveCursor Next) -- move cursor backward
+ , (xK_BackSpace, killWord Prev) -- kill the previous word
+ , (xK_y, pasteString) -- paste a string
+ , (xK_g, quit) -- quit out of prompt
+ , (xK_bracketleft, quit)
+ ]
+ ++
+ List.map (first $ (,) altMask) -- meta key + <key>
+ [ (xK_BackSpace, killWord Prev) -- kill the prev word
+ , (xK_f, moveWord Next) -- move a word forward
+ , (xK_b, moveWord Prev) -- move a word backward
+ , (xK_d, killWord Next) -- kill the next word
+ , (xK_n, moveHistory W.focusUp') -- move up thru history
+ , (xK_p, moveHistory W.focusDown') -- move down thru history
+ ]
+ ++
+ List.map (first $ (,) 0) -- <key>
+ [ (xK_Return, setSuccess True >> setDone True)
+ , (xK_KP_Enter, setSuccess True >> setDone True)
+ , (xK_BackSpace, deleteString Prev)
+ , (xK_Delete, deleteString Next)
+ , (xK_Left, moveCursor Prev)
+ , (xK_Right, moveCursor Next)
+ , (xK_Home, startOfLine)
+ , (xK_End, endOfLine)
+ , (xK_Down, moveHistory W.focusUp')
+ , (xK_Up, moveHistory W.focusDown')
+ , (xK_Escape, quit)
+ ]
+
+altMask :: KeyMask
+altMask = mod1Mask