Initial commit
This commit is contained in:
commit
3b117c4fe0
|
|
@ -0,0 +1 @@
|
|||
dist/
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
# Revision history for xmonad-masser
|
||||
|
||||
## 0.1.0.0 -- YYYY-mm-dd
|
||||
|
||||
* First version. Released on an unsuspecting world.
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
Copyright (c) 2019, Mats Rauhala
|
||||
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above
|
||||
copyright notice, this list of conditions and the following
|
||||
disclaimer in the documentation and/or other materials provided
|
||||
with the distribution.
|
||||
|
||||
* Neither the name of Mats Rauhala nor the names of other
|
||||
contributors may be used to endorse or promote products derived
|
||||
from this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
{ haskellPackages }:
|
||||
|
||||
haskellPackages.callCabal2nix "xmonad-masser" ./. {}
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
{ nixpkgs ? import <nixpkgs> {} }:
|
||||
|
||||
rec {
|
||||
xmonad-masser = nixpkgs.callPackage ./default.nix {};
|
||||
shell = nixpkgs.buildEnv {
|
||||
name = "shell";
|
||||
paths = [];
|
||||
buildInputs = with nixpkgs.haskellPackages; [
|
||||
(ghcWithPackages (_: xmonad-masser.buildInputs ++ xmonad-masser.propagatedBuildInputs))
|
||||
ghcid
|
||||
cabal-install
|
||||
nixpkgs.pkgs.binutils
|
||||
];
|
||||
};
|
||||
}
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
{ nixpkgs ? import <nixpkgs> {} }:
|
||||
|
||||
(nixpkgs.callPackage ./release.nix {}).shell
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
{-# Language RecordWildCards #-}
|
||||
{-# Language DeriveGeneric #-}
|
||||
{-# Language OverloadedStrings #-}
|
||||
module Config where
|
||||
|
||||
import Dhall
|
||||
|
||||
data Applications = Applications { urxvt :: Text
|
||||
, prompt :: Text
|
||||
, browser :: Text
|
||||
, launcher :: Text -- xdg-open
|
||||
, screenshot :: Text
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
data TopicRule = TopicRule { topicName :: Text
|
||||
, topicHome :: Maybe Text
|
||||
, topicAction :: Maybe Text }
|
||||
deriving (Show, Generic)
|
||||
data ExtraConfig = ExtraConfig { applications :: Applications
|
||||
, topics :: [TopicRule]}
|
||||
deriving (Show, Generic)
|
||||
|
||||
defaultExtraConfig :: ExtraConfig
|
||||
defaultExtraConfig =
|
||||
let applications = Applications{..}
|
||||
urxvt = "urxvt"
|
||||
prompt = "xmobar"
|
||||
browser = "qutebrowser"
|
||||
launcher = "xdg-open"
|
||||
screenshot = "scrot ~/screenSel.png"
|
||||
topics = []
|
||||
in ExtraConfig{..}
|
||||
|
||||
instance Interpret ExtraConfig
|
||||
instance Interpret TopicRule
|
||||
instance Interpret Applications
|
||||
|
|
@ -0,0 +1,265 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module XMonad.Config.MasseR where
|
||||
|
||||
|
||||
import XMonad.Password
|
||||
import XMonad.CustomPrompt
|
||||
import XMonad.TopicSpace
|
||||
import qualified Data.List as List
|
||||
import XMonad
|
||||
import XMonad.Actions.CycleWS (swapNextScreen)
|
||||
import XMonad.Actions.Search
|
||||
import XMonad.Hooks.EwmhDesktops (ewmh, ewmhDesktopsStartup)
|
||||
import XMonad.Hooks.SetWMName (setWMName)
|
||||
import XMonad.Hooks.UrgencyHook (args, dzenUrgencyHook,
|
||||
withUrgencyHook)
|
||||
import XMonad.Layout.Accordion
|
||||
import XMonad.Layout.BinarySpacePartition (emptyBSP)
|
||||
import XMonad.Layout.Decoration (Decoration,
|
||||
DefaultShrinker)
|
||||
import XMonad.Layout.DwmStyle
|
||||
import XMonad.Layout.HintedGrid
|
||||
import XMonad.Layout.LayoutModifier (ModifiedLayout)
|
||||
import XMonad.Layout.Master
|
||||
import XMonad.Layout.NoBorders (smartBorders)
|
||||
import XMonad.Layout.PerWorkspace (onWorkspace)
|
||||
import XMonad.Layout.Renamed
|
||||
import XMonad.Layout.Simplest (Simplest)
|
||||
import XMonad.Layout.Spiral
|
||||
import XMonad.Layout.Tabbed (TabbedDecoration,
|
||||
Theme (..), shrinkText,
|
||||
tabbed)
|
||||
import XMonad.Layout.ToggleLayouts (ToggleLayout (..))
|
||||
import XMonad.Prompt.RunOrRaise (runOrRaisePrompt)
|
||||
import qualified XMonad.StackSet as W
|
||||
import XMonad.Util.EZConfig
|
||||
|
||||
import XMonad.XMobar (zenburnPP)
|
||||
|
||||
import Data.Monoid (Endo, (<>))
|
||||
|
||||
import XMonad.Util.NamedScratchpad
|
||||
import XMonad.Util.SpawnOnce
|
||||
|
||||
import System.IO (hClose, hPutStr)
|
||||
import XMonad.Actions.Navigation2D
|
||||
import XMonad.Util.NamedActions
|
||||
import XMonad.Util.Run (spawnPipe)
|
||||
|
||||
import XMonad.Config.MasseR.ExtraConfig
|
||||
-- import Customizations
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
import XMonad.Hooks.DynamicLog (statusBar)
|
||||
|
||||
import qualified Data.Set as S
|
||||
|
||||
spotify :: XConfig l -> NamedAction
|
||||
spotify conf = submapName . mkNamedKeymap conf $
|
||||
[ ("M-p", addName "Play" $ spawn "sp play") ]
|
||||
|
||||
scratchpads :: [NamedScratchpad]
|
||||
scratchpads = [
|
||||
NS "notes" "vim -g --role notes -c 'e ~/wikidata/index.md'" (wmRole =? "notes") nonFloating
|
||||
]
|
||||
where wmRole = stringProperty "WM_WINDOW_ROLE"
|
||||
|
||||
scratchSubmaps :: XConfig l -> NamedAction
|
||||
scratchSubmaps conf = submapName . mkNamedKeymap conf $ [
|
||||
("M-n", addName "Open notes" $ namedScratchpadAction scratchpads "notes")
|
||||
]
|
||||
|
||||
-- Search engines inside submaps
|
||||
searchSubmaps :: XConfig l -> NamedAction
|
||||
searchSubmaps conf =
|
||||
let mkBrowser = promptSearchBrowser def "qutebrowser"
|
||||
_googleP = addName "Search google" $ mkBrowser google
|
||||
ddgP = addName "Search duckduckgo" $ mkBrowser (searchEngine "duckduckgo" "http://duckduckgo.com/?q=")
|
||||
in submapName . mkNamedKeymap conf $
|
||||
[ ("d", ddgP) -- Training to use ddg again
|
||||
, ("g", ddgP) -- training to use ddg again
|
||||
]
|
||||
|
||||
myNav2d :: Navigation2DConfig
|
||||
myNav2d = def { defaultTiledNavigation = lineNavigation }
|
||||
|
||||
showKeybindings :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
|
||||
showKeybindings x = addName "Show keybindings" $ io $ do
|
||||
h <- spawnPipe "zenity --text-info --font=terminus"
|
||||
hPutStr h (unlines $ showKm x)
|
||||
hClose h
|
||||
|
||||
|
||||
-- Layout
|
||||
myTabConfig :: Theme
|
||||
myTabConfig = def {
|
||||
activeBorderColor = "#DCDCCC"
|
||||
, activeTextColor = "#DCDCCC"
|
||||
, activeColor = "#3F3F3F"
|
||||
, fontName = "xft:Inconsolata-9"
|
||||
, inactiveBorderColor = "#262626"
|
||||
, inactiveTextColor = "#9FAFAF"
|
||||
, inactiveColor = "#262626"
|
||||
}
|
||||
|
||||
|
||||
(=~?) :: XMonad.Query String -> String -> XMonad.Query Bool
|
||||
q =~? x = fmap (x `List.isInfixOf`) q
|
||||
|
||||
-- Manage hooks
|
||||
-- Move programs to their workspaces
|
||||
myManageHook :: XMonad.Query (Endo WindowSet)
|
||||
myManageHook = composeAll $ concat [
|
||||
dynamicsHook
|
||||
, webHooks
|
||||
, pdfHooks
|
||||
, documentHooks
|
||||
, floatHooks
|
||||
, debuggerHooks
|
||||
, ideHooks
|
||||
, flowHook
|
||||
]
|
||||
where
|
||||
classHook y = map (\x -> className =? x --> y)
|
||||
ideHooks = classHook (doShift "eclipse") [
|
||||
"Anypoint Studio"
|
||||
]
|
||||
webHooks = classHook (doShift "web") [
|
||||
"Firefox"
|
||||
, "qutebrowser"
|
||||
, "Midori"
|
||||
, "chromium-browser"
|
||||
, "Uzbl-tabbed"
|
||||
, "Uzbl-core"
|
||||
]
|
||||
pdfHooks = classHook (doShift "pdf") [
|
||||
"Evince"
|
||||
, "Okular"
|
||||
, "Kpdf"
|
||||
, "Xdvi"
|
||||
, ".zathura-wrapped_"
|
||||
]
|
||||
documentHooks = classHook (doShift "documents") [
|
||||
"libreoffice"
|
||||
, "libreoffice-calc"
|
||||
, "Assistant"
|
||||
, "Bouml"
|
||||
]
|
||||
floatHooks = classHook doFloat [
|
||||
"SMplayer"
|
||||
, "Gimp"
|
||||
, "MPlayer"
|
||||
, "Kaffeine"
|
||||
, "Xmessage"
|
||||
, "Wfica_Seamless"
|
||||
, "mpv"
|
||||
]
|
||||
debuggerHooks = classHook (doShift "debugger") [
|
||||
"JSwat Debugger",
|
||||
"DBeaver"
|
||||
]
|
||||
dynamicsHook = [title =~? "Dynamics" --> doShift "dynamics"]
|
||||
flowHook = [title =~? "www.flowdock.com" --> doShift "flowdock"]
|
||||
|
||||
myKeys :: ExtraConfig -> XConfig l -> [((KeyMask, KeySym), NamedAction)]
|
||||
myKeys extraConfig conf =
|
||||
let subKeys str ks = subtitle str : mkNamedKeymap conf ks in
|
||||
subKeys "Actions" [ ("M-S-r", addName "foo" $ spawn "xmonad --restart")
|
||||
, ("M-C-l", addName "Lock screen" $ spawn locker)] ^++^
|
||||
subKeys "System" [ ("<XF86Sleep>", addName "Suspend machine" $ spawn "sudo pm-suspend")
|
||||
, ("<XF86AudioRaiseVolume>", addName "Increase volume" $ spawn "amixer set Master 2%+")
|
||||
, ("<XF86AudioLowerVolume>", addName "Decrease volume" $ spawn "amixer set Master 2%-")
|
||||
, ("M-<plus>", addName "Increase volume" $ spawn "amixer set Master 2+")
|
||||
, ("M-<minus>", addName "Decrease volume" $ spawn "amixer set Master 2-")
|
||||
-- , ("<XF86AudioPlay>", addName "Play/pause spotify" $ spawn "/home/masse/.local/bin/sp play")
|
||||
, ("<XF86AudioPlay>", addName "Play/pause mopidy" $ spawn "mpc toggle")
|
||||
, ("M-m", spotify conf)
|
||||
, ("M-S-<Space>", addName "Swap screens" swapNextScreen)
|
||||
, ("M-<Backspace>", addName "Kill window" kill)
|
||||
-- scrot requires `unGrab`
|
||||
, ("M-<Print>", addName "Take screenshot" $ spawn (screenshot . applications $ extraConfig))] ^++^
|
||||
subKeys "Launchers" [ ("M-S-y", addName "Open youtube" $ spawn "mpv $(clip -o)")
|
||||
, ("M-S-<Return>", addName "Open terminal" $ spawn $ XMonad.terminal conf)
|
||||
, ("M-n", scratchSubmaps conf)
|
||||
, ("M-s", searchSubmaps conf)
|
||||
, ("M-p", addName "Retrieve password" $ passPrompt def)
|
||||
, ("M-S-e", addName "Open with app" xdg_open)
|
||||
, ("M-e", addName "Run app" $ runOrRaisePrompt def)] ^++^
|
||||
subKeys "Windows" [ ("M-j", addName "Go down" $ windowGo D False)
|
||||
, ("M-k", addName "Go up" $ windowGo U False)
|
||||
, ("M-h", addName "Go left" $ windowGo L False)
|
||||
, ("M-l", addName "Go right" $ windowGo R False)
|
||||
, ("M-S-j", addName "Shift window down" $ windowSwap D False)
|
||||
, ("M-S-k", addName "Shift window up" $ windowSwap U False)
|
||||
, ("M-S-h", addName "Shift window left" $ windowSwap L False)
|
||||
, ("M-S-l", addName "Shift window right" $ windowSwap R False)
|
||||
, ("M-.", addName "Go to previous window" $ windows W.focusDown)
|
||||
, ("M-,", addName "Go to next window" $ windows W.focusUp)
|
||||
, ("M-S-m", addName "Swap master" $ windows W.swapMaster)
|
||||
] ^++^
|
||||
subKeys "Projects & Workspaces" (topicKeys' extraConfig conf) ^++^
|
||||
subKeys "Layout management" [ ("M-C-<Space>", addName "Toggle layout" $ sendMessage ToggleLayout)
|
||||
, ("M-<Space>", addName "Next layout" $ sendMessage NextLayout)] ^++^
|
||||
subKeys "Resize" []
|
||||
where
|
||||
locker = "sh ~/scripts/lock.sh"
|
||||
|
||||
|
||||
|
||||
myStartupHook :: X ()
|
||||
myStartupHook = spawnOnce "$HOME/wminit"
|
||||
|
||||
masser :: ExtraConfig -> IO ()
|
||||
masser extraConfig = xmonad =<< statusBar (bar extraConfig) zenburnPP toggleStrutsKey myConfig
|
||||
where
|
||||
toggleStrutsKey XConfig{modMask=modm} = (modm, xK_b)
|
||||
bar = prompt . applications
|
||||
myConfig = withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"]} $
|
||||
withNavigation2DConfig myNav2d $
|
||||
ewmh $
|
||||
addDescrKeys' ((mod4Mask, xK_F1), showKeybindings) (myKeys extraConfig) $
|
||||
def {
|
||||
modMask = mod4Mask -- Hyper
|
||||
, terminal = urxvt . applications $ extraConfig
|
||||
, keys = const mempty
|
||||
, workspaces = let defaults = ["irc", "web", "mail"]
|
||||
external = map (T.unpack . topicName) . topics $ extraConfig
|
||||
in S.toList (S.fromList defaults <> S.fromList external)
|
||||
, layoutHook = smartBorders myLayout
|
||||
, clickJustFocuses = False
|
||||
, startupHook = myStartupHook >> ewmhDesktopsStartup >> setWMName "LG3D"
|
||||
, borderWidth = 2
|
||||
, normalBorderColor = "#262626"
|
||||
, focusedBorderColor = "#7F9F7F"
|
||||
, manageHook = myManageHook
|
||||
, focusFollowsMouse = False
|
||||
}
|
||||
myLayout = onWorkspace "web" webLayout $
|
||||
onWorkspace "dynamics" webLayout $
|
||||
onWorkspace "pdf" pdfLayout $
|
||||
onWorkspace "documents" documentLayout $
|
||||
onWorkspace "mail" mailLayout $
|
||||
onWorkspace "irc" ircLayout
|
||||
defLayout
|
||||
where
|
||||
-- Default layout
|
||||
defLayout = tiled ||| tabLayout ||| readLayout ||| bspLayout ||| vimLayout ||| spiral (6/7) ||| Full
|
||||
ircLayout = GridRatio (4/3) False ||| emptyBSP
|
||||
-- Pdfs are restricted to tabs
|
||||
vimLayout = Mirror (mastered (1/100) (4/5) Accordion)
|
||||
pdfLayout = readLayout ||| tiled ||| tabLayout
|
||||
readLayout = renamed [Replace "2/3"] (dwmStyle shrinkText myTabConfig (mastered (1/100) (2/3) Accordion))
|
||||
bspLayout = renamed [Replace "master bsp"] (dwmStyle shrinkText myTabConfig (mastered (1/100) (2/3) (Mirror emptyBSP)))
|
||||
-- Documents are by default tabs, but have looser restrictions
|
||||
documentLayout = tabLayout ||| Full ||| tiled ||| Mirror tiled
|
||||
-- Web is either tabbed, full, or tiled
|
||||
webLayout = readLayout ||| tabLayout ||| Full ||| tiled
|
||||
tiled = Tall nmaster delta ratio
|
||||
-- I need to restrict the type or type inferencer can't deduce type classes
|
||||
tabLayout :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
|
||||
tabLayout = tabbed shrinkText myTabConfig
|
||||
mailLayout = readLayout ||| tabLayout
|
||||
delta = 3/100
|
||||
ratio = 1/2
|
||||
nmaster = 1
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
module XMonad.Config.MasseR.ExtraConfig where
|
||||
|
||||
import GHC.Generics (Generic)
|
||||
import Data.Text (Text)
|
||||
|
||||
data Applications = Applications { browser :: FilePath, launcher :: FilePath, prompt :: FilePath, screenshot :: FilePath, urxvt :: FilePath } deriving (Show, Generic)
|
||||
|
||||
data TopicRule = TopicRule { topicName :: Text
|
||||
, topicHome :: Maybe Text
|
||||
, topicAction :: Maybe Text }
|
||||
deriving (Show, Generic)
|
||||
|
||||
data ExtraConfig = ExtraConfig { applications :: Applications, topics :: [ TopicRule ] } deriving (Show, Generic)
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
module XMonad.Configurable (Configurable, EndoM(..), configure) where
|
||||
|
||||
import Control.Monad ((<=<))
|
||||
import Control.Monad.Reader
|
||||
|
||||
newtype EndoM m a = EndoM { appEndoM :: a -> m a }
|
||||
|
||||
instance Monad m => Semigroup (EndoM m a) where
|
||||
EndoM f <> EndoM g = EndoM (f <=< g)
|
||||
|
||||
instance Monad m => Monoid (EndoM m a) where
|
||||
mempty = EndoM pure
|
||||
|
||||
type Configurable a = EndoM (Reader a) a
|
||||
|
||||
configure :: Configurable a -> a
|
||||
configure (EndoM f) = fix (\self -> runReader (f self) self)
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
module XMonad.CustomPrompt (xdg_open, browser) where
|
||||
|
||||
import qualified XMonad.Prompt.AppLauncher as AL
|
||||
import XMonad.Prompt
|
||||
import XMonad (X)
|
||||
|
||||
launchApp :: AL.Application -> X ()
|
||||
launchApp = AL.launchApp def
|
||||
|
||||
xdg_open :: X ()
|
||||
xdg_open = launchApp "xdg-open"
|
||||
|
||||
browser :: X ()
|
||||
browser = launchApp "qutebrowser"
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
{-# Language FlexibleContexts #-}
|
||||
module Customizations (customizations) where
|
||||
|
||||
import Configurable
|
||||
import XMonad
|
||||
import XMonad.Util.EZConfig (additionalKeys)
|
||||
|
||||
import Customizations.Types
|
||||
import qualified Customizations.Topics as Topics
|
||||
|
||||
import Control.Lens
|
||||
|
||||
customizations :: LayoutClass l Window => XConfig l -> XConfig l
|
||||
customizations start = xconfig $ configure (mconcat [topics, Topics.customize, initial])
|
||||
where
|
||||
initial = EndoM $ \_ -> pure (Customize start def)
|
||||
topics :: LayoutClass l Window => Configurable (Customize l)
|
||||
topics = EndoM $ \super -> do
|
||||
_self <- ask
|
||||
pure (over _xconfig _ super)
|
||||
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
module XMonad.Password (passGeneratePrompt, passPrompt) where
|
||||
|
||||
import Control.Monad.Trans (liftIO)
|
||||
import Data.Function (on)
|
||||
import Data.List (foldl', scanl', sort, sortBy)
|
||||
import System.Directory (getHomeDirectory)
|
||||
import System.FilePath.Posix (dropExtension, takeExtension, (</>))
|
||||
import System.Posix.Env (getEnv)
|
||||
import XMonad.Core
|
||||
import XMonad.Prompt
|
||||
import XMonad.Util.Run (runProcessWithInput)
|
||||
|
||||
data Pass = Pass { passLabel :: String }
|
||||
|
||||
-- Rosetta code levenshtein
|
||||
levenshtein :: String -> String -> Int
|
||||
levenshtein s1 s2 = last $ foldl' transform [0..length s1] s2
|
||||
where
|
||||
transform [] _ = []
|
||||
transform ns@(n:ns1) c = scanl' calc (n+1) $ zip3 s1 ns ns1
|
||||
where
|
||||
calc z (c1, x, y) = minimum [y+1, z+1, x + (fromEnum (c1 /= c) * 2)]
|
||||
|
||||
instance XPrompt Pass where
|
||||
showXPrompt p = passLabel p <> ": "
|
||||
commandToComplete _ = id
|
||||
nextCompletion _ = getNextCompletion
|
||||
|
||||
passGeneratePrompt :: XPConfig -> X ()
|
||||
passGeneratePrompt _ = return () -- Not implemented
|
||||
|
||||
passPrompt :: XPConfig -> X ()
|
||||
passPrompt = mkPassPrompt "Select password" selectPassword
|
||||
|
||||
mkPassPrompt :: String -> (String -> X ()) -> XPConfig -> X ()
|
||||
mkPassPrompt label f conf = do
|
||||
-- I'm just sorting here, but could use some kind of fuzzy matching instead, but it requires a bit more effort
|
||||
passwords <- sort <$> liftIO getPasswords
|
||||
-- Other change, use infixof instead of prefixof
|
||||
mkXPrompt (Pass label) conf (\input -> pure (sortBy (compare `on` (levenshtein input)) . filter (consumes input) $ passwords)) f
|
||||
where
|
||||
consumes [] _ = True -- everything consumed
|
||||
consumes (_:_) [] = False -- all not consumed
|
||||
consumes (a:xs) (a':ys) | a == a' = consumes xs ys
|
||||
| otherwise = consumes (a:xs) ys
|
||||
getStore = do
|
||||
let storeDefault = (</> ".password-store")
|
||||
maybe (storeDefault <$> getHomeDirectory) pure =<< getEnv "PASSWORD_STORE_DIR"
|
||||
getPasswords = do
|
||||
passwordStoreDir <- getStore
|
||||
files <- runProcessWithInput "find" [ passwordStoreDir, "-type", "f", "-name", "*.gpg", "-printf", "%P\n"] []
|
||||
return . map (\path -> if path `hasExtension` ".gpg" then dropExtension path else path) . lines $ files
|
||||
hasExtension path ext = takeExtension path == ext
|
||||
|
||||
|
||||
selectPassword :: String -> X ()
|
||||
selectPassword pass = spawn $ "pass --clip " ++ pass
|
||||
|
|
@ -0,0 +1 @@
|
|||
module Projects where
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
module RestartFile (restartFile, resumeArgsFromFile, getArgs, withArgs) where
|
||||
|
||||
import XMonad.Core
|
||||
import XMonad.Operations
|
||||
import qualified XMonad.StackSet as W
|
||||
import Graphics.X11.Xlib.Event
|
||||
import Control.Monad.Reader (asks)
|
||||
import Control.Monad.State (gets)
|
||||
import Data.Maybe
|
||||
import Data.List (intercalate)
|
||||
import qualified Data.Map.Strict as M
|
||||
import System.Environment (getArgs, withArgs)
|
||||
import Control.Monad
|
||||
import Control.Exception
|
||||
import System.Posix.Process (executeFile)
|
||||
|
||||
stateFile = "xmonadargs.txt"
|
||||
|
||||
restartFile :: String -> Bool -> X ()
|
||||
restartFile prog resume = do
|
||||
io $ appendFile "/home/masse/xmonad.log" $ "trying to restart"
|
||||
broadcastMessage ReleaseResources
|
||||
io . flush =<< asks display
|
||||
let wsData = show . W.mapLayout show . windowset
|
||||
maybeShow (t, Right (PersistentExtension ext)) = Just (t, show ext)
|
||||
maybeShow (t, Left str) = Just (t, str)
|
||||
maybeShow _ = Nothing
|
||||
extState = return . show . mapMaybe maybeShow . M.toList . extensibleState
|
||||
args <- if resume then return ["--resume"] else return []
|
||||
when resume $ do
|
||||
argsstr <- gets (\s -> intercalate "\n" ("--resume":wsData s:extState s))
|
||||
catchIO $ writeFile stateFile argsstr
|
||||
return ()
|
||||
catchIO (executeFile prog True args Nothing)
|
||||
|
||||
catchAny :: IO a -> (SomeException -> IO a) -> IO a
|
||||
catchAny = Control.Exception.catch
|
||||
|
||||
resumeArgsFromFile :: IO [String]
|
||||
resumeArgsFromFile = do
|
||||
let readLines = liftM lines . readFile $ stateFile
|
||||
args <- getArgs
|
||||
if ["--resume"] == args then
|
||||
catchAny readLines $ \e -> do
|
||||
appendFile "/home/masse/xmonad.log" $ "got error" ++ show e
|
||||
return args
|
||||
else return args
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
module Screen (screenWidth, nextScreen, prevScreen) where
|
||||
|
||||
import Graphics.X11.Xinerama (xineramaQueryScreens, XineramaScreenInfo(..))
|
||||
import Graphics.X11.Xlib (openDisplay, closeDisplay)
|
||||
import qualified XMonad.Actions.CycleWS as CycleWS
|
||||
import XMonad (X())
|
||||
import Control.Monad.Trans (liftIO)
|
||||
|
||||
screenWidth :: Int -> IO Int
|
||||
screenWidth idx = do
|
||||
dsp <- openDisplay "" -- I don't know what the string does :/
|
||||
info <- xineramaQueryScreens dsp
|
||||
case info of
|
||||
Nothing -> return 0
|
||||
Just [] -> return 0
|
||||
Just screens -> if idx >= 0 && idx < length screens
|
||||
then (return . fromIntegral . xsi_width) (screens !! idx)
|
||||
else return 0
|
||||
|
||||
swapScreenDir :: IO Bool
|
||||
swapScreenDir = do
|
||||
dsp <- openDisplay ""
|
||||
info <- xineramaQueryScreens dsp
|
||||
closeDisplay dsp
|
||||
case info of
|
||||
Nothing -> return False
|
||||
Just [] -> return False
|
||||
Just (s:_) -> return (xsi_width s > 0)
|
||||
|
||||
nextScreen :: X ()
|
||||
nextScreen = do
|
||||
swap <- liftIO $ swapScreenDir -- Not too fond of querying the x each time we swap screens, but oh well
|
||||
if swap then CycleWS.prevScreen else CycleWS.nextScreen
|
||||
|
||||
prevScreen :: X ()
|
||||
prevScreen = do
|
||||
swap <- liftIO $ swapScreenDir -- Not too fond of querying the x each time we swap screens, but oh well
|
||||
if swap then CycleWS.nextScreen else CycleWS.prevScreen
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
{-# Language RecordWildCards #-}
|
||||
module XMonad.TopicSpace (topicKeys', addTopic, TopicAction(..)) where
|
||||
|
||||
import XMonad.Actions.TopicSpace
|
||||
import XMonad
|
||||
import qualified Data.Map as M
|
||||
import XMonad.Actions.GridSelect
|
||||
import XMonad.Actions.DynamicWorkspaces
|
||||
import XMonad.TopicUtils
|
||||
import XMonad.Util.EZConfig (mkNamedKeymap)
|
||||
import XMonad.Util.NamedActions
|
||||
|
||||
import XMonad.Config.MasseR.ExtraConfig
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
import XMonad.Configurable
|
||||
|
||||
data TopicAction = TopicAction { name :: String
|
||||
, action :: X ()
|
||||
, home :: Maybe FilePath }
|
||||
|
||||
addTopic :: TopicAction -> Configurable TopicConfig
|
||||
addTopic TopicAction{..} = EndoM $ \super -> let
|
||||
newDirs = topicDirs super <> maybe mempty (M.singleton name) home
|
||||
newActions = topicActions super <> M.singleton name action
|
||||
in pure super { topicDirs = newDirs
|
||||
, topicActions = newActions }
|
||||
|
||||
myTopicConfig :: ExtraConfig -> TopicConfig
|
||||
myTopicConfig extraConfig =
|
||||
let dirs = M.fromList [ (T.unpack n, T.unpack d) | TopicRule n (Just d) _ <- topics extraConfig ]
|
||||
actions = M.fromList [ (T.unpack n, spawn (T.unpack a)) | TopicRule n _ (Just a) <- topics extraConfig ]
|
||||
in def {
|
||||
topicDirs = dirs
|
||||
, defaultTopicAction = const (realTopicDir dirs >>= spawnShellIn)
|
||||
, defaultTopic = "irc"
|
||||
, topicActions = actions
|
||||
}
|
||||
|
||||
|
||||
topicKeys' :: ExtraConfig -> XConfig l -> [(String, NamedAction)]
|
||||
topicKeys' extraConfig conf = [ ("M-y", addName "Change topic" $ visualSelect (myTopicConfig extraConfig))
|
||||
, ("M-S-g", addName "Move window to topic" $ gridselectMove def)
|
||||
, ("M-u", addName "Select window" $ gotoSelected' def{gs_colorizer = fromClassName})
|
||||
, ("M-<Return>", addName "Open project action" $ currentTopicAction' (myTopicConfig extraConfig))
|
||||
, ("M-w", modificationSubmaps' conf)]
|
||||
|
||||
|
||||
spawnShellIn :: Dir -> X ()
|
||||
spawnShellIn dir = safeRunInTerm dir Nothing
|
||||
|
||||
|
||||
modificationSubmaps' :: XConfig l -> NamedAction
|
||||
modificationSubmaps' conf =
|
||||
submapName $ mkNamedKeymap conf [ ("a", addName "Add a new workspace" $ addWorkspacePrompt def)
|
||||
, ("w", addName "Copy project" copyTopic)
|
||||
, ("d", addName "Remove empty workspace" removeEmptyWorkspace)]
|
||||
|
||||
|
|
@ -0,0 +1,90 @@
|
|||
module XMonad.TopicUtils where
|
||||
|
||||
import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
|
||||
import Data.List (isPrefixOf, sort, nub)
|
||||
import XMonad.Actions.TopicSpace
|
||||
import XMonad
|
||||
import qualified Data.Map as M
|
||||
import XMonad.Actions.GridSelect hiding (gridselectWorkspace)
|
||||
import XMonad.Util.Run (safeSpawn)
|
||||
import qualified XMonad.StackSet as W
|
||||
import XMonad.Util.Dmenu (dmenu)
|
||||
import XMonad.Actions.DynamicWorkspaces
|
||||
import XMonad.Util.NamedWindows (getName)
|
||||
|
||||
|
||||
realTopicDir :: M.Map String FilePath -> X String
|
||||
realTopicDir tg = do
|
||||
topic <- realTopic
|
||||
return . fromMaybe "" . M.lookup topic $ tg
|
||||
|
||||
|
||||
safeRunInTerm :: Dir -> Maybe String -> X ()
|
||||
safeRunInTerm dir Nothing = safeSpawn "urxvt" ["-cd", dir]
|
||||
safeRunInTerm dir (Just command) = safeSpawn "urxvt" ["-cd", dir, "-e", command]
|
||||
|
||||
inactiveTags :: X [WorkspaceId]
|
||||
inactiveTags = map W.tag . inactive' <$> gets windowset
|
||||
where
|
||||
inactive' s = W.hidden s ++ map W.workspace (filter (\w -> (W.tag . W.workspace . W.current) s /= (W.tag . W.workspace) w) (W.visible s))
|
||||
|
||||
gridselectMove :: GSConfig WorkspaceId -> X ()
|
||||
gridselectMove conf = do
|
||||
topics <- inactiveTags
|
||||
gridselect conf [(x,x) | x <- topics] >>= maybe (return ()) (windows . W.shift)
|
||||
|
||||
dmenuMove :: X ()
|
||||
dmenuMove = do
|
||||
topics <- inactiveTags
|
||||
dmenu topics >>= \t -> windows (W.shift t)
|
||||
|
||||
gsConfig :: GSConfig Window
|
||||
gsConfig = def{gs_navigate = navNSearch, gs_colorizer = fromClassName}
|
||||
|
||||
-- Copied from gridselect and modified so that it doesn't contain current and visible
|
||||
-- - Doesn't contain current and visible
|
||||
-- - Takes a topicspace viewfunc
|
||||
gridselectWorkspace :: GSConfig WorkspaceId -> (WorkspaceId -> X ()) -> X ()
|
||||
gridselectWorkspace conf viewFunc = withWindowSet $ \ws -> do
|
||||
let wss = map W.tag . W.hidden $ ws
|
||||
gridselect conf (zip wss wss) >>= flip whenJust viewFunc
|
||||
|
||||
gotoSelected' :: GSConfig Window -> X ()
|
||||
gotoSelected' gsconf = do
|
||||
w <- gridselectCurrentWindows gsconf
|
||||
maybe (return ()) (windows . W.focusWindow) w
|
||||
|
||||
gridselectCurrentWindows :: GSConfig Window -> X (Maybe Window)
|
||||
gridselectCurrentWindows gsconf = windowMap >>= gridselect gsconf
|
||||
where
|
||||
getName' = fmap show . getName
|
||||
kvPair w = flip (,) w `fmap` getName' w
|
||||
windowMap = do
|
||||
ws <- gets (nub . W.integrate' . W.stack . W.workspace . W.current . windowset)
|
||||
mapM kvPair ws
|
||||
|
||||
visualSelect :: TopicConfig -> X ()
|
||||
visualSelect cfg = gridselectWorkspace def{gs_navigate = navNSearch, gs_colorizer = stringColorizer} (switchTopic cfg)
|
||||
|
||||
realTopic :: X String
|
||||
realTopic = gets (real . W.tag . W.workspace . W.current . windowset)
|
||||
where real = takeWhile (/= ':')
|
||||
|
||||
currentTopicAction' :: TopicConfig -> X ()
|
||||
currentTopicAction' tg = do
|
||||
topic <- realTopic
|
||||
topicAction tg topic
|
||||
|
||||
copyTopic :: X ()
|
||||
copyTopic = do
|
||||
currentTopic <- realTopic
|
||||
lastN <- gets (listToMaybe . reverse . sort . mapMaybe (subset currentTopic . W.tag) . W.workspaces . windowset)
|
||||
addWorkspace (currentTopic ++ ":" ++ (show $ maybe 2 (+1) lastN))
|
||||
where
|
||||
subset :: String -> String -> Maybe Int
|
||||
subset topic other = if topic `isPrefixOf` other then (readM $ tail' $ snd $ break (== ':') other) else Nothing
|
||||
readM a = case reads a of
|
||||
[(x,_)] -> Just x
|
||||
_ -> Nothing
|
||||
tail' [] = []
|
||||
tail' xs = tail xs
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
module TreeSelectUtils where
|
||||
|
||||
import XMonad.Actions.TreeSelect
|
||||
import Data.Tree
|
||||
import Data.List (sort, groupBy)
|
||||
import Data.Function (on)
|
||||
import qualified XMonad.StackSet as W
|
||||
import XMonad.Core
|
||||
import Control.Monad.State
|
||||
|
||||
-- fromWorkspace :: [String] -> Forest String
|
||||
fromWorkspace = map go . group . sort
|
||||
where
|
||||
group = groupBy ((==) `on` (takeWhile (/= '.')))
|
||||
go (root:xs) = Node root [Node x [] | x <- xs]
|
||||
|
||||
treeselectWorkspaces' conf f = withWindowSet $ \w -> do
|
||||
let ws = map W.tag . W.hidden $ w
|
||||
treeselectWorkspace conf (fromWorkspace ws) f
|
||||
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
module XMonad.XMobar (zenburnPP) where
|
||||
|
||||
-- import XMonad.Util.Loggers
|
||||
import XMonad.Hooks.DynamicLog (
|
||||
PP(..)
|
||||
, xmobarColor
|
||||
, shorten
|
||||
, xmobarPP
|
||||
, dzenStrip)
|
||||
|
||||
|
||||
myUrgencyHintFgColor :: String
|
||||
myUrgencyHintFgColor = "#333333"
|
||||
|
||||
myUrgencyHintBgColor :: String
|
||||
myUrgencyHintBgColor = "#F18C96"
|
||||
|
||||
|
||||
-- Xmobar pretty printer. Color scheme zenburn
|
||||
zenburnPP :: PP
|
||||
zenburnPP = xmobarPP {
|
||||
ppTitle = xmobarColor "#DCA3A3" "" . shorten 70
|
||||
, ppCurrent = xmobarColor "#CEFFAC" ""
|
||||
, ppHidden = const ""
|
||||
, ppSep = " | "
|
||||
, ppLayout = id
|
||||
, ppUrgent = xmobarColor myUrgencyHintFgColor myUrgencyHintBgColor . dzenStrip
|
||||
, ppOrder = \(ws:_layout:_title:_) -> [ws]
|
||||
, ppExtras = []
|
||||
}
|
||||
|
||||
-- xmobar :: IO (X ())
|
||||
-- xmobar = do
|
||||
-- xmproc <- spawnPipe "xmobar ~/.xmonad/xmobar"
|
||||
-- return $ dynamicLogWithPP $ zenburnPP xmproc
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
-- Initial xmonad-masser.cabal generated by cabal init. For further
|
||||
-- documentation, see http://haskell.org/cabal/users-guide/
|
||||
|
||||
name: xmonad-masser
|
||||
version: 0.1.0.0
|
||||
-- synopsis:
|
||||
-- description:
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Mats Rauhala
|
||||
maintainer: mats.rauhala@iki.fi
|
||||
-- copyright:
|
||||
-- category:
|
||||
build-type: Simple
|
||||
extra-source-files: ChangeLog.md
|
||||
cabal-version: >=1.10
|
||||
|
||||
library
|
||||
exposed-modules: XMonad.Config.MasseR
|
||||
, XMonad.Config.MasseR.ExtraConfig
|
||||
other-modules: XMonad.Configurable
|
||||
, XMonad.CustomPrompt
|
||||
, XMonad.Password
|
||||
, XMonad.TopicUtils
|
||||
, XMonad.TopicSpace
|
||||
, XMonad.XMobar
|
||||
-- other-extensions:
|
||||
build-depends: base >=4.11 && <4.12
|
||||
, xmonad
|
||||
, xmonad-contrib
|
||||
, mtl
|
||||
, directory
|
||||
, filepath
|
||||
, unix
|
||||
, containers
|
||||
, text
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
Loading…
Reference in New Issue