Merge branch 'master' into master

This commit is contained in:
Brent Yorgey 2017-03-30 16:02:47 -05:00 committed by GitHub
commit 08abaccdce
25 changed files with 390 additions and 155 deletions

24
.github/ISSUE_TEMPLATE.md vendored Normal file
View File

@ -0,0 +1,24 @@
### Problem Description
Describe the problem you are having, what you expect to happen
instead, and how to reproduce the problem.
### Configuration File
Please include the smallest configuration file that reproduces the
problem you are experiencing:
```haskell
module Main (main) where
import XMonad
main :: IO ()
main = xmonad def
```
### Checklist
- [ ] I've read [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)
- [ ] I tested my configuration with [xmonad-testing](https://github.com/xmonad/xmonad-testing)

12
.github/PULL_REQUEST_TEMPLATE.md vendored Normal file
View File

@ -0,0 +1,12 @@
### Description
Include a description for your changes, including the motivation
behind them.
### Checklist
- [ ] I've read [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)
- [ ] I tested my changes with [xmonad-testing](https://github.com/xmonad/xmonad-testing)
- [ ] I updated the `CHANGES.md` file

1
.gitignore vendored
View File

@ -23,3 +23,4 @@ tags
# stack artifacts # stack artifacts
/.stack-work/ /.stack-work/
/cabal.project.local

View File

@ -1,12 +1,40 @@
# Change Log / Release Notes # Change Log / Release Notes
## 0.13 ## 0.14 (Not Yet)
### Breaking Changes
* `XMonad.Actions.GridSelect`
- Added field `gs_bordercolor` to `GSConfig` to specify border color.
### Bug Fixes and Minor Changes
* `XMonad.Actions.GridSelect`
- The vertical centring of text in each cell has been improved.
* `XMonad.Util.WindowProperties`
- Added the ability to test if a window has a tag from
`XMonad.Actions.TagWindows`
* `XMonad.Layout.Magnifier`
- Handle `IncMasterN` messages.
* `XMonad.Util.EZConfig`
- Can now parse Latin1 keys, to better accommodate users with
non-US keyboards.
## 0.13 (February 10, 2017)
### Breaking Changes ### Breaking Changes
* The type of `completionKey` (of `XPConfig` record) has been * The type of `completionKey` (of `XPConfig` record) has been
changed from `KeySym` to `(KeyMask, KeySym)`. The default value changed from `KeySym` to `(KeyMask, KeySym)`. The default value
for this is still binded to `Tab` key. for this is still bound to the `Tab` key.
* New constructor `CenteredAt Rational Rational` added for * New constructor `CenteredAt Rational Rational` added for
`XMonad.Prompt.XPPosition`. `XMonad.Prompt.XPPosition`.
@ -23,6 +51,9 @@
Also, you can use regular 'ManageHook' combinators for changing window Also, you can use regular 'ManageHook' combinators for changing window
activation behavior. activation behavior.
* `XMonad.Prompt` now stores its history file in the XMonad cache
directory in a file named `prompt-history`.
### New Modules ### New Modules
* `XMonad.Layout.SortedLayout` * `XMonad.Layout.SortedLayout`
@ -67,13 +98,35 @@
called for activated windows. But this lifts `manageHook` into called for activated windows. But this lifts `manageHook` into
`FocusHook` and it needs to be converted back later using `manageFocus`. `FocusHook` and it needs to be converted back later using `manageFocus`.
### Minor Changes ### Bug Fixes and Minor Changes
* `XMonad.Hooks.ManageDocks`,
- Fix a very annoying bug where taskbars/docs would be
covered by windows.
- Also fix a bug that caused certain Gtk and Qt application to
have issues displaying menus and popups.
* `XMonad.Layout.LayoutBuilder` * `XMonad.Layout.LayoutBuilder`
Merge all functionality from `XMonad.Layout.LayoutBuilderP` into Merge all functionality from `XMonad.Layout.LayoutBuilderP` into
`XMonad.Layout.LayoutBuilder`. `XMonad.Layout.LayoutBuilder`.
* `XMonad.Actions.WindowGo`
- Fix `raiseNextMaybe` cycling between 2 workspaces only.
* `XMonad.Actions.UpdatePointer`
- Fix bug when cursor gets stuck in one of the corners.
* `XMonad.Actions.Submap`
Establish pointer grab to avoid freezing X, when button press occurs after
submap key press. And terminate submap at button press in the same way,
as we do for wrong key press.
* `XMonad.Actions.DynamicProjects` * `XMonad.Actions.DynamicProjects`
- Switching away from a dynamic project that contains no windows - Switching away from a dynamic project that contains no windows
@ -82,13 +135,10 @@
The project itself was already being deleted, this just deletes The project itself was already being deleted, this just deletes
the workspace created for it as well. the workspace created for it as well.
* `XMonad.Actions.WindowGo` - Added function to change the working directory (`changeProjectDirPrompt`)
- Fix `raiseNextMaybe` cycling between 2 workspaces only. - All of the prompts are now multiple mode prompts. Try using the
`changeModeKey` in a prompt and see what happens!
* `XMonad.Actions.UpdatePointer`
- Fix bug when cursor gets stuck in one of the corners.
* `XMonad.Actions.Submap` * `XMonad.Actions.Submap`

View File

@ -239,6 +239,7 @@ data WSType = EmptyWS -- ^ cycle through empty workspaces
| NonEmptyWS -- ^ cycle through non-empty workspaces | NonEmptyWS -- ^ cycle through non-empty workspaces
| HiddenWS -- ^ cycle through non-visible workspaces | HiddenWS -- ^ cycle through non-visible workspaces
| HiddenNonEmptyWS -- ^ cycle through non-empty non-visible workspaces | HiddenNonEmptyWS -- ^ cycle through non-empty non-visible workspaces
| HiddenEmptyWS -- ^ cycle through empty non-visible workspaces
| AnyWS -- ^ cycle through all workspaces | AnyWS -- ^ cycle through all workspaces
| WSTagGroup Char | WSTagGroup Char
-- ^ cycle through workspaces in the same group, the -- ^ cycle through workspaces in the same group, the
@ -257,6 +258,9 @@ wsTypeToPred HiddenWS = do hs <- gets (map tag . hidden . windowset)
wsTypeToPred HiddenNonEmptyWS = do ne <- wsTypeToPred NonEmptyWS wsTypeToPred HiddenNonEmptyWS = do ne <- wsTypeToPred NonEmptyWS
hi <- wsTypeToPred HiddenWS hi <- wsTypeToPred HiddenWS
return (\w -> hi w && ne w) return (\w -> hi w && ne w)
wsTypeToPred HiddenEmptyWS = do ne <- wsTypeToPred EmptyWS
hi <- wsTypeToPred HiddenWS
return (\w -> hi w && ne w)
wsTypeToPred AnyWS = return (const True) wsTypeToPred AnyWS = return (const True)
wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) `fmap` gets windowset wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) `fmap` gets windowset
return $ (cur ==).groupName return $ (cur ==).groupName

