diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,7 +1,118 @@ # Change Log / Release Notes -## unknown +## 0.16 +### Breaking Changes + + * `XMonad.Layout.Decoration` + - Added `Theme` record fields for controlling decoration border width for active/inactive/urgent windows. + * `XMonad.Prompt` + + - Prompt ships a vim-like keymap, see `vimLikeXPKeymap` and + `vimLikeXPKeymap'`. A reworked event loop supports new vim-like prompt + actions. + - Prompt supports dynamic colors. Colors are now specified by the `XPColor` + type in `XPState` while `XPConfig` colors remain unchanged for backwards + compatibility. + - Fixes `showCompletionOnTab`. + - The behavior of `moveWord` and `moveWord'` has changed; brought in line + with the documentation and now internally consistent. The old keymaps + retain the original behavior; see the documentation to do the same your + XMonad configuration. + * `XMonad.Util.Invisble` + - Requires `MonadFail` for `Read` instance + +### New Modules + + * `XMonad.Layout.TwoPanePersistent` + + A layout that is like TwoPane but keeps track of the slave window that is + currently beside the master. In TwoPane, the default behavior when the master + is focused is to display the next window in the stack on the slave pane. This + is a problem when a different slave window is selected without changing the stack + order. + + * `XMonad.Util.ExclusiveScratchpads` + + Named scratchpads that can be mutually exclusive: This new module extends the + idea of named scratchpads such that you can define "families of scratchpads" + that are exclusive on the same screen. It also allows to remove this + constraint of being mutually exclusive with another scratchpad. + +### Bug Fixes and Minor Changes + + * `XMonad.Layout.Tabbed` + + tabbedLeft and tabbedRight will set their tabs' height and width according to decoHeight/decoWidth + + * `XMonad.Prompt` + + Added `sorter` to `XPConfig` used to sort the possible completions by how + well they match the search string (example: `XMonad.Prompt.FuzzyMatch`). + + Fixes a potential bug where an error during prompt execution would + leave the window open and keep the keyboard grabbed. See issue + [#180](https://github.com/xmonad/xmonad-contrib/issues/180). + + Fixes [issue #217](https://github.com/xmonad/xmonad-contrib/issues/217), where + using tab to wrap around the completion rows would fail when maxComplRows is + restricting the number of rows of output. + + * `XMonad.Prompt.Pass` + + Added 'passOTPPrompt' to support getting OTP type password. This require + pass-otp (https://github.com/tadfisher/pass-otp) has been setup in the running + machine. + + Added 'passGenerateAndCopyPrompt', which both generates a new password and + copies it to the clipboard. These two actions are commonly desirable to + take together, e.g. when establishing a new account. + + Made password prompts traverse symlinks when gathering password names for + autocomplete. + + * `XMonad.Actions.DynamicProjects` + + Make the input directory read from the prompt in `DynamicProjects` + absolute wrt the current directory. + + Before this, the directory set by the prompt was treated like a relative + directory. This means that when you switch from a project with directory + `foo` into a project with directory `bar`, xmonad actually tries to `cd` + into `foo/bar`, instead of `~/bar` as expected. + + * `XMonad.Actions.DynamicWorkspaceOrder` + + Add a version of `withNthWorkspace` that takes a `[WorkspaceId] -> + [WorkspaceId]` transformation to apply over the list of workspace tags + resulting from the dynamic order. + + * `XMonad.Actions.GroupNavigation` + + Add a utility function `isOnAnyVisibleWS :: Query Bool` to allow easy + cycling between all windows on all visible workspaces. + + + * `XMonad.Hooks.WallpaperSetter` + + Preserve the aspect ratio of wallpapers that xmonad sets. When previous + versions would distort images to fit the screen size, it will now find a + best fit by cropping instead. + + * `XMonad.Util.Themes` + + Add adwaitaTheme and adwaitaDarkTheme to match their respective + GTK themes. + + * 'XMonad.Layout.BinarySpacePartition' + + Add a new `SplitShiftDirectional` message that allows moving windows by + splitting its neighbours. + + * `XMonad.Prompt.FuzzyMatch` + + Make fuzzy sort show shorter strings first. + ## 0.15 ### Breaking Changes @@ -164,6 +275,12 @@ Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to dynamically toggle `XMonad.Layout.TabBarDecoration`. + * `XMonad.Hooks.RefocusLast` + + Provides hooks and actions that keep track of recently focused windows on a + per workspace basis and automatically refocus the last window on loss of the + current (if appropriate as determined by user specified criteria). + * `XMonad.Layout.StateFull` Provides `StateFull`: a stateful form of `Full` that does not misbehave when @@ -349,6 +466,8 @@ - New function `passTypePrompt` which uses `xdotool` to type in a password from the store, bypassing the clipboard. + - New function `passEditPrompt` for editing a password from the + store. - Now handles password labels with spaces and special characters inside them. diff --git a/XMonad/Actions/DynamicProjects.hs b/XMonad/Actions/DynamicProjects.hs --- a/XMonad/Actions/DynamicProjects.hs +++ b/XMonad/Actions/DynamicProjects.hs @@ -50,7 +50,7 @@ import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe, isNothing) import Data.Monoid ((<>)) -import System.Directory (setCurrentDirectory, getHomeDirectory) +import System.Directory (setCurrentDirectory, getHomeDirectory, makeAbsolute) import XMonad import XMonad.Actions.DynamicWorkspaces import XMonad.Prompt @@ -182,7 +182,8 @@ modifyProject (\p -> p { projectName = name }) modeAction (ProjectPrompt DirMode _) buf auto = do - let dir = if null auto then buf else auto + let dir' = if null auto then buf else auto + dir <- io $ makeAbsolute dir' modifyProject (\p -> p { projectDirectory = dir }) -------------------------------------------------------------------------------- diff --git a/XMonad/Actions/DynamicWorkspaceOrder.hs b/XMonad/Actions/DynamicWorkspaceOrder.hs --- a/XMonad/Actions/DynamicWorkspaceOrder.hs +++ b/XMonad/Actions/DynamicWorkspaceOrder.hs @@ -30,6 +30,7 @@ , moveToGreedy , shiftTo + , withNthWorkspace' , withNthWorkspace ) where @@ -183,13 +184,19 @@ shiftTo :: Direction1D -> WSType -> X () shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift) --- | Do something with the nth workspace in the dynamic order. The --- callback is given the workspace's tag as well as the 'WindowSet' --- of the workspace itself. -withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X () -withNthWorkspace job wnum = do +-- | Do something with the nth workspace in the dynamic order after +-- transforming it. The callback is given the workspace's tag as well +-- as the 'WindowSet' of the workspace itself. +withNthWorkspace' :: ([WorkspaceId] -> [WorkspaceId]) -> (String -> WindowSet -> WindowSet) -> Int -> X () +withNthWorkspace' tr job wnum = do sort <- getSortByOrder - ws <- gets (map W.tag . sort . W.workspaces . windowset) + ws <- gets (tr . map W.tag . sort . W.workspaces . windowset) case drop wnum ws of (w:_) -> windows $ job w [] -> return () + +-- | Do something with the nth workspace in the dynamic order. The +-- callback is given the workspace's tag as well as the 'WindowSet' +-- of the workspace itself. +withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X () +withNthWorkspace = withNthWorkspace' id diff --git a/XMonad/Actions/GroupNavigation.hs b/XMonad/Actions/GroupNavigation.hs --- a/XMonad/Actions/GroupNavigation.hs +++ b/XMonad/Actions/GroupNavigation.hs @@ -16,7 +16,7 @@ -- query. -- -- Also provides a method for jumping back to the most recently used --- window in any given group. +-- window in any given group, and predefined groups. -- ---------------------------------------------------------------------- @@ -27,9 +27,14 @@ , nextMatchOrDo , nextMatchWithThis , historyHook + + -- * Utilities + -- $utilities + , isOnAnyVisibleWS ) where import Control.Monad.Reader +import Control.Monad.State import Data.Foldable as Fold import Data.Map as Map import Data.Sequence as Seq @@ -142,7 +147,7 @@ where wspcs = SS.workspaces ss wspcsMap = Fold.foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs - wspcs' = fmap (\wsid -> wspcsMap ! wsid) wsids + wspcs' = fmap (wspcsMap !) wsids isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss) --- History navigation, requires a layout modifier ------------------- @@ -167,7 +172,7 @@ updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do let newcur = SS.peek ss wins = Set.fromList $ SS.allWindows ss - newhist = flt (flip Set.member wins) (ins oldcur oldhist) + newhist = flt (`Set.member` wins) (ins oldcur oldhist) return $ HistoryDB newcur (del newcur newhist) where ins x xs = maybe xs (<| xs) x @@ -216,3 +221,22 @@ if isMatch then return (Just x') else findM qry xs' + + +-- $utilities +-- #utilities# +-- Below are handy queries for use with 'nextMatch', 'nextMatchOrDo', +-- and 'nextMatchWithThis'. + +-- | A query that matches all windows on visible workspaces. This is +-- useful for configurations with multiple screens, and matches even +-- invisible windows. +isOnAnyVisibleWS :: Query Bool +isOnAnyVisibleWS = do + w <- ask + ws <- liftX $ gets windowset + let allVisible = concat $ maybe [] SS.integrate . SS.stack . SS.workspace <$> SS.current ws:SS.visible ws + visibleWs = w `elem` allVisible + unfocused = maybe True (w /=) $ SS.peek ws + return $ visibleWs && unfocused + diff --git a/XMonad/Doc/Extending.hs b/XMonad/Doc/Extending.hs --- a/XMonad/Doc/Extending.hs +++ b/XMonad/Doc/Extending.hs @@ -467,7 +467,7 @@ * "XMonad.Hooks.DebugStack": Dump the state of the StackSet. A logHook and handleEventHook are also provided. -* "Xmonad.Hooks.DynamicBars": +* "XMonad.Hooks.DynamicBars": Manage per-screen status bars. * "XMonad.Hooks.DynamicHooks": diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -29,12 +29,15 @@ import Data.List import Data.Maybe import Data.Monoid +import qualified Data.Map.Strict as M +import System.IO.Unsafe import XMonad import Control.Monad import qualified XMonad.StackSet as W import XMonad.Hooks.SetWMName +import qualified XMonad.Util.ExtensibleState as E import XMonad.Util.XUtils (fi) import XMonad.Util.WorkspaceCompare import XMonad.Util.WindowProperties (getProp32) @@ -70,7 +73,59 @@ -- of the current state of workspaces and windows. ewmhDesktopsLogHook :: X () ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id + -- | +-- Cached desktop names (e.g. @_NET_NUMBER_OF_DESKTOPS@ and +-- @_NET_DESKTOP_NAMES@). +newtype DesktopNames = DesktopNames [String] + deriving (Eq) + +instance ExtensionClass DesktopNames where + initialValue = DesktopNames [] + +-- | +-- Cached client list (e.g. @_NET_CLIENT_LIST@). +newtype ClientList = ClientList [Window] + deriving (Eq) + +instance ExtensionClass ClientList where + initialValue = ClientList [] + +-- | +-- Cached current desktop (e.g. @_NET_CURRENT_DESKTOP@). +newtype CurrentDesktop = CurrentDesktop Int + deriving (Eq) + +instance ExtensionClass CurrentDesktop where + initialValue = CurrentDesktop 0 + +-- | +-- Cached window-desktop assignments (e.g. @_NET_CLIENT_LIST_STACKING@). +newtype WindowDesktops = WindowDesktops (M.Map Window Int) + deriving (Eq) + +instance ExtensionClass WindowDesktops where + initialValue = WindowDesktops M.empty + +-- | +-- The value of @_NET_ACTIVE_WINDOW@, cached to avoid unnecessary property +-- updates. +newtype ActiveWindow = ActiveWindow Window + deriving (Eq) + +instance ExtensionClass ActiveWindow where + initialValue = ActiveWindow none + +-- | Compare the given value against the value in the extensible state. Run the +-- action if it has changed. +whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X () +whenChanged v action = do + v0 <- E.get + unless (v == v0) $ do + action + E.put v + +-- | -- Generalized version of ewmhDesktopsLogHook that allows an arbitrary -- user-specified function to transform the workspace list (post-sorting) ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X () @@ -78,28 +133,32 @@ sort' <- getSortByIndex let ws = f $ sort' $ W.workspaces s - -- Number of Workspaces - setNumberOfDesktops (length ws) - - -- Names thereof - setDesktopNames (map W.tag ws) + -- Set number of workspaces and names thereof + let desktopNames = map W.tag ws + whenChanged (DesktopNames desktopNames) $ do + setNumberOfDesktops (length desktopNames) + setDesktopNames desktopNames - -- all windows, with focused windows last - let wins = nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws - setClientList wins + -- Set client list; all windows, with focused windows last + let clientList = nub . concatMap (maybe [] (\(W.Stack x l r) -> reverse l ++ r ++ [x]) . W.stack) $ ws + whenChanged (ClientList clientList) $ setClientList clientList -- Remap the current workspace to handle any renames that f might be doing. let maybeCurrent' = W.tag <$> listToMaybe (f [W.workspace $ W.current s]) - maybeCurrent = join (flip elemIndex (map W.tag ws) <$> maybeCurrent') - - fromMaybe (return ()) $ setCurrentDesktop <$> maybeCurrent - - sequence_ $ zipWith setWorkspaceWindowDesktops [0..] ws - - setActiveWindow + current = join (flip elemIndex (map W.tag ws) <$> maybeCurrent') + whenChanged (CurrentDesktop $ fromMaybe 0 current) $ do + mapM_ setCurrentDesktop current - return () + -- Set window-desktop mapping + let windowDesktops = + let f wsId workspace = M.fromList [ (winId, wsId) | winId <- W.integrate' $ W.stack workspace ] + in M.unions $ zipWith f [0..] ws + whenChanged (WindowDesktops windowDesktops) $ do + mapM_ (uncurry setWindowDesktop) (M.toList windowDesktops) + -- Set active window + let activeWindow' = fromMaybe none (W.peek s) + whenChanged (ActiveWindow activeWindow') $ setActiveWindow activeWindow' -- | -- Intercepts messages from pagers and similar applications and reacts on them. @@ -221,10 +280,6 @@ a' <- getAtom "_NET_CLIENT_LIST_STACKING" io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins) -setWorkspaceWindowDesktops :: (Integral a) => a -> WindowSpace -> X() -setWorkspaceWindowDesktops index workspace = - mapM_ (flip setWindowDesktop index) (W.integrate' $ W.stack workspace) - setWindowDesktop :: (Integral a) => Window -> a -> X () setWindowDesktop win i = withDisplay $ \dpy -> do a <- getAtom "_NET_WM_DESKTOP" @@ -250,9 +305,8 @@ setWMName "xmonad" -setActiveWindow :: X () -setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do - let w = fromMaybe none (W.peek s) +setActiveWindow :: Window -> X () +setActiveWindow w = withDisplay $ \dpy -> do r <- asks theRoot a <- getAtom "_NET_ACTIVE_WINDOW" c <- getAtom "WINDOW" diff --git a/XMonad/Hooks/RefocusLast.hs b/XMonad/Hooks/RefocusLast.hs new file mode 100644 --- /dev/null +++ b/XMonad/Hooks/RefocusLast.hs @@ -0,0 +1,295 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, MultiWayIf #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.RefocusLast +-- Description : Hooks and actions to refocus the previous window. +-- Copyright : (c) 2018 L. S. Leary +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : L. S. Leary +-- Stability : unstable +-- Portability : unportable +-- +-- Provides hooks and actions that keep track of recently focused windows on a +-- per workspace basis and automatically refocus the last window on loss of the +-- current (if appropriate as determined by user specified criteria). +-------------------------------------------------------------------------------- + +-- --< Imports & Exports >-- {{{ + +module XMonad.Hooks.RefocusLast ( + -- * Usage + -- $Usage + -- * Hooks + refocusLastLogHook, + refocusLastLayoutHook, + refocusLastWhen, + -- ** Predicates + -- $Predicates + refocusingIsActive, + isFloat, + -- * Actions + toggleRefocusing, + toggleFocus, + swapWithLast, + refocusWhen, + shiftRLWhen, + updateRecentsOn, + -- * Types + -- $Types + RecentWins(..), + RecentsMap(..), + RefocusLastLayoutHook(..), + RefocusLastToggle(..) +) where + +import XMonad +import qualified XMonad.StackSet as W +import qualified XMonad.Util.ExtensibleState as XS +import XMonad.Util.Stack (findS, mapZ_) +import XMonad.Layout.LayoutModifier + +import Data.Maybe (fromMaybe) +import Data.Monoid (All(..)) +import Data.Foldable (asum) +import qualified Data.Map.Strict as M +import Control.Monad (when) + +-- }}} + +-- --< Usage >-- {{{ + +-- $Usage +-- To use this module, you must either include 'refocusLastLogHook' in your log +-- hook __or__ 'refocusLastLayoutHook' in your layout hook; don't use both. +-- This suffices to make use of both 'toggleFocus' and 'shiftRLWhen' but will +-- not refocus automatically upon loss of the current window; for that you must +-- include in your event hook @'refocusLastWhen' pred@ for some valid @pred@. +-- +-- The event hooks that trigger refocusing only fire when a window is lost +-- completely, not when it's simply e.g. moved to another workspace. Hence you +-- will need to use @'shiftRLWhen' pred@ or @'refocusWhen' pred@ as appropriate +-- if you want the same behaviour in such cases. +-- +-- Example configuration: +-- +-- > import XMonad +-- > import XMonad.Hooks.RefocusLast +-- > import qualified Data.Map.Strict as M +-- > +-- > main :: IO () +-- > main = xmonad def +-- > { handleEventHook = refocusLastWhen myPred <+> handleEventHook def +-- > , logHook = refocusLastLogHook <+> logHook def +-- > -- , layoutHook = refocusLastLayoutHook $ layoutHook def +-- > , keys = refocusLastKeys <+> keys def +-- > } where +-- > myPred = refocusingIsActive <||> isFloat +-- > refocusLastKeys cnf +-- > = M.fromList +-- > $ ((modMask cnf , xK_a), toggleFocus) +-- > : ((modMask cnf .|. shiftMask, xK_a), swapWithLast) +-- > : ((modMask cnf , xK_b), toggleRefocusing) +-- > : [ ( (modMask cnf .|. shiftMask, n) +-- > , windows =<< shiftRLWhen myPred wksp +-- > ) +-- > | (n, wksp) <- zip [xK_1..xK_9] (workspaces cnf) +-- > ] +-- + +-- }}} + +-- --< Types >-- {{{ + +-- $Types +-- The types and constructors used in this module are exported principally to +-- aid extensibility; typical users will have nothing to gain from this section. + +-- | Data type holding onto the previous and current @Window@. +data RecentWins = Recent { previous :: !Window, current :: !Window } + deriving (Show, Read, Eq) + +-- | Newtype wrapper for a @Map@ holding the @RecentWins@ for each workspace. +-- Is an instance of @ExtensionClass@ with persistence of state. +newtype RecentsMap = RecentsMap (M.Map WorkspaceId RecentWins) + deriving (Show, Read, Eq, Typeable) + +instance ExtensionClass RecentsMap where + initialValue = RecentsMap M.empty + extensionType = PersistentExtension + +-- | A 'LayoutModifier' that updates the 'RecentWins' for a workspace upon +-- relayout. +data RefocusLastLayoutHook a = RefocusLastLayoutHook + deriving (Show, Read) + +instance LayoutModifier RefocusLastLayoutHook a where + modifyLayout _ w@(W.Workspace tg _ _) r = updateRecentsOn tg >> runLayout w r + +-- | A newtype on @Bool@ to act as a universal toggle for refocusing. +newtype RefocusLastToggle = RefocusLastToggle { refocusing :: Bool } + deriving (Show, Read, Eq, Typeable) + +instance ExtensionClass RefocusLastToggle where + initialValue = RefocusLastToggle { refocusing = True } + extensionType = PersistentExtension + +-- }}} + +-- --< Public Hooks >-- {{{ + +-- | A log hook recording the current workspace's most recently focused windows +-- into extensible state. +refocusLastLogHook :: X () +refocusLastLogHook = withWindowSet (updateRecentsOn . W.currentTag) + +-- | Records a workspace's recently focused windows into extensible state upon +-- relayout. Potentially a less wasteful alternative to @refocusLastLogHook@, +-- as it does not run on @WM_NAME@ @propertyNotify@ events. +refocusLastLayoutHook :: l a -> ModifiedLayout RefocusLastLayoutHook l a +refocusLastLayoutHook = ModifiedLayout RefocusLastLayoutHook + +-- | Given a predicate on the event window determining whether or not to act, +-- construct an event hook that runs iff the core xmonad event handler will +-- unmanage the window, and which shifts focus to the last focused window on +-- the appropriate workspace if desired. +refocusLastWhen :: Query Bool -> Event -> X All +refocusLastWhen p event = All True <$ case event of + UnmapEvent { ev_send_event = synth, ev_window = w } -> do + e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap) + when (synth || e == 0) (refocusLast w) + DestroyWindowEvent { ev_window = w } -> refocusLast w + _ -> return () + where + refocusLast w = whenX (runQuery p w) . withWindowSet $ \ws -> + whenJust (W.findTag w ws) $ \tag -> + withRecentsIn tag () $ \lw cw -> + when (w == cw) . modify $ \xs -> + xs { windowset = tryFocusIn tag [lw] ws } + +-- }}} + +-- --< Predicates >-- {{{ + +-- $Predicates +-- Impure @Query Bool@ predicates on event windows for use as arguments to +-- 'refocusLastWhen', 'shiftRLWhen' and 'refocusWhen'. Can be combined with +-- '<||>' or '<&&>'. Use like e.g. +-- +-- > , handleEventHook = refocusLastWhen refocusingIsActive +-- +-- or in a keybinding: +-- +-- > windows =<< shiftRLWhen (refocusingIsActive <&&> isFloat) "3" +-- +-- It's also valid to use a property lookup like @className =? "someProgram"@ as +-- a predicate, and it should function as expected with e.g. @shiftRLWhen@. +-- In the event hook on the other hand, the window in question has already been +-- unmapped or destroyed, so external lookups to X properties don't work: +-- only the information fossilised in xmonad's state is available. + +-- | Holds iff refocusing is toggled active. +refocusingIsActive :: Query Bool +refocusingIsActive = (liftX . XS.gets) refocusing + +-- | Holds iff the event window is a float. +isFloat :: Query Bool +isFloat = ask >>= \w -> (liftX . gets) (M.member w . W.floating . windowset) + +-- }}} + +-- --< Public Actions >-- {{{ + +-- | Toggle automatic refocusing at runtime. Has no effect unless the +-- @refocusingIsActive@ predicate has been used. +toggleRefocusing :: X () +toggleRefocusing = XS.modify (RefocusLastToggle . not . refocusing) + +-- | Refocuses the previously focused window; acts as a toggle. +-- Is not affected by @toggleRefocusing@. +toggleFocus :: X () +toggleFocus = withRecents $ \lw cw -> + when (cw /= lw) . windows $ tryFocus [lw] + +-- | Swaps the current and previous windows of the current workspace. +-- Is not affected by @toggleRefocusing@. +swapWithLast :: X () +swapWithLast = withRecents $ \lw cw -> + when (cw /= lw) . windows . modify''. mapZ_ $ \w -> + if | (w == lw) -> cw + | (w == cw) -> lw + | otherwise -> w + where modify'' f = W.modify (f Nothing) (f . Just) + +-- | Given a target workspace and a predicate on its current window, produce a +-- 'windows' suitable function that will refocus that workspace appropriately. +-- Allows you to hook refocusing into any action you can run through +-- @windows@. See the implementation of @shiftRLWhen@ for a straight-forward +-- usage example. +refocusWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet) +refocusWhen p tag = withRecentsIn tag id $ \lw cw -> do + b <- runQuery p cw + return (if b then tryFocusIn tag [cw, lw] else id) + +-- | Sends the focused window to the specified workspace, refocusing the last +-- focused window if the predicate holds on the current window. Note that the +-- native version of this, @windows . W.shift@, has a nice property that this +-- does not: shifting a window to another workspace then shifting it back +-- preserves its place in the stack. Can be used in a keybinding like e.g. +-- +-- > windows =<< shiftRLWhen refocusingIsActive "3" +-- +-- or +-- +-- > (windows <=< shiftRLWhen refocusingIsActive) "3" +-- +-- where '<=<' is imported from "Control.Monad". +shiftRLWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet) +shiftRLWhen p to = withWindowSet $ \ws -> do + refocus <- refocusWhen p (W.currentTag ws) + let shift = maybe id (W.shiftWin to) (W.peek ws) + return (refocus . shift) + +-- | Perform an update to the 'RecentWins' for the specified workspace. +-- The RefocusLast log and layout hooks are both implemented trivially in +-- terms of this function. Only exported to aid extensibility. +updateRecentsOn :: WorkspaceId -> X () +updateRecentsOn tag = withWindowSet $ \ws -> + whenJust (W.peek $ W.view tag ws) $ \fw -> do + m <- getRecentsMap + let insertRecent l c = XS.put . RecentsMap $ M.insert tag (Recent l c) m + case M.lookup tag m of + Just (Recent _ cw) -> when (cw /= fw) (insertRecent cw fw) + Nothing -> insertRecent fw fw + +-- }}} + +-- --< Private Utilities >-- {{{ + +-- | Focuses the first window in the list it can find on the current workspace. +tryFocus :: [Window] -> WindowSet -> WindowSet +tryFocus wins = W.modify' $ \s -> + fromMaybe s . asum $ (\w -> findS (== w) s) <$> wins + +-- | Operate the above on a specified workspace. +tryFocusIn :: WorkspaceId -> [Window] -> WindowSet -> WindowSet +tryFocusIn tag wins ws = + W.view (W.currentTag ws) . tryFocus wins . W.view tag $ ws + +-- | Get the RecentsMap out of extensible state and remove its newtype wrapper. +getRecentsMap :: X (M.Map WorkspaceId RecentWins) +getRecentsMap = XS.get >>= \(RecentsMap m) -> return m + +-- | Perform an X action dependent on successful lookup of the RecentWins for +-- the specified workspace, or return a default value. +withRecentsIn :: WorkspaceId -> a -> (Window -> Window -> X a) -> X a +withRecentsIn tag dflt f = M.lookup tag <$> getRecentsMap + >>= maybe (return dflt) (\(Recent lw cw) -> f lw cw) + +-- | The above specialised to the current workspace and unit. +withRecents :: (Window -> Window -> X ()) -> X () +withRecents f = withWindowSet $ \ws -> withRecentsIn (W.currentTag ws) () f + +-- }}} + diff --git a/XMonad/Hooks/WallpaperSetter.hs b/XMonad/Hooks/WallpaperSetter.hs --- a/XMonad/Hooks/WallpaperSetter.hs +++ b/XMonad/Hooks/WallpaperSetter.hs @@ -221,7 +221,7 @@ res <- getPicRes path return $ case needsRotation rect <$> res of Nothing -> "" - Just rotate -> + Just rotate -> let size = show (rect_width rect) ++ "x" ++ show (rect_height rect) in " \\( '"++path++"' "++(if rotate then "-rotate 90 " else "") - ++ " -scale "++(show$rect_width rect)++"x"++(show$rect_height rect)++"! \\)" + ++ " -scale "++size++"^ -gravity center -extent "++size++" +gravity \\)" ++ " -geometry +"++(show$rect_x rect)++"+"++(show$rect_y rect)++" -composite " diff --git a/XMonad/Layout/BinarySpacePartition.hs b/XMonad/Layout/BinarySpacePartition.hs --- a/XMonad/Layout/BinarySpacePartition.hs +++ b/XMonad/Layout/BinarySpacePartition.hs @@ -6,6 +6,7 @@ -- Module : XMonad.Layout.BinarySpacePartition -- Copyright : (c) 2013 Ben Weitzman -- 2015 Anton Pirogov +-- 2019 Mateusz Karbowy @@ -29,6 +30,7 @@ , FocusParent(..) , SelectMoveNode(..) , Direction2D(..) + , SplitShiftDirectional(..) ) where import XMonad @@ -66,19 +68,21 @@ -- -- If you don't want to use the mouse, add the following key bindings to resize the splits with the keyboard: -- --- > , ((modm .|. altMask, xK_l ), sendMessage $ ExpandTowards R) --- > , ((modm .|. altMask, xK_h ), sendMessage $ ExpandTowards L) --- > , ((modm .|. altMask, xK_j ), sendMessage $ ExpandTowards D) --- > , ((modm .|. altMask, xK_k ), sendMessage $ ExpandTowards U) --- > , ((modm .|. altMask .|. ctrlMask , xK_l ), sendMessage $ ShrinkFrom R) --- > , ((modm .|. altMask .|. ctrlMask , xK_h ), sendMessage $ ShrinkFrom L) --- > , ((modm .|. altMask .|. ctrlMask , xK_j ), sendMessage $ ShrinkFrom D) --- > , ((modm .|. altMask .|. ctrlMask , xK_k ), sendMessage $ ShrinkFrom U) --- > , ((modm, xK_r ), sendMessage Rotate) --- > , ((modm, xK_s ), sendMessage Swap) --- > , ((modm, xK_n ), sendMessage FocusParent) --- > , ((modm .|. ctrlMask, xK_n ), sendMessage SelectNode) --- > , ((modm .|. shiftMask, xK_n ), sendMessage MoveNode) +-- > , ((modm .|. altMask, xK_l ), sendMessage $ ExpandTowards R) +-- > , ((modm .|. altMask, xK_h ), sendMessage $ ExpandTowards L) +-- > , ((modm .|. altMask, xK_j ), sendMessage $ ExpandTowards D) +-- > , ((modm .|. altMask, xK_k ), sendMessage $ ExpandTowards U) +-- > , ((modm .|. altMask .|. ctrlMask , xK_l ), sendMessage $ ShrinkFrom R) +-- > , ((modm .|. altMask .|. ctrlMask , xK_h ), sendMessage $ ShrinkFrom L) +-- > , ((modm .|. altMask .|. ctrlMask , xK_j ), sendMessage $ ShrinkFrom D) +-- > , ((modm .|. altMask .|. ctrlMask , xK_k ), sendMessage $ ShrinkFrom U) +-- > , ((modm, xK_r ), sendMessage Rotate) +-- > , ((modm, xK_s ), sendMessage Swap) +-- > , ((modm, xK_n ), sendMessage FocusParent) +-- > , ((modm .|. ctrlMask, xK_n ), sendMessage SelectNode) +-- > , ((modm .|. shiftMask, xK_n ), sendMessage MoveNode) +-- > , ((modm .|. shiftMask .|. ctrlMask , xK_j ), sendMessage $ SplitShift Prev) +-- > , ((modm .|. shiftMask .|. ctrlMask , xK_k ), sendMessage $ SplitShift Next) -- -- Here's an alternative key mapping, this time using additionalKeysP, -- arrow keys, and slightly different behavior when resizing windows @@ -92,7 +96,9 @@ -- > , ("M-M1-C-", sendMessage $ ShrinkFrom D) -- > , ("M-M1-C-", sendMessage $ ExpandTowards D) -- > , ("M-s", sendMessage $ BSP.Swap) --- > , ("M-M1-s", sendMessage $ Rotate) ] +-- > , ("M-M1-s", sendMessage $ Rotate) +-- > , ("M-S-C-j", sendMessage $ SplitShift Prev) +-- > , ("M-S-C-k", sendMessage $ SplitShift Next) -- -- If you have many windows open and the layout begins to look too hard to manage, you can 'Balance' -- the layout, so that the current splittings are discarded and windows are tiled freshly in a way that @@ -133,6 +139,10 @@ data Axis = Horizontal | Vertical deriving (Show, Read, Eq) +-- |Message for shifting window by splitting its neighbour +data SplitShiftDirectional = SplitShift Direction1D deriving Typeable +instance Message SplitShiftDirectional + oppositeDirection :: Direction2D -> Direction2D oppositeDirection U = D oppositeDirection D = U @@ -273,6 +283,42 @@ swapCurrent l@(_, []) = Just l swapCurrent (n, c:cs) = Just (n, swapCrumb c:cs) +insertLeftLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split) +insertLeftLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Node x l r), crumb:cs) +insertLeftLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Leaf x), crumb:cs) +insertLeftLeaf (Node _ _ _) z = Just z + +insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split) +insertRightLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Node x l r) (Leaf n), crumb:cs) +insertRightLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf x) (Leaf n), crumb:cs) +insertRightLeaf (Node _ _ _) z = Just z + +findRightLeaf :: Zipper Split -> Maybe (Zipper Split) +findRightLeaf n@(Node _ _ _, _) = goRight n >>= findRightLeaf +findRightLeaf l@(Leaf _, _) = Just l + +findLeftLeaf :: Zipper Split -> Maybe (Zipper Split) +findLeftLeaf n@(Node _ _ _, _) = goLeft n +findLeftLeaf l@(Leaf _, _) = Just l + +findTheClosestLeftmostLeaf :: Zipper Split -> Maybe (Zipper Split) +findTheClosestLeftmostLeaf s@(_, (RightCrumb _ _):_) = goUp s >>= goLeft >>= findRightLeaf +findTheClosestLeftmostLeaf s@(_, (LeftCrumb _ _):_) = goUp s >>= findTheClosestLeftmostLeaf + +findTheClosestRightmostLeaf :: Zipper Split -> Maybe (Zipper Split) +findTheClosestRightmostLeaf s@(_, (RightCrumb _ _):_) = goUp s >>= findTheClosestRightmostLeaf +findTheClosestRightmostLeaf s@(_, (LeftCrumb _ _):_) = goUp s >>= goRight >>= findLeftLeaf + +splitShiftLeftCurrent :: Zipper Split -> Maybe (Zipper Split) +splitShiftLeftCurrent l@(_, []) = Just l +splitShiftLeftCurrent l@(_, (RightCrumb _ _):_) = Just l -- Do nothing. We can swap windows instead. +splitShiftLeftCurrent l@(n, c:cs) = removeCurrent l >>= findTheClosestLeftmostLeaf >>= insertRightLeaf n + +splitShiftRightCurrent :: Zipper Split -> Maybe (Zipper Split) +splitShiftRightCurrent l@(_, []) = Just l +splitShiftRightCurrent l@(_, (LeftCrumb _ _):_) = Just l -- Do nothing. We can swap windows instead. +splitShiftRightCurrent l@(n, c:cs) = removeCurrent l >>= findTheClosestRightmostLeaf >>= insertLeftLeaf n + isAllTheWay :: Direction2D -> Zipper Split -> Bool isAllTheWay _ (_, []) = True isAllTheWay R (_, LeftCrumb s _:_) @@ -513,6 +559,12 @@ swapNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b swapNth b = doToNth swapCurrent b +splitShiftNth :: Direction1D -> BinarySpacePartition a -> BinarySpacePartition a +splitShiftNth _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP +splitShiftNth _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b +splitShiftNth Prev b = doToNth splitShiftLeftCurrent b +splitShiftNth Next b = doToNth splitShiftRightCurrent b + growNthTowards :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a growNthTowards _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP growNthTowards _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b @@ -687,6 +739,7 @@ , fmap rotateTr (fromMessage m) , fmap (balanceTr r) (fromMessage m) , fmap move (fromMessage m) + , fmap splitShift (fromMessage m) ] resize (ExpandTowards dir) = growNthTowards dir b resize (ShrinkFrom dir) = shrinkNthFrom dir b @@ -699,6 +752,7 @@ balanceTr r Balance = resetFoc $ rebalanceNth b r move MoveNode = resetFoc $ moveNode b move SelectNode = b --should not happen here, is done above, as we need X monad + splitShift (SplitShift dir) = resetFoc $ splitShiftNth dir b b = numerateLeaves b_orig resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf=(-1)} diff --git a/XMonad/Layout/Decoration.hs b/XMonad/Layout/Decoration.hs --- a/XMonad/Layout/Decoration.hs +++ b/XMonad/Layout/Decoration.hs @@ -68,18 +68,21 @@ -- -- For a collection of 'Theme's see "XMonad.Util.Themes" data Theme = - Theme { activeColor :: String -- ^ Color of the active window - , inactiveColor :: String -- ^ Color of the inactive window - , urgentColor :: String -- ^ Color of the urgent window - , activeBorderColor :: String -- ^ Color of the border of the active window - , inactiveBorderColor :: String -- ^ Color of the border of the inactive window - , urgentBorderColor :: String -- ^ Color of the border of the urgent window - , activeTextColor :: String -- ^ Color of the text of the active window - , inactiveTextColor :: String -- ^ Color of the text of the inactive window - , urgentTextColor :: String -- ^ Color of the text of the urgent window - , fontName :: String -- ^ Font name - , decoWidth :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle') - , decoHeight :: Dimension -- ^ Height of the decorations + Theme { activeColor :: String -- ^ Color of the active window + , inactiveColor :: String -- ^ Color of the inactive window + , urgentColor :: String -- ^ Color of the urgent window + , activeBorderColor :: String -- ^ Color of the border of the active window + , inactiveBorderColor :: String -- ^ Color of the border of the inactive window + , urgentBorderColor :: String -- ^ Color of the border of the urgent window + , activeBorderWidth :: Dimension -- ^ Width of the border of the active window + , inactiveBorderWidth :: Dimension -- ^ Width of the border of the inactive window + , urgentBorderWidth :: Dimension -- ^ Width of the border of the urgent window + , activeTextColor :: String -- ^ Color of the text of the active window + , inactiveTextColor :: String -- ^ Color of the text of the inactive window + , urgentTextColor :: String -- ^ Color of the text of the urgent window + , fontName :: String -- ^ Font name + , decoWidth :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle') + , decoHeight :: Dimension -- ^ Height of the decorations , windowTitleAddons :: [(String, Align)] -- ^ Extra text to appear in a window's title bar. -- Refer to for a use "XMonad.Layout.ImageButtonDecoration" , windowTitleIcons :: [([[Bool]], Placement)] -- ^ Extra icons to appear in a window's title bar. @@ -94,6 +97,9 @@ , activeBorderColor = "#FFFFFF" , inactiveBorderColor = "#BBBBBB" , urgentBorderColor = "##00FF00" + , activeBorderWidth = 1 + , inactiveBorderWidth = 1 + , urgentBorderWidth = 1 , activeTextColor = "#FFFFFF" , inactiveTextColor = "#BFBFBF" , urgentTextColor = "#FF0000" @@ -395,9 +401,10 @@ | win `elem` ur -> uc | otherwise -> ic) . W.peek) `fmap` gets windowset - (bc,borderc,tc) <- focusColor w (inactiveColor t, inactiveBorderColor t, inactiveTextColor t) - (activeColor t, activeBorderColor t, activeTextColor t) - (urgentColor t, urgentBorderColor t, urgentTextColor t) + (bc,borderc,borderw,tc) <- + focusColor w (inactiveColor t, inactiveBorderColor t, inactiveBorderWidth t, inactiveTextColor t) + (activeColor t, activeBorderColor t, activeBorderWidth t, activeTextColor t) + (urgentColor t, urgentBorderColor t, urgentBorderWidth t, urgentTextColor t) let s = shrinkIt sh name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw) @@ -405,7 +412,7 @@ strs = name : map fst (windowTitleAddons t) i_als = map snd (windowTitleIcons t) icons = map fst (windowTitleIcons t) - paintTextAndIcons dw fs wh ht 1 bc borderc tc bc als strs i_als icons + paintTextAndIcons dw fs wh ht borderw bc borderc tc bc als strs i_als icons updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w updateDeco _ _ _ _ = return () diff --git a/XMonad/Layout/LayoutCombinators.hs b/XMonad/Layout/LayoutCombinators.hs --- a/XMonad/Layout/LayoutCombinators.hs +++ b/XMonad/Layout/LayoutCombinators.hs @@ -214,7 +214,7 @@ -- layouts, and use those. -- -- For the ability to select a layout from a prompt, see --- "Xmonad.Prompt.Layout". +-- "XMonad.Prompt.Layout". -- | A reimplementation of the combinator of the same name from the -- xmonad core, providing layout choice, and the ability to support diff --git a/XMonad/Layout/Tabbed.hs b/XMonad/Layout/Tabbed.hs --- a/XMonad/Layout/Tabbed.hs +++ b/XMonad/Layout/Tabbed.hs @@ -226,8 +226,12 @@ ny = n y hh upperTab = Rectangle nx y wid (fi ht) lowerTab = Rectangle nx (y + fi (hh - ht)) wid (fi ht) - leftTab = Rectangle x ny (fi wt) hid - rightTab = Rectangle (x + fi (wh - wt)) ny (fi wt) hid + fixHeightLoc i = y + fi (((fi ht) * fi i)) + fixHeightTab k = Rectangle k + (maybe y (fixHeightLoc) + $ w `elemIndex` ws) (fi wt) (fi ht) + rightTab = fixHeightTab (x + fi (wh - wt)) + leftTab = fixHeightTab x numWindows = length ws shrink (Tabbed loc _ ) (Rectangle _ _ dw dh) (Rectangle x y w h) = case loc of diff --git a/XMonad/Layout/TwoPanePersistent.hs b/XMonad/Layout/TwoPanePersistent.hs new file mode 100644 --- /dev/null +++ b/XMonad/Layout/TwoPanePersistent.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.TwoPanePersistent +-- Copyright : (c) Chayanon Wichitrnithed +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Chayanon Wichitrnithed +-- Stability : unstable +-- Portability : unportable +-- +-- This layout is the same as "XMonad.Layout.TwoPane" except that it keeps track of the slave window +-- that is alongside the master pane. In other words, it prevents the slave pane +-- from changing after the focus goes back to the master pane. + +----------------------------------------------------------------------------- + + +module XMonad.Layout.TwoPanePersistent + ( + -- * Usage + -- $usage + TwoPanePersistent(..) + ) where + +import XMonad.StackSet (focus, up, down, Stack, Stack(..)) +import XMonad hiding (focus) + +-- $usage +-- Import the module in @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.TwoPanePersistent +-- +-- Then add the layout to the @layoutHook@: +-- +-- > myLayout = TwoPanePersistent Nothing (3/100) (1/2) ||| Full ||| etc.. +-- > main = xmonad def { layoutHook = myLayout } + + +data TwoPanePersistent a = TwoPanePersistent + { slaveWin :: (Maybe a) -- ^ slave window; if 'Nothing' or not in the current workspace, + -- the window below the master will go into the slave pane + , dFrac :: Rational -- ^ shrink/expand size + , mFrac :: Rational -- ^ initial master size + } deriving (Show, Read) + + +instance (Show a, Eq a) => LayoutClass TwoPanePersistent a where + doLayout l r s = + case reverse (up s) of + -- master is focused + [] -> return $ focusedMaster l s r + + -- slave is focused + (master:_) -> return $ focusedSlave l s r master + + + pureMessage (TwoPanePersistent w delta split) x = + case fromMessage x of + Just Shrink -> Just (TwoPanePersistent w delta (split - delta)) + Just Expand -> Just (TwoPanePersistent w delta (split + delta)) + _ -> Nothing + + description _ = "TwoPanePersistent" + + +---------------------------------------------------------------------------------------- + +focusedMaster :: (Eq a) => TwoPanePersistent a -> Stack a -> Rectangle + -> ( [(a, Rectangle)], Maybe (TwoPanePersistent a) ) +focusedMaster (TwoPanePersistent w delta split) s r = + let (left, right) = splitHorizontallyBy split r in + case down s of + -- there exist windows below the master + (next:_) -> let nextSlave = ( [(focus s, left), (next, right)] + , Just $ TwoPanePersistent (Just next) delta split ) + in case w of + -- if retains state, preserve the layout + Just win -> if win `elem` (down s) && (focus s /= win) + then ( [(focus s, left), (win, right)] + , Just $ TwoPanePersistent w delta split ) + else nextSlave + -- if no previous state, default to the next slave window + Nothing -> nextSlave + + + -- the master is the only window + [] -> ( [(focus s, r)] + , Just $ TwoPanePersistent Nothing delta split ) + + + +focusedSlave :: TwoPanePersistent a -> Stack a -> Rectangle -> a + -> ( [(a, Rectangle)], Maybe (TwoPanePersistent a) ) +focusedSlave (TwoPanePersistent _ delta split) s r m = + ( [(m, left), (focus s, right)] + , Just $ TwoPanePersistent (Just $ focus s) delta split ) + where (left, right) = splitHorizontallyBy split r diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -4,1130 +4,1586 @@ -- | -- Module : XMonad.Prompt -- Copyright : (C) 2007 Andrea Rossato, 2015 Evgeny Kurnevsky --- 2015 Sibi Prabakaran --- License : BSD3 --- --- Maintainer : Spencer Janssen --- Stability : unstable --- Portability : unportable --- --- A module for writing graphical prompts for XMonad --- ------------------------------------------------------------------------------ - -module XMonad.Prompt - ( -- * Usage - -- $usage - mkXPrompt - , mkXPromptWithReturn - , mkXPromptWithModes - , def - , amberXPConfig - , defaultXPConfig - , greenXPConfig - , XPMode - , XPType (..) - , XPPosition (..) - , XPConfig (..) - , XPrompt (..) - , XP - , defaultXPKeymap, defaultXPKeymap' - , emacsLikeXPKeymap, emacsLikeXPKeymap' - , quit - , killBefore, killAfter, startOfLine, endOfLine - , insertString, pasteString, moveCursor - , setInput, getInput - , moveWord, moveWord', killWord, killWord', deleteString - , moveHistory, setSuccess, setDone - , Direction1D(..) - , ComplFunction - -- * X Utilities - -- $xutils - , mkUnmanagedWindow - , fillDrawable - -- * Other Utilities - -- $utils - , mkComplFunFromList - , mkComplFunFromList' - -- * @nextCompletion@ implementations - , getNextOfLastWord - , getNextCompletion - -- * List utilities - , getLastWord - , skipLastWord - , splitInSubListsAt - , breakAtSpace - , uniqSort - , historyCompletion - , historyCompletionP - -- * History filters - , deleteAllDuplicates - , deleteConsecutive - , HistoryMatches - , initMatches - , historyUpMatching - , historyDownMatching - -- * Types - , XPState - ) where - -import XMonad hiding (cleanMask, config) -import qualified XMonad as X (numberlockMask) -import qualified XMonad.StackSet as W -import XMonad.Util.Font -import XMonad.Util.Types -import XMonad.Util.XSelection (getSelection) - -import Codec.Binary.UTF8.String (decodeString,isUTF8Encoded) -import Control.Applicative ((<$>)) -import Control.Arrow (first, (&&&), (***)) -import Control.Concurrent (threadDelay) -import Control.Exception.Extensible as E hiding (handle) -import Control.Monad.State -import Data.Bits -import Data.Char (isSpace) -import Data.IORef -import Data.List -import qualified Data.Map as M -import Data.Maybe (fromMaybe) -import Data.Set (fromList, toList) -import System.IO -import System.Posix.Files - --- $usage --- For usage examples see "XMonad.Prompt.Shell", --- "XMonad.Prompt.XMonad" or "XMonad.Prompt.Ssh" --- --- TODO: --- --- * scrolling the completions that don't fit in the window (?) - -type XP = StateT XPState IO - -data XPState = - XPS { dpy :: Display - , rootw :: !Window - , win :: !Window - , screen :: !Rectangle - , complWin :: Maybe Window - , complWinDim :: Maybe ComplWindowDim - , complIndex :: !(Int,Int) - , showComplWin :: Bool - , operationMode :: XPOperationMode - , highlightedCompl :: Maybe String - , gcon :: !GC - , fontS :: !XMonadFont - , commandHistory :: W.Stack String - , offset :: !Int - , config :: XPConfig - , successful :: Bool - , numlockMask :: KeyMask - , done :: Bool - } - -data XPConfig = - XPC { font :: String -- ^ Font. For TrueType fonts, use something like - -- @"xft:Hack:pixelsize=1"@. Alternatively, use X Logical Font - -- Description, i.e. something like - -- @"-*-dejavu sans mono-medium-r-normal--*-80-*-*-*-*-iso10646-1"@. - , bgColor :: String -- ^ Background color - , fgColor :: String -- ^ Font color - , fgHLight :: String -- ^ Font color of a highlighted completion entry - , bgHLight :: String -- ^ Background color of a highlighted completion entry - , borderColor :: String -- ^ Border color - , promptBorderWidth :: !Dimension -- ^ Border width - , position :: XPPosition -- ^ Position: 'Top', 'Bottom', or 'CenteredAt' - , alwaysHighlight :: !Bool -- ^ Always highlight an item, overriden to True with multiple modes. This implies having *one* column of autocompletions only. - , height :: !Dimension -- ^ Window height - , maxComplRows :: Maybe Dimension - -- ^ Just x: maximum number of rows to show in completion window - , historySize :: !Int -- ^ The number of history entries to be saved - , historyFilter :: [String] -> [String] - -- ^ a filter to determine which - -- history entries to remember - , promptKeymap :: M.Map (KeyMask,KeySym) (XP ()) - -- ^ Mapping from key combinations to actions - , completionKey :: (KeyMask, KeySym) -- ^ Key that should trigger completion - , changeModeKey :: KeySym -- ^ Key to change mode (when the prompt has multiple modes) - , defaultText :: String -- ^ The text by default in the prompt line - , autoComplete :: Maybe Int -- ^ Just x: if only one completion remains, auto-select it, - -- and delay by x microseconds - , showCompletionOnTab :: Bool -- ^ Only show list of completions when Tab was pressed - , searchPredicate :: String -> String -> Bool - -- ^ Given the typed string and a possible - -- completion, is the completion valid? - } - -data XPType = forall p . XPrompt p => XPT p -type ComplFunction = String -> IO [String] -type XPMode = XPType -data XPOperationMode = XPSingleMode ComplFunction XPType | XPMultipleModes (W.Stack XPType) - -instance Show XPType where - show (XPT p) = showXPrompt p - -instance XPrompt XPType where - showXPrompt = show - nextCompletion (XPT t) = nextCompletion t - commandToComplete (XPT t) = commandToComplete t - completionToCommand (XPT t) = completionToCommand t - completionFunction (XPT t) = completionFunction t - modeAction (XPT t) = modeAction t - --- | The class prompt types must be an instance of. In order to --- create a prompt you need to create a data type, without parameters, --- and make it an instance of this class, by implementing a simple --- method, 'showXPrompt', which will be used to print the string to be --- displayed in the command line window. --- --- This is an example of a XPrompt instance definition: --- --- > instance XPrompt Shell where --- > showXPrompt Shell = "Run: " -class XPrompt t where - - -- | This method is used to print the string to be - -- displayed in the command line window. - showXPrompt :: t -> String - - -- | This method is used to generate the next completion to be - -- printed in the command line when tab is pressed, given the - -- string presently in the command line and the list of - -- completion. - -- This function is not used when in multiple modes (because alwaysHighlight in XPConfig is True) - nextCompletion :: t -> String -> [String] -> String - nextCompletion = getNextOfLastWord - - -- | This method is used to generate the string to be passed to - -- the completion function. - commandToComplete :: t -> String -> String - commandToComplete _ = getLastWord - - -- | This method is used to process each completion in order to - -- generate the string that will be compared with the command - -- presently displayed in the command line. If the prompt is using - -- 'getNextOfLastWord' for implementing 'nextCompletion' (the - -- default implementation), this method is also used to generate, - -- from the returned completion, the string that will form the - -- next command line when tab is pressed. - completionToCommand :: t -> String -> String - completionToCommand _ c = c - - -- | When the prompt has multiple modes, this is the function - -- used to generate the autocompletion list. - -- The argument passed to this function is given by `commandToComplete` - -- The default implementation shows an error message. - completionFunction :: t -> ComplFunction - completionFunction t = \_ -> return ["Completions for " ++ (showXPrompt t) ++ " could not be loaded"] - - -- | When the prompt has multiple modes (created with mkXPromptWithModes), this function is called - -- when the user picks an item from the autocompletion list. - -- The first argument is the prompt (or mode) on which the item was picked - -- The first string argument is the autocompleted item's text. - -- The second string argument is the query made by the user (written in the prompt's buffer). - -- See XMonad/Actions/Launcher.hs for a usage example. - modeAction :: t -> String -> String -> X () - modeAction _ _ _ = return () - -data XPPosition = Top - | Bottom - -- | Prompt will be placed in the center horizontally and - -- in the certain place of screen vertically. If it's in the upper - -- part of the screen, completion window will be placed below(like - -- in 'Top') and otherwise above(like in 'Bottom') - | CenteredAt { xpCenterY :: Rational - -- ^ Rational between 0 and 1, giving - -- y coordinate of center of the prompt relative to the screen height. - , xpWidth :: Rational - -- ^ Rational between 0 and 1, giving - -- width of the prompt relatave to the screen width. - } - deriving (Show,Read) - -amberXPConfig, defaultXPConfig, greenXPConfig :: XPConfig - -instance Default XPConfig where - def = - XPC { font = "-misc-fixed-*-*-*-*-12-*-*-*-*-*-*-*" - , bgColor = "grey22" - , fgColor = "grey80" - , fgHLight = "black" - , bgHLight = "grey" - , borderColor = "white" - , promptBorderWidth = 1 - , promptKeymap = defaultXPKeymap - , completionKey = (0,xK_Tab) - , changeModeKey = xK_grave - , position = Bottom - , height = 18 - , maxComplRows = Nothing - , historySize = 256 - , historyFilter = id - , defaultText = [] - , autoComplete = Nothing - , showCompletionOnTab = False - , searchPredicate = isPrefixOf - , alwaysHighlight = False - } -{-# DEPRECATED defaultXPConfig "Use def (from Data.Default, and re-exported from XMonad.Prompt) instead." #-} -defaultXPConfig = def -greenXPConfig = def { fgColor = "green", bgColor = "black", promptBorderWidth = 0 } -amberXPConfig = def { fgColor = "#ca8f2d", bgColor = "black", fgHLight = "#eaaf4c" } - -initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode - -> GC -> XMonadFont -> [String] -> XPConfig -> KeyMask -> XPState -initState d rw w s opMode gc fonts h c nm = - XPS { dpy = d - , rootw = rw - , win = w - , screen = s - , complWin = Nothing - , complWinDim = Nothing - , showComplWin = not (showCompletionOnTab c) - , operationMode = opMode - , highlightedCompl = Nothing - , gcon = gc - , fontS = fonts - , commandHistory = W.Stack { W.focus = defaultText c - , W.up = [] - , W.down = h } - , complIndex = (0,0) --(column index, row index), used when `alwaysHighlight` in XPConfig is True - , offset = length (defaultText c) - , config = c - , successful = False - , done = False - , numlockMask = nm - } - --- Returns the current XPType -currentXPMode :: XPState -> XPType -currentXPMode st = case operationMode st of - XPMultipleModes modes -> W.focus modes - XPSingleMode _ xptype -> xptype - --- When in multiple modes, this function sets the next mode --- in the list of modes as active -setNextMode :: XPState -> XPState -setNextMode st = case operationMode st of - XPMultipleModes modes -> case W.down modes of - [] -> st -- there is no next mode, return same state - (m:ms) -> let - currentMode = W.focus modes - in st { operationMode = XPMultipleModes W.Stack { W.up = [], W.focus = m, W.down = ms ++ [currentMode]}} --set next and move previous current mode to the of the stack - _ -> st --nothing to do, the prompt's operation has only one mode - --- Returns the highlighted item -highlightedItem :: XPState -> [String] -> Maybe String -highlightedItem st' completions = case complWinDim st' of - Nothing -> Nothing -- when there isn't any compl win, we can't say how many cols,rows there are - Just winDim -> - let - (_,_,_,_,xx,yy) = winDim - complMatrix = splitInSubListsAt (length yy) (take (length xx * length yy) completions) - (col_index,row_index) = (complIndex st') - in case completions of - [] -> Nothing - _ -> Just $ complMatrix !! col_index !! row_index - --- this would be much easier with functional references -command :: XPState -> String -command = W.focus . commandHistory - -setCommand :: String -> XPState -> XPState -setCommand xs s = s { commandHistory = (commandHistory s) { W.focus = xs }} - -setHighlightedCompl :: Maybe String -> XPState -> XPState -setHighlightedCompl hc st = st { highlightedCompl = hc} - --- | Sets the input string to the given value. -setInput :: String -> XP () -setInput = modify . setCommand - --- | Returns the current input string. Intented for use in custom keymaps --- where the 'get' or similar can't be used to retrieve it. -getInput :: XP String -getInput = gets command - --- | Same as 'mkXPrompt', except that the action function can have --- type @String -> X a@, for any @a@, and the final action returned --- by 'mkXPromptWithReturn' will have type @X (Maybe a)@. @Nothing@ --- is yielded if the user cancels the prompt (by e.g. hitting Esc or --- Ctrl-G). For an example of use, see the 'XMonad.Prompt.Input' --- module. -mkXPromptWithReturn :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X a) -> X (Maybe a) -mkXPromptWithReturn t conf compl action = do - XConf { display = d, theRoot = rw } <- ask - s <- gets $ screenRect . W.screenDetail . W.current . windowset - hist <- io readHistory - w <- io $ createWin d rw conf s - io $ selectInput d w $ exposureMask .|. keyPressMask - gc <- io $ createGC d w - io $ setGraphicsExposures d gc False - fs <- initXMF (font conf) - numlock <- gets $ X.numberlockMask - let hs = fromMaybe [] $ M.lookup (showXPrompt t) hist - om = (XPSingleMode compl (XPT t)) --operation mode - st = initState d rw w s om gc fs hs conf numlock - st' <- io $ execStateT runXP st - - releaseXMF fs - io $ freeGC d gc - if successful st' then do - let - prune = take (historySize conf) - - io $ writeHistory $ M.insertWith - (\xs ys -> prune . historyFilter conf $ xs ++ ys) - (showXPrompt t) - (prune $ historyFilter conf [command st']) - hist - -- we need to apply historyFilter before as well, since - -- otherwise the filter would not be applied if - -- there is no history - --When alwaysHighlight is True, autocompletion is handled with indexes. - --When it is false, it is handled depending on the prompt buffer's value - let selectedCompletion = case alwaysHighlight (config st') of - False -> command st' - True -> fromMaybe (command st') $ highlightedCompl st' - Just <$> action selectedCompletion - else return Nothing - --- | Creates a prompt given: --- --- * a prompt type, instance of the 'XPrompt' class. --- --- * a prompt configuration ('def' can be used as a starting point) --- --- * a completion function ('mkComplFunFromList' can be used to --- create a completions function given a list of possible completions) --- --- * an action to be run: the action must take a string and return 'XMonad.X' () -mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X () -mkXPrompt t conf compl action = mkXPromptWithReturn t conf compl action >> return () - --- | Creates a prompt with multiple modes given: --- --- * A non-empty list of modes --- * A prompt configuration --- --- The created prompt allows to switch between modes with `changeModeKey` in `conf`. The modes are --- instances of XPrompt. See XMonad.Actions.Launcher for more details --- --- The argument supplied to the action to execute is always the current highlighted item, --- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True. -mkXPromptWithModes :: [XPType] -> XPConfig -> X () -mkXPromptWithModes modes conf = do - XConf { display = d, theRoot = rw } <- ask - s <- gets $ screenRect . W.screenDetail . W.current . windowset - hist <- io readHistory - w <- io $ createWin d rw conf s - io $ selectInput d w $ exposureMask .|. keyPressMask - gc <- io $ createGC d w - io $ setGraphicsExposures d gc False - fs <- initXMF (font conf) - numlock <- gets $ X.numberlockMask - let - defaultMode = head modes - hs = fromMaybe [] $ M.lookup (showXPrompt defaultMode) hist - modeStack = W.Stack{ W.focus = defaultMode --current mode - , W.up = [] - , W.down = tail modes --other modes - } - st = initState d rw w s (XPMultipleModes modeStack) gc fs hs conf { alwaysHighlight = True} numlock - st' <- io $ execStateT runXP st - - releaseXMF fs - io $ freeGC d gc - - if successful st' then do - let - prune = take (historySize conf) - - -- insert into history the buffers value - io $ writeHistory $ M.insertWith - (\xs ys -> prune . historyFilter conf $ xs ++ ys) - (showXPrompt defaultMode) - (prune $ historyFilter conf [command st']) - hist - - case operationMode st' of - XPMultipleModes ms -> let - action = modeAction $ W.focus ms - in action (command st') $ (fromMaybe "" $ highlightedCompl st') - _ -> error "The impossible occurred: This prompt runs with multiple modes but they could not be found." --we are creating a prompt with multiple modes, so its operationMode should have been constructed with XPMultipleMode - else - return () - - -runXP :: XP () -runXP = do - (d,w) <- gets (dpy &&& win) - status <- io $ grabKeyboard d w True grabModeAsync grabModeAsync currentTime - when (status == grabSuccess) $ do - updateWindows - eventLoop handle - io $ ungrabKeyboard d currentTime - io $ destroyWindow d w - destroyComplWin - io $ sync d False - -type KeyStroke = (KeySym, String) - -eventLoop :: (KeyStroke -> Event -> XP ()) -> XP () -eventLoop action = do - d <- gets dpy - (keysym,string,event) <- io $ - allocaXEvent $ \e -> do - maskEvent d (exposureMask .|. keyPressMask) e - ev <- getEvent e - (ks,s) <- if ev_event_type ev == keyPress - then lookupString $ asKeyEvent e - else return (Nothing, "") - return (ks,s,ev) - action (fromMaybe xK_VoidSymbol keysym,string) event - gets done >>= flip unless (eventLoop handle) - --- | Removes numlock and capslock from a keymask. --- Duplicate of cleanMask from core, but in the --- XP monad instead of X. -cleanMask :: KeyMask -> XP KeyMask -cleanMask msk = do - numlock <- gets numlockMask - let highMasks = 1 `shiftL` 12 - 1 - return (complement (numlock .|. lockMask) .&. msk .&. highMasks) - --- Main event handler -handle :: KeyStroke -> Event -> XP () -handle ks@(sym,_) e@(KeyEvent {ev_event_type = t, ev_state = m}) = do - complKey <- gets $ completionKey . config - chgModeKey <- gets $ changeModeKey . config - c <- getCompletions - mCleaned <- cleanMask m - when (length c > 1) $ modify (\s -> s { showComplWin = True }) - if complKey == (mCleaned,sym) - then completionHandle c ks e - else if (sym == chgModeKey) then - do - modify setNextMode - updateWindows - else when (t == keyPress) $ keyPressHandle mCleaned ks -handle _ (ExposeEvent {ev_window = w}) = do - st <- get - when (win st == w) updateWindows -handle _ _ = return () - --- completion event handler -completionHandle :: [String] -> KeyStroke -> Event -> XP () -completionHandle c ks@(sym,_) (KeyEvent { ev_event_type = t, ev_state = m }) = do - complKey <- gets $ completionKey . config - alwaysHlight <- gets $ alwaysHighlight . config - mCleaned <- cleanMask m - case () of - () | t == keyPress && (mCleaned,sym) == complKey -> do - st <- get - - let updateWins l = redrawWindows l >> eventLoop (completionHandle l) - updateState l = case alwaysHlight of - False -> simpleComplete l st - True | Just (command st) /= highlightedCompl st -> alwaysHighlightCurrent st - | otherwise -> alwaysHighlightNext l st - - case c of - [] -> updateWindows >> eventLoop handle - [x] -> updateState [x] >> getCompletions >>= updateWins - l -> updateState l >> updateWins l - | t == keyRelease && (mCleaned,sym) == complKey -> eventLoop (completionHandle c) - | otherwise -> keyPressHandle mCleaned ks -- some other key, handle it normally - where - -- When alwaysHighlight is off, just complete based on what the - -- user has typed so far. - simpleComplete :: [String] -> XPState -> XP () - simpleComplete l st = do - let newCommand = nextCompletion (currentXPMode st) (command st) l - modify $ \s -> setCommand newCommand $ - s { offset = length newCommand - , highlightedCompl = Just newCommand - } - - -- If alwaysHighlight is on, and this is the first use of the - -- completion key, update the buffer so that it contains the - -- current completion item. - alwaysHighlightCurrent :: XPState -> XP () - alwaysHighlightCurrent st = do - let newCommand = fromMaybe (command st) $ highlightedItem st c - modify $ \s -> setCommand newCommand $ - setHighlightedCompl (Just newCommand) $ - s { offset = length newCommand - } - - -- If alwaysHighlight is on, and the user wants the next - -- completion, move to the next completion item and update the - -- buffer to reflect that. - -- - --TODO: Scroll or paginate results - alwaysHighlightNext :: [String] -> XPState -> XP () - alwaysHighlightNext l st = do - let complIndex' = nextComplIndex st (length l) - highlightedCompl' = highlightedItem st { complIndex = complIndex'} c - newCommand = fromMaybe (command st) $ highlightedCompl' - modify $ \s -> setHighlightedCompl highlightedCompl' $ - setCommand newCommand $ - s { complIndex = complIndex' - , offset = length newCommand - } - --- some other event: go back to main loop -completionHandle _ k e = handle k e - ---Receives an state of the prompt, the size of the autocompletion list and returns the column,row ---which should be highlighted next -nextComplIndex :: XPState -> Int -> (Int,Int) -nextComplIndex st nitems = case complWinDim st of - Nothing -> (0,0) --no window dims (just destroyed or not created) - Just (_,_,_,_,_,yy) -> let - (ncols,nrows) = (nitems `div` length yy + if (nitems `mod` length yy > 0) then 1 else 0, length yy) - (currentcol,currentrow) = complIndex st - in if (currentcol + 1 >= ncols) then --hlight is in the last column - if (currentrow + 1 < nrows ) then --hlight is still not at the last row - (currentcol, currentrow + 1) - else - (0,0) - else if(currentrow + 1 < nrows) then --hlight not at the last row - (currentcol, currentrow + 1) - else - (currentcol + 1, 0) - -tryAutoComplete :: XP Bool -tryAutoComplete = do - ac <- gets (autoComplete . config) - case ac of - Just d -> do cs <- getCompletions - case cs of - [c] -> runCompleted c d >> return True - _ -> return False - Nothing -> return False - where runCompleted cmd delay = do - st <- get - let new_command = nextCompletion (currentXPMode st) (command st) [cmd] - modify $ setCommand "autocompleting..." - updateWindows - io $ threadDelay delay - modify $ setCommand new_command - return True - --- KeyPresses - --- | Default key bindings for prompts. Click on the \"Source\" link --- to the right to see the complete list. See also 'defaultXPKeymap''. -defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) -defaultXPKeymap = defaultXPKeymap' isSpace - --- | A variant of 'defaultXPKeymap' which lets you specify a custom --- predicate for identifying non-word characters, which affects all --- the word-oriented commands (move\/kill word). The default is --- 'isSpace'. For example, by default a path like @foo\/bar\/baz@ --- would be considered as a single word. You could use a predicate --- like @(\\c -> isSpace c || c == \'\/\')@ to move through or --- delete components of the path one at a time. -defaultXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ()) -defaultXPKeymap' p = M.fromList $ - map (first $ (,) controlMask) -- control + - [ (xK_u, killBefore) - , (xK_k, killAfter) - , (xK_a, startOfLine) - , (xK_e, endOfLine) - , (xK_y, pasteString) - , (xK_Right, moveWord' p Next) - , (xK_Left, moveWord' p Prev) - , (xK_Delete, killWord' p Next) - , (xK_BackSpace, killWord' p Prev) - , (xK_w, killWord' p Prev) - , (xK_g, quit) - , (xK_bracketleft, quit) - ] ++ - map (first $ (,) 0) - [ (xK_Return, setSuccess True >> setDone True) - , (xK_KP_Enter, setSuccess True >> setDone True) - , (xK_BackSpace, deleteString Prev) - , (xK_Delete, deleteString Next) - , (xK_Left, moveCursor Prev) - , (xK_Right, moveCursor Next) - , (xK_Home, startOfLine) - , (xK_End, endOfLine) - , (xK_Down, moveHistory W.focusUp') - , (xK_Up, moveHistory W.focusDown') - , (xK_Escape, quit) - ] - --- | A keymap with many emacs-like key bindings. Click on the --- \"Source\" link to the right to see the complete list. --- See also 'emacsLikeXPKeymap''. -emacsLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) -emacsLikeXPKeymap = emacsLikeXPKeymap' isSpace - --- | A variant of 'emacsLikeXPKeymap' which lets you specify a custom --- predicate for identifying non-word characters, which affects all --- the word-oriented commands (move\/kill word). The default is --- 'isSpace'. For example, by default a path like @foo\/bar\/baz@ --- would be considered as a single word. You could use a predicate --- like @(\\c -> isSpace c || c == \'\/\')@ to move through or --- delete components of the path one at a time. -emacsLikeXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ()) -emacsLikeXPKeymap' p = M.fromList $ - map (first $ (,) controlMask) -- control + - [ (xK_z, killBefore) --kill line backwards - , (xK_k, killAfter) -- kill line fowards - , (xK_a, startOfLine) --move to the beginning of the line - , (xK_e, endOfLine) -- move to the end of the line - , (xK_d, deleteString Next) -- delete a character foward - , (xK_b, moveCursor Prev) -- move cursor forward - , (xK_f, moveCursor Next) -- move cursor backward - , (xK_BackSpace, killWord' p Prev) -- kill the previous word - , (xK_y, pasteString) - , (xK_g, quit) - , (xK_bracketleft, quit) - ] ++ - map (first $ (,) mod1Mask) -- meta key + - [ (xK_BackSpace, killWord' p Prev) - , (xK_f, moveWord' p Next) -- move a word forward - , (xK_b, moveWord' p Prev) -- move a word backward - , (xK_d, killWord' p Next) -- kill the next word - , (xK_n, moveHistory W.focusUp') - , (xK_p, moveHistory W.focusDown') - ] - ++ - map (first $ (,) 0) -- - [ (xK_Return, setSuccess True >> setDone True) - , (xK_KP_Enter, setSuccess True >> setDone True) - , (xK_BackSpace, deleteString Prev) - , (xK_Delete, deleteString Next) - , (xK_Left, moveCursor Prev) - , (xK_Right, moveCursor Next) - , (xK_Home, startOfLine) - , (xK_End, endOfLine) - , (xK_Down, moveHistory W.focusUp') - , (xK_Up, moveHistory W.focusDown') - , (xK_Escape, quit) - ] - -keyPressHandle :: KeyMask -> KeyStroke -> XP () -keyPressHandle m (ks,str) = do - km <- gets (promptKeymap . config) - case M.lookup (m,ks) km of - Just action -> action >> updateWindows - Nothing -> case str of - "" -> eventLoop handle - _ -> when (m .&. controlMask == 0) $ do - let str' = if isUTF8Encoded str - then decodeString str - else str - insertString str' - updateWindows - updateHighlightedCompl - completed <- tryAutoComplete - when completed $ setSuccess True >> setDone True - -setSuccess :: Bool -> XP () -setSuccess b = modify $ \s -> s { successful = b } - -setDone :: Bool -> XP () -setDone b = modify $ \s -> s { done = b } - --- KeyPress and State - --- | Quit. -quit :: XP () -quit = flushString >> setSuccess False >> setDone True - --- | Kill the portion of the command before the cursor -killBefore :: XP () -killBefore = - modify $ \s -> setCommand (drop (offset s) (command s)) $ s { offset = 0 } - --- | Kill the portion of the command including and after the cursor -killAfter :: XP () -killAfter = - modify $ \s -> setCommand (take (offset s) (command s)) s - --- | Kill the next\/previous word, using 'isSpace' as the default --- predicate for non-word characters. See 'killWord''. -killWord :: Direction1D -> XP () -killWord = killWord' isSpace - --- | Kill the next\/previous word, given a predicate to identify --- non-word characters. First delete any consecutive non-word --- characters; then delete consecutive word characters, stopping --- just before the next non-word character. --- --- For example, by default (using 'killWord') a path like --- @foo\/bar\/baz@ would be deleted in its entirety. Instead you can --- use something like @killWord' (\\c -> isSpace c || c == \'\/\')@ to --- delete the path one component at a time. -killWord' :: (Char -> Bool) -> Direction1D -> XP () -killWord' p d = do - o <- gets offset - c <- gets command - let (f,ss) = splitAt o c - delNextWord = snd . break p . dropWhile p - delPrevWord = reverse . delNextWord . reverse - (ncom,noff) = - case d of - Next -> (f ++ delNextWord ss, o) - Prev -> (delPrevWord f ++ ss, length $ delPrevWord f) -- laziness!! - modify $ \s -> setCommand ncom $ s { offset = noff} - --- | Put the cursor at the end of line -endOfLine :: XP () -endOfLine = - modify $ \s -> s { offset = length (command s)} - --- | Put the cursor at the start of line -startOfLine :: XP () -startOfLine = - modify $ \s -> s { offset = 0 } - --- | Flush the command string and reset the offset -flushString :: XP () -flushString = modify $ \s -> setCommand "" $ s { offset = 0} - ---reset index if config has `alwaysHighlight`. The inserted char could imply fewer autocompletions. ---If the current index was column 2, row 1 and now there are only 4 autocompletion rows with 1 column, what should we highlight? Set it to the first and start navigation again -resetComplIndex :: XPState -> XPState -resetComplIndex st = if (alwaysHighlight $ config st) then st { complIndex = (0,0) } else st - --- | Insert a character at the cursor position -insertString :: String -> XP () -insertString str = - modify $ \s -> let - cmd = (c (command s) (offset s)) - st = resetComplIndex $ s { offset = o (offset s)} - in setCommand cmd st - where o oo = oo + length str - c oc oo | oo >= length oc = oc ++ str - | otherwise = f ++ str ++ ss - where (f,ss) = splitAt oo oc - --- | Insert the current X selection string at the cursor position. -pasteString :: XP () -pasteString = join $ io $ liftM insertString getSelection - --- | Remove a character at the cursor position -deleteString :: Direction1D -> XP () -deleteString d = - modify $ \s -> setCommand (c (command s) (offset s)) $ s { offset = o (offset s)} - where o oo = if d == Prev then max 0 (oo - 1) else oo - c oc oo - | oo >= length oc && d == Prev = take (oo - 1) oc - | oo < length oc && d == Prev = take (oo - 1) f ++ ss - | oo < length oc && d == Next = f ++ tail ss - | otherwise = oc - where (f,ss) = splitAt oo oc - --- | move the cursor one position -moveCursor :: Direction1D -> XP () -moveCursor d = - modify $ \s -> s { offset = o (offset s) (command s)} - where o oo c = if d == Prev then max 0 (oo - 1) else min (length c) (oo + 1) - --- | Move the cursor one word, using 'isSpace' as the default --- predicate for non-word characters. See 'moveWord''. -moveWord :: Direction1D -> XP () -moveWord = moveWord' isSpace - --- | Move the cursor one word, given a predicate to identify non-word --- characters. First move past any consecutive non-word characters; --- then move to just before the next non-word character. -moveWord' :: (Char -> Bool) -> Direction1D -> XP () -moveWord' p d = do - c <- gets command - o <- gets offset - let (f,ss) = splitAt o c - len = uncurry (+) - . (length *** (length . fst . break p)) - . break (not . p) - newoff = case d of - Prev -> o - len (reverse f) - Next -> o + len ss - modify $ \s -> s { offset = newoff } - -moveHistory :: (W.Stack String -> W.Stack String) -> XP () -moveHistory f = do - modify $ \s -> let ch = f $ commandHistory s - in s { commandHistory = ch - , offset = length $ W.focus ch - , complIndex = (0,0) } - updateWindows - updateHighlightedCompl - -updateHighlightedCompl :: XP () -updateHighlightedCompl = do - st <- get - cs <- getCompletions - alwaysHighlight' <- gets $ alwaysHighlight . config - when (alwaysHighlight') $ modify $ \s -> s {highlightedCompl = highlightedItem st cs} - --- X Stuff - -updateWindows :: XP () -updateWindows = do - d <- gets dpy - drawWin - c <- getCompletions - case c of - [] -> destroyComplWin >> return () - l -> redrawComplWin l - io $ sync d False - -redrawWindows :: [String] -> XP () -redrawWindows c = do - d <- gets dpy - drawWin - case c of - [] -> return () - l -> redrawComplWin l - io $ sync d False - -createWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window -createWin d rw c s = do - let (x,y) = case position c of - Top -> (0,0) - Bottom -> (0, rect_height s - height c) - CenteredAt py w -> (floor $ (fi $ rect_width s) * ((1 - w) / 2), floor $ py * fi (rect_height s) - (fi (height c) / 2)) - width = case position c of - CenteredAt _ w -> floor $ fi (rect_width s) * w - _ -> rect_width s - w <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rw - (rect_x s + x) (rect_y s + fi y) width (height c) - mapWindow d w - return w - -drawWin :: XP () -drawWin = do - st <- get - let (c,(d,(w,gc))) = (config &&& dpy &&& win &&& gcon) st - scr = defaultScreenOfDisplay d - wh = case position c of - CenteredAt _ wd -> floor $ wd * fi (widthOfScreen scr) - _ -> widthOfScreen scr - ht = height c - bw = promptBorderWidth c - Just bgcolor <- io $ initColor d (bgColor c) - Just border <- io $ initColor d (borderColor c) - p <- io $ createPixmap d w wh ht - (defaultDepthOfScreen scr) - io $ fillDrawable d p gc border bgcolor (fi bw) wh ht - printPrompt p - io $ copyArea d p w gc 0 0 wh ht 0 0 - io $ freePixmap d p - -printPrompt :: Drawable -> XP () -printPrompt drw = do - st <- get - let (gc,(c,(d,fs))) = (gcon &&& config &&& dpy &&& fontS) st - (prt,(com,off)) = (show . currentXPMode &&& command &&& offset) st - str = prt ++ com - -- break the string in 3 parts: till the cursor, the cursor and the rest - (f,p,ss) = if off >= length com - then (str, " ","") -- add a space: it will be our cursor ;-) - else let (a,b) = (splitAt off com) - in (prt ++ a, [head b], tail b) - ht = height c - fsl <- io $ textWidthXMF (dpy st) fs f - psl <- io $ textWidthXMF (dpy st) fs p - (asc,desc) <- io $ textExtentsXMF fs str - let y = fi $ ((ht - fi (asc + desc)) `div` 2) + fi asc - x = (asc + desc) `div` 2 - - let draw = printStringXMF d drw fs gc - -- print the first part - draw (fgColor c) (bgColor c) x y f - -- reverse the colors and print the "cursor" ;-) - draw (bgColor c) (fgColor c) (x + fromIntegral fsl) y p - -- reverse the colors and print the rest of the string - draw (fgColor c) (bgColor c) (x + fromIntegral (fsl + psl)) y ss - --- get the current completion function depending on the active mode -getCompletionFunction :: XPState -> ComplFunction -getCompletionFunction st = case operationMode st of - XPSingleMode compl _ -> compl - XPMultipleModes modes -> completionFunction $ W.focus modes - --- Completions -getCompletions :: XP [String] -getCompletions = do - s <- get - io $ getCompletionFunction s (commandToComplete (currentXPMode s) (command s)) - `E.catch` \(SomeException _) -> return [] - -setComplWin :: Window -> ComplWindowDim -> XP () -setComplWin w wi = - modify (\s -> s { complWin = Just w, complWinDim = Just wi }) - -destroyComplWin :: XP () -destroyComplWin = do - d <- gets dpy - cw <- gets complWin - case cw of - Just w -> do io $ destroyWindow d w - modify (\s -> s { complWin = Nothing, complWinDim = Nothing }) - Nothing -> return () - -type ComplWindowDim = (Position,Position,Dimension,Dimension,Columns,Rows) -type Rows = [Position] -type Columns = [Position] - -createComplWin :: ComplWindowDim -> XP Window -createComplWin wi@(x,y,wh,ht,_,_) = do - st <- get - let d = dpy st - scr = defaultScreenOfDisplay d - w <- io $ mkUnmanagedWindow d scr (rootw st) - x y wh ht - io $ mapWindow d w - setComplWin w wi - return w - -getComplWinDim :: [String] -> XP ComplWindowDim -getComplWinDim compl = do - st <- get - let (c,(scr,fs)) = (config &&& screen &&& fontS) st - wh = case position c of - CenteredAt _ w -> floor $ fi (rect_width scr) * w - _ -> rect_width scr - ht = height c - bw = promptBorderWidth c - - tws <- mapM (textWidthXMF (dpy st) fs) compl - let max_compl_len = fromIntegral ((fi ht `div` 2) + maximum tws) - columns = max 1 $ wh `div` fi max_compl_len - rem_height = rect_height scr - ht - (rows,r) = length compl `divMod` fi columns - needed_rows = max 1 (rows + if r == 0 then 0 else 1) - limit_max_number = case maxComplRows c of - Nothing -> id - Just m -> min m - actual_max_number_of_rows = limit_max_number $ rem_height `div` ht - actual_rows = min actual_max_number_of_rows (fi needed_rows) - actual_height = actual_rows * ht - (x,y) = case position c of - Top -> (0,ht - bw) - Bottom -> (0, (0 + rem_height - actual_height + bw)) - CenteredAt py w - | py <= 1/2 -> (floor $ fi (rect_width scr) * ((1 - w) / 2), floor (py * fi (rect_height scr) + (fi ht)/2) - bw) - | otherwise -> (floor $ fi (rect_width scr) * ((1 - w) / 2), floor (py * fi (rect_height scr) - (fi ht)/2) - actual_height + bw) - (asc,desc) <- io $ textExtentsXMF fs $ head compl - let yp = fi $ (ht + fi (asc - desc)) `div` 2 - xp = (asc + desc) `div` 2 - yy = map fi . take (fi actual_rows) $ [yp,(yp + ht)..] - xx = take (fi columns) [xp,(xp + max_compl_len)..] - - return (rect_x scr + x, rect_y scr + fi y, wh, actual_height, xx, yy) - -drawComplWin :: Window -> [String] -> XP () -drawComplWin w compl = do - st <- get - let c = config st - d = dpy st - scr = defaultScreenOfDisplay d - bw = promptBorderWidth c - gc = gcon st - Just bgcolor <- io $ initColor d (bgColor c) - Just border <- io $ initColor d (borderColor c) - - (_,_,wh,ht,xx,yy) <- getComplWinDim compl - - p <- io $ createPixmap d w wh ht - (defaultDepthOfScreen scr) - io $ fillDrawable d p gc border bgcolor (fi bw) wh ht - let ac = splitInSubListsAt (length yy) (take (length xx * length yy) compl) - - printComplList d p gc (fgColor c) (bgColor c) xx yy ac - --lift $ spawn $ "xmessage " ++ " ac: " ++ show ac ++ " xx: " ++ show xx ++ " length xx: " ++ show (length xx) ++ " yy: " ++ show (length yy) - io $ copyArea d p w gc 0 0 wh ht 0 0 - io $ freePixmap d p - -redrawComplWin :: [String] -> XP () -redrawComplWin compl = do - st <- get - nwi <- getComplWinDim compl - let recreate = do destroyComplWin - w <- createComplWin nwi - drawComplWin w compl - if compl /= [] && showComplWin st - then case complWin st of - Just w -> case complWinDim st of - Just wi -> if nwi == wi -- complWinDim did not change - then drawComplWin w compl -- so update - else recreate - Nothing -> recreate - Nothing -> recreate - else destroyComplWin - --- Finds the column and row indexes in which a string appears. --- if the string is not in the matrix, the indexes default to (0,0) -findComplIndex :: String -> [[String]] -> (Int,Int) -findComplIndex x xss = let - colIndex = fromMaybe 0 $ findIndex (\cols -> x `elem` cols) xss - rowIndex = fromMaybe 0 $ elemIndex x $ (!!) xss colIndex - in (colIndex,rowIndex) - -printComplList :: Display -> Drawable -> GC -> String -> String - -> [Position] -> [Position] -> [[String]] -> XP () -printComplList d drw gc fc bc xs ys sss = - zipWithM_ (\x ss -> - zipWithM_ (\y item -> do - st <- get - alwaysHlight <- gets $ alwaysHighlight . config - let (f,b) = case alwaysHlight of - True -> -- default to the first item, the one in (0,0) - let - (colIndex,rowIndex) = findComplIndex item sss - in -- assign some colors - if ((complIndex st) == (colIndex,rowIndex)) then (fgHLight $ config st,bgHLight $ config st) - else (fc,bc) - False -> - -- compare item with buffer's value - if completionToCommand (currentXPMode st) item == commandToComplete (currentXPMode st) (command st) - then (fgHLight $ config st,bgHLight $ config st) - else (fc,bc) - printStringXMF d drw (fontS st) gc f b x y item) - ys ss) xs sss - --- History - -type History = M.Map String [String] - -emptyHistory :: History -emptyHistory = M.empty - -getHistoryFile :: IO FilePath -getHistoryFile = fmap (++ "/prompt-history") getXMonadCacheDir - -readHistory :: IO History -readHistory = readHist `E.catch` \(SomeException _) -> return emptyHistory - where - readHist = do - path <- getHistoryFile - xs <- bracket (openFile path ReadMode) hClose hGetLine - readIO xs - -writeHistory :: History -> IO () -writeHistory hist = do - path <- getHistoryFile - let filtered = M.filter (not . null) hist - writeFile path (show filtered) `E.catch` \(SomeException e) -> - hPutStrLn stderr ("error writing history: "++show e) - setFileMode path mode - where mode = ownerReadMode .|. ownerWriteMode - --- $xutils - --- | Fills a 'Drawable' with a rectangle and a border -fillDrawable :: Display -> Drawable -> GC -> Pixel -> Pixel - -> Dimension -> Dimension -> Dimension -> IO () -fillDrawable d drw gc border bgcolor bw wh ht = do - -- we start with the border - setForeground d gc border +-- 2015 Sibi Prabakaran, 2018 Yclept Nemo +-- License : BSD3 +-- +-- Maintainer : Spencer Janssen +-- Stability : unstable +-- Portability : unportable +-- +-- A module for writing graphical prompts for XMonad +-- +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- +-- Bugs: +-- if 'alwaysHighlight' is True, and +-- 1 type several characters +-- 2 tab-complete past several entries +-- 3 backspace back to the several characters +-- 4 tab-complete once (results in the entry past the one in [2]) +-- 5 tab-complete against this shorter list of completions +-- then the prompt will freeze (XMonad continues however). +----------------------------------------------------------------------------- + +module XMonad.Prompt + ( -- * Usage + -- $usage + mkXPrompt + , mkXPromptWithReturn + , mkXPromptWithModes + , def + , amberXPConfig + , defaultXPConfig + , greenXPConfig + , XPMode + , XPType (..) + , XPColor (..) + , XPPosition (..) + , XPConfig (..) + , XPrompt (..) + , XP + , defaultXPKeymap, defaultXPKeymap' + , emacsLikeXPKeymap, emacsLikeXPKeymap' + , vimLikeXPKeymap, vimLikeXPKeymap' + , quit + , promptSubmap, promptBuffer, toHeadChar, bufferOne + , killBefore, killAfter, startOfLine, endOfLine + , insertString, pasteString, pasteString' + , clipCursor, moveCursor, moveCursorClip + , setInput, getInput, getOffset + , defaultColor, modifyColor, setColor + , resetColor, setBorderColor + , modifyPrompter, setPrompter, resetPrompter + , moveWord, moveWord', killWord, killWord' + , changeWord, deleteString + , moveHistory, setSuccess, setDone, setModeDone + , Direction1D(..) + , ComplFunction + -- * X Utilities + -- $xutils + , mkUnmanagedWindow + , fillDrawable + -- * Other Utilities + -- $utils + , mkComplFunFromList + , mkComplFunFromList' + -- * @nextCompletion@ implementations + , getNextOfLastWord + , getNextCompletion + -- * List utilities + , getLastWord + , skipLastWord + , splitInSubListsAt + , breakAtSpace + , uniqSort + , historyCompletion + , historyCompletionP + -- * History filters + , deleteAllDuplicates + , deleteConsecutive + , HistoryMatches + , initMatches + , historyUpMatching + , historyDownMatching + -- * Types + , XPState + ) where + +import XMonad hiding (cleanMask, config) +import qualified XMonad as X (numberlockMask) +import qualified XMonad.StackSet as W +import XMonad.Util.Font +import XMonad.Util.Types +import XMonad.Util.XSelection (getSelection) + +import Codec.Binary.UTF8.String (decodeString,isUTF8Encoded) +import Control.Applicative ((<$>)) +import Control.Arrow (first, second, (&&&), (***)) +import Control.Concurrent (threadDelay) +import Control.Exception.Extensible as E hiding (handle) +import Control.Monad.State +import Data.Bits +import Data.Char (isSpace) +import Data.IORef +import Data.List +import qualified Data.Map as M +import Data.Maybe (fromMaybe) +import Data.Set (fromList, toList) +import System.IO +import System.IO.Unsafe (unsafePerformIO) +import System.Posix.Files + +-- $usage +-- For usage examples see "XMonad.Prompt.Shell", +-- "XMonad.Prompt.XMonad" or "XMonad.Prompt.Ssh" +-- +-- TODO: +-- +-- * scrolling the completions that don't fit in the window (?) + +type XP = StateT XPState IO + +data XPState = + XPS { dpy :: Display + , rootw :: !Window + , win :: !Window + , screen :: !Rectangle + , complWin :: Maybe Window + , complWinDim :: Maybe ComplWindowDim + , complIndex :: !(Int,Int) + -- | This IORef should always have the same value as + -- complWin. Its purpose is to enable removal of the + -- completion window if an exception occurs, since the most + -- recent value of complWin is not available when handling + -- exceptions. + , complWinRef :: IORef (Maybe Window) + , showComplWin :: Bool + , operationMode :: XPOperationMode + , highlightedCompl :: Maybe String + , gcon :: !GC + , fontS :: !XMonadFont + , commandHistory :: W.Stack String + , offset :: !Int + , config :: XPConfig + , successful :: Bool + , numlockMask :: KeyMask + , done :: Bool + , modeDone :: Bool + , color :: XPColor + , prompter :: String -> String + , eventBuffer :: [(KeySym, String, Event)] + , inputBuffer :: String + , currentCompletions :: Maybe [String] + } + +data XPConfig = + XPC { font :: String -- ^ Font. For TrueType fonts, use something like + -- @"xft:Hack:pixelsize=1"@. Alternatively, use X Logical Font + -- Description, i.e. something like + -- @"-*-dejavu sans mono-medium-r-normal--*-80-*-*-*-*-iso10646-1"@. + , bgColor :: String -- ^ Background color + , fgColor :: String -- ^ Font color + , bgHLight :: String -- ^ Background color of a highlighted completion entry + , fgHLight :: String -- ^ Font color of a highlighted completion entry + , borderColor :: String -- ^ Border color + , promptBorderWidth :: !Dimension -- ^ Border width + , position :: XPPosition -- ^ Position: 'Top', 'Bottom', or 'CenteredAt' + , alwaysHighlight :: !Bool -- ^ Always highlight an item, overriden to True with multiple modes. This implies having *one* column of autocompletions only. + , height :: !Dimension -- ^ Window height + , maxComplRows :: Maybe Dimension + -- ^ Just x: maximum number of rows to show in completion window + , historySize :: !Int -- ^ The number of history entries to be saved + , historyFilter :: [String] -> [String] + -- ^ a filter to determine which + -- history entries to remember + , promptKeymap :: M.Map (KeyMask,KeySym) (XP ()) + -- ^ Mapping from key combinations to actions + , completionKey :: (KeyMask, KeySym) -- ^ Key that should trigger completion + , changeModeKey :: KeySym -- ^ Key to change mode (when the prompt has multiple modes) + , defaultText :: String -- ^ The text by default in the prompt line + , autoComplete :: Maybe Int -- ^ Just x: if only one completion remains, auto-select it, + -- and delay by x microseconds + , showCompletionOnTab :: Bool -- ^ Only show list of completions when Tab was pressed + , searchPredicate :: String -> String -> Bool + -- ^ Given the typed string and a possible + -- completion, is the completion valid? + , defaultPrompter :: String -> String + -- ^ Modifies the prompt given by 'showXPrompt' + , sorter :: String -> [String] -> [String] + -- ^ Used to sort the possible completions by how well they + -- match the search string (see X.P.FuzzyMatch for an + -- example). + } + +data XPType = forall p . XPrompt p => XPT p +type ComplFunction = String -> IO [String] +type XPMode = XPType +data XPOperationMode = XPSingleMode ComplFunction XPType | XPMultipleModes (W.Stack XPType) + +instance Show XPType where + show (XPT p) = showXPrompt p + +instance XPrompt XPType where + showXPrompt = show + nextCompletion (XPT t) = nextCompletion t + commandToComplete (XPT t) = commandToComplete t + completionToCommand (XPT t) = completionToCommand t + completionFunction (XPT t) = completionFunction t + modeAction (XPT t) = modeAction t + +-- | The class prompt types must be an instance of. In order to +-- create a prompt you need to create a data type, without parameters, +-- and make it an instance of this class, by implementing a simple +-- method, 'showXPrompt', which will be used to print the string to be +-- displayed in the command line window. +-- +-- This is an example of a XPrompt instance definition: +-- +-- > instance XPrompt Shell where +-- > showXPrompt Shell = "Run: " +class XPrompt t where + + -- | This method is used to print the string to be + -- displayed in the command line window. + showXPrompt :: t -> String + + -- | This method is used to generate the next completion to be + -- printed in the command line when tab is pressed, given the + -- string presently in the command line and the list of + -- completion. + -- This function is not used when in multiple modes (because alwaysHighlight in XPConfig is True) + nextCompletion :: t -> String -> [String] -> String + nextCompletion = getNextOfLastWord + + -- | This method is used to generate the string to be passed to + -- the completion function. + commandToComplete :: t -> String -> String + commandToComplete _ = getLastWord + + -- | This method is used to process each completion in order to + -- generate the string that will be compared with the command + -- presently displayed in the command line. If the prompt is using + -- 'getNextOfLastWord' for implementing 'nextCompletion' (the + -- default implementation), this method is also used to generate, + -- from the returned completion, the string that will form the + -- next command line when tab is pressed. + completionToCommand :: t -> String -> String + completionToCommand _ c = c + + -- | When the prompt has multiple modes, this is the function + -- used to generate the autocompletion list. + -- The argument passed to this function is given by `commandToComplete` + -- The default implementation shows an error message. + completionFunction :: t -> ComplFunction + completionFunction t = \_ -> return ["Completions for " ++ (showXPrompt t) ++ " could not be loaded"] + + -- | When the prompt has multiple modes (created with mkXPromptWithModes), this function is called + -- when the user picks an item from the autocompletion list. + -- The first argument is the prompt (or mode) on which the item was picked + -- The first string argument is the autocompleted item's text. + -- The second string argument is the query made by the user (written in the prompt's buffer). + -- See XMonad/Actions/Launcher.hs for a usage example. + modeAction :: t -> String -> String -> X () + modeAction _ _ _ = return () + +data XPPosition = Top + | Bottom + -- | Prompt will be placed in the center horizontally and + -- in the certain place of screen vertically. If it's in the upper + -- part of the screen, completion window will be placed below(like + -- in 'Top') and otherwise above(like in 'Bottom') + | CenteredAt { xpCenterY :: Rational + -- ^ Rational between 0 and 1, giving + -- y coordinate of center of the prompt relative to the screen height. + , xpWidth :: Rational + -- ^ Rational between 0 and 1, giving + -- width of the prompt relatave to the screen width. + } + deriving (Show,Read) + +data XPColor = + XPColor { bgNormal :: String -- ^ Background color + , fgNormal :: String -- ^ Font color + , bgHighlight :: String -- ^ Background color of a highlighted completion entry + , fgHighlight :: String -- ^ Font color of a highlighted completion entry + , border :: String -- ^ Border color + } + +amberXPConfig, defaultXPConfig, greenXPConfig :: XPConfig + +instance Default XPColor where + def = + XPColor { bgNormal = "grey22" + , fgNormal = "grey80" + , bgHighlight = "grey" + , fgHighlight = "black" + , border = "white" + } + +instance Default XPConfig where + def = + XPC { font = "-misc-fixed-*-*-*-*-12-*-*-*-*-*-*-*" + , bgColor = bgNormal def + , fgColor = fgNormal def + , bgHLight = bgHighlight def + , fgHLight = fgHighlight def + , borderColor = border def + , promptBorderWidth = 1 + , promptKeymap = defaultXPKeymap + , completionKey = (0,xK_Tab) + , changeModeKey = xK_grave + , position = Bottom + , height = 18 + , maxComplRows = Nothing + , historySize = 256 + , historyFilter = id + , defaultText = [] + , autoComplete = Nothing + , showCompletionOnTab = False + , searchPredicate = isPrefixOf + , alwaysHighlight = False + , defaultPrompter = id + , sorter = const id + } +{-# DEPRECATED defaultXPConfig "Use def (from Data.Default, and re-exported from XMonad.Prompt) instead." #-} +defaultXPConfig = def +greenXPConfig = def { bgColor = "black" + , fgColor = "green" + , promptBorderWidth = 0 + } +amberXPConfig = def { bgColor = "black" + , fgColor = "#ca8f2d" + , fgHLight = "#eaaf4c" + } + +initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode + -> GC -> XMonadFont -> [String] -> XPConfig -> KeyMask -> XPState +initState d rw w s opMode gc fonts h c nm = + XPS { dpy = d + , rootw = rw + , win = w + , screen = s + , complWin = Nothing + , complWinDim = Nothing + , complWinRef = unsafePerformIO (newIORef Nothing) + , showComplWin = not (showCompletionOnTab c) + , operationMode = opMode + , highlightedCompl = Nothing + , gcon = gc + , fontS = fonts + , commandHistory = W.Stack { W.focus = defaultText c + , W.up = [] + , W.down = h + } + , complIndex = (0,0) --(column index, row index), used when `alwaysHighlight` in XPConfig is True + , offset = length (defaultText c) + , config = c + , successful = False + , done = False + , modeDone = False + , numlockMask = nm + , prompter = defaultPrompter c + , color = defaultColor c + , eventBuffer = [] + , inputBuffer = "" + , currentCompletions = Nothing + } + +-- Returns the current XPType +currentXPMode :: XPState -> XPType +currentXPMode st = case operationMode st of + XPMultipleModes modes -> W.focus modes + XPSingleMode _ xptype -> xptype + +-- When in multiple modes, this function sets the next mode +-- in the list of modes as active +setNextMode :: XPState -> XPState +setNextMode st = case operationMode st of + XPMultipleModes modes -> case W.down modes of + [] -> st -- there is no next mode, return same state + (m:ms) -> let + currentMode = W.focus modes + in st { operationMode = XPMultipleModes W.Stack { W.up = [], W.focus = m, W.down = ms ++ [currentMode]}} --set next and move previous current mode to the of the stack + _ -> st --nothing to do, the prompt's operation has only one mode + +-- Returns the highlighted item +highlightedItem :: XPState -> [String] -> Maybe String +highlightedItem st' completions = case complWinDim st' of + Nothing -> Nothing -- when there isn't any compl win, we can't say how many cols,rows there are + Just winDim -> + let + (_,_,_,_,xx,yy) = winDim + complMatrix = splitInSubListsAt (length yy) (take (length xx * length yy) completions) + (col_index,row_index) = (complIndex st') + in case completions of + [] -> Nothing + _ -> Just $ complMatrix !! col_index !! row_index + +-- this would be much easier with functional references +command :: XPState -> String +command = W.focus . commandHistory + +setCommand :: String -> XPState -> XPState +setCommand xs s = s { commandHistory = (commandHistory s) { W.focus = xs }} + +setHighlightedCompl :: Maybe String -> XPState -> XPState +setHighlightedCompl hc st = st { highlightedCompl = hc} + +-- | Sets the input string to the given value. +setInput :: String -> XP () +setInput = modify . setCommand + +-- | Returns the current input string. Intented for use in custom keymaps +-- where 'get' or similar can't be used to retrieve it. +getInput :: XP String +getInput = gets command + +-- | Returns the offset of the current input string. Intended for use in custom +-- keys where 'get' or similar can't be used to retrieve it. +getOffset :: XP Int +getOffset = gets offset + +-- | Accessor encapsulating disparate color fields of 'XPConfig' into an +-- 'XPColor' (the configuration provides default values). +defaultColor :: XPConfig -> XPColor +defaultColor c = XPColor { bgNormal = bgColor c + , fgNormal = fgColor c + , bgHighlight = bgHLight c + , fgHighlight = fgHLight c + , border = borderColor c + } + +-- | Modify the prompt colors. +modifyColor :: (XPColor -> XPColor) -> XP () +modifyColor c = modify $ \s -> s { color = c $ color s } + +-- | Set the prompt colors. +setColor :: XPColor -> XP () +setColor = modifyColor . const + +-- | Reset the prompt colors to those from 'XPConfig'. +resetColor :: XP () +resetColor = gets (defaultColor . config) >>= setColor + +-- | Set the prompt border color. +setBorderColor :: String -> XPColor -> XPColor +setBorderColor bc xpc = xpc { border = bc } + +-- | Modify the prompter, i.e. for chaining prompters. +modifyPrompter :: ((String -> String) -> (String -> String)) -> XP () +modifyPrompter p = modify $ \s -> s { prompter = p $ prompter s } + +-- | Set the prompter. +setPrompter :: (String -> String) -> XP () +setPrompter = modifyPrompter . const + +-- | Reset the prompter to the one from 'XPConfig'. +resetPrompter :: XP () +resetPrompter = gets (defaultPrompter . config) >>= setPrompter + +-- | Set the current completion list, or 'Nothing' to invalidate the current +-- completions. +setCurrentCompletions :: Maybe [String] -> XP () +setCurrentCompletions cs = modify $ \s -> s { currentCompletions = cs } + +-- | Get the current completion list. +getCurrentCompletions :: XP (Maybe [String]) +getCurrentCompletions = gets currentCompletions + +-- | Same as 'mkXPrompt', except that the action function can have +-- type @String -> X a@, for any @a@, and the final action returned +-- by 'mkXPromptWithReturn' will have type @X (Maybe a)@. @Nothing@ +-- is yielded if the user cancels the prompt (by e.g. hitting Esc or +-- Ctrl-G). For an example of use, see the 'XMonad.Prompt.Input' +-- module. +mkXPromptWithReturn :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X a) -> X (Maybe a) +mkXPromptWithReturn t conf compl action = do + st' <- mkXPromptImplementation (showXPrompt t) conf (XPSingleMode compl (XPT t)) + if successful st' + then do + let selectedCompletion = + case alwaysHighlight (config st') of + -- When alwaysHighlight is True, autocompletion is + -- handled with indexes. + False -> command st' + -- When it is false, it is handled depending on the + -- prompt buffer's value. + True -> fromMaybe (command st') $ highlightedCompl st' + Just <$> action selectedCompletion + else return Nothing + +-- | Creates a prompt given: +-- +-- * a prompt type, instance of the 'XPrompt' class. +-- +-- * a prompt configuration ('def' can be used as a starting point) +-- +-- * a completion function ('mkComplFunFromList' can be used to +-- create a completions function given a list of possible completions) +-- +-- * an action to be run: the action must take a string and return 'XMonad.X' () +mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X () +mkXPrompt t conf compl action = mkXPromptWithReturn t conf compl action >> return () + +-- | Creates a prompt with multiple modes given: +-- +-- * A non-empty list of modes +-- * A prompt configuration +-- +-- The created prompt allows to switch between modes with `changeModeKey` in `conf`. The modes are +-- instances of XPrompt. See XMonad.Actions.Launcher for more details +-- +-- The argument supplied to the action to execute is always the current highlighted item, +-- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True. +mkXPromptWithModes :: [XPType] -> XPConfig -> X () +mkXPromptWithModes modes conf = do + let defaultMode = head modes + modeStack = W.Stack { W.focus = defaultMode -- Current mode + , W.up = [] + , W.down = tail modes -- Other modes + } + om = XPMultipleModes modeStack + st' <- mkXPromptImplementation (showXPrompt defaultMode) conf { alwaysHighlight = True } om + if successful st' + then do + case operationMode st' of + XPMultipleModes ms -> let + action = modeAction $ W.focus ms + in action (command st') $ (fromMaybe "" $ highlightedCompl st') + _ -> error "The impossible occurred: This prompt runs with multiple modes but they could not be found." --we are creating a prompt with multiple modes, so its operationMode should have been constructed with XPMultipleMode + else return () + +-- Internal function used to implement 'mkXPromptWithReturn' and +-- 'mkXPromptWithModes'. +mkXPromptImplementation :: String -> XPConfig -> XPOperationMode -> X XPState +mkXPromptImplementation historyKey conf om = do + XConf { display = d, theRoot = rw } <- ask + s <- gets $ screenRect . W.screenDetail . W.current . windowset + numlock <- gets X.numberlockMask + hist <- io readHistory + fs <- initXMF (font conf) + st' <- io $ + bracket + (createWin d rw conf s) + (destroyWindow d) + (\w -> + bracket + (createGC d w) + (freeGC d) + (\gc -> do + selectInput d w $ exposureMask .|. keyPressMask + setGraphicsExposures d gc False + let hs = fromMaybe [] $ M.lookup historyKey hist + st = initState d rw w s om gc fs hs conf numlock + runXP st)) + releaseXMF fs + when (successful st') $ do + let prune = take (historySize conf) + io $ writeHistory $ + M.insertWith + (\xs ys -> prune . historyFilter conf $ xs ++ ys) + historyKey + -- We need to apply historyFilter before as well, since + -- otherwise the filter would not be applied if there is no + -- history + (prune $ historyFilter conf [command st']) + hist + return st' + +-- | Removes numlock and capslock from a keymask. +-- Duplicate of cleanMask from core, but in the +-- XP monad instead of X. +cleanMask :: KeyMask -> XP KeyMask +cleanMask msk = do + numlock <- gets numlockMask + let highMasks = 1 `shiftL` 12 - 1 + return (complement (numlock .|. lockMask) .&. msk .&. highMasks) + +-- | Inverse of 'Codec.Binary.UTF8.String.utf8Encode', that is, a convenience +-- function that checks to see if the input string is UTF8 encoded before +-- decoding. +utf8Decode :: String -> String +utf8Decode str + | isUTF8Encoded str = decodeString str + | otherwise = str + +runXP :: XPState -> IO XPState +runXP st = do + let d = dpy st + w = win st + st' <- bracket + (grabKeyboard d w True grabModeAsync grabModeAsync currentTime) + (\_ -> ungrabKeyboard d currentTime) + (\status -> + (flip execStateT st $ do + when (status == grabSuccess) $ do + updateWindows + eventLoop handleMain evDefaultStop) + `finally` (mapM_ (destroyWindow d) =<< readIORef (complWinRef st)) + `finally` sync d False) + return st' + +type KeyStroke = (KeySym, String) + +-- | Main event "loop". Gives priority to events from the state's event buffer. +eventLoop :: (KeyStroke -> Event -> XP ()) + -> XP Bool + -> XP () +eventLoop handle stopAction = do + b <- gets eventBuffer + (keysym,keystr,event) <- case b of + [] -> do + d <- gets dpy + io $ allocaXEvent $ \e -> do + maskEvent d (exposureMask .|. keyPressMask) e + ev <- getEvent e + (ks,s) <- if ev_event_type ev == keyPress + then lookupString $ asKeyEvent e + else return (Nothing, "") + return (fromMaybe xK_VoidSymbol ks,s,ev) + l -> do + modify $ \s -> s { eventBuffer = tail l } + return $ head l + handle (keysym,keystr) event + stopAction >>= flip unless (eventLoop handle stopAction) + +-- | Default event loop stop condition. +evDefaultStop :: XP Bool +evDefaultStop = (||) <$> (gets modeDone) <*> (gets done) + +-- | Common patterns shared by all event handlers. Expose events can be +-- triggered by switching virtual consoles. +handleOther :: KeyStroke -> Event -> XP () +handleOther _ (ExposeEvent {ev_window = w}) = do + st <- get + when (win st == w) updateWindows +handleOther _ _ = return () + +-- | Prompt event handler for the main loop. Dispatches to input, completion +-- and mode switching handlers. +handleMain :: KeyStroke -> Event -> XP () +handleMain stroke@(keysym,_) (KeyEvent {ev_event_type = t, ev_state = m}) = do + (compKey,modeKey) <- gets $ (completionKey &&& changeModeKey) . config + keymask <- cleanMask m + -- haven't subscribed to keyRelease, so just in case + when (t == keyPress) $ + if (keymask,keysym) == compKey + then getCurrentCompletions >>= handleCompletionMain + else do + setCurrentCompletions Nothing + if (keysym == modeKey) + then modify setNextMode >> updateWindows + else handleInputMain keymask stroke +handleMain stroke event = handleOther stroke event + +-- | Prompt input handler for the main loop. +handleInputMain :: KeyMask -> KeyStroke -> XP () +handleInputMain keymask (keysym,keystr) = do + keymap <- gets (promptKeymap . config) + case M.lookup (keymask,keysym) keymap of + -- 'null keystr' i.e. when only a modifier was pressed + Just action -> action >> updateWindows + Nothing -> unless (null keystr) $ + when (keymask .&. controlMask == 0) $ do + insertString $ utf8Decode keystr + updateWindows + updateHighlightedCompl + complete <- tryAutoComplete + when complete $ setSuccess True >> setDone True + +-- There are two options to store the completion list during the main loop: +-- * Use the State monad, with 'Nothing' as the initial state. +-- * Join the output of the event loop handler to the input of the (same) +-- subsequent handler, using 'Nothing' as the initial input. +-- Both approaches are, under the hood, equivalent. +-- +-- | Prompt completion handler for the main loop. Given 'Nothing', generate the +-- current completion list. With the current list, trigger a completion. +handleCompletionMain :: Maybe [String] -> XP () +handleCompletionMain Nothing = do + cs <- getCompletions + when (length cs > 1) $ + modify $ \s -> s { showComplWin = True } + setCurrentCompletions $ Just cs + handleCompletion cs +handleCompletionMain (Just cs) = handleCompletion cs + +handleCompletion :: [String] -> XP () +handleCompletion cs = do + alwaysHlight <- gets $ alwaysHighlight . config + st <- get + + let updateWins l = redrawWindows l + updateState l = case alwaysHlight of + False -> simpleComplete l st + True | Just (command st) /= highlightedCompl st -> alwaysHighlightCurrent st + | otherwise -> alwaysHighlightNext l st + + case cs of + [] -> updateWindows + [x] -> do updateState [x] + cs' <- getCompletions + updateWins cs' + setCurrentCompletions $ Just cs' + l -> updateState l >> updateWins l + where + -- When alwaysHighlight is off, just complete based on what the + -- user has typed so far. + simpleComplete :: [String] -> XPState -> XP () + simpleComplete l st = do + let newCommand = nextCompletion (currentXPMode st) (command st) l + modify $ \s -> setCommand newCommand $ + s { offset = length newCommand + , highlightedCompl = Just newCommand + } + + -- If alwaysHighlight is on, and this is the first use of the + -- completion key, update the buffer so that it contains the + -- current completion item. + alwaysHighlightCurrent :: XPState -> XP () + alwaysHighlightCurrent st = do + let newCommand = fromMaybe (command st) $ highlightedItem st cs + modify $ \s -> setCommand newCommand $ + setHighlightedCompl (Just newCommand) $ + s { offset = length newCommand + } + + -- If alwaysHighlight is on, and the user wants the next + -- completion, move to the next completion item and update the + -- buffer to reflect that. + -- + --TODO: Scroll or paginate results + alwaysHighlightNext :: [String] -> XPState -> XP () + alwaysHighlightNext l st = do + let complIndex' = nextComplIndex st (length l) + highlightedCompl' = highlightedItem st { complIndex = complIndex'} cs + newCommand = fromMaybe (command st) $ highlightedCompl' + modify $ \s -> setHighlightedCompl highlightedCompl' $ + setCommand newCommand $ + s { complIndex = complIndex' + , offset = length newCommand + } + +-- | Initiate a prompt sub-map event loop. Submaps are intended to provide +-- alternate keybindings. Accepts a default action and a mapping from key +-- combinations to actions. If no entry matches, the default action is run. +promptSubmap :: XP () + -> M.Map (KeyMask, KeySym) (XP ()) + -> XP () +promptSubmap defaultAction keymap = do + md <- gets modeDone + setModeDone False + updateWindows + eventLoop (handleSubmap defaultAction keymap) evDefaultStop + setModeDone md + +handleSubmap :: XP () + -> M.Map (KeyMask, KeySym) (XP ()) + -> KeyStroke + -> Event + -> XP () +handleSubmap defaultAction keymap stroke (KeyEvent {ev_event_type = t, ev_state = m}) = do + keymask <- cleanMask m + when (t == keyPress) $ handleInputSubmap defaultAction keymap keymask stroke +handleSubmap _ _ stroke event = handleOther stroke event + +handleInputSubmap :: XP () + -> M.Map (KeyMask, KeySym) (XP ()) + -> KeyMask + -> KeyStroke + -> XP () +handleInputSubmap defaultAction keymap keymask (keysym,keystr) = do + case M.lookup (keymask,keysym) keymap of + Just action -> action >> updateWindows + Nothing -> unless (null keystr) $ defaultAction >> updateWindows + +-- | Initiate a prompt input buffer event loop. Input is sent to a buffer and +-- bypasses the prompt. The provided function is given the existing buffer and +-- the input keystring. The first field of the result determines whether the +-- input loop continues (if @True@). The second field determines whether the +-- input is appended to the buffer, or dropped (if @False@). If the loop is to +-- stop without keeping input - that is, @(False,False)@ - the event is +-- prepended to the event buffer to be processed by the parent loop. This +-- allows loop to process both fixed and indeterminate inputs. +-- +-- Result given @(continue,keep)@: +-- +-- * cont and keep +-- +-- * grow input buffer +-- +-- * stop and keep +-- +-- * grow input buffer +-- * stop loop +-- +-- * stop and drop +-- +-- * buffer event +-- * stop loop +-- +-- * cont and drop +-- +-- * do nothing +promptBuffer :: (String -> String -> (Bool,Bool)) -> XP (String) +promptBuffer f = do + md <- gets modeDone + setModeDone False + eventLoop (handleBuffer f) evDefaultStop + buff <- gets inputBuffer + modify $ \s -> s { inputBuffer = "" } + setModeDone md + return buff + +handleBuffer :: (String -> String -> (Bool,Bool)) + -> KeyStroke + -> Event + -> XP () +handleBuffer f stroke event@(KeyEvent {ev_event_type = t, ev_state = m}) = do + keymask <- cleanMask m + when (t == keyPress) $ handleInputBuffer f keymask stroke event +handleBuffer _ stroke event = handleOther stroke event + +handleInputBuffer :: (String -> String -> (Bool,Bool)) + -> KeyMask + -> KeyStroke + -> Event + -> XP () +handleInputBuffer f keymask (keysym,keystr) event = do + unless (null keystr || keymask .&. controlMask /= 0) $ do + (evB,inB) <- gets (eventBuffer &&& inputBuffer) + let keystr' = utf8Decode keystr + let (cont,keep) = f inB keystr' + when (keep) $ + modify $ \s -> s { inputBuffer = inB ++ keystr' } + unless (cont) $ + setModeDone True + unless (cont || keep) $ + modify $ \s -> s { eventBuffer = (keysym,keystr,event) : evB } + +-- | Predicate instructing 'promptBuffer' to get (and keep) a single non-empty +-- 'KeyEvent'. +bufferOne :: String -> String -> (Bool,Bool) +bufferOne xs x = (null xs && null x,True) + +--Receives an state of the prompt, the size of the autocompletion list and returns the column,row +--which should be highlighted next +nextComplIndex :: XPState -> Int -> (Int,Int) +nextComplIndex st nitems = case complWinDim st of + Nothing -> (0,0) --no window dims (just destroyed or not created) + Just (_,_,_,_,xx,yy) -> let + (ncols,nrows) = (length xx, length yy) + (currentcol,currentrow) = complIndex st + in if (currentcol + 1 >= ncols) then --hlight is in the last column + if (currentrow + 1 < nrows ) then --hlight is still not at the last row + (currentcol, currentrow + 1) + else + (0,0) + else if(currentrow + 1 < nrows) then --hlight not at the last row + (currentcol, currentrow + 1) + else + (currentcol + 1, 0) + +tryAutoComplete :: XP Bool +tryAutoComplete = do + ac <- gets (autoComplete . config) + case ac of + Just d -> do cs <- getCompletions + case cs of + [c] -> runCompleted c d >> return True + _ -> return False + Nothing -> return False + where runCompleted cmd delay = do + st <- get + let new_command = nextCompletion (currentXPMode st) (command st) [cmd] + modify $ setCommand "autocompleting..." + updateWindows + io $ threadDelay delay + modify $ setCommand new_command + return True + +-- KeyPresses + +-- | Default key bindings for prompts. Click on the \"Source\" link +-- to the right to see the complete list. See also 'defaultXPKeymap''. +defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) +defaultXPKeymap = defaultXPKeymap' isSpace + +-- | A variant of 'defaultXPKeymap' which lets you specify a custom +-- predicate for identifying non-word characters, which affects all +-- the word-oriented commands (move\/kill word). The default is +-- 'isSpace'. For example, by default a path like @foo\/bar\/baz@ +-- would be considered as a single word. You could use a predicate +-- like @(\\c -> isSpace c || c == \'\/\')@ to move through or +-- delete components of the path one at a time. +defaultXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ()) +defaultXPKeymap' p = M.fromList $ + map (first $ (,) controlMask) -- control + + [ (xK_u, killBefore) + , (xK_k, killAfter) + , (xK_a, startOfLine) + , (xK_e, endOfLine) + , (xK_y, pasteString) + -- Retain the pre-0.14 moveWord' behavior: + , (xK_Right, moveWord' p Next >> moveCursor Next) + , (xK_Left, moveCursor Prev >> moveWord' p Prev) + , (xK_Delete, killWord' p Next) + , (xK_BackSpace, killWord' p Prev) + , (xK_w, killWord' p Prev) + , (xK_g, quit) + , (xK_bracketleft, quit) + ] ++ + map (first $ (,) 0) + [ (xK_Return, setSuccess True >> setDone True) + , (xK_KP_Enter, setSuccess True >> setDone True) + , (xK_BackSpace, deleteString Prev) + , (xK_Delete, deleteString Next) + , (xK_Left, moveCursor Prev) + , (xK_Right, moveCursor Next) + , (xK_Home, startOfLine) + , (xK_End, endOfLine) + , (xK_Down, moveHistory W.focusUp') + , (xK_Up, moveHistory W.focusDown') + , (xK_Escape, quit) + ] + +-- | A keymap with many emacs-like key bindings. Click on the +-- \"Source\" link to the right to see the complete list. +-- See also 'emacsLikeXPKeymap''. +emacsLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) +emacsLikeXPKeymap = emacsLikeXPKeymap' isSpace + +-- | A variant of 'emacsLikeXPKeymap' which lets you specify a custom +-- predicate for identifying non-word characters, which affects all +-- the word-oriented commands (move\/kill word). The default is +-- 'isSpace'. For example, by default a path like @foo\/bar\/baz@ +-- would be considered as a single word. You could use a predicate +-- like @(\\c -> isSpace c || c == \'\/\')@ to move through or +-- delete components of the path one at a time. +emacsLikeXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ()) +emacsLikeXPKeymap' p = M.fromList $ + map (first $ (,) controlMask) -- control + + [ (xK_z, killBefore) --kill line backwards + , (xK_k, killAfter) -- kill line fowards + , (xK_a, startOfLine) --move to the beginning of the line + , (xK_e, endOfLine) -- move to the end of the line + , (xK_d, deleteString Next) -- delete a character foward + , (xK_b, moveCursor Prev) -- move cursor forward + , (xK_f, moveCursor Next) -- move cursor backward + , (xK_BackSpace, killWord' p Prev) -- kill the previous word + , (xK_y, pasteString) + , (xK_g, quit) + , (xK_bracketleft, quit) + ] ++ + map (first $ (,) mod1Mask) -- meta key + + [ (xK_BackSpace, killWord' p Prev) + -- Retain the pre-0.14 moveWord' behavior: + , (xK_f, moveWord' p Next >> moveCursor Next) -- move a word forward + , (xK_b, moveCursor Prev >> moveWord' p Prev) -- move a word backward + , (xK_d, killWord' p Next) -- kill the next word + , (xK_n, moveHistory W.focusUp') + , (xK_p, moveHistory W.focusDown') + ] + ++ + map (first $ (,) 0) -- + [ (xK_Return, setSuccess True >> setDone True) + , (xK_KP_Enter, setSuccess True >> setDone True) + , (xK_BackSpace, deleteString Prev) + , (xK_Delete, deleteString Next) + , (xK_Left, moveCursor Prev) + , (xK_Right, moveCursor Next) + , (xK_Home, startOfLine) + , (xK_End, endOfLine) + , (xK_Down, moveHistory W.focusUp') + , (xK_Up, moveHistory W.focusDown') + , (xK_Escape, quit) + ] + +-- | Vim-ish key bindings. Click on the \"Source\" link to the right to see the +-- complete list. See also 'vimLikeXPKeymap''. +vimLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) +vimLikeXPKeymap = vimLikeXPKeymap' (setBorderColor "grey22") id id isSpace + +-- | A variant of 'vimLikeXPKeymap' with customizable aspects: +vimLikeXPKeymap' :: (XPColor -> XPColor) + -- ^ Modifies the prompt color when entering normal mode. + -- The default is @setBorderColor "grey22"@ - same color as + -- the default background color. + -> (String -> String) + -- ^ Prompter to use in normal mode. The default of 'id' + -- balances 'defaultPrompter' but @("[n] " ++)@ is a good + -- alternate with 'defaultPrompter' as @("[i] " ++)@. + -> (String -> String) + -- ^ Filter applied to the X Selection before pasting. The + -- default is 'id' but @filter isPrint@ is a good + -- alternate. + -> (Char -> Bool) + -- ^ Predicate identifying non-word characters. The default + -- is 'isSpace'. See the documentation of other keymaps for + -- alternates. + -> M.Map (KeyMask,KeySym) (XP ()) +vimLikeXPKeymap' fromColor promptF pasteFilter notWord = M.fromList $ + map (first $ (,) 0) + [ (xK_Return, setSuccess True >> setDone True) + , (xK_KP_Enter, setSuccess True >> setDone True) + , (xK_BackSpace, deleteString Prev) + , (xK_Delete, deleteString Next) + , (xK_Left, moveCursor Prev) + , (xK_Right, moveCursor Next) + , (xK_Home, startOfLine) + , (xK_End, endOfLine) + , (xK_Down, moveHistory W.focusUp') + , (xK_Up, moveHistory W.focusDown') + , (xK_Escape, moveCursor Prev + >> modifyColor fromColor + >> setPrompter promptF + >> promptSubmap (return ()) normalVimXPKeymap + >> resetColor + >> resetPrompter + ) + ] where + normalVimXPKeymap = M.fromList $ + map (first $ (,) 0) + [ (xK_i, setModeDone True) + , (xK_a, moveCursor Next >> setModeDone True) + , (xK_s, deleteString Next >> setModeDone True) + , (xK_x, deleteString Next >> clipCursor) + , (xK_Delete, deleteString Next >> clipCursor) + , (xK_p, moveCursor Next + >> pasteString' pasteFilter + >> moveCursor Prev + ) + , (xK_0, startOfLine) + , (xK_Escape, quit) + , (xK_Down, moveHistory W.focusUp') + , (xK_j, moveHistory W.focusUp') + , (xK_Up, moveHistory W.focusDown') + , (xK_k, moveHistory W.focusDown') + , (xK_Right, moveCursorClip Next) + , (xK_l, moveCursorClip Next) + , (xK_h, moveCursorClip Prev) + , (xK_Left, moveCursorClip Prev) + , (xK_BackSpace, moveCursorClip Prev) + -- Implementation using the original 'moveWord'': + --, (xK_e, moveCursor Next >> moveWord' notWord Next >> moveCursor Prev) + --, (xK_b, moveWord' notWord Prev) + --, (xK_w, moveWord' (not . notWord) Next >> clipCursor) + , (xK_e, moveCursorClip Next >> moveWord' notWord Next) + , (xK_b, moveCursorClip Prev >> moveWord' notWord Prev) + , (xK_w, moveWord' (not . notWord) Next >> moveCursorClip Next) + , (xK_f, promptBuffer bufferOne >>= toHeadChar Next) + , (xK_d, promptSubmap (setModeDone True) deleteVimXPKeymap) + , (xK_c, promptSubmap (setModeDone True) changeVimXPKeymap + >> setModeDone True + ) + ] ++ + map (first $ (,) shiftMask) + [ (xK_dollar, endOfLine >> moveCursor Prev) + , (xK_D, killAfter >> moveCursor Prev) + , (xK_C, killAfter >> setModeDone True) + , (xK_P, pasteString' pasteFilter >> moveCursor Prev) + , (xK_A, endOfLine >> setModeDone True) + , (xK_I, startOfLine >> setModeDone True) + , (xK_F, promptBuffer bufferOne >>= toHeadChar Prev) + ] + deleteVimXPKeymap = M.fromList $ + map ((first $ (,) 0) . (second $ flip (>>) (setModeDone True))) + [ (xK_e, deleteString Next >> killWord' notWord Next >> clipCursor) + , (xK_w, killWord' (not . notWord) Next >> clipCursor) + , (xK_0, killBefore) + , (xK_b, killWord' notWord Prev) + , (xK_d, setInput "") + ] ++ + map ((first $ (,) shiftMask) . (second $ flip (>>) (setModeDone True))) + [ (xK_dollar, killAfter >> moveCursor Prev) + ] + changeVimXPKeymap = M.fromList $ + map ((first $ (,) 0) . (second $ flip (>>) (setModeDone True))) + [ (xK_e, deleteString Next >> killWord' notWord Next) + , (xK_0, killBefore) + , (xK_b, killWord' notWord Prev) + , (xK_c, setInput "") + , (xK_w, changeWord notWord) + ] ++ + map ((first $ (,) shiftMask) . (second $ flip (>>) (setModeDone True))) + [ (xK_dollar, killAfter) + ] + +-- Useful for exploring off-by-one issues. +--testOffset :: XP () +--testOffset = do +-- off <- getOffset +-- str <- getInput +-- setInput $ str ++ "|" ++ (show off) ++ ":" ++ (show $ length str) + +-- | Set @True@ to save the prompt's entry to history and run it via the +-- provided action. +setSuccess :: Bool -> XP () +setSuccess b = modify $ \s -> s { successful = b } + +-- | Set @True@ to leave all event loops, no matter how nested. +setDone :: Bool -> XP () +setDone b = modify $ \s -> s { done = b } + +-- | Set @True@ to leave the current event loop, i.e. submaps. +setModeDone :: Bool -> XP () +setModeDone b = modify $ \s -> s { modeDone = b } + +-- KeyPress and State + +-- | Quit. +quit :: XP () +quit = flushString >> setSuccess False >> setDone True >> setModeDone True + +-- | Kill the portion of the command before the cursor +killBefore :: XP () +killBefore = + modify $ \s -> setCommand (drop (offset s) (command s)) $ s { offset = 0 } + +-- | Kill the portion of the command including and after the cursor +killAfter :: XP () +killAfter = + modify $ \s -> setCommand (take (offset s) (command s)) s + +-- | Kill the next\/previous word, using 'isSpace' as the default +-- predicate for non-word characters. See 'killWord''. +killWord :: Direction1D -> XP () +killWord = killWord' isSpace + +-- | Kill the next\/previous word, given a predicate to identify +-- non-word characters. First delete any consecutive non-word +-- characters; then delete consecutive word characters, stopping +-- just before the next non-word character. +-- +-- For example, by default (using 'killWord') a path like +-- @foo\/bar\/baz@ would be deleted in its entirety. Instead you can +-- use something like @killWord' (\\c -> isSpace c || c == \'\/\')@ to +-- delete the path one component at a time. +killWord' :: (Char -> Bool) -> Direction1D -> XP () +killWord' p d = do + o <- gets offset + c <- gets command + let (f,ss) = splitAt o c + delNextWord = snd . break p . dropWhile p + delPrevWord = reverse . delNextWord . reverse + (ncom,noff) = + case d of + Next -> (f ++ delNextWord ss, o) + Prev -> (delPrevWord f ++ ss, length $ delPrevWord f) -- laziness!! + modify $ \s -> setCommand ncom $ s { offset = noff} + +-- | From Vim's @:help cw@: +-- +-- * Special case: When the cursor is in a word, "cw" and "cW" do not include +-- the white space after a word, they only change up to the end of the word. +changeWord :: (Char -> Bool) -> XP () +changeWord p = f <$> getInput <*> getOffset <*> (pure p) >>= id + where + f :: String -> Int -> (Char -> Bool) -> XP () + f str off _ | length str <= off || + length str <= 0 = return () + f str off p'| p' $ str !! off = killWord' (not . p') Next + | otherwise = killWord' p' Next + +-- | Put the cursor at the end of line +endOfLine :: XP () +endOfLine = + modify $ \s -> s { offset = length (command s)} + +-- | Put the cursor at the start of line +startOfLine :: XP () +startOfLine = + modify $ \s -> s { offset = 0 } + +-- | Flush the command string and reset the offset +flushString :: XP () +flushString = modify $ \s -> setCommand "" $ s { offset = 0} + +--reset index if config has `alwaysHighlight`. The inserted char could imply fewer autocompletions. +--If the current index was column 2, row 1 and now there are only 4 autocompletion rows with 1 column, what should we highlight? Set it to the first and start navigation again +resetComplIndex :: XPState -> XPState +resetComplIndex st = if (alwaysHighlight $ config st) then st { complIndex = (0,0) } else st + +-- | Insert a character at the cursor position +insertString :: String -> XP () +insertString str = + modify $ \s -> let + cmd = (c (command s) (offset s)) + st = resetComplIndex $ s { offset = o (offset s)} + in setCommand cmd st + where o oo = oo + length str + c oc oo | oo >= length oc = oc ++ str + | otherwise = f ++ str ++ ss + where (f,ss) = splitAt oo oc + +-- | Insert the current X selection string at the cursor position. The X +-- selection is not modified. +pasteString :: XP () +pasteString = pasteString' id + +-- | A variant of 'pasteString' which allows modifying the X selection before +-- pasting. +pasteString' :: (String -> String) -> XP () +pasteString' f = join $ io $ liftM (insertString . f) getSelection + +-- | Remove a character at the cursor position +deleteString :: Direction1D -> XP () +deleteString d = + modify $ \s -> setCommand (c (command s) (offset s)) $ s { offset = o (offset s)} + where o oo = if d == Prev then max 0 (oo - 1) else oo + c oc oo + | oo >= length oc && d == Prev = take (oo - 1) oc + | oo < length oc && d == Prev = take (oo - 1) f ++ ss + | oo < length oc && d == Next = f ++ tail ss + | otherwise = oc + where (f,ss) = splitAt oo oc + +-- | Ensure the cursor remains over the command by shifting left if necessary. +clipCursor :: XP () +clipCursor = modify $ \s -> s { offset = o (offset s) (command s)} + where o oo c = min (max 0 $ length c - 1) oo + +-- | Move the cursor one position. +moveCursor :: Direction1D -> XP () +moveCursor d = + modify $ \s -> s { offset = o (offset s) (command s)} + where o oo c = if d == Prev then max 0 (oo - 1) else min (length c) (oo + 1) + +-- | Move the cursor one position, but not beyond the command. +moveCursorClip :: Direction1D -> XP () +moveCursorClip = (>> clipCursor) . moveCursor +-- modify $ \s -> s { offset = o (offset s) (command s)} +-- where o oo c = if d == Prev then max 0 (oo - 1) else min (max 0 $ length c - 1) (oo + 1) + +-- | Move the cursor one word, using 'isSpace' as the default +-- predicate for non-word characters. See 'moveWord''. +moveWord :: Direction1D -> XP () +moveWord = moveWord' isSpace + +-- | Given a direction, move the cursor to just before the next +-- (predicate,not-predicate) character transition. This means a (not-word,word) +-- transition should be followed by a 'moveCursorClip' action. Always considers +-- the character under the current cursor position. This means a +-- (word,not-word) transition should be preceded by a 'moveCursorClip' action. +-- Calculated as the length of consecutive non-predicate characters starting +-- from the cursor position, plus the length of subsequent consecutive +-- predicate characters, plus when moving backwards the distance of the cursor +-- beyond the input. Reduced by one to avoid jumping off either end of the +-- input, when present. +-- +-- Use these identities to retain the pre-0.14 behavior: +-- +-- @ +-- (oldMoveWord' p Prev) = (moveCursor Prev >> moveWord' p Prev) +-- @ +-- +-- @ +-- (oldMoveWord' p Next) = (moveWord' p Next >> moveCursor Next) +-- @ +moveWord' :: (Char -> Bool) -> Direction1D -> XP () +moveWord' p d = do + c <- gets command + o <- gets offset + let (f,ss) = splitOn o c + splitOn n xs = (take (n+1) xs, drop n xs) + gap = case d of + Prev -> max 0 $ (o + 1) - (length c) + Next -> 0 + len = max 0 . flip (-) 1 . (gap +) + . uncurry (+) + . (length *** (length . fst . break p)) + . break (not . p) + newoff = case d of + Prev -> o - len (reverse f) + Next -> o + len ss + modify $ \s -> s { offset = newoff } + +-- | Set the prompt's input to an entry further up or further down the history +-- stack. Use 'Stack' functions from 'XMonad.StackSet', i.e. 'focusUp'' or +-- 'focusDown''. +moveHistory :: (W.Stack String -> W.Stack String) -> XP () +moveHistory f = do + modify $ \s -> let ch = f $ commandHistory s + in s { commandHistory = ch + , offset = length $ W.focus ch + , complIndex = (0,0) } + updateWindows + updateHighlightedCompl + +-- | Move the cursor in the given direction to the first instance of the first +-- character of the given string, assuming the string is not empty. The +-- starting cursor character is not considered, and the cursor is placed over +-- the matching character. +toHeadChar :: Direction1D -> String -> XP () +toHeadChar d s = unless (null s) $ do + cmd <- gets command + off <- gets offset + let c = head s + off' = (if d == Prev then negate . fst else snd) + . join (***) (fromMaybe 0 . fmap (+1) . elemIndex c) + . (reverse *** drop 1) + $ (splitAt off cmd) + modify $ \st -> st { offset = offset st + off' } + +updateHighlightedCompl :: XP () +updateHighlightedCompl = do + st <- get + cs <- getCompletions + alwaysHighlight' <- gets $ alwaysHighlight . config + when (alwaysHighlight') $ modify $ \s -> s {highlightedCompl = highlightedItem st cs} + +-- X Stuff + +updateWindows :: XP () +updateWindows = do + d <- gets dpy + drawWin + c <- getCompletions + case c of + [] -> destroyComplWin >> return () + l -> redrawComplWin l + io $ sync d False + +redrawWindows :: [String] -> XP () +redrawWindows c = do + d <- gets dpy + drawWin + case c of + [] -> return () + l -> redrawComplWin l + io $ sync d False + +createWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window +createWin d rw c s = do + let (x,y) = case position c of + Top -> (0,0) + Bottom -> (0, rect_height s - height c) + CenteredAt py w -> (floor $ (fi $ rect_width s) * ((1 - w) / 2), floor $ py * fi (rect_height s) - (fi (height c) / 2)) + width = case position c of + CenteredAt _ w -> floor $ fi (rect_width s) * w + _ -> rect_width s + w <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rw + (rect_x s + x) (rect_y s + fi y) width (height c) + mapWindow d w + return w + +drawWin :: XP () +drawWin = do + st <- get + let (c,(cr,(d,(w,gc)))) = (config &&& color &&& dpy &&& win &&& gcon) st + scr = defaultScreenOfDisplay d + wh = case position c of + CenteredAt _ wd -> floor $ wd * fi (widthOfScreen scr) + _ -> widthOfScreen scr + ht = height c + bw = promptBorderWidth c + Just bgcolor <- io $ initColor d (bgNormal cr) + Just borderC <- io $ initColor d (border cr) + p <- io $ createPixmap d w wh ht + (defaultDepthOfScreen scr) + io $ fillDrawable d p gc borderC bgcolor (fi bw) wh ht + printPrompt p + io $ copyArea d p w gc 0 0 wh ht 0 0 + io $ freePixmap d p + +printPrompt :: Drawable -> XP () +printPrompt drw = do + st <- get + let (pr,(cr,gc)) = (prompter &&& color &&& gcon) st + (c,(d,fs)) = (config &&& dpy &&& fontS) st + (prt,(com,off)) = (pr . show . currentXPMode &&& command &&& offset) st + str = prt ++ com + -- break the string in 3 parts: till the cursor, the cursor and the rest + (f,p,ss) = if off >= length com + then (str, " ","") -- add a space: it will be our cursor ;-) + else let (a,b) = (splitAt off com) + in (prt ++ a, [head b], tail b) + ht = height c + fsl <- io $ textWidthXMF (dpy st) fs f + psl <- io $ textWidthXMF (dpy st) fs p + (asc,desc) <- io $ textExtentsXMF fs str + let y = fi $ ((ht - fi (asc + desc)) `div` 2) + fi asc + x = (asc + desc) `div` 2 + + let draw = printStringXMF d drw fs gc + -- print the first part + draw (fgNormal cr) (bgNormal cr) x y f + -- reverse the colors and print the "cursor" ;-) + draw (bgNormal cr) (fgNormal cr) (x + fromIntegral fsl) y p + -- reverse the colors and print the rest of the string + draw (fgNormal cr) (bgNormal cr) (x + fromIntegral (fsl + psl)) y ss + +-- get the current completion function depending on the active mode +getCompletionFunction :: XPState -> ComplFunction +getCompletionFunction st = case operationMode st of + XPSingleMode compl _ -> compl + XPMultipleModes modes -> completionFunction $ W.focus modes + +-- Completions +getCompletions :: XP [String] +getCompletions = do + s <- get + let q = commandToComplete (currentXPMode s) (command s) + compl = getCompletionFunction s + srt = sorter (config s) + io $ (srt q <$> compl q) `E.catch` \(SomeException _) -> return [] + +setComplWin :: Window -> ComplWindowDim -> XP () +setComplWin w wi = do + wr <- gets complWinRef + io $ writeIORef wr (Just w) + modify (\s -> s { complWin = Just w, complWinDim = Just wi }) + +destroyComplWin :: XP () +destroyComplWin = do + d <- gets dpy + cw <- gets complWin + wr <- gets complWinRef + case cw of + Just w -> do io $ destroyWindow d w + io $ writeIORef wr Nothing + modify (\s -> s { complWin = Nothing, complWinDim = Nothing }) + Nothing -> return () + +type ComplWindowDim = (Position,Position,Dimension,Dimension,Columns,Rows) +type Rows = [Position] +type Columns = [Position] + +createComplWin :: ComplWindowDim -> XP Window +createComplWin wi@(x,y,wh,ht,_,_) = do + st <- get + let d = dpy st + scr = defaultScreenOfDisplay d + w <- io $ mkUnmanagedWindow d scr (rootw st) + x y wh ht + io $ mapWindow d w + setComplWin w wi + return w + +getComplWinDim :: [String] -> XP ComplWindowDim +getComplWinDim compl = do + st <- get + let (c,(scr,fs)) = (config &&& screen &&& fontS) st + wh = case position c of + CenteredAt _ w -> floor $ fi (rect_width scr) * w + _ -> rect_width scr + ht = height c + bw = promptBorderWidth c + + tws <- mapM (textWidthXMF (dpy st) fs) compl + let max_compl_len = fromIntegral ((fi ht `div` 2) + maximum tws) + columns = max 1 $ wh `div` fi max_compl_len + rem_height = rect_height scr - ht + (rows,r) = length compl `divMod` fi columns + needed_rows = max 1 (rows + if r == 0 then 0 else 1) + limit_max_number = case maxComplRows c of + Nothing -> id + Just m -> min m + actual_max_number_of_rows = limit_max_number $ rem_height `div` ht + actual_rows = min actual_max_number_of_rows (fi needed_rows) + actual_height = actual_rows * ht + (x,y) = case position c of + Top -> (0,ht - bw) + Bottom -> (0, (0 + rem_height - actual_height + bw)) + CenteredAt py w + | py <= 1/2 -> (floor $ fi (rect_width scr) * ((1 - w) / 2), floor (py * fi (rect_height scr) + (fi ht)/2) - bw) + | otherwise -> (floor $ fi (rect_width scr) * ((1 - w) / 2), floor (py * fi (rect_height scr) - (fi ht)/2) - actual_height + bw) + (asc,desc) <- io $ textExtentsXMF fs $ head compl + let yp = fi $ (ht + fi (asc - desc)) `div` 2 + xp = (asc + desc) `div` 2 + yy = map fi . take (fi actual_rows) $ [yp,(yp + ht)..] + xx = take (fi columns) [xp,(xp + max_compl_len)..] + + return (rect_x scr + x, rect_y scr + fi y, wh, actual_height, xx, yy) + +drawComplWin :: Window -> [String] -> XP () +drawComplWin w compl = do + st <- get + let c = config st + cr = color st + d = dpy st + scr = defaultScreenOfDisplay d + bw = promptBorderWidth c + gc = gcon st + Just bgcolor <- io $ initColor d (bgNormal cr) + Just borderC <- io $ initColor d (border cr) + + (_,_,wh,ht,xx,yy) <- getComplWinDim compl + + p <- io $ createPixmap d w wh ht + (defaultDepthOfScreen scr) + io $ fillDrawable d p gc borderC bgcolor (fi bw) wh ht + let ac = splitInSubListsAt (length yy) (take (length xx * length yy) compl) + + printComplList d p gc (fgNormal cr) (bgNormal cr) xx yy ac + --lift $ spawn $ "xmessage " ++ " ac: " ++ show ac ++ " xx: " ++ show xx ++ " length xx: " ++ show (length xx) ++ " yy: " ++ show (length yy) + io $ copyArea d p w gc 0 0 wh ht 0 0 + io $ freePixmap d p + +redrawComplWin :: [String] -> XP () +redrawComplWin compl = do + st <- get + nwi <- getComplWinDim compl + let recreate = do destroyComplWin + w <- createComplWin nwi + drawComplWin w compl + if compl /= [] && showComplWin st + then case complWin st of + Just w -> case complWinDim st of + Just wi -> if nwi == wi -- complWinDim did not change + then drawComplWin w compl -- so update + else recreate + Nothing -> recreate + Nothing -> recreate + else destroyComplWin + +-- Finds the column and row indexes in which a string appears. +-- if the string is not in the matrix, the indexes default to (0,0) +findComplIndex :: String -> [[String]] -> (Int,Int) +findComplIndex x xss = let + colIndex = fromMaybe 0 $ findIndex (\cols -> x `elem` cols) xss + rowIndex = fromMaybe 0 $ elemIndex x $ (!!) xss colIndex + in (colIndex,rowIndex) + +printComplList :: Display -> Drawable -> GC -> String -> String + -> [Position] -> [Position] -> [[String]] -> XP () +printComplList d drw gc fc bc xs ys sss = + zipWithM_ (\x ss -> + zipWithM_ (\y item -> do + st <- get + alwaysHlight <- gets $ alwaysHighlight . config + let (f,b) = case alwaysHlight of + True -> -- default to the first item, the one in (0,0) + let + (colIndex,rowIndex) = findComplIndex item sss + in -- assign some colors + if ((complIndex st) == (colIndex,rowIndex)) + then (fgHighlight $ color st,bgHighlight $ color st) + else (fc,bc) + False -> + -- compare item with buffer's value + if completionToCommand (currentXPMode st) item == commandToComplete (currentXPMode st) (command st) + then (fgHighlight $ color st,bgHighlight $ color st) + else (fc,bc) + printStringXMF d drw (fontS st) gc f b x y item) + ys ss) xs sss + +-- History + +type History = M.Map String [String] + +emptyHistory :: History +emptyHistory = M.empty + +getHistoryFile :: IO FilePath +getHistoryFile = fmap (++ "/prompt-history") getXMonadCacheDir + +readHistory :: IO History +readHistory = readHist `E.catch` \(SomeException _) -> return emptyHistory + where + readHist = do + path <- getHistoryFile + xs <- bracket (openFile path ReadMode) hClose hGetLine + readIO xs + +writeHistory :: History -> IO () +writeHistory hist = do + path <- getHistoryFile + let filtered = M.filter (not . null) hist + writeFile path (show filtered) `E.catch` \(SomeException e) -> + hPutStrLn stderr ("error writing history: "++show e) + setFileMode path mode + where mode = ownerReadMode .|. ownerWriteMode + +-- $xutils + +-- | Fills a 'Drawable' with a rectangle and a border +fillDrawable :: Display -> Drawable -> GC -> Pixel -> Pixel + -> Dimension -> Dimension -> Dimension -> IO () +fillDrawable d drw gc borderC bgcolor bw wh ht = do + -- we start with the border + setForeground d gc borderC fillRectangle d drw gc 0 0 wh ht -- here foreground means the background of the text setForeground d gc bgcolor diff --git a/XMonad/Prompt/FuzzyMatch.hs b/XMonad/Prompt/FuzzyMatch.hs --- a/XMonad/Prompt/FuzzyMatch.hs +++ b/XMonad/Prompt/FuzzyMatch.hs @@ -23,7 +23,7 @@ import Data.List -- $usage --- +-- -- This module offers two aspects of fuzzy matching of completions offered by -- XMonad.Prompt. -- @@ -48,22 +48,22 @@ -- 11. "FastSPR" is ranked before "FasterSPR" because its match starts at -- position 5 while the match in "FasterSPR" starts at position 7. -- --- To use these functions in an XPrompt, for example, for windowPromptGoto: +-- To use these functions in an XPrompt, for example, for windowPrompt: -- -- > import XMonad.Prompt --- > import XMonad.Prompt.Window ( windowPromptGoto ) +-- > import XMonad.Prompt.Window ( windowPrompt ) -- > import XMonad.Prompt.FuzzyMatch -- > -- > myXPConfig = def { searchPredicate = fuzzyMatch --- , sorter = fuzzySort --- } --- +-- > , sorter = fuzzySort +-- > } +-- -- then add this to your keys definition: -- --- > , ((modm .|. shiftMask, xK_g), windowPromptGoto myXPConfig) +-- > , ((modm .|. shiftMask, xK_g), windowPrompt myXPConfig Goto allWindows) -- -- For detailed instructions on editing the key bindings, see --- "Xmonad.Doc.Extending#Editing_key_bindings". +-- "XMonad.Doc.Extending#Editing_key_bindings". -- | Returns True if the first argument is a subsequence of the second argument, -- that is, it can be obtained from the second sequence by deleting elements. @@ -77,7 +77,7 @@ -- measured first by the length of the substring containing the match and second -- by the positions of the matching characters in the string. fuzzySort :: String -> [String] -> [String] -fuzzySort q = map snd . sortBy (compare `on` fst) . map (rankMatch q) +fuzzySort q = map snd . sort . map (rankMatch q) rankMatch :: String -> String -> ((Int, Int), String) rankMatch q s = (minimum $ rankMatches q s, s) @@ -95,7 +95,7 @@ findOccurrences s c = map snd $ filter ((toLower c ==) . toLower . fst) $ zip s [0..] extendMatches :: [(Int, Int)] -> [Int] -> [(Int, Int)] -extendMatches spans xs = map last $ groupBy ((==) `on` snd) $ extendMatches' spans xs +extendMatches spans = map last . groupBy ((==) `on` snd) . extendMatches' spans extendMatches' :: [(Int, Int)] -> [Int] -> [(Int, Int)] extendMatches' [] _ = [] diff --git a/XMonad/Prompt/Pass.hs b/XMonad/Prompt/Pass.hs --- a/XMonad/Prompt/Pass.hs +++ b/XMonad/Prompt/Pass.hs @@ -8,23 +8,33 @@ -- Stability : unstable -- Portability : unportable -- --- This module provides 4 to ease password manipulation (generate, read, remove): +-- This module provides 5 s to ease password +-- manipulation (generate, read, edit, remove): -- --- - two to lookup passwords in the password-store; one of which copies to the --- clipboard, and the other uses @xdotool@ to type the password directly. +-- - two to lookup passwords in the password-store; one of which +-- copies to the clipboard, and the other uses @xdotool@ to type the +-- password directly. -- --- - one to generate a password for a given password label that the user inputs. +-- - one to generate a password for a given password label that the +-- user inputs. -- --- - one to delete a stored password for a given password label that the user inputs. +-- - one to edit a password for a given password label that the user +-- inputs. -- --- All those prompts benefit from the completion system provided by the module . +-- - one to delete a stored password for a given password label that +-- the user inputs. -- --- The password store is setup through an environment variable PASSWORD_STORE_DIR, --- or @$HOME\/.password-store@ if it is unset. +-- All those prompts benefit from the completion system provided by +-- the module . -- +-- The password store is setup through an environment variable +-- PASSWORD_STORE_DIR, or @$HOME\/.password-store@ if it is unset. +-- The editor is determined from the environment variable EDITOR. +-- -- Source: -- --- - The password store implementation is . +-- - The +-- implementation is . -- -- - Inspired by -- @@ -34,8 +44,11 @@ -- * Usage -- $usage passPrompt + , passOTPPrompt , passGeneratePrompt + , passGenerateAndCopyPrompt , passRemovePrompt + , passEditPrompt , passTypePrompt ) where @@ -58,10 +71,12 @@ -- -- > import XMonad.Prompt.Pass -- --- Then add a keybinding for 'passPrompt', 'passGeneratePrompt' or 'passRemovePrompt': +-- Then add a keybinding for 'passPrompt', 'passGeneratePrompt', +-- 'passRemovePrompt', 'passEditPrompt' or 'passTypePrompt': -- -- > , ((modMask , xK_p) , passPrompt xpconfig) -- > , ((modMask .|. controlMask, xK_p) , passGeneratePrompt xpconfig) +-- > , ((modMask .|. shiftMask, xK_p) , passEditPrompt xpconfig) -- > , ((modMask .|. controlMask .|. shiftMask, xK_p), passRemovePrompt xpconfig) -- -- For detailed instructions on: @@ -112,6 +127,11 @@ passPrompt :: XPConfig -> X () passPrompt = mkPassPrompt "Select password" selectPassword +-- | A prompt to retrieve a OTP from a given entry. +-- +passOTPPrompt :: XPConfig -> X () +passOTPPrompt = mkPassPrompt "Select OTP" selectOTP + -- | A prompt to generate a password for a given entry. -- This can be used to override an already stored entry. -- (Beware that no confirmation is asked) @@ -119,6 +139,13 @@ passGeneratePrompt :: XPConfig -> X () passGeneratePrompt = mkPassPrompt "Generate password" generatePassword +-- | A prompt to generate a password for a given entry and immediately copy it +-- to the clipboard. This can be used to override an already stored entry. +-- (Beware that no confirmation is asked) +-- +passGenerateAndCopyPrompt :: XPConfig -> X () +passGenerateAndCopyPrompt = mkPassPrompt "Generate and copy password" generateAndCopyPassword + -- | A prompt to remove a password for a given entry. -- (Beware that no confirmation is asked) -- @@ -131,22 +158,45 @@ passTypePrompt :: XPConfig -> X () passTypePrompt = mkPassPrompt "Type password" typePassword +-- | A prompt to edit a given entry. +-- This doesn't touch the clipboard. +-- +passEditPrompt :: XPConfig -> X () +passEditPrompt = mkPassPrompt "Edit password" editPassword + -- | Select a password. -- selectPassword :: String -> X () selectPassword passLabel = spawn $ "pass --clip \"" ++ escapeQuote passLabel ++ "\"" +-- | Select a OTP. +-- +selectOTP :: String -> X () +selectOTP passLabel = spawn $ "pass otp --clip \"" ++ escapeQuote passLabel ++ "\"" + -- | Generate a 30 characters password for a given entry. -- If the entry already exists, it is updated with a new password. -- generatePassword :: String -> X () generatePassword passLabel = spawn $ "pass generate --force \"" ++ escapeQuote passLabel ++ "\" 30" +-- | Generate a 30 characters password for a given entry. +-- If the entry already exists, it is updated with a new password. +-- After generating the password, it is copied to the clipboard. +-- +generateAndCopyPassword :: String -> X () +generateAndCopyPassword passLabel = spawn $ "pass generate --force -c \"" ++ escapeQuote passLabel ++ "\" 30" + -- | Remove a password stored for a given entry. -- removePassword :: String -> X () removePassword passLabel = spawn $ "pass rm --force \"" ++ escapeQuote passLabel ++ "\"" +-- | Edit a password stored for a given entry. +-- +editPassword :: String -> X () +editPassword passLabel = spawn $ "pass edit \"" ++ escapeQuote passLabel ++ "\"" + -- | Type a password stored for a given entry using xdotool. -- typePassword :: String -> X () @@ -163,6 +213,7 @@ getPasswords :: FilePath -> IO [String] getPasswords passwordStoreDir = do files <- runProcessWithInput "find" [ + "-L", -- Traverse symlinks passwordStoreDir, "-type", "f", "-name", "*.gpg", diff --git a/XMonad/Util/ExclusiveScratchpads.hs b/XMonad/Util/ExclusiveScratchpads.hs new file mode 100644 --- /dev/null +++ b/XMonad/Util/ExclusiveScratchpads.hs @@ -0,0 +1,263 @@ +{-# LANGUAGE LambdaCase #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.ExclusiveScratchpads +-- Copyright : Bruce Forte (2017) +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Bruce Forte +-- Stability : unstable +-- Portability : unportable +-- +-- Named scratchpads that can be mutually exclusive. +-- +----------------------------------------------------------------------------- + +module XMonad.Util.ExclusiveScratchpads ( + -- * Usage + -- $usage + mkXScratchpads, + xScratchpadsManageHook, + -- * Keyboard related + scratchpadAction, + hideAll, + resetExclusiveSp, + -- * Mouse related + setNoexclusive, + resizeNoexclusive, + floatMoveNoexclusive, + -- * Types + ExclusiveScratchpad(..), + ExclusiveScratchpads, + -- * Hooks + nonFloating, + defaultFloating, + customFloating + ) where + +import Control.Applicative ((<$>)) +import Control.Monad ((<=<),filterM,liftM2) +import Data.Monoid (appEndo) +import XMonad +import XMonad.Actions.Minimize +import XMonad.Actions.TagWindows (addTag,delTag) +import XMonad.Hooks.ManageHelpers (doRectFloat,isInProperty) + +import qualified XMonad.StackSet as W + +-- $usage +-- +-- For this module to work properly, you need to use "XMonad.Layout.BoringWindows" and +-- "XMonad.Layout.Minimize", please refer to the documentation of these modules for more +-- information on how to configure them. +-- +-- To use this module, put the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Utils.ExclusiveScratchpads +-- > import XMonad.ManageHook (title,appName) +-- > import qualified XMonad.StackSet as W +-- +-- Add exclusive scratchpads, for example: +-- +-- > exclusiveSps = mkXScratchpads [ ("htop", "urxvt -name htop -e htop", title =? "htop") +-- > , ("xclock", "xclock", appName =? "xclock") +-- > ] $ customFloating $ W.RationalRect (1/4) (1/4) (1/2) (1/2) +-- +-- The scratchpads don\'t have to be exclusive, you can create them like this (see 'ExclusiveScratchpad'): +-- +-- > regularSps = [ XSP "term" "urxvt -name scratchpad" (appName =? "scratchpad") defaultFloating [] ] +-- +-- Create a list that contains all your scratchpads like this: +-- +-- > scratchpads = exclusiveSps ++ regularSps +-- +-- Add the hooks to your managehook (see "XMonad.Doc.Extending#Editing_the_manage_hook"), eg.: +-- +-- > manageHook = myManageHook <+> xScratchpadsManageHook scratchpads +-- +-- And finally add some keybindings (see "XMonad.Doc.Extending#Editing_key_bindings"): +-- +-- > , ((modMask, xK_h), scratchpadAction scratchpads "htop") +-- > , ((modMask, xK_c), scratchpadAction scratchpads "xclock") +-- > , ((modMask, xK_t), scratchpadAction scratchpads "term") +-- > , ((modMask, xK_h), hideAll scratchpads) +-- +-- Now you can get your scratchpads by pressing the corresponding keys, if you +-- have the @htop@ scratchpad on your current screen and you fetch the @xclock@ +-- scratchpad then @htop@ gets hidden. +-- +-- If you move a scratchpad it still gets hidden when you fetch a scratchpad of +-- the same family, to change that behaviour and make windows not exclusive +-- anymore when they get resized or moved add these mouse bindings +-- (see "XMonad.Doc.Extending#Editing_mouse_bindings"): +-- +-- > , ((mod4Mask, button1), floatMoveNoexclusive scratchpads) +-- > , ((mod4Mask, button3), resizeNoexclusive scratchpads) +-- +-- To reset a moved scratchpad to the original position that you set with its hook, +-- call @resetExclusiveSp@ when it is in focus. For example if you want to extend +-- Mod-Return to reset the placement when a scratchpad is in focus but keep the +-- default behaviour for tiled windows, set these key bindings: +-- +-- > , ((modMask, xK_Return), windows W.swapMaster >> resetExclusiveSp scratchpads) +-- +-- __Note:__ This is just an example, in general you can add more than two +-- exclusive scratchpads and multiple families of such. + +data ExclusiveScratchpad = XSP { name :: String -- ^ Name of the scratchpad + , cmd :: String -- ^ Command to spawn the scratchpad + , query :: Query Bool -- ^ Query to match the scratchpad + , hook :: ManageHook -- ^ Hook to specify the placement policy + , exclusive :: [String] -- ^ Names of exclusive scratchpads + } + +type ExclusiveScratchpads = [ExclusiveScratchpad] + +-- ----------------------------------------------------------------------------------- + +-- | Create 'ExclusiveScratchpads' from @[(name,cmd,query)]@ with a common @hook@ +mkXScratchpads :: [(String,String,Query Bool)] -- ^ List of @(name,cmd,query)@ of the + -- exclusive scratchpads + -> ManageHook -- ^ The common @hook@ that they use + -> ExclusiveScratchpads +mkXScratchpads xs h = foldl accumulate [] xs + where + accumulate a (n,c,q) = XSP n c q h (filter (n/=) names) : a + names = map (\(n,_,_) -> n) xs + +-- | Create 'ManageHook' from 'ExclusiveScratchpads' +xScratchpadsManageHook :: ExclusiveScratchpads -- ^ List of exclusive scratchpads from + -- which a 'ManageHook' should be generated + -> ManageHook +xScratchpadsManageHook = composeAll . fmap (\sp -> query sp --> hook sp) + +-- | Pop up/hide the scratchpad by name and possibly hide its exclusive +scratchpadAction :: ExclusiveScratchpads -- ^ List of exclusive scratchpads + -> String -- ^ Name of the scratchpad to toggle + -> X () +scratchpadAction xs n = + let ys = filter ((n==).name) xs in + + case ys of [] -> return () + (sp:_) -> let q = query sp in withWindowSet $ \s -> do + ws <- filterM (runQuery q) $ W.allWindows s + + case ws of [] -> do spawn (cmd sp) + hideOthers xs n + windows W.shiftMaster + + (w:_) -> do toggleWindow w + whenX (runQuery isExclusive w) (hideOthers xs n) + where + toggleWindow w = liftM2 (&&) (runQuery isMaximized w) (onCurrentScreen w) >>= \case + True -> whenX (onCurrentScreen w) (minimizeWindow w) + False -> do windows (flip W.shiftWin w =<< W.currentTag) + maximizeWindowAndFocus w + windows W.shiftMaster + + onCurrentScreen w = withWindowSet (return . elem w . currentWindows) + +-- | Hide all 'ExclusiveScratchpads' on the current screen +hideAll :: ExclusiveScratchpads -- ^ List of exclusive scratchpads + -> X () +hideAll xs = mapWithCurrentScreen q minimizeWindow + where q = joinQueries (map query xs) <&&> isExclusive <&&> isMaximized + +-- | If the focused window is a scratchpad, the scratchpad gets reset to the original +-- placement specified with the hook and becomes exclusive again +resetExclusiveSp :: ExclusiveScratchpads -- ^ List of exclusive scratchpads + -> X () +resetExclusiveSp xs = withFocused $ \w -> whenX (isScratchpad xs w) $ do + let ys = filterM (flip runQuery w . query) xs + + unlessX (null <$> ys) $ do + mh <- (head . map hook) <$> ys -- ys /= [], so `head` is fine + n <- (head . map name) <$> ys -- same + + (windows . appEndo <=< runQuery mh) w + hideOthers xs n + delTag "_XSP_NOEXCLUSIVE" w + + where unlessX = whenX . fmap not + +-- ----------------------------------------------------------------------------------- + +-- | Hide the scratchpad of the same family by name if it's on the focused workspace +hideOthers :: ExclusiveScratchpads -> String -> X () +hideOthers xs n = + let ys = concatMap exclusive $ filter ((n==).name) xs + qs = map query $ filter ((`elem` ys).name) xs + q = joinQueries qs <&&> isExclusive <&&> isMaximized in + + mapWithCurrentScreen q minimizeWindow + +-- | Conditionally map a function on all windows of the current screen +mapWithCurrentScreen :: Query Bool -> (Window -> X ()) -> X () +mapWithCurrentScreen q f = withWindowSet $ \s -> do + ws <- filterM (runQuery q) $ currentWindows s + mapM_ f ws + +-- | Extract all windows on the current screen from a StackSet +currentWindows :: W.StackSet i l a sid sd -> [a] +currentWindows = W.integrate' . W.stack . W.workspace . W.current + +-- | Check if given window is a scratchpad +isScratchpad :: ExclusiveScratchpads -> Window -> X Bool +isScratchpad xs w = withWindowSet $ \s -> do + let q = joinQueries $ map query xs + + ws <- filterM (runQuery q) $ W.allWindows s + return $ elem w ws + +-- | Build a disjunction from a list of clauses +joinQueries :: [Query Bool] -> Query Bool +joinQueries = foldl (<||>) (liftX $ return False) + +-- | Useful queries +isExclusive, isMaximized :: Query Bool +isExclusive = (notElem "_XSP_NOEXCLUSIVE" . words) <$> stringProperty "_XMONAD_TAGS" +isMaximized = not <$> isInProperty "_NET_WM_STATE" "_NET_WM_STATE_HIDDEN" + +-- ----------------------------------------------------------------------------------- + +-- | Make a window not exclusive anymore +setNoexclusive :: ExclusiveScratchpads -- ^ List of exclusive scratchpads + -> Window -- ^ Window which should be made not + -- exclusive anymore + -> X () +setNoexclusive xs w = whenX (isScratchpad xs w) $ addTag "_XSP_NOEXCLUSIVE" w + +-- | Float and drag the window, make it not exclusive anymore +floatMoveNoexclusive :: ExclusiveScratchpads -- ^ List of exclusive scratchpads + -> Window -- ^ Window which should be moved + -> X () +floatMoveNoexclusive xs w = setNoexclusive xs w + >> focus w + >> mouseMoveWindow w + >> windows W.shiftMaster + +-- | Resize window, make it not exclusive anymore +resizeNoexclusive :: ExclusiveScratchpads -- ^ List of exclusive scratchpads + -> Window -- ^ Window which should be resized + -> X () +resizeNoexclusive xs w = setNoexclusive xs w + >> focus w + >> mouseResizeWindow w + >> windows W.shiftMaster + +-- ----------------------------------------------------------------------------------- + +-- | Manage hook that makes the window non-floating +nonFloating :: ManageHook +nonFloating = idHook + +-- | Manage hook that makes the window floating with the default placement +defaultFloating :: ManageHook +defaultFloating = doFloat + +-- | Manage hook that makes the window floating with custom placement +customFloating :: W.RationalRect -- ^ @RationalRect x y w h@ that specifies relative position, + -- height and width (see "XMonad.StackSet#RationalRect") + -> ManageHook +customFloating = doRectFloat diff --git a/XMonad/Util/Image.hs b/XMonad/Util/Image.hs --- a/XMonad/Util/Image.hs +++ b/XMonad/Util/Image.hs @@ -37,7 +37,7 @@ -- In the module we suppose that those matrices are represented as [[Bool]], -- so the lengths of the inner lists must be the same. -- --- See "Xmonad.Layout.Decoration" for usage examples +-- See "XMonad.Layout.Decoration" for usage examples -- | Gets the ('width', 'height') of an image imageDims :: [[Bool]] -> (Int, Int) diff --git a/XMonad/Util/Invisible.hs b/XMonad/Util/Invisible.hs --- a/XMonad/Util/Invisible.hs +++ b/XMonad/Util/Invisible.hs @@ -23,6 +23,7 @@ ) where import Control.Applicative +import Control.Monad.Fail -- $usage -- A wrapper data type to store layout state that shouldn't be persisted across @@ -30,10 +31,10 @@ -- Invisible derives trivial definitions for Read and Show, so the wrapped data -- type need not do so. -newtype Invisible m a = I (m a) deriving (Monad, Applicative, Functor) +newtype Invisible m a = I (m a) deriving (Monad, MonadFail, Applicative, Functor) -instance (Functor m, Monad m) => Read (Invisible m a) where - readsPrec _ s = [(fail "Read Invisible", s)] +instance (Functor m, Monad m, MonadFail m) => Read (Invisible m a) where + readsPrec _ s = [(Control.Monad.Fail.fail "Read Invisible", s)] instance Monad m => Show (Invisible m a) where show _ = "" diff --git a/XMonad/Util/Themes.hs b/XMonad/Util/Themes.hs --- a/XMonad/Util/Themes.hs +++ b/XMonad/Util/Themes.hs @@ -19,6 +19,8 @@ , ppThemeInfo , xmonadTheme , smallClean + , adwaitaTheme + , adwaitaDarkTheme , robertTheme , darkTheme , deiflTheme @@ -91,6 +93,8 @@ listOfThemes :: [ThemeInfo] listOfThemes = [ xmonadTheme , smallClean + , adwaitaTheme + , adwaitaDarkTheme , darkTheme , deiflTheme , oxymor00nTheme @@ -129,6 +133,48 @@ , activeTextColor = "white" , inactiveTextColor = "grey" , decoHeight = 14 + } + } + +-- | Matching decorations for Adwaita GTK theme +adwaitaTheme :: ThemeInfo +adwaitaTheme = + newTheme { themeName = "adwaitaTheme" + , themeAuthor = "Alex Griffin" + , themeDescription = "Matching decorations for Adwaita GTK theme" + , theme = def { activeColor = "#dfdcd8" + , inactiveColor = "#f6f5f4" + , urgentColor = "#3584e4" + , activeBorderColor = "#bfb8b1" + , inactiveBorderColor = "#cdc7c2" + , urgentBorderColor = "#1658a7" + , activeTextColor = "#2e3436" + , inactiveTextColor = "#929595" + , urgentTextColor = "#ffffff" + , fontName = "xft:Cantarell:bold:size=11" + , decoWidth = 400 + , decoHeight = 35 + } + } + +-- | Matching decorations for Adwaita-dark GTK theme +adwaitaDarkTheme :: ThemeInfo +adwaitaDarkTheme = + newTheme { themeName = "adwaitaDarkTheme" + , themeAuthor = "Alex Griffin" + , themeDescription = "Matching decorations for Adwaita-dark GTK theme" + , theme = def { activeColor = "#2d2d2d" + , inactiveColor = "#353535" + , urgentColor = "#15539e" + , activeBorderColor = "#070707" + , inactiveBorderColor = "#1c1c1c" + , urgentBorderColor = "#030c17" + , activeTextColor = "#eeeeec" + , inactiveTextColor = "#929291" + , urgentTextColor = "#ffffff" + , fontName = "xft:Cantarell:bold:size=11" + , decoWidth = 400 + , decoHeight = 35 } } diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -1,5 +1,5 @@ name: xmonad-contrib -version: 0.15 +version: 0.16 homepage: http://xmonad.org/ synopsis: Third party extensions for xmonad description: @@ -36,7 +36,7 @@ build-type: Simple bug-reports: https://github.com/xmonad/xmonad-contrib/issues -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1 +tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.1 source-repository head type: git @@ -52,7 +52,7 @@ default: False library - build-depends: base >= 4.5 && < 5, + build-depends: base >= 4.9 && < 5, bytestring >= 0.10 && < 0.11, containers >= 0.5 && < 0.7, directory, @@ -181,6 +181,7 @@ XMonad.Hooks.Minimize XMonad.Hooks.Place XMonad.Hooks.PositionStoreHooks + XMonad.Hooks.RefocusLast XMonad.Hooks.RestoreMinimized XMonad.Hooks.ScreenCorners XMonad.Hooks.Script @@ -285,6 +286,7 @@ XMonad.Layout.ToggleLayouts XMonad.Layout.TrackFloating XMonad.Layout.TwoPane + XMonad.Layout.TwoPanePersistent XMonad.Layout.WindowArranger XMonad.Layout.WindowNavigation XMonad.Layout.WindowSwitcherDecoration @@ -316,6 +318,7 @@ XMonad.Util.Dmenu XMonad.Util.Dzen XMonad.Util.EZConfig + XMonad.Util.ExclusiveScratchpads XMonad.Util.ExtensibleState XMonad.Util.Font XMonad.Util.Image