Merge branch 'master' into reSpaced

This commit is contained in:
Brent Yorgey
2018-06-04 13:59:21 -05:00
committed by GitHub
6 changed files with 310 additions and 16 deletions

79
XMonad/Config/Saegesser.hs Executable file
View File

@@ -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

View File

@@ -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 "</fc>"
where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"]
-- | 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 = "<action=`" ++ command ++ "` button=" ++ button ++ ">"
r = "</action>"
-- | 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 ["<raw=", show $ length s, ":", s, "/>"]
-- ??? add an xmobarEscape function?
-- | Strip xmobar markup, specifically the <fc>, <icon> and <action> 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 = " "

View File

@@ -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 <ideasman42@gmail.com>
-- 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)

View File

@@ -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

View File

@@ -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