View File

@ -31,6 +31,7 @@ module XMonad.Actions.DynamicProjects
, switchProjectPrompt , switchProjectPrompt
, shiftToProjectPrompt , shiftToProjectPrompt
, renameProjectPrompt , renameProjectPrompt
, changeProjectDirPrompt
-- * Helper Functions -- * Helper Functions
, switchProject , switchProject
@ -43,6 +44,7 @@ module XMonad.Actions.DynamicProjects
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Control.Monad (when, unless) import Control.Monad (when, unless)
import Data.Char (isSpace)
import Data.List (sort, union, stripPrefix) import Data.List (sort, union, stripPrefix)
import Data.Map.Strict (Map) import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
@ -52,8 +54,7 @@ import System.Directory (setCurrentDirectory, getHomeDirectory)
import XMonad import XMonad
import XMonad.Actions.DynamicWorkspaces import XMonad.Actions.DynamicWorkspaces
import XMonad.Prompt import XMonad.Prompt
import XMonad.Prompt.Directory (directoryPrompt) import XMonad.Prompt.Directory
import XMonad.Prompt.Workspace (Wor(..))
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS import qualified XMonad.Util.ExtensibleState as XS
@ -142,6 +143,48 @@ data ProjectState = ProjectState
instance ExtensionClass ProjectState where instance ExtensionClass ProjectState where
initialValue = ProjectState Map.empty Nothing initialValue = ProjectState Map.empty Nothing
--------------------------------------------------------------------------------
-- Internal types for working with XPrompt.
data ProjectPrompt = ProjectPrompt ProjectMode [ProjectName]
data ProjectMode = SwitchMode | ShiftMode | RenameMode | DirMode
instance XPrompt ProjectPrompt where
showXPrompt (ProjectPrompt submode _) =
case submode of
SwitchMode -> "Switch or Create Project: "
ShiftMode -> "Send Window to Project: "
RenameMode -> "New Project Name: "
DirMode -> "Change Project Directory: "
completionFunction (ProjectPrompt RenameMode _) = return . (:[])
completionFunction (ProjectPrompt DirMode _) =
let xpt = directoryMultipleModes "" (const $ return ())
in completionFunction xpt
completionFunction (ProjectPrompt _ ns) = mkComplFunFromList' ns
modeAction (ProjectPrompt SwitchMode _) buf auto = do
let name = if null auto then buf else auto
ps <- XS.gets projects
case Map.lookup name ps of
Just p -> switchProject p
Nothing | null name -> return ()
| otherwise -> switchProject (defProject name)
modeAction (ProjectPrompt ShiftMode _) buf auto = do
let name = if null auto then buf else auto
ps <- XS.gets projects
shiftToProject . fromMaybe (defProject name) $ Map.lookup name ps
modeAction (ProjectPrompt RenameMode _) name _ =
when (not (null name) && not (all isSpace name)) $ do
renameWorkspaceByName name
modifyProject (\p -> p { projectName = name })
modeAction (ProjectPrompt DirMode _) buf auto = do
let dir = if null auto then buf else auto
modifyProject (\p -> p { projectDirectory = dir })
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Add dynamic projects support to the given config. -- | Add dynamic projects support to the given config.
dynamicProjects :: [Project] -> XConfig a -> XConfig a dynamicProjects :: [Project] -> XConfig a -> XConfig a
@ -198,6 +241,21 @@ currentProject = do
proj <- lookupProject name proj <- lookupProject name
return $ fromMaybe (defProject name) proj return $ fromMaybe (defProject name) proj
--------------------------------------------------------------------------------
-- | Modify the current project using a pure function.
modifyProject :: (Project -> Project) -> X ()
modifyProject f = do
p <- currentProject
ps <- XS.gets projects
-- If a project is renamed to match another project, the old project
-- will be removed and replaced with this one.
let new = f p
ps' = Map.insert (projectName new) new $ Map.delete (projectName p) ps
XS.modify $ \s -> s {projects = ps'}
activateProject new
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Switch to the given project. -- | Switch to the given project.
switchProject :: Project -> X () switchProject :: Project -> X ()
@ -220,22 +278,11 @@ switchProject p = do
-- | Prompt for a project name and then switch to it. Automatically -- | Prompt for a project name and then switch to it. Automatically
-- creates a project if a new name is returned from the prompt. -- creates a project if a new name is returned from the prompt.
switchProjectPrompt :: XPConfig -> X () switchProjectPrompt :: XPConfig -> X ()
switchProjectPrompt c = projectPrompt c switch switchProjectPrompt = projectPrompt [ SwitchMode
where , ShiftMode
switch :: ProjectTable -> ProjectName -> X () , RenameMode
switch ps name = case Map.lookup name ps of , DirMode
Just p -> switchProject p ]
Nothing | null name -> return ()
| otherwise -> directoryPrompt dirC "Project Dir: " (mkProject name)
dirC :: XPConfig
dirC = c { alwaysHighlight = False } -- Fix broken tab completion.
mkProject :: ProjectName -> FilePath -> X ()
mkProject name dir = do
let p = Project name dir Nothing
XS.modify $ \s -> s {projects = Map.insert name p $ projects s}
switchProject p
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Shift the currently focused window to the given project. -- | Shift the currently focused window to the given project.
@ -248,40 +295,44 @@ shiftToProject p = do
-- | Prompts for a project name and then shifts the currently focused -- | Prompts for a project name and then shifts the currently focused
-- window to that project. -- window to that project.
shiftToProjectPrompt :: XPConfig -> X () shiftToProjectPrompt :: XPConfig -> X ()
shiftToProjectPrompt c = projectPrompt c go shiftToProjectPrompt = projectPrompt [ ShiftMode
where , RenameMode
go :: ProjectTable -> ProjectName -> X () , SwitchMode
go ps name = shiftToProject . fromMaybe (defProject name) $ , DirMode
Map.lookup name ps ]
--------------------------------------------------------------------------------
-- | Prompt for a project name.
projectPrompt :: XPConfig -> (ProjectTable -> ProjectName -> X ()) -> X ()
projectPrompt c f = do
ws <- map W.tag `fmap` gets (W.workspaces . windowset)
ps <- XS.gets projects
let names = sort (Map.keys ps `union` ws)
label = "Switch or Create Project: "
mkXPrompt (Wor label) c (mkComplFunFromList' names) (f ps)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Rename the current project. -- | Rename the current project.
renameProjectPrompt :: XPConfig -> X () renameProjectPrompt :: XPConfig -> X ()
renameProjectPrompt c = mkXPrompt (Wor "New Project Name: ") c (return . (:[])) go renameProjectPrompt = projectPrompt [ RenameMode
where , DirMode
go :: String -> X () , SwitchMode
go name = do , ShiftMode
p <- currentProject ]
--------------------------------------------------------------------------------
-- | Change the working directory used for the current project.
--
-- NOTE: This will only affect new processed started in this project.
-- Existing processes will maintain the previous working directory.
changeProjectDirPrompt :: XPConfig -> X ()
changeProjectDirPrompt = projectPrompt [ DirMode
, SwitchMode
, ShiftMode
, RenameMode
]
--------------------------------------------------------------------------------
-- | Prompt for a project name.
projectPrompt :: [ProjectMode] -> XPConfig -> X ()
projectPrompt submodes c = do
ws <- map W.tag `fmap` gets (W.workspaces . windowset)
ps <- XS.gets projects ps <- XS.gets projects
renameWorkspaceByName name
let p' = fromMaybe (p { projectName = name }) $ Map.lookup name ps let names = sort (Map.keys ps `union` ws)
ps' = Map.insert name p' $ Map.delete (projectName p) ps modes = map (\m -> XPT $ ProjectPrompt m names) submodes
XS.modify $ \s -> s {projects = ps'} mkXPromptWithModes modes c
activateProject p'
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Activate a project by updating the working directory and -- | Activate a project by updating the working directory and

View File

@ -205,7 +205,8 @@ data GSConfig a = GSConfig {
gs_navigate :: TwoD a (Maybe a), gs_navigate :: TwoD a (Maybe a),
gs_rearranger :: Rearranger a, gs_rearranger :: Rearranger a,
gs_originFractX :: Double, gs_originFractX :: Double,
gs_originFractY :: Double gs_originFractY :: Double,
gs_bordercolor :: String
} }
-- | That is 'fromClassName' if you are selecting a 'Window', or -- | That is 'fromClassName' if you are selecting a 'Window', or
@ -322,15 +323,15 @@ diamondRestrict x y originX originY =
findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b) findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
findInElementMap pos = find ((== pos) . fst) findInElementMap pos = find ((== pos) . fst)
drawWinBox :: Window -> XMonadFont -> (String, String) -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X () drawWinBox :: Window -> XMonadFont -> (String, String) -> String -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()
drawWinBox win font (fg,bg) ch cw text x y cp = drawWinBox win font (fg,bg) bc ch cw text x y cp =
withDisplay $ \dpy -> do withDisplay $ \dpy -> do
gc <- liftIO $ createGC dpy win gc <- liftIO $ createGC dpy win
bordergc <- liftIO $ createGC dpy win bordergc <- liftIO $ createGC dpy win
liftIO $ do liftIO $ do
Just fgcolor <- initColor dpy fg Just fgcolor <- initColor dpy fg
Just bgcolor <- initColor dpy bg Just bgcolor <- initColor dpy bg
Just bordercolor <- initColor dpy borderColor Just bordercolor <- initColor dpy bc
setForeground dpy gc fgcolor setForeground dpy gc fgcolor
setBackground dpy gc bgcolor setBackground dpy gc bgcolor
setForeground dpy bordergc bordercolor setForeground dpy bordergc bordercolor
@ -340,7 +341,10 @@ drawWinBox win font (fg,bg) ch cw text x y cp =
(\n -> do size <- liftIO $ textWidthXMF dpy font n (\n -> do size <- liftIO $ textWidthXMF dpy font n
return $ size > (fromInteger (cw-(2*cp)))) return $ size > (fromInteger (cw-(2*cp))))
text text
printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+(div ch 2))) stext -- calculate the offset to vertically centre the text based on the ascender and descender
(asc,desc) <- liftIO $ textExtentsXMF font stext
let offset = ((ch - fromIntegral (asc + desc)) `div` 2) + fromIntegral asc
printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+offset)) stext
liftIO $ freeGC dpy gc liftIO $ freeGC dpy gc
liftIO $ freeGC dpy bordergc liftIO $ freeGC dpy bordergc
@ -378,6 +382,7 @@ updateElementsWithColorizer colorizer elementmap = do
colors <- colorizer element (pos == curpos) colors <- colorizer element (pos == curpos)
drawWinBox win font drawWinBox win font
colors colors
(gs_bordercolor gsconfig)
cellheight cellheight
cellwidth cellwidth
text text
@ -390,7 +395,7 @@ stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop
| t == buttonRelease = do | t == buttonRelease = do
s @ TwoDState { td_paneX = px, td_paneY = py, s @ TwoDState { td_paneX = px, td_paneY = py,
td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _) } <- get td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get
let gridX = (fi x - (px - cw) `div` 2) `div` cw let gridX = (fi x - (px - cw) `div` 2) `div` cw
gridY = (fi y - (py - ch) `div` 2) `div` ch gridY = (fi y - (py - ch) `div` 2) `div` ch
case lookup (gridX,gridY) (td_elementmap s) of case lookup (gridX,gridY) (td_elementmap s) of
@ -714,10 +719,7 @@ decorateName' w = do
-- | Builds a default gs config from a colorizer function. -- | Builds a default gs config from a colorizer function.
buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white"
borderColor :: String
borderColor = "white"
-- | Brings selected window to the current workspace. -- | Brings selected window to the current workspace.
bringSelected :: GSConfig Window -> X () bringSelected :: GSConfig Window -> X ()

