Merge branch 'v017' of josher.dev:rde into v017

2 files changed, 32 insertions, 18 deletions

diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 647234c..7cff173 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -22,6 +22,8 @@ import Control.Monad (join, forM_, unless)
 import Data.List (sortOn, intercalate)
 import Data.Ord (Down(..))
 import Data.Typeable (cast)
+import XMonad.Prompt.ConfirmPrompt (confirmPrompt)
+import System.Exit (exitWith, ExitCode(..))
 
 import qualified Data.Map as Map
 import Data.Map (Map)
@@ -94,11 +96,28 @@ justWorkspace s =
   , extraWorkspaceData = ()
   }
 
+justWorkspaceWithPreferredWindow :: Window -> String -> Workspace
+justWorkspaceWithPreferredWindow w s =
+  Workspace {
+    moveLocationToWorkspaceFn = flip moveLocationToWorkspace s
+  , gotoWorkspaceFn = do
+      windows $ \ws' ->
+        let ws = W.greedyView s ws'
+            l = W.integrate' $ W.stack $ W.workspace $ W.current ws in
+          if w `elem` l
+            then W.focusWindow w ws
+            else ws
+
+  , workspaceName = Just s
+  , extraWorkspaceData = ()
+  }
+
 blackHoleWorkspace :: Workspace
 blackHoleWorkspace =
   Workspace {
     moveLocationToWorkspaceFn = mapM_ killWindow . locationWindow
-  , gotoWorkspaceFn = return () -- can't navigate to black hole
+  , gotoWorkspaceFn =
+      confirmPrompt def "Do you want to exit xmonad" $ io (exitWith ExitSuccess)
   , workspaceName = Nothing
   , extraWorkspaceData = ()
   }
@@ -214,6 +233,8 @@ readNextWorkspace :: (KeyFeeder m) => MaybeT m Workspace
 readNextWorkspace =
   readNextKey $ \mask sym str ->
     case (mask, sym, str) of
+      (_, e, _) | e == xK_Escape -> MaybeT $ return Nothing
+
       (_, _, [ch]) | isAlphaNum ch || ch == '*' -> return $ justWorkspace [ch]
       (_, _, "[") ->
         justWorkspace <$>
@@ -270,7 +291,7 @@ readNextWorkspace =
         MaybeT $ fromX $ withWindowSet $ \ws -> return $ do
           win <- locationWindow =<< head loc
           winLocation <- W.findWindow ws win
-          (justWorkspace . W.tag) <$> W.getLocationWorkspace winLocation
+          (justWorkspaceWithPreferredWindow win . W.tag) <$> W.getLocationWorkspace winLocation
 
       (_, _, "~") ->
         justWorkspace . accompaningWorkspace <$> readNextWorkspaceName
@@ -291,27 +312,18 @@ readNextWorkspace =
             then ws3
             else ws4
 
-      (_, _, "<") -> do
-        lift . fromX $
-          logs Trace "Doing thing"
-
-        l1 <- map locationWindow <$> readNextLocationSet
-
-        lift . fromX $
-          logs Trace "%s" (show l1)
-
-        l2 <- map locationWindow <$> readNextLocationSet
+      (_, _, "?") -> do
+        l1 <- readNextLocationSet
 
         ws1 <- readNextWorkspace
         ws2 <- readNextWorkspace
 
-        (lift . fromX) $ (logs Trace "%s < %s? %s" (show l1) (show l2) (show $ all (`elem`l2) l1) :: X ())
-        (lift . fromX) $ (logs Trace "%s %s" (show $ workspaceName ws1) (show $ workspaceName ws2))
+        mt $ logs Trace "If not empty %s then %s else %s" (show l1) (show $ workspaceName ws1) (show $ workspaceName ws2)
 
         return $
-          if all (`elem`l2) l1
-            then ws1
-            else ws2
+          if null l1
+            then ws2
+            else ws1
 
       (mask, keysym, _) -> do
         macro <- (MaybeT . fromX) (Map.lookup (mask, keysym) . workspaceMacros <$> XS.get)
@@ -324,6 +336,8 @@ readNextLocationSet :: (KeyFeeder m) => MaybeT m [Location]
 readNextLocationSet =
   readNextKey $ \mask sym str ->
     case (mask, sym, str) of
+      (_, e, _) | e == xK_Escape -> MaybeT $ return Nothing
+
       (_, _, [ch]) | isAlpha ch -> mt $ getMarkedLocations [ch]
       (_, _, "0") -> (:[]) <$> MaybeT (fromX getMostRecentLocationInHistory)
       (_, _, [ch]) | isDigit ch ->
diff --git a/src/Rahm/Desktop/Swallow.hs b/src/Rahm/Desktop/Swallow.hs
index 1939c58..a411b3f 100644
--- a/src/Rahm/Desktop/Swallow.hs
+++ b/src/Rahm/Desktop/Swallow.hs
@@ -26,4 +26,4 @@ toggleSwallowEnabled :: X ()
 toggleSwallowEnabled = (setSwallowEnabled . not) =<< isSwallowEnabled
 
 instance ExtensionClass DisableSwallow where
-  initialValue = DisableSwallow False
+  initialValue = DisableSwallow True