Yeah!! 0.17.0's xmonad.hs

xmonad.hs

------------------------------------------------------------------------------
-- shunsk's xmonad.hs file for 0.17.0
-- https://ok-xmonad.blogspot.com
--
-- xmobarかpolybarの設定ファイルは別途必要
-- https://ok-xmonad.blogspot.com/p/blog-page.html
------------------------------------------------------------------------------

import XMonad
import qualified XMonad.StackSet as W
import System.Exit

import XMonad.Layout.Spacing
import XMonad.Layout.Renamed
import XMonad.Layout.NoBorders

import XMonad.Hooks.ManageDocks
import XMonad.Hooks.StatusBar
import XMonad.Hooks.StatusBar.PP
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.WindowSwallowing

import XMonad.Util.EZConfig
import XMonad.Util.NamedScratchpad
import XMonad.Util.WorkspaceCompare

import XMonad.Actions.Navigation2D
import XMonad.Actions.DynamicProjects
import XMonad.Actions.CycleWS

import XMonad.Prompt

---------------------------------------------------------------
-- MAIN
---------------------------------------------------------------

main = xmonad
     $ dynamicProjects projects
     $ ewmhFullscreen . ewmh
     $ scratchpadTask mySPConf
     $ withNavigation2DConfig myNavi
     $ withSB (mySBConfig "polybar")
     $ docks
     $ def { terminal           = "kitty"
           , modMask            = mod4Mask
           , focusFollowsMouse  = False
           , workspaces         = ["home"]
           , borderWidth　      = 3
           , normalBorderColor  = "#cccccc"
           , focusedBorderColor = "#00bbff"
           , layoutHook         = mylayouthook
           , handleEventHook    = myHandleEventHook
                                  <+> handleEventHook def
           , keys = \c -> mkKeymap c (myKeyMap c)
           }


---------------------------------------------------------------
-- レイアウト
---------------------------------------------------------------
mylayouthook 
  = smartBorders $ avoidStruts (mytall ||| mymirror) ||| myfull
  where 
    mytall 
      = renamed [CutWordsLeft 1] 
      $ spacingRaw True (Border 10 10 10 10) True (Border 5 5 5 5) True 
      $ Tall 1 0.03 0.5
    
    mymirror 
      = Mirror mytall
    
    myfull
      = noBorders 
      $ Full


---------------------------------------------
-- キーバインド関連
---------------------------------------------
myKeyMap :: XConfig Layout -> [(String, X ())]
myKeyMap conf =
  [("M-S-<Return>", spawn $ XMonad.terminal conf)
  ,("M-p", spawn "rofi -show drun")
  ,("M-S-c", kill)
  ,("M-<Space>", sendMessage NextLayout)
  ,("M-n", refresh)
  
  ,("M-j", windows W.focusDown)
  ,("M-k", windows W.focusUp)
  ,("M-m", windows W.focusMaster)
  ,("M-S-j", windows W.swapDown)
  ,("M-S-k", windows W.swapUp)
  ,("M-<Return>", windows W.swapMaster)
  ,("M-h", sendMessage Shrink)
  ,("M-l", sendMessage Expand)
  ,("M-,", sendMessage $ IncMasterN 1)
  ,("M-.", sendMessage $ IncMasterN (-1))

  ,("M-t", withFocused $ windows . W.sink)

  ,("M-S-q", io (exitWith ExitSuccess))
  ,("M-q", spawn myRecompileCmd)
  
  -- スクラッチパッド
  ,("M-o", namedScratchpadAction mySPConf "sp01")
  ,("M-i", namedScratchpadAction mySPConf "sp02")
 
  -- windowのフォーカス移動
  ,("M-<R>", windowGo R False)
  ,("M-<L>", windowGo L False)
  ,("M-<U>", windowGo U False)
  ,("M-<D>", windowGo D False)

  -- workspaceの移動等
  ,("M-C-<R>", nonEmptyWS Next)
  ,("M-C-<L>", nonEmptyWS Prev)
  ,("M-g",   switchProjectPrompt myXPConfig)
  ,("M-S-g", shiftToProjectPrompt myXPConfig)

  ]
    where
      myRecompileCmd =
        "xmonad --recompile && xmonad --restart"