View File

@ -96,7 +96,7 @@ import XMonad.Util.Types
-- --
-- Alternatively, you can use navigation2DP: -- Alternatively, you can use navigation2DP:
-- --
-- > main = xmonad $ navigation2D def -- > main = xmonad $ navigation2DP def
-- > ("<Up>", "<Left>", "<Down>", "<Right>") -- > ("<Up>", "<Left>", "<Down>", "<Right>")
-- > [("M-", windowGo ), -- > [("M-", windowGo ),
-- > ("M-S-", windowSwap)] -- > ("M-S-", windowSwap)]

View File

@ -140,7 +140,6 @@ docksEventHook (MapNotifyEvent { ev_window = w }) = do
return (All True) return (All True)
docksEventHook (PropertyEvent { ev_window = w docksEventHook (PropertyEvent { ev_window = w
, ev_atom = a }) = do , ev_atom = a }) = do
whenX (runQuery checkDock w) $ do
nws <- getAtom "_NET_WM_STRUT" nws <- getAtom "_NET_WM_STRUT"
nwsp <- getAtom "_NET_WM_STRUT_PARTIAL" nwsp <- getAtom "_NET_WM_STRUT_PARTIAL"
when (a == nws || a == nwsp) $ do when (a == nws || a == nwsp) $ do
@ -246,7 +245,9 @@ instance Message SetStruts
instance LayoutModifier AvoidStruts a where instance LayoutModifier AvoidStruts a where
modifyLayout (AvoidStruts ss) w r = do modifyLayout (AvoidStruts ss) w r = do
srect <- fmap ($ r) (calcGap ss) srect <- fmap ($ r) (calcGap ss)
setWorkarea srect -- Ensure _NET_WORKAREA is not set.
-- See: https://github.com/xmonad/xmonad-contrib/pull/79
rmWorkarea
runLayout w srect runLayout w srect
pureMess as@(AvoidStruts ss) m pureMess as@(AvoidStruts ss) m
@ -262,13 +263,11 @@ instance LayoutModifier AvoidStruts a where
toggleOne x xs | x `S.member` xs = S.delete x xs toggleOne x xs | x `S.member` xs = S.delete x xs
| otherwise = x `S.insert` xs | otherwise = x `S.insert` xs
setWorkarea :: Rectangle -> X () rmWorkarea :: X ()
setWorkarea (Rectangle x y w h) = withDisplay $ \dpy -> do rmWorkarea = withDisplay $ \dpy -> do
a <- getAtom "_NET_WORKAREA" a <- getAtom "_NET_WORKAREA"
c <- getAtom "CARDINAL"
r <- asks theRoot r <- asks theRoot
io $ changeProperty32 dpy r a c propModeReplace [fi x, fi y, fi w, fi h] io (deleteProperty dpy r a)
-- | (Direction, height\/width, initial pixel, final pixel). -- | (Direction, height\/width, initial pixel, final pixel).

