Merge pull request #405 from slotThe/toggleTopic

Update XMonad.Actions.TopicSpace
This commit is contained in:
Brent Yorgey
2020-11-28 14:00:41 -06:00
committed by GitHub
3 changed files with 242 additions and 120 deletions

View File

@@ -177,9 +177,9 @@
* `XMonad.Util.NamedScratchpad`
Added two new exported functions to the module:
- `customRunNamedScratchpadAction`
(provides the option to customize the `X ()` action the scratchpad is launched by)
- `spawnHereNamedScratchpadAction`
- `customRunNamedScratchpadAction`
(provides the option to customize the `X ()` action the scratchpad is launched by)
- `spawnHereNamedScratchpadAction`
(uses `XMonad.Actions.SpawnOn.spawnHere` to initially start the scratchpad on the workspace it was launched on)
* `XMonad.Util.Run`
@@ -266,6 +266,26 @@
can now add `Typeable` to `LayoutClass` in `XMonad.Core` and make it
possible to introspect the current layout and its modifiers.
* `XMonad.Actions.TopicSpace`
- `switchTopic` now correctly updates the last used topics.
- `setLastFocusedTopic` will now check whether we have exceeded the
`maxTopicHistory` and prune the topic history as necessary, as well as
cons the given topic onto the list __before__ filtering it.
- Added `switchNthLastFocusedExclude`, which works like
`switchNthLastFocused` but is able to exclude certain topics.
- Added `switchTopicWith`, which works like `switchTopic`, but one is able
to give `setLastFocusedTopic` a custom filtering function as well.
- Instead of a hand-rolled history, use the oneu from
`XMonad.Hooks.WorkspaceHistory`.
- Added the screen-aware functions `getLastFocusedTopicsByScreen` and
`switchNthLastFocusedByScreen`.
* `XMonad.Hooks.WorkspaceHistory`
- Added `workspaceHistoryModify` to modify the workspace history with a pure
function.
## 0.16
### Breaking Changes

View File