-----------------------------------------------------------------
--
-- WindowSwallowing
--
-- require module
--  XMonad.Hooks.WindowSwallowing
--
-- 基本形の例
-- main = xmonad def { handleEventHook
--                      = myHandleEventHook
--                        <+> handleEventHook def
--                   }
--
-- refer to
--   https://hackage.haskell.org/package/xmonad-contrib-0.17.0/docs/XMonad-Hooks-WindowSwallowing.html
--   https://ok-xmonad.blogspot.com/2021/11/xmonad0170.html
-----------------------------------------------------------------}

myHandleEventHook 
  = swallowEventHook (className =? "kitty" 
                 <||> className =? "Alacritty"
                 <||> className =? "XTerm") (return True)


-----------------------------------------------------------------
--
-- ステータスバーの設定
--
-- xmonad-contrib 0.17.0で刷新されたX.H.StatusBarを利用して
-- xmobarとpolybarを簡単に使えるようにする設定
--
-- require module
--   XMonad.Hooks.StatusBar
--   XMonad.Hooks.StatusBar.PP
--   XMonad.Hooks.ManageDocks
--
--
-- ++++++++++++++++++++++++++++++++++++++
--  基本例
-- ++++++++++++++++++++++++++++++++++++++
--
-- main = xmonad 
--        $ withSB (mySBConfig "xmobar")
--        $ docks 
--        $ def
--
-- これに加えてlayoutに適宜avoidStrutsを加える必要あり
--
-- withSB関数に用意したStatusBarConfigを渡した関数で、
-- XConfig l型の設定データを受け取るのが基本。
-- ステータスバー用に加工されたXConfig l型データを返します。
--
-- ここで自作のmySBConfig関数は、
-- "xmobar"か"polybar"の値を渡すとそれぞれに相応しい設定を行う
-- StatusBarConfigデータを返してくれます。
--
--
-- ++++++++++++++++++++++++++++++++++++++
--  polybar利用の場合
-- ++++++++++++++++++++++++++++++++++++++
--
-- 自分のpolybar起動のコマンドをmySBConfigの定義で
-- myPolybarConfの引数を自分の環境に合わせて必ず書き換える必要あり。
-- この文字列でspawnされます。
--
-- また、polybar側の設定としては、
-- https://github.com/xmonad/xmonad-contrib
-- でリポジトリを確認し、
-- script/xmonadpropread.hsにあるファイルを
-- 自分のローカルディレクトリの適当なところにコピーして
-- 実行権限を与えます。
--
-- https://ok-xmonad.blogspot.com/2021/02/polybarxmonad.html
-- ここで紹介している[module/xmonad]の項目で
-- 「xmonad-log」を使っていますが、
-- この部分をxmonadpropread.hsにします。
-- パスの通っているとこにおいてもうまく行かない場合
-- フルパスで記述してみましょう。
--
-- 例）
-- [module/xmonad]
-- type = custom/script
-- exec = /somewhere/path/xmonadpropread.hs
-- tail = true
--
--
-- ++++++++++++++++++++++++++++++++++++++
--  mydefLogPPについて
-- ++++++++++++++++++++++++++++++++++++++
--
-- ステータスバーに何を表示して何を表示しないかの
-- 共通デフォルト値を設定している。
--
-- 基本、非表示でなく、ウィンドウを一つ以上持っているワークスペースを表示
-- 但し、NSP（スクラッチパッド退避ワークスペース名）は常に表示しない
-- 更に、homeという名前のワークスペースは、常に表示する
--
-- カスタム例としては
-- stickmyfavorit関数のパターンマッチで
-- 常に表示するものを追加する。
--
-- 例)
-- stickmyfavorit "home" = "home"
-- stickmyfavorit "1"    = "1"
-- stickmyfavorit "2"    = "2"
-- stickmyfavorit "3"    = "3"
-- stickmyfavorit _      = ""
--
--
-- ++++++++++++++++++++++++++++++++++++++
--  xmobar用
-- ++++++++++++++++++++++++++++++++++++++
--
-- statusBarProp関数でStatusBarConfig値を作成している。
-- カスタムする場合、第2引数でpure関数に渡す引数PP型を書き換える。
--
-- ここでは、先に紹介したmydefLogPPを元に書き換えを行っているが、
-- 好き勝手やりたい場合、def::PPから自分の好きなようにすればOK
--
-- X.H.StatusBar.PPモジュールでは、
-- xmobar用のエスケープに対応した、関数がたくさん追加されてる。
-- refer to
--   https://hackage.haskell.org/package/xmonad-contrib-0.17.0/docs/XMonad-Hooks-StatusBar-PP.html#v:xmobarColor
--
--
-- ++++++++++++++++++++++++++++++++++++++
--  polybar用
-- ++++++++++++++++++++++++++++++++++++++
--
-- 先に述べたとおり起動コマンドの設定は必須
--
-- statusBarProp関数の作成する、StatusBarConfigデータには、
-- 起動時のPID等を管理して、先起動等の手助けをする機能があるが
-- polybarの場合、
-- カスタムスクリプト等どのようになんのコマンドで起動されるか
-- わからないので、単なるアクションを使って
-- 起動コマンドは明示的に入力してそのとおり起動し、
-- 終了時は「killall polybar」によって、全部終了するようにしてある。
--
-- このあたりの改良を目論む場合は以下を参照
-- https://hackage.haskell.org/package/xmonad-contrib-0.17.0/docs/XMonad-Hooks-StatusBar.html#g:6
--
--カスタムについては、
--polybarPPdefのあたりをdef::PP等から書き換える。
--
--ラッパー関数に関しては、
--polybarColor関数を自作してあるので活用。
--
--polybar上でのエスケープシーケンスについては
--https://github.com/polybar/polybar/wiki/Formatting
--
-------------------------------------------------------------------

