{-# LANGUAGE NamedFieldPuns #-} {-# 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 qualified Data.Map as Map import Control.Arrow (first) -- import XMonad.Actions.DwmPromote -- import XMonad.Actions.Warp -- import XMonad.Layout.Maximize -- import XMonad.Layout.Monitor -- import XMonad.Layout.ResizableTile -- import XMonad.Layout.TabBarDecoration -- import XMonad.Util.EZConfig -- import XMonad.Util.EZConfig(additionalKeys) -- import XMonad.Util.WorkspaceCompare import XMonad hiding ((|||)) import XMonad.Actions.CopyWindow import XMonad.Actions.CycleWS import XMonad.Actions.SwapWorkspaces import XMonad.Actions.UpdatePointer import XMonad.Config.Azerty import XMonad.Hooks.DynamicLog 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.LayoutCombinators import XMonad.Layout.Magnifier import XMonad.Layout.MultiToggle import XMonad.Layout.MultiToggle.Instances import XMonad.Layout.NoBorders import XMonad.Layout.ResizableTile import XMonad.Layout.Spiral import XMonad.Layout.Tabbed import XMonad.Layout.ThreeColumns 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 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 = \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), 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}'\"") -- 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\"") -- 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), 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) -- 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 ..] ] -} , 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 tabConfig = def { activeBorderColor = "#7C7C7C" , activeColor = "#000000" , activeTextColor = "#00FF00" , inactiveBorderColor = "#7C7C7C" , inactiveColor = "#000000" , inactiveTextColor = "#EEEEEE" , fontName = "Hack 7" } 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 + [ (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 + [ (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) -- [ (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