diff --git a/files/.xmonad/lib/Config.hs b/files/.xmonad/lib/Config.hs index d5be0d2..fd1d455 100644 --- a/files/.xmonad/lib/Config.hs +++ b/files/.xmonad/lib/Config.hs @@ -44,7 +44,7 @@ import XMonad.Hooks.SetWMName (setWMName) import XMonad.Layout.BinarySpacePartition import XMonad.Layout.BorderResize import XMonad.Layout.Gaps -import XMonad.Layout.IndependentScreens +--import qualified XMonad.Layout.IndependentScreens as IS import XMonad.Layout.LayoutCombinators ((|||)) import XMonad.Layout.LayoutHints import XMonad.Layout.MouseResizableTile @@ -96,6 +96,7 @@ import Data.Maybe (catMaybes, maybeToList, fromMaybe) import Data.Bifunctor import GHC.IO.Unsafe (unsafePerformIO) import XMonad.Layout.LayoutModifier +import qualified IndependentScreens as IS --import XMonad.Layout.MultiColumns (multiCol) {-# ANN module "HLint: ignore Redundant $" #-} {-# ANN module "HLint: ignore Redundant bracket" #-} @@ -334,12 +335,12 @@ myKeys = concat [ zoomRowBindings, tabbedBindings, multiMonitorBindings, program multiMonitorBindings :: [(String, X ())] multiMonitorBindings = - [ ("M-s", windows $ withFocusedOnScreen 2 W.view) - , ("M-a", windows $ withFocusedOnScreen 1 W.view) - , ("M-d", windows $ withFocusedOnScreen 0 W.view) - , ("M-S-s", windows $ withFocusedOnScreen 2 (\wsp -> W.view wsp >> W.shift wsp)) - , ("M-S-a", windows $ withFocusedOnScreen 1 (\wsp -> W.view wsp >> W.shift wsp)) - , ("M-S-d", windows $ withFocusedOnScreen 0 (\wsp -> W.view wsp >> W.shift wsp)) + [ ("M-s", windows $ IS.focusScreen 2) + , ("M-a", windows $ IS.focusScreen 1) + , ("M-d", windows $ IS.focusScreen 0) + , ("M-S-s", windows $ IS.withWspOnScreen 2 (\wsp -> W.view wsp . W.shift wsp)) + , ("M-S-a", windows $ IS.withWspOnScreen 1 (\wsp -> W.view wsp . W.shift wsp)) + , ("M-S-d", windows $ IS.withWspOnScreen 0 (\wsp -> W.view wsp . W.shift wsp)) , ("M-C-s", windows swapScreenContents) ] @@ -406,12 +407,13 @@ myKeys = concat [ zoomRowBindings, tabbedBindings, multiMonitorBindings, program | wspNum <- [1..9 :: Int] ] where - runActionOnWorkspace :: (VirtualWorkspace -> WindowSet -> WindowSet) -> Int -> X () + runActionOnWorkspace :: (IS.VirtualWorkspace -> WindowSet -> WindowSet) -> Int -> X () runActionOnWorkspace action wspNum = do - wsps <- workspaces' <$> asks config - if length wsps > (wspNum - 1) - then windows $ onCurrentScreen action (wsps !! (wspNum - 1)) - else pure () + desiredWsp <- IS.nthWorkspace (wspNum - 1) + case desiredWsp of + Just wsp -> windows $ IS.onCurrentScreen action wsp + Nothing -> pure () + windowControlBindings :: [(String, X ())] @@ -537,7 +539,7 @@ myManageHook = composeAll -- Main ------------------------------------ {{{ main :: IO () main = do - currentScreenCount :: Int <- countScreens + currentScreenCount :: Int <- IS.countScreens let monitorIndices = [0..currentScreenCount - 1] @@ -554,7 +556,7 @@ main = do { terminal = myTerminal , workspaces = if useSharedWorkspaces then (map show [1..9 :: Int]) ++ ["NSP"] - else (withScreens (fromIntegral currentScreenCount) (map show [1..6 :: Int])) ++ ["NSP"] + else (IS.withScreens (fromIntegral currentScreenCount) (map show [1..6 :: Int])) ++ ["NSP"] , modMask = myModMask , borderWidth = 0 , layoutHook = myLayout @@ -605,13 +607,12 @@ activateWindowEventHook (ClientMessageEvent { ev_message_type = messageType, ev_ shouldRaise <- runQuery (className =? "discord" <||> className =? "web.whatsapp.com") window if shouldRaise then windows (W.shiftWin (W.currentTag ws) window) - else withWindowSet $ focusWindowIndependentScreens window + else windows (IS.focusWindow' window) return $ All True activateWindowEventHook _ = return $ All True - -- | Fixes fullscreen behaviour of chromium based apps by quickly applying and undoing a resize. -- This causes chromium to recalculate the fullscreen window -- dimensions to match the actual "windowed fullscreen" dimensions. @@ -621,9 +622,13 @@ fullscreenFixEventHook (ClientMessageEvent _ _ _ dpy win typ (_:dats)) = do fullscreen <- getAtom "_NET_WM_STATE_FULLSCREEN" when (typ == wmstate && fromIntegral fullscreen `elem` dats) $ do withWindowAttributes dpy win $ \attrs -> - liftIO $ resizeWindow dpy win (fromIntegral $ wa_width attrs - 1) (fromIntegral $ wa_height attrs) - withWindowAttributes dpy win $ \attrs -> - liftIO $ resizeWindow dpy win (fromIntegral $ wa_width attrs + 1) (fromIntegral $ wa_height attrs) + liftIO $ do + resizeWindow dpy win (fromIntegral $ wa_width attrs - 1) (fromIntegral $ wa_height attrs) + resizeWindow dpy win (fromIntegral $ wa_width attrs) (fromIntegral $ wa_height attrs) + --withWindowAttributes dpy win $ \attrs -> + --liftIO $ resizeWindow dpy win (fromIntegral $ wa_width attrs - 1) (fromIntegral $ wa_height attrs) + --withWindowAttributes dpy win $ \attrs -> + --liftIO $ resizeWindow dpy win (fromIntegral $ wa_width attrs + 1) (fromIntegral $ wa_height attrs) return $ All True fullscreenFixEventHook _ = return $ All True @@ -643,7 +648,7 @@ polybarLogHook monitor = do -- swapping namedScratchpadFilterOutWorkspacePP and marshallPP will throw "Prelude.read no Parse" errors..... wtf -- | create a polybar Pretty printer, marshalled for given monitor. polybarPP :: ScreenId -> PP -polybarPP monitor = namedScratchpadFilterOutWorkspacePP . (if useSharedWorkspaces then id else marshallPP $ fromIntegral monitor) $ def +polybarPP monitor = namedScratchpadFilterOutWorkspacePP . (if useSharedWorkspaces then id else IS.marshallPP $ fromIntegral monitor) $ def { ppCurrent = withFG aqua . withMargin . withFont 5 . const "__active__" , ppVisible = withFG aqua . withMargin . withFont 5 . const "__active__" , ppUrgent = withFG red . withMargin . withFont 5 . const "__urgent__" @@ -690,13 +695,13 @@ dropEndWhile test xs = if test $ last xs then dropEndWhile test (init xs) else catchAndNotifyAny :: IO () -> IO () catchAndNotifyAny ioAction = catch ioAction (\(e :: SomeException) -> notify "Xmonad exception" (show e)) -getVisibleWorkspacesTagsOnMonitor :: ScreenId -> X [VirtualWorkspace] +getVisibleWorkspacesTagsOnMonitor :: ScreenId -> X [IS.VirtualWorkspace] getVisibleWorkspacesTagsOnMonitor monitor = do ws <- gets windowset return $ W.current ws : W.visible ws |> map (W.tag . W.workspace) - |> filter (\tag -> monitor == fromIntegral (unmarshallS tag)) - |> map unmarshallW + |> filter (\tag -> monitor == fromIntegral (IS.unmarshallS tag)) + |> map IS.unmarshallW notify :: MonadIO m => String -> String -> m () @@ -717,32 +722,6 @@ getActiveLayoutDescription = (description . W.layout . W.workspace . W.current) - --- | Focus a window, switching workspace on the correct Xinerama screen if neccessary - respecting IndependentLayouts -focusWindowIndependentScreens :: Window -> WindowSet -> X () -focusWindowIndependentScreens window ws - | Just window == W.peek ws = pure () - | otherwise = case W.findTag window ws of - Just tag -> windows $ W.focusWindow window . withFocusedOnScreen (unmarshallS tag) W.view - Nothing -> pure () - - --- | Get the workspace that is active on a given screen -screenOnMonitor :: ScreenId -> WindowSet -> Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail) -screenOnMonitor screenId ws = Data.List.find ((screenId ==) . W.screen) (W.current ws : W.visible ws) - - --- | Convert a function that needs a workspace id into a windowset transformation by providing it with the workspace currently focused on a given screen. -withFocusedOnScreen - :: ScreenId -- ^ screen from which the workspaceId will be taken - -> (WorkspaceId -> WindowSet -> WindowSet) -- ^ operation that will be transformed - -> (WindowSet -> WindowSet) -withFocusedOnScreen screenId operation ws = - case screenOnMonitor screenId ws of - Just wsp -> operation (W.tag $ W.workspace wsp) ws - Nothing -> ws - - -- }}} diff --git a/files/.xmonad/lib/IndependentScreens.hs b/files/.xmonad/lib/IndependentScreens.hs new file mode 100644 index 0000000..50392d2 --- /dev/null +++ b/files/.xmonad/lib/IndependentScreens.hs @@ -0,0 +1,259 @@ +{-# LANGUAGE LambdaCase #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.IndependentScreens +-- Copyright : (c) 2009 Daniel Wagner +-- License : BSD3 +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Utility functions for simulating independent sets of workspaces on +-- each screen (like dwm's workspace model), using internal tags to +-- distinguish workspaces associated with each screen. +----------------------------------------------------------------------------- + +module IndependentScreens ( + -- * Usage + -- $usage + VirtualWorkspace, PhysicalWorkspace, + workspaces', + withScreens, onCurrentScreen, + marshallPP, + whenCurrentOn, + countScreens, + -- * Converting between virtual and physical workspaces + -- $converting + marshall, unmarshall, unmarshallS, unmarshallW, + marshallWindowSpace, unmarshallWindowSpace, marshallSort, + workspaceOnScreen, focusWindow', focusScreen, nthWorkspace, withWspOnScreen, activateWindowEventHook + ) where + +-- for the screen stuff +import Control.Applicative(liftA2) +import Control.Arrow hiding ((|||)) +import Data.List (find, nub, genericLength) +import Graphics.X11.Xinerama +import XMonad +import qualified XMonad.StackSet as W +import XMonad.Hooks.DynamicLog +import Data.Monoid (All(All)) +import Control.Monad (when) + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.IndependentScreens +-- +-- You can define your workspaces by calling @withScreens@: +-- +-- > myConfig = def { workspaces = withScreens 2 ["web", "email", "irc"] } +-- +-- This will create \"physical\" workspaces with distinct internal names for +-- each (screen, virtual workspace) pair. +-- +-- Then edit any keybindings that use the list of workspaces or refer +-- to specific workspace names. In the default configuration, only +-- the keybindings for changing workspace do this: +-- +-- > keyBindings conf = let m = modMask conf in fromList $ +-- > {- lots of other keybindings -} +-- > [((m .|. modm, k), windows $ f i) +-- > | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9] +-- > , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] +-- +-- This should change to +-- +-- > keyBindings conf = let m = modMask conf in fromList $ +-- > {- lots of other keybindings -} +-- > [((m .|. modm, k), windows $ onCurrentScreen f i) +-- > | (i, k) <- zip (workspaces' conf) [xK_1 .. xK_9] +-- > , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] +-- +-- In particular, the analogue of @XMonad.workspaces@ is +-- @workspaces'@, and you can use @onCurrentScreen@ to convert functions +-- of virtual workspaces to functions of physical workspaces, which work +-- by marshalling the virtual workspace name and the currently focused +-- screen into a physical workspace name. +-- +-- A complete example abusing many of the functions below is available in the +-- "XMonad.Config.Dmwit" module. + +type VirtualWorkspace = WorkspaceId +type PhysicalWorkspace = WorkspaceId + +-- $converting +-- You shouldn't need to use the functions below very much. They are used +-- internally. However, in some cases, they may be useful, and so are exported +-- just in case. In general, the \"marshall\" functions convert the convenient +-- form (like \"web\") you would like to use in your configuration file to the +-- inconvenient form (like \"2_web\") that xmonad uses internally. Similarly, +-- the \"unmarshall\" functions convert in the other direction. + +marshall :: ScreenId -> VirtualWorkspace -> PhysicalWorkspace +marshall (S sc) vws = show sc ++ '_':vws + +unmarshall :: PhysicalWorkspace -> (ScreenId, VirtualWorkspace) +unmarshallS :: PhysicalWorkspace -> ScreenId +unmarshallW :: PhysicalWorkspace -> VirtualWorkspace + +unmarshall = ((S . read) *** drop 1) . break (=='_') +unmarshallS = fst . unmarshall +unmarshallW = snd . unmarshall + +-- | Get a list of all the virtual workspace names. +workspaces' :: XConfig l -> [VirtualWorkspace] +workspaces' = nub . map (snd . unmarshall) . workspaces + +withScreens :: ScreenId -- ^ The number of screens to make workspaces for + -> [VirtualWorkspace] -- ^ The desired virtual workspace names + -> [PhysicalWorkspace] -- ^ A list of all internal physical workspace names +withScreens n vws = [marshall sc pws | pws <- vws, sc <- [0..n-1]] + +-- | Transform a function over physical workspaces into a function over virtual workspaces. +-- This is useful as it allows you to write code without caring about the current screen, i.e. to say "switch to workspace 3" +-- rather than saying "switch to workspace 3 on monitor 3". +onCurrentScreen :: (PhysicalWorkspace -> WindowSet -> a) -> (VirtualWorkspace -> WindowSet -> a) +onCurrentScreen f vws ws = + let currentScreenId = W.screen $ W.current ws + in f (marshall currentScreenId vws) ws + +-- | Get the workspace currently active on a given screen +workspaceOnScreen :: ScreenId -> WindowSet -> Maybe PhysicalWorkspace +workspaceOnScreen screenId ws = W.tag . W.workspace <$> screenOnMonitor screenId ws + + +-- | generate WindowSet transformation by providing a given function with the workspace active on a given screen. +-- This may for example be used to shift a window to another screen as follows: +-- +-- > windows $ withWspOnScreen 1 W.shift +-- +withWspOnScreen :: ScreenId -- ^ The screen to run on + -> (PhysicalWorkspace -> WindowSet -> WindowSet) -- ^ The transformation that will be passed the workspace currently active on there + -> WindowSet -> WindowSet +withWspOnScreen screenId operation ws = case workspaceOnScreen screenId ws of + Just wsp -> operation wsp ws + Nothing -> ws + +-- | Get the workspace that is active on a given screen. +screenOnMonitor :: ScreenId -> WindowSet -> Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail) +screenOnMonitor screenId ws = find ((screenId ==) . W.screen) (W.current ws : W.visible ws) + +-- | Focus a window, switching workspace on the correct Xinerama screen if neccessary. +focusWindow' :: Window -> WindowSet -> WindowSet +focusWindow' window ws + | Just window == W.peek ws = ws + | otherwise = case W.findTag window ws of + Just tag -> W.focusWindow window $ focusScreen (unmarshallS tag) ws + Nothing -> ws + +-- | Focus a given screen. +focusScreen :: ScreenId -> WindowSet -> WindowSet +focusScreen screenId = withWspOnScreen screenId W.view + +-- | Get the nth virtual workspace +nthWorkspace :: Int -> X (Maybe VirtualWorkspace) +nthWorkspace n = (!!? n) . workspaces' <$> asks config + + +-- | HandleEventHook which makes the activate window event respect IndependentScreens. +-- Without this, a window requesting activation may cause a workspace switch +-- that shows a workspace from a different screen on the current one. +activateWindowEventHook :: Event -> X All +activateWindowEventHook ClientMessageEvent { ev_message_type = messageType, ev_window = window } = do + activateWindowAtom <- getAtom "_NET_ACTIVE_WINDOW" + when (messageType == activateWindowAtom) $ + windows (focusWindow' window) + return $ All True +activateWindowEventHook _ = return $ All True + + +-- | In case you don't know statically how many screens there will be, you can call this in main before starting xmonad. For example, part of my config reads +-- +-- > main = do +-- > nScreens <- countScreens +-- > xmonad $ def { +-- > ... +-- > workspaces = withScreens nScreens (workspaces def), +-- > ... +-- > } +-- +countScreens :: (MonadIO m, Integral i) => m i +countScreens = fmap genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getScreenInfo closeDisplay + +-- | This turns a naive pretty-printer into one that is aware of the +-- independent screens. That is, you can write your pretty printer to behave +-- the way you want on virtual workspaces; this function will convert that +-- pretty-printer into one that first filters out physical workspaces on other +-- screens, then converts all the physical workspaces on this screen to their +-- virtual names. +-- +-- For example, if you have handles @hLeft@ and @hRight@ for bars on the left and right screens, respectively, and @pp@ is a pretty-printer function that takes a handle, you could write +-- +-- > logHook = let log screen handle = dynamicLogWithPP . marshallPP screen . pp $ handle +-- > in log 0 hLeft >> log 1 hRight +marshallPP :: ScreenId -> PP -> PP +marshallPP s pp = pp { + ppCurrent = ppCurrent pp . snd . unmarshall, + ppVisible = ppVisible pp . snd . unmarshall, + ppHidden = ppHidden pp . snd . unmarshall, + ppHiddenNoWindows = ppHiddenNoWindows pp . snd . unmarshall, + ppUrgent = ppUrgent pp . snd . unmarshall, + ppSort = fmap (marshallSort s) (ppSort pp) + } + +-- | Take a pretty-printer and turn it into one that only runs when the current +-- workspace is one associated with the given screen. The way this works is a +-- bit hacky, so beware: the 'ppOutput' field of the input will not be invoked +-- if either of the following conditions is met: +-- +-- 1. The 'ppSort' of the input returns an empty list (when not given one). +-- +-- 2. The 'ppOrder' of the input returns the exact string @\"\\0\"@. +-- +-- For example, you can use this to create a pipe which tracks the title of the +-- window currently focused on a given screen (even if the screen is not +-- current) by doing something like this: +-- +-- > ppFocus s = whenCurrentOn s def +-- > { ppOrder = \(_:_:title:_) -> [title] +-- > , ppOutput = appendFile ("focus" ++ show s) . (++ "\n") +-- > } +-- +-- Sequence a few of these pretty-printers to get a log hook that keeps each +-- screen's title up-to-date. +whenCurrentOn :: ScreenId -> PP -> PP +whenCurrentOn s pp = pp + { ppSort = do + sort <- ppSort pp + pure $ \xs -> case xs of + x:_ | unmarshallS (W.tag x) == s -> sort xs + _ -> [] + , ppOrder = \case ("":_) -> ["\0"] -- we got passed no workspaces; this is the signal from ppSort that this is a boring case + list -> ppOrder pp list + + , ppOutput = \case "\0" -> pure () -- we got passed the signal from ppOrder that this is a boring case + output -> ppOutput pp output + } + +-- | If @vSort@ is a function that sorts 'WindowSpace's with virtual names, then @marshallSort s vSort@ is a function which sorts 'WindowSpace's with physical names in an analogous way -- but keeps only the spaces on screen @s@. +marshallSort :: ScreenId -> ([WindowSpace] -> [WindowSpace]) -> ([WindowSpace] -> [WindowSpace]) +marshallSort s vSort = pScreens . vSort . vScreens where + isOnScreen ws = unmarshallS (W.tag ws) == s + vScreens = map unmarshallWindowSpace . filter isOnScreen + pScreens = map (marshallWindowSpace s) + +-- | Convert the tag of the 'WindowSpace' from a 'VirtualWorkspace' to a 'PhysicalWorkspace'. +marshallWindowSpace :: ScreenId -> WindowSpace -> WindowSpace +-- | Convert the tag of the 'WindowSpace' from a 'PhysicalWorkspace' to a 'VirtualWorkspace'. +unmarshallWindowSpace :: WindowSpace -> WindowSpace + +marshallWindowSpace s ws = ws { W.tag = marshall s (W.tag ws) } +unmarshallWindowSpace ws = ws { W.tag = unmarshallW (W.tag ws) } + +-- | Safe version of (!!) +(!!?) :: [a] -> Int -> Maybe a +(!!?) list n + | n < length list = Just $ list !! n + | otherwise = Nothing diff --git a/files/.xmonad/my-xmonad.cabal b/files/.xmonad/my-xmonad.cabal index f36734e..b56d3f8 100644 --- a/files/.xmonad/my-xmonad.cabal +++ b/files/.xmonad/my-xmonad.cabal @@ -15,6 +15,7 @@ executable my-xmonad FancyBorders WsContexts MultiColumns + IndependentScreens --FlexiColumns default-language: Haskell2010 @@ -29,4 +30,7 @@ executable my-xmonad containers >=0.6.2.1, utf8-string >=1.0.1.1, text >=1.2.4.0, - process >= 0.0.10 + process >= 0.0.10, + -- todo remove this again + X11>=1.6.1 && < 1.10 + diff --git a/files/nix-stuff/nixpkgs/modules/base.nix b/files/nix-stuff/nixpkgs/modules/base.nix index c8438d5..a76c186 100644 --- a/files/nix-stuff/nixpkgs/modules/base.nix +++ b/files/nix-stuff/nixpkgs/modules/base.nix @@ -90,6 +90,8 @@ in hexchat swiPrologWithGui kmonad + gitAndTools.delta + git-fuzzy ] ) ( diff --git a/files/nix-stuff/nixpkgs/overlay/default.nix b/files/nix-stuff/nixpkgs/overlay/default.nix index 8adc4d3..436087b 100644 --- a/files/nix-stuff/nixpkgs/overlay/default.nix +++ b/files/nix-stuff/nixpkgs/overlay/default.nix @@ -9,6 +9,7 @@ self: super: { carp-new = super.callPackage ./carp-new.nix {}; liquidctl = super.callPackage ../packages/liquidctl.nix { }; mmutils = super.callPackage ../packages/mmutils.nix { }; + git-fuzzy = super.callPackage ../packages/git-fuzzy.nix { }; nixGL = import sources.nixGL { }; scr = super.callPackage ../packages/scr.nix { }; my-st = super.callPackage ../packages/st/st-tanish2002 { }; diff --git a/files/nix-stuff/nixpkgs/packages/git-fuzzy.nix b/files/nix-stuff/nixpkgs/packages/git-fuzzy.nix new file mode 100644 index 0000000..1e2ffb1 --- /dev/null +++ b/files/nix-stuff/nixpkgs/packages/git-fuzzy.nix @@ -0,0 +1,40 @@ +{ fetchFromGitHub, stdenvNoCC, lib, makeWrapper, gitAndTools, bat, extraPackages ? [] }: +let + binPath = lib.makeBinPath ([gitAndTools.hub gitAndTools.delta bat] ++ extraPackages); +in +stdenvNoCC.mkDerivation rec { + pname = "git-fuzzy"; + version = "1.0"; + src = fetchFromGitHub { + owner = "bigH"; + repo = "git-fuzzy"; + rev = "ecdcd157e537d98586435a40bed83d40c65bd959"; + sha256 = "1f2iq8bk0fpld99m0siajadn3lr5fwvgwpniwfdh73picxa7hwhk"; + }; + + nativeBuildInputs = [ makeWrapper ]; + installPhase = '' + install -m755 -D ./bin/git-fuzzy $out/bin/git-fuzzy + install -d "$out/lib" + cp -r lib "$out/lib/git-fuzzy" + + ''; + postFixup = '' + sed -i 's%lib_dir="$script_dir/../lib"%lib_dir='"$out"'/lib/git-fuzzy%' $out/bin/git-fuzzy + wrapProgram "$out/bin/git-fuzzy" --prefix PATH : ${binPath} + ''; + meta = { + description = "FZF-based github cli interface"; + homepage = "https://github.com/bigH/git-fuzzy"; + maintainers = with lib.maintainers; [ elkowar ]; + license = lib.licenses.mit; + platforms = lib.platforms.all; + }; +} + +#"build() { + #cd "${srcdir}/${_pkgname}" + #sed -i 's%lib_dir="$script_dir/../lib"%lib_dir=/usr/lib/git-fuzzy%' bin/git-fuzzy + + #sed -i 's%gifs/%https://github.com/bigH/git-fuzzy/raw/master/gifs/%' README.md +#}" diff --git a/files/scripts/wpms.sh b/files/scripts/wpms.sh new file mode 100755 index 0000000..fc89cd0 --- /dev/null +++ b/files/scripts/wpms.sh @@ -0,0 +1,16 @@ +#!/bin/sh + + +file="$(echo ~/wpms/* | xargs realpath | rofi -dmenu)" +if [ -f "$file" ]; then + echo "$(date +%s) $(rofi -dmenu)" >> "$file" + +else + notify-send "No valid file given :/" +fi + + + + + +