@@ -1,4 +1,3 @@
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.TopicSpace
@@ -19,20 +18,40 @@ module XMonad.Actions.TopicSpace
-- * Usage
-- $usage
Topic
-- * Types for Building Topics
Topic
, Dir
, TopicConfig(..)
-- * Default Topic Config
, def
, getLastFocusedTopics
, setLastFocusedTopic
, reverseLastFocusedTopics
, pprWindowSet
-- * Switching and Shifting Topics
, switchTopic
, switchTopicWith
, switchNthLastFocused
, switchNthLastFocusedByScreen
, switchNthLastFocusedExclude
, shiftNthLastFocused
-- * Topic Actions
, topicActionWithPrompt
, topicAction
, currentTopicAction
, switchTopic
, switchNthLastFocused
, shiftNthLastFocused
-- * Getting the Topic History
, getLastFocusedTopics
, getLastFocusedTopicsByScreen
-- * Modifying the Topic History
, setLastFocusedTopic
, reverseLastFocusedTopics
-- * Pretty Printing
, pprWindowSet
-- * Utility
, currentTopicDir
, checkTopicConfig
, (>*>)
@@ -41,25 +60,28 @@ where
import XMonad
import Data.List
import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust)
import Data.Ord
import qualified Data.Map as M
import Control.Applicative (liftA2)
import Control.Monad (when,unless,replicateM_)
import System.IO
import qualified XMonad.StackSet as W
import XMonad.Prompt
import XMonad.Prompt.Workspace
import XMonad.Hooks.UrgencyHook
import XMonad.Hooks.DynamicLog (PP(..))
import qualified Data.Map as M
import qualified XMonad.Hooks.DynamicLog as DL
import qualified XMonad.StackSet as W
import Control.Applicative (liftA2)
import Control.Monad (replicateM_, unless, when)
import Data.List ((\\), elemIndex, nub, sort, sortOn)
import Data.Maybe (fromJust, fromMaybe, isNothing, listToMaybe)
import System.IO (hClose, hPutStr)
import XMonad.Prompt (XPConfig)
import XMonad.Prompt.Workspace (workspacePrompt)
import XMonad.Hooks.DynamicLog (PP(ppHidden, ppVisible))
import XMonad.Hooks.UrgencyHook (readUrgents)
import XMonad.Hooks.WorkspaceHistory
( workspaceHistory
, workspaceHistoryByScreen
, workspaceHistoryModify
)
import XMonad.Util.Run (spawnPipe)
import qualified XMonad.Util.ExtensibleState as XS
-- $overview
-- This module allows to organize your workspaces on a precise topic basis. So
@@ -75,7 +97,23 @@ import qualified XMonad.Util.ExtensibleState as XS
-- of last focused topics.
-- $usage
-- Here is an example of configuration using TopicSpace:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import qualified Data.Map as M
-- > import qualified XMonad.StackSet as W
-- >
-- > import XMonad.Actions.TopicSpace
--
-- You will then have to
--
-- * Define new a new 'TopicConfig'
--
-- * Add the appropriate keybindings
--
-- * Replace the @workspaces@ field in your 'XConfig' with a list of your
-- topics names
--
-- Let us go through a full example together. Given the following topic names
--
-- > -- The list of all topics/workspaces of your xmonad configuration.
-- > -- The order is important, new topics must be inserted
@@ -88,7 +126,9 @@ import qualified XMonad.Util.ExtensibleState as XS
-- > , "mail", "movie", "music", "talk", "text", "tools", "web", "xmonad"
-- > , "yi", "documents", "twitter", "pdf"
-- > ]
-- >
--
-- we can define a 'TopicConfig' like this
--
-- > myTopicConfig :: TopicConfig
-- > myTopicConfig = def
-- > { topicDirs = M.fromList $
@@ -131,25 +171,22 @@ import qualified XMonad.Util.ExtensibleState as XS
-- > , ("pdf", spawn pdfViewerCmd)
-- > ]
-- > }
-- >
-- > -- extend your keybindings
-- > myKeys conf@XConfig{modMask=modm} =
-- > [ ((modm , xK_n ), spawnShell) -- %! Launch terminal
-- > , ((modm , xK_a ), currentTopicAction myTopicConfig)
-- > , ((modm , xK_g ), promptedGoto)
-- > , ((modm .|. shiftMask, xK_g ), promptedShift)
-- > {- more keys ... -}
-- > ]
-- > ++
-- > [ ((modm, k), switchNthLastFocused myTopicConfig i)
-- > | (i, k) <- zip [1..] workspaceKeys]
-- >
--
-- Above we have used the `spawnShell` and `spawnShellIn` helper functions; here
-- they are:
--
-- > spawnShell :: X ()
-- > spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
-- >
-- > spawnShellIn :: Dir -> X ()
-- > spawnShellIn dir = spawn $ "urxvt '(cd ''" ++ dir ++ "'' && " ++ myShell ++ " )'"
-- >
-- > -- Some terminals support a working-directory option directly:
-- > -- spawnShellIn dir = spawn $ "alacritty --working-directory " ++ dir
--
-- Next, we define some other other useful helper functions. Note that some of
-- these function make use of the 'workspacePrompt' function. You will also
-- have to have an already defined 'XPConfig' (here called @myXPConfig@).
--
-- > goto :: Topic -> X ()
-- > goto = switchTopic myTopicConfig
-- >
@@ -159,22 +196,51 @@ import qualified XMonad.Util.ExtensibleState as XS
-- > promptedShift :: X ()
-- > promptedShift = workspacePrompt myXPConfig $ windows . W.shift
-- >
-- > -- Toggle between the two most recently used topics while filtering
-- > -- out the scratchpad topic.
-- > toggleTopic :: X ()
-- > toggleTopic = switchNthLastFocusedExclude ["NSP"] myTopicConfig 1
--
-- Hopefully you've gotten a general feeling of how to define these kind of
-- small helper functions using what's provided in this module.
--
-- Adding the appropriate keybindings works as it normally would:
--
-- > -- extend your keybindings
-- > myKeys conf@XConfig{modMask=modm} =
-- > [ ((modm , xK_n ), spawnShell) -- %! Launch terminal
-- > , ((modm , xK_a ), currentTopicAction myTopicConfig)
-- > , ((modm , xK_g ), promptedGoto)
-- > , ((modm .|. shiftMask, xK_g ), promptedShift)
-- > , ((modm .|. shiftMask, xK_space ), toggleTopic)
-- > {- more keys ... -}
-- > ]
-- > ++
-- > -- Switching to recently used topics
-- > [ ((modm, k), switchNthLastFocused myTopicConfig i)
-- > | (i, k) <- zip [1..] workspaceKeys]
--
-- If you want a more "default" experience with regards to @M-1@ through @M-9@
-- (i.e. switch to the first nine topics in `myTopics` instead of switching to
-- the last used ones), you can replace the last list above with the following
-- (using "EZConfig" syntax):
--
-- > -- The following does two things:
-- > -- 1. Switch topics (no modifier)
-- > -- 2. Move focused window to topic N (shift modifier)
-- > [ ("M-" ++ m ++ k, f i)
-- > | (i, k) <- zip myTopics (map show [1 .. 9 :: Int])
-- > , (f, m) <- [(goto, ""), (windows . W.shift, "S-")]
-- > ]
--
-- We can now put the whole configuration together with the following (while
-- also checking that we haven't made any mistakes):
--
-- > myConfig = do
-- > checkTopicConfig myTopics myTopicConfig
-- > myLogHook <- makeMyLogHook
-- > return $ def
-- > { borderWidth = 1 -- Width of the window border in pixels.
-- > , workspaces = myTopics
-- > , layoutHook = myModifiers myLayout
-- > , manageHook = myManageHook
-- > , logHook = myLogHook
-- > , handleEventHook = myHandleEventHook
-- > , terminal = myTerminal -- The preferred terminal program.
-- > , normalBorderColor = "#3f3c6d"
-- > , focusedBorderColor = "#4f66ff"
-- > , XMonad.modMask = mod1Mask
-- > , keys = myKeys
-- > , mouseBindings = myMouseBindings
-- > { workspaces = myTopics
-- > , keys = myKeys
-- > }
-- >
-- > main :: IO ()
@@ -188,81 +254,80 @@ infix >*>
-- | 'Topic' is just an alias for 'WorkspaceId'
type Topic = WorkspaceId
-- | 'Dir' is just an alias for 'FilePath' but should points to a directory.
-- | 'Dir' is just an alias for 'FilePath', but should point to a directory.
type Dir = FilePath
-- | Here is the topic space configuration area.
data TopicConfig = TopicConfig { topicDirs :: M.Map Topic Dir
-- ^ This mapping associate a directory to each topic.
-- ^ This mapping associates a directory to each topic.
, topicActions :: M.Map Topic (X ())
-- ^ This mapping associate an action to trigger when
-- ^ This mapping associates an action to trigger when
-- switching to a given topic which workspace is empty.
, defaultTopicAction :: Topic -> X ()
-- ^ This is the default topic action.
, defaultTopic :: Topic
-- ^ This is the default topic.
-- ^ This is the default (= fallback) topic.
, maxTopicHistory :: Int
-- ^ This setups the maximum depth of topic history, usually
-- 10 is a good default since we can bind all of them using
-- numeric keypad.
-- ^ This specifies the maximum depth of the topic history;
-- usually 10 is a good default since we can bind all of
-- them using numeric keypad.
}
instance Default TopicConfig where
def = TopicConfig { topicDirs = M.empty
, topicActions = M.empty
, defaultTopicAction = const (ask >>= spawn . terminal . config)
, defaultTopic = "1"
, maxTopicHistory = 10
}
def = TopicConfig { topicDirs = M.empty
, topicActions = M.empty
, defaultTopicAction = const (ask >>= spawn . terminal . config)
, defaultTopic = "1"
, maxTopicHistory = 10
}
newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable)
instance ExtensionClass PrevTopics where
initialValue = PrevTopics []
extensionType = PersistentExtension
-- | Return the (possibly empty) list of last focused topics.
getLastFocusedTopics :: X [Topic]
getLastFocusedTopics = workspaceHistory
-- | Returns the list of last focused workspaces the empty list otherwise.
getLastFocusedTopics :: X [String]
getLastFocusedTopics = XS.gets getPrevTopics
-- | Like 'getLastFocusedTopics', but group the topics by their screen-id's.
getLastFocusedTopicsByScreen :: X [(ScreenId, [Topic])]
getLastFocusedTopicsByScreen = workspaceHistoryByScreen
-- | Given a 'TopicConfig', the last focused topic, and a predicate that will
-- select topics that one want to keep, this function will set the property
-- of last focused topics.
setLastFocusedTopic :: Topic -> (Topic -> Bool) -> X ()
setLastFocusedTopic w predicate =
XS.modify $ PrevTopics
. seqList . nub . (w:) . filter predicate
. getPrevTopics
where seqList xs = length xs `seq` xs
-- | Given a 'TopicConfig', a topic, and a predicate to select topics that one
-- wants to keep, this function will cons the topic in front of the list of
-- last focused topics and filter it according to the predicate. Note that we
-- prune the list in case that its length exceeds 'maxTopicHistory'.
setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()
setLastFocusedTopic tc w predicate = do
sid <- gets $ W.screen . W.current . windowset
workspaceHistoryModify $
take (maxTopicHistory tc) . nub . filter (predicate . snd) . ((sid, w) :)
-- | Reverse the list of "last focused topics"
reverseLastFocusedTopics :: X ()
reverseLastFocusedTopics =
XS.modify $ PrevTopics . reverse . getPrevTopics
reverseLastFocusedTopics = workspaceHistoryModify reverse
-- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration
-- and a pretty-printing record 'PP'. It will show the list of topics sorted historically
-- and highlighting topics with urgent windows.
-- and highlight topics with urgent windows.
pprWindowSet :: TopicConfig -> PP -> X String
pprWindowSet tg pp = do
winset <- gets windowset
urgents <- readUrgents
let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
maxDepth = maxTopicHistory tg
setLastFocusedTopic (W.tag . W.workspace . W.current $ winset)
(`notElem` empty_workspaces)
lastWs <- getLastFocusedTopics
let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])
add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
sortWindows = take maxDepth . sortBy (comparing $ depth . W.tag)
return $ DL.pprWindowSet sortWindows urgents pp' winset
winset <- gets windowset
urgents <- readUrgents
let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
maxDepth = maxTopicHistory tg
setLastFocusedTopic tg
(W.tag . W.workspace . W.current $ winset)
(`notElem` empty_workspaces)
lastWs <- getLastFocusedTopics
let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])
add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
sortWindows = take maxDepth . sortOn (depth . W.tag)
return $ DL.pprWindowSet sortWindows urgents pp' winset
-- | Given a prompt configuration and a topic configuration, triggers the action associated with
-- | Given a prompt configuration and a topic configuration, trigger the action associated with
-- the topic given in prompt.
topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()
topicActionWithPrompt xp tg = workspacePrompt xp (liftA2 (>>) (switchTopic tg) (topicAction tg))
-- | Given a configuration and a topic, triggers the action associated with the given topic.
-- | Given a configuration and a topic, trigger the action associated with the given topic.
topicAction :: TopicConfig -> Topic -> X ()
topicAction tg topic = fromMaybe (defaultTopicAction tg topic) $ M.lookup topic $ topicActions tg
@@ -272,42 +337,74 @@ currentTopicAction tg = topicAction tg =<< gets (W.tag . W.workspace . W.current
-- | Switch to the given topic.
switchTopic :: TopicConfig -> Topic -> X ()
switchTopic tg topic = do
switchTopic = switchTopicWith (const True)
-- | Like 'switchTopic', but give a custom filtering function to
-- 'setLastFocusedTopic'.
switchTopicWith :: (Topic -> Bool) -> TopicConfig -> Topic -> X ()
switchTopicWith predicate tg topic = do
-- Switch to topic and add it to the last seen topics
windows $ W.greedyView topic
setLastFocusedTopic tg topic predicate
-- If applicable, execute the topic action
wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)
when (null wins) $ topicAction tg topic
-- | Switch to the Nth last focused topic or failback to the 'defaultTopic'.
-- | Switch to the Nth last focused topic or fall back to the 'defaultTopic'.
switchNthLastFocused :: TopicConfig -> Int -> X ()
switchNthLastFocused tg depth = do
lastWs <- getLastFocusedTopics
switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth
switchNthLastFocused = switchNthLastFocusedExclude []
-- | Shift the focused window to the Nth last focused topic, or fallback to doing nothing.
-- | Like 'switchNthLastFocused', but also filter out certain topics.
switchNthLastFocusedExclude :: [Topic] -> TopicConfig -> Int -> X ()
switchNthLastFocusedExclude excludes tc depth = do
lastWs <- filter (`notElem` excludes) <$> getLastFocusedTopics
switchTopic tc $ (lastWs ++ repeat (defaultTopic tc)) !! depth
-- | Like 'switchNthLastFocused', but only consider topics that used to
-- be on the current screen.
--
-- For example, the following function allows one to toggle between the
-- currently focused and the last used topic, while treating different
-- screens completely independently from one another.
--
-- > toggleTopicScreen = switchNthLastFocusedByScreen myTopicConfig 1
switchNthLastFocusedByScreen :: TopicConfig -> Int -> X ()
switchNthLastFocusedByScreen tc depth = do
sid <- gets $ W.screen . W.current . windowset
sws <- fromMaybe []
. listToMaybe
. map snd
. filter ((== sid) . fst)
<$> getLastFocusedTopicsByScreen
switchTopic tc $ (sws ++ repeat (defaultTopic tc)) !! depth
-- | Shift the focused window to the Nth last focused topic, or fall back to doing nothing.
shiftNthLastFocused :: Int -> X ()
shiftNthLastFocused n = do
ws <- fmap (listToMaybe . drop n) getLastFocusedTopics
whenJust ws $ windows . W.shift
-- | Returns the directory associated with current topic returns the empty string otherwise.
currentTopicDir :: TopicConfig -> X String
-- | Return the directory associated with the current topic, or return the empty
-- string if the topic could not be found.
currentTopicDir :: TopicConfig -> X FilePath
currentTopicDir tg = do
topic <- gets (W.tag . W.workspace . W.current . windowset)
return . fromMaybe "" . M.lookup topic $ topicDirs tg
-- | Check the given topic configuration for duplicates topics or undefined topics.
-- | Check the given topic configuration for duplicate or undefined topics.
checkTopicConfig :: [Topic] -> TopicConfig -> IO ()
checkTopicConfig tags tg = do
-- tags <- gets $ map W.tag . workspaces . windowset
-- tags <- gets $ map W.tag . workspaces . windowset
let
seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
dups = tags \\ nub tags
diffTopic = seenTopics \\ sort tags
check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst
let
seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
dups = tags \\ nub tags
diffTopic = seenTopics \\ sort tags
check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst
check diffTopic "Seen but missing topics/workspaces"
check dups "Duplicate topics/workspaces"
check diffTopic "Seen but missing topics/workspaces"
check dups "Duplicate topics/workspaces"
-- | Display the given message using the @xmessage@ program.
xmessage :: String -> IO ()

View File

@@ -25,6 +25,7 @@ module XMonad.Hooks.WorkspaceHistory (
, workspaceHistoryWithScreen
-- * Handling edits
, workspaceHistoryTransaction
, workspaceHistoryModify
) where
import Control.Applicative
@@ -101,3 +102,7 @@ updateLastActiveOnEachScreen StackSet {current = cur, visible = vis} wh =
let newEntry = (sid, wid)
alreadyCurrent = maybe False (== newEntry) $ firstOnScreen sid curr
in if alreadyCurrent then curr else newEntry:delete newEntry curr
-- | Modify a the workspace history with a given pure function.
workspaceHistoryModify :: ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]) -> X ()
workspaceHistoryModify action = XS.modify $ WorkspaceHistory . action . history