View File

@ -497,11 +497,11 @@ data BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: !String }
instance UrgencyHook BorderUrgencyHook where instance UrgencyHook BorderUrgencyHook where
urgencyHook BorderUrgencyHook { urgencyBorderColor = cs } w = urgencyHook BorderUrgencyHook { urgencyBorderColor = cs } w =
withDisplay $ \dpy -> io $ do withDisplay $ \dpy -> do
c' <- initColor dpy cs c' <- io (initColor dpy cs)
case c' of case c' of
Just c -> setWindowBorder dpy w c Just c -> setWindowBorderWithFallback dpy w cs c
_ -> hPutStrLn stderr $ concat ["Warning: bad urgentBorderColor " _ -> io $ hPutStrLn stderr $ concat ["Warning: bad urgentBorderColor "
,show cs ,show cs
," in BorderUrgencyHook" ," in BorderUrgencyHook"
] ]
@ -543,4 +543,3 @@ filterUrgencyHook skips w = do
Just tag -> when (tag `elem` skips) Just tag -> when (tag `elem` skips)
$ adjustUrgents (delete w) $ adjustUrgents (delete w)
_ -> return () _ -> return ()

View File

@ -20,6 +20,7 @@ module XMonad.Layout.BinarySpacePartition (
-- * Usage -- * Usage
-- $usage -- $usage
emptyBSP emptyBSP
, BinarySpacePartition
, Rotate(..) , Rotate(..)
, Swap(..) , Swap(..)
, ResizeDirectional(..) , ResizeDirectional(..)

View File

@ -110,7 +110,7 @@ popNewestHiddenWindow = sendMessage PopNewestHiddenWindow
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
hideWindowMsg :: HiddenWindows a -> Window -> X (Maybe (HiddenWindows a)) hideWindowMsg :: HiddenWindows a -> Window -> X (Maybe (HiddenWindows a))
hideWindowMsg (HiddenWindows hidden) win = do hideWindowMsg (HiddenWindows hidden) win = do
windows (W.delete' win) modify (\s -> s { windowset = W.delete' win $ windowset s })
return . Just . HiddenWindows $ hidden ++ [win] return . Just . HiddenWindows $ hidden ++ [win]
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -130,4 +130,5 @@ popOldestMsg (HiddenWindows (win:rest)) = do
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
restoreWindow :: Window -> X () restoreWindow :: Window -> X ()
restoreWindow = windows . W.insertUp restoreWindow win =
modify (\s -> s { windowset = W.insertUp win $ windowset s })

