From 729e030dd25da2e36fa5a1312b8ecb3415dc1675 Mon Sep 17 00:00:00 2001 From: Azat Bahawi Date: Tue, 23 Nov 2021 03:19:06 +0300 Subject: Huge update --- src/Main.hs | 71 --------- src/XMonad/Actions/FloatSnapSpaced.hs | 154 -------------------- src/XMonad/Actions/PerConditionKeys.hs | 34 ----- src/XMonad/Custom/Bindings.hs | 258 --------------------------------- src/XMonad/Custom/Event.hs | 23 --- src/XMonad/Custom/Layout.hs | 59 -------- src/XMonad/Custom/Log.hs | 80 ---------- src/XMonad/Custom/Manage.hs | 54 ------- src/XMonad/Custom/Misc.hs | 33 ----- src/XMonad/Custom/Navigation.hs | 22 --- src/XMonad/Custom/Projects.hs | 32 ---- src/XMonad/Custom/Prompt.hs | 27 ---- src/XMonad/Custom/Scratchpads.hs | 49 ------- src/XMonad/Custom/Startup.hs | 56 ------- src/XMonad/Custom/Theme.hs | 125 ---------------- src/XMonad/Custom/Workspaces.hs | 34 ----- src/exe/Main.hs | 70 +++++++++ src/lib/XMonad/Custom/Bindings.hs | 256 ++++++++++++++++++++++++++++++++ src/lib/XMonad/Custom/Event.hs | 24 +++ src/lib/XMonad/Custom/Layout.hs | 60 ++++++++ src/lib/XMonad/Custom/Log.hs | 82 +++++++++++ src/lib/XMonad/Custom/Manage.hs | 54 +++++++ src/lib/XMonad/Custom/Misc.hs | 36 +++++ src/lib/XMonad/Custom/Navigation.hs | 23 +++ src/lib/XMonad/Custom/Projects.hs | 33 +++++ src/lib/XMonad/Custom/Prompt.hs | 28 ++++ src/lib/XMonad/Custom/Scratchpads.hs | 50 +++++++ src/lib/XMonad/Custom/Startup.hs | 58 ++++++++ src/lib/XMonad/Custom/Theme.hs | 126 ++++++++++++++++ src/lib/XMonad/Custom/Workspaces.hs | 18 +++ 30 files changed, 918 insertions(+), 1111 deletions(-) delete mode 100644 src/Main.hs delete mode 100644 src/XMonad/Actions/FloatSnapSpaced.hs delete mode 100644 src/XMonad/Actions/PerConditionKeys.hs delete mode 100644 src/XMonad/Custom/Bindings.hs delete mode 100644 src/XMonad/Custom/Event.hs delete mode 100644 src/XMonad/Custom/Layout.hs delete mode 100644 src/XMonad/Custom/Log.hs delete mode 100644 src/XMonad/Custom/Manage.hs delete mode 100644 src/XMonad/Custom/Misc.hs delete mode 100644 src/XMonad/Custom/Navigation.hs delete mode 100644 src/XMonad/Custom/Projects.hs delete mode 100644 src/XMonad/Custom/Prompt.hs delete mode 100644 src/XMonad/Custom/Scratchpads.hs delete mode 100644 src/XMonad/Custom/Startup.hs delete mode 100644 src/XMonad/Custom/Theme.hs delete mode 100644 src/XMonad/Custom/Workspaces.hs create mode 100644 src/exe/Main.hs create mode 100644 src/lib/XMonad/Custom/Bindings.hs create mode 100644 src/lib/XMonad/Custom/Event.hs create mode 100644 src/lib/XMonad/Custom/Layout.hs create mode 100644 src/lib/XMonad/Custom/Log.hs create mode 100644 src/lib/XMonad/Custom/Manage.hs create mode 100644 src/lib/XMonad/Custom/Misc.hs create mode 100644 src/lib/XMonad/Custom/Navigation.hs create mode 100644 src/lib/XMonad/Custom/Projects.hs create mode 100644 src/lib/XMonad/Custom/Prompt.hs create mode 100644 src/lib/XMonad/Custom/Scratchpads.hs create mode 100644 src/lib/XMonad/Custom/Startup.hs create mode 100644 src/lib/XMonad/Custom/Theme.hs create mode 100644 src/lib/XMonad/Custom/Workspaces.hs (limited to 'src') diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 index 74b63a1..0000000 --- a/src/Main.hs +++ /dev/null @@ -1,71 +0,0 @@ --- | --- Module : Main --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable - -module Main where - -import XMonad ( Default(def) - , XConfig - ( borderWidth - , clickJustFocuses - , focusFollowsMouse - , focusedBorderColor - , handleEventHook - , keys - , layoutHook - , logHook - , manageHook - , modMask - , mouseBindings - , normalBorderColor - , startupHook - , terminal - , workspaces - ) - , xmonad - ) -import XMonad.Actions.DynamicProjects ( dynamicProjects ) -import XMonad.Actions.Navigation2D ( withNavigation2DConfig ) -import qualified XMonad.Custom.Bindings as C -import qualified XMonad.Custom.Event as C -import qualified XMonad.Custom.Layout as C -import qualified XMonad.Custom.Log as C -import qualified XMonad.Custom.Manage as C -import qualified XMonad.Custom.Misc as C -import qualified XMonad.Custom.Navigation as C -import qualified XMonad.Custom.Projects as C -import qualified XMonad.Custom.Startup as C -import qualified XMonad.Custom.Theme as C -import qualified XMonad.Custom.Workspaces as C -import XMonad.Hooks.EwmhDesktops ( ewmh ) -import XMonad.Hooks.ManageDocks ( docks ) -import XMonad.Layout.Fullscreen ( fullscreenSupport ) - -main :: IO () -main = - xmonad - $ ewmh - $ fullscreenSupport - $ docks - $ withNavigation2DConfig C.navigation - $ dynamicProjects C.projects - $ def { borderWidth = C.border - , workspaces = C.workspaces - , layoutHook = C.layoutHook - , terminal = C.term C.applications - , normalBorderColor = C.colorN - , focusedBorderColor = C.colorF - , modMask = C.modMask - , keys = C.keys - , logHook = C.logHook - , startupHook = C.startupHook - , mouseBindings = C.mouseBindings - , manageHook = C.manageHook - , handleEventHook = C.handleEventHook - , focusFollowsMouse = False - , clickJustFocuses = False - } diff --git a/src/XMonad/Actions/FloatSnapSpaced.hs b/src/XMonad/Actions/FloatSnapSpaced.hs deleted file mode 100644 index ad14016..0000000 --- a/src/XMonad/Actions/FloatSnapSpaced.hs +++ /dev/null @@ -1,154 +0,0 @@ --- | --- Module : XMonad.Actions.FloatSnapSpaced --- Copyright : (c) 2009 Anders Engstrom --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable --- - -module XMonad.Actions.FloatSnapSpaced - ( snapSpacedMagicMove - ) where - -import Data.List -import Data.Maybe -import Data.Set ( fromList ) -import XMonad -import XMonad.Hooks.ManageDocks -import qualified XMonad.StackSet as S - -snapSpacedMagicMove :: Int -> Maybe Int -> Maybe Int -> Window -> X () -snapSpacedMagicMove spacing collidedist snapdist w = - whenX (isClient w) $ withDisplay $ \d -> do - io $ raiseWindow d w - wa <- io $ getWindowAttributes d w - - nx <- handleAxis True d wa - ny <- handleAxis False d wa - - io $ moveWindow d w (fromIntegral nx) (fromIntegral ny) - float w - where - handleAxis horiz d wa = do - ((mbl, mbr, bs), (mfl, mfr, fs)) <- getSnap horiz collidedist d w - return $ if bs || fs - then wpos wa - else - let - b = case (mbl, mbr) of - (Just bl, Just br) -> - if wpos wa - bl < br - wpos wa then bl + spacing else br + spacing - (Just bl, Nothing) -> bl + spacing - (Nothing, Just br) -> br + spacing - (Nothing, Nothing) -> wpos wa + spacing - - f = case (mfl, mfr) of - (Just fl, Just fr) -> - if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa - then fl - spacing - else fr - spacing - (Just fl, Nothing) -> fl - spacing - (Nothing, Just fr) -> fr - spacing - (Nothing, Nothing) -> wpos wa - spacing - - newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) - then b - else f - wdim wa - in - if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist - then newpos - else wpos wa - where (wpos, wdim, _, _) = constructors horiz - -getSnap - :: Bool - -> Maybe Int - -> Display - -> Window - -> X ((Maybe Int, Maybe Int, Bool), (Maybe Int, Maybe Int, Bool)) -getSnap horiz collidedist d w = do - wa <- io $ getWindowAttributes d w - screen <- S.current <$> gets windowset - let sr = screenRect $ S.screenDetail screen - wl = S.integrate' . S.stack $ S.workspace screen - gr <- fmap ($ sr) $ calcGap $ fromList [minBound .. maxBound] - wla <- filter (collides wa) - <$> io (mapM (getWindowAttributes d) $ filter (/= w) wl) - - return - ( neighbours (back wa sr gr wla) (wpos wa) - , neighbours (front wa sr gr wla) (wpos wa + wdim wa) - ) - where - wborder = fromIntegral . wa_border_width - - (wpos , wdim , rpos, rdim) = constructors horiz - (refwpos, refwdim, _ , _ ) = constructors $ not horiz - - back wa sr gr wla = - dropWhile (< rpos sr) - $ takeWhile (< rpos sr + rdim sr) - $ sort - $ rpos sr - : rpos gr - : (rpos gr + rdim gr) - : foldr - (\a as -> wpos a : (wpos a + wdim a + wborder a + wborder wa) : as) - [] - wla - - front wa sr gr wla = - dropWhile (<= rpos sr) - $ takeWhile (<= rpos sr + rdim sr) - $ sort - $ (rpos gr - 2 * wborder wa) - : (rpos gr + rdim gr - 2 * wborder wa) - : (rpos sr + rdim sr - 2 * wborder wa) - : foldr - (\a as -> (wpos a - wborder a - wborder wa) : (wpos a + wdim a) : as) - [] - wla - - neighbours l v = - ( listToMaybe $ reverse $ takeWhile (< v) l - , listToMaybe $ dropWhile (<= v) l - , v `elem` l - ) - - collides wa oa = case collidedist of - Nothing -> True - Just dist -> - refwpos oa - - wborder oa - < refwpos wa - + refwdim wa - + wborder wa - + dist - && refwpos wa - - wborder wa - - dist - < refwpos oa - + refwdim oa - + wborder oa - - -constructors - :: Bool - -> ( WindowAttributes -> Int - , WindowAttributes -> Int - , Rectangle -> Int - , Rectangle -> Int - ) -constructors True = - ( fromIntegral . wa_x - , fromIntegral . wa_width - , fromIntegral . rect_x - , fromIntegral . rect_width - ) -constructors False = - ( fromIntegral . wa_y - , fromIntegral . wa_height - , fromIntegral . rect_y - , fromIntegral . rect_height - ) diff --git a/src/XMonad/Actions/PerConditionKeys.hs b/src/XMonad/Actions/PerConditionKeys.hs deleted file mode 100644 index 09372cd..0000000 --- a/src/XMonad/Actions/PerConditionKeys.hs +++ /dev/null @@ -1,34 +0,0 @@ --- | --- Module : XMonad.Actions.PerConditionKeys --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable --- - -module XMonad.Actions.PerConditionKeys - ( XCond(..) - , chooseAction - , bindOn - ) where - -import Data.List -import XMonad -import qualified XMonad.StackSet as S - -data XCond = WS | LD - -chooseAction :: XCond -> (String -> X ()) -> X () -chooseAction WS f = withWindowSet (f . S.currentTag) -chooseAction LD f = - withWindowSet (f . description . S.layout . S.workspace . S.current) - -bindOn :: XCond -> [(String, X ())] -> X () -bindOn xc bindings = chooseAction xc chooser - where - chooser x = case find ((x ==) . fst) bindings of - Just (_, action) -> action - Nothing -> case find (("" ==) . fst) bindings of - Just (_, action) -> action - Nothing -> return () diff --git a/src/XMonad/Custom/Bindings.hs b/src/XMonad/Custom/Bindings.hs deleted file mode 100644 index de0fd26..0000000 --- a/src/XMonad/Custom/Bindings.hs +++ /dev/null @@ -1,258 +0,0 @@ -{-# LANGUAGE LambdaCase #-} - --- | --- Module : XMonad.Custom.Bindings --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable --- - -module XMonad.Custom.Bindings - ( keys - , rawKeys - , modMask - , mouseBindings - ) where - -import qualified Data.Map as M -import System.Exit -import XMonad hiding ( keys - , modMask - , mouseBindings - ) -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.UpdatePointer -import XMonad.Actions.WithAll -import XMonad.Custom.Layout -import qualified XMonad.Custom.Misc as C -import XMonad.Custom.Scratchpads -import XMonad.Custom.Theme -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.Shell -import XMonad.Prompt.Window -import XMonad.Prompt.Workspace -import qualified XMonad.StackSet as S -import XMonad.Util.EZConfig -import XMonad.Util.NamedScratchpad -import XMonad.Util.WorkspaceCompare - -modMask :: KeyMask -modMask = mod4Mask - -directions :: [Direction2D] -directions = [D, U, L, R] - -arrowKeys, directionKeys, wsKeys :: [String] -arrowKeys = ["", "", "", ""] -directionKeys = ["j", "k", "h", "l"] -wsKeys = map show [1 .. 9 :: Int] - -zipKeys :: [a] -> [[a]] -> [t1] -> (t1 -> b) -> [([a], b)] -zipKeys m ks as f = zipWith (\k d -> (m ++ k, f d)) ks as -zipKeys' :: [a] -> [[a]] -> [t1] -> (t1 -> t2 -> b) -> t2 -> [([a], b)] -zipKeys' m ks as f b = zipWith (\k d -> (m ++ k, f d b)) ks as - -tryMessageR_ :: (Message a, Message b) => a -> b -> X () -tryMessageR_ x y = sequence_ [tryMessageWithNoRefreshToCurrent x y, refresh] - -toggleCopyToAll :: X () -toggleCopyToAll = wsContainingCopies >>= \case - [] -> 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 - ) - -withUpdatePointer :: [(String, X ())] -> [(String, X ())] -withUpdatePointer = map addAction - where - addAction :: (String, X ()) -> (String, X ()) - addAction (key, action) = (key, action >> updatePointer (0.98, 0.01) (0, 0)) - -keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) -keys c = mkKeymap c (rawKeys c) - -rawKeys :: XConfig Layout -> [(String, X ())] -rawKeys c = withUpdatePointer $ concatMap ($ c) keymaps - where - keymaps = - [ keysBase - , keysSystem - , keysMedia - , keysWorkspaces - , keysSpawnables - , keysWindows - , keysLayout - , keysResize - ] - -keysBase :: XConfig Layout -> [(String, X ())] -keysBase _ = - [ ("M-S-q", confirmPrompt hotPromptTheme "Quit XMonad?" $ io exitSuccess) - , ("M-q" , spawn "xmonad --restart") -- TODO Replace with interal calls - , ("M-C-q", spawn "xmonad --recompile && xmonad --restart") - , ("M-x" , shellPrompt promptTheme) - , ("M-w" , windowPrompt promptTheme Goto allWindows) - , ("M-S-w", windowPrompt promptTheme Bring allWindows) - ] - -keysSystem :: XConfig Layout -> [(String, X ())] -keysSystem _ = - [ ("M-C-g" , return ()) -- TODO Replace scripts with internal functions - , ("", spawn "~/.xmonad/scripts/screenlock.sh") - , ("M-", spawn "~/.xmonad/scripts/xshot-upload.sh") - , ("M-S-", spawn "~/.xmonad/scripts/xshot-select-upload.sh") - , ("M-C-c", spawn "~/.xmonad/scripts/toggle-compton.sh") - , ("M-C-r", spawn "~/.xmonad/scripts/toggle-redshift.sh") - , ("M-C-p", spawn "~/.xmonad/scripts/toggle-touchpad.sh") - , ("M-C-t", spawn "~/.xmonad/scripts/toggle-trackpoint.sh") - ] - -keysMedia :: XConfig Layout -> [(String, X ())] -- TODO Make audio keys compatible with ALSA/PA at the same time -keysMedia _ = - [ ("", spawn "pactl set-source-mute 1 toggle") - , ("" , spawn "pactl set-sink-mute 0 toggle") - , ( "" - , spawn "pactl set-sink-mute 0 false && pactl set-sink-volume 0 -10%" - ) - , ( "" - , spawn "pactl set-sink-mute 0 false && pactl set-sink-volume 0 +10%" - ) - , ("", spawn "mpc toggle") - , ("", spawn "mpc stop") - , ("", spawn "mpc prev") - , ("", spawn "mpc next") - ] - -keysWorkspaces :: XConfig Layout -> [(String, X ())] -keysWorkspaces _ = - [ ("M-S-o", switchProjectPrompt promptTheme) - , ("M-S-p", shiftToProjectPrompt promptTheme) - , ("M-," , nextNonEmptyWS) - , ("M-." , prevNonEmptyWS) - , ("M-i" , toggleWS' ["NSP"]) - , ("M-n", workspacePrompt promptTheme $ windows . S.shift) - ] - ++ zipKeys "M-" wsKeys [0 ..] (withNthWorkspace S.greedyView) - ++ zipKeys "M-S-" wsKeys [0 ..] (withNthWorkspace S.shift) - ++ zipKeys "M-C-S-" wsKeys [0 ..] (withNthWorkspace copy) - -keysSpawnables :: XConfig Layout -> [(String, X ())] -keysSpawnables _ = - [ ("M-", spawn (C.term C.applications)) - , ("M-b" , spawn (C.browser C.applications)) - , ("M-c" , namedScratchpadAction scratchpads "console") - , ("M-m" , namedScratchpadAction scratchpads "music") - , ("M-t" , namedScratchpadAction scratchpads "top") - , ("M-v" , namedScratchpadAction scratchpads "volume") - ] - -keysWindows :: XConfig Layout -> [(String, X ())] -keysWindows _ = - [ ("M-d" , kill) - , ("M-S-d", confirmPrompt hotPromptTheme "Kill all" killAll) - , ("M-a" , toggleCopyToAll) - , ("M-e" , withFocused hideWindow) -- FIXME This is so broken - , ("M-S-e", popOldestHiddenWindow) - , ("M-p" , promote) - , ("M-g", withFocused $ sendMessage . MergeAll) - , ("M-S-g", withFocused $ sendMessage . UnMerge) - , ("M-u" , focusUrgent) - , ("M-s" , windows S.focusMaster) - , ( "M-'" - , bindOn LD [("Tabs", windows S.focusDown), ("", onGroup S.focusDown')] - ) - , ("M-;", bindOn LD [("Tabs", windows S.focusUp), ("", onGroup S.focusUp')]) - , ("M-S-'", windows S.swapDown) - , ("M-S-;", windows S.swapUp) - ] - ++ zipKeys' "M-" directionKeys directions windowGo True -- TODO W moving - ++ zipKeys' "M-S-" directionKeys directions windowSwap True - ++ zipKeys "M-C-" directionKeys directions (sendMessage . pullGroup) - ++ zipKeys' "M-" arrowKeys directions screenGo True - ++ zipKeys' "M-S-" arrowKeys directions windowToScreen True - ++ zipKeys' "M-C-" arrowKeys directions screenSwap True - -keysLayout :: XConfig Layout -> [(String, X ())] -keysLayout c = - [ ("M-" , sendMessage NextLayout) - , ("M-C-", toSubl NextLayout) - , ("M-S-", setLayout $ XMonad.layoutHook c) - , ("M-o" , withFocused toggleFloat) - , ("M-S-o" , sinkAll) - , ("M-S-," , sendMessage $ IncMasterN (-1)) - , ("M-S-." , sendMessage $ IncMasterN 1) - , ("M-r" , tryMessageR_ Rotate (Toggle REFLECTX)) - , ("M-S-r" , sendMessage $ Toggle REFLECTX) - , ( "M-f" - , sequence_ [withFocused $ windows . S.sink, sendMessage $ Toggle NBFULL] - ) - , ("M-C-g", sendMessage $ Toggle GAPS) -- FIXME Breaks merged tabbed layout - ] - -keysResize :: XConfig Layout -> [(String, X ())] -keysResize _ = - [ ("M-[" , tryMessageR_ (ExpandTowards L) Shrink) - , ("M-]" , tryMessageR_ (ExpandTowards R) Expand) - , ("M-S-[" , tryMessageR_ (ExpandTowards U) MirrorShrink) - , ("M-S-]" , tryMessageR_ (ExpandTowards D) MirrorExpand) - , ("M-C-[" , tryMessageR_ (ShrinkFrom R) Shrink) - , ("M-C-]" , tryMessageR_ (ShrinkFrom L) Expand) - , ("M-S-C-[", tryMessageR_ (ShrinkFrom D) MirrorShrink) - , ("M-S-C-]", tryMessageR_ (ShrinkFrom U) MirrorExpand) - ] - -mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) -mouseBindings XConfig{} = M.fromList - [ ( (modMask, button1) - , \w -> - focus w - >> F.mouseWindow F.position w - >> ifClick (snapSpacedMagicMove gapFull (Just 50) (Just 50) w) - >> windows S.shiftMaster - ) - , ( (modMask, button3) - , \w -> - focus w - >> F.mouseWindow F.linear w - >> ifClick (snapMagicResize [L, R, U, D] (Just 50) (Just 50) w) - >> windows S.shiftMaster - ) - ] diff --git a/src/XMonad/Custom/Event.hs b/src/XMonad/Custom/Event.hs deleted file mode 100644 index f55511d..0000000 --- a/src/XMonad/Custom/Event.hs +++ /dev/null @@ -1,23 +0,0 @@ --- | --- Module : XMonad.Custom.Event --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable --- - -module XMonad.Custom.Event - ( handleEventHook - ) where - -import Data.Monoid -import XMonad hiding ( handleEventHook ) -import XMonad.Custom.Scratchpads -import XMonad.Hooks.EwmhDesktops -import XMonad.Hooks.ManageDocks -import XMonad.Util.Loggers.NamedScratchpad - -handleEventHook :: Event -> X All -handleEventHook = - mconcat [nspTrackHook scratchpads, docksEventHook, fullscreenEventHook] diff --git a/src/XMonad/Custom/Layout.hs b/src/XMonad/Custom/Layout.hs deleted file mode 100644 index fe9224a..0000000 --- a/src/XMonad/Custom/Layout.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# OPTIONS_GHC -Wno-missing-signatures #-} - --- | --- Module : XMonad.Custom.Layout --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable --- - -module XMonad.Custom.Layout - ( layoutHook - , CustomTransformers(..) - ) where - -import XMonad hiding ( layoutHook ) -import XMonad.Custom.Theme -import XMonad.Hooks.ManageDocks -import XMonad.Layout.Accordion -import XMonad.Layout.BinarySpacePartition -import XMonad.Layout.Fullscreen -import XMonad.Layout.Hidden -import XMonad.Layout.LayoutModifier -import XMonad.Layout.MultiToggle -import XMonad.Layout.MultiToggle.Instances -import XMonad.Layout.NoBorders -import XMonad.Layout.Reflect -import XMonad.Layout.Simplest -import XMonad.Layout.Spacing -import XMonad.Layout.SubLayouts -import XMonad.Layout.Tabbed -import XMonad.Layout.WindowNavigation - -applySpacing :: l a -> ModifiedLayout Spacing l a -applySpacing = spacingRaw False (Border 6 6 6 6) True (Border 6 6 6 6) True - -data CustomTransformers = GAPS - deriving (Read, Show, Eq, Typeable) - -instance Transformer CustomTransformers Window where - transform GAPS x k = k (avoidStruts $ applySpacing x) (const x) - -layoutHook = - fullscreenFloat - $ lessBorders OnlyLayoutFloat - $ mkToggle (single NBFULL) - $ avoidStruts - $ applySpacing - $ mkToggle (single GAPS) - $ mkToggle (single REFLECTX) - $ mkToggle (single REFLECTY) - $ windowNavigation - $ addTabs shrinkText tabTheme - $ hiddenWindows - $ subLayout [] (Simplest ||| Accordion) emptyBSP diff --git a/src/XMonad/Custom/Log.hs b/src/XMonad/Custom/Log.hs deleted file mode 100644 index 6b7af37..0000000 --- a/src/XMonad/Custom/Log.hs +++ /dev/null @@ -1,80 +0,0 @@ --- | --- Module : XMonad.Custom.Log --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable - -module XMonad.Custom.Log - ( logHook - ) where - -import System.IO -import XMonad hiding ( logHook ) -import XMonad.Actions.CopyWindow -import XMonad.Custom.Theme -import XMonad.Hooks.CurrentWorkspaceOnTop -import XMonad.Hooks.DynamicLog -import XMonad.Hooks.EwmhDesktops -import XMonad.Util.NamedScratchpad -import XMonad.Util.SpawnNamedPipe -import XMonad.Util.WorkspaceCompare - -xmobarFont :: Int -> String -> String -xmobarFont f = wrap (concat [""]) "" - -topBarPP :: PP -topBarPP = def - { ppCurrent = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "=" - , ppVisible = xmobarColor white1 "" . wrap "~" "~" - , ppHidden = xmobarColor white1 "" . wrap "-" "-" - , ppHiddenNoWindows = xmobarColor white1 "" . wrap "_" "_" - , ppUrgent = xmobarColor red2 "" . wrap "!" "!" - , ppSep = " / " - , ppWsSep = " " - , ppTitle = xmobarColor white1 "" . shorten 50 - , ppTitleSanitize = xmobarStrip - , ppLayout = xmobarColor white1 "" - , ppOrder = id - , ppSort = (namedScratchpadFilterOutWorkspace .) <$> getSortByIndex - , ppExtras = [] - } - -botBarPP :: PP -botBarPP = topBarPP { ppCurrent = const "" - , ppVisible = const "" - , ppHidden = const "" - , ppHiddenNoWindows = const "" - , ppUrgent = const "" - , ppTitle = const "" - , ppLayout = const "" - } - -safePrintToPipe :: Maybe Handle -> String -> IO () -safePrintToPipe = maybe (\_ -> return ()) hPutStrLn - -logHook :: X () -logHook = do - currentWorkspaceOnTop - ewmhDesktopsLogHook - t <- getNamedPipe "xmobarTop" - b <- getNamedPipe "xmobarBot" - c <- wsContainingCopies - let copiesCurrent ws - | ws `elem` c - = xmobarColor yellow2 "" . xmobarFont 2 . wrap "*" "=" $ ws - | otherwise - = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "=" $ ws - let copiesHidden ws - | ws `elem` c = xmobarColor yellow1 "" . wrap "*" "-" $ ws - | otherwise = xmobarColor white1 "" . wrap "-" "-" $ ws - let copiesUrgent ws - | ws `elem` c = xmobarColor yellow2 "" . wrap "*" "!" $ ws - | otherwise = xmobarColor white2 "" . wrap "!" "!" $ ws - dynamicLogWithPP $ topBarPP { ppCurrent = copiesCurrent - , ppHidden = copiesHidden - , ppUrgent = copiesUrgent - , ppOutput = safePrintToPipe t - } - dynamicLogWithPP $ botBarPP { ppOutput = safePrintToPipe b } diff --git a/src/XMonad/Custom/Manage.hs b/src/XMonad/Custom/Manage.hs deleted file mode 100644 index ac4201b..0000000 --- a/src/XMonad/Custom/Manage.hs +++ /dev/null @@ -1,54 +0,0 @@ --- | --- Module : XMonad.Custom.Manage --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable --- - -module XMonad.Custom.Manage - ( manageHook - ) where - -import XMonad hiding ( manageHook ) -import XMonad.Custom.Scratchpads -import XMonad.Hooks.InsertPosition -import XMonad.Hooks.ManageDocks -import XMonad.Hooks.ManageHelpers -import XMonad.Layout.Fullscreen -import XMonad.Util.NamedScratchpad - -composeActions :: [MaybeManageHook] -composeActions = - [ appName =? "emacs-popup" -?> tileBelowNoFocus - , appName =? "eterm" -?> tileBelow - , className =? "Pinentry" -?> doCenterFloat - , className =? "Steam" <&&> not <$> title =? "Steam" -?> doFloat - , className =? "Xmessage" -?> doCenterFloat - , className =? "Zenity" -?> doCenterFloat - , className =? "explorer.exe" -?> doFullFloat - , className =? "qemu-system-x86" -?> doCenterFloat - , className =? "qemu-system-x86_64" -?> doCenterFloat - , className =? "urxvt" -?> tileBelow - , className =? "xterm" -?> tileBelow - , isDialog -?> doCenterFloat - , isFullscreen -?> doFullFloat - , pure True -?> tileNormal - , stringProperty "WM_WINDOW_ROLE" =? "pop-up" -?> doCenterFloat - , stringProperty "WM_WINDOW_ROLE" =? "GtkFileChooserDialog" -?> doCenterFloat - , transience - ] - where - tileNormal = insertPosition Above Newer - tileBelow = insertPosition Below Newer - tileBelowNoFocus = insertPosition Below Older - - -manageHook :: ManageHook -manageHook = mconcat - [ manageDocks - , fullscreenManageHook - , namedScratchpadManageHook scratchpads - , composeOne composeActions - ] diff --git a/src/XMonad/Custom/Misc.hs b/src/XMonad/Custom/Misc.hs deleted file mode 100644 index aa48ee2..0000000 --- a/src/XMonad/Custom/Misc.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# OPTIONS_GHC -funbox-strict-fields #-} - --- | --- Module : XMonad.Custom.Misc --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable - -module XMonad.Custom.Misc - ( Applications(..) - , applications - ) where - -data Applications = Applications - { browser :: !String - , mixer :: !String - , notify :: !String - , player :: !String - , term :: !String - , top :: !String - } - deriving (Eq, Show) - -applications :: Applications -applications = Applications { browser = "qutebrowser" - , mixer = "pulsemixer" - , notify = "notify-send" - , player = "ncmpcpp" - , term = "urxvtc" - , top = "htop" - } diff --git a/src/XMonad/Custom/Navigation.hs b/src/XMonad/Custom/Navigation.hs deleted file mode 100644 index 812dd30..0000000 --- a/src/XMonad/Custom/Navigation.hs +++ /dev/null @@ -1,22 +0,0 @@ --- | --- Module : XMonad.Custom.Navigation --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable --- - -module XMonad.Custom.Navigation - ( navigation - ) where - -import XMonad.Actions.Navigation2D - -navigation :: Navigation2DConfig -navigation = def - { defaultTiledNavigation = hybridOf sideNavigation centerNavigation - , floatNavigation = hybridOf lineNavigation centerNavigation - , layoutNavigation = [("Full", centerNavigation)] - , unmappedWindowRect = [("Full", singleWindowRect)] - } diff --git a/src/XMonad/Custom/Projects.hs b/src/XMonad/Custom/Projects.hs deleted file mode 100644 index 4726fc7..0000000 --- a/src/XMonad/Custom/Projects.hs +++ /dev/null @@ -1,32 +0,0 @@ --- | --- Module : XMonad.Custom.Projects --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable --- - -module XMonad.Custom.Projects - ( projects - ) where - -import XMonad.Actions.DynamicProjects -import XMonad.Actions.SpawnOn -import qualified XMonad.Custom.Misc as C - -projects :: [Project] -projects = - [ Project { projectName = "Template" - , projectDirectory = "~/" - , projectStartHook = Nothing - } - , Project { projectName = "Emacs" - , projectDirectory = "~/" - , projectStartHook = Just $ spawnOn "Emacs" "emacsclient" - } - , Project { projectName = "WWW" - , projectDirectory = "~/" - , projectStartHook = Just $ spawnOn "WWW" (C.browser C.applications) - } - ] diff --git a/src/XMonad/Custom/Prompt.hs b/src/XMonad/Custom/Prompt.hs deleted file mode 100644 index e8762d1..0000000 --- a/src/XMonad/Custom/Prompt.hs +++ /dev/null @@ -1,27 +0,0 @@ --- | --- Module : XMonad.Custom.Prompt --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable --- - -module XMonad.Custom.Prompt - ( listCompFunc - , aListCompFunc - , predicateFunction - ) where - -import Data.Char -import Data.List -import XMonad.Prompt - -listCompFunc :: XPConfig -> [String] -> String -> IO [String] -listCompFunc c xs s = return (filter (searchPredicate c s) xs) - -aListCompFunc :: XPConfig -> [(String, a)] -> String -> IO [String] -aListCompFunc c xs = listCompFunc c (map fst xs) - -predicateFunction :: String -> String -> Bool -predicateFunction x y = lc x `isInfixOf` lc y where lc = map toLower diff --git a/src/XMonad/Custom/Scratchpads.hs b/src/XMonad/Custom/Scratchpads.hs deleted file mode 100644 index 157a1fb..0000000 --- a/src/XMonad/Custom/Scratchpads.hs +++ /dev/null @@ -1,49 +0,0 @@ --- | --- Module : XMonad.Custom.Scratchpads --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable --- - -module XMonad.Custom.Scratchpads - ( scratchpads - ) where - -import XMonad.Core -import XMonad.Custom.Misc as C -import XMonad.ManageHook -import qualified XMonad.StackSet as S -import XMonad.Util.NamedScratchpad - -spawnTerminalWith :: String -> String -> String -spawnTerminalWith t c = term applications ++ " -title " ++ t ++ " -e " ++ c - -floatingNSP :: ManageHook -floatingNSP = customFloating $ S.RationalRect x y w h - where - x = (1 - w) / 2 - y = (1 - h) / 2 - w = 1 / 2 - h = 1 / 2.5 - -scratchpads :: [NamedScratchpad] -scratchpads = - [ NS "console" - (spawnTerminalWith "NSPConsole" "~/.xmonad/scripts/nsp-console.sh") - (title =? "NSPConsole") - floatingNSP - , NS "volume" - (spawnTerminalWith "NSPVolume" (C.mixer C.applications)) - (title =? "NSPVolume") - floatingNSP - , NS "music" - (spawnTerminalWith "NSPMusic" (C.player C.applications)) - (title =? "NSPMusic") - floatingNSP - , NS "top" - (spawnTerminalWith "NSPTop" (C.top C.applications)) - (title =? "NSPTop") - floatingNSP - ] diff --git a/src/XMonad/Custom/Startup.hs b/src/XMonad/Custom/Startup.hs deleted file mode 100644 index cdd63ac..0000000 --- a/src/XMonad/Custom/Startup.hs +++ /dev/null @@ -1,56 +0,0 @@ --- | --- Module : XMonad.Custom.Startup --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable - -module XMonad.Custom.Startup - ( startupHook - ) where - -import Control.Monad -import Data.Maybe -import XMonad hiding ( startupHook ) -import XMonad.Hooks.ManageDocks -import XMonad.Hooks.SetWMName -import XMonad.Util.Cursor -import XMonad.Util.SpawnNamedPipe - -atomsToFullscreen :: [String] -atomsToFullscreen = - [ "_NET_ACTIVE_WINDOW" - , "_NET_CLIENT_LIST" - , "_NET_CLIENT_LIST_STACKING" - , "_NET_DESKTOP_NAMES" - , "_NET_WM_DESKTOP" - , "_NET_WM_STATE" - , "_NET_WM_STATE_FULLSCREEN" - , "_NET_WM_STATE_HIDDEN" - , "_NET_WM_STRUT" - ] - -addNETSupported :: Atom -> X () -addNETSupported x = withDisplay $ \d -> do - r <- asks theRoot - n <- getAtom "_NET_SUPPORTED" - a <- getAtom "ATOM" - liftIO $ do - p <- join . maybeToList <$> getWindowProperty32 d n r - when (fromIntegral x `notElem` p) - $ changeProperty32 d r n a propModeAppend [fromIntegral x] - -addEWMHFullscreen :: X () -addEWMHFullscreen = do - s <- mapM getAtom atomsToFullscreen - mapM_ addNETSupported s - -startupHook :: X () -startupHook = do - spawnNamedPipe "xmobar ~/.xmonad/xmobarrc/top.hs" "xmobarTop" - spawnNamedPipe "xmobar ~/.xmonad/xmobarrc/bot.hs" "xmobarBot" - docksStartupHook - addEWMHFullscreen - setDefaultCursor xC_left_ptr - setWMName "xmonad" diff --git a/src/XMonad/Custom/Theme.hs b/src/XMonad/Custom/Theme.hs deleted file mode 100644 index 64b52a8..0000000 --- a/src/XMonad/Custom/Theme.hs +++ /dev/null @@ -1,125 +0,0 @@ --- | --- Module : XMonad.Custom.Theme --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable --- - -module XMonad.Custom.Theme - ( font - , black1 - , black2 - , red1 - , red2 - , green1 - , green2 - , yellow1 - , yellow2 - , blue1 - , blue2 - , magenta1 - , magenta2 - , cyan1 - , cyan2 - , white1 - , white2 - , colorN - , colorF - , gapBase - , gapFull - , border - , tabTheme - , promptTheme - , hotPromptTheme - ) where - -import Data.Char -import Data.Function -import Data.List -import Data.Ratio -import Graphics.X11.Xlib.Types -import XMonad.Layout.Decoration -import qualified XMonad.Prompt as P - -font :: String -font = "xft:tewi:style=Regular:size=8" -- TODO CJKのフォールバックフォントを追加する - -black1, black2 :: String -- TODO get variables from Xresources -(black1, black2) = ("#0b0806", "#2f2b2a") - --- | Red -red1, red2 :: String -(red1, red2) = ("#844d2c", "#a64848") - --- | Green -green1, green2 :: String -(green1, green2) = ("#57553a", "#897f5a") - --- | Yellow -yellow1, yellow2 :: String -(yellow1, yellow2) = ("#a17c38", "#c8b38d") - --- | Blue -blue1, blue2 :: String -(blue1, blue2) = ("#41434f", "#526274") - --- | Magenta -magenta1, magenta2 :: String -(magenta1, magenta2) = ("#6b4444", "#755c47") - --- | Cyan -cyan1, cyan2 :: String -(cyan1, cyan2) = ("#59664c", "#718062") - --- | White -white1, white2 :: String -(white1, white2) = ("#a19782", "#c1ab83") - -colorN, colorF :: String -colorN = black2 -colorF = white2 - -gapBase, gapFull :: Int -gapBase = 6 -gapFull = gapBase * 2 - -height, border :: Dimension -height = 12 * 2 -border = 1 - -tabTheme :: Theme -tabTheme = def { activeColor = black1 - , inactiveColor = black2 - , urgentColor = red1 - , activeBorderColor = white1 - , inactiveBorderColor = white2 - , urgentBorderColor = red2 - , activeTextColor = white1 - , inactiveTextColor = white2 - , urgentTextColor = red2 - , fontName = font - , decoHeight = height - } - -promptTheme, hotPromptTheme :: P.XPConfig -promptTheme = def - { P.font = font - , P.bgColor = black1 - , P.fgColor = white1 - , P.fgHLight = white2 - , P.bgHLight = black2 - , P.borderColor = white2 - , P.promptBorderWidth = border - , P.position = P.CenteredAt { P.xpCenterY = 3 % 10, P.xpWidth = 9 % 10 } - , P.height = height - , P.maxComplRows = Just 5 - , P.searchPredicate = isInfixOf `on` map toLower - , P.alwaysHighlight = True - } -hotPromptTheme = promptTheme { P.bgColor = black2 - , P.fgColor = white2 - , P.fgHLight = white1 - , P.bgHLight = black1 - } diff --git a/src/XMonad/Custom/Workspaces.hs b/src/XMonad/Custom/Workspaces.hs deleted file mode 100644 index 65d1b14..0000000 --- a/src/XMonad/Custom/Workspaces.hs +++ /dev/null @@ -1,34 +0,0 @@ --- | --- Module : XMonad.Custom.Workspaces --- Copyright : (c) 2018-2020 Azat Bahawi --- License : BSD3-style (see LICENSE) --- Maintainer : Azat Bahawi --- Stability : unstable --- Portability : unportable --- - -module XMonad.Custom.Workspaces - ( workspaces - ) where - -import XMonad.Actions.DynamicProjects -import XMonad.Core hiding ( workspaces ) - -workspaces :: [WorkspaceId] -workspaces = map show [1 .. 9 :: Int] - -projects :: [Project] -projects = - [ Project { projectName = "scratch" - , projectDirectory = "~/" - , projectStartHook = Nothing - } - , Project { projectName = "www" - , projectDirectory = "~/" - , projectStartHook = Nothing - } - , Project { projectName = "mail" - , projectDirectory = "~/" - , projectStartHook = Nothing - } - ] diff --git a/src/exe/Main.hs b/src/exe/Main.hs new file mode 100644 index 0000000..3a57650 --- /dev/null +++ b/src/exe/Main.hs @@ -0,0 +1,70 @@ +-- | +-- Module : Main +-- Description : Entrypoint +-- Copyright : (c) Azat Bahawi 2018-2021 +-- SPDX-License-Identifier : GPL-3.0-or-later +-- Maintainer : azahi@teknik.io +-- Stability : experimental +-- Portability : non-portable +-- + +module Main where + +import XMonad ( Default(def) + , XConfig + ( borderWidth + , clickJustFocuses + , focusFollowsMouse + , focusedBorderColor + , handleEventHook + , keys + , layoutHook + , manageHook + , modMask + , mouseBindings + , normalBorderColor + , startupHook + , terminal + , workspaces + ) + , xmonad + ) +import XMonad.Actions.DynamicProjects ( dynamicProjects ) +import XMonad.Actions.Navigation2D ( withNavigation2DConfig ) +import qualified XMonad.Custom.Bindings as C +import qualified XMonad.Custom.Event as C +import qualified XMonad.Custom.Layout as C +import qualified XMonad.Custom.Manage as C +import qualified XMonad.Custom.Misc as C +import qualified XMonad.Custom.Navigation as C +import qualified XMonad.Custom.Projects as C +import qualified XMonad.Custom.Startup as C +import qualified XMonad.Custom.Theme as C +import qualified XMonad.Custom.Workspaces as C +import XMonad.Hooks.EwmhDesktops ( ewmh ) +import XMonad.Hooks.ManageDocks ( docks ) +import XMonad.Layout.Fullscreen ( fullscreenSupport ) + +main :: IO () +main = + xmonad + $ ewmh + $ fullscreenSupport + $ docks + $ withNavigation2DConfig C.navigation + $ dynamicProjects C.projects + $ def { borderWidth = C.border + , workspaces = C.workspaces + , layoutHook = C.layoutHook + , terminal = C.term C.applications + , normalBorderColor = C.colorN + , focusedBorderColor = C.colorF + , modMask = C.modMask + , keys = C.keys + , startupHook = C.startupHook + , mouseBindings = C.mouseBindings + , manageHook = C.manageHook + , handleEventHook = C.handleEventHook + , focusFollowsMouse = False + , clickJustFocuses = False + } diff --git a/src/lib/XMonad/Custom/Bindings.hs b/src/lib/XMonad/Custom/Bindings.hs new file mode 100644 index 0000000..208ccdf --- /dev/null +++ b/src/lib/XMonad/Custom/Bindings.hs @@ -0,0 +1,256 @@ +{-# LANGUAGE LambdaCase #-} + +-- | +-- Module : XMonad.Custom.Bindings +-- Description : Key bindings and keys configuration +-- Copyright : (c) Azat Bahawi 2018-2021 +-- SPDX-License-Identifier : GPL-3.0-or-later +-- Maintainer : azahi@teknik.io +-- Stability : experimental +-- Portability : non-portable +-- + +module XMonad.Custom.Bindings + ( keys + , rawKeys + , modMask + , mouseBindings + ) where + +import qualified Data.Map as M +import System.Exit +import XMonad hiding ( keys + , modMask + , mouseBindings + ) +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.MessageFeedback +import XMonad.Actions.Navigation2D +import XMonad.Actions.Promote +import XMonad.Actions.UpdatePointer +import XMonad.Actions.WithAll +import XMonad.Custom.Layout +import qualified XMonad.Custom.Misc as C +import XMonad.Custom.Scratchpads +import XMonad.Custom.Theme +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.Shell +import XMonad.Prompt.Window +import XMonad.Prompt.Workspace +import qualified XMonad.StackSet as S +import XMonad.Util.EZConfig +import XMonad.Util.NamedScratchpad +import XMonad.Util.WorkspaceCompare + +modMask :: KeyMask +modMask = mod4Mask + +directions :: [Direction2D] +directions = [D, U, L, R] + +arrowKeys, directionKeys, wsKeys :: [String] +arrowKeys = ["", "", "", ""] +directionKeys = ["j", "k", "h", "l"] +wsKeys = map show [1 .. 9 :: Int] + +zipKeys :: [a] -> [[a]] -> [t1] -> (t1 -> b) -> [([a], b)] +zipKeys m ks as f = zipWith (\k d -> (m ++ k, f d)) ks as + +zipKeys' :: [a] -> [[a]] -> [t1] -> (t1 -> t2 -> b) -> t2 -> [([a], b)] +zipKeys' m ks as f b = zipWith (\k d -> (m ++ k, f d b)) ks as + +tryMessageR_ :: (Message a, Message b) => a -> b -> X () +tryMessageR_ x y = sequence_ [tryMessageWithNoRefreshToCurrent x y, refresh] + +toggleCopyToAll :: X () +toggleCopyToAll = wsContainingCopies >>= \case + [] -> 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 + ) + +withUpdatePointer :: [(String, X ())] -> [(String, X ())] +withUpdatePointer = map addAction + where + addAction :: (String, X ()) -> (String, X ()) + addAction (key, action) = (key, action >> updatePointer (0.98, 0.01) (0, 0)) + +keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) +keys c = mkKeymap c (rawKeys c) + +rawKeys :: XConfig Layout -> [(String, X ())] +rawKeys c = withUpdatePointer $ concatMap ($ c) keymaps + where + keymaps = + [ keysBase + , keysSystem + , keysMedia + , keysWorkspaces + , keysSpawnables + , keysWindows + , keysLayout + , keysResize + ] + +keysBase :: XConfig Layout -> [(String, X ())] +keysBase _ = + [ ("M-S-q", confirmPrompt hotPromptTheme "Quit XMonad?" $ io exitSuccess) + , ("M-q" , spawn "xmonad --restart") + , -- TODO Replace with interal calls + ("M-C-q", spawn "xmonad --recompile && xmonad --restart") + , ("M-x" , shellPrompt promptTheme) + , ("M-w" , windowPrompt promptTheme Goto allWindows) + , ("M-S-w", windowPrompt promptTheme Bring allWindows) + ] + +keysSystem :: XConfig Layout -> [(String, X ())] +keysSystem _ = + [ ("M-C-g" , return ()) + , -- TODO Replace scripts with internal functions + ("", spawn "~/.xmonad/scripts/screenlock.sh") + , ("M-", spawn "~/.xmonad/scripts/xshot-upload.sh") + , ("M-S-", spawn "~/.xmonad/scripts/xshot-select-upload.sh") + , ("M-C-c", spawn "~/.xmonad/scripts/toggle-compton.sh") + , ("M-C-r", spawn "~/.xmonad/scripts/toggle-redshift.sh") + , ("M-C-p", spawn "~/.xmonad/scripts/toggle-touchpad.sh") + , ("M-C-t", spawn "~/.xmonad/scripts/toggle-trackpoint.sh") + ] + +keysMedia :: XConfig Layout -> [(String, X ())] -- TODO Make audio keys compatible with ALSA/PA at the same time +keysMedia _ = + [ ("", spawn "pactl set-source-mute 1 toggle") + , ("" , spawn "pactl set-sink-mute 0 toggle") + , ( "" + , spawn "pactl set-sink-mute 0 false && pactl set-sink-volume 0 -10%" + ) + , ( "" + , spawn "pactl set-sink-mute 0 false && pactl set-sink-volume 0 +10%" + ) + , ("", spawn "mpc toggle") + , ("", spawn "mpc stop") + , ("", spawn "mpc prev") + , ("", spawn "mpc next") + ] + +keysWorkspaces :: XConfig Layout -> [(String, X ())] +keysWorkspaces _ = + [ ("M-S-o", switchProjectPrompt promptTheme) + , ("M-S-p", shiftToProjectPrompt promptTheme) + , ("M-," , nextNonEmptyWS) + , ("M-." , prevNonEmptyWS) + , ("M-i" , toggleWS' ["NSP"]) + , ("M-n", workspacePrompt promptTheme $ windows . S.shift) + ] + ++ zipKeys "M-" wsKeys [0 ..] (withNthWorkspace S.greedyView) + ++ zipKeys "M-S-" wsKeys [0 ..] (withNthWorkspace S.shift) + ++ zipKeys "M-C-S-" wsKeys [0 ..] (withNthWorkspace copy) + +keysSpawnables :: XConfig Layout -> [(String, X ())] +keysSpawnables _ = + [ ("M-", spawn (C.term C.applications)) + , ("M-b" , spawn (C.browser C.applications)) + , ("M-c" , namedScratchpadAction scratchpads "console") + , ("M-m" , namedScratchpadAction scratchpads "music") + , ("M-t" , namedScratchpadAction scratchpads "top") + , ("M-v" , namedScratchpadAction scratchpads "volume") + ] + +keysWindows :: XConfig Layout -> [(String, X ())] +keysWindows _ = + [ ("M-d" , kill) + , ("M-S-d", confirmPrompt hotPromptTheme "Kill all" killAll) + , ("M-a" , toggleCopyToAll) + , ("M-e" , withFocused hideWindow) + , ("M-S-e", popOldestHiddenWindow) + , ("M-p" , promote) + , ("M-g", withFocused $ sendMessage . MergeAll) + , ("M-S-g", withFocused $ sendMessage . UnMerge) + , ("M-u" , focusUrgent) + , ("M-s" , windows S.focusMaster) + , ("M-S-'", windows S.swapDown) + , ("M-S-;", windows S.swapUp) + ] + ++ zipKeys' "M-" directionKeys directions windowGo True -- TODO W moving + ++ zipKeys' "M-S-" directionKeys directions windowSwap True + ++ zipKeys "M-C-" directionKeys directions (sendMessage . pullGroup) + ++ zipKeys' "M-" arrowKeys directions screenGo True + ++ zipKeys' "M-S-" arrowKeys directions windowToScreen True + ++ zipKeys' "M-C-" arrowKeys directions screenSwap True + +keysLayout :: XConfig Layout -> [(String, X ())] +keysLayout c = + [ ("M-" , sendMessage NextLayout) + , ("M-C-", toSubl NextLayout) + , ("M-S-", setLayout $ XMonad.layoutHook c) + , ("M-o" , withFocused toggleFloat) + , ("M-S-o" , sinkAll) + , ("M-S-," , sendMessage $ IncMasterN (-1)) + , ("M-S-." , sendMessage $ IncMasterN 1) + , ("M-r" , tryMessageR_ Rotate (Toggle REFLECTX)) + , ("M-S-r" , sendMessage $ Toggle REFLECTX) + , ( "M-f" + , sequence_ [withFocused $ windows . S.sink, sendMessage $ Toggle NBFULL] + ) + , ("M-C-g", sendMessage $ Toggle GAPS) -- FIXME Breaks merged tabbed layout + ] + +keysResize :: XConfig Layout -> [(String, X ())] +keysResize _ = + [ ("M-[" , tryMessageR_ (ExpandTowards L) Shrink) + , ("M-]" , tryMessageR_ (ExpandTowards R) Expand) + , ("M-S-[" , tryMessageR_ (ExpandTowards U) MirrorShrink) + , ("M-S-]" , tryMessageR_ (ExpandTowards D) MirrorExpand) + , ("M-C-[" , tryMessageR_ (ShrinkFrom R) Shrink) + , ("M-C-]" , tryMessageR_ (ShrinkFrom L) Expand) + , ("M-S-C-[", tryMessageR_ (ShrinkFrom D) MirrorShrink) + , ("M-S-C-]", tryMessageR_ (ShrinkFrom U) MirrorExpand) + ] + +mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) +mouseBindings XConfig{} = M.fromList + [ ( (modMask, button1) + , \w -> + focus w + >> F.mouseWindow F.position w + >> ifClick (snapMagicMove (Just 50) (Just 50) w) + >> windows S.shiftMaster + ) + , ( (modMask, button3) + , \w -> + focus w + >> F.mouseWindow F.linear w + >> ifClick (snapMagicResize [L, R, U, D] (Just 50) (Just 50) w) + >> windows S.shiftMaster + ) + ] diff --git a/src/lib/XMonad/Custom/Event.hs b/src/lib/XMonad/Custom/Event.hs new file mode 100644 index 0000000..9ff2552 --- /dev/null +++ b/src/lib/XMonad/Custom/Event.hs @@ -0,0 +1,24 @@ +-- | +-- Module : XMonad.Custom.Event +-- Description : Event hooks and stuff +-- Copyright : (c) Azat Bahawi 2018-2021 +-- SPDX-License-Identifier : GPL-3.0-or-later +-- Maintainer : azahi@teknik.io +-- Stability : experimental +-- Portability : non-portable +-- + +module XMonad.Custom.Event + ( handleEventHook + ) where + +import Data.Monoid +import XMonad hiding ( handleEventHook ) +import XMonad.Custom.Scratchpads +import XMonad.Hooks.EwmhDesktops +import XMonad.Hooks.ManageDocks +import XMonad.Util.Loggers.NamedScratchpad + +handleEventHook :: Event -> X All +handleEventHook = + mconcat [nspTrackHook scratchpads, docksEventHook, fullscreenEventHook] diff --git a/src/lib/XMonad/Custom/Layout.hs b/src/lib/XMonad/Custom/Layout.hs new file mode 100644 index 0000000..8ed7d08 --- /dev/null +++ b/src/lib/XMonad/Custom/Layout.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS_GHC -Wno-missing-signatures #-} + +-- | +-- Module : XMonad.Custom.Layout +-- Description : Layouts and such +-- Copyright : (c) Azat Bahawi 2018-2021 +-- SPDX-License-Identifier : GPL-3.0-or-later +-- Maintainer : azahi@teknik.io +-- Stability : experimental +-- Portability : non-portable +-- + +module XMonad.Custom.Layout + ( layoutHook + , CustomTransformers(..) + ) where + +import XMonad hiding ( layoutHook ) +import XMonad.Custom.Theme +import XMonad.Hooks.ManageDocks +import XMonad.Layout.Accordion +import XMonad.Layout.BinarySpacePartition +import XMonad.Layout.Fullscreen +import XMonad.Layout.Hidden +import XMonad.Layout.LayoutModifier +import XMonad.Layout.MultiToggle +import XMonad.Layout.MultiToggle.Instances +import XMonad.Layout.NoBorders +import XMonad.Layout.Reflect +import XMonad.Layout.Simplest +import XMonad.Layout.Spacing +import XMonad.Layout.SubLayouts +import XMonad.Layout.Tabbed +import XMonad.Layout.WindowNavigation + +applySpacing :: l a -> ModifiedLayout Spacing l a +applySpacing = spacingRaw False (Border 6 6 6 6) True (Border 6 6 6 6) True + +data CustomTransformers = GAPS + deriving (Read, Show, Eq, Typeable) + +instance Transformer CustomTransformers Window where + transform GAPS x k = k (avoidStruts $ applySpacing x) (const x) + +layoutHook = + fullscreenFloat + $ lessBorders OnlyLayoutFloat + $ mkToggle (single NBFULL) + $ avoidStruts + $ applySpacing + $ mkToggle (single GAPS) + $ mkToggle (single REFLECTX) + $ mkToggle (single REFLECTY) + $ windowNavigation + $ addTabs shrinkText tabTheme + $ hiddenWindows + $ subLayout [] (Simplest ||| Accordion) emptyBSP diff --git a/src/lib/XMonad/Custom/Log.hs b/src/lib/XMonad/Custom/Log.hs new file mode 100644 index 0000000..e9d3c1a --- /dev/null +++ b/src/lib/XMonad/Custom/Log.hs @@ -0,0 +1,82 @@ +-- | +-- Module : XMonad.Custom.Log +-- Description : Loggers and statusbar configuration +-- Copyright : (c) Azat Bahawi 2018-2021 +-- SPDX-License-Identifier : GPL-3.0-or-later +-- Maintainer : azahi@teknik.io +-- Stability : experimental +-- Portability : non-portable +-- + +module XMonad.Custom.Log + ( logHook + ) where + +import System.IO +import XMonad hiding ( logHook ) +import XMonad.Actions.CopyWindow +import XMonad.Custom.Theme +import XMonad.Hooks.CurrentWorkspaceOnTop +import XMonad.Hooks.DynamicLog +import XMonad.Hooks.EwmhDesktops +import XMonad.Util.NamedScratchpad +import XMonad.Util.SpawnNamedPipe +import XMonad.Util.WorkspaceCompare + +xmobarFont :: Int -> String -> String +xmobarFont f = wrap (concat [""]) "" + +topBarPP :: PP +topBarPP = def + { ppCurrent = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "=" + , ppVisible = xmobarColor white1 "" . wrap "~" "~" + , ppHidden = xmobarColor white1 "" . wrap "-" "-" + , ppHiddenNoWindows = xmobarColor white1 "" . wrap "_" "_" + , ppUrgent = xmobarColor red2 "" . wrap "!" "!" + , ppSep = " / " + , ppWsSep = " " + , ppTitle = xmobarColor white1 "" . shorten 50 + , ppTitleSanitize = xmobarStrip + , ppLayout = xmobarColor white1 "" + , ppOrder = id + , ppSort = (namedScratchpadFilterOutWorkspace .) <$> getSortByIndex + , ppExtras = [] + } + +botBarPP :: PP +botBarPP = topBarPP { ppCurrent = const "" + , ppVisible = const "" + , ppHidden = const "" + , ppHiddenNoWindows = const "" + , ppUrgent = const "" + , ppTitle = const "" + , ppLayout = const "" + } + +safePrintToPipe :: Maybe Handle -> String -> IO () +safePrintToPipe = maybe (\_ -> return ()) hPutStrLn + +logHook :: X () +logHook = do + currentWorkspaceOnTop + ewmhDesktopsLogHook + t <- getNamedPipe "xmobarTop" + b <- getNamedPipe "xmobarBot" + c <- wsContainingCopies + let copiesCurrent ws + | ws `elem` c + = xmobarColor yellow2 "" . xmobarFont 2 . wrap "*" "=" $ ws + | otherwise + = xmobarColor white2 "" . xmobarFont 2 . wrap "=" "=" $ ws + let copiesHidden ws + | ws `elem` c = xmobarColor yellow1 "" . wrap "*" "-" $ ws + | otherwise = xmobarColor white1 "" . wrap "-" "-" $ ws + let copiesUrgent ws + | ws `elem` c = xmobarColor yellow2 "" . wrap "*" "!" $ ws + | otherwise = xmobarColor white2 "" . wrap "!" "!" $ ws + dynamicLogWithPP $ topBarPP { ppCurrent = copiesCurrent + , ppHidden = copiesHidden + , ppUrgent = copiesUrgent + , ppOutput = safePrintToPipe t + } + dynamicLogWithPP $ botBarPP { ppOutput = safePrintToPipe b } diff --git a/src/lib/XMonad/Custom/Manage.hs b/src/lib/XMonad/Custom/Manage.hs new file mode 100644 index 0000000..dbc560e --- /dev/null +++ b/src/lib/XMonad/Custom/Manage.hs @@ -0,0 +1,54 @@ +-- | +-- Module : XMonad.Custom.Manage +-- Description : Window management hooks and scratchpads +-- Copyright : (c) Azat Bahawi 2018-2021 +-- SPDX-License-Identifier : GPL-3.0-or-later +-- Maintainer : azahi@teknik.io +-- Stability : experimental +-- Portability : non-portable +-- + +module XMonad.Custom.Manage + ( manageHook + ) where + +import XMonad hiding ( manageHook ) +import XMonad.Custom.Scratchpads +import XMonad.Hooks.InsertPosition +import XMonad.Hooks.ManageDocks +import XMonad.Hooks.ManageHelpers +import XMonad.Layout.Fullscreen +import XMonad.Util.NamedScratchpad + +composeActions :: [MaybeManageHook] +composeActions = + [ appName =? "emacs-popup" -?> tileBelowNoFocus + , appName =? "eterm" -?> tileBelow + , className =? "Pinentry" -?> doCenterFloat + , className =? "Steam" <&&> not <$> title =? "Steam" -?> doFloat + , className =? "Xmessage" -?> doCenterFloat + , className =? "Zenity" -?> doCenterFloat + , className =? "explorer.exe" -?> doFullFloat + , className =? "qemu-system-x86" -?> doCenterFloat + , className =? "qemu-system-x86_64" -?> doCenterFloat + , className =? "urxvt" -?> tileBelow + , className =? "xterm" -?> tileBelow + , isDialog -?> doCenterFloat + , isFullscreen -?> doFullFloat + , pure True -?> tileNormal + , stringProperty "WM_WINDOW_ROLE" =? "pop-up" -?> doCenterFloat + , stringProperty "WM_WINDOW_ROLE" =? "GtkFileChooserDialog" -?> doCenterFloat + , transience + ] + where + tileNormal = insertPosition Above Newer + tileBelow = insertPosition Below Newer + tileBelowNoFocus = insertPosition Below Older + +manageHook :: ManageHook +manageHook = mconcat + [ manageDocks + , fullscreenManageHook + , namedScratchpadManageHook scratchpads + , composeOne composeActions + ] diff --git a/src/lib/XMonad/Custom/Misc.hs b/src/lib/XMonad/Custom/Misc.hs new file mode 100644 index 0000000..b9901b4 --- /dev/null +++ b/src/lib/XMonad/Custom/Misc.hs @@ -0,0 +1,36 @@ +{-# OPTIONS_GHC -funbox-strict-fields #-} + +-- | +-- Module : XMonad.Custom.Misc +-- Description : Miscellaneous functions and constants +-- Copyright : (c) Azat Bahawi 2018-2021 +-- SPDX-License-Identifier : GPL-3.0-or-later +-- Maintainer : azahi@teknik.io +-- Stability : experimental +-- Portability : non-portable +-- + +module XMonad.Custom.Misc + ( Applications(..) + , applications + ) where + +data Applications = Applications + { browser :: !String + , mixer :: !String + , notify :: !String + , player :: !String + , term :: !String + , top :: !String + } + deriving (Eq, Show) + + +applications :: Applications +applications = Applications { browser = "qutebrowser" + , mixer = "pulsemixer" + , notify = "notify-send" + , player = "ncmpcpp" + , term = "urxvtc" + , top = "htop" + } diff --git a/src/lib/XMonad/Custom/Navigation.hs b/src/lib/XMonad/Custom/Navigation.hs new file mode 100644 index 0000000..2646db4 --- /dev/null +++ b/src/lib/XMonad/Custom/Navigation.hs @@ -0,0 +1,23 @@ +-- | +-- Module : XMonad.Custom.Navigation +-- Description : Window navigation and layouts +-- Copyright : (c) Azat Bahawi 2018-2021 +-- SPDX-License-Identifier : GPL-3.0-or-later +-- Maintainer : azahi@teknik.io +-- Stability : experimental +-- Portability : non-portable +-- + +module XMonad.Custom.Navigation + ( navigation + ) where + +import XMonad.Actions.Navigation2D + +navigation :: Navigation2DConfig +navigation = def + { defaultTiledNavigation = hybridOf sideNavigation centerNavigation + , floatNavigation = hybridOf lineNavigation centerNavigation + , layoutNavigation = [("Full", centerNavigation)] + , unmappedWindowRect = [("Full", singleWindowRect)] + } diff --git a/src/lib/XMonad/Custom/Projects.hs b/src/lib/XMonad/Custom/Projects.hs new file mode 100644 index 0000000..9fa7a37 --- /dev/null +++ b/src/lib/XMonad/Custom/Projects.hs @@ -0,0 +1,33 @@ +-- | +-- Module : XMonad.Custom.Projects +-- Description : Per-project workspaces +-- Copyright : (c) Azat Bahawi 2018-2021 +-- SPDX-License-Identifier : GPL-3.0-or-later +-- Maintainer : azahi@teknik.io +-- Stability : experimental +-- Portability : non-portable +-- + +module XMonad.Custom.Projects + ( projects + ) where + +import XMonad.Actions.DynamicProjects +import XMonad.Actions.SpawnOn +import qualified XMonad.Custom.Misc as C + +projects :: [Project] +projects = + [ Project { projectName = "Template" + , projectDirectory = "~/" + , projectStartHook = Nothing + } + , Project { projectName = "Emacs" + , projectDirectory = "~/" + , projectStartHook = Just $ spawnOn "Emacs" "emacsclient" + } + , Project { projectName = "WWW" + , projectDirectory = "~/" + , projectStartHook = Just $ spawnOn "WWW" (C.browser C.applications) + } + ] diff --git a/src/lib/XMonad/Custom/Prompt.hs b/src/lib/XMonad/Custom/Prompt.hs new file mode 100644 index 0000000..c54a00f --- /dev/null +++ b/src/lib/XMonad/Custom/Prompt.hs @@ -0,0 +1,28 @@ +-- | +-- Module : XMonad.Custom.Prompt +-- Description : Prompt configuration +-- Copyright : (c) Azat Bahawi 2018-2021 +-- SPDX-License-Identifier : GPL-3.0-or-later +-- Maintainer : azahi@teknik.io +-- Stability : experimental +-- Portability : non-portable +-- + +module XMonad.Custom.Prompt + ( listCompFunc + , aListCompFunc + , predicateFunction + ) where + +import Data.Char +import Data.List ( isInfixOf ) +import XMonad.Prompt + +listCompFunc :: XPConfig -> [String] -> String -> IO [String] +listCompFunc c xs s = return (filter (searchPredicate c s) xs) + +aListCompFunc :: XPConfig -> [(String, a)] -> String -> IO [String] +aListCompFunc c xs = listCompFunc c (map fst xs) + +predicateFunction :: String -> String -> Bool +predicateFunction x y = lc x `isInfixOf` lc y where lc = map toLower diff --git a/src/lib/XMonad/Custom/Scratchpads.hs b/src/lib/XMonad/Custom/Scratchpads.hs new file mode 100644 index 0000000..5570435 --- /dev/null +++ b/src/lib/XMonad/Custom/Scratchpads.hs @@ -0,0 +1,50 @@ +-- | +-- Module : XMonad.Custom.Scratchpads +-- Description : Scratchpads configuration +-- Copyright : (c) Azat Bahawi 2018-2021 +-- SPDX-License-Identifier : GPL-3.0-or-later +-- Maintainer : azahi@teknik.io +-- Stability : experimental +-- Portability : non-portable +-- + +module XMonad.Custom.Scratchpads + ( scratchpads + ) where + +import XMonad.Core +import XMonad.Custom.Misc as C +import XMonad.ManageHook +import qualified XMonad.StackSet as S +import XMonad.Util.NamedScratchpad + +spawnTerminalWith :: String -> String -> String +spawnTerminalWith t c = term applications ++ " -title " ++ t ++ " -e " ++ c + +floatingNSP :: ManageHook +floatingNSP = customFloating $ S.RationalRect x y w h + where + x = (1 - w) / 2 + y = (1 - h) / 2 + w = 1 / 2 + h = 1 / 2.5 + +scratchpads :: [NamedScratchpad] +scratchpads = + [ NS "console" + (spawnTerminalWith "NSPConsole" "~/.xmonad/scripts/nsp-console.sh") + (title =? "NSPConsole") + floatingNSP + , NS "volume" + (spawnTerminalWith "NSPVolume" (C.mixer C.applications)) + (title =? "NSPVolume") + floatingNSP + , NS "music" + (spawnTerminalWith "NSPMusic" (C.player C.applications)) + (title =? "NSPMusic") + floatingNSP + , NS "top" + (spawnTerminalWith "NSPTop" (C.top C.applications)) + (title =? "NSPTop") + floatingNSP + ] diff --git a/src/lib/XMonad/Custom/Startup.hs b/src/lib/XMonad/Custom/Startup.hs new file mode 100644 index 0000000..f2415ea --- /dev/null +++ b/src/lib/XMonad/Custom/Startup.hs @@ -0,0 +1,58 @@ +-- | +-- Module : XMonad.Custom.Startup +-- Description : Startup hooks +-- Copyright : (c) Azat Bahawi 2018-2021 +-- SPDX-License-Identifier : GPL-3.0-or-later +-- Maintainer : azahi@teknik.io +-- Stability : experimental +-- Portability : non-portable +-- + +module XMonad.Custom.Startup + ( startupHook + ) where + +import Control.Monad +import Data.Maybe +import XMonad hiding ( startupHook ) +import XMonad.Hooks.ManageDocks +import XMonad.Hooks.SetWMName +import XMonad.Util.Cursor +import XMonad.Util.SpawnNamedPipe + +atomsToFullscreen :: [String] +atomsToFullscreen = + [ "_NET_ACTIVE_WINDOW" + , "_NET_CLIENT_LIST" + , "_NET_CLIENT_LIST_STACKING" + , "_NET_DESKTOP_NAMES" + , "_NET_WM_DESKTOP" + , "_NET_WM_STATE" + , "_NET_WM_STATE_FULLSCREEN" + , "_NET_WM_STATE_HIDDEN" + , "_NET_WM_STRUT" + ] + +addNETSupported :: Atom -> X () +addNETSupported x = withDisplay $ \d -> do + r <- asks theRoot + n <- getAtom "_NET_SUPPORTED" + a <- getAtom "ATOM" + liftIO $ do + p <- join . maybeToList <$> getWindowProperty32 d n r + when (fromIntegral x `notElem` p) + $ changeProperty32 d r n a propModeAppend [fromIntegral x] + +addEWMHFullscreen :: X () +addEWMHFullscreen = do + s <- mapM getAtom atomsToFullscreen + mapM_ addNETSupported s + +startupHook :: X () +startupHook = do + spawnNamedPipe "xmobar ~/.xmonad/xmobarrc/top.hs" "xmobarTop" + spawnNamedPipe "xmobar ~/.xmonad/xmobarrc/bot.hs" "xmobarBot" + docksStartupHook + addEWMHFullscreen + setDefaultCursor xC_left_ptr + setWMName "xmonad" diff --git a/src/lib/XMonad/Custom/Theme.hs b/src/lib/XMonad/Custom/Theme.hs new file mode 100644 index 0000000..cfcd176 --- /dev/null +++ b/src/lib/XMonad/Custom/Theme.hs @@ -0,0 +1,126 @@ +-- | +-- Module : XMonad.Custom.Theme +-- Description : Theming and styles +-- Copyright : (c) Azat Bahawi 2018-2021 +-- SPDX-License-Identifier : GPL-3.0-or-later +-- Maintainer : azahi@teknik.io +-- Stability : experimental +-- Portability : non-portable +-- + +module XMonad.Custom.Theme + ( font + , black1 + , black2 + , red1 + , red2 + , green1 + , green2 + , yellow1 + , yellow2 + , blue1 + , blue2 + , magenta1 + , magenta2 + , cyan1 + , cyan2 + , white1 + , white2 + , colorN + , colorF + , gapBase + , gapFull + , border + , tabTheme + , promptTheme + , hotPromptTheme + ) where + +import Data.Char +import Data.Function +import Data.List ( isInfixOf ) +import Data.Ratio +import Graphics.X11.Xlib.Types +import XMonad.Layout.Decoration +import qualified XMonad.Prompt as P + +font :: String +font = "xft:tewi:style=Regular:size=8" -- TODO CJKのフォールバックフォントを追加する + +black1, black2 :: String -- TODO get variables from Xresources +(black1, black2) = ("#0b0806", "#2f2b2a") + +-- | Red +red1, red2 :: String +(red1, red2) = ("#844d2c", "#a64848") + +-- | Green +green1, green2 :: String +(green1, green2) = ("#57553a", "#897f5a") + +-- | Yellow +yellow1, yellow2 :: String +(yellow1, yellow2) = ("#a17c38", "#c8b38d") + +-- | Blue +blue1, blue2 :: String +(blue1, blue2) = ("#41434f", "#526274") + +-- | Magenta +magenta1, magenta2 :: String +(magenta1, magenta2) = ("#6b4444", "#755c47") + +-- | Cyan +cyan1, cyan2 :: String +(cyan1, cyan2) = ("#59664c", "#718062") + +-- | White +white1, white2 :: String +(white1, white2) = ("#a19782", "#c1ab83") + +colorN, colorF :: String +colorN = black2 +colorF = white2 + +gapBase, gapFull :: Int +gapBase = 6 +gapFull = gapBase * 2 + +height, border :: Dimension +height = 12 * 2 +border = 1 + +tabTheme :: Theme +tabTheme = def { activeColor = black1 + , inactiveColor = black2 + , urgentColor = red1 + , activeBorderColor = white1 + , inactiveBorderColor = white2 + , urgentBorderColor = red2 + , activeTextColor = white1 + , inactiveTextColor = white2 + , urgentTextColor = red2 + , fontName = font + , decoHeight = height + } + +promptTheme, hotPromptTheme :: P.XPConfig +promptTheme = def + { P.font = font + , P.bgColor = black1 + , P.fgColor = white1 + , P.fgHLight = white2 + , P.bgHLight = black2 + , P.borderColor = white2 + , P.promptBorderWidth = border + , P.position = P.CenteredAt { P.xpCenterY = 3 % 10, P.xpWidth = 9 % 10 } + , P.height = height + , P.maxComplRows = Just 5 + , P.searchPredicate = isInfixOf `on` map toLower + , P.alwaysHighlight = True + } +hotPromptTheme = promptTheme { P.bgColor = black2 + , P.fgColor = white2 + , P.fgHLight = white1 + , P.bgHLight = black1 + } diff --git a/src/lib/XMonad/Custom/Workspaces.hs b/src/lib/XMonad/Custom/Workspaces.hs new file mode 100644 index 0000000..ba2a1e7 --- /dev/null +++ b/src/lib/XMonad/Custom/Workspaces.hs @@ -0,0 +1,18 @@ +-- | +-- Module : XMonad.Custom.Workspaces +-- Description : General workspace configuration +-- Copyright : (c) Azat Bahawi 2018-2021 +-- SPDX-License-Identifier : GPL-3.0-or-later +-- Maintainer : azahi@teknik.io +-- Stability : experimental +-- Portability : non-portable +-- + +module XMonad.Custom.Workspaces + ( workspaces + ) where + +import XMonad.Core hiding ( workspaces ) + +workspaces :: [WorkspaceId] +workspaces = map show [1 .. 9 :: Int] -- cgit 1.4.1