xmonad-contrib 0.15 → 0.16

raw patch · 21 files changed

+2705/−1222 lines, 21 filesdep ~X11dep ~basedep ~mtlPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: X11, base, mtl

API changes (from Hackage documentation)

Files

• CHANGES.md +120/−1
• XMonad/Actions/DynamicProjects.hs +3/−2
• XMonad/Actions/DynamicWorkspaceOrder.hs +13/−6
• XMonad/Actions/GroupNavigation.hs +27/−3
• XMonad/Doc/Extending.hs +1/−1
• XMonad/Hooks/EwmhDesktops.hs +77/−23
• XMonad/Hooks/RefocusLast.hs +295/−0
• XMonad/Hooks/WallpaperSetter.hs +2/−2
• XMonad/Layout/BinarySpacePartition.hs +68/−14
• XMonad/Layout/Decoration.hs +23/−16
• XMonad/Layout/LayoutCombinators.hs +1/−1
• XMonad/Layout/Tabbed.hs +6/−2
• XMonad/Layout/TwoPanePersistent.hs +98/−0
• XMonad/Prompt.hs +1580/−1124
• XMonad/Prompt/FuzzyMatch.hs +10/−10
• XMonad/Prompt/Pass.hs +61/−10
• XMonad/Util/ExclusiveScratchpads.hs +263/−0
• XMonad/Util/Image.hs +1/−1
• XMonad/Util/Invisible.hs +4/−3
• XMonad/Util/Themes.hs +46/−0
• xmonad-contrib.cabal +6/−3

@@ -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. 

@@ -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 })  --------------------------------------------------------------------------------

@@ -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

@@ -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+

@@ -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":

@@ -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"

@@ -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++-- }}}+

@@ -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 "

@@ -6,6 +6,7 @@ -- Module      :  XMonad.Layout.BinarySpacePartition -- Copyright   :  (c) 2013 Ben Weitzman    <benweitzman@gmail.com> --                    2015 Anton Pirogov   <anton.pirogov@gmail.com>+--                    2019 Mateusz Karbowy <obszczymucha@gmail.com -- License     :  BSD3-style (see LICENSE) -- -- Maintainer  :  Ben Weitzman <benweitzman@gmail.com>@@ -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-<Up>",    sendMessage $ ShrinkFrom D) -- > , ("M-M1-C-<Down>",  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)}

@@ -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 () 

@@ -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

@@ -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

@@ -0,0 +1,98 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.TwoPanePersistent+-- Copyright   :  (c) Chayanon Wichitrnithed+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Chayanon Wichitrnithed <namowi@gatech.edu>+-- 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

@@ -4,1130 +4,1586 @@ -- | -- Module      :  XMonad.Prompt -- Copyright   :  (C) 2007 Andrea Rossato, 2015 Evgeny Kurnevsky---                    2015 Sibi Prabakaran--- License     :  BSD3------ Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>--- 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 + <key>-  [ (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 + <key>-  [ (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 + <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) -- <key>-  [ (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 <spencerjanssen@gmail.com>+-- 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 + <key>+  [ (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 + <key>+  [ (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 + <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) -- <key>+  [ (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

@@ -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' []                    _          = []

@@ -8,23 +8,33 @@ -- Stability   :  unstable -- Portability :  unportable ----- This module provides 4 <XMonad.Prompt> to ease password manipulation (generate, read, remove):+-- This module provides 5 <XMonad.Prompt>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 <XMonad.Prompt>.+-- - 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 <XMonad.Prompt>. --+-- 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 <http://git.zx2c4.com/password-store the password-store cli>.+-- - The <https://www.passwordstore.org/ password store>+--   implementation is <http://git.zx2c4.com/password-store here>. -- -- - Inspired by <http://babushk.in/posts/combining-xmonad-and-pass.html> --@@ -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",

@@ -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

@@ -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)

@@ -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 _ = ""

@@ -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                                       }              } 

@@ -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