View File

@ -83,62 +83,64 @@ import XMonad.Util.XUtils
-- | Increase the size of the window that has focus -- | Increase the size of the window that has focus
magnifier :: l a -> ModifiedLayout Magnifier l a magnifier :: l a -> ModifiedLayout Magnifier l a
magnifier = ModifiedLayout (Mag (1.5,1.5) On All) magnifier = ModifiedLayout (Mag 1 (1.5,1.5) On All)
-- | Change the size of the window that has focus by a custom zoom -- | Change the size of the window that has focus by a custom zoom
magnifiercz :: Rational -> l a -> ModifiedLayout Magnifier l a magnifiercz :: Rational -> l a -> ModifiedLayout Magnifier l a
magnifiercz cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On All) magnifiercz cz = ModifiedLayout (Mag 1 (fromRational cz, fromRational cz) On All)
-- | Increase the size of the window that has focus, unless if it is the -- | Increase the size of the window that has focus, unless if it is one of the
-- master window. -- master windows.
magnifier' :: l a -> ModifiedLayout Magnifier l a magnifier' :: l a -> ModifiedLayout Magnifier l a
magnifier' = ModifiedLayout (Mag (1.5,1.5) On NoMaster) magnifier' = ModifiedLayout (Mag 1 (1.5,1.5) On NoMaster)
-- | Magnifier that defaults to Off -- | Magnifier that defaults to Off
magnifierOff :: l a -> ModifiedLayout Magnifier l a magnifierOff :: l a -> ModifiedLayout Magnifier l a
magnifierOff = ModifiedLayout (Mag (1.5,1.5) Off All) magnifierOff = ModifiedLayout (Mag 1 (1.5,1.5) Off All)
-- | Increase the size of the window that has focus by a custom zoom, -- | Increase the size of the window that has focus by a custom zoom,
-- unless if it is the master window. -- unless if it is one of the the master windows.
magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a
magnifiercz' cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On NoMaster) magnifiercz' cz = ModifiedLayout (Mag 1 (fromRational cz, fromRational cz) On NoMaster)
-- | A magnifier that greatly magnifies just the vertical direction -- | A magnifier that greatly magnifies just the vertical direction
maximizeVertical :: l a -> ModifiedLayout Magnifier l a maximizeVertical :: l a -> ModifiedLayout Magnifier l a
maximizeVertical = ModifiedLayout (Mag (1,1000) Off All) maximizeVertical = ModifiedLayout (Mag 1 (1,1000) Off All)
data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle deriving ( Typeable ) data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle deriving ( Typeable )
instance Message MagnifyMsg instance Message MagnifyMsg
data Magnifier a = Mag (Double,Double) Toggle MagnifyMaster deriving (Read, Show) data Magnifier a = Mag !Int (Double,Double) Toggle MagnifyMaster deriving (Read, Show)
data Toggle = On | Off deriving (Read, Show) data Toggle = On | Off deriving (Read, Show)
data MagnifyMaster = All | NoMaster deriving (Read, Show) data MagnifyMaster = All | NoMaster deriving (Read, Show)
instance LayoutModifier Magnifier Window where instance LayoutModifier Magnifier Window where
redoLayout (Mag z On All ) r (Just s) wrs = applyMagnifier z r s wrs redoLayout (Mag _ z On All ) r (Just s) wrs = applyMagnifier z r s wrs
redoLayout (Mag z On NoMaster) r (Just s) wrs = unlessMaster (applyMagnifier z) r s wrs redoLayout (Mag n z On NoMaster) r (Just s) wrs = unlessMaster n (applyMagnifier z) r s wrs
redoLayout _ _ _ wrs = return (wrs, Nothing) redoLayout _ _ _ wrs = return (wrs, Nothing)
handleMess (Mag z On t) m handleMess (Mag n z On t) m
| Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z `addto` 0.1 ) On t) | Just MagnifyMore <- fromMessage m = return . Just $ Mag n (z `addto` 0.1 ) On t
| Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z `addto` (-0.1)) On t) | Just MagnifyLess <- fromMessage m = return . Just $ Mag n (z `addto` (-0.1)) On t
| Just ToggleOff <- fromMessage m = return . Just $ (Mag (z ) Off t) | Just ToggleOff <- fromMessage m = return . Just $ Mag n z Off t
| Just Toggle <- fromMessage m = return . Just $ (Mag (z ) Off t) | Just Toggle <- fromMessage m = return . Just $ Mag n z Off t
| Just (IncMasterN d) <- fromMessage m = return . Just $ Mag (max 0 (n+d)) z On t
where addto (x,y) i = (x+i,y+i) where addto (x,y) i = (x+i,y+i)
handleMess (Mag z Off t) m handleMess (Mag n z Off t) m
| Just ToggleOn <- fromMessage m = return . Just $ (Mag z On t) | Just ToggleOn <- fromMessage m = return . Just $ Mag n z On t
| Just Toggle <- fromMessage m = return . Just $ (Mag z On t) | Just Toggle <- fromMessage m = return . Just $ Mag n z On t
| Just (IncMasterN d) <- fromMessage m = return . Just $ Mag (max 0 (n+d)) z Off t
handleMess _ _ = return Nothing handleMess _ _ = return Nothing
modifierDescription (Mag _ On All ) = "Magnifier" modifierDescription (Mag _ _ On All ) = "Magnifier"
modifierDescription (Mag _ On NoMaster) = "Magnifier NoMaster" modifierDescription (Mag _ _ On NoMaster) = "Magnifier NoMaster"
modifierDescription (Mag _ Off _ ) = "Magnifier (off)" modifierDescription (Mag _ _ Off _ ) = "Magnifier (off)"
type NewLayout a = Rectangle -> Stack a -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe (Magnifier a)) type NewLayout a = Rectangle -> Stack a -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe (Magnifier a))
unlessMaster :: NewLayout a -> NewLayout a unlessMaster :: Int -> NewLayout a -> NewLayout a
unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing) unlessMaster n mainmod r s wrs = if null (drop (n-1) (up s)) then return (wrs, Nothing)
else mainmod r s wrs else mainmod r s wrs
applyMagnifier :: (Double,Double) -> Rectangle -> t -> [(Window, Rectangle)] applyMagnifier :: (Double,Double) -> Rectangle -> t -> [(Window, Rectangle)]