-- myPolybarConf の引数を必ず自分の環境にあわせて書き換え
mySBConfig "xmobar"  = myXmobarConf
mySBConfig "polybar" = myPolybarConf 
                         "/home/neko/.config/polybar/blocks/launch.sh"


mydefLogPP
  = filterOutWsPP 
      [scratchpadWorkspaceTag] 
      def {ppHiddenNoWindows = stickmyfavorit}

stickmyfavorit "home" = "home"
stickmyfavorit _      = ""


-- xmobar用
myXmobarConf
  = statusBarProp
      "xmobar"
      (pure $ mydefLogPP
                { ppCurrent 
                    = xmobarColor "#FF9F1C" "#1A1B41" . wrap "[" "]"
      
                , ppTitle 
                    = xmobarColor "#6290C3" "#F1FFE7" . pad . shorten 30 
                }
      )


-- polybar用
myPolybarConf cmd
  = def { sbLogHook 
            = xmonadPropLog 
                =<< dynamicLogString polybarPPdef
        , sbStartupHook = spawn cmd
        , sbCleanupHook = spawn "killall polybar"
        }

polybarPPdef 
  = mydefLogPP { ppCurrent 
                   = polybarColor "#FF9F1C" "#1A1B41" . wrap "[" "]"
      
               , ppTitle = const ""
               }

polybarColor :: String -> String -> String -> String
polybarColor fore_color back_color contents
  = wrap ("%{B" <> back_color <> "} ") " %{B-}" 
  . wrap ("%{F" <> fore_color <> "} ") " %{F-}" 
  $ contents 


-----------------------------------------------------------------
--
-- ワークスペース移動のカスタム関数
--
-- 非表示でウィンドウを持たないワークスペースをスキップする。
-- スクラッチパッドを使う場合に作られるNSPワークスペースをスキップする。
-- ただし、homeという名のワークスペースはどの状態にあってもスキップしない。
--
-- require module
--   XMonad.Actions.CycleWS
--   XMonad.Util.WorkspaceCompare
--   XMonad.Util.NamedScratchpad
--
--「nonEmptyWS d」アクションをキーにバインドする。
-- dはNextかPrev
--
-- 例)
--  ,("M-C-<R>", nonEmptyWS Next)
--  ,("M-C-<L>", nonEmptyWS Prev)
--
-- カスタム例
-- isFavorit関数に、いつでも表示したいワークスペース名を渡して
-- いつでも表示するワークスペース値を作成し
-- これを、findWorkspace関数の第3引数WSTypeの部分に組み込む
--
-- refer to
--   https://hackage.haskell.org/package/xmonad-contrib-0.17.0/docs/XMonad-Actions-CycleWS.html
--
-------------------------------------------------------------------

nonEmptyWS d 
  = findWorkspace 
      getSortByIndexNoSP 
      d 
      (hiddenWS :&:Not emptyWS :|: isFavorit "home")
      1
  >>= \t -> (windows . W.view $ t)

