1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132

{-# HLINT ignore "Use lambda-case" #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

module Main where

import Data.Function ((&))
import GHC.IO.StdHandles (stderr)
import System.Environment qualified
import System.IO (hPutStrLn)
import System.Posix.Process (executeFile)
import XMonad
import XMonad qualified as Xmonad
import XMonad.Hooks.EwmhDesktops (ewmh)
import XMonad.Hooks.ManageHelpers (doCenterFloat)
import XMonad.Layout.MultiToggle
import XMonad.Layout.MultiToggle.Instances (StdTransformers (..))
import XMonad.Layout.SideBorderDecoration (SideBorderConfig (..), sideBorderLayout)
import XMonad.Operations qualified as Xmonad.Operations
import XMonad.StackSet qualified as StackSet
import XMonad.Util.Cursor (setDefaultCursor)
import XMonad.Util.EZConfig (additionalKeys, additionalKeysP, removeKeysP)

data Mode = Normal | Presentation

main :: IO ()
main = do
  let config = ewmh myConfig
  -- get new xmonad binary from first argument
  System.Environment.getArgs >>= \args -> case args of
    [] -> do
      hPutStrLn stderr "No new xmonad binary specified, launching this xmonad"
      directories <- Xmonad.getDirectories
      Xmonad.launch config directories
    (newBinary : newArgs) -> do
      Xmonad.Operations.sendReplace
      hPutStrLn stderr $ "Starting new xmonad binary: " ++ newBinary ++ " with args: " ++ show newArgs
      executeFile newBinary False newArgs Nothing

-- dirs <- Xmonad.getDirectories
-- Xmonad.launch config dirs

myConfig =
  conf
    { modMask = modKey,
      terminal = term Normal,
      focusedBorderColor = "#859900",
      manageHook = className =? "floating" --> doCenterFloat,
      layoutHook = layout,
      startupHook = setDefaultCursor xC_heart,
      workspaces = workspaceNames,
      borderWidth = 0
    }
    `additionalKeysP` ( [
                          -- fullscreen
                          ("M-e", sendMessage $ Toggle NBFULL),
                          -- i3-like keybindings, because I’m spoiled
                          ("M-S-x", kill),
                          -- exchange M-Ret and M-S-Ret
                          ("M-<Return>", spawn $ term Normal),
                          ("C-M-<Return>", spawn $ term Presentation),
                          ("M-S-<Return>", windows StackSet.swapMaster)
                          -- open simple exec dmenu
                        ]
                          ++
                          -- something something workspaces
                          [ (otherModMasks ++ "M-" ++ [key], action tag)
                            | (tag, key) <- zip workspaceNames "123456789",
                              (otherModMasks, action) <-
                                [ ("", windows . StackSet.greedyView),
                                  ("S-", windows . StackSet.shift)
                                ]
                          ]
                          ++
                          -- 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-v", focusToScreen 0),
                            -- , ("M-l", focusToScreen 1)
                            ("M-c", focusToScreen 2),
                            ("M-S-v", windowToScreen 0),
                            ("M-S-l", windowToScreen 1),
                            ("M-S-c", windowToScreen 2)
                          ]
                          -- ((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)]]
                      )
    `additionalKeys`
    -- arrow keys should move as well (hjkl blindness)
    [ ((modKey, xK_Up), windows StackSet.focusUp),
      ((modKey, xK_Down), windows StackSet.focusDown)
    ]
    `removeKeysP` [
                    -- previous kill command
                    "M-S-c",
                    -- It is way to easy to kill everything by default
                    "M-S-q",
                    -- no idea, I want to use it for Mozc
                    "M-n"
                  ]
  where
    conf = def
    workspaceNames = conf & workspaces
    modKey = mod4Mask
    -- TODO: meh
    term :: Mode -> String
    -- TODO: get terminal-emulator from the system config (currently alacritty)
    term Normal = "alacritty"
    term Presentation = "notify-send TODO: currently not terminal presentation mode implemented" -- "terminal- -u ~/.config/lilyterm/pres.conf"
    toScreen with _number = screenWorkspace 0 >>= \ws -> whenJust ws (windows . with)
    focusToScreen = toScreen StackSet.view
    windowToScreen = toScreen StackSet.shift

-- copied from Xmonad.Config
layout =
  sideBorderLayout borderConfig tiled
    & toggleFullscreen
  where
    borderConfig =
      def
        { sbActiveColor = "#bbbbbb",
          sbInactiveColor = "#888888"
        }
    -- default tiling algorithm partitions the screen into two panes
    tiled = Tall nmaster delta ratio
    -- The default number of windows in the master pane
    nmaster = 1
    -- Default proportion of screen occupied by master pane
    ratio = 1 / 2
    -- Percent of screen to increment by when resizing panes
    delta = 3 / 100
    toggleFullscreen = mkToggle1 NBFULL