View File

@ -97,8 +97,8 @@ split3HorizontallyBy :: Bool -> Rational -> Rectangle -> (Rectangle, Rectangle,
split3HorizontallyBy middle f (Rectangle sx sy sw sh) = split3HorizontallyBy middle f (Rectangle sx sy sw sh) =
if middle if middle
then ( Rectangle (sx + fromIntegral r3w) sy r1w sh then ( Rectangle (sx + fromIntegral r3w) sy r1w sh
, Rectangle (sx + fromIntegral r3w + fromIntegral r1w) sy r2w sh , Rectangle sx sy r3w sh
, Rectangle sx sy r3w sh ) , Rectangle (sx + fromIntegral r3w + fromIntegral r1w) sy r2w sh )
else ( Rectangle sx sy r1w sh else ( Rectangle sx sy r1w sh
, Rectangle (sx + fromIntegral r1w) sy r2w sh , Rectangle (sx + fromIntegral r1w) sy r2w sh
, Rectangle (sx + fromIntegral r1w + fromIntegral r2w) sy r3w sh ) , Rectangle (sx + fromIntegral r1w + fromIntegral r2w) sy r3w sh )

View File

@ -195,7 +195,9 @@ navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangl
navigable d pt = sortby d . filter (inr d pt . snd) navigable d pt = sortby d . filter (inr d pt . snd)
sc :: Pixel -> Window -> X () sc :: Pixel -> Window -> X ()
sc c win = withDisplay $ \dpy -> io $ setWindowBorder dpy win c sc c win = withDisplay $ \dpy -> do
colorName <- io (pixelToString dpy c)
setWindowBorderWithFallback dpy win colorName c
center :: Rectangle -> Point center :: Rectangle -> Point
center (Rectangle x y w h) = P (fromIntegral x + fromIntegral w/2) (fromIntegral y + fromIntegral h/2) center (Rectangle x y w h) = P (fromIntegral x + fromIntegral w/2) (fromIntegral y + fromIntegral h/2)

View File

@ -91,7 +91,6 @@ import Data.List
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Set (fromList, toList) import Data.Set (fromList, toList)
import System.Directory (getAppUserDataDirectory)
import System.IO import System.IO
import System.Posix.Files import System.Posix.Files
@ -127,7 +126,10 @@ data XPState =
} }
data XPConfig = data XPConfig =
XPC { font :: String -- ^ Font; use the prefix @"xft:"@ for TrueType fonts XPC { font :: String -- ^ Font. For TrueType fonts, use something like
-- @"xft:Hack:pixelsize=1"@. Alternatively, use X Logical Font
-- Description, i.e. something like
-- @"-*-dejavu sans mono-medium-r-normal--*-80-*-*-*-*-iso10646-1"@.
, bgColor :: String -- ^ Background color , bgColor :: String -- ^ Background color
, fgColor :: String -- ^ Font color , fgColor :: String -- ^ Font color
, fgHLight :: String -- ^ Font color of a highlighted completion entry , fgHLight :: String -- ^ Font color of a highlighted completion entry
@ -521,24 +523,59 @@ completionHandle c ks@(sym,_) (KeyEvent { ev_event_type = t, ev_state = m }) = d
alwaysHlight <- gets $ alwaysHighlight . config alwaysHlight <- gets $ alwaysHighlight . config
mCleaned <- cleanMask m mCleaned <- cleanMask m
case () of case () of
() | t == keyPress && (mCleaned,sym) == complKey -> () | t == keyPress && (mCleaned,sym) == complKey -> do
do
st <- get st <- get
let updateState l = case alwaysHlight of
-- modify the buffer's value let updateWins l = redrawWindows l >> eventLoop (completionHandle l)
False -> let newCommand = nextCompletion (currentXPMode st) (command st) l updateState l = case alwaysHlight of
in modify $ \s -> setCommand newCommand $ s { offset = length newCommand, highlightedCompl = Just newCommand} False -> simpleComplete l st
--TODO: Scroll or paginate results True | Just (command st) /= highlightedCompl st -> alwaysHighlightCurrent st
True -> let complIndex' = nextComplIndex st (length l) | otherwise -> alwaysHighlightNext l st
highlightedCompl' = highlightedItem st { complIndex = complIndex'} c
in modify $ \s -> setHighlightedCompl highlightedCompl' $ s { complIndex = complIndex' }
updateWins l = redrawWindows l >> eventLoop (completionHandle l)
case c of case c of
[] -> updateWindows >> eventLoop handle [] -> updateWindows >> eventLoop handle
[x] -> updateState [x] >> getCompletions >>= updateWins [x] -> updateState [x] >> getCompletions >>= updateWins
l -> updateState l >> updateWins l l -> updateState l >> updateWins l
| t == keyRelease && (mCleaned,sym) == complKey -> eventLoop (completionHandle c) | t == keyRelease && (mCleaned,sym) == complKey -> eventLoop (completionHandle c)
| otherwise -> keyPressHandle mCleaned ks -- some other key, handle it normally | otherwise -> keyPressHandle mCleaned ks -- some other key, handle it normally
where
-- When alwaysHighlight is off, just complete based on what the
-- user has typed so far.
simpleComplete :: [String] -> XPState -> XP ()
simpleComplete l st = do
let newCommand = nextCompletion (currentXPMode st) (command st) l
modify $ \s -> setCommand newCommand $
s { offset = length newCommand
, highlightedCompl = Just newCommand
}
-- If alwaysHighlight is on, and this is the first use of the
-- completion key, update the buffer so that it contains the
-- current completion item.
alwaysHighlightCurrent :: XPState -> XP ()
alwaysHighlightCurrent st = do
let newCommand = fromMaybe (command st) $ highlightedItem st c
modify $ \s -> setCommand newCommand $
setHighlightedCompl (Just newCommand) $
s { offset = length newCommand
}
-- If alwaysHighlight is on, and the user wants the next
-- completion, move to the next completion item and update the
-- buffer to reflect that.
--
--TODO: Scroll or paginate results
alwaysHighlightNext :: [String] -> XPState -> XP ()
alwaysHighlightNext l st = do
let complIndex' = nextComplIndex st (length l)
highlightedCompl' = highlightedItem st { complIndex = complIndex'} c
newCommand = fromMaybe (command st) $ highlightedCompl'
modify $ \s -> setHighlightedCompl highlightedCompl' $
setCommand newCommand $
s { complIndex = complIndex'
, offset = length newCommand
}
-- some other event: go back to main loop -- some other event: go back to main loop
completionHandle _ k e = handle k e completionHandle _ k e = handle k e
@ -1064,7 +1101,7 @@ emptyHistory :: History
emptyHistory = M.empty emptyHistory = M.empty
getHistoryFile :: IO FilePath getHistoryFile :: IO FilePath
getHistoryFile = fmap (++ "/history") $ getAppUserDataDirectory "xmonad" getHistoryFile = fmap (++ "/prompt-history") getXMonadCacheDir
readHistory :: IO History readHistory :: IO History
readHistory = readHist `E.catch` \(SomeException _) -> return emptyHistory readHistory = readHist `E.catch` \(SomeException _) -> return emptyHistory
@ -1170,7 +1207,7 @@ breakAtSpace s
-- | 'historyCompletion' provides a canned completion function much like -- | 'historyCompletion' provides a canned completion function much like
-- 'getShellCompl'; you pass it to mkXPrompt, and it will make completions work -- 'getShellCompl'; you pass it to mkXPrompt, and it will make completions work
-- from the query history stored in ~\/.xmonad\/history. -- from the query history stored in the XMonad cache directory.
historyCompletion :: ComplFunction historyCompletion :: ComplFunction
historyCompletion = historyCompletionP (const True) historyCompletion = historyCompletionP (const True)

