diff --git a/CHANGES.md b/CHANGES.md index 2df570b0..6f5af4a4 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -19,6 +19,13 @@ created by XMonad). This isn't perfect, so you might want to disable `Spacing` on such layouts. + * `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` - Added field `gs_bordercolor` to `GSConfig` to specify border color. @@ -77,6 +84,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` @@ -121,6 +133,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.Hooks.FadeWindows @@ -271,6 +292,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/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/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs index 1d6473b9..ce0e4cf9 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 @@ -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 @@ -417,6 +418,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 @@ -460,6 +486,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 +540,7 @@ instance Default PP where , ppVisible = wrap "<" ">" , ppHidden = id , ppHiddenNoWindows = const "" + , ppVisibleNoWindows= Nothing , ppUrgent = id , ppSep = " : " , ppWsSep = " " diff --git a/XMonad/Layout/BinaryColumn.hs b/XMonad/Layout/BinaryColumn.hs new file mode 100644 index 00000000..b0d85381 --- /dev/null +++ b/XMonad/Layout/BinaryColumn.hs @@ -0,0 +1,139 @@ +{-# 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, +-- except for the last pair of windows. +-- +-- 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. +-- +----------------------------------------------------------------------------- + +module XMonad.Layout.BinaryColumn ( + -- * Usage + -- $usage + BinaryColumn (..) + ) where +import XMonad +import qualified XMonad.StackSet +import qualified Data.List + +-- $usage +-- This module defines layout named BinaryColumn. +-- It places all windows in one column. +-- 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 following 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. +-- +-- 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 sizes 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) 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 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