-- NSP(スクラッチパッド退避ワークスペース)をスキップ
getSortByIndexNoSP =
        fmap (.filterOutWs [scratchpadWorkspaceTag]) getSortByIndex

-- いつでも表示したいワークスペース名を判別する関数
-- これを使っていつでも訪れたいワークスペースに利用する
isFavorit s =
  WSIs $ return (((==) s) . W.tag)


---------------------------------------------------------------
--
--  カーソルでのフォーカス移動
--
--  required module
--   XMonad.Actions.Navigation2D
--
-- 基本形
--  main = xmonad
--       $ withNavigation2DConfig myNavi
--       $ def
--
--  キーバインドは以下の通り
--  ,("M-<R>", windowGo R False)
--  ,("M-<L>", windowGo L False)
--  ,("M-<U>", windowGo U False)
--  ,("M-<D>", windowGo D False)
--
-- refer to
--   https://hackage.haskell.org/package/xmonad-contrib-0.17.0/docs/XMonad-Actions-Navigation2D.html
--   https://ok-xmonad.blogspot.com/2021/03/xmonad_10.html
--
---------------------------------------------------------------

myNavi = def {
  defaultTiledNavigation = sideNavigation
}



---------------------------------------------------------------
--
-- scratchpad用の設定
--
-- required module
--   XMonad.Util.NamedScratchpad
--
-- 自作のscratchpadTask関数を使った基本形の例
-- main = xmonad
--      $ scratchpadTask mySPConf
--      $ def 
--
-- NS型のリストであるmySPConfで自分好みのスクラッチパッドを定義
--
-- refer to
--   https://hackage.haskell.org/package/xmonad-contrib-0.17.0/docs/XMonad-Util-NamedScratchpad.html
--   https://ok-xmonad.blogspot.com/2021/03/xmonad.html
--
----------------------------------------------------------------

scratchpadTask spdata conf
  = conf {manageHook 
            = namedScratchpadManageHook spdata
            <+> manageHook conf
         }

mySPConf =
  [ NS "sp01"
       "kitty -T SCPad" 
       (title =? "SCPad")
       (customFloating $ W.RationalRect 0.5 0.05 0.48 0.5) 
  , NS "sp02"
       "kitty -T ranger ranger" 
       (title =? "ranger") 
       (customFloating $ W.RationalRect 0.05 0.1 0.9 0.8) 
  ]

---------------------------------------------------------------
--
-- DynamicProject 用のデータ
--
-- required module
--   XMonad.Actions.DynamicProjects
--
-- 基本形の例
-- main = xmonad
--      $ dynamicProjects projects
--      $ def 
--
-- Project型のリストであるprojectsで自分好みのプロジェクトを定義
--
-- refer to
--   https://hackage.haskell.org/package/xmonad-contrib-0.17.0/docs/XMonad-Actions-DynamicProjects.html
--   https://ok-xmonad.blogspot.com/2021/03/xmonad_3.html
--
----------------------------------------------------------------

projects :: [Project]
projects =
  [ Project   "home"    "~/"          Nothing
  , Project   "misc"    "~/"          Nothing
  , Project   "config"  "~/.config"   Nothing
  , Project   "code"    "~/Workspace" (Just $ spawn "kitty ranger")
  , Project   "web"     "~/"          (Just $ spawn my_browser)
  , Project   "rstudio" "~/"          (Just $ spawn "rstudio-bin")
  , Project   "slack"   "~/"          (Just $ spawn "slack")
  
  -- Archlinux page for application list 
  , Project   
      "applist" 
      "~/"
      (Just $ spawn $ my_browser ++ url_applist ++ " --new-window")
  
  -- twitterdeck
  , Project   
      "twitter" 
      "~/"
      (Just $ spawn $ my_browser ++ " --app=" ++ url_twitter ++ " --new-window")
  
  -- for xmonad config
  , Project   
      "xmonad" 
      "~/.xmonad"
      (Just $ do spawn (my_browser ++ "https://xmonad.org/documentation.html --new-window")
                 spawn "kitty nvim xmonad.hs")
  ]
   where 
      my_browser = "google-chrome-stable "
      url_applist = "https://wiki.archlinux.org/index.php/List_of_applications"
      url_twitter = "https://tweetdeck.twitter.com/"


myXPConfig = def
    { font    = "xft:M+1 mn:size=14:medium:antialias=true"
    , position = CenteredAt 0.5 0.8 
    , height   = 40
    }