View File

@ -16,7 +16,8 @@ module XMonad.Prompt.Directory (
-- * Usage -- * Usage
-- $usage -- $usage
directoryPrompt, directoryPrompt,
Dir, directoryMultipleModes,
Dir
) where ) where
import XMonad import XMonad
@ -26,13 +27,23 @@ import XMonad.Util.Run ( runProcessWithInput )
-- $usage -- $usage
-- For an example usage see "XMonad.Layout.WorkspaceDir" -- For an example usage see "XMonad.Layout.WorkspaceDir"
data Dir = Dir String data Dir = Dir String (String -> X ())
instance XPrompt Dir where instance XPrompt Dir where
showXPrompt (Dir x) = x showXPrompt (Dir x _) = x
completionFunction _ = getDirCompl
modeAction (Dir _ f) buf auto =
let dir = if null auto then buf else auto
in f dir
directoryPrompt :: XPConfig -> String -> (String -> X ()) -> X () directoryPrompt :: XPConfig -> String -> (String -> X ()) -> X ()
directoryPrompt c prom = mkXPrompt (Dir prom) c getDirCompl directoryPrompt c prom f = mkXPrompt (Dir prom f) c getDirCompl f
-- | A @XPType@ entry suitable for using with @mkXPromptWithModes@.
directoryMultipleModes :: String -- ^ Prompt.
-> (String -> X ()) -- ^ Action.
-> XPType
directoryMultipleModes p f = XPT (Dir p f)
getDirCompl :: String -> IO [String] getDirCompl :: String -> IO [String]
getDirCompl s = (filter notboring . lines) `fmap` getDirCompl s = (filter notboring . lines) `fmap`

View File

