blob: feb5f261c60cfb07cbf51f93255e1cab6b253ac5 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
{-# LANGUAGE RankNTypes #-}
module Internal.Lib where
import Prelude hiding ((!!))
import XMonad.Util.Run
import XMonad.Prompt
import XMonad.Prompt.Input
import XMonad.Prompt.Shell
import Internal.PromptConfig
import Data.Char
import Data.List hiding ((!!))
import Data.List.Safe ((!!))
import Data.Maybe
import Internal.Marking
import Internal.XPlus
import Text.Printf
import XMonad hiding (workspaces, Screen)
import XMonad.StackSet hiding (filter, focus)
import qualified Data.Map as Map
import Internal.DMenu
type WorkspaceName = Char
newtype Selector = Selector (forall a. (Eq a) => a -> [a] -> a)
data WinPrompt = WinPrompt
instance XPrompt WinPrompt where
showXPrompt _ = "[Window] "
commandToComplete _ = id
getHorizontallyOrderedScreens ::
StackSet wid l a ScreenId ScreenDetail ->
[Screen wid l a ScreenId ScreenDetail]
-- ^ Returns a list of screens ordered from leftmost to rightmost.
getHorizontallyOrderedScreens windowSet =
flip sortBy screens $ \sc1 sc2 ->
let (SD (Rectangle x1 _ _ _)) = screenDetail sc1
(SD (Rectangle x2 _ _ _)) = screenDetail sc2
in x1 `compare` x2
where
screens = current windowSet : visible windowSet
gotoWorkspace :: WorkspaceName -> XPlus l ()
gotoWorkspace ch = do
mc <- getMarkContext
liftXPlus $ do
saveLastMark mc
windows $ greedyView $ return ch
shiftToWorkspace :: WorkspaceName -> XPlus l ()
shiftToWorkspace = liftXPlus . windows . shift . return
swapWorkspace :: WorkspaceName -> XPlus l ()
swapWorkspace toWorkspaceName = liftXPlus $ do
windows $ \ss -> do
let fromWorkspace = tag $ workspace $ current ss
toWorkspace = [toWorkspaceName] in
(StackSet (swapSc fromWorkspace toWorkspace $ current ss)
(map (swapSc fromWorkspace toWorkspace) $ visible ss)
(map (swapWs fromWorkspace toWorkspace) $ hidden ss)
(floating ss))
where
swapSc fromWorkspace toWorkspace (Screen ws a b) =
Screen (swapWs fromWorkspace toWorkspace ws) a b
swapWs fromWorkspace toWorkspace ws@(Workspace t' l s)
| t' == fromWorkspace = Workspace toWorkspace l s
| t' == toWorkspace = Workspace fromWorkspace l s
| otherwise = ws
fuzzyCompletion :: String -> String -> Bool
fuzzyCompletion str0 str1 =
all (`isInfixOf`l0) ws
where
ws = filter (not . all isSpace) $ words (map toLower str0)
l0 = map toLower str1
getString :: Window -> X String
getString = runQuery $ do
t <- title
a <- appName
return $
if map toLower a `isInfixOf` map toLower t
then t
else printf "%s - %s" t a
relativeWorkspaceShift :: Selector -> X ()
relativeWorkspaceShift (Selector selector) = do
windows $ \ss ->
let tags = sort $ (tag <$> filter (isJust . stack) (workspaces ss))
from = tag $ workspace $ current ss
to = selector from tags
in greedyView to ss
next :: Selector
next = Selector $ \a l -> select a l l
where select n (x:y:xs) _ | n == x = y
select n [x] (y:_) | n == x = y
select n (x:xs) orig = select n xs orig
select n _ _ = n
prev :: Selector
prev = Selector $ \a l ->
let (Selector fn) = next in fn a (reverse l)
withScreen :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> XPlus l ()
withScreen fn n = do
markContext <- getMarkContext
liftXPlus $
windows $ \windowSet ->
case (getHorizontallyOrderedScreens windowSet !! n) of
Nothing -> windowSet
Just screen -> fn (tag $ workspace screen) windowSet
windowJump :: XPlus l ()
windowJump = do
markContext <- getMarkContext
liftXPlus $ do
windowTitlesToWinId <- withWindowSet $ \ss ->
Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss)
windowId <- runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
case windowId of
Nothing -> return ()
Just wid -> do
saveLastMark markContext
focus wid
-- mkXPrompt
-- WinPrompt
-- xpConfig
-- (\input -> return $ filter (fuzzyCompletion input) (Map.keys windowTitlesToWinId)) $
-- \str -> do
-- saveLastMark markContext
-- case Map.lookup str windowTitlesToWinId of
-- Just w -> focus w
-- Nothing ->
-- case filter (fuzzyCompletion str) (Map.keys windowTitlesToWinId) of
-- [s] -> mapM_ focus (Map.lookup s windowTitlesToWinId)
-- _ -> return ()
|