From 236ca9959d428228d1546e68f9c5183fd5b4f9a4 Mon Sep 17 00:00:00 2001 From: Campbell Barton Date: Sun, 11 Mar 2018 14:38:57 +1100 Subject: [PATCH 1/7] Add BinaryColumn layout This is similar to 'Column' layout with some differences. - Add/remove windows keeps window bounds. - Enforce minimum window size. - Negative scale can be used to increase the size of the last window instead of the master window. --- CHANGES.md | 9 +++ XMonad/Layout/BinaryColumn.hs | 132 ++++++++++++++++++++++++++++++++++ 2 files changed, 141 insertions(+) create mode 100644 XMonad/Layout/BinaryColumn.hs diff --git a/CHANGES.md b/CHANGES.md index 1605706a..515b4f6a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -94,6 +94,15 @@ A new layout based on Dishes, however it accepts additional configuration to allow multiple windows within a single stack. + * `XMonad.Hooks.BinaryColumn` + + A new module which provides a simple grid layout, halving the window + sizes of each window after master. + + This is similar to Column, but splits the window in a way + that maintains window sizes upon adding & removing windows as well as the + option to specify a minimum window size. + ### Bug Fixes and Minor Changes * `XMonad.Actions.Navigation2D` diff --git a/XMonad/Layout/BinaryColumn.hs b/XMonad/Layout/BinaryColumn.hs new file mode 100644 index 00000000..69e49733 --- /dev/null +++ b/XMonad/Layout/BinaryColumn.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.BinaryColumn +-- Copyright : (c) 2009 Ilya Portnov, (c) 2018 Campbell Barton +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Campbell Barton +-- Stability : unstable +-- Portability : unportable +-- +-- Provides Column layout that places all windows in one column. +-- Each window is half the height of the previous. +-- +-- Note: Originally based on XMonad.Layout.Column with edits. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.BinaryColumn ( + -- * Usage + -- $usage + BinaryColumn (..) + ) where +import XMonad +import qualified XMonad.StackSet +import qualified Data.List + +-- $usage +-- This module defines layot named BinaryColumn. +-- It places all windows in one column. +-- Windows heights are calculated that. +-- +-- You can use this module by adding folowing in your @xmonad.hs@: +-- +-- > import XMonad.Layout.BinaryColumn +-- +-- Then add layouts to your layoutHook: +-- +-- > myLayoutHook = BinaryColumn 1.0 32 ||| ... +-- +-- The first value causes the master window to take exactly half of the screen, +-- the second ensures that windows are no less than 32 pixels tall. +-- +-- Shring/Expand can be used to adjust the first value by increments of 0.1. +-- +-- 2.0 uses all space for the master window +-- (minus the space for windows which get their fixed height) +-- 0.0 gives an evenly spaced grid. +-- Negative values reverse the sixes so the last +-- window in the stack becomes larger. +-- + +data BinaryColumn a = BinaryColumn Float Int + deriving (Read, Show) + +instance XMonad.LayoutClass BinaryColumn a where + pureLayout = columnLayout + pureMessage = columnMessage + +columnMessage :: BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a) +columnMessage (BinaryColumn q min_size) m = fmap resize (fromMessage m) + where + resize Shrink = BinaryColumn (max (-2.0) (q - 0.1)) min_size + resize Expand = BinaryColumn (min 2.0 (q + 0.1)) min_size + +columnLayout :: BinaryColumn a + -> XMonad.Rectangle + -> XMonad.StackSet.Stack a + -> [(a, XMonad.Rectangle)] +columnLayout (BinaryColumn scale min_size) rect stack = zip ws rects + where + ws = XMonad.StackSet.integrate stack + n = length ws + scale_abs = abs scale + heights_noflip = + let + -- Regular case: check for min size. + f n size div False = let + n_fl = (fromIntegral n) + n_prev_fl = (fromIntegral (n + 1)) + div_test = min (div) (n_prev_fl) + value_test = (toInteger (round ((fromIntegral size) / div_test))) + value_max = size - (toInteger (min_size * n)) + (value, divide_next, no_room) = + if value_test < value_max then + (value_test, div, False) + else + (value_max, n_fl, True) + size_next = size - value + n_next = n - 1 + in value + : f n_next size_next divide_next no_room + -- Fallback case: when windows have reached min size + -- simply create an even grid with the remaining space. + f n size div True = let + n_fl = (fromIntegral n) + value_even = ((fromIntegral size) / div) + value = (toInteger (round value_even)) + + n_next = n - 1 + size_next = size - value + divide_next = n_fl + in value + : f n_next size_next n_fl True + -- Last item: included twice. + f 0 size div no_room_prev = + [size]; + in f + n_init size_init divide_init False + where + n_init = n - 1 + size_init = (toInteger (rect_height rect)) + divide_init = + if scale_abs == 0.0 then + (fromIntegral n) + else + (1.0 / (0.5 * scale_abs)) + + heights = + if (scale < 0.0) then + Data.List.reverse (take n heights_noflip) + else + heights_noflip + + ys = [fromIntegral $ sum $ take k heights | k <- [0..n - 1]] + rects = map (mkRect rect) $ zip heights ys + +mkRect :: XMonad.Rectangle + -> (Integer,XMonad.Position) + -> XMonad.Rectangle +mkRect (XMonad.Rectangle xs ys ws _) (h, y) = + XMonad.Rectangle xs (ys + fromIntegral y) ws (fromInteger h) From 9c4dad9946a7b28a73bd0499495b8517b1f99af7 Mon Sep 17 00:00:00 2001 From: "Marc A. Saegesser" Date: Wed, 28 Mar 2018 21:16:54 -0500 Subject: [PATCH 2/7] Add spawnOnOnce and related functions. --- CHANGES.md | 5 +++ XMonad/Config/Saegesser.hs | 79 ++++++++++++++++++++++++++++++++++++++ XMonad/Util/SpawnOnce.hs | 37 ++++++++++++++---- 3 files changed, 113 insertions(+), 8 deletions(-) create mode 100755 XMonad/Config/Saegesser.hs diff --git a/CHANGES.md b/CHANGES.md index 62239f32..edb91866 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,11 @@ ### Breaking Changes + * `XMonad.Util.SpawnOnce` + + - Added `spawnOnOnce`, `spawnNOnOnce` and `spawnAndDoOnce`. These are useful in startup hooks + to shift spawned windows to a specific workspace. + * Adding handling of modifySpacing message in smartSpacing and smartSpacingWithEdge layout modifier * `XMonad.Actions.GridSelect` diff --git a/XMonad/Config/Saegesser.hs b/XMonad/Config/Saegesser.hs new file mode 100755 index 00000000..d76622ee --- /dev/null +++ b/XMonad/Config/Saegesser.hs @@ -0,0 +1,79 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-} +{-# LANGUAGE OverloadedStrings #-} + +--------------------------------------------------------------------- +-- | +-- A mostly striped down configuration that demonstrates spawnOnOnce +-- +--------------------------------------------------------------------- +import System.IO + +import XMonad + +import XMonad.Hooks.DynamicLog +import XMonad.Hooks.ManageDocks +import XMonad.Hooks.ManageHelpers +import XMonad.Hooks.UrgencyHook +import XMonad.Hooks.FadeInactive + +import XMonad.Layout.NoBorders +import XMonad.Layout.ResizableTile +import XMonad.Layout.Mosaic + +import XMonad.Util.Run +import XMonad.Util.Cursor +import XMonad.Util.NamedScratchpad +import XMonad.Util.Scratchpad +import XMonad.Util.SpawnOnce + +import XMonad.Actions.CopyWindow +import XMonad.Actions.SpawnOn + +import qualified XMonad.StackSet as W + +main = do + myStatusBarPipe <- spawnPipe "xmobar" + xmonad $ docks $ withUrgencyHook NoUrgencyHook $ def + { terminal = "xterm" + , workspaces = myWorkspaces + , layoutHook = myLayoutHook + , manageHook = myManageHook <+> manageSpawn + , startupHook = myStartupHook + , logHook = myLogHook myStatusBarPipe + , focusFollowsMouse = False + } + +myManageHook = composeOne + [ isDialog -?> doFloat + , className =? "trayer" -?> doIgnore + , className =? "Skype" -?> doShift "chat" + , appName =? "libreoffice" -?> doShift "office" + , return True -?> doF W.swapDown + ] + +myWorkspaces = [ "web", "emacs", "chat", "vm", "office", "media", "xterms", "8", "9", "0"] + +myStartupHook = do + setDefaultCursor xC_left_ptr + spawnOnOnce "emacs" "emacs" + spawnNOnOnce 4 "xterms" "xterm" + +myLayoutHook = smartBorders $ avoidStruts $ standardLayouts + where standardLayouts = tiled ||| mosaic 2 [3,2] ||| Mirror tiled ||| Full + tiled = ResizableTall nmaster delta ratio [] + nmaster = 1 + delta = 0.03 + ratio = 0.6 + +myLogHook p = do + copies <- wsContainingCopies + let check ws | ws == "NSP" = "" -- Hide the scratchpad workspace + | ws `elem` copies = xmobarColor "red" "black" $ ws -- Workspaces with copied windows are red on black + | otherwise = ws + dynamicLogWithPP $ xmobarPP { ppHidden = check + , ppOutput = hPutStrLn p + , ppUrgent = xmobarColor "white" "red" + , ppTitle = xmobarColor "green" "" . shorten 180 + } + fadeInactiveLogHook 0.6 + diff --git a/XMonad/Util/SpawnOnce.hs b/XMonad/Util/SpawnOnce.hs index a281a621..df935097 100644 --- a/XMonad/Util/SpawnOnce.hs +++ b/XMonad/Util/SpawnOnce.hs @@ -15,9 +15,10 @@ -- ----------------------------------------------------------------------------- -module XMonad.Util.SpawnOnce (spawnOnce) where +module XMonad.Util.SpawnOnce (spawnOnce, spawnOnOnce, spawnNOnOnce, spawnAndDoOnce) where import XMonad +import XMonad.Actions.SpawnOn import Data.Set as Set import qualified XMonad.Util.ExtensibleState as XS import Control.Monad @@ -29,11 +30,31 @@ instance ExtensionClass SpawnOnce where initialValue = SpawnOnce Set.empty extensionType = PersistentExtension --- | The first time 'spawnOnce' is executed on a particular command, that --- command is executed. Subsequent invocations for a command do nothing. -spawnOnce :: String -> X () -spawnOnce xs = do - b <- XS.gets (Set.member xs . unspawnOnce) +doOnce :: (String -> X ()) -> String -> X () +doOnce f s = do + b <- XS.gets (Set.member s . unspawnOnce) when (not b) $ do - spawn xs - XS.modify (SpawnOnce . Set.insert xs . unspawnOnce) + f s + XS.modify (SpawnOnce . Set.insert s . unspawnOnce) + + +-- | The first time 'spawnOnce' is executed on a particular command, +-- that command is executed. Subsequent invocations for a command do +-- nothing. +spawnOnce :: String -> X () +spawnOnce cmd = doOnce spawn cmd + +-- | Like spawnOnce but launches the application on the given workspace. +spawnOnOnce :: WorkspaceId -> String -> X () +spawnOnOnce ws cmd = doOnce (spawnOn ws) cmd + +-- | Lanch the given application n times on the specified +-- workspace. Subsequent attempts to spawn this application will be +-- ignored. +spawnNOnOnce :: Int -> WorkspaceId -> String -> X () +spawnNOnOnce n ws cmd = doOnce (\c -> sequence_ $ replicate n $ spawnOn ws c) cmd + +-- | Spawn the application once and apply the manage hook. Subsequent +-- attempts to spawn this application will be ignored. +spawnAndDoOnce :: ManageHook -> String -> X () +spawnAndDoOnce mh cmd = doOnce (spawnAndDo mh) cmd From 869311090c41f8a82c3e416f9fc102011a3c778c Mon Sep 17 00:00:00 2001 From: Campbell Barton Date: Wed, 11 Apr 2018 07:58:11 +0200 Subject: [PATCH 3/7] Correct docs --- XMonad/Layout/BinaryColumn.hs | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/XMonad/Layout/BinaryColumn.hs b/XMonad/Layout/BinaryColumn.hs index 69e49733..b0d85381 100644 --- a/XMonad/Layout/BinaryColumn.hs +++ b/XMonad/Layout/BinaryColumn.hs @@ -10,9 +10,14 @@ -- Portability : unportable -- -- Provides Column layout that places all windows in one column. --- Each window is half the height of the previous. +-- Each window is half the height of the previous, +-- except for the last pair of windows. -- --- Note: Originally based on XMonad.Layout.Column with edits. +-- Note: Originally based on 'XMonad.Layout.Column' with changes: +-- +-- * Adding/removing windows doesn't resize all other windows. +-- (last window pair exception). +-- * Minimum window height option. -- ----------------------------------------------------------------------------- @@ -26,11 +31,13 @@ import qualified XMonad.StackSet import qualified Data.List -- $usage --- This module defines layot named BinaryColumn. +-- This module defines layout named BinaryColumn. -- It places all windows in one column. --- Windows heights are calculated that. +-- Windows heights are calculated to prevent window resizing whenever +-- a window is added or removed. +-- This is done by keeping the last two windows in the stack the same height. -- --- You can use this module by adding folowing in your @xmonad.hs@: +-- You can use this module by adding following in your @xmonad.hs@: -- -- > import XMonad.Layout.BinaryColumn -- @@ -41,12 +48,12 @@ import qualified Data.List -- The first value causes the master window to take exactly half of the screen, -- the second ensures that windows are no less than 32 pixels tall. -- --- Shring/Expand can be used to adjust the first value by increments of 0.1. +-- Shrink/Expand can be used to adjust the first value by increments of 0.1. -- --- 2.0 uses all space for the master window --- (minus the space for windows which get their fixed height) --- 0.0 gives an evenly spaced grid. --- Negative values reverse the sixes so the last +-- * 2.0 uses all space for the master window +-- (minus the space for windows which get their fixed height). +-- * 0.0 gives an evenly spaced grid. +-- Negative values reverse the sizes so the last -- window in the stack becomes larger. -- From 670eb3bc605bbb44167f6c666dc332ad4421d99b Mon Sep 17 00:00:00 2001 From: Miguel Date: Wed, 18 Apr 2018 11:36:46 +0200 Subject: [PATCH 4/7] Added pretty printer for empty visible workspaces Simple extensions of the pretty printer to differentiate between empty and non-empty visible workspaces. Analogical to the existing functionality for hidden workspaces. Particularly useful if some displays managed by xmonad are turned off temporarily. The new 'ppVisibleNoWindows' function was wrapped in a Maybe data type. Its value dafaults to 'Nothing' and 'ppVisible' is used as fallback. --- CHANGES.md | 5 +++++ XMonad/Hooks/DynamicLog.hs | 8 ++++++-- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 91a2a47e..c5952ffd 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -258,6 +258,11 @@ `lineCount` to enable a second (slave) window that displays lines beyond the initial (title) one. + * `XMonad.Hooks.DynamicLog` + + - Added optional `ppVisibleNoWindows` to differentiate between empty + and non-empty visible workspaces in pretty printing. + ## 0.13 (February 10, 2017) ### Breaking Changes diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs index 1d6473b9..e111ab25 100644 --- a/XMonad/Hooks/DynamicLog.hs +++ b/XMonad/Hooks/DynamicLog.hs @@ -62,7 +62,7 @@ import Codec.Binary.UTF8.String (encodeString) import Control.Monad (liftM2, msum) import Data.Char ( isSpace, ord ) import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy) -import Data.Maybe ( isJust, catMaybes, mapMaybe ) +import Data.Maybe ( isJust, catMaybes, mapMaybe, fromMaybe ) import Data.Ord ( comparing ) import qualified Data.Map as M import qualified XMonad.StackSet as S @@ -320,7 +320,8 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $ fmt w = printer pp (S.tag w) where printer | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents = ppUrgent | S.tag w == this = ppCurrent - | S.tag w `elem` visibles = ppVisible + | S.tag w `elem` visibles && isJust (S.stack w) = ppVisible + | S.tag w `elem` visibles = liftM2 fromMaybe ppVisible ppVisibleNoWindows | isJust (S.stack w) = ppHidden | otherwise = ppHiddenNoWindows @@ -460,6 +461,8 @@ data PP = PP { ppCurrent :: WorkspaceId -> String -- contain windows , ppHiddenNoWindows :: WorkspaceId -> String -- ^ how to print tags of empty hidden workspaces + , ppVisibleNoWindows :: Maybe (WorkspaceId -> String) + -- ^ how to print tags of empty visible workspaces , ppUrgent :: WorkspaceId -> String -- ^ format to be applied to tags of urgent workspaces. , ppSep :: String @@ -512,6 +515,7 @@ instance Default PP where , ppVisible = wrap "<" ">" , ppHidden = id , ppHiddenNoWindows = const "" + , ppVisibleNoWindows= Nothing , ppUrgent = id , ppSep = " : " , ppWsSep = " " From 348861da005de3fd4277d25c98ee1eaefac3e764 Mon Sep 17 00:00:00 2001 From: Yclept Nemo Date: Thu, 19 Apr 2018 18:30:30 -0400 Subject: [PATCH 5/7] 'XMonad.Hooks.DynamicLog': xmobar tags Support xmobar's and tags. --- XMonad/Hooks/DynamicLog.hs | 29 +++++++++++++++++++++++++++-- 1 file changed, 27 insertions(+), 2 deletions(-) diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs index 1d6473b9..3a694de2 100644 --- a/XMonad/Hooks/DynamicLog.hs +++ b/XMonad/Hooks/DynamicLog.hs @@ -43,8 +43,8 @@ module XMonad.Hooks.DynamicLog ( -- * Formatting utilities wrap, pad, trim, shorten, - xmobarColor, xmobarStrip, - xmobarStripTags, + xmobarColor, xmobarAction, xmobarRaw, + xmobarStrip, xmobarStripTags, dzenColor, dzenEscape, dzenStrip, -- * Internal formatting functions @@ -417,6 +417,31 @@ xmobarColor :: String -- ^ foreground color: a color name, or #rrggbb format xmobarColor fg bg = wrap t "" where t = concat [""] +-- | Encapsulate text with an action. The text will be displayed, and the +-- action executed when the displayed text is clicked. Illegal input is not +-- filtered, allowing xmobar to display any parse errors. Uses xmobar's new +-- syntax wherein the command is surrounded by backticks. +xmobarAction :: String + -- ^ Command. Use of backticks (`) will cause a parse error. + -> String + -- ^ Buttons 1-5, such as "145". Other characters will cause a + -- parse error. + -> String + -- ^ Displayed/wrapped text. + -> String +xmobarAction command button = wrap l r + where + l = "" + r = "" + +-- | Encapsulate arbitrary text for display only, i.e. untrusted content if +-- wrapped (perhaps from window titles) will be displayed only, with all tags +-- ignored. Introduced in xmobar 0.21; see their documentation. Be careful not +-- to shorten the result. +xmobarRaw :: String -> String +xmobarRaw "" = "" +xmobarRaw s = concat [""] + -- ??? add an xmobarEscape function? -- | Strip xmobar markup, specifically the , and tags and From 26d6bde9c303734c707369f2601b2959c95a43bb Mon Sep 17 00:00:00 2001 From: Yclept Nemo Date: Fri, 20 Apr 2018 11:11:04 -0400 Subject: [PATCH 6/7] 'XMonad.Hooks.DynamicLog': advertise changes --- CHANGES.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 91a2a47e..e7d4b1b4 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -64,6 +64,11 @@ - Handle workspace renames that might be occuring in the custom function that is provided to ewmhDesktopsLogHookCustom. + * `XMonad.Hooks.DynamicLog` + + - Support xmobar's \ and \ tags; see `xmobarAction` and + `xmobarRaw`. + ### New Modules * `XMonad.Hooks.Focus` From 56f7b3acb3eecadc79918d7d08e2e311b0187436 Mon Sep 17 00:00:00 2001 From: "L. S. Leary" Date: Tue, 24 Apr 2018 05:14:06 +1200 Subject: [PATCH 7/7] X.P.FuzzyMatch: Relocate imports so that haddock generation succeeds. --- XMonad/Prompt/FuzzyMatch.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/XMonad/Prompt/FuzzyMatch.hs b/XMonad/Prompt/FuzzyMatch.hs index dd97cba6..24e306ae 100644 --- a/XMonad/Prompt/FuzzyMatch.hs +++ b/XMonad/Prompt/FuzzyMatch.hs @@ -18,6 +18,10 @@ module XMonad.Prompt.FuzzyMatch ( -- * Usage , fuzzySort ) where +import Data.Char +import Data.Function +import Data.List + -- $usage -- -- This module offers two aspects of fuzzy matching of completions offered by @@ -61,10 +65,6 @@ module XMonad.Prompt.FuzzyMatch ( -- * Usage -- For detailed instructions on editing the key bindings, see -- "Xmonad.Doc.Extending#Editing_key_bindings". -import Data.Char -import Data.Function -import Data.List - -- | 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. fuzzyMatch :: String -> String -> Bool