@ -80,6 +80,9 @@ instance XPrompt WindowPrompt where
nextCompletion _ = getNextCompletion nextCompletion _ = getNextCompletion
-- | Deprecated. Use windowPrompt instead. -- | Deprecated. Use windowPrompt instead.
{-# DEPRECATED windowPromptGoto "Use windowPrompt instead." #-}
{-# DEPRECATED windowPromptBring "Use windowPrompt instead." #-}
{-# DEPRECATED windowPromptBringCopy "Use windowPrompt instead." #-}
windowPromptGoto, windowPromptBring, windowPromptBringCopy :: XPConfig -> X () windowPromptGoto, windowPromptBring, windowPromptBringCopy :: XPConfig -> X ()
windowPromptGoto c = windowPrompt c Goto windowMap windowPromptGoto c = windowPrompt c Goto windowMap
windowPromptBring c = windowPrompt c Bring windowMap windowPromptBring c = windowPrompt c Bring windowMap

View File

@ -427,7 +427,11 @@ parseKey = parseRegular +++ parseSpecial
-- | Parse a regular key name (represented by itself). -- | Parse a regular key name (represented by itself).
parseRegular :: ReadP KeySym parseRegular :: ReadP KeySym
parseRegular = choice [ char s >> return k parseRegular = choice [ char s >> return k
| (s,k) <- zip ['!'..'~'] [xK_exclam..xK_asciitilde] | (s,k) <- zip ['!' .. '~' ] -- ASCII
[xK_exclam .. xK_asciitilde]
++ zip ['\xa0' .. '\xff' ] -- Latin1
[xK_nobreakspace .. xK_ydiaeresis]
] ]
-- | Parse a special key name (one enclosed in angle brackets). -- | Parse a special key name (one enclosed in angle brackets).

View File

@ -29,6 +29,7 @@ module XMonad.Util.Font
, textExtentsXMF , textExtentsXMF
, printStringXMF , printStringXMF
, stringToPixel , stringToPixel
, pixelToString
, fi , fi
) where ) where
@ -37,6 +38,8 @@ import Foreign
import Control.Applicative import Control.Applicative
import Control.Exception as E import Control.Exception as E
import Data.Maybe import Data.Maybe
import Data.Bits (shiftR)
import Text.Printf (printf)
#ifdef XFT #ifdef XFT
import Data.List import Data.List
@ -61,6 +64,19 @@ stringToPixel d s = fromMaybe fallBack <$> io getIt
where getIt = initColor d s where getIt = initColor d s
fallBack = blackPixel d (defaultScreen d) fallBack = blackPixel d (defaultScreen d)
-- | Convert a @Pixel@ into a @String@.
pixelToString :: (MonadIO m) => Display -> Pixel -> m String
pixelToString d p = do
let cm = defaultColormap d (defaultScreen d)
(Color _ r g b _) <- io (queryColor d cm $ Color p 0 0 0 0)
return ("#" ++ hex r ++ hex g ++ hex b)
where
-- NOTE: The @Color@ type has 16-bit values for red, green, and
-- blue, even though the actual type in X is only 8 bits wide. It
-- seems that the upper and lower 8-bit sections of the @Word16@
-- values are the same. So, we just discard the lower 8 bits.
hex = printf "%02x" . (`shiftR` 8)
econst :: a -> IOException -> a econst :: a -> IOException -> a
econst = const econst = const

View File

@ -21,10 +21,12 @@ module XMonad.Util.WindowProperties (
-- $helpers -- $helpers
getProp32, getProp32s) getProp32, getProp32s)
where where
import XMonad
import qualified XMonad.StackSet as W
import Foreign.C.Types (CLong)
import Control.Monad import Control.Monad
import Foreign.C.Types (CLong)
import XMonad
import XMonad.Actions.TagWindows (hasTag)
import qualified XMonad.StackSet as W
-- $edsl -- $edsl
-- Allows to specify window properties, such as title, classname or -- Allows to specify window properties, such as title, classname or
@ -43,6 +45,7 @@ data Property = Title String
| Or Property Property | Or Property Property
| Not Property | Not Property
| Const Bool | Const Bool
| Tagged String -- ^ Tagged via 'XMonad.Actions.TagWindows'
deriving (Read, Show) deriving (Read, Show)
infixr 9 `And` infixr 9 `And`
infixr 8 `Or` infixr 8 `Or`
@ -78,6 +81,7 @@ propertyToQuery (And p1 p2) = propertyToQuery p1 <&&> propertyToQuery p2
propertyToQuery (Or p1 p2) = propertyToQuery p1 <||> propertyToQuery p2 propertyToQuery (Or p1 p2) = propertyToQuery p1 <||> propertyToQuery p2
propertyToQuery (Not p) = not `fmap` propertyToQuery p propertyToQuery (Not p) = not `fmap` propertyToQuery p
propertyToQuery (Const b) = return b propertyToQuery (Const b) = return b
propertyToQuery (Tagged s) = ask >>= \w -> liftX (hasTag s w)
-- $helpers -- $helpers

View File

@ -28,6 +28,7 @@ module XMonad.Util.XUtils
, paintAndWrite , paintAndWrite
, paintTextAndIcons , paintTextAndIcons
, stringToPixel , stringToPixel
, pixelToString
, fi , fi
) where ) where
@ -208,4 +209,3 @@ mkWindow d s rw x y w h p o = do
set_background_pixel attributes p set_background_pixel attributes p
createWindow d rw x y w h 0 (defaultDepthOfScreen s) createWindow d rw x y w h 0 (defaultDepthOfScreen s)
inputOutput visual attrmask attributes inputOutput visual attrmask attributes

3
cabal.project Normal file
View File

@ -0,0 +1,3 @@
packages: ./
../xmonad/
../x11/

9
stack.yaml Normal file
View File

@ -0,0 +1,9 @@
resolver: lts-7.19
packages:
- ./
- ../xmonad
extra-deps:
- X11-1.8
- X11-xft-0.3.1

View File

@ -1,5 +1,5 @@
name: xmonad-contrib name: xmonad-contrib
version: 0.12 version: 0.13
homepage: http://xmonad.org/ homepage: http://xmonad.org/
synopsis: Third party extensions for xmonad synopsis: Third party extensions for xmonad
description: description:
@ -63,8 +63,8 @@ library
random, random,
mtl >= 1 && < 3, mtl >= 1 && < 3,
unix, unix,
X11>=1.6.1 && < 1.8, X11>=1.6.1 && < 1.9,
xmonad>=0.12 && < 0.13, xmonad>=0.13 && < 0.14,
utf8-string utf8-string
if flag(use_xft) if flag(use_xft)