twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-18 21:53:47 -07:00
Code Issues Packages Projects Releases Wiki Activity

Compare commits

base: twin:v0.15
Branches Tags
twin:master twin:dependabot/github_actions/actions/checkout-5 twin:haskell-ci-update twin:feature/fix-PR9
twin:v0.18.1 twin:v0.18.0 twin:v0.17.1 twin:v0.17.0 twin:v0.16 twin:v0.15 twin:v0.14 twin:v0.13 twin:v0.12 twin:v0.11 twin:v0.10 twin:v0.9.1 twin:v0.9 twin:v0.8.1 twin:v0.8 twin:v0.7 twin:v0.6 twin:v0.5 twin:v0.4 twin:v0.3
..
compare: twin:feature/fix-PR9
Branches Tags
twin:dependabot/github_actions/actions/checkout-5 twin:master twin:haskell-ci-update twin:feature/fix-PR9
twin:v0.18.1 twin:v0.18.0 twin:v0.17.1 twin:v0.17.0 twin:v0.16 twin:v0.15 twin:v0.14 twin:v0.13 twin:v0.12 twin:v0.11 twin:v0.10 twin:v0.9.1 twin:v0.9 twin:v0.8.1 twin:v0.8 twin:v0.7 twin:v0.6 twin:v0.5 twin:v0.4 twin:v0.3

1 Commits
v0.15 ... feature/fi

Author SHA1 Message Date
Peter Jones
1833003404 Update X11 version for xmonad/xmonad#9 2016-11-22 18:49:01 -07:00
88 changed files with 896 additions and 4509 deletions
Expand all files Collapse all files

24
.github/ISSUE_TEMPLATE.md vendored
View File

@@ -1,24 +0,0 @@
### 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
View File

@@ -1,12 +0,0 @@
### 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,4 +23,3 @@ tags
# stack artifacts
/.stack-work/
/cabal.project.local

46
.travis.yml
View File

@@ -13,32 +13,27 @@ before_cache:
matrix:
include:
- env: GHCVER=8.6.1 CABALVER=2.4
compiler: ": #GHC 8.6.1"
addons: { apt: { packages: [cabal-install-2.4, ghc-8.6.1, libxrandr-dev]
, sources: [hvr-ghc]
} }
- env: GHCVER=8.4.3 CABALVER=2.2
compiler: ": #GHC 8.4.3"
addons: { apt: { packages: [cabal-install-2.2, ghc-8.4.3, libxrandr-dev]
, sources: [hvr-ghc]
} }
- env: GHCVER=8.2.2 CABALVER=2.0
compiler: ": #GHC 8.2.2"
addons: { apt: { packages: [cabal-install-2.0, ghc-8.2.2, libxrandr-dev]
, sources: [hvr-ghc]
} }
- env: GHCVER=8.0.1 CABALVER=1.24
compiler: ": #GHC 8.0.1"
addons: { apt: { packages: [cabal-install-1.24, ghc-8.0.1, libxrandr-dev]
, sources: [hvr-ghc]
} }
- env: CABALVER=1.16 GHCVER=7.4.2
compiler: ": #GHC 7.4.2"
addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2], sources: [hvr-ghc]}}
- env: CABALVER=1.16 GHCVER=7.6.3
compiler: ": #GHC 7.6.3"
addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}
- env: CABALVER=1.18 GHCVER=7.8.4
compiler: ": #GHC 7.8.4"
addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
- env: CABALVER=1.22 GHCVER=7.10.2
compiler: ": #GHC 7.10.2"
addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}}
before_install:
- unset CC
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
install:
# build xmonad from HEAD
- git clone https://github.com/xmonad/xmonad.git
- cabal --version
- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
- if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
@@ -47,17 +42,12 @@ install:
$HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
fi
- travis_retry cabal update -v
# build xmonad from HEAD
- git clone https://github.com/xmonad/xmonad.git
- cabal install xmonad/
- sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
- cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
- sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
# check whether current requested install-plan matches cached package-db snapshot
- if diff -u $HOME/.cabsnap/installplan.txt installplan.txt;
- if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;
then
echo "cabal build-cache HIT";
rm -rfv .ghc;
@@ -67,8 +57,8 @@ install:
echo "cabal build-cache MISS";
rm -rf $HOME/.cabsnap;
mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
cabal install --only-dependencies --enable-tests --enable-benchmarks;
fi
- cabal install --only-dependencies --enable-tests --enable-benchmarks;
# snapshot package-db on cache miss
- if [ ! -d $HOME/.cabsnap ];
@@ -79,6 +69,8 @@ install:
cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
fi
- cabal install xmonad/
# Here starts the actual work to be performed for the package under test;
# any command which exits with a non-zero exit code causes the build to fail.
script:

426
CHANGES.md
View File

@@ -1,415 +1,16 @@
# Change Log / Release Notes
## unknown
## 0.15
### Breaking Changes
* `XMonad.Layout.Groups` & `XMonad.Layout.Groups.Helpers`
The layout will no longer perform refreshes inside of its message handling.
If you have been relying on it to in your xmonad.hs, you will need to start
sending its messages in a manner that properly handles refreshing, e.g. with
`sendMessage`.
### New Modules
* `XMonad.Util.Purex`
Unlike the opaque `IO` actions that `X` actions can wrap, regular reads from
the `XConf` and modifications to the `XState` are fundamentally pure --
contrary to the current treatment of such actions in most xmonad code. Pure
modifications to the `WindowSet` can be readily composed, but due to the
need for those modifications to be properly handled by `windows`, other pure
changes to the `XState` cannot be interleaved with those changes to the
`WindowSet` without superfluous refreshes, hence breaking composability.
This module aims to rectify that situation by drawing attention to it and
providing `PureX`: a pure type with the same monadic interface to state as
`X`. The `XLike` typeclass enables writing actions generic over the two
monads; if pure, existing `X` actions can be generalised with only a change
to the type signature. Various other utilities are provided, in particular
the `defile` function which is needed by end-users.
### Bug Fixes and Minor Changes
* Add support for GHC 8.6.1.
* `XMonad.Actions.MessageHandling`
Refresh-performing functions updated to better reflect the new `sendMessage`.
## 0.14
### Breaking Changes
* `XMonad.Layout.Spacing`
Rewrite `XMonad.Layout.Spacing`. Borders are no longer uniform but composed
of four sides each with its own border width. The screen and window borders
are now separate and can be independently toggled on/off. The screen border
examines the window/rectangle list resulting from 'runLayout' rather than
the stack, which makes it compatible with layouts such as the builtin
`Full`. The child layout will always be called with the screen border. If
only a single window is displayed (and `smartBorder` enabled), it will be
expanded into the original layout rectangle. Windows that are displayed but
not part of the stack, such as those created by 'XMonad.Layout.Decoration',
will be shifted out of the way, but not scaled (not possible for windows
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.
* `XMonad.Layout.Minimize`
Though the interface it offers is quite similar, this module has been
almost completely rewritten. The new `XMonad.Actions.Minimize` contains
several functions that allow interaction with minimization window state.
If you are using this module, you must upgrade your configuration to import
`X.A.Minimize` and use `maximizeWindow` and `withLastMinimized` instead of
sending messages to `Minimized` layout. `XMonad.Hooks.RestoreMinimized` has
been completely deprecated, and its functions have no effect.
* `XMonad.Prompt.Unicode`
- `unicodePrompt :: String -> XPConfig -> X ()` now additionally takes a
filepath to the `UnicodeData.txt` file containing unicode data.
* `XMonad.Actions.PhysicalScreens`
`getScreen`, `viewScreen`, `sendToScreen`, `onNextNeighbour`, `onPrevNeighbour` now need a extra parameter
of type `ScreenComparator`. This allow the user to specify how he want his screen to be ordered default
value are:
- `def`(same as verticalScreenOrderer) will keep previous behavior
- `verticalScreenOrderer`
- `horizontalScreenOrderer`
One can build his custom ScreenOrderer using:
- `screenComparatorById` (allow to order by Xinerama id)
- `screenComparatorByRectangle` (allow to order by screen coordonate)
- `ScreenComparator` (allow to mix ordering by screen coordonate and xinerama id)
* `XMonad.Util.WorkspaceCompare`
`getXineramaPhysicalWsCompare` now need a extra argument of type `ScreenComparator` defined in
`XMonad.Actions.PhysicalScreens` (see changelog of this module for more information)
* `XMonad.Hooks.EwmhDesktops`
- Simplify ewmhDesktopsLogHookCustom, and remove the gnome-panel specific
remapping of all visible windows to the active workspace (#216).
- Handle workspace renames that might be occuring in the custom function
that is provided to ewmhDesktopsLogHookCustom.
* `XMonad.Hooks.DynamicLog`
- Support xmobar's \<action> and \<raw> tags; see `xmobarAction` and
`xmobarRaw`.
* `XMonad.Layout.NoBorders`
The layout now maintains a list of windows that never have borders, and a
list of windows that always have borders. Use `BorderMessage` to manage
these lists and the accompanying event hook (`borderEventHook`) to remove
destroyed windows from them. Also provides the `hasBorder` manage hook.
Two new conditions have been added to `Ambiguity`: `OnlyLayoutFloat` and
`OnlyLayoutFloatBelow`; `OnlyFloat` was renamed to `OnlyScreenFloat`. See
the documentation for more information.
The type signature of `hiddens` was changed to accept a new `Rectangle`
parameter representing the bounds of the parent layout, placed after the
`WindowSet` parameter. Anyone defining a new instance of `SetsAmbiguous`
will need to update their configuration. For example, replace "`hiddens amb
wset mst wrs =`" either with "`hiddens amb wset _ mst wrs =`" or to make
use of the new parameter with "`hiddens amb wset lr mst wrs =`".
* `XMonad.Actions.MessageFeedback`
- Follow the naming conventions of `XMonad.Operations`. Functions returning
`X ()` are named regularly (previously these ended in underscore) while
those returning `X Bool` are suffixed with an uppercase 'B'.
- Provide all `X Bool` and `SomeMessage` variations for `sendMessage` and
`sendMessageWithNoRefresh`, not just `sendMessageWithNoRefreshToCurrent`
(renamed from `send`).
- The new `tryInOrderB` and `tryMessageB` functions accept a parameter of
type `SomeMessage -> X Bool`, which means you are no longer constrained
to the behavior of the `sendMessageWithNoRefreshToCurrent` dispatcher.
- The `send*Messages*` family of funtions allows for sequencing arbitrary
sets of messages with minimal refresh. It makes little sense for these
functions to support custom message dispatchers.
- Remain backwards compatible. Maintain deprecated aliases of all renamed
functions:
- `send` -> `sendMessageWithNoRefreshToCurrentB`
- `sendSM` -> `sendSomeMessageWithNoRefreshToCurrentB`
- `sendSM_` -> `sendSomeMessageWithNoRefreshToCurrent`
- `tryInOrder` -> `tryInOrderWithNoRefreshToCurrentB`
- `tryInOrder_` -> `tryInOrderWithNoRefreshToCurrent`
- `tryMessage` -> `tryMessageWithNoRefreshToCurrentB`
- `tryMessage_` -> `tryMessageWithNoRefreshToCurrent`
### New Modules
* `XMonad.Layout.MultiToggle.TabBarDecoration`
Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to
dynamically toggle `XMonad.Layout.TabBarDecoration`.
* `XMonad.Layout.StateFull`
Provides `StateFull`: a stateful form of `Full` that does not misbehave when
floats are focused, and the `FocusTracking` layout transformer by means of
which `StateFull` is implemented. `FocusTracking` simply holds onto the last
true focus it was given and continues to use it as the focus for the
transformed layout until it sees another. It can be used to improve the
behaviour of a child layout that has not been given the focused window.
* `XMonad.Actions.SwapPromote`
Module for tracking master window history per workspace, and associated
functions for manipulating the stack using such history.
* `XMonad.Actions.CycleWorkspaceByScreen`
A new module that allows cycling through previously viewed workspaces in the
order they were viewed most recently on the screen where cycling is taking
place.
Also provides the `repeatableAction` helper function which can be used to
build actions that can be repeated while a modifier key is held down.
* `XMonad.Prompt.FuzzyMatch`
Provides a predicate `fuzzyMatch` that is much more lenient in matching
completions in `XMonad.Prompt` than the default prefix match. Also provides
a function `fuzzySort` that allows sorting the fuzzy matches by "how well"
they match.
* `XMonad.Utils.SessionStart`
A new module that allows to query if this is the first time xmonad is
started of the session, or a xmonad restart.
Currently needs manual setting of the session start flag. This could be
automated when this moves to the core repository.
* `XMonad.Layout.MultiDishes`
A new layout based on Dishes, however it accepts additional configuration
to allow multiple windows within a single stack.
* `XMonad.Util.Rectangle`
A new module for handling pixel rectangles.
* `XMonad.Layout.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.Layout.Grid`
Fix as per issue #223; Grid will no longer calculate more columns than there
are windows.
* `XMonad.Hooks.FadeWindows`
Added support for GHC version 8.4.x by adding a Semigroup instance for
Monoids
* `XMonad.Hooks.WallpaperSetter`
Added support for GHC version 8.4.x by adding a Semigroup instance for
Monoids
* `XMonad.Hooks.Mosaic`
Added support for GHC version 8.4.x by adding a Semigroup instance for
Monoids
* `XMonad.Actions.Navigation2D`
Added `sideNavigation` and a parameterised variant, providing a navigation
strategy with fewer quirks for tiled layouts using X.L.Spacing.
* `XMonad.Layout.Fullscreen`
The fullscreen layouts will now not render any window that is totally
obscured by fullscreen windows.
* `XMonad.Layout.Gaps`
Extended the sendMessage interface with `ModifyGaps` to allow arbitrary
modifications to the `GapSpec`.
* `XMonad.Layout.Groups`
Added a new `ModifyX` message type that allows the modifying
function to return values in the `X` monad.
* `XMonad.Actions.Navigation2D`
Generalised (and hence deprecated) hybridNavigation to hybridOf.
* `XMonad.Layout.LayoutHints`
Preserve the window order of the modified layout, except for the focused
window that is placed on top. This fixes an issue where the border of the
focused window in certain situations could be rendered below borders of
unfocused windows. It also has a lower risk of interfering with the
modified layout.
* `XMonad.Layout.MultiColumns`
The focused window is placed above the other windows if they would be made to
overlap due to a layout modifier. (As long as it preserves the window order.)
* `XMonad.Actions.GridSelect`
- The vertical centring of text in each cell has been improved.
* `XMonad.Actions.SpawnOn`
- Bind windows spawns by child processes of the original window to the same
workspace as the original window.
* `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.
* `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.Hooks.SetWMName`
Add function `getWMName`.
* `XMonad.Hooks.ManageHelpers`
Make type of ManageHook combinators more general.
* `XMonad.Prompt`
Export `insertString`.
* `XMonad.Prompt.Window`
- New function: `windowMultiPrompt` for using `mkXPromptWithModes`
with window prompts.
* `XMonad.Hooks.WorkspaceHistory`
- Now supports per screen history.
* `XMonad.Layout.ComboP`
- New `PartitionWins` message to re-partition all windows into the
configured sub-layouts. Useful when window properties have
changed and you want to re-sort windows into the appropriate
sub-layout.
* `XMonad.Actions.Minimize`
- Now has `withFirstMinimized` and `withFirstMinimized'` so you can perform
actions with both the last and first minimized windows easily.
* `XMonad.Config.Gnome`
- Update logout key combination (modm+shift+Q) to work with modern
* `XMonad.Prompt.Pass`
- New function `passTypePrompt` which uses `xdotool` to type in a password
from the store, bypassing the clipboard.
- Now handles password labels with spaces and special characters inside
them.
* `XMonad.Prompt.Unicode`
- Persist unicode data cache across XMonad instances due to
`ExtensibleState` now used instead of `unsafePerformIO`.
- `typeUnicodePrompt :: String -> XPConfig -> X ()` provided to insert the
Unicode character via `xdotool` instead of copying it to the paste buffer.
- `mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()`
acts as a generic function to pass the selected Unicode character to any
program.
* `XMonad.Prompt.AppendFile`
- New function `appendFilePrompt'` which allows for transformation of the
string passed by a user before writing to a file.
* `XMonad.Hooks.DynamicLog`
- Added a new function `dzenWithFlags` which allows specifying the arguments
passed to `dzen2` invocation. The behaviour of current `dzen` function is
unchanged.
* `XMonad.Util.Dzen`
- Now provides functions `fgColor` and `bgColor` to specify foreground and
background color, `align` and `slaveAlign` to set text alignment, and
`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.
* `XMonad.Actions.DynamicWorkspaceOrder`
- Added `updateName` and `removeName` to better control ordering when
workspace names are changed or workspaces are removed.
* `XMonad.Config.Azerty`
* Added `belgianConfig` and `belgianKeys` to support Belgian AZERTY
keyboards, which are slightly different from the French ones in the top
row.
## 0.13 (February 10, 2017)
## 0.13
### Breaking Changes
* The type of `completionKey` (of `XPConfig` record) has been
changed from `KeySym` to `(KeyMask, KeySym)`. The default value
for this is still bound to the `Tab` key.
for this is still binded to `Tab` key.
* New constructor `CenteredAt Rational Rational` added for
`XMonad.Prompt.XPPosition`.
* `XMonad.Prompt` now stores its history file in the XMonad cache
directory in a file named `prompt-history`.
### New Modules
* `XMonad.Layout.SortedLayout`
@@ -441,29 +42,13 @@
EWMH taskbars and pagers. Useful for `NamedScratchpad` windows, since
you will usually be taken to the `NSP` workspace by them.
### 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.
### Minor Changes
* `XMonad.Layout.LayoutBuilder`
Merge all functionality from `XMonad.Layout.LayoutBuilderP` into
`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.DynamicProjects`
- Switching away from a dynamic project that contains no windows
@@ -472,11 +57,6 @@
The project itself was already being deleted, this just deletes
the workspace created for it as well.
- Added function to change the working directory (`changeProjectDirPrompt`)
- All of the prompts are now multiple mode prompts. Try using the
`changeModeKey` in a prompt and see what happens!
## 0.12 (December 14, 2015)
### Breaking Changes

21
README.md
View File

@@ -1,15 +1,12 @@
# xmonad-contrib: Third Party Extensions to the xmonad Window Manager
[![Build Status](https://travis-ci.org/xmonad/xmonad-contrib.svg?branch=master)](https://travis-ci.org/xmonad/xmonad-contrib)
[![Open Source Helpers](https://www.codetriage.com/xmonad/xmonad-contrib/badges/users.svg)](https://www.codetriage.com/xmonad/xmonad-contrib)
You need the ghc compiler and xmonad window manager installed in
order to use these extensions.
For installation and configuration instructions, please see the
[xmonad website][xmonad], the documents included with the
[xmonad source distribution][xmonad-git], and the
[online haddock documentation][xmonad-docs].
[xmonad website] [xmonad], the documents included with the
[xmonad source distribution] [xmonad-git], and the
[online haddock documentation] [xmonad-docs].
## Getting or Updating XMonadContrib
@@ -18,7 +15,7 @@ For installation and configuration instructions, please see the
* Git version: <https://github.com/xmonad/xmonad-contrib>
(To use git xmonad-contrib you must also use the
[git version of xmonad][xmonad-git].)
[git version of xmonad] [xmonad-git].)
## Contributing
@@ -29,15 +26,15 @@ example, to use the Grid layout, one would import:
XMonad.Layout.Grid
For further details, see the [documentation][developing] for the
`XMonad.Doc.Developing` module, XMonad's [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md) and the [xmonad website][xmonad].
For further details, see the [documentation] [developing] for the
`XMonad.Doc.Developing` module and the [xmonad website] [xmonad].
## License
Code submitted to the contrib repo is licensed under the same license as
xmonad itself, with copyright held by the authors.
[xmonad]: http://xmonad.org
[xmonad-git]: https://github.com/xmonad/xmonad
[xmonad-docs]: http://hackage.haskell.org/package/xmonad
[developing]: http://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Doc-Developing.html
[xmonad-docs]: http://www.xmonad.org/xmonad-docs
[developing]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html

14
XMonad/Actions/Commands.hs
View File

@@ -19,7 +19,6 @@ module XMonad.Actions.Commands (
-- $usage
commandMap,
runCommand,
runCommandConfig,
runCommand',
workspaceCommands,
screenCommands,
@@ -104,18 +103,11 @@ defaultCommands = do
]
-- | Given a list of command\/action pairs, prompt the user to choose a
-- command using dmenu and return the corresponding action.
-- command and return the corresponding action.
runCommand :: [(String, X ())] -> X ()
runCommand = runCommandConfig dmenu
-- | Given a list of command\/action pairs, prompt the user to choose a
-- command using dmenu-compatible launcher and return the corresponding action.
-- See X.U.Dmenu for compatible launchers.
runCommandConfig :: ([String] -> X String) -> [(String, X ())] -> X()
runCommandConfig f cl = do
runCommand cl = do
let m = commandMap cl
choice <- f (M.keys m)
choice <- dmenu (M.keys m)
fromMaybe (return ()) (M.lookup choice m)
-- | Given the name of a command from 'defaultCommands', return the

4
XMonad/Actions/CycleWS.hs
View File

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

102
XMonad/Actions/CycleWorkspaceByScreen.hs
View File

@@ -1,102 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.CycleWorkspaceByScreen
-- Copyright : (c) 2017 Ivan Malison
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : IvanMalison@gmail.com
-- Stability : unstable
-- Portability : unportable
--
-- Cycle through previously viewed workspaces in the order they were viewed most
-- recently on the screen where cycling is taking place.
--
-----------------------------------------------------------------------------
module XMonad.Actions.CycleWorkspaceByScreen (
-- * Usage
-- $usage
cycleWorkspaceOnScreen
, cycleWorkspaceOnCurrentScreen
, handleKeyEvent
, repeatableAction
) where
import Control.Monad
import Data.IORef
import Data.List
import Data.Maybe
import Graphics.X11.Xlib.Extras
import XMonad
import XMonad.Hooks.WorkspaceHistory
import qualified XMonad.StackSet as W
-- $usage
-- This module must be used in conjuction with XMonad.Hooks.WorkspaceHistory
--
-- To use, add something like the following to your keybindings
-- , ((mod4Mask, xK_slash), cycleWorkspaceOnCurrentScreen [xK_Super_L] xK_slash xK_p)
repeatableAction :: [KeySym] -> (EventType -> KeySym -> X ()) -> X ()
repeatableAction mods pressHandler = do
XConf {theRoot = root, display = d} <- ask
let getNextEvent = io $ allocaXEvent $ \p ->
do
maskEvent d (keyPressMask .|. keyReleaseMask) p
KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
s <- io $ keycodeToKeysym d c 0
return (t, s)
handleEvent (t, s)
| t == keyRelease && s `elem` mods = return ()
| otherwise = (pressHandler t s) >> getNextEvent >>= handleEvent
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
getNextEvent >>= handleEvent
io $ ungrabKeyboard d currentTime
handleKeyEvent :: EventType
-> KeySym
-> X ()
-> EventType
-> KeySym
-> Maybe (X ())
handleKeyEvent eventType key action = helper
where
helper et k
| et == eventType && k == key = Just action
| otherwise = Nothing
runFirst :: [EventType -> KeySym -> Maybe (X ())] -> EventType -> KeySym -> X ()
runFirst matchers eventType key =
fromMaybe (return ()) $ join $ find isJust $ map (\fn -> fn eventType key) matchers
cycleWorkspaceOnScreen :: ScreenId -> [KeySym] -> KeySym -> KeySym -> X ()
cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransaction $ do
startingHistory <- workspaceHistoryByScreen
currentWSIndex <- io $ newIORef 1
let cycleWorkspaces = fromMaybe [] $ lookup screenId startingHistory
getAndIncrementWS increment = do
current <- readIORef currentWSIndex
modifyIORef
currentWSIndex
((`mod` (length cycleWorkspaces)) . (+ increment))
return $ cycleWorkspaces !! current
focusIncrement i = (io $ getAndIncrementWS i) >>= (windows . W.greedyView)
focusIncrement 1 -- Do the first workspace cycle
repeatableAction mods $
runFirst
[ handleKeyEvent keyPress nextKey $ focusIncrement 1
, handleKeyEvent keyPress prevKey $ focusIncrement (-1)
]
return ()
cycleWorkspaceOnCurrentScreen
:: [KeySym] -> KeySym -> KeySym -> X ()
cycleWorkspaceOnCurrentScreen mods n p =
withWindowSet $ \ws ->
cycleWorkspaceOnScreen (W.screen $ W.current ws) mods n p

139
XMonad/Actions/DynamicProjects.hs
View File

@@ -31,7 +31,6 @@ module XMonad.Actions.DynamicProjects
, switchProjectPrompt
, shiftToProjectPrompt
, renameProjectPrompt
, changeProjectDirPrompt
-- * Helper Functions
, switchProject
@@ -44,7 +43,6 @@ module XMonad.Actions.DynamicProjects
--------------------------------------------------------------------------------
import Control.Applicative ((<|>))
import Control.Monad (when, unless)
import Data.Char (isSpace)
import Data.List (sort, union, stripPrefix)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
@@ -54,7 +52,8 @@ import System.Directory (setCurrentDirectory, getHomeDirectory)
import XMonad
import XMonad.Actions.DynamicWorkspaces
import XMonad.Prompt
import XMonad.Prompt.Directory
import XMonad.Prompt.Directory (directoryPrompt)
import XMonad.Prompt.Workspace (Wor(..))
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
@@ -143,48 +142,6 @@ data ProjectState = ProjectState
instance ExtensionClass ProjectState where
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.
dynamicProjects :: [Project] -> XConfig a -> XConfig a
@@ -241,21 +198,6 @@ currentProject = do
proj <- lookupProject name
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.
switchProject :: Project -> X ()
@@ -278,11 +220,22 @@ switchProject p = do
-- | Prompt for a project name and then switch to it. Automatically
-- creates a project if a new name is returned from the prompt.
switchProjectPrompt :: XPConfig -> X ()
switchProjectPrompt = projectPrompt [ SwitchMode
, ShiftMode
, RenameMode
, DirMode
]
switchProjectPrompt c = projectPrompt c switch
where
switch :: ProjectTable -> ProjectName -> X ()
switch ps name = case Map.lookup name ps of
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.
@@ -295,44 +248,40 @@ shiftToProject p = do
-- | Prompts for a project name and then shifts the currently focused
-- window to that project.
shiftToProjectPrompt :: XPConfig -> X ()
shiftToProjectPrompt = projectPrompt [ ShiftMode
, RenameMode
, SwitchMode
, DirMode
]
--------------------------------------------------------------------------------
-- | Rename the current project.
renameProjectPrompt :: XPConfig -> X ()
renameProjectPrompt = projectPrompt [ RenameMode
, DirMode
, SwitchMode
, ShiftMode
]
--------------------------------------------------------------------------------
-- | 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
]
shiftToProjectPrompt c = projectPrompt c go
where
go :: ProjectTable -> ProjectName -> X ()
go ps name = shiftToProject . fromMaybe (defProject name) $
Map.lookup name ps
--------------------------------------------------------------------------------
-- | Prompt for a project name.
projectPrompt :: [ProjectMode] -> XPConfig -> X ()
projectPrompt submodes c = do
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)
modes = map (\m -> XPT $ ProjectPrompt m names) submodes
label = "Switch or Create Project: "
mkXPromptWithModes modes c
mkXPrompt (Wor label) c (mkComplFunFromList' names) (f ps)
--------------------------------------------------------------------------------
-- | Rename the current project.
renameProjectPrompt :: XPConfig -> X ()
renameProjectPrompt c = mkXPrompt (Wor "New Project Name: ") c (return . (:[])) go
where
go :: String -> X ()
go name = do
p <- currentProject
ps <- XS.gets projects
renameWorkspaceByName name
let p' = fromMaybe (p { projectName = name }) $ Map.lookup name ps
ps' = Map.insert name p' $ Map.delete (projectName p) ps
XS.modify $ \s -> s {projects = ps'}
activateProject p'
--------------------------------------------------------------------------------
-- | Activate a project by updating the working directory and

19
XMonad/Actions/DynamicWorkspaceOrder.hs
View File

@@ -23,8 +23,6 @@ module XMonad.Actions.DynamicWorkspaceOrder
getWsCompareByOrder
, getSortByOrder
, swapWith
, updateName
, removeName
, moveTo
, moveToGreedy
@@ -154,21 +152,6 @@ swapOrder w1 w2 = do
XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))
windows id -- force a status bar update
-- | Update the name of a workspace in the stored order.
updateName :: WorkspaceId -> WorkspaceId -> X ()
updateName oldId newId = XS.modify . withWSO $ changeKey oldId newId
-- | Remove a workspace from the stored order.
removeName :: WorkspaceId -> X ()
removeName = XS.modify . withWSO . M.delete
-- | Update a key in a Map.
changeKey :: Ord k => k -> k -> M.Map k a -> M.Map k a
changeKey oldKey newKey oldMap =
case M.updateLookupWithKey (\_ _ -> Nothing) oldKey oldMap of
(Nothing, _) -> oldMap
(Just val, newMap) -> M.insert newKey val newMap
-- | View the next workspace of the given type in the given direction,
-- where \"next\" is determined using the dynamic workspace order.
moveTo :: Direction1D -> WSType -> X ()
@@ -192,4 +175,4 @@ withNthWorkspace job wnum = do
ws <- gets (map W.tag . sort . W.workspaces . windowset)
case drop wnum ws of
(w:_) -> windows $ job w
[] -> return ()
[] -> return ()

22
XMonad/Actions/GridSelect.hs
View File

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

283
XMonad/Actions/MessageFeedback.hs
View File

@@ -1,8 +1,7 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.MessageFeedback
-- Copyright : (c) -- Quentin Moser <moserq@gmail.com>
-- 2018 Yclept Nemo
-- Copyright : (c) Quentin Moser <moserq@gmail.com>
-- License : BSD3
--
-- Maintainer : orphaned
@@ -14,263 +13,87 @@
-- this facility.
-----------------------------------------------------------------------------
module XMonad.Actions.MessageFeedback
( -- * Usage
-- $usage
module XMonad.Actions.MessageFeedback (
-- * Usage
-- $usage
-- * Messaging variants
send
, tryMessage
, tryMessage_
, tryInOrder
, tryInOrder_
, sm
, sendSM
, sendSM_
) where
-- ** 'SomeMessage'
sendSomeMessageB, sendSomeMessage
, sendSomeMessageWithNoRefreshB, sendSomeMessageWithNoRefresh
, sendSomeMessageWithNoRefreshToCurrentB, sendSomeMessageWithNoRefreshToCurrent
import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX )
import XMonad.StackSet ( current, workspace, layout, tag )
import XMonad.Operations ( updateLayout )
-- ** 'Message'
, sendMessageB
, sendMessageWithNoRefreshB
, sendMessageWithNoRefreshToCurrentB, sendMessageWithNoRefreshToCurrent
-- * Utility Functions
-- ** Send All
, sendSomeMessagesB, sendSomeMessages, sendMessagesB, sendMessages
-- ** Send Until
, tryInOrderB, tryInOrderWithNoRefreshToCurrentB, tryInOrderWithNoRefreshToCurrent
, tryMessageB, tryMessageWithNoRefreshToCurrentB, tryMessageWithNoRefreshToCurrent
-- ** Aliases
, sm
-- * Backwards Compatibility
-- $backwardsCompatibility
, send, sendSM, sendSM_
, tryInOrder, tryInOrder_
, tryMessage, tryMessage_
) where
import XMonad ( Window )
import XMonad.Core ( X(), Message, SomeMessage(..), LayoutClass(..), windowset, catchX, WorkspaceId, Layout, whenJust )
import XMonad.StackSet ( Workspace, current, workspace, layout, tag )
import XMonad.Operations ( updateLayout, windowBracket, modifyWindowSet )
import Data.Maybe ( isJust )
import Control.Monad ( void )
import Control.Monad.State ( gets )
import Control.Applicative ( (<$>), liftA2 )
import Control.Monad.State ( gets )
import Data.Maybe ( isJust )
import Control.Applicative ((<$>))
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.MessageFeedback
--
-- You can then use this module's functions wherever an action is expected. All
-- feedback variants are supported:
--
-- * message to any workspace with no refresh
-- * message to current workspace with no refresh
-- * message to current workspace with refresh
--
-- Except "message to any workspace with refresh" which makes little sense.
-- You can then use this module's functions wherever an action is expected.
--
-- Note that most functions in this module have a return type of @X Bool@
-- whereas configuration options will expect a @X ()@ action. For example, the
-- key binding:
-- whereas configuration options will expect a @X ()@ action.
-- For example, the key binding
--
-- > -- Shrink the master area of a tiled layout, or move the focused window
-- > -- to the left in a WindowArranger-based layout
-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrentB Shrink (MoveLeft 50))
-- > ((modKey, xK_Left), tryMessage Shrink (MoveLeft 50))
--
-- is mis-typed. For this reason, this module provides alternatives (not ending
-- with an uppercase \"B\", e.g. 'XMonad.Operations.sendMessage' rather than
-- 'sendMessageB') that discard their boolean result and return an @X ()@. For
-- example, to correct the previous example:
-- is mis-typed. For this reason, this module provides alternatives (ending with
-- an underscore, e.g. tryMessage_) that discard their result and return an @X ()@.
-- For example, to correct the previous example:
--
-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrent Shrink (MoveLeft 50))
-- > ((modKey, xK_Left), tryMessage_ Shrink (MoveLeft 50))
--
-- This module also provides 'SomeMessage' variants of each 'Message' function
-- for when the messages are of differing types (but still instances of
-- 'Message'). First box each message using 'SomeMessage' or the convenience
-- alias 'sm'. Then, for example, to send each message:
--
-- > sendSomeMessages [sm messageOfTypeA, sm messageOfTypeB]
--
-- This is /not/ equivalent to the following example, which will not refresh
-- the workspace unless the last message is handled:
--
-- > sendMessageWithNoRefreshToCurrent messageOfTypeA >> sendMessage messageOfTypeB
-- | Variant of 'XMonad.Operations.sendMessage'. Accepts 'SomeMessage'; to use
-- 'Message' see 'sendMessageB'. Returns @True@ if the message was handled,
-- @False@ otherwise. Instead of using 'sendSomeMessageWithNoRefreshToCurrentB'
-- for efficiency this is pretty much an exact copy of the
-- 'XMonad.Operations.sendMessage' code - foregoes the O(n) 'updateLayout'.
sendSomeMessageB :: SomeMessage -> X Bool
sendSomeMessageB m = windowBracket id $ do
w <- workspace . current <$> gets windowset
ml <- handleMessage (layout w) m `catchX` return Nothing
whenJust ml $ \l ->
modifyWindowSet $ \ws -> ws { current = (current ws)
{ workspace = (workspace $ current ws)
{ layout = l }}}
return $ isJust ml
-- | Behaves like 'XMonad.Operations.sendMessage', but returns True of the
-- message was handled by the layout, False otherwise.
send :: Message a => a -> X Bool
send = sendSM . sm
-- | Variant of 'sendSomeMessageB' that discards the result.
sendSomeMessage :: SomeMessage -> X ()
sendSomeMessage = void . sendSomeMessageB
-- | Sends the first message, and if it was not handled, sends the second.
-- Returns True if either message was handled, False otherwise.
tryMessage :: (Message a, Message b) => a -> b -> X Bool
tryMessage m1 m2 = do b <- send m1
if b then return True else send m2
-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh'. Accepts
-- 'SomeMessage'; to use 'Message' see 'sendMessageWithNoRefreshB'. Returns
-- @True@ if the message was handled, @False@ otherwise.
sendSomeMessageWithNoRefreshB :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendSomeMessageWithNoRefreshB m w
= handleMessage (layout w) m `catchX` return Nothing
>>= liftA2 (>>) (updateLayout $ tag w) (return . isJust)
tryMessage_ :: (Message a, Message b) => a -> b -> X ()
tryMessage_ m1 m2 = tryMessage m1 m2 >> return ()
-- | Variant of 'sendSomeMessageWithNoRefreshB' that discards the result.
sendSomeMessageWithNoRefresh :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X ()
sendSomeMessageWithNoRefresh m = void . sendSomeMessageWithNoRefreshB m
-- | Tries sending every message of the list in order until one of them
-- is handled. Returns True if one of the messages was handled, False otherwise.
tryInOrder :: [SomeMessage] -> X Bool
tryInOrder [] = return False
tryInOrder (m:ms) = do b <- sendSM m
if b then return True else tryInOrder ms
-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh' that sends the
-- message to the current layout. Accepts 'SomeMessage'; to use 'Message' see
-- 'sendMessageWithNoRefreshToCurrentB'. Returns @True@ if the message was
-- handled, @False@ otherwise. This function is somewhat of a cross between
-- 'XMonad.Operations.sendMessage' (sends to the current layout) and
-- 'XMonad.Operations.sendMessageWithNoRefresh' (does not refresh).
sendSomeMessageWithNoRefreshToCurrentB :: SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB m
= (gets $ workspace . current . windowset)
>>= sendSomeMessageWithNoRefreshB m
-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' that discards the
-- result.
sendSomeMessageWithNoRefreshToCurrent :: SomeMessage -> X ()
sendSomeMessageWithNoRefreshToCurrent = void . sendSomeMessageWithNoRefreshToCurrentB
tryInOrder_ :: [SomeMessage] -> X ()
tryInOrder_ ms = tryInOrder ms >> return ()
-- | Variant of 'sendSomeMessageB' which like 'XMonad.Operations.sendMessage'
-- accepts 'Message' rather than 'SomeMessage'. Returns @True@ if the message
-- was handled, @False@ otherwise.
sendMessageB :: Message a => a -> X Bool
sendMessageB = sendSomeMessageB . SomeMessage
-- | Variant of 'sendSomeMessageWithNoRefreshB' which like
-- 'XMonad.Operations.sendMessageWithNoRefresh' accepts 'Message' rather than
-- 'SomeMessage'. Returns @True@ if the message was handled, @False@ otherwise.
sendMessageWithNoRefreshB :: Message a => a -> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendMessageWithNoRefreshB = sendSomeMessageWithNoRefreshB . SomeMessage
-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' which accepts
-- 'Message' rather than 'SomeMessage'. Returns @True@ if the message was
-- handled, @False@ otherwise.
sendMessageWithNoRefreshToCurrentB :: Message a => a -> X Bool
sendMessageWithNoRefreshToCurrentB = sendSomeMessageWithNoRefreshToCurrentB . SomeMessage
-- | Variant of 'sendMessageWithNoRefreshToCurrentB' that discards the result.
sendMessageWithNoRefreshToCurrent :: Message a => a -> X ()
sendMessageWithNoRefreshToCurrent = void . sendMessageWithNoRefreshToCurrentB
-- | Send each 'SomeMessage' to the current layout without refresh (using
-- 'sendSomeMessageWithNoRefreshToCurrentB') and collect the results. If any
-- message was handled, refresh. If you want to sequence a series of messages
-- that would have otherwise used 'XMonad.Operations.sendMessage' while
-- minimizing refreshes, use this.
sendSomeMessagesB :: [SomeMessage] -> X [Bool]
sendSomeMessagesB
= windowBracket or
. mapM sendSomeMessageWithNoRefreshToCurrentB
-- | Variant of 'sendSomeMessagesB' that discards the results.
sendSomeMessages :: [SomeMessage] -> X ()
sendSomeMessages = void . sendSomeMessagesB
-- | Variant of 'sendSomeMessagesB' which accepts 'Message' rather than
-- 'SomeMessage'. Use this if all the messages are of the same type.
sendMessagesB :: Message a => [a] -> X [Bool]
sendMessagesB = sendSomeMessagesB . map SomeMessage
-- | Variant of 'sendMessagesB' that discards the results.
sendMessages :: Message a => [a] -> X ()
sendMessages = void . sendMessagesB
-- | Apply the dispatch function in order to each message of the list until one
-- is handled. Returns @True@ if so, @False@ otherwise.
tryInOrderB :: (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool
tryInOrderB _ [] = return False
tryInOrderB f (m:ms) = do b <- f m
if b then return True else tryInOrderB f ms
-- | Variant of 'tryInOrderB' that sends messages to the current layout without
-- refresh using 'sendSomeMessageWithNoRefreshToCurrentB'.
tryInOrderWithNoRefreshToCurrentB :: [SomeMessage] -> X Bool
tryInOrderWithNoRefreshToCurrentB = tryInOrderB sendSomeMessageWithNoRefreshToCurrentB
-- | Variant of 'tryInOrderWithNoRefreshToCurrent' that discards the results.
tryInOrderWithNoRefreshToCurrent :: [SomeMessage] -> X ()
tryInOrderWithNoRefreshToCurrent = void . tryInOrderWithNoRefreshToCurrentB
-- | Apply the dispatch function to the first message, and if it was not
-- handled, apply it to the second. Returns @True@ if either message was
-- handled, @False@ otherwise.
tryMessageB :: (Message a, Message b) => (SomeMessage -> X Bool) -> a -> b -> X Bool
tryMessageB f m1 m2 = tryInOrderB f [sm m1,sm m2]
-- | Variant of 'tryMessageB' that sends messages to the current layout without
-- refresh using 'sendMessageWithNoRefreshToCurrentB'.
tryMessageWithNoRefreshToCurrentB :: (Message a, Message b) => a -> b -> X Bool
tryMessageWithNoRefreshToCurrentB = tryMessageB sendSomeMessageWithNoRefreshToCurrentB
-- | Variant of 'tryMessage' that discards the results.
tryMessageWithNoRefreshToCurrent :: (Message a, Message b) => a -> b -> X ()
tryMessageWithNoRefreshToCurrent m = void . tryMessageWithNoRefreshToCurrentB m
-- | Convenience shorthand for 'SomeMessage'.
-- | Convenience shorthand for 'XMonad.Core.SomeMessage'.
sm :: Message a => a -> SomeMessage
sm = SomeMessage
--------------------------------------------------------------------------------
-- Backwards Compatibility:
--------------------------------------------------------------------------------
{-# DEPRECATED send "Use sendMessageB instead." #-}
{-# DEPRECATED sendSM "Use sendSomeMessageB instead." #-}
{-# DEPRECATED sendSM_ "Use sendSomeMessage instead." #-}
{-# DEPRECATED tryInOrder "Use tryInOrderWithNoRefreshToCurrentB instead." #-}
{-# DEPRECATED tryInOrder_ "Use tryInOrderWithNoRefreshToCurrent instead." #-}
{-# DEPRECATED tryMessage "Use tryMessageWithNoRefreshToCurrentB instead." #-}
{-# DEPRECATED tryMessage_ "Use tryMessageWithNoRefreshToCurrent instead." #-}
-- $backwardsCompatibility
-- The following functions exist solely for compatibility with pre-0.14
-- releases.
-- | See 'sendMessageWithNoRefreshToCurrentB'.
send :: Message a => a -> X Bool
send = sendMessageWithNoRefreshToCurrentB
-- | See 'sendSomeMessageWithNoRefreshToCurrentB'.
sendSM :: SomeMessage -> X Bool
sendSM = sendSomeMessageWithNoRefreshToCurrentB
sendSM m = do w <- workspace . current <$> gets windowset
ml' <- handleMessage (layout w) m `catchX` return Nothing
updateLayout (tag w) ml'
return $ isJust ml'
-- | See 'sendSomeMessageWithNoRefreshToCurrent'.
sendSM_ :: SomeMessage -> X ()
sendSM_ = sendSomeMessageWithNoRefreshToCurrent
-- | See 'tryInOrderWithNoRefreshToCurrentB'.
tryInOrder :: [SomeMessage] -> X Bool
tryInOrder = tryInOrderWithNoRefreshToCurrentB
-- | See 'tryInOrderWithNoRefreshToCurrent'.
tryInOrder_ :: [SomeMessage] -> X ()
tryInOrder_ = tryInOrderWithNoRefreshToCurrent
-- | See 'tryMessageWithNoRefreshToCurrentB'.
tryMessage :: (Message a, Message b) => a -> b -> X Bool
tryMessage = tryMessageWithNoRefreshToCurrentB
-- | See 'tryMessageWithNoRefreshToCurrent'.
tryMessage_ :: (Message a, Message b) => a -> b -> X ()
tryMessage_ = tryMessageWithNoRefreshToCurrent
sendSM_ m = sendSM m >> return ()

144
XMonad/Actions/Minimize.hs
View File

@@ -1,144 +0,0 @@
----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.Minimize
-- Copyright : (c) Bogdan Sinitsyn (2016)
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Bogdan Sinitsyn <bogdan.sinitsyn@gmail.com>
-- Stability : unstable
-- Portability : not portable
--
-- Adds actions for minimizing and maximizing windows
--
-- This module should be used with "XMonad.Layout.Minimize". Add 'minimize' to your
-- layout modifiers as described in "XMonad.Layout.Minimized" and use actions from
-- this module
--
-- Possible keybindings:
--
-- > , ((modm, xK_m ), withFocused minimizeWindow)
-- > , ((modm .|. shiftMask, xK_m ), withLastMinimized maximizeWindowAndFocus)
--
-----------------------------------------------------------------------------
module XMonad.Actions.Minimize
( -- * Usage
-- $usage
minimizeWindow
, maximizeWindow
, maximizeWindowAndFocus
, withLastMinimized
, withLastMinimized'
, withFirstMinimized
, withFirstMinimized'
, withMinimized
) where
import XMonad
import qualified XMonad.StackSet as W
import qualified XMonad.Layout.BoringWindows as BW
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.Minimize
import XMonad.Util.WindowProperties (getProp32)
import Foreign.C.Types (CLong)
import Control.Applicative((<$>))
import Control.Monad (join)
import Data.Maybe (fromMaybe, listToMaybe)
import qualified Data.List as L
import qualified Data.Map as M
-- $usage
-- Import this module with "XMonad.Layout.Minimize" and "XMonad.Layout.BoringWindows":
-- > import XMonad.Actions.Minimize
-- > import XMonad.Layout.Minimize
-- > import qualified XMonad.Layout.BoringWindows as BW
--
-- Then apply 'minimize' and 'boringWindows' to your layout hook and use some
-- actions from this module:
-- > main = xmonad def { layoutHook = minimize . BW.boringWindows $ whatever }
-- Example keybindings:
-- > , ((modm, xK_m ), withFocused minimizeWindow )
-- > , ((modm .|. shiftMask, xK_m ), withLastMinimized maximizeWindow)
setMinimizedState :: Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X ()
setMinimizedState win st f = do
setWMState win st
withDisplay $ \dpy -> do
wm_state <- getAtom "_NET_WM_STATE"
hidden <- fromIntegral <$> getAtom "_NET_WM_STATE_HIDDEN"
wstate <- fromMaybe [] <$> getProp32 wm_state win
io $ changeProperty32 dpy win wm_state aTOM propModeReplace (f hidden wstate)
setMinimized :: Window -> X ()
setMinimized win = setMinimizedState win iconicState (:)
setNotMinimized :: Window -> X ()
setNotMinimized win = setMinimizedState win normalState L.delete
-- It does not just set minimizedStack to newWindows because it should save
-- order in which elements were added (newer first)
modified :: (RectMap -> RectMap) -> X Bool
modified f = XS.modified $
\Minimized { rectMap = oldRectMap, minimizedStack = oldStack } ->
let newRectMap = f oldRectMap
newWindows = M.keys newRectMap
in Minimized { rectMap = newRectMap
, minimizedStack = (newWindows L.\\ oldStack)
++
(oldStack `L.intersect` newWindows)
}
-- | Minimize a window
minimizeWindow :: Window -> X ()
minimizeWindow w = withWindowSet $ \ws ->
whenX (modified $ M.insert w (M.lookup w $ W.floating ws)) $ do
setMinimized w
windows $ W.sink w
BW.focusDown
-- | Maximize window and apply a function to maximized window and 'WindowSet'
maximizeWindowAndChangeWSet :: (Window -> WindowSet -> WindowSet) -> Window -> X ()
maximizeWindowAndChangeWSet f w = do
mrect <- XS.gets (join . M.lookup w . rectMap)
whenX (modified $ M.delete w) $ do
setNotMinimized w
broadcastMessage BW.UpdateBoring
windows $ f w . maybe id (W.float w) mrect
-- | Just maximize a window without focusing
maximizeWindow :: Window -> X ()
maximizeWindow = maximizeWindowAndChangeWSet $ const id
-- | Maximize a window and then focus it
maximizeWindowAndFocus :: Window -> X ()
maximizeWindowAndFocus = maximizeWindowAndChangeWSet W.focusWindow
-- | Perform an action with first minimized window on current workspace
-- or do nothing if there is no minimized windows on current workspace
withFirstMinimized :: (Window -> X ()) -> X ()
withFirstMinimized action = withFirstMinimized' (flip whenJust action)
-- | Like withFirstMinimized but the provided action is always invoked with a
-- 'Maybe Window', that will be nothing if there is no first minimized window.
withFirstMinimized' :: (Maybe Window -> X ()) -> X ()
withFirstMinimized' action = withMinimized (action . listToMaybe . reverse)
-- | Perform an action with last minimized window on current workspace
-- or do nothing if there is no minimized windows on current workspace
withLastMinimized :: (Window -> X ()) -> X ()
withLastMinimized action = withLastMinimized' (flip whenJust action)
-- | Like withLastMinimized but the provided action is always invoked with a
-- 'Maybe Window', that will be nothing if there is no last minimized window.
withLastMinimized' :: (Maybe Window -> X ()) -> X ()
withLastMinimized' action = withMinimized (action . listToMaybe)
withMinimized :: ([Window] -> X a) -> X a
withMinimized action = do
minimized <- XS.gets minimizedStack
currentStack <- withWindowSet $ return . W.index
action $ minimized `L.intersect` currentStack

133
XMonad/Actions/Navigation2D.hs
View File

@@ -43,9 +43,6 @@ module XMonad.Actions.Navigation2D ( -- * Usage
, Navigation2D
, lineNavigation
, centerNavigation
, sideNavigation
, sideNavigationWithBias
, hybridOf
, hybridNavigation
, fullScreenRect
, singleWindowRect
@@ -62,7 +59,6 @@ import Control.Applicative
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe
import Data.Ord (comparing)
import XMonad hiding (Screen)
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
@@ -74,17 +70,16 @@ import XMonad.Util.Types
-- Navigation2D provides directional navigation (go left, right, up, down) for
-- windows and screens. It treats floating and tiled windows as two separate
-- layers and provides mechanisms to navigate within each layer and to switch
-- between layers. Navigation2D provides three different navigation strategies
-- (see <#Technical_Discussion> for details): /Line navigation/ and
-- /Side navigation/ feel rather natural but may make it impossible to navigate
-- to a given window from the current window, particularly in the floating
-- layer. /Center navigation/ feels less natural in certain situations but
-- ensures that all windows can be reached without the need to involve the
-- mouse. Another option is to use a /Hybrid/ of the three strategies,
-- automatically choosing whichever first provides a suitable target window.
-- Navigation2D allows different navigation strategies to be used in the two
-- layers and allows customization of the navigation strategy for the tiled
-- layer based on the layout currently in effect.
-- between layers. Navigation2D provides two different navigation strategies
-- (see <#Technical_Discussion> for details): /Line navigation/ feels rather
-- natural but may make it impossible to navigate to a given window from the
-- current window, particularly in the floating layer. /Center navigation/
-- feels less natural in certain situations but ensures that all windows can be
-- reached without the need to involve the mouse. A third option is to use
-- /Hybrid navigation/, which automatically chooses between the two whenever
-- navigation is attempted. Navigation2D allows different navigation strategies
-- to be used in the two layers and allows customization of the navigation strategy
-- for the tiled layer based on the layout currently in effect.
--
-- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:
--
@@ -101,11 +96,11 @@ import XMonad.Util.Types
--
-- Alternatively, you can use navigation2DP:
--
-- > main = xmonad $ navigation2DP def
-- > ("<Up>", "<Left>", "<Down>", "<Right>")
-- > [("M-", windowGo ),
-- > ("M-S-", windowSwap)]
-- > False
-- > main = xmonad $ navigation2D def
-- > ("<Up>", "<Left>", "<Down>", "<Right>")
-- > [("M-", windowGo ),
-- > ("M-S-", windowSwap)]
-- > False
-- > $ def
--
-- That's it. If instead you'd like more control, you can combine
@@ -323,46 +318,12 @@ lineNavigation = N 1 doLineNavigation
centerNavigation :: Navigation2D
centerNavigation = N 2 doCenterNavigation
-- | Side navigation. Consider navigating to the right this time. The strategy
-- is to take the line segment forming the right boundary of the current window,
-- and push it to the right until it intersects with at least one other window.
-- Of those windows, one with a point that is the closest to the centre of the
-- line (+1) is selected. This is probably the most intuitive strategy for the
-- tiled layer when using XMonad.Layout.Spacing.
sideNavigation :: Navigation2D
sideNavigation = N 1 (doSideNavigationWithBias 1)
-- | Side navigation with bias. Consider a case where the screen is divided
-- up into three vertical panes; the side panes occupied by one window each and
-- the central pane split across the middle by two windows. By the criteria
-- of side navigation, the two central windows are equally good choices when
-- navigating inwards from one of the side panes. Hence in order to be
-- equitable, symmetric and pleasant to use, different windows are chosen when
-- navigating from different sides. In particular, the lower is chosen when
-- going left and the higher when going right, causing L, L, R, R, L, L, etc to
-- cycle through the four windows clockwise. This is implemented by using a bias
-- of 1. /Bias/ is how many pixels off centre the vertical split can be before
-- this behaviour is lost and the same window chosen every time. A negative bias
-- swaps the preferred window for each direction. A bias of zero disables the
-- behaviour.
sideNavigationWithBias :: Int -> Navigation2D
sideNavigationWithBias b = N 1 (doSideNavigationWithBias b)
-- | Hybrid of two modes of navigation, preferring the motions of the first.
-- Use this if you want to fall back on a second strategy whenever the first
-- does not find a candidate window. E.g.
-- @hybridOf lineNavigation centerNavigation@ is a good strategy for the
-- floating layer, and @hybridOf sideNavigation centerNavigation@ will enable
-- you to take advantage of some of the latter strategy's more interesting
-- motions in the tiled layer.
hybridOf :: Navigation2D -> Navigation2D -> Navigation2D
hybridOf (N g1 s1) (N g2 s2) = N (max g1 g2) $ applyToBoth s1 s2
where
applyToBoth f g a b c = f a b c <|> g a b c
{-# DEPRECATED hybridNavigation "Use hybridOf with lineNavigation and centerNavigation as arguments." #-}
-- | Hybrid navigation. This attempts Line navigation, then falls back on Center
-- navigation if it does not find any suitable target windows. This is useful since
-- Line navigation tends to fail on gaps, but provides more intuitive motions
-- when it succeeds—provided there are no floating windows.
hybridNavigation :: Navigation2D
hybridNavigation = hybridOf lineNavigation centerNavigation
hybridNavigation = N 2 doHybridNavigation
-- | Stores the configuration of directional navigation. The 'Default' instance
-- uses line navigation for the tiled layer and for navigation between screens,
@@ -806,54 +767,12 @@ doCenterNavigation dir (cur, rect) winrects
-- or it has the same distance but comes later
-- in the window stack
-- x -y w h format is a pain. Let's use side coordinates. We assume x1 <= x2 and
-- y1 <= y2, and make the assumption valid by initialising SideRects with the
-- property and carefully preserving it over any individual transformation.
data SideRect = SideRect { x1 :: Int, x2 :: Int, y1 :: Int, y2 :: Int }
deriving Show
-- Conversion from Rectangle format to SideRect.
toSR :: Rectangle -> SideRect
toSR (Rectangle x y w h) = SideRect (fi x) (fi x + fi w) (-fi y - fi h) (-fi y)
-- Implements side navigation with bias.
doSideNavigationWithBias ::
Eq a => Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
doSideNavigationWithBias bias dir (cur, rect)
= fmap fst . listToMaybe
. L.sortBy (comparing dist) . foldr acClosest []
. filter (`toRightOf` (cur, transform rect))
. map (fmap transform)
where
-- Getting the center of the current window so we can make it the new origin.
cOf r = ((x1 r + x2 r) `div` 2, (y1 r + y2 r) `div` 2)
(x0, y0) = cOf . toSR $ rect
-- Translate the given SideRect by (-x0, -y0).
translate r = SideRect (x1 r - x0) (x2 r - x0) (y1 r - y0) (y2 r - y0)
-- Rotate the given SideRect 90 degrees counter-clockwise about the origin.
rHalfPiCC r = SideRect (-y2 r) (-y1 r) (x1 r) (x2 r)
-- Apply the above function until d becomes synonymous with R (wolog).
rotateToR d = let (_, _:l) = break (d ==) [U, L, D, R]
in foldr (const $ (.) rHalfPiCC) id l
transform = rotateToR dir . translate . toSR
-- (_, r) `toRightOf` (_, c) iff r has points to the right of c that aren't
-- below or above c, i.e. iff:
-- [x1 r, x2 r] x [y1 r, y2 r] intersects (x2 c, infinity) x (y1 c, y2 c)
toRightOf (_, r) (_, c) = (x2 r > x2 c) && (y2 r > y1 c) && (y1 r < y2 c)
-- Greedily accumulate the windows tied for the leftmost left side.
acClosest (w, r) l@((_, r'):_) | x1 r == x1 r' = (w, r) : l
| x1 r > x1 r' = l
acClosest (w, r) _ = (w, r) : []
-- Given a (_, SideRect), calculate how far it is from the y=bias line.
dist (_, r) | (y1 r <= bias) && (bias <= y2 r) = 0
| otherwise = min (abs $ y1 r - bias) (abs $ y2 r - bias)
-- | Implements Hybrid navigation. This attempts Line navigation first,
-- then falls back on Center navigation if it finds no suitable target window.
doHybridNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doHybridNavigation = applyToBoth (<|>) doLineNavigation doCenterNavigation
where
applyToBoth f g h a b c = f (g a b c) (h a b c)
-- | Swaps the current window with the window given as argument
swap :: Window -> WindowSet -> WindowSet

117
XMonad/Actions/PhysicalScreens.hs
View File

@@ -21,12 +21,6 @@ module XMonad.Actions.PhysicalScreens (
, sendToScreen
, onNextNeighbour
, onPrevNeighbour
, horizontalScreenOrderer
, verticalScreenOrderer
, ScreenComparator(ScreenComparator)
, getScreenIdAndRectangle
, screenComparatorById
, screenComparatorByRectangle
) where
import XMonad
@@ -42,20 +36,17 @@ physical location relative to each other (as reported by Xinerama),
rather than their @ScreenID@ s, which are arbitrarily determined by
your X server and graphics hardware.
You can specify how to order the screen by giving a ScreenComparator.
To create a screen comparator you can use screenComparatorByRectangle or screenComparatorByScreenId.
The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
Screens are ordered by the upper-left-most corner, from top-to-bottom
and then left-to-right.
Example usage in your @~\/.xmonad\/xmonad.hs@ file:
> import XMonad.Actions.PhysicalScreens
> import Data.Default
> , ((modMask, xK_a), onPrevNeighbour def W.view)
> , ((modMask, xK_o), onNextNeighbour def W.view)
> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour def W.shift)
> , ((modMask .|. shiftMask, xK_o), onNextNeighbour def W.shift)
> , ((modMask, xK_a), onPrevNeighbour W.view)
> , ((modMask, xK_o), onNextNeighbour W.view)
> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour W.shift)
> , ((modMask .|. shiftMask, xK_o), onNextNeighbour W.shift)
> --
> -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3
@@ -63,7 +54,7 @@ Example usage in your @~\/.xmonad\/xmonad.hs@ file:
> --
> [((modm .|. mask, key), f sc)
> | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
> , (f, mask) <- [(viewScreen def, 0), (sendToScreen def, shiftMask)]]
> , (f, mask) <- [(viewScreen, 0), (sendToScreen, shiftMask)]]
For detailed instructions on editing your key bindings, see
"XMonad.Doc.Extending#Editing_key_bindings".
@@ -72,78 +63,52 @@ For detailed instructions on editing your key bindings, see
-- | The type of the index of a screen by location
newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
getScreenIdAndRectangle :: (W.Screen i l a ScreenId ScreenDetail) -> (ScreenId, Rectangle)
getScreenIdAndRectangle screen = (W.screen screen, rect) where
rect = screenRect $ W.screenDetail screen
-- | Translate a physical screen index to a "ScreenId"
getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
getScreen (ScreenComparator cmpScreen) (P i) = do w <- gets windowset
let screens = W.current w : W.visible w
if i<0 || i >= length screens
then return Nothing
else let ss = sortBy (cmpScreen `on` getScreenIdAndRectangle) screens
in return $ Just $ W.screen $ ss !! i
getScreen :: PhysicalScreen -> X (Maybe ScreenId)
getScreen (P i) = do w <- gets windowset
let screens = W.current w : W.visible w
if i<0 || i >= length screens
then return Nothing
else let ss = sortBy (cmpScreen `on` (screenRect . W.screenDetail)) screens
in return $ Just $ W.screen $ ss !! i
-- | Switch to a given physical screen
viewScreen :: ScreenComparator -> PhysicalScreen -> X ()
viewScreen sc p = do i <- getScreen sc p
whenJust i $ \s -> do
w <- screenWorkspace s
whenJust w $ windows . W.view
viewScreen :: PhysicalScreen -> X ()
viewScreen p = do i <- getScreen p
whenJust i $ \s -> do
w <- screenWorkspace s
whenJust w $ windows . W.view
-- | Send the active window to a given physical screen
sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()
sendToScreen sc p = do i <- getScreen sc p
whenJust i $ \s -> do
w <- screenWorkspace s
whenJust w $ windows . W.shift
sendToScreen :: PhysicalScreen -> X ()
sendToScreen p = do i <- getScreen p
whenJust i $ \s -> do
w <- screenWorkspace s
whenJust w $ windows . W.shift
-- | A ScreenComparator allow to compare two screen based on their coordonate and Xinerama Id
newtype ScreenComparator = ScreenComparator ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
-- | Compare two screens by their top-left corners, ordering
-- | top-to-bottom and then left-to-right.
cmpScreen :: Rectangle -> Rectangle -> Ordering
cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)
-- | The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
instance Default ScreenComparator where
def= verticalScreenOrderer
-- | Compare screen only by their coordonate
screenComparatorByRectangle :: (Rectangle -> Rectangle -> Ordering) -> ScreenComparator
screenComparatorByRectangle rectComparator = ScreenComparator comparator where
comparator (_, rec1) (_, rec2) = rectComparator rec1 rec2
-- | Compare screen only by their Xinerama id
screenComparatorById :: (ScreenId -> ScreenId -> Ordering) -> ScreenComparator
screenComparatorById idComparator = ScreenComparator comparator where
comparator (id1, _) (id2, _) = idComparator id1 id2
-- | orders screens by the upper-left-most corner, from top-to-bottom
verticalScreenOrderer :: ScreenComparator
verticalScreenOrderer = screenComparatorByRectangle comparator where
comparator (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1, x1) (y2, x2)
-- | orders screens by the upper-left-most corner, from left-to-right
horizontalScreenOrderer :: ScreenComparator
horizontalScreenOrderer = screenComparatorByRectangle comparator where
comparator (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (x1, y1) (x2, y2)
-- | Get ScreenId for neighbours of the current screen based on position offset.
getNeighbour :: ScreenComparator -> Int -> X ScreenId
getNeighbour (ScreenComparator cmpScreen) d =
do w <- gets windowset
let ss = map W.screen $ sortBy (cmpScreen `on` getScreenIdAndRectangle) $ W.current w : W.visible w
curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
pos = (curPos + d) `mod` length ss
return $ ss !! pos
getNeighbour :: Int -> X ScreenId
getNeighbour d = do w <- gets windowset
let ss = map W.screen $ sortBy (cmpScreen `on` (screenRect . W.screenDetail)) $ W.current w : W.visible w
curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
pos = (curPos + d) `mod` length ss
return $ ss !! pos
neighbourWindows :: ScreenComparator -> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
neighbourWindows sc d f = do s <- getNeighbour sc d
w <- screenWorkspace s
whenJust w $ windows . f
neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
neighbourWindows d f = do s <- getNeighbour d
w <- screenWorkspace s
whenJust w $ windows . f
-- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter.
onNextNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onNextNeighbour sc = neighbourWindows sc 1
onNextNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onNextNeighbour = neighbourWindows 1
-- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.
onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onPrevNeighbour sc = neighbourWindows sc (-1)
onPrevNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onPrevNeighbour = neighbourWindows (-1)

39
XMonad/Actions/SpawnOn.hs
View File

@@ -28,14 +28,8 @@ module XMonad.Actions.SpawnOn (
shellPromptOn
) where
import Control.Exception (tryJust)
import Control.Monad (guard)
import Data.List (isInfixOf)
import Data.Maybe (isJust)
import System.IO.Error (isDoesNotExistError)
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Types (ProcessID)
import Text.Printf (printf)
import XMonad
import qualified XMonad.StackSet as W
@@ -74,25 +68,6 @@ instance ExtensionClass Spawner where
initialValue = Spawner []
getPPIDOf :: ProcessID -> Maybe ProcessID
getPPIDOf pid =
case unsafePerformIO . tryJust (guard . isDoesNotExistError) . readFile . printf "/proc/%d/stat" $ toInteger pid of
Left _ -> Nothing
Right contents -> case lines contents of
[] -> Nothing
first : _ -> case words first of
_ : _ : _ : ppid : _ -> Just $ fromIntegral (read ppid :: Int)
_ -> Nothing
getPPIDChain :: ProcessID -> [ProcessID]
getPPIDChain pid' = ppid_chain pid' []
where ppid_chain pid acc =
if pid == 0
then acc
else case getPPIDOf pid of
Nothing -> acc
Just ppid -> ppid_chain ppid (ppid : acc)
-- | Get the current Spawner or create one if it doesn't exist.
modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
modifySpawner f = XS.modify (Spawner . f . pidsRef)
@@ -108,17 +83,9 @@ manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)])
manageSpawnWithGC garbageCollect = do
Spawner pids <- liftX XS.get
mp <- pid
let ppid_chain = case mp of
Just winpid -> winpid : getPPIDChain winpid
Nothing -> []
known_window_handlers = [ mh
| ppid <- ppid_chain
, let mpid = lookup ppid pids
, isJust mpid
, let (Just mh) = mpid ]
case known_window_handlers of
[] -> idHook
(mh:_) -> do
case flip lookup pids =<< mp of
Nothing -> idHook
Just mh -> do
whenJust mp $ \p -> liftX $ do
ps <- XS.gets pidsRef
XS.put . Spawner =<< garbageCollect (filter ((/= p) . fst) ps)

18
XMonad/Actions/Submap.hs
View File

@@ -75,23 +75,17 @@ submapDefaultWithKey defAction keys = do
XConf { theRoot = root, display = d } <- ask
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync
none none currentTime
(m, s) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
maskEvent d (keyPressMask .|. buttonPressMask) p
ev <- getEvent p
case ev of
KeyEvent { ev_keycode = code, ev_state = m } -> do
keysym <- keycodeToKeysym d code 0
if isModifierKey keysym
then nextkey
else return (m, keysym)
_ -> return (0, 0)
maskEvent d keyPressMask p
KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
keysym <- keycodeToKeysym d code 0
if isModifierKey keysym
then nextkey
else return (m, keysym)
-- Remove num lock mask and Xkb group state bits
m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1)
io $ ungrabPointer d currentTime
io $ ungrabKeyboard d currentTime
fromMaybe (defAction (m', s)) (M.lookup (m', s) keys)

407
XMonad/Actions/SwapPromote.hs
View File

@@ -1,407 +0,0 @@
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.SwapPromote
-- Copyright : (c) 2018 Yclept Nemo
-- License : BSD-style (see LICENSE)
--
-- Maintainer :
-- Stability : unstable
-- Portability : unportable
--
-- Module for tracking master window history per workspace, and associated
-- functions for manipulating the stack using such history.
--
-----------------------------------------------------------------------------
module XMonad.Actions.SwapPromote
( -- * Usage
-- $usage
MasterHistory (..)
-- * State Accessors
, getMasterHistoryMap
, getMasterHistoryFromTag
, getMasterHistoryCurrent
, getMasterHistoryFromWindow
, modifyMasterHistoryFromTag
, modifyMasterHistoryCurrent
-- * Log Hook
, masterHistoryHook
-- * Log Hook Building Blocks
, masterHistoryHook'
, updateMasterHistory
-- * Actions
, swapPromote
, swapPromote'
, swapIn
, swapIn'
, swapHybrid
, swapHybrid'
-- * Action Building Blocks
, swapApply
, swapPromoteStack
, swapInStack
, swapHybridStack
-- * List Utilities
, cycleN
, split
, split'
, merge
, merge'
-- * Stack Utilities
, stackSplit
, stackMerge
) where
import XMonad
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import qualified Data.Map as M
import qualified Data.Set as S
import Data.List
import Data.Maybe
import Control.Arrow
import Control.Applicative ((<$>),(<*>))
import Control.Monad
-- $usage
-- Given your configuration file, import this module:
--
-- > import XMonad.Actions.SwapPromote
--
-- First add 'masterHistoryHook' to your 'logHook' to track master windows per
-- workspace:
--
-- > myLogHook = otherHook >> masterHistoryHook
--
-- Then replace xmonad's default promote keybinding with 'swapPromote'':
--
-- > , ((mod1Mask, xK_Return), swapPromote' False)
--
-- Depending on your xmonad configuration or window actions the master history
-- may be empty. If this is the case you can still chain another promotion
-- function:
--
-- > import XMonad.Actions.DwmPromote
-- > , ((mod1Mask, xK_Return), whenX (swapPromote False) dwmpromote)
--
-- To be clear, this is only called when the lack of master history hindered
-- the swap and not other conditions, such as having a only a single window.
--
-- While 'swapPromote' preserves window focus, 'swapIn' preserves the focus
-- position - effectively "swapping" new windows into focus without moving the
-- zipper. A mix of both, 'swapHybrid' promotes focused non-master windows
-- while swapping windows into the focused master. This works well on layouts
-- with large masters. Both come with chainable variants, see 'swapIn'' and
-- 'swapHybrid''.
--
-- So far floating windows have been treated no differently than tiled windows
-- even though their positions are independent of the stack. Often, yanking
-- floating windows in and out of the workspace will obliterate the stack
-- history - particularly frustrating with 'XMonad.Util.Scratchpad' since it is
-- toggled so frequenty and always replaces the master window. That's why the
-- swap functions accept a boolean argument; when @True@ non-focused floating
-- windows will be ignored.
--
-- All together:
--
-- > , ((mod1Mask, xK_Return), whenX (swapHybrid True) dwmpromote)
-- | Mapping from workspace tag to master history list. The current master is
-- the head of the list, the previous master the second element, and so on.
-- Without history, the list is empty.
newtype MasterHistory = MasterHistory
{ getMasterHistory :: M.Map WorkspaceId [Window]
} deriving (Read,Show,Typeable)
instance ExtensionClass MasterHistory where
initialValue = MasterHistory M.empty
-- | Return the master history map from the state.
getMasterHistoryMap :: X (M.Map WorkspaceId [Window])
getMasterHistoryMap = XS.gets getMasterHistory
-- | Return the master history list of a given tag. The master history list may
-- be empty. An invalid tag will also result in an empty list.
getMasterHistoryFromTag :: WorkspaceId -> X [Window]
getMasterHistoryFromTag t = M.findWithDefault [] t <$> getMasterHistoryMap
-- | Return the master history list of the current workspace.
getMasterHistoryCurrent :: X [Window]
getMasterHistoryCurrent = gets (W.currentTag . windowset)
>>= getMasterHistoryFromTag
-- | Return the master history list of the workspace containing the given
-- window. Return an empty list if the window is not in the stackset.
getMasterHistoryFromWindow :: Window -> X [Window]
getMasterHistoryFromWindow w = gets (W.findTag w . windowset)
>>= maybe (return []) getMasterHistoryFromTag
-- | Modify the master history list of a given workspace, or the empty list of
-- no such workspace is mapped. The result is then re-inserted into the master
-- history map.
modifyMasterHistoryFromTag :: WorkspaceId -> ([Window] -> [Window]) -> X ()
modifyMasterHistoryFromTag t f = XS.modify $ \(MasterHistory m) ->
let l = M.findWithDefault [] t m
in MasterHistory $ M.insert t (f l) m
-- | Modify the master history list of the current workspace. While the current
-- workspace is guaranteed to exist; its master history may not. For more
-- information see 'modifyMasterHistoryFromTag'.
modifyMasterHistoryCurrent :: ([Window] -> [Window]) -> X ()
modifyMasterHistoryCurrent f = gets (W.currentTag . windowset)
>>= flip modifyMasterHistoryFromTag f
-- | A 'logHook' to update the master history mapping. Non-existent workspaces
-- are removed, and the master history list for the current workspaces is
-- updated. See 'masterHistoryHook''.
masterHistoryHook :: X ()
masterHistoryHook = masterHistoryHook' True updateMasterHistory
-- | Backend for 'masterHistoryHook'.
masterHistoryHook' :: Bool
-- ^ If @True@, remove non-existent workspaces.
-> ([Window] -> [Window] -> [Window])
-- ^ Function used to update the master history list of
-- the current workspace. First argument is the master
-- history, second is the integrated stack. See
-- 'updateMasterHistory' for more details.
-> X ()
masterHistoryHook' removeWorkspaces historyModifier = do
wset <- gets windowset
let W.Workspace wid _ mst = W.workspace . W.current $ wset
tags = map W.tag $ W.workspaces wset
st = W.integrate' mst
XS.modify $ \(MasterHistory mm) ->
let mm' = if removeWorkspaces
then restrictKeys mm $ S.fromList tags
else mm
ms = M.findWithDefault [] wid mm'
ms' = historyModifier ms st
in MasterHistory $ M.insert wid ms' mm'
-- | Less efficient version of 'M.restrictKeys'. Given broader eventual
-- adoption, replace this with 'M.restrictKeys'.
restrictKeys :: Ord k => M.Map k a -> S.Set k -> M.Map k a
restrictKeys m s = M.filterWithKey (\k _ -> k `S.member` s) m
-- | Given the current master history list and an integrated stack, return the
-- new master history list. The current master is either moved (if it exists
-- within the history) or added to the head of the list, and all missing (i.e.
-- closed) windows are removed.
updateMasterHistory :: [Window] -- ^ The master history list.
-> [Window] -- ^ The integrated stack.
-> [Window]
updateMasterHistory _ [] = []
updateMasterHistory ms ws@(w:_) = (w : delete w ms) `intersect` ws
-- | Wrap 'swapPromoteStack'; see also 'swapApply'.
swapPromote :: Bool -> X Bool
swapPromote = flip swapApply swapPromoteStack
-- | Like 'swapPromote'' but discard the result.
swapPromote' :: Bool -> X ()
swapPromote' = void . swapPromote
-- | Wrap 'swapInStack'; see also 'swapApply'.
swapIn :: Bool -> X Bool
swapIn = flip swapApply swapInStack
-- | Like 'swapIn'' but discard the result.
swapIn' :: Bool -> X ()
swapIn' = void . swapIn
-- | Wrap 'swapHybridStack'; see also 'swapApply'.
swapHybrid :: Bool -> X Bool
swapHybrid = flip swapApply swapHybridStack
-- | Like 'swapHybrid'' but discard the result.
swapHybrid' :: Bool -> X ()
swapHybrid' = void . swapHybrid
-- | Apply the given master history stack modifier to the current stack. If
-- given @True@, all non-focused floating windows will be ignored. Return
-- @True@ if insufficient history; if so use 'whenX' to sequence a backup
-- promotion function.
swapApply :: Bool
-> (Maybe Window -> W.Stack Window -> (Bool,W.Stack Window))
-> X Bool
swapApply ignoreFloats swapFunction = do
fl <- gets $ W.floating . windowset
st <- gets $ W.stack . W.workspace . W.current . windowset
ch <- getMasterHistoryCurrent
let swapApply' s1 =
let fl' = if ignoreFloats then M.keysSet fl else S.empty
ff = (||) <$> (`S.notMember` fl') <*> (== W.focus s1)
fh = filter ff ch
pm = listToMaybe . drop 1 $ fh
(r,s2) = stackSplit s1 fl' :: ([(Int,Window)],W.Stack Window)
(b,s3) = swapFunction pm s2
s4 = stackMerge s3 r
mh = let w = head . W.integrate $ s3
in const $ w : delete w ch
in (b,Just s4,mh)
(x,y,z) = maybe (False,Nothing,id) swapApply' st
-- Any floating master windows will be added to the history when 'windows'
-- calls the log hook.
modifyMasterHistoryCurrent z
windows $ W.modify Nothing . const $ y
return x
-- | If the focused window is the master window and there is no previous
-- master, do nothing. Otherwise swap the master with the previous master. If
-- the focused window is not the master window, swap it with the master window.
-- In either case focus follows the original window, i.e. the focused window
-- does not change, only its position.
--
-- The first argument is the previous master (which may not exist), the second
-- a window stack. Return @True@ if the master history hindered the swap; the
-- history is either empty or out-of-sync. Though the latter shouldn't happen
-- this function never changes the stack under such circumstances.
swapPromoteStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
swapPromoteStack _ st@(W.Stack _x [] []) = (False,st)
swapPromoteStack Nothing st@(W.Stack _x [] _r) = (True,st)
swapPromoteStack (Just pm) (W.Stack x [] r) =
let (r',l') = (reverse *** cycleN 1) $ span (/= pm) $ reverse r
st' = W.Stack x l' r'
b = null l'
in (b,st')
swapPromoteStack _ (W.Stack x l r) =
let r' = (++ r) . cycleN 1 . reverse $ l
st' = W.Stack x [] r'
in (False,st')
-- | Perform the same swap as 'swapPromoteStack'. However the new window
-- receives the focus; it appears to "swap into" the position of the original
-- window. Under this model focus follows stack position and the zipper does
-- not move.
--
-- See 'swapPromoteStack' for more details regarding the parameters.
swapInStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
swapInStack _ st@(W.Stack _x [] []) = (False,st)
swapInStack Nothing st@(W.Stack _x [] _r) = (True,st)
swapInStack (Just pm) (W.Stack x [] r) =
let (x',r') = case span (/= pm) r of
(__,[]) -> (x,r)
(sl,sr) -> (pm,sl ++ x : drop 1 sr)
st' = W.Stack x' [] r'
b = x' == x
in (b,st')
swapInStack _ (W.Stack x l r) =
let l' = init l ++ [x]
x' = last l
st' = W.Stack x' l' r
in (False,st')
-- | If the focused window is the master window, use 'swapInStack'. Otherwise use
-- 'swapPromoteStack'.
--
-- See 'swapPromoteStack' for more details regarding the parameters.
swapHybridStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
swapHybridStack m st@(W.Stack _ [] _) = swapInStack m st
swapHybridStack m st = swapPromoteStack m st
-- | Cycle a list by the given count. If positive, cycle to the left. If
-- negative, cycle to the right:
--
-- >>> cycleN 2 [1,2,3,4,5]
-- [3,4,5,1,2]
-- >>> cycleN (-2) [1,2,3,4,5]
-- [4,5,1,2,3]
cycleN :: Int -> [a] -> [a]
cycleN n ls =
let l = length ls
in take l $ drop (n `mod` l) $ cycle ls
-- | Wrap 'split'' with an initial index of @0@, discarding the list's length.
split :: (Num a, Enum a) => (b -> Bool) -> [b] -> ([(a,b)],[b])
split p l =
let (_,ys,ns) = split' p 0 l
in (ys,ns)
-- | Given a predicate, an initial index and a list, return a tuple containing:
--
-- * List length.
-- * Indexed list of elements which satisfy the predicate. An indexed element
-- is a tuple containing the element index (offset by the initial index) and
-- the element.
-- * List of elements which do not satisfy the predicate.
--
-- The initial index and length of the list simplify chaining calls to this
-- function, such as for zippers of lists.
split' :: (Num a, Enum a) => (b -> Bool) -> a -> [b] -> (a,[(a,b)],[b])
split' p i l =
let accumulate e (c,ys,ns) = if p (snd e)
then (c+1,e:ys,ns)
else (c+1,ys,e:ns)
(c',ys',ns') = foldr accumulate (0,[],[]) $ zip [i..] l
in (c',ys',snd . unzip $ ns')
-- | Wrap 'merge'' with an initial virtual index of @0@. Return only the
-- unindexed list with elements from the leftover indexed list appended.
merge :: (Ord a, Num a) => [(a,b)] -> [b] -> [b]
merge il ul =
let (_,il',ul') = merge' 0 il ul
in ul' ++ map snd il'
-- | Inverse of 'split'. Merge an indexed list with an unindexed list (see
-- 'split''). Given a virtual index, an indexed list and an unindexed list,
-- return a tuple containing:
--
-- * Virtual index /after/ the unindexed list
-- * Remainder of the indexed list
-- * Merged unindexed list
--
-- If the indexed list is empty, this functions consumes the entire unindexed
-- list. If the unindexed list is empty, this function consumes only adjacent
-- indexed elements. For example, @[(10,"ten"),(12,"twelve")]@ implies missing
-- unindexed elements and so once @(10,"ten")@ is consumed this function
-- concludes.
--
-- The indexed list is assumed to have been created by 'split'' and not checked
-- for correctness. Indices are assumed to be ascending, i.e.
-- > [(1,"one"),(2,"two"),(4,"four")]
--
-- The initial and final virtual indices simplify chaining calls to the this
-- function, as as for zippers of lists. Positive values shift the unindexed
-- list towards the tail, as if preceded by that many elements.
merge' :: (Ord a, Num a) => a -> [(a,b)] -> [b] -> (a,[(a,b)],[b])
merge' i il@((j,a):ps) ul@(b:bs) = if j <= i
then let (x,y,z) = merge' (i+1) ps ul
in (x,y,a:z)
else let (x,y,z) = merge' (i+1) il bs
in (x,y,b:z)
merge' i [] (b:bs) =
let (x,y,z) = merge' (i+1) [] bs
in (x,y,b:z)
merge' i il@((j,a):ps) [] = if j <= i
then let (x,y,z) = merge' (i+1) ps []
in (x,y,a:z)
else (i,il,[])
merge' i [] [] =
(i,[],[])
-- | Remove all elements of the set from the stack. Skip the currently focused
-- member. Return an indexed list of excluded elements and the modified stack.
-- Use 'stackMerge' to re-insert the elements using this list.
stackSplit :: (Num a, Enum a, Ord b) => W.Stack b -> S.Set b -> ([(a,b)],W.Stack b)
stackSplit (W.Stack x l r) s =
let (c,fl,tl) = split' (`S.member` s) 0 (reverse l)
(_,fr,tr) = split' (`S.member` s) (c+1) r
in (fl++fr,W.Stack x (reverse tl) tr)
-- | Inverse of 'stackSplit'. Given a list of elements and their original
-- indices, re-insert the elements into these same positions within the stack.
-- Skip the currently focused member. Works best if the stack's length hasn't
-- changed, though if shorter any leftover elements will be tacked on.
stackMerge :: (Ord a, Num a) => W.Stack b -> [(a,b)] -> W.Stack b
stackMerge (W.Stack x l r) il =
let (i,il1,l') = merge' 0 il (reverse l)
(_,il2,r') = merge' (i+1) il1 r
in W.Stack x (reverse l') (r' ++ map snd il2)

12
XMonad/Actions/UpdatePointer.hs
View File

@@ -1,8 +1,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonadContrib.UpdatePointer
-- Copyright : (c) Robert Marlow <robreim@bobturf.org>, 2015 Evgeny Kurnevsky
-- Copyright : (c) Robert Marlow <robreim@bobturf.org>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Robert Marlow <robreim@bobturf.org>
@@ -29,7 +28,6 @@ import Control.Arrow
import Control.Monad
import XMonad.StackSet (member, peek, screenDetail, current)
import Data.Maybe
import Control.Exception
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -65,13 +63,9 @@ updatePointer :: (Rational, Rational) -> (Rational, Rational) -> X ()
updatePointer refPos ratio = do
ws <- gets windowset
dpy <- asks display
let defaultRect = screenRect $ screenDetail $ current ws
rect <- case peek ws of
Nothing -> return defaultRect
Just w -> do tryAttributes <- io $ try $ getWindowAttributes dpy w
return $ case tryAttributes of
Left (_ :: SomeException) -> defaultRect
Right attributes -> windowAttributesToRectangle attributes
Nothing -> return $ (screenRect . screenDetail .current) ws
Just w -> windowAttributesToRectangle `fmap` io (getWindowAttributes dpy w)
root <- asks theRoot
mouseIsMoving <- asks mouseFocused
(_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root

13
XMonad/Actions/WindowGo.hs
View File

@@ -38,14 +38,13 @@ module XMonad.Actions.WindowGo (
import Control.Monad
import Data.Char (toLower)
import qualified Data.List as L (nub,sortBy)
import Data.Monoid
import XMonad (Query(), X(), ManageHook, WindowSet, withWindowSet, runQuery, liftIO, ask)
import Graphics.X11 (Window)
import XMonad.ManageHook
import XMonad.Operations (windows)
import XMonad.Prompt.Shell (getBrowser, getEditor)
import qualified XMonad.StackSet as W (peek, swapMaster, focusWindow, workspaces, StackSet, Workspace, integrate', tag, stack)
import qualified XMonad.StackSet as W (allWindows, peek, swapMaster, focusWindow)
import XMonad.Util.Run (safeSpawnProg)
{- $usage
@@ -67,20 +66,12 @@ appropriate one, or cover your bases by using instead something like:
For detailed instructions on editing your key bindings, see
"XMonad.Doc.Extending#Editing_key_bindings". -}
-- | Get the list of workspaces sorted by their tag
workspacesSorted :: Ord i => W.StackSet i l a s sd -> [W.Workspace i l a]
workspacesSorted s = L.sortBy (\u t -> W.tag u `compare` W.tag t) $ W.workspaces s
-- | Get a list of all windows in the 'StackSet' with an absolute ordering of workspaces
allWindowsSorted :: Ord i => Eq a => W.StackSet i l a s sd -> [a]
allWindowsSorted = L.nub . concatMap (W.integrate' . W.stack) . workspacesSorted
-- | If windows that satisfy the query exist, apply the supplied
-- function to them, otherwise run the action given as
-- second parameter.
ifWindows :: Query Bool -> ([Window] -> X ()) -> X () -> X ()
ifWindows qry f el = withWindowSet $ \wins -> do
matches <- filterM (runQuery qry) $ allWindowsSorted wins
matches <- filterM (runQuery qry) $ W.allWindows wins
case matches of
[] -> el
ws -> f ws

2
XMonad/Actions/WindowMenu.hs
View File

@@ -28,7 +28,7 @@ import XMonad
import qualified XMonad.StackSet as W
import XMonad.Actions.GridSelect
import XMonad.Layout.Maximize
import XMonad.Actions.Minimize
import XMonad.Layout.Minimize
import XMonad.Util.XUtils (fi)
-- $usage

12
XMonad/Config/Azerty.hs
View File

@@ -17,7 +17,7 @@
module XMonad.Config.Azerty (
-- * Usage
-- $usage
azertyConfig, azertyKeys, belgianConfig, belgianKeys
azertyConfig, azertyKeys
) where
import XMonad
@@ -40,17 +40,11 @@ import qualified Data.Map as M
azertyConfig = def { keys = azertyKeys <+> keys def }
belgianConfig = def { keys = belgianKeys <+> keys def }
azertyKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0]
belgianKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0xa7,0xe8,0x21,0xe7,0xe0]
azertyKeysTop topRow conf@(XConfig {modMask = modm}) = M.fromList $
azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $
[((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
++
[((m .|. modm, k), windows $ f i)
| (i, k) <- zip (workspaces conf) topRow,
| (i, k) <- zip (workspaces conf) [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0],
(f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
++
-- mod-{z,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3

3
XMonad/Config/Bluetile.hs
View File

@@ -44,7 +44,6 @@ import XMonad.Layout.WindowSwitcherDecoration
import XMonad.Actions.BluetileCommands
import XMonad.Actions.CycleWS
import XMonad.Actions.Minimize
import XMonad.Actions.WindowMenu
import XMonad.Hooks.CurrentWorkspaceOnTop
@@ -144,7 +143,7 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
-- Minimizing
, ((modMask', xK_m ), withFocused minimizeWindow)
, ((modMask' .|. shiftMask, xK_m ), withLastMinimized maximizeWindow)
, ((modMask' .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin)
]
++
-- mod-[1..9] ++ [0] %! Switch to workspace N

78
XMonad/Config/Example.hs
View File

@@ -1,78 +0,0 @@
--------------------------------------------------------------------------------
-- | Example.hs
--
-- Example configuration file for xmonad using the latest recommended
-- features (e.g., 'desktopConfig').
module Main (main) where
--------------------------------------------------------------------------------
import System.Exit
import XMonad
import XMonad.Config.Desktop
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.ManageHelpers
import XMonad.Layout.BinarySpacePartition (emptyBSP)
import XMonad.Layout.NoBorders (noBorders)
import XMonad.Layout.ResizableTile (ResizableTall(..))
import XMonad.Layout.ToggleLayouts (ToggleLayout(..), toggleLayouts)
import XMonad.Prompt
import XMonad.Prompt.ConfirmPrompt
import XMonad.Prompt.Shell
import XMonad.Util.EZConfig
--------------------------------------------------------------------------------
main = do
spawn "xmobar" -- Start a task bar such as xmobar.
-- Start xmonad using the main desktop configuration with a few
-- simple overrides:
xmonad $ desktopConfig
{ modMask = mod4Mask -- Use the "Win" key for the mod key
, manageHook = myManageHook <+> manageHook desktopConfig
, layoutHook = desktopLayoutModifiers $ myLayouts
, logHook = dynamicLogString def >>= xmonadPropLog
}
`additionalKeysP` -- Add some extra key bindings:
[ ("M-S-q", confirmPrompt myXPConfig "exit" (io exitSuccess))
, ("M-p", shellPrompt myXPConfig)
, ("M-<Esc>", sendMessage (Toggle "Full"))
]
--------------------------------------------------------------------------------
-- | Customize layouts.
--
-- This layout configuration uses two primary layouts, 'ResizableTall'
-- and 'BinarySpacePartition'. You can also use the 'M-<Esc>' key
-- binding defined above to toggle between the current layout and a
-- full screen layout.
myLayouts = toggleLayouts (noBorders Full) others
where
others = ResizableTall 1 (1.5/100) (3/5) [] ||| emptyBSP
--------------------------------------------------------------------------------
-- | Customize the way 'XMonad.Prompt' looks and behaves. It's a
-- great replacement for dzen.
myXPConfig = def
{ position = Top
, alwaysHighlight = True
, promptBorderWidth = 0
, font = "xft:monospace:size=9"
}
--------------------------------------------------------------------------------
-- | Manipulate windows as they are created. The list given to
-- @composeOne@ is processed from top to bottom. The first matching
-- rule wins.
--
-- Use the `xprop' tool to get the info you need for these matches.
-- For className, use the second value that xprop gives you.
myManageHook = composeOne
[ className =? "Pidgin" -?> doFloat
, className =? "XCalc" -?> doFloat
, className =? "mpv" -?> doFloat
, isDialog -?> doCenterFloat
-- Move transient windows to their parent:
, transience
]

2
XMonad/Config/Gnome.hs
View File

@@ -47,7 +47,7 @@ gnomeConfig = desktopConfig
gnomeKeys (XConfig {modMask = modm}) = M.fromList $
[ ((modm, xK_p), gnomeRun)
, ((modm .|. shiftMask, xK_q), spawn "gnome-session-quit --logout") ]
, ((modm .|. shiftMask, xK_q), spawn "gnome-session-save --kill") ]
-- | Launch the "Run Application" dialog. gnome-panel must be running for this
-- to work.

79
XMonad/Config/Saegesser.hs
View File

@@ -1,79 +0,0 @@
{-# 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

79
XMonad/Hooks/DebugEvents.hs
View File

@@ -34,7 +34,6 @@ import Control.Exception.Extensible as E
import Control.Monad.State
import Control.Monad.Reader
import Data.Char (isDigit)
import Data.Maybe (fromJust)
import Data.List (genericIndex
,genericLength
,unfoldr
@@ -697,31 +696,30 @@ dumpList'' m ((l,p,t):ps) sep = do
dumpString :: Decoder Bool
dumpString = do
fmt <- asks pType
x <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
case x of
[cOMPOUND_TEXT,uTF8_STRING] -> case () of
() | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
| fmt == sTRING -> guardSize 8 $ do
vs <- gets value
modify (\r -> r {value = []})
let ss = flip unfoldr (map twiddle vs) $
\s -> if null s
then Nothing
else let (w,s'') = break (== '\NUL') s
s' = if null s''
then s''
else tail s''
in Just (w,s')
case ss of
[s] -> append $ show s
ss' -> let go (s:ss'') c = append c >>
append (show s) >>
go ss'' ","
go [] _ = append "]"
in append "[" >> go ss' ""
| fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :)
| otherwise -> (inX $ atomName fmt) >>=
failure . ("unrecognized string type " ++)
[cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
case () of
() | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
| fmt == sTRING -> guardSize 8 $ do
vs <- gets value
modify (\r -> r {value = []})
let ss = flip unfoldr (map twiddle vs) $
\s -> if null s
then Nothing
else let (w,s'') = break (== '\NUL') s
s' = if null s''
then s''
else tail s''
in Just (w,s')
case ss of
[s] -> append $ show s
ss' -> let go (s:ss'') c = append c >>
append (show s) >>
go ss'' ","
go [] _ = append "]"
in append "[" >> go ss' ""
| fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :)
| otherwise -> (inX $ atomName fmt) >>=
failure . ("unrecognized string type " ++)
-- show who owns a selection
dumpSelection :: Decoder Bool
@@ -919,7 +917,7 @@ dumpExcept xs item = do
let w = (length (value sp) - length vs) * 8
-- now we get to reparse again so we get our copy of it
put sp
v <- fmap fromJust (getInt' w)
Just v <- getInt' w
-- and after all that, we can process the exception list
dumpExcept' xs that v
@@ -1178,23 +1176,20 @@ getInt w f = getInt' w >>= maybe (return False) (append . f)
-- @@@@@@@@@ evil beyond evil. there *has* to be a better way
inhale :: Int -> Decoder Integer
inhale 8 = do
x <- eat 1
case x of
[b] -> return $ fromIntegral b
[b] <- eat 1
return $ fromIntegral b
inhale 16 = do
x <- eat 2
case x of
[b0,b1] -> io $ allocaArray 2 $ \p -> do
pokeArray p [b0,b1]
[v] <- peekArray 1 (castPtr p :: Ptr Word16)
return $ fromIntegral v
[b0,b1] <- eat 2
io $ allocaArray 2 $ \p -> do
pokeArray p [b0,b1]
[v] <- peekArray 1 (castPtr p :: Ptr Word16)
return $ fromIntegral v
inhale 32 = do
x <- eat 4
case x of
[b0,b1,b2,b3] -> io $ allocaArray 4 $ \p -> do
pokeArray p [b0,b1,b2,b3]
[v] <- peekArray 1 (castPtr p :: Ptr Word32)
return $ fromIntegral v
[b0,b1,b2,b3] <- eat 4
io $ allocaArray 4 $ \p -> do
pokeArray p [b0,b1,b2,b3]
[v] <- peekArray 1 (castPtr p :: Ptr Word32)
return $ fromIntegral v
inhale b = error $ "inhale " ++ show b
eat :: Int -> Decoder Raw

72
XMonad/Hooks/DynamicLog.hs
View File

@@ -24,7 +24,6 @@ module XMonad.Hooks.DynamicLog (
-- * Drop-in loggers
dzen,
dzenWithFlags,
xmobar,
statusBar,
dynamicLog,
@@ -43,8 +42,8 @@ module XMonad.Hooks.DynamicLog (
-- * Formatting utilities
wrap, pad, trim, shorten,
xmobarColor, xmobarAction, xmobarRaw,
xmobarStrip, xmobarStripTags,
xmobarColor, xmobarStrip,
xmobarStripTags,
dzenColor, dzenEscape, dzenStrip,
-- * Internal formatting functions
@@ -62,7 +61,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, fromMaybe )
import Data.Maybe ( isJust, catMaybes, mapMaybe )
import Data.Ord ( comparing )
import qualified Data.Map as M
import qualified XMonad.StackSet as S
@@ -151,32 +150,6 @@ import XMonad.Hooks.ManageDocks
------------------------------------------------------------------------
-- | Run xmonad with a dzen status bar with specified dzen
-- command line arguments.
--
-- > main = xmonad =<< dzenWithFlags flags myConfig
-- >
-- > myConfig = def { ... }
-- >
-- > flags = "-e onstart lower -w 800 -h 24 -ta l -fg #a8a3f7 -bg #3f3c6d"
--
-- This function can be used to customize the arguments passed to dzen2.
-- e.g changing the default width and height of dzen2.
--
-- If you wish to customize the status bar format at all, you'll have to
-- use the 'statusBar' function instead.
--
-- The binding uses the XMonad.Hooks.ManageDocks module to automatically
-- handle screen placement for dzen, and enables 'mod-b' for toggling
-- the menu bar.
--
-- You should use this function only when the default 'dzen' function does not
-- serve your purpose.
--
dzenWithFlags :: LayoutClass l Window
=> String -> XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
dzenWithFlags flags conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf
-- | Run xmonad with a dzen status bar set to some nice defaults.
--
-- > main = xmonad =<< dzen myConfig
@@ -186,14 +159,16 @@ dzenWithFlags flags conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey
-- The intent is that the above config file should provide a nice
-- status bar with minimal effort.
--
-- If you wish to customize the status bar format at all, you'll have to
-- use the 'statusBar' function instead.
--
-- The binding uses the XMonad.Hooks.ManageDocks module to automatically
-- handle screen placement for dzen, and enables 'mod-b' for toggling
-- the menu bar. Please refer to 'dzenWithFlags' function for further
-- documentation.
-- the menu bar.
--
dzen :: LayoutClass l Window
=> XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
dzen conf = dzenWithFlags flags conf
dzen conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf
where
fg = "'#a8a3f7'" -- n.b quoting
bg = "'#3f3c6d'"
@@ -320,8 +295,7 @@ 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 && isJust (S.stack w) = ppVisible
| S.tag w `elem` visibles = liftM2 fromMaybe ppVisible ppVisibleNoWindows
| S.tag w `elem` visibles = ppVisible
| isJust (S.stack w) = ppHidden
| otherwise = ppHiddenNoWindows
@@ -418,31 +392,6 @@ 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
@@ -486,8 +435,6 @@ 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
@@ -540,7 +487,6 @@ instance Default PP where
, ppVisible = wrap "<" ">"
, ppHidden = id
, ppHiddenNoWindows = const ""
, ppVisibleNoWindows= Nothing
, ppUrgent = id
, ppSep = " : "
, ppWsSep = " "

4
XMonad/Hooks/DynamicProperty.hs
View File

@@ -58,8 +58,8 @@ dynamicPropertyChange prop hook PropertyEvent { ev_window = w, ev_atom = a, ev_p
when (ps == propertyNewValue && a == pa) $ do
g <- appEndo <$> userCodeDef (Endo id) (runQuery hook w)
windows g
return mempty -- so anything else also processes it
dynamicPropertyChange _ _ _ = return mempty
return (All False) -- so anything else also processes it
dynamicPropertyChange _ _ _ = return (All False)
-- | A shorthand for the most common case, dynamic titles
dynamicTitle :: ManageHook -> Event -> X All

27
XMonad/Hooks/EwmhDesktops.hs
View File

@@ -25,7 +25,6 @@ module XMonad.Hooks.EwmhDesktops (
) where
import Codec.Binary.UTF8.String (encode)
import Control.Applicative((<$>))
import Data.List
import Data.Maybe
import Data.Monoid
@@ -88,19 +87,29 @@ ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
let wins = nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws
setClientList wins
-- Remap the current workspace to handle any renames that f might be doing.
let maybeCurrent' = W.tag <$> listToMaybe (f [W.workspace $ W.current s])
maybeCurrent = join (flip elemIndex (map W.tag ws) <$> maybeCurrent')
-- Current desktop
case (elemIndex (W.currentTag s) $ map W.tag ws) of
Nothing -> return ()
Just curr -> do
setCurrentDesktop curr
fromMaybe (return ()) $ setCurrentDesktop <$> maybeCurrent
-- Per window Desktop
-- To make gnome-panel accept our xinerama stuff, we display
-- all visible windows on the current desktop.
forM_ (W.current s : W.visible s) $ \x ->
forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do
setWindowDesktop win curr
sequence_ $ zipWith setWorkspaceWindowDesktops [0..] ws
forM_ (W.hidden s) $ \w ->
case elemIndex (W.tag w) (map W.tag ws) of
Nothing -> return ()
Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do
setWindowDesktop win wn
setActiveWindow
return ()
-- |
-- Intercepts messages from pagers and similar applications and reacts on them.
-- Currently supports:
@@ -221,10 +230,6 @@ setClientList wins = withDisplay $ \dpy -> do
a' <- getAtom "_NET_CLIENT_LIST_STACKING"
io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins)
setWorkspaceWindowDesktops :: (Integral a) => a -> WindowSpace -> X()
setWorkspaceWindowDesktops index workspace =
mapM_ (flip setWindowDesktop index) (W.integrate' $ W.stack workspace)
setWindowDesktop :: (Integral a) => Window -> a -> X ()
setWindowDesktop win i = withDisplay $ \dpy -> do
a <- getAtom "_NET_WM_DESKTOP"

6
XMonad/Hooks/FadeWindows.hs
View File

@@ -61,8 +61,7 @@ import Control.Monad.Reader (ask
,asks)
import Control.Monad.State (gets)
import qualified Data.Map as M
import Data.Monoid hiding ((<>))
import Data.Semigroup
import Data.Monoid
import Graphics.X11.Xlib.Extras (Event(..))
@@ -135,9 +134,6 @@ instance Monoid Opacity where
r `mappend` OEmpty = r
_ `mappend` r = r
instance Semigroup Opacity where
(<>) = mappend
-- | A FadeHook is similar to a ManageHook, but records window opacity.
type FadeHook = Query Opacity

23
XMonad/Hooks/ManageDocks.hs
View File

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

6
XMonad/Hooks/Minimize.hs
View File

@@ -23,7 +23,7 @@ import Data.Monoid
import Control.Monad(when)
import XMonad
import XMonad.Actions.Minimize
import XMonad.Layout.Minimize
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -43,10 +43,10 @@ minimizeEventHook (ClientMessageEvent {ev_window = w,
a_aw <- getAtom "_NET_ACTIVE_WINDOW"
a_cs <- getAtom "WM_CHANGE_STATE"
when (mt == a_aw) $ maximizeWindow w
when (mt == a_aw) $ sendMessage (RestoreMinimizedWin w)
when (mt == a_cs) $ do
let message = fromIntegral . head $ dt
when (message == normalState) $ maximizeWindow w
when (message == normalState) $ sendMessage (RestoreMinimizedWin w)
when (message == iconicState) $ minimizeWindow w
return (All True)

12
XMonad/Hooks/RestoreMinimized.hs
View File

@@ -1,4 +1,4 @@
-----------------------------------------------------------------------------
----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.RestoreMinimized
-- Copyright : (c) Jan Vornberger 2009
@@ -15,7 +15,6 @@
-----------------------------------------------------------------------------
module XMonad.Hooks.RestoreMinimized
{-# DEPRECATED "Use XMonad.Hooks.Minimize instead, this module has no effect" #-}
( -- * Usage
-- $usage
RestoreMinimized (..)
@@ -23,8 +22,10 @@ module XMonad.Hooks.RestoreMinimized
) where
import Data.Monoid
import Control.Monad(when)
import XMonad
import XMonad.Layout.Minimize
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -38,4 +39,11 @@ import XMonad
data RestoreMinimized = RestoreMinimized deriving ( Show, Read )
restoreMinimizedEventHook :: Event -> X All
restoreMinimizedEventHook (ClientMessageEvent {ev_window = w,
ev_message_type = mt}) = do
a_aw <- getAtom "_NET_ACTIVE_WINDOW"
a_cs <- getAtom "WM_CHANGE_STATE"
when (mt == a_aw || mt == a_cs) $ do
sendMessage (RestoreMinimizedWin w)
return (All True)
restoreMinimizedEventHook _ = return (All True)

17
XMonad/Hooks/UrgencyHook.hs
View File

@@ -339,7 +339,7 @@ getNetWMState :: Window -> X [CLong]
getNetWMState w = do
a_wmstate <- getAtom "_NET_WM_STATE"
fromMaybe [] `fmap` getProp32 a_wmstate w
-- The Non-ICCCM Manifesto:
-- Note: Some non-standard choices have been made in this implementation to
@@ -497,14 +497,14 @@ data BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: !String }
instance UrgencyHook BorderUrgencyHook where
urgencyHook BorderUrgencyHook { urgencyBorderColor = cs } w =
withDisplay $ \dpy -> do
c' <- io (initColor dpy cs)
withDisplay $ \dpy -> io $ do
c' <- initColor dpy cs
case c' of
Just c -> setWindowBorderWithFallback dpy w cs c
_ -> io $ hPutStrLn stderr $ concat ["Warning: bad urgentBorderColor "
,show cs
," in BorderUrgencyHook"
]
Just c -> setWindowBorder dpy w c
_ -> hPutStrLn stderr $ concat ["Warning: bad urgentBorderColor "
,show cs
," in BorderUrgencyHook"
]
-- | Flashes when a window requests your attention and you can't see it.
-- Defaults to a duration of five seconds, and no extra args to dzen.
@@ -543,3 +543,4 @@ filterUrgencyHook skips w = do
Just tag -> when (tag `elem` skips)
$ adjustUrgents (delete w)
_ -> return ()

6
XMonad/Hooks/WallpaperSetter.hs
View File

@@ -41,8 +41,7 @@ import Data.Ord (comparing)
import Control.Monad
import Control.Applicative
import Data.Maybe
import Data.Monoid hiding ((<>))
import Data.Semigroup
import Data.Monoid
-- $usage
-- This module requires imagemagick and feh to be installed, as these are utilized
@@ -87,9 +86,6 @@ instance Monoid WallpaperList where
mappend (WallpaperList w1) (WallpaperList w2) =
WallpaperList $ M.toList $ (M.fromList w2) `M.union` (M.fromList w1)
instance Semigroup WallpaperList where
(<>) = mappend
-- | Complete wallpaper configuration passed to the hook
data WallpaperConf = WallpaperConf {
wallpaperBaseDir :: FilePath -- ^ Where the wallpapers reside (if empty, will look in \~\/.wallpapers/)

69
XMonad/Hooks/WorkspaceHistory.hs
View File

@@ -14,25 +14,20 @@
--
-----------------------------------------------------------------------------
module XMonad.Hooks.WorkspaceHistory (
-- * Usage
module XMonad.Hooks.WorkspaceHistory
( -- * Usage
-- $usage
-- * Hooking
workspaceHistoryHook
-- * Querying
, workspaceHistory
, workspaceHistoryByScreen
, workspaceHistoryWithScreen
-- * Handling edits
, workspaceHistoryTransaction
) where
import Control.Applicative
import Prelude
-- * Hooking
workspaceHistoryHook
-- * Querying
, workspaceHistory
) where
import XMonad
import XMonad.StackSet hiding (filter, delete)
import Data.List
import XMonad.StackSet (currentTag)
import qualified XMonad.Util.ExtensibleState as XS
-- $usage
@@ -51,10 +46,10 @@ import qualified XMonad.Util.ExtensibleState as XS
--
-- To make use of the collected data, a query function is provided.
data WorkspaceHistory = WorkspaceHistory
{ history :: [(ScreenId, WorkspaceId)] -- ^ Workspace Screens in
-- reverse-chronological order.
} deriving (Typeable, Read, Show)
data WorkspaceHistory =
WorkspaceHistory { history :: [WorkspaceId] -- ^ Workspaces in reverse-chronological order.
}
deriving (Typeable, Read, Show)
instance ExtensionClass WorkspaceHistory where
initialValue = WorkspaceHistory []
@@ -63,41 +58,17 @@ instance ExtensionClass WorkspaceHistory where
-- | A 'logHook' that keeps track of the order in which workspaces have
-- been viewed.
workspaceHistoryHook :: X ()
workspaceHistoryHook = gets windowset >>= (XS.modify . updateLastActiveOnEachScreen)
workspaceHistoryWithScreen :: X [(ScreenId, WorkspaceId)]
workspaceHistoryWithScreen = XS.gets history
workspaceHistoryByScreen :: X [(ScreenId, [WorkspaceId])]
workspaceHistoryByScreen =
map (\wss -> (fst $ head wss, map snd wss)) .
groupBy (\a b -> fst a == fst b) .
sortBy (\a b -> compare (fst a) $ fst b)<$>
workspaceHistoryWithScreen
workspaceHistoryHook = gets (currentTag . windowset) >>= (XS.modify . makeFirst)
-- | A list of workspace tags in the order they have been viewed, with the
-- most recent first. No duplicates are present, but not all workspaces are
-- guaranteed to appear, and there may be workspaces that no longer exist.
workspaceHistory :: X [WorkspaceId]
workspaceHistory = nub . map snd <$> XS.gets history
workspaceHistory = XS.gets history
workspaceHistoryTransaction :: X () -> X ()
workspaceHistoryTransaction action = do
startingHistory <- XS.gets history
action
new <- (flip updateLastActiveOnEachScreen $ WorkspaceHistory startingHistory) <$> gets windowset
XS.put new
-- | Update the last visible workspace on each monitor if needed
-- | Cons the 'WorkspaceId' onto the 'WorkspaceHistory' if it is not
-- already there, or move it to the front if it is.
updateLastActiveOnEachScreen :: WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreen StackSet {current = cur, visible = vis} wh =
WorkspaceHistory { history = doUpdate cur $ foldl updateLastForScreen (history wh) $ vis ++ [cur] }
where
firstOnScreen sid = find ((== sid) . fst)
doUpdate Screen {workspace = Workspace { tag = wid }, screen = sid} curr =
let newEntry = (sid, wid) in newEntry:delete newEntry curr
updateLastForScreen curr Screen {workspace = Workspace { tag = wid }, screen = sid} =
let newEntry = (sid, wid)
alreadyCurrent = maybe False (== newEntry) $ firstOnScreen sid curr
in if alreadyCurrent then curr else newEntry:delete newEntry curr
makeFirst :: WorkspaceId -> WorkspaceHistory -> WorkspaceHistory
makeFirst w v = let (xs, ys) = break (w ==) $ history v
in v { history = w : (xs ++ drop 1 ys) }

139
XMonad/Layout/BinaryColumn.hs
View File

@@ -1,139 +0,0 @@
{-# 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)

1
XMonad/Layout/BinarySpacePartition.hs
View File

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

12
XMonad/Layout/ComboP.hs
View File

@@ -20,7 +20,6 @@ module XMonad.Layout.ComboP (
combineTwoP,
CombineTwoP,
SwapWindow(..),
PartitionWins(..),
Property(..)
) where
@@ -72,16 +71,6 @@ data SwapWindow = SwapWindow -- ^ Swap window between panes
deriving (Read, Show, Typeable)
instance Message SwapWindow
data PartitionWins = PartitionWins -- ^ Reset the layout and
-- partition all windows into the
-- correct sub-layout. Useful for
-- when window properties have
-- changed and you want ComboP to
-- update which layout a window
-- belongs to.
deriving (Read, Show, Typeable)
instance Message PartitionWins
data CombineTwoP l l1 l2 a = C2P [a] [a] [a] l (l1 a) (l2 a) Property
deriving (Read, Show)
@@ -111,7 +100,6 @@ instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) =>
(maybe l1 id ml1') (maybe l2 id ml2') prop)
handleMessage us@(C2P f ws1 ws2 super l1 l2 prop) m
| Just PartitionWins <- fromMessage m = return . Just $ C2P [] [] [] super l1 l2 prop
| Just SwapWindow <- fromMessage m = swap us
| Just (SwapWindowN 0) <- fromMessage m = swap us
| Just (SwapWindowN n) <- fromMessage m = forwardToFocused us $ SomeMessage $ SwapWindowN $ n-1

2
XMonad/Layout/DecorationAddons.hs
View File

@@ -24,7 +24,7 @@ import XMonad
import qualified XMonad.StackSet as W
import XMonad.Layout.Decoration
import XMonad.Actions.WindowMenu
import XMonad.Actions.Minimize
import XMonad.Layout.Minimize
import XMonad.Layout.Maximize
import XMonad.Hooks.ManageDocks
import XMonad.Util.Font

38
XMonad/Layout/Fullscreen.hs
View File

@@ -30,19 +30,17 @@ module XMonad.Layout.Fullscreen
,FullscreenFloat, FullscreenFocus, FullscreenFull
) where
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Hooks.ManageHelpers (isFullscreen)
import XMonad.Util.WindowProperties
import qualified XMonad.Util.Rectangle as R
import qualified XMonad.StackSet as W
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.Map as M
import Control.Monad
import Control.Arrow (second)
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Util.WindowProperties
import XMonad.Hooks.ManageHelpers (isFullscreen)
import qualified XMonad.StackSet as W
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.Map as M
import Control.Monad
import Control.Arrow (second)
-- $usage
-- Provides a ManageHook and an EventHook that sends layout messages
@@ -109,12 +107,9 @@ instance LayoutModifier FullscreenFull Window where
_ -> Nothing
pureModifier (FullscreenFull frect fulls) rect _ list =
(visfulls' ++ rest', Nothing)
where (visfulls,rest) = partition (flip elem fulls . fst) list
visfulls' = map (second $ const rect') visfulls
rest' = if null visfulls'
then rest
else filter (not . R.supersetOf rect' . snd) rest
(map (flip (,) rect') visfulls ++ rest, Nothing)
where visfulls = intersect fulls $ map fst list
rest = filter (flip notElem visfulls . fst) list
rect' = scaleRationalRect rect frect
instance LayoutModifier FullscreenFocus Window where
@@ -127,7 +122,7 @@ instance LayoutModifier FullscreenFocus Window where
pureModifier (FullscreenFocus frect fulls) rect (Just (W.Stack {W.focus = f})) list
| f `elem` fulls = ((f, rect') : rest, Nothing)
| otherwise = (list, Nothing)
where rest = filter (not . orP (== f) (R.supersetOf rect')) list
where rest = filter ((/= f) . fst) list
rect' = scaleRationalRect rect frect
pureModifier _ _ Nothing list = (list, Nothing)
@@ -245,6 +240,3 @@ fullscreenManageHook' isFull = isFull --> do
sendMessageWithNoRefresh FullscreenChanged cw
idHook
-- | Applies a pair of predicates to a pair of operands, combining them with ||.
orP :: (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
orP f g (x, y) = f x || g y

72
XMonad/Layout/Gaps.hs
View File

@@ -14,9 +14,7 @@
-- be used for tiling, along with support for toggling gaps on and
-- off.
--
-- Note 1: For gaps\/space around /windows/ see "XMonad.Layout.Spacing".
--
-- Note 2: "XMonad.Hooks.ManageDocks" is the preferred solution for
-- Note that "XMonad.Hooks.ManageDocks" is the preferred solution for
-- leaving space for your dock-type applications (status bars,
-- toolbars, docks, etc.), since it automatically sets up appropriate
-- gaps, allows them to be toggled, etc. However, this module may
@@ -31,8 +29,8 @@ module XMonad.Layout.Gaps (
-- * Usage
-- $usage
Direction2D(..), Gaps,
GapSpec, gaps, gaps', GapMessage(..),
weakModifyGaps, modifyGap, setGaps, setGap
GapSpec, gaps, gaps', GapMessage(..)
) where
import XMonad.Core
@@ -57,23 +55,10 @@ import Data.List (delete)
-- You can additionally add some keybindings to toggle or modify the gaps,
-- for example:
--
-- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps) -- toggle all gaps
-- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap
-- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap 5 R) -- increment the right-hand gap
-- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap 5 R) -- decrement the right-hand gap
-- > , ((modm .|. controlMask, xK_r), sendMessage $ ModifyGaps rotateGaps) -- rotate gaps 90 degrees clockwise
-- > , ((modm .|. controlMask, xK_h), sendMessage $ weakModifyGaps halveHor) -- halve the left and right-hand gaps
-- > , ((modm .|. controlMask, xK_d), sendMessage $ modifyGap (*2) L) -- double the left-hand gap
-- > , ((modm .|. controlMask, xK_s), sendMessage $ setGaps [(U,18), (R,23)]) -- reset the GapSpec
-- > , ((modm .|. controlMask, xK_b), sendMessage $ setGap 30 D) -- set the bottom gap to 30
-- > ]
-- > where rotateGaps gs = zip (map (rotate . fst) gs) (map snd gs)
-- > rotate U = R
-- > rotate R = D
-- > rotate D = L
-- > rotate L = U
-- > halveHor d i | d `elem` [L, R] = i `div` 2
-- > | otherwise = i
-- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps) -- toggle all gaps
-- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap
-- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap 5 R) -- increment the right-hand gap
-- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap 5 R) -- decrement the right-hand gap
--
-- If you want complete control over all gaps, you could include
-- something like this in your keybindings, assuming in this case you
@@ -108,7 +93,6 @@ data GapMessage = ToggleGaps -- ^ Toggle all gaps.
| ToggleGap !Direction2D -- ^ Toggle a single gap.
| IncGap !Int !Direction2D -- ^ Increase a gap by a certain number of pixels.
| DecGap !Int !Direction2D -- ^ Decrease a gap.
| ModifyGaps (GapSpec -> GapSpec) -- ^ Modify arbitrarily.
deriving (Typeable)
instance Message GapMessage
@@ -122,46 +106,11 @@ instance LayoutModifier Gaps a where
| Just (ToggleGap d) <- fromMessage m
= Just $ Gaps conf (toggleGap conf cur d)
| Just (IncGap i d) <- fromMessage m
= Just $ Gaps (limit . continuation (+ i ) d $ conf) cur
= Just $ Gaps (incGap conf d i) cur
| Just (DecGap i d) <- fromMessage m
= Just $ Gaps (limit . continuation (+(-i)) d $ conf) cur
| Just (ModifyGaps f) <- fromMessage m
= Just $ Gaps (limit . f $ conf) cur
= Just $ Gaps (incGap conf d (-i)) cur
| otherwise = Nothing
-- | Modifies gaps weakly, for convenience.
weakModifyGaps :: (Direction2D -> Int -> Int) -> GapMessage
weakModifyGaps = ModifyGaps . weakToStrong
-- | Arbitrarily modify a single gap with the given function.
modifyGap :: (Int -> Int) -> Direction2D -> GapMessage
modifyGap f d = ModifyGaps $ continuation f d
-- | Set the GapSpec.
setGaps :: GapSpec -> GapMessage
setGaps = ModifyGaps . const
-- | Set a gap to the given value.
setGap :: Int -> Direction2D -> GapMessage
setGap = modifyGap . const
-- | Imposes limits upon a GapSpec, ensuring gaps are at least 0. Not exposed.
limit :: GapSpec -> GapSpec
limit = weakToStrong $ \_ -> max 0
-- | Takes a weak gaps-modifying function f and returns a GapSpec modifying
-- function. Not exposed.
weakToStrong :: (Direction2D -> Int -> Int) -> GapSpec -> GapSpec
weakToStrong f gs = zip (map fst gs) (map (uncurry f) gs)
-- | Given f as a definition for the behaviour of a gaps modifying function in
-- one direction d, produces a continuation of the function to the other
-- directions using the identity. Not exposed.
continuation :: (Int -> Int) -> Direction2D -> GapSpec -> GapSpec
continuation f d1 = weakToStrong h
where h d2 | d2 == d1 = f
| otherwise = id
applyGaps :: Gaps a -> Rectangle -> Rectangle
applyGaps gs r = foldr applyGap r (activeGaps gs)
where
@@ -182,6 +131,9 @@ toggleGap conf cur d | d `elem` cur = delete d cur
| d `elem` (map fst conf) = d:cur
| otherwise = cur
incGap :: GapSpec -> Direction2D -> Int -> GapSpec
incGap gs d i = map (\(dir,j) -> if dir == d then (dir,max (j+i) 0) else (dir,j)) gs
-- | Add togglable manual gaps to a layout.
gaps :: GapSpec -- ^ The gaps to allow, paired with their initial sizes.
-> l a -- ^ The layout to modify.

2
XMonad/Layout/Grid.hs
View File

@@ -56,7 +56,7 @@ arrange :: Double -> Rectangle -> [a] -> [(a, Rectangle)]
arrange aspectRatio (Rectangle rx ry rw rh) st = zip st rectangles
where
nwins = length st
ncols = max 1 . min nwins . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh * aspectRatio)
ncols = max 1 . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh * aspectRatio)
mincs = max 1 $ nwins `div` ncols
extrs = nwins - ncols * mincs
chop :: Int -> Dimension -> [(Position, Dimension)]

92
XMonad/Layout/Groups.hs
View File

@@ -1,6 +1,6 @@
{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-}
{-# LANGUAGE StandaloneDeriving, FlexibleContexts, DeriveDataTypeable
, UndecidableInstances, FlexibleInstances, LambdaCase, MultiParamTypeClasses
, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses
, PatternGuards, Rank2Types, TypeSynonymInstances #-}
-----------------------------------------------------------------------------
@@ -25,7 +25,6 @@ module XMonad.Layout.Groups ( -- * Usage
-- * Messages
, GroupsMessage(..)
, ModifySpec
, ModifySpecX
-- ** Useful 'ModifySpec's
, swapUp
, swapDown
@@ -61,8 +60,8 @@ import XMonad.Util.Stack
import Data.Maybe (isJust, isNothing, fromMaybe, catMaybes, fromJust)
import Data.List ((\\))
import Control.Arrow ((>>>))
import Control.Applicative ((<$>),(<|>),(<$))
import Control.Monad (forM,void)
import Control.Applicative ((<$>))
import Control.Monad (forM)
-- $usage
-- This module provides a layout combinator that allows you
@@ -100,6 +99,7 @@ group :: l Window -> l2 (Group l Window) -> Groups l l2 Window
group l l2 = Groups l l2 startingGroups (U 1 0)
where startingGroups = fromJust $ singletonZ $ G (ID (U 0 0) l) emptyZ
-- * Stuff with unique keys
data Uniq = U Integer Integer
@@ -187,7 +187,6 @@ data GroupsMessage = ToEnclosing SomeMessage -- ^ Send a message to the enclosin
-- to the layout.
| Modify ModifySpec -- ^ Modify the ordering\/grouping\/focusing
-- of windows according to a 'ModifySpec'
| ModifyX ModifySpecX -- ^ Same as 'Modify', but within the 'X' monad
deriving Typeable
instance Show GroupsMessage where
@@ -207,13 +206,6 @@ modifyGroups f g = let (seed', id:_) = gen (seed g)
in g { groups = fromMaybe defaultGroups . f . Just $ groups g
, seed = seed' }
modifyGroupsX :: (Zipper (Group l a) -> X (Zipper (Group l a)))
-> Groups l l2 a -> X (Groups l l2 a)
modifyGroupsX f g = do
let (seed', id:_) = gen (seed g)
defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ
g' <- f . Just $ groups g
return g { groups = fromMaybe defaultGroups g', seed = seed' }
-- ** Readaptation
@@ -311,12 +303,9 @@ instance (LayoutClass l Window, LayoutClass l2 (Group l Window))
Just (ToGroup i sm') -> do mg's <- handleOnIndex i sm' z
return $ maybeMakeNew l Nothing mg's
Just (Modify spec) -> case applySpec spec l of
Just l' -> refocus l'
Nothing -> return Nothing
Just (ModifyX spec) -> do ml' <- applySpecX spec l
whenJust ml' (void . refocus)
return (ml' <|> Just l)
Just Refocus -> refocus l
Just l' -> refocus l' >> return (Just l')
Nothing -> return $ Just l
Just Refocus -> refocus l >> return (Just l)
Just _ -> return Nothing
Nothing -> handleMessage l $ SomeMessage (ToFocused sm)
where handleOnFocused sm z = mapZM step $ Just z
@@ -343,10 +332,10 @@ maybeMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)]
maybeMakeNew _ Nothing ml's | all isNothing ml's = Nothing
maybeMakeNew g mpart' ml's = justMakeNew g mpart' ml's
refocus :: Groups l l2 Window -> X (Maybe (Groups l l2 Window))
refocus g =
let mw = (getFocusZ . gZipper . W.focus . groups) g
in g <$ mw <$ whenJust mw (modifyWindowSet . W.focusWindow)
refocus :: Groups l l2 Window -> X ()
refocus g = case getFocusZ $ gZipper $ W.focus $ groups g
of Just w -> focus w
Nothing -> return ()
-- ** ModifySpec type
@@ -372,50 +361,29 @@ type ModifySpec = forall l. WithID l Window
-> Zipper (Group l Window)
-> Zipper (Group l Window)
-- ** ModifierSpecX type
-- | This is the same as 'ModifySpec', but it allows the function to use
-- actions inside the 'X' monad. This is useful, for example, if the function
-- has to make decisions based on the results of a 'runQuery'.
type ModifySpecX = forall l. WithID l Window
-> Zipper (Group l Window)
-> X (Zipper (Group l Window))
-- | Apply a ModifySpec.
applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)
applySpec f g =
let (seed', id:ids) = gen $ seed g
g' = flip modifyGroups g $ f (ID id $ baseLayout g)
>>> toTags
>>> foldr (reID g) ((ids, []), [])
>>> snd
>>> fromTags
in case groups g == groups g' of
True -> Nothing
False -> Just g' { seed = seed' }
applySpec f g = let (seed', id:ids) = gen $ seed g
g' = flip modifyGroups g $ f (ID id $ baseLayout g)
>>> toTags
>>> foldr reID ((ids, []), [])
>>> snd
>>> fromTags
in case groups g == groups g' of
True -> Nothing
False -> Just g' { seed = seed' }
where reID eg ((id:ids, seen), egs)
= let myID = getID $ gLayout $ fromE eg
in case elem myID seen of
False -> ((id:ids, myID:seen), eg:egs)
True -> ((ids, seen), mapE_ (setID id) eg:egs)
where setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z
reID _ (([], _), _) = undefined -- The list of ids is infinite
applySpecX :: ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window))
applySpecX f g = do
let (seed', id:ids) = gen $ seed g
g' <- flip modifyGroupsX g $ f (ID id $ baseLayout g)
>>> fmap toTags
>>> fmap (foldr (reID g) ((ids, []), []))
>>> fmap snd
>>> fmap fromTags
return $ case groups g == groups g' of
True -> Nothing
False -> Just g' { seed = seed' }
reID :: Groups l l2 Window
-> Either (Group l Window) (Group l Window)
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
reID _ _ (([], _), _) = undefined -- The list of ids is infinite
reID g eg ((id:ids, seen), egs) = case elem myID seen of
False -> ((id:ids, myID:seen), eg:egs)
True -> ((ids, seen), mapE_ (setID id) eg:egs)
where myID = getID $ gLayout $ fromE eg
setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z
-- ** Misc. ModifySpecs

8
XMonad/Layout/Groups/Helpers.hs
View File

@@ -1,5 +1,5 @@
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-}
{-# LANGUAGE MultiParamTypeClasses, Rank2Types, ImpredicativeTypes #-}
-----------------------------------------------------------------------------
-- |
@@ -45,7 +45,7 @@ import qualified XMonad.StackSet as W
import qualified XMonad.Layout.Groups as G
import XMonad.Actions.MessageFeedback (sendMessageB)
import XMonad.Actions.MessageFeedback
import Control.Monad (unless)
import qualified Data.Map as M
@@ -92,7 +92,7 @@ alt :: G.ModifySpec -> (WindowSet -> WindowSet) -> X ()
alt f g = alt2 (G.Modify f) $ windows g
alt2 :: G.GroupsMessage -> X () -> X ()
alt2 m x = do b <- sendMessageB m
alt2 m x = do b <- send m
unless b x
-- | Swap the focused window with the previous one
@@ -178,7 +178,7 @@ focusFloatDown = focusHelper id id
-- ** Groups-specific actions
wrap :: G.ModifySpec -> X ()
wrap x = sendMessage (G.Modify x)
wrap = sendMessage . G.Modify
-- | Swap the focused group with the previous one
swapGroupUp :: X ()

5
XMonad/Layout/Hidden.hs
View File

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

2
XMonad/Layout/ImageButtonDecoration.hs
View File

@@ -38,7 +38,7 @@ import XMonad.Layout.DecorationAddons
import XMonad.Util.Image
import XMonad.Actions.WindowMenu
import XMonad.Actions.Minimize
import XMonad.Layout.Minimize
import XMonad.Layout.Maximize
-- $usage

6
XMonad/Layout/LayoutHints.hs
View File

@@ -44,7 +44,6 @@ import Data.Monoid(All(..))
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Maybe(fromJust)
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -148,15 +147,10 @@ instance LayoutModifier LayoutHintsToCenter Window where
modifyLayout _ ws@(W.Workspace _ _ (Just st)) r = do
(arrs,ol) <- runLayout ws r
flip (,) ol
. changeOrder (W.focus st : (filter (/= W.focus st) $ map fst arrs))
. head . reverse . sortBy (compare `on` (fitting . map snd))
. map (applyHints st r) . applyOrder r
<$> mapM (\x -> fmap ((,) x) $ mkAdjust (fst x)) arrs
changeOrder :: [Window] -> [(Window, Rectangle)] -> [(Window, Rectangle)]
changeOrder w wr = zip w' $ map (fromJust . flip lookup wr) w'
where w' = filter (`elem` map fst wr) w
-- apply hints to first, grow adjacent windows
applyHints :: W.Stack Window -> Rectangle -> [((Window, Rectangle),(D -> D))] -> [(Window, Rectangle)]
applyHints _ _ [] = []

54
XMonad/Layout/Magnifier.hs
View File

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

96
XMonad/Layout/Minimize.hs
View File

@@ -1,4 +1,4 @@
{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards #-}
{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleContexts, PatternGuards #-}
----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.Minimize
@@ -18,14 +18,20 @@ module XMonad.Layout.Minimize (
-- * Usage
-- $usage
minimize,
minimizeWindow,
MinimizeMsg(RestoreMinimizedWin,RestoreNextMinimizedWin),
Minimize,
) where
import XMonad
import qualified XMonad.StackSet as W
import XMonad.Util.Minimize (Minimized(..))
import XMonad.Layout.LayoutModifier
import XMonad.Layout.BoringWindows as BW
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.WindowProperties (getProp32)
import Data.List
import qualified Data.Map as M
import Data.Maybe
import Foreign.C.Types (CLong)
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -41,33 +47,97 @@ import qualified XMonad.Util.ExtensibleState as XS
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
--
-- In the key-bindings, do something like:
--
-- > , ((modm, xK_m ), withFocused minimizeWindow)
-- > , ((modm .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin)
--
-- The first action will minimize the focused window, while the second one will restore
-- the next minimized window.
--
-- For detailed instruction on editing the key binding see:
--
-- "XMonad.Doc.Extending#Editing_key_bindings".
--
-- The module is designed to work together with "XMonad.Layout.BoringWindows" so
-- that minimized windows will be skipped over when switching the focused window with
-- the keyboard. Include 'BW.boringWindows' in your layout hook and see the
-- documentation of "XMonad.Layout.BoringWindows" on how to modify your keybindings.
--
-- See "XMonad.Actions.Minimize" for possible actions for minimizing/restoring windows
--
-- Also see "XMonad.Hooks.Minimize" if you want to be able to minimize
-- and restore windows from your taskbar.
data Minimize a = Minimize deriving ( Read, Show )
minimize :: l Window -> ModifiedLayout Minimize l Window
minimize = ModifiedLayout Minimize
data Minimize a = Minimize [Window] (M.Map Window W.RationalRect) deriving ( Read, Show )
minimize :: LayoutClass l Window => l Window -> ModifiedLayout Minimize l Window
minimize = ModifiedLayout $ Minimize [] M.empty
data MinimizeMsg = MinimizeWin Window
| RestoreMinimizedWin Window
| RestoreNextMinimizedWin
deriving (Typeable, Eq)
instance Message MinimizeMsg
minimizeWindow :: Window -> X ()
minimizeWindow w = sendMessage (MinimizeWin w) >> BW.focusDown
setMinimizedState :: Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X ()
setMinimizedState win st f = do
setWMState win st
withDisplay $ \dpy -> do
wm_state <- getAtom "_NET_WM_STATE"
mini <- getAtom "_NET_WM_STATE_HIDDEN"
wstate <- fromMaybe [] `fmap` getProp32 wm_state win
let ptype = 4 -- The atom property type for changeProperty
fi_mini = fromIntegral mini
io $ changeProperty32 dpy win wm_state ptype propModeReplace (f fi_mini wstate)
setMinimized :: Window -> X ()
setMinimized win = setMinimizedState win iconicState (:)
setNotMinimized :: Window -> X ()
setNotMinimized win = setMinimizedState win normalState delete
instance LayoutModifier Minimize Window where
modifierDescription _ = "Minimize"
modifyLayout Minimize wksp rect = do
minimized <- XS.gets minimizedStack
modifyLayout (Minimize minimized _) wksp rect = do
let stack = W.stack wksp
filtStack = stack >>= W.filter (`notElem` minimized)
filtStack = stack >>=W.filter (\w -> not (w `elem` minimized))
runLayout (wksp {W.stack = filtStack}) rect
handleMess Minimize m
handleMess (Minimize minimized unfloated) m
| Just (MinimizeWin w) <- fromMessage m, not (w `elem` minimized) = do
setMinimized w
ws <- gets windowset
case M.lookup w (W.floating ws) of
Nothing -> return $ Just $ Minimize (w:minimized) unfloated
Just r -> do
modify (\s -> s { windowset = W.sink w ws})
return $ Just $ Minimize (w:minimized) (M.insert w r unfloated)
| Just (RestoreMinimizedWin w) <- fromMessage m = do
setNotMinimized w
case M.lookup w unfloated of
Nothing -> return $ Just $ Minimize (minimized \\ [w]) unfloated
Just r -> do
ws <- gets windowset
modify (\s -> s { windowset = W.float w r ws})
return $ Just $ Minimize (minimized \\ [w]) (M.delete w unfloated)
| Just RestoreNextMinimizedWin <- fromMessage m = do
ws <- gets windowset
if not (null minimized)
then case M.lookup (head minimized) unfloated of
Nothing -> do
let w = head minimized
setNotMinimized w
modify (\s -> s { windowset = W.focusWindow w ws})
return $ Just $ Minimize (tail minimized) unfloated
Just r -> do
let w = head minimized
setNotMinimized w
modify (\s -> s { windowset = (W.focusWindow w . W.float w r) ws})
return $ Just $ Minimize (tail minimized) (M.delete w unfloated)
else return Nothing
| Just BW.UpdateBoring <- fromMessage m = do
minimized <- XS.gets minimizedStack
ws <- gets (W.workspace . W.current . windowset)
flip sendMessageWithNoRefresh ws $ BW.Replace "Minimize" minimized
return Nothing

6
XMonad/Layout/Mosaic.hs
View File

@@ -38,8 +38,7 @@ import Control.Monad(mplus)
import Data.Foldable(Foldable,foldMap, sum)
import Data.Function(on)
import Data.List(sortBy)
import Data.Monoid(Monoid,mempty, mappend, (<>))
import Data.Semigroup
import Data.Monoid(Monoid,mempty, mappend)
-- $usage
@@ -203,9 +202,6 @@ instance Monoid (Tree a) where
mappend x Empty = x
mappend x y = Branch x y
instance Semigroup (Tree a) where
(<>) = mappend
makeTree :: (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a
makeTree _ [] = Empty
makeTree _ [x] = Leaf x

10
XMonad/Layout/MultiColumns.hs
View File

@@ -77,9 +77,10 @@ data MultiCol a = MultiCol
} deriving (Show,Read,Eq)
instance LayoutClass MultiCol a where
doLayout l r s = return (combine s rlist, resl)
doLayout l r s = return (zip w rlist, resl)
where rlist = doL (multiColNWin l') (multiColSize l') r wlen
wlen = length $ W.integrate s
w = W.integrate s
wlen = length w
-- Make sure the list of columns is big enough and update active column
nw = multiColNWin l ++ repeat (multiColDefWin l)
l' = l { multiColNWin = take (max (length $ multiColNWin l) $ getCol (wlen-1) nw + 1) nw
@@ -89,7 +90,6 @@ instance LayoutClass MultiCol a where
resl = if l'==l
then Nothing
else Just l'
combine (W.Stack foc left right) rs = zip (foc : reverse left ++ right) $ raiseFocused (length left) rs
handleMessage l m =
return $ msum [fmap resize (fromMessage m)
,fmap incmastern (fromMessage m)]
@@ -104,10 +104,6 @@ instance LayoutClass MultiCol a where
a = multiColActive l
description _ = "MultiCol"
raiseFocused :: Int -> [a] -> [a]
raiseFocused n xs = actual ++ before ++ after
where (before,rest) = splitAt n xs
(actual,after) = splitAt 1 rest
-- | Get which column a window is in, starting at 0.
getCol :: Int -> [Int] -> Int

92
XMonad/Layout/MultiDishes.hs
View File

@@ -1,92 +0,0 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.MultiDishes
-- Copyright : (c) Jeremy Apthorp, Nathan Fairhurst
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Nathan Fairhurst <nathan.p3pictures@gmail.com>
-- Stability : unstable
-- Portability : portable
--
-- MultiDishes is a layout that stacks groups of extra windows underneath
-- the master windows.
--
-----------------------------------------------------------------------------
module XMonad.Layout.MultiDishes (
-- * Usage
-- $usage
MultiDishes (..)
) where
import XMonad
import XMonad.StackSet (integrate)
import Control.Monad (ap)
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.MultiDishes
--
-- Then edit your @layoutHook@ by adding the MultiDishes layout:
--
-- > myLayout = MultiDishes 2 3 (1/6) ||| Full ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- This is based on the Layout Dishes, but accepts another parameter for
-- the maximum number of dishes allowed within a stack.
--
-- > MultiDishes x 1 y
-- is equivalent to
-- > Dishes x y
--
-- The stack with the fewest dishes is always on top, so 4 windows
-- with the layout `MultiDishes 1 2 (1/5)` would look like this:
--
-- > _________
-- > | |
-- > | M |
-- > |_______|
-- > |_______|
-- > |___|___|
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
data MultiDishes a = MultiDishes Int Int Rational deriving (Show, Read)
instance LayoutClass MultiDishes a where
pureLayout (MultiDishes nmaster dishesPerStack h) r =
ap zip (multiDishes h r nmaster dishesPerStack . length) . integrate
pureMessage (MultiDishes nmaster dishesPerStack h) m = fmap incmastern (fromMessage m)
where incmastern (IncMasterN d) = MultiDishes (max 0 (nmaster+d)) dishesPerStack h
multiDishes :: Rational -> Rectangle -> Int -> Int -> Int -> [Rectangle]
multiDishes h s nmaster dishesPerStack n = if n <= nmaster
then splitHorizontally n s
else ws
where
(filledDishStackCount, remainder) =
(n - nmaster) `quotRem` (max 1 dishesPerStack)
(firstDepth, dishStackCount) =
if remainder == 0 then
(dishesPerStack, filledDishStackCount)
else
(remainder, filledDishStackCount + 1)
(masterRect, dishesRect) =
splitVerticallyBy (1 - (fromIntegral dishStackCount) * h) s
dishStackRects =
splitVertically dishStackCount dishesRect
allDishRects = case dishStackRects of
(firstStack:bottomDishStacks) ->
splitHorizontally firstDepth firstStack ++ (bottomDishStacks >>= splitHorizontally dishesPerStack)
[] -> []
ws =
splitHorizontally nmaster masterRect ++ allDishRects

3
XMonad/Layout/MultiToggle.hs
View File

@@ -90,8 +90,7 @@ import Data.Maybe
-- > instance Transformer MIRROR Window where
-- > transform _ x k = k (Mirror x) (\(Mirror x') -> x')
--
-- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable,
-- TypeSynonymInstances, MultiParamTypeClasses \#-}@ at the
-- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable \#-}@ at the
-- beginning of your file.
-- | A class to identify custom transformers (and look up transforming

47
XMonad/Layout/MultiToggle/TabBarDecoration.hs
View File

@@ -1,47 +0,0 @@
{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.MultiToggle.TabBarDecoration
-- Copyright : (c) 2018 Lucian Poston
-- License : BSD-style (see LICENSE)
--
-- Maintainer : <lucianposton@pm.me>
-- Stability : unstable
-- Portability : unportable
--
-- Provides a simple transformer for use with "XMonad.Layout.MultiToggle" to
-- dynamically toggle "XMonad.Layout.TabBarDecoration".
-----------------------------------------------------------------------------
module XMonad.Layout.MultiToggle.TabBarDecoration (
SimpleTabBar(..)
) where
import XMonad.Layout.MultiToggle
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Layout.TabBarDecoration
-- $usage
-- To use this module with "XMonad.Layout.MultiToggle", add the @SIMPLETABBAR@
-- to your layout For example, from a basic layout like
--
-- > layout = tiled ||| Full
--
-- Add @SIMPLETABBAR@ by changing it this to
--
-- > layout = mkToggle (single SIMPLETABBAR) (tiled ||| Full)
--
-- You can now dynamically toggle the 'XMonad.Layout.TabBarDecoration'
-- transformation by adding a key binding such as @mod-x@ as follows.
--
-- > ...
-- > , ((modm, xK_x ), sendMessage $ Toggle SIMPLETABBAR)
-- > ...
-- | Transformer for "XMonad.Layout.TabBarDecoration".
data SimpleTabBar = SIMPLETABBAR deriving (Read, Show, Eq, Typeable)
instance Transformer SimpleTabBar Window where
transform _ x k = k (simpleTabBar x) (\(ModifiedLayout _ (ModifiedLayout _ x')) -> x')

264
XMonad/Layout/NoBorders.hs
View File

@@ -1,11 +1,10 @@
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances, PatternGuards, DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.NoBorders
-- Copyright : (c) -- David Roundy <droundy@darcs.net>
-- 2018 Yclept Nemo
-- Copyright : (c) David Roundy <droundy@darcs.net>
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Spencer Janssen <spencerjanssen@gmail.com>
@@ -19,32 +18,25 @@
--
-----------------------------------------------------------------------------
module XMonad.Layout.NoBorders ( -- * Usage
-- $usage
noBorders
, smartBorders
, withBorder
, lessBorders
, hasBorder
, SetsAmbiguous(..)
, Ambiguity(..)
, With(..)
, BorderMessage (..), borderEventHook
, SmartBorder, WithBorder, ConfigurableBorder
module XMonad.Layout.NoBorders (
-- * Usage
-- $usage
noBorders,
smartBorders,
withBorder,
lessBorders,
SetsAmbiguous(..),
Ambiguity(..),
With(..),
SmartBorder, WithBorder, ConfigurableBorder,
) where
import XMonad
import XMonad.Layout.LayoutModifier
import qualified XMonad.StackSet as W
import qualified XMonad.Util.Rectangle as R
import Data.List
import Data.Monoid
import qualified Data.Map as M
import Data.Function (on)
import Control.Applicative ((<$>),(<*>),pure)
import Control.Monad (guard)
import XMonad
import XMonad.Layout.LayoutModifier
import qualified XMonad.StackSet as W
import Data.List
import qualified Data.Map as M
import Data.Function (on)
-- $usage
-- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file:
@@ -108,94 +100,34 @@ smartBorders = lessBorders Never
-- instances
lessBorders :: (SetsAmbiguous p, Read p, Show p, LayoutClass l a) =>
p -> l a -> ModifiedLayout (ConfigurableBorder p) l a
lessBorders amb = ModifiedLayout (ConfigurableBorder amb [] [] [])
lessBorders amb = ModifiedLayout (ConfigurableBorder amb [])
-- | 'ManageHook' for sending 'HasBorder' messages:
--
-- > title =? "foo" --> hasBorder True
--
-- There is no equivalent for 'ResetBorder'.
hasBorder :: Bool -> ManageHook
hasBorder b = ask >>= \w -> liftX (broadcastMessage $ HasBorder b w) >> idHook
data BorderMessage
= HasBorder Bool Window
-- ^ If @True@, never remove the border from the specified window. If
-- @False@, always remove the border from the specified window.
| ResetBorder Window
-- ^ Reset the effects of any 'HasBorder' messages on the specified
-- window.
deriving (Typeable)
instance Message BorderMessage
data ConfigurableBorder p w = ConfigurableBorder
{ _generateHidden :: p
-- ^ Generates a list of windows without borders. Uses 'SetsAmbiguous'
-- to filter the current layout.
, alwaysHidden :: [w]
-- ^ Windows that never have borders. This list is added to the result
-- of 'generateHidden'.
, neverHidden :: [w]
-- ^ Windows that always have borders - i.e. ignored by this module.
-- This list is subtraced from 'alwaysHidden' and so has higher
-- precendence.
, currentHidden :: [w]
-- ^ The current set of windows without borders, i.e. the state.
} deriving (Read, Show)
-- | Only necessary with 'BorderMessage' - remove non-existent windows from the
-- 'alwaysHidden' or 'neverHidden' lists.
borderEventHook :: Event -> X All
borderEventHook (DestroyWindowEvent { ev_window = w }) = do
broadcastMessage $ ResetBorder w
return $ All True
borderEventHook _ = return $ All True
data ConfigurableBorder p w = ConfigurableBorder p [w] deriving (Read, Show)
instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where
unhook (ConfigurableBorder _ _ _ ch) = asks (borderWidth . config) >>= setBorders ch
unhook (ConfigurableBorder _p s) = asks (borderWidth . config) >>= setBorders s
redoLayout cb@(ConfigurableBorder gh ah nh ch) lr mst wrs = do
let gh' wset = let lh = (hiddens gh wset lr mst wrs)
in return $ (ah `union` lh) \\ nh
ch' <- withWindowSet gh'
asks (borderWidth . config) >>= setBorders (ch \\ ch')
setBorders ch' 0
return (wrs, Just $ cb { currentHidden = ch' })
pureMess cb@(ConfigurableBorder gh ah nh ch) m
| Just (HasBorder b w) <- fromMessage m =
let consNewIf l True = if w `elem` l then Nothing else Just (w:l)
consNewIf l False = Just l
in (ConfigurableBorder gh) <$> consNewIf ah (not b)
<*> consNewIf nh b
<*> pure ch
| Just (ResetBorder w) <- fromMessage m =
let delete' e l = if e `elem` l then (True,delete e l) else (False,l)
(da,ah') = delete' w ah
(dn,nh') = delete' w nh
in if da || dn
then Just cb { alwaysHidden = ah', neverHidden = nh' }
else Nothing
| otherwise = Nothing
redoLayout (ConfigurableBorder p s) _ mst wrs = do
ws <- withWindowSet (\wset -> return (hiddens p wset mst wrs))
asks (borderWidth . config) >>= setBorders (s \\ ws)
setBorders ws 0
return (wrs, Just $ ConfigurableBorder p ws)
-- | SetsAmbiguous allows custom actions to generate lists of windows that
-- should not have borders drawn through 'ConfigurableBorder'
--
-- To add your own (though perhaps those options would better belong as an
-- additional constructor to 'Ambiguity'), you can add the following function.
-- Note that @lr@, the parameter representing the 'Rectangle' of the parent
-- layout, was added to 'hiddens' in 0.14. Update your instance accordingly.
-- aditional constructor to 'Ambiguity'), you can add the function as such:
--
-- > data MyAmbiguity = MyAmbiguity deriving (Read, Show)
--
-- > instance SetsAmbiguous MyAmbiguity where
-- > hiddens _ wset lr mst wrs = otherHiddens Screen \\ otherHiddens OnlyScreenFloat
-- > where otherHiddens p = hiddens p wset lr mst wrs
-- > hiddens _ wset mst wrs = otherHiddens Screen \\ otherHiddens OnlyFloat
-- > where otherHiddens p = hiddens p wset mst wrs
--
-- The above example is redundant, because you can have the same result with:
--
-- > layoutHook = lessBorders (Combine Difference Screen OnlyScreenFloat) (Tall 1 0.5 0.03 ||| ... )
-- > layoutHook = lessBorders (Combine Difference Screen OnlyFloat) (Tall 1 0.5 0.03 ||| ... )
--
-- To get the same result as 'smartBorders':
--
@@ -204,87 +136,32 @@ instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder
-- This indirect method is required to keep the 'Read' and 'Show' for
-- ConfigurableBorder so that xmonad can serialize state.
class SetsAmbiguous p where
hiddens :: p -> WindowSet -> Rectangle -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window]
hiddens :: p -> WindowSet -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window]
-- Quick overview since the documentation lacks clarity:
-- * Overall stacking order =
-- tiled stacking order ++ floating stacking order
-- Where tiled windows are (obviously) stacked below floating windows.
-- * Tiled stacking order =
-- [(window, Rectangle] order
-- Given by 'XMonad.Core.LayoutClass' where earlier entries are stacked
-- higher.
-- * Floating stacking order =
-- focus order
-- Given by the workspace stack where a higher focus corresponds to a higher
-- stacking position.
--
-- Integrating a stack returns a list in order of [highest...lowest].
--
-- 'XMonad.Core.LayoutClass' is given a stack with all floating windows removed
-- and returns a list (in stack order) of only the visible tiled windows, while
-- the workspace stack contains all windows (visible/hidden, floating/tiled) in
-- focus order. The StackSet 'floating' field maps all floating windows across
-- all workspaces to relative rectangles - without the associated screen.
--
-- 'XMonad.Operations.windows' gets the windowset from the state, mutates it,
-- then updates the state before calling 'runLayout' with the new windowset -
-- excluding any floating windows. Aside from the filtering, the stack received
-- by the layout should be identical to the one received from 'withWindowSet'.
instance SetsAmbiguous Ambiguity where
hiddens amb wset lr mst wrs
hiddens amb wset mst wrs
| Combine Union a b <- amb = on union next a b
| Combine Difference a b <- amb = on (\\) next a b
| Combine Intersection a b <- amb = on intersect next a b
| otherwise = tiled ms ++ floating
where next p = hiddens p wset lr mst wrs
screens = [ scr | scr <- W.screens wset
, case amb of
Never -> True
_ -> not $ null $ integrate scr
, not . R.empty . screenRect
$ W.screenDetail scr
]
-- This originally considered all floating windows across all
-- workspaces. It seems more efficient to have each layout manage
-- its own floating windows - and equally valid though untested
-- against a multihead setup. In some cases the previous code would
-- redundantly add then remove borders from already-borderless
-- windows.
floating = do
let wz :: Integer -> (Window,Rectangle)
-> (Integer,Window,Rectangle)
wz i (w,wr) = (i,w,wr)
-- For the following: in stacking order lowest -> highest.
ts = reverse . zipWith wz [-1,-2..] $ wrs
fs = zipWith wz [0..] $ do
w <- reverse . W.index $ wset
Just wr <- [M.lookup w (W.floating wset)]
return (w,scaleRationalRect sr wr)
sr = screenRect . W.screenDetail . W.current $ wset
(i1,w1,wr1) <- fs
guard $ case amb of
OnlyLayoutFloatBelow ->
let vu = do
gr <- sr `R.difference` lr
(i2,_w2,wr2) <- ts ++ fs
guard $ i2 < i1
[wr2 `R.intersects` gr]
in lr == wr1 && (not . or) vu
OnlyLayoutFloat ->
lr == wr1
_ ->
wr1 `R.supersetOf` sr
return w1
where next p = hiddens p wset mst wrs
nonzerorect (Rectangle _ _ 0 0) = False
nonzerorect _ = True
screens =
[ scr | scr <- W.screens wset,
case amb of
Never -> True
_ -> not $ null $ integrate scr,
nonzerorect . screenRect $ W.screenDetail scr]
floating = [ w |
(w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset,
px <= 0, py <= 0,
wx + px >= 1, wy + py >= 1]
ms = filter (`elem` W.integrate' mst) $ map fst wrs
tiled [w]
| Screen <- amb = [w]
| OnlyScreenFloat <- amb = []
| OnlyLayoutFloat <- amb = []
| OnlyLayoutFloatBelow <- amb = []
| OnlyFloat <- amb = []
| OtherIndicated <- amb
, let nonF = map integrate $ W.current wset : W.visible wset
, length (concat nonF) > length wrs
@@ -297,34 +174,23 @@ instance SetsAmbiguous Ambiguity where
-- subsequent constructors add additional cases where borders are not drawn
-- than their predecessors. These behaviors make most sense with with multiple
-- screens: for single screens, 'Never' or 'smartBorders' makes more sense.
data Ambiguity
= Combine With Ambiguity Ambiguity
-- ^ This constructor is used to combine the borderless windows
-- provided by the SetsAmbiguous instances from two other 'Ambiguity'
-- data types.
| OnlyScreenFloat
-- ^ Only remove borders on floating windows that cover the whole
-- screen.
| OnlyLayoutFloatBelow
-- ^ Like 'OnlyLayoutFloat', but only removes borders if no window
-- stacked below remains visible. Considers all floating windows on the
-- current screen and all visible tiled windows of the child layout. If
-- any such window (that is stacked below) shows in any gap between the
-- parent layout rectangle and the physical screen, the border will
-- remain drawn.
| OnlyLayoutFloat
-- ^ Only remove borders on floating windows that exactly cover the
-- parent layout rectangle.
| Never
-- ^ Never remove borders when ambiguous: this is the same as
-- smartBorders.
| EmptyScreen
-- ^ Focus in an empty screen does not count as ambiguous.
| OtherIndicated
-- ^ No borders on full when all other screens have borders.
| Screen
-- ^ Borders are never drawn on singleton screens. With this one you
-- really need another way such as a statusbar to detect focus.
data Ambiguity = Combine With Ambiguity Ambiguity
-- ^ This constructor is used to combine the
-- borderless windows provided by the
-- SetsAmbiguous instances from two other
-- 'Ambiguity' data types.
| OnlyFloat -- ^ Only remove borders on floating windows that
-- cover the whole screen
| Never -- ^ Never remove borders when ambiguous:
-- this is the same as smartBorders
| EmptyScreen -- ^ Focus in an empty screens does not count as
-- ambiguous.
| OtherIndicated
-- ^ No borders on full when all other screens
-- have borders.
| Screen -- ^ Borders are never drawn on singleton screens.
-- With this one you really need another way such
-- as a statusbar to detect focus.
deriving (Read, Show)
-- | Used to indicate to the 'SetsAmbiguous' instance for 'Ambiguity' how two

445
XMonad/Layout/Spacing.hs
View File

@@ -1,388 +1,129 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.Spacing
-- Copyright : (C) -- Brent Yorgey
-- 2018 Yclept Nemo
-- Copyright : (c) Brent Yorgey
-- License : BSD-style (see LICENSE)
--
-- Maintainer : <byorgey@gmail.com>
-- Stability : unstable
-- Portability : unportable
-- Portability : portable
--
-- Add a configurable amount of space around windows.
--
-- Note: For space\/gaps along edges of the /screen/ see "XMonad.Layout.Gaps".
-----------------------------------------------------------------------------
module XMonad.Layout.Spacing
( -- * Usage
-- $usage
Border (..)
, Spacing (..)
, SpacingModifier (..)
, spacingRaw
, setSmartSpacing
, setScreenSpacing, setScreenSpacingEnabled
, setWindowSpacing, setWindowSpacingEnabled
, toggleSmartSpacing
, toggleScreenSpacingEnabled
, toggleWindowSpacingEnabled
, setScreenWindowSpacing
, incWindowSpacing, incScreenSpacing
, decWindowSpacing, decScreenSpacing
, incScreenWindowSpacing, decScreenWindowSpacing
, borderMap, borderIncrementBy
-- * Backwards Compatibility
-- $backwardsCompatibility
, SpacingWithEdge
, SmartSpacing, SmartSpacingWithEdge
, ModifySpacing (..)
, spacing, spacingWithEdge
, smartSpacing, smartSpacingWithEdge
, setSpacing, incSpacing
) where
module XMonad.Layout.Spacing (
-- * Usage
-- $usage
import XMonad
import XMonad.StackSet as W
import qualified XMonad.Util.Rectangle as R
import XMonad.Layout.LayoutModifier
import XMonad.Actions.MessageFeedback
spacing, Spacing,
spacingWithEdge, SpacingWithEdge,
smartSpacing, SmartSpacing,
smartSpacingWithEdge, SmartSpacingWithEdge,
ModifySpacing(..), setSpacing, incSpacing
) where
import Graphics.X11 (Rectangle(..))
import Control.Arrow (second)
import XMonad.Operations (sendMessage)
import XMonad.Core (X,runLayout,Message,fromMessage,Typeable)
import XMonad.StackSet (up, down, Workspace(..))
import XMonad.Util.Font (fi)
import XMonad.Layout.LayoutModifier
-- $usage
-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@
-- file:
-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Layout.Spacing
--
-- and modifying your layoutHook as follows (for example):
--
-- > layoutHook = spacingRaw True (Border 0 10 10 10) True (Border 10 10 10 10) True $
-- > layoutHook def
-- > layoutHook = spacing 2 $ Tall 1 (3/100) (1/2)
-- > -- put a 2px space around every window
--
-- | Represent the borders of a rectangle.
data Border = Border
{ top :: Integer
, bottom :: Integer
, right :: Integer
, left :: Integer
} deriving (Show,Read)
-- | Surround all windows by a certain number of pixels of blank space.
spacing :: Int -> l a -> ModifiedLayout Spacing l a
spacing p = ModifiedLayout (Spacing p)
-- | A 'LayoutModifier' providing customizable screen and window borders.
-- Borders are clamped to @[0,Infinity]@ before being applied.
data Spacing a = Spacing
{ smartBorder :: Bool
-- ^ When @True@ borders are not applied if
-- there fewer than two windows.
, screenBorder :: Border
-- ^ The screen border.
, screenBorderEnabled :: Bool
-- ^ Is the screen border enabled?
, windowBorder :: Border
-- ^ The window borders.
, windowBorderEnabled :: Bool
-- ^ Is the window border enabled?
} deriving (Show,Read)
data Spacing a = Spacing Int deriving (Show, Read)
instance Eq a => LayoutModifier Spacing a where
-- This is a bit of a chicken-and-egg problem - the visible window list has
-- yet to be generated. Several workarounds to incorporate the screen
-- border:
-- 1. Call 'runLayout' twice, with/without the screen border. Since layouts
-- run arbitrary X actions, this breaks an important underlying
-- assumption. Also, doesn't really solve the chicken-egg problem.
-- 2. Create the screen border after and if the child layout returns more
-- than one window. Unfortunately this breaks the window ratios
-- presented by the child layout, another important assumption.
-- 3. Create the screen border before, and remove it after and if the child
-- layout returns fewer than two visible windows. This is somewhat hacky
-- but probably the best option. Could significantly modify the child
-- layout if it would have returned more than one window given the space
-- of the screen border, but this is the underlying chicken-egg problem,
-- and some concession must be made:
-- * no border -> multiple windows
-- * border -> single window
-- Also slightly breaks layouts that expect to present absolutely-sized
-- windows; a single window will be scaled up by the border size.
-- Overall these are trivial assumptions.
--
-- Note #1: the original code counted the windows of the 'Workspace' stack,
-- and so generated incorrect results even for the builtin 'Full' layout.
-- Even though most likely true, it isn't guaranteed that a layout will
-- never return windows not in the stack, specifically that an empty stack
-- will lead to 0 visible windows and a stack with a single window will
-- lead to 0-1 visible windows (see 'XMonad.Layout.Decoration'). So as much
-- as I would like to pass a rectangle without screen borders to the child
-- layout when appropriate (per the original approach), I can't. Since the
-- screen border is always present whether displayed or not, child layouts
-- can't depend on an accurate layout rectangle.
--
-- Note #2: If there are fewer than two stack windows displayed, the stack
-- window (if present) is scaled up while the non-stack windows are moved a
-- border-dependent amount based on their quadrant. So a non-stack window
-- in the top-left quadrant will be moved using only the border's top and
-- left components. Originally I was going to use an edge-attachment
-- algorithm, but this is much simpler and covers most cases. Edge
-- attachment would have scaled non-stack windows, but most non-stack
-- windows are created by XMonad and therefore cannot be scaled. I suggest
-- this layout be disabled for any incompatible child layouts.
modifyLayout (Spacing _b _sb False _wb _wbe) wsp lr =
runLayout wsp lr
modifyLayout (Spacing b sb _sbe _wb _wbe) wsp lr = do
let sb1 = borderClampGTZero sb
lr' = withBorder' sb1 2 lr
sb2 = toBorder lr' lr
(wrs,ml) <- runLayout wsp lr'
let ff (w,wr) (i,ps) = if w `elem` (W.integrate' . W.stack $ wsp)
then let wr' = withBorder' sb2 2 wr
in (i+1,(w,wr'):ps)
else let wr' = moveByQuadrant lr wr sb2
in (i,(w,wr'):ps)
(c,wrs') = foldr ff (0::Integer,[]) wrs
return $ if c <= 1 && b
then (wrs',ml)
else (wrs,ml)
where
moveByQuadrant :: Rectangle -> Rectangle -> Border -> Rectangle
moveByQuadrant rr mr@(Rectangle {rect_x = x, rect_y = y}) (Border bt bb br bl) =
let (rcx,rcy) = R.center rr
(mcx,mcy) = R.center mr
dx = orderSelect (compare mcx rcx) (bl,0,negate br)
dy = orderSelect (compare mcy rcy) (bt,0,negate bb)
in mr { rect_x = x + fromIntegral dx, rect_y = y + fromIntegral dy }
-- This is run after 'modifyLayout' but receives the original stack, not
-- one possibly modified by the child layout. Does not remove borders from
-- windows not in the stack, i.e. decorations generated by
-- 'XMonad.Layout.Decorations'.
pureModifier (Spacing _b _sb _sbe _wb False) _lr _mst wrs =
(wrs, Nothing)
pureModifier (Spacing b _sb _sbe wb _wbe) _lr mst wrs =
let wb' = borderClampGTZero wb
ff p@(w,wr) (i,ps) = if w `elem` W.integrate' mst
then let wr' = withBorder' wb' 2 wr
in (i+1,(w,wr'):ps)
else (i,p:ps)
(c,wrs') = foldr ff (0::Integer,[]) wrs
in if c <= 1 && b
then (wrs, Nothing)
else (wrs', Nothing)
pureMess s@(Spacing b sb sbe wb wbe) m
| Just (ModifySmartBorder f) <- fromMessage m
= Just $ s { smartBorder = f b }
| Just (ModifyScreenBorder f) <- fromMessage m
= Just $ s { screenBorder = f sb }
| Just (ModifyScreenBorderEnabled f) <- fromMessage m
= Just $ s { screenBorderEnabled = f sbe }
| Just (ModifyWindowBorder f) <- fromMessage m
= Just $ s { windowBorder = f wb }
| Just (ModifyWindowBorderEnabled f) <- fromMessage m
= Just $ s { windowBorderEnabled = f wbe }
| Just (ModifySpacing f) <- fromMessage m
= Just $ let f' = borderMap (fromIntegral . f . fromIntegral)
in s { screenBorder = f' sb, windowBorder = f' wb }
| otherwise
= Nothing
modifierDescription Spacing {} =
"Spacing"
-- | Generate the 'ModifiedLayout', exposing all initial state of 'Spacing'.
spacingRaw :: Bool -- ^ The 'smartBorder'.
-> Border -- ^ The 'screenBorder'.
-> Bool -- ^ The 'screenBorderEnabled'.
-> Border -- ^ The 'windowBorder'.
-> Bool -- ^ The 'windowBorderEnabled'.
-> l a -> ModifiedLayout Spacing l a
spacingRaw b sb sbe wb wbe = ModifiedLayout (Spacing b sb sbe wb wbe)
-- | Messages to alter the state of 'Spacing' using the endomorphic function
-- arguments.
data SpacingModifier
= ModifySmartBorder (Bool -> Bool)
| ModifyScreenBorder (Border -> Border)
| ModifyScreenBorderEnabled (Bool -> Bool)
| ModifyWindowBorder (Border -> Border)
| ModifyWindowBorderEnabled (Bool -> Bool)
deriving (Typeable)
instance Message SpacingModifier
-- | Set 'smartBorder' to the given 'Bool'.
setSmartSpacing :: Bool -> X ()
setSmartSpacing = sendMessage . ModifySmartBorder . const
-- | Set 'screenBorder' to the given 'Border'.
setScreenSpacing :: Border -> X ()
setScreenSpacing = sendMessage . ModifyScreenBorder . const
-- | Set 'screenBorderEnabled' to the given 'Bool'.
setScreenSpacingEnabled :: Bool -> X ()
setScreenSpacingEnabled = sendMessage . ModifyScreenBorderEnabled . const
-- | Set 'windowBorder' to the given 'Border'.
setWindowSpacing :: Border -> X ()
setWindowSpacing = sendMessage . ModifyWindowBorder . const
-- | Set 'windowBorderEnabled' to the given 'Bool'.
setWindowSpacingEnabled :: Bool -> X ()
setWindowSpacingEnabled = sendMessage . ModifyWindowBorderEnabled . const
-- | Toggle 'smartBorder'.
toggleSmartSpacing :: X ()
toggleSmartSpacing = sendMessage $ ModifySmartBorder not
-- | Toggle 'screenBorderEnabled'.
toggleScreenSpacingEnabled :: X ()
toggleScreenSpacingEnabled = sendMessage $ ModifyScreenBorderEnabled not
-- | Toggle 'windowBorderEnabled'.
toggleWindowSpacingEnabled :: X ()
toggleWindowSpacingEnabled = sendMessage $ ModifyWindowBorderEnabled not
-- | Set all borders to a uniform size; see 'setWindowSpacing' and
-- 'setScreenSpacing'.
setScreenWindowSpacing :: Integer -> X ()
setScreenWindowSpacing = sendMessages . flip map [ModifyWindowBorder,ModifyScreenBorder]
. flip id . const . uniformBorder
-- | Increment the borders of 'windowBorder' using 'borderIncrementBy', which
-- preserves border ratios during clamping.
incWindowSpacing :: Integer -> X ()
incWindowSpacing = sendMessage . ModifyWindowBorder . borderIncrementBy
-- | Increment the borders of 'screenBorder' using 'borderIncrementBy'.
incScreenSpacing :: Integer -> X ()
incScreenSpacing = sendMessage . ModifyScreenBorder . borderIncrementBy
-- | Inverse of 'incWindowSpacing', equivalent to applying 'negate'.
decWindowSpacing :: Integer -> X ()
decWindowSpacing = incWindowSpacing . negate
-- | Inverse of 'incScreenSpacing'.
decScreenSpacing :: Integer -> X ()
decScreenSpacing = incScreenSpacing . negate
-- | Increment both screen and window borders; see 'incWindowSpacing' and
-- 'incScreenSpacing'.
incScreenWindowSpacing :: Integer -> X ()
incScreenWindowSpacing = sendMessages . flip map [ModifyWindowBorder,ModifyScreenBorder]
. flip id . borderIncrementBy
-- | Inverse of 'incScreenWindowSpacing'.
decScreenWindowSpacing :: Integer -> X ()
decScreenWindowSpacing = incScreenWindowSpacing . negate
-- | Construct a uniform 'Border'. That is, having equal individual borders.
uniformBorder :: Integer -> Border
uniformBorder i = Border i i i i
-- | Map a function over a 'Border'. That is, over the four individual borders.
borderMap :: (Integer -> Integer) -> Border -> Border
borderMap f (Border t b r l) = Border (f t) (f b) (f r) (f l)
-- | Clamp borders to within @[0,Infinity]@.
borderClampGTZero :: Border -> Border
borderClampGTZero = borderMap (max 0)
-- | Change the border spacing by the provided amount, adjusted so that at
-- least one border field is @>=0@.
borderIncrementBy :: Integer -> Border -> Border
borderIncrementBy i (Border t b r l) =
let bl = [t,b,r,l]
o = maximum bl
o' = max i $ negate o
[t',b',r',l'] = map (+o') bl
in Border t' b' r' l'
-- | Interface to 'XMonad.Util.Rectangle.withBorder'.
withBorder' :: Border -> Integer -> Rectangle -> Rectangle
withBorder' (Border t b r l) = R.withBorder t b r l
-- | Return the border necessary to derive the second rectangle from the first.
-- Since 'R.withBorder' may scale the borders to stay within rectangle bounds,
-- it is not an invertible operation, i.e. applying a negated border may not
-- return the original rectangle. Use this instead.
toBorder :: Rectangle -> Rectangle -> Border
toBorder r1 r2 =
let R.PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = R.pixelsToCoordinates r1
R.PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = R.pixelsToCoordinates r2
l = r2_x1 - r1_x1
r = r1_x2 - r2_x2
t = r2_y1 - r1_y1
b = r1_y2 - r2_y2
in Border t b r l
-- | Given an ordering and a three-tuple, return the first tuple entry if 'LT',
-- second if 'EQ' and third if 'GT'.
orderSelect :: Ordering -> (a,a,a) -> a
orderSelect o (lt,eq,gt) = case o of
LT -> lt
EQ -> eq
GT -> gt
-----------------------------------------------------------------------------
-- Backwards Compatibility:
-----------------------------------------------------------------------------
{-# DEPRECATED SpacingWithEdge, SmartSpacing, SmartSpacingWithEdge "Use Spacing instead." #-}
{-# DEPRECATED ModifySpacing "Use SpacingModifier instead, perhaps with sendMessages." #-}
{-# DEPRECATED spacing, spacingWithEdge, smartSpacing, smartSpacingWithEdge "Use spacingRaw instead." #-}
{-# DEPRECATED setSpacing "Use setScreenWindowSpacing instead." #-}
{-# DEPRECATED incSpacing "Use incScreenWindowSpacing instead." #-}
-- $backwardsCompatibility
-- The following functions and types exist solely for compatibility with
-- pre-0.14 releases.
-- | A type synonym for the 'Spacing' 'LayoutModifier'.
type SpacingWithEdge = Spacing
-- | A type synonym for the 'Spacing' 'LayoutModifier'.
type SmartSpacing = Spacing
-- | A type synonym for the 'Spacing' 'LayoutModifier'.
type SmartSpacingWithEdge = Spacing
-- | Message to dynamically modify (e.g. increase\/decrease\/set) the size of
-- the screen spacing and window spacing. See 'SpacingModifier'.
-- | Message to dynamically modify (e.g. increase/decrease/set) the size of the window spacing
data ModifySpacing = ModifySpacing (Int -> Int) deriving (Typeable)
instance Message ModifySpacing
-- | Surround all windows by a certain number of pixels of blank space. See
-- 'spacingRaw'.
spacing :: Int -> l a -> ModifiedLayout Spacing l a
spacing i = spacingRaw False (uniformBorder 0) False (uniformBorder i') True
where i' = fromIntegral i
-- | Set spacing to given amount
setSpacing :: Int -> X ()
setSpacing n = sendMessage $ ModifySpacing $ const n
-- | Increase spacing by given amount
incSpacing :: Int -> X ()
incSpacing n = sendMessage $ ModifySpacing $ (+n)
instance LayoutModifier Spacing a where
pureModifier (Spacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
pureMess (Spacing px) m
| Just (ModifySpacing f) <- fromMessage m = Just $ Spacing $ max 0 $ f px
| otherwise = Nothing
modifierDescription (Spacing p) = "Spacing " ++ show p
-- | Surround all windows by a certain number of pixels of blank space, and
-- additionally adds the same amount of spacing around the edge of the screen.
-- See 'spacingRaw'.
spacingWithEdge :: Int -> l a -> ModifiedLayout Spacing l a
spacingWithEdge i = spacingRaw False (uniformBorder i') True (uniformBorder i') True
where i' = fromIntegral i
spacingWithEdge :: Int -> l a -> ModifiedLayout SpacingWithEdge l a
spacingWithEdge p = ModifiedLayout (SpacingWithEdge p)
data SpacingWithEdge a = SpacingWithEdge Int deriving (Show, Read)
instance LayoutModifier SpacingWithEdge a where
pureModifier (SpacingWithEdge p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
pureMess (SpacingWithEdge px) m
| Just (ModifySpacing f) <- fromMessage m = Just $ SpacingWithEdge $ max 0 $ f px
| otherwise = Nothing
modifyLayout (SpacingWithEdge p) w r = runLayout w (shrinkRect p r)
modifierDescription (SpacingWithEdge p) = "SpacingWithEdge " ++ show p
shrinkRect :: Int -> Rectangle -> Rectangle
shrinkRect p (Rectangle x y w h) = Rectangle (x+fi p) (y+fi p) (fi $ max 1 $ fi w-2*p) (fi $ max 1 $ fi h-2*p)
-- | Surrounds all windows with blank space, except when the window is the only
-- visible window on the current workspace. See 'spacingRaw'.
smartSpacing :: Int -> l a -> ModifiedLayout Spacing l a
smartSpacing i = spacingRaw True (uniformBorder 0) False (uniformBorder i') True
where i' = fromIntegral i
-- visible window on the current workspace.
smartSpacing :: Int -> l a -> ModifiedLayout SmartSpacing l a
smartSpacing p = ModifiedLayout (SmartSpacing p)
-- | Surrounds all windows with blank space, and adds the same amount of
-- spacing around the edge of the screen, except when the window is the only
-- visible window on the current workspace. See 'spacingRaw'.
smartSpacingWithEdge :: Int -> l a -> ModifiedLayout Spacing l a
smartSpacingWithEdge i = spacingRaw True (uniformBorder i') True (uniformBorder i') True
where i' = fromIntegral i
data SmartSpacing a = SmartSpacing Int deriving (Show, Read)
-- | See 'setScreenWindowSpacing'.
setSpacing :: Int -> X ()
setSpacing = setScreenWindowSpacing . fromIntegral
instance LayoutModifier SmartSpacing a where
-- | See 'incScreenWindowSpacing'.
incSpacing :: Int -> X ()
incSpacing = incScreenWindowSpacing . fromIntegral
pureModifier _ _ _ [x] = ([x], Nothing)
pureModifier (SmartSpacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
modifierDescription (SmartSpacing p) = "SmartSpacing " ++ show p
-- | Surrounds all windows with blank space, and adds the same amount of spacing
-- around the edge of the screen, except when the window is the only visible
-- window on the current workspace.
smartSpacingWithEdge :: Int -> l a -> ModifiedLayout SmartSpacingWithEdge l a
smartSpacingWithEdge p = ModifiedLayout (SmartSpacingWithEdge p)
data SmartSpacingWithEdge a = SmartSpacingWithEdge Int deriving (Show, Read)
instance LayoutModifier SmartSpacingWithEdge a where
pureModifier _ _ _ [x] = ([x], Nothing)
pureModifier (SmartSpacingWithEdge p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
modifyLayout (SmartSpacingWithEdge p) w r
| maybe False (\s -> null (up s) && null (down s)) (stack w) = runLayout w r
| otherwise = runLayout w (shrinkRect p r)
modifierDescription (SmartSpacingWithEdge p) = "SmartSpacingWithEdge " ++ show p

94
XMonad/Layout/StateFull.hs
View File

@@ -1,94 +0,0 @@
{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
--------------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.StateFull
-- Description : The StateFull Layout & FocusTracking Layout Transformer
-- Copyright : (c) 2018 L. S. Leary
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : L. S. Leary
-- Stability : unstable
-- Portability : unportable
--
-- Provides StateFull: a stateful form of Full that does not misbehave when
-- floats are focused, and the FocusTracking layout transformer by means of
-- which StateFull is implemented. FocusTracking simply holds onto the last
-- true focus it was given and continues to use it as the focus for the
-- transformed layout until it sees another. It can be used to improve the
-- behaviour of a child layout that has not been given the focused window.
--------------------------------------------------------------------------------
module XMonad.Layout.StateFull (
-- * Usage
-- $Usage
pattern StateFull,
StateFull,
FocusTracking(..),
focusTracking
) where
import XMonad hiding ((<&&>))
import qualified XMonad.StackSet as W
import XMonad.Util.Stack (findZ)
import Data.Maybe (fromMaybe)
import Control.Applicative ((<|>),(<$>))
import Control.Monad (join)
-- $Usage
--
-- To use it, first you need to:
--
-- > import XMonad.Layout.StateFull
--
-- Then to toggle your tiled layout with @StateFull@, you can do:
--
-- > main = xmonad def { layoutHook = someTiledLayout ||| StateFull }
--
-- Or, some child layout that depends on focus information can be made to fall
-- back on the last focus it had:
--
-- > main = xmonad def
-- > { layoutHook = someParentLayoutWith aChild (focusTracking anotherChild) }
-- | The @FocusTracking@ data type for which the @LayoutClass@ instance is
-- provided.
data FocusTracking l a = FocusTracking (Maybe a) (l a)
deriving (Show, Read)
-- | Transform a layout into one that remembers and uses its last focus.
focusTracking :: l a -> FocusTracking l a
focusTracking = FocusTracking Nothing
-- | A type synonym to match the @StateFull@ pattern synonym.
type StateFull = FocusTracking Full
-- | A pattern synonym for the primary use case of the @FocusTracking@
-- transformer; using @Full@.
pattern StateFull = FocusTracking Nothing Full
instance LayoutClass l Window => LayoutClass (FocusTracking l) Window where
description (FocusTracking _ child)
| (chDesc == "Full") = "StateFull"
| (' ' `elem` chDesc) = "FocusTracking (" ++ chDesc ++ ")"
| otherwise = "FocusTracking " ++ chDesc
where chDesc = description child
runLayout (W.Workspace i (FocusTracking mOldFoc childL) mSt) sr = do
mRealFoc <- gets (W.peek . windowset)
let mGivenFoc = W.focus <$> mSt
passedMSt = if mRealFoc == mGivenFoc then mSt
else join (mOldFoc >>= \oF -> findZ (==oF) mSt) <|> mSt
(wrs, mChildL') <- runLayout (W.Workspace i childL passedMSt) sr
let newFT = if mRealFoc /= mGivenFoc then FocusTracking mOldFoc <$> mChildL'
else Just $ FocusTracking mGivenFoc (fromMaybe childL mChildL')
return (wrs, newFT)
handleMessage (FocusTracking mf childLayout) m =
(fmap . fmap) (FocusTracking mf) (handleMessage childLayout m)

4
XMonad/Layout/ThreeColumns.hs
View File

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

4
XMonad/Layout/WindowNavigation.hs
View File

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

81
XMonad/Prompt.hs
View File

@@ -35,7 +35,7 @@ module XMonad.Prompt
, emacsLikeXPKeymap, emacsLikeXPKeymap'
, quit
, killBefore, killAfter, startOfLine, endOfLine
, insertString, pasteString, moveCursor
, pasteString, moveCursor
, setInput, getInput
, moveWord, moveWord', killWord, killWord', deleteString
, moveHistory, setSuccess, setDone
@@ -91,6 +91,7 @@ import Data.List
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Set (fromList, toList)
import System.Directory (getAppUserDataDirectory)
import System.IO
import System.Posix.Files
@@ -126,10 +127,7 @@ data XPState =
}
data XPConfig =
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"@.
XPC { font :: String -- ^ Font; use the prefix @"xft:"@ for TrueType fonts
, bgColor :: String -- ^ Background color
, fgColor :: String -- ^ Font color
, fgHLight :: String -- ^ Font color of a highlighted completion entry
@@ -523,59 +521,24 @@ completionHandle c ks@(sym,_) (KeyEvent { ev_event_type = t, ev_state = m }) = d
alwaysHlight <- gets $ alwaysHighlight . config
mCleaned <- cleanMask m
case () of
() | t == keyPress && (mCleaned,sym) == complKey -> do
st <- get
let updateWins l = redrawWindows l >> eventLoop (completionHandle l)
updateState l = case alwaysHlight of
False -> simpleComplete l st
True | Just (command st) /= highlightedCompl st -> alwaysHighlightCurrent st
| otherwise -> alwaysHighlightNext l st
case c of
[] -> updateWindows >> eventLoop handle
[x] -> updateState [x] >> getCompletions >>= updateWins
l -> updateState l >> updateWins l
() | t == keyPress && (mCleaned,sym) == complKey ->
do
st <- get
let updateState l = case alwaysHlight of
-- modify the buffer's value
False -> let newCommand = nextCompletion (currentXPMode st) (command st) l
in modify $ \s -> setCommand newCommand $ s { offset = length newCommand, highlightedCompl = Just newCommand}
--TODO: Scroll or paginate results
True -> let complIndex' = nextComplIndex st (length l)
highlightedCompl' = highlightedItem st { complIndex = complIndex'} c
in modify $ \s -> setHighlightedCompl highlightedCompl' $ s { complIndex = complIndex' }
updateWins l = redrawWindows l >> eventLoop (completionHandle l)
case c of
[] -> updateWindows >> eventLoop handle
[x] -> updateState [x] >> getCompletions >>= updateWins
l -> updateState l >> updateWins l
| t == keyRelease && (mCleaned,sym) == complKey -> eventLoop (completionHandle c)
| 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
completionHandle _ k e = handle k e
@@ -1101,7 +1064,7 @@ emptyHistory :: History
emptyHistory = M.empty
getHistoryFile :: IO FilePath
getHistoryFile = fmap (++ "/prompt-history") getXMonadCacheDir
getHistoryFile = fmap (++ "/history") $ getAppUserDataDirectory "xmonad"
readHistory :: IO History
readHistory = readHist `E.catch` \(SomeException _) -> return emptyHistory
@@ -1207,7 +1170,7 @@ breakAtSpace s
-- | 'historyCompletion' provides a canned completion function much like
-- 'getShellCompl'; you pass it to mkXPrompt, and it will make completions work
-- from the query history stored in the XMonad cache directory.
-- from the query history stored in ~\/.xmonad\/history.
historyCompletion :: ComplFunction
historyCompletion = historyCompletionP (const True)
@@ -1215,7 +1178,7 @@ historyCompletion = historyCompletionP (const True)
-- name satisfies the given predicate.
historyCompletionP :: (String -> Bool) -> ComplFunction
historyCompletionP p x = fmap (toComplList . M.filterWithKey (const . p)) readHistory
where toComplList = deleteConsecutive . filter (isInfixOf x) . M.foldr (++) []
where toComplList = deleteConsecutive . filter (isInfixOf x) . M.fold (++) []
-- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off
-- laziness and stability for efficiency.

26
XMonad/Prompt/AppendFile.hs
View File

@@ -23,7 +23,6 @@ module XMonad.Prompt.AppendFile (
-- $usage
appendFilePrompt,
appendFilePrompt',
AppendFile,
) where
@@ -56,17 +55,6 @@ import Control.Exception.Extensible (bracket)
--
-- (Put the spawn on the line after the prompt to append the time instead.)
--
-- 'appendFilePrompt'' can be used to transform the string input in the prompt
-- before saving into the file. Previous example with date can be rewritten as:
--
-- > , ((modm .|. controlMask, xK_n), do
-- > date <- io $ liftM (formatTime defaultTimeLocale "[%Y-%m-%d %H:%M] ") getZonedTime
-- > appendFilePrompt' def (date ++) $ "/home/me/NOTES"
-- > )
--
-- A benefit is that if the prompt is cancelled the date is not output to
-- the file too.
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".
@@ -78,17 +66,11 @@ instance XPrompt AppendFile where
-- | Given an XPrompt configuration and a file path, prompt the user
-- for a line of text, and append it to the given file.
appendFilePrompt :: XPConfig -> FilePath -> X ()
appendFilePrompt c fn = appendFilePrompt' c id fn
-- | Given an XPrompt configuration, string transformation function
-- and a file path, prompt the user for a line of text, transform it
-- and append the result to the given file.
appendFilePrompt' :: XPConfig -> (String -> String) -> FilePath -> X ()
appendFilePrompt' c trans fn = mkXPrompt (AppendFile fn)
appendFilePrompt c fn = mkXPrompt (AppendFile fn)
c
(const (return []))
(doAppend trans fn)
(doAppend fn)
-- | Append a string to a file.
doAppend :: (String -> String) -> FilePath -> String -> X ()
doAppend trans fn = io . bracket (openFile fn AppendMode) hClose . flip hPutStrLn . trans
doAppend :: FilePath -> String -> X ()
doAppend fn = io . bracket (openFile fn AppendMode) hClose . flip hPutStrLn

19
XMonad/Prompt/Directory.hs
View File

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

104
XMonad/Prompt/FuzzyMatch.hs
View File

@@ -1,104 +0,0 @@
--------------------------------------------------------------------------------
-- |
-- Module : XMonad.Prompt.FuzzyMatch
-- Copyright : (C) 2015 Norbert Zeh
-- License : GPL
--
-- Maintainer : Norbert Zeh <norbert.zeh@gmail.com>
-- Stability : unstable
-- Portability : unportable
--
-- A module for fuzzy completion matching in prompts akin to emacs ido mode.
--
--------------------------------------------------------------------------------
module XMonad.Prompt.FuzzyMatch ( -- * Usage
-- $usage
fuzzyMatch
, fuzzySort
) where
import Data.Char
import Data.Function
import Data.List
-- $usage
--
-- This module offers two aspects of fuzzy matching of completions offered by
-- XMonad.Prompt.
--
-- 'fuzzyMatch' can be used as the searchPredicate in the XPConfig. The effect
-- is that any completion that contains the currently typed characters as a
-- subsequence is a valid completion; matching is case insensitive. This means
-- that the sequence of typed characters can be obtained from the completion by
-- deleting an appropriate subset of its characters. Example: "spr" matches
-- "FastSPR" but also "SuccinctParallelTrees" because it's a subsequence of the
-- latter: "S.......P.r..........".
--
-- While this type of inclusiveness is helpful most of the time, it sometimes
-- also produces surprising matches. 'fuzzySort' helps sorting matches by
-- relevance, using a simple heuristic for measuring relevance. The matches are
-- sorted primarily by the length of the substring that contains the query
-- characters and secondarily the starting position of the match. So, if the
-- search string is "spr" and the matches are "FastSPR", "FasterSPR", and
-- "SuccinctParallelTrees", then the order is "FastSPR", "FasterSPR",
-- "SuccinctParallelTrees" because both "FastSPR" and "FasterSPR" contain "spr"
-- within a substring of length 3 ("SPR") while the shortest substring of
-- "SuccinctParallelTrees" that matches "spr" is "SuccinctPar", which has length
-- 11. "FastSPR" is ranked before "FasterSPR" because its match starts at
-- position 5 while the match in "FasterSPR" starts at position 7.
--
-- To use these functions in an XPrompt, for example, for windowPromptGoto:
--
-- > import XMonad.Prompt
-- > import XMonad.Prompt.Window ( windowPromptGoto )
-- > import XMonad.Prompt.FuzzyMatch
-- >
-- > myXPConfig = def { searchPredicate = fuzzyMatch
-- , sorter = fuzzySort
-- }
--
-- then add this to your keys definition:
--
-- > , ((modm .|. shiftMask, xK_g), windowPromptGoto myXPConfig)
--
-- For detailed instructions on editing the key bindings, see
-- "Xmonad.Doc.Extending#Editing_key_bindings".
-- | 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
fuzzyMatch [] _ = True
fuzzyMatch _ [] = False
fuzzyMatch xxs@(x:xs) (y:ys) | toLower x == toLower y = fuzzyMatch xs ys
| otherwise = fuzzyMatch xxs ys
-- | Sort the given set of strings by how well they match. Match quality is
-- measured first by the length of the substring containing the match and second
-- by the positions of the matching characters in the string.
fuzzySort :: String -> [String] -> [String]
fuzzySort q = map snd . sortBy (compare `on` fst) . map (rankMatch q)
rankMatch :: String -> String -> ((Int, Int), String)
rankMatch q s = (minimum $ rankMatches q s, s)
rankMatches :: String -> String -> [(Int, Int)]
rankMatches [] _ = [(0, 0)]
rankMatches q s = map (\(l, r) -> (r - l, l)) $ findShortestMatches q s
findShortestMatches :: String -> String -> [(Int, Int)]
findShortestMatches q s = foldl' extendMatches spans oss
where (os:oss) = map (findOccurrences s) q
spans = [(o, o) | o <- os]
findOccurrences :: String -> Char -> [Int]
findOccurrences s c = map snd $ filter ((toLower c ==) . toLower . fst) $ zip s [0..]
extendMatches :: [(Int, Int)] -> [Int] -> [(Int, Int)]
extendMatches spans xs = map last $ groupBy ((==) `on` snd) $ extendMatches' spans xs
extendMatches' :: [(Int, Int)] -> [Int] -> [(Int, Int)]
extendMatches' [] _ = []
extendMatches' _ [] = []
extendMatches' spans@((l, r):spans') xs@(x:xs') | r < x = (l, x) : extendMatches' spans' xs
| otherwise = extendMatches' spans xs'

65
XMonad/Prompt/Pass.hs
View File

@@ -8,10 +8,9 @@
-- Stability : unstable
-- Portability : unportable
--
-- This module provides 4 <XMonad.Prompt> to ease password manipulation (generate, read, remove):
-- This module provides 3 <XMonad.Prompt> to ease passwords manipulation (generate, read, remove):
--
-- - two to lookup passwords in the password-store; one of which copies to the
-- clipboard, and the other uses @xdotool@ to type the password directly.
-- - one to lookup passwords in the password-storage.
--
-- - one to generate a password for a given password label that the user inputs.
--
@@ -19,26 +18,28 @@
--
-- All those prompts benefit from the completion system provided by the module <XMonad.Prompt>.
--
-- The password store is setup through an environment variable PASSWORD_STORE_DIR,
-- or @$HOME\/.password-store@ if it is unset.
-- The password store is setuped through an environment variable PASSWORD_STORE_DIR.
-- If this is set, use the content of the variable.
-- Otherwise, the password store is located on user's home @$HOME\/.password-store@.
--
--
-- Source:
--
-- - The password store implementation is <http://git.zx2c4.com/password-store the password-store cli>.
-- - The password storage implementation is <http://git.zx2c4.com/password-store the password-store cli>.
--
-- - Inspired by <http://babushk.in/posts/combining-xmonad-and-pass.html>
-- - Inspired from <http://babushk.in/posts/combining-xmonad-and-pass.html>
--
-----------------------------------------------------------------------------
module XMonad.Prompt.Pass (
-- * Usage
-- $usage
-- * Usages
-- $usages
passPrompt
, passGeneratePrompt
, passRemovePrompt
, passTypePrompt
) where
import Control.Monad (liftM)
import XMonad.Core
import XMonad.Prompt ( XPrompt
, showXPrompt
@@ -53,32 +54,32 @@ import System.FilePath (takeExtension, dropExtension, combine)
import System.Posix.Env (getEnv)
import XMonad.Util.Run (runProcessWithInput)
-- $usage
-- $usages
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Prompt.Pass
--
-- Then add a keybinding for 'passPrompt', 'passGeneratePrompt' or 'passRemovePrompt':
--
-- > , ((modMask , xK_p) , passPrompt xpconfig)
-- > , ((modMask .|. controlMask, xK_p) , passGeneratePrompt xpconfig)
-- > , ((modMask .|. controlMask .|. shiftMask, xK_p), passRemovePrompt xpconfig)
-- > , ((modMask x , xK_p) , passPrompt xpconfig)
-- > , ((modMask x .|. controlMask, xK_p) , passGeneratePrompt xpconfig)
-- > , ((modMask x .|. controlMask .|. shiftMask, xK_p), passRemovePrompt xpconfig)
--
-- For detailed instructions on:
--
-- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".
--
-- - how to setup the password store, see <http://git.zx2c4.com/password-store/about/>
-- - how to setup the password storage, see <http://git.zx2c4.com/password-store/about/>
--
type Predicate = String -> String -> Bool
getPassCompl :: [String] -> Predicate -> String -> IO [String]
getPassCompl compls p s = return $ filter (p s) compls
getPassCompl compls p s = do return $ filter (p s) compls
type PromptLabel = String
newtype Pass = Pass PromptLabel
data Pass = Pass PromptLabel
instance XPrompt Pass where
showXPrompt (Pass prompt) = prompt ++ ": "
@@ -97,7 +98,7 @@ passwordStoreFolderDefault home = combine home ".password-store"
passwordStoreFolder :: IO String
passwordStoreFolder =
getEnv "PASSWORD_STORE_DIR" >>= computePasswordStoreDir
where computePasswordStoreDir Nothing = fmap passwordStoreFolderDefault getHomeDirectory
where computePasswordStoreDir Nothing = liftM passwordStoreFolderDefault getHomeDirectory
computePasswordStoreDir (Just storeDir) = return storeDir
-- | A pass prompt factory
@@ -125,41 +126,23 @@ passGeneratePrompt = mkPassPrompt "Generate password" generatePassword
passRemovePrompt :: XPConfig -> X ()
passRemovePrompt = mkPassPrompt "Remove password" removePassword
-- | A prompt to type in a password for a given entry.
-- This doesn't touch the clipboard.
--
passTypePrompt :: XPConfig -> X ()
passTypePrompt = mkPassPrompt "Type password" typePassword
-- | Select a password.
--
selectPassword :: String -> X ()
selectPassword passLabel = spawn $ "pass --clip \"" ++ escapeQuote passLabel ++ "\""
selectPassword passLabel = spawn $ "pass --clip " ++ passLabel
-- | Generate a 30 characters password for a given entry.
-- If the entry already exists, it is updated with a new password.
--
generatePassword :: String -> X ()
generatePassword passLabel = spawn $ "pass generate --force \"" ++ escapeQuote passLabel ++ "\" 30"
generatePassword passLabel = spawn $ "pass generate --force " ++ passLabel ++ " 30"
-- | Remove a password stored for a given entry.
--
removePassword :: String -> X ()
removePassword passLabel = spawn $ "pass rm --force \"" ++ escapeQuote passLabel ++ "\""
removePassword passLabel = spawn $ "pass rm --force " ++ passLabel
-- | Type a password stored for a given entry using xdotool.
--
typePassword :: String -> X ()
typePassword passLabel = spawn $ "pass \"" ++ escapeQuote passLabel
++ "\"|head -n1|tr -d '\n'|xdotool type --clearmodifiers --file -"
escapeQuote :: String -> String
escapeQuote = concatMap escape
where escape :: Char -> String
escape '"' = ['\\', '\"']
escape x = return x
-- | Retrieve the list of passwords from the password store 'passwordStoreDir
-- | Retrieve the list of passwords from the password storage 'passwordStoreDir
getPasswords :: FilePath -> IO [String]
getPasswords passwordStoreDir = do
files <- runProcessWithInput "find" [
@@ -167,7 +150,7 @@ getPasswords passwordStoreDir = do
"-type", "f",
"-name", "*.gpg",
"-printf", "%P\n"] []
return . map removeGpgExtension $ lines files
return $ map removeGpgExtension $ lines files
removeGpgExtension :: String -> String
removeGpgExtension file | takeExtension file == ".gpg" = dropExtension file

106
XMonad/Prompt/Unicode.hs
View File

@@ -1,7 +1,6 @@
{- |
Module : XMonad.Prompt.Unicode
Copyright : (c) 2016 Joachim Breitner
2017 Nick Hu
License : BSD-style (see LICENSE)
Maintainer : <mail@joachim-breitner.de>
@@ -10,18 +9,14 @@ Stability : stable
A prompt for searching unicode characters by name and inserting them into
the clipboard.
The provided @unicodePrompt@ and @typeUnicodePrompt@ use @xsel@ and @xdotool@
respectively.
Requires the file @\/usr\/share\/unicode\/UnicodeData.txt@ (shipped in the package
@unicode-data@ on Debian) and the @xsel@ tool.
-}
{-# LANGUAGE DeriveDataTypeable #-}
module XMonad.Prompt.Unicode (
-- * Usage
-- $usage
unicodePrompt,
typeUnicodePrompt,
mkUnicodePrompt
unicodePrompt
) where
import qualified Data.ByteString.Char8 as BS
@@ -38,23 +33,9 @@ import Data.List
import Text.Printf
import XMonad
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.Run
import XMonad.Prompt
data Unicode = Unicode
instance XPrompt Unicode where
showXPrompt Unicode = "Unicode: "
commandToComplete Unicode s = s
nextCompletion Unicode = getNextCompletion
newtype UnicodeData = UnicodeData { getUnicodeData :: [(Char, BS.ByteString)] }
deriving (Typeable, Read, Show)
instance ExtensionClass UnicodeData where
initialValue = UnicodeData []
extensionType = StateExtension
{- $usage
You can use this module by importing it, along with
@@ -65,61 +46,54 @@ You can use this module by importing it, along with
and adding an appropriate keybinding, for example:
> , ((modm .|. controlMask, xK_u), unicodePrompt "/path/to/unicode-data" def)
> , ((modm .|. controlMask, xK_u), unicodePrompt def)
More flexibility is given by the @mkUnicodePrompt@ function, which takes a
command and a list of arguments to pass as its first two arguments. See
@unicodePrompt@ for details.
-}
populateEntries :: String -> X Bool
populateEntries unicodeDataFilename = do
entries <- fmap getUnicodeData (XS.get :: X UnicodeData)
if null entries
then do
datE <- liftIO . tryIOError $ BS.readFile unicodeDataFilename
case datE of
Left e -> liftIO $ do
hPutStrLn stderr $ "Could not read file \"" ++ unicodeDataFilename ++ "\""
hPrint stderr e
hPutStrLn stderr "Do you have unicode-data installed?"
return False
Right dat -> do
XS.put . UnicodeData . sortBy (comparing (BS.length . snd)) $ parseUnicodeData dat
return True
else return True
unicodeDataFilename :: String
unicodeDataFilename = "/usr/share/unicode/UnicodeData.txt"
entries :: [(Char, BS.ByteString)]
entries = unsafePerformIO $ do
datE <- tryIOError $ BS.readFile unicodeDataFilename
case datE of
Left e -> do
hPutStrLn stderr $ "Could not read file \"" ++ unicodeDataFilename ++ "\""
hPutStrLn stderr $ show e
hPutStrLn stderr $ "Do you have unicode-data installed?"
return []
Right dat -> return $ sortBy (comparing (BS.length . snd)) $ parseUnicodeData dat
{-# NOINLINE entries #-}
parseUnicodeData :: BS.ByteString -> [(Char, BS.ByteString)]
parseUnicodeData = mapMaybe parseLine . BS.lines
where parseLine l = do
field1 : field2 : _ <- return $ BS.split ';' l
[(c,"")] <- return . readHex $ BS.unpack field1
return (chr c, field2)
where
parseLine l = do
field1 : field2 : _ <- return $ BS.split ';' l
[(c,"")] <- return $ readHex (BS.unpack field1)
return (chr c, field2)
searchUnicode :: [(Char, BS.ByteString)] -> String -> [(Char, String)]
searchUnicode entries s = map (second BS.unpack) $ filter go entries
where w = map BS.pack . filter (all isAscii) . filter ((> 1) . length) . words $ map toUpper s
searchUnicode :: String -> [(Char, String)]
searchUnicode s = map (second BS.unpack) $ filter go entries
where w = map BS.pack $ filter (all isAscii) $ filter ((> 1) . length) $ words $ map toUpper s
go (c,d) = all (`BS.isInfixOf` d) w
mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()
mkUnicodePrompt prog args unicodeDataFilename config =
whenX (populateEntries unicodeDataFilename) $ do
entries <- fmap getUnicodeData (XS.get :: X UnicodeData)
mkXPrompt Unicode config (unicodeCompl entries) paste
-- | Prompt the user for a unicode character to be inserted into the paste buffer of the X server.
unicodePrompt :: XPConfig -> X ()
unicodePrompt config = mkXPrompt Unicode config unicodeCompl paste
where
unicodeCompl _ [] = return []
unicodeCompl entries s = do
let m = searchUnicode entries s
return . map (\(c,d) -> printf "%s %s" [c] d) $ take 20 m
unicodeCompl [] = return []
unicodeCompl s = do
return $ map (\(c,d) -> printf "%s %s" [c] d) $ take 20 $ searchUnicode s
paste [] = return ()
paste (c:_) = do
runProcessWithInput prog args [c]
return ()
runProcessWithInput "xsel" ["-i"] [c]
return ()
-- | Prompt the user for a Unicode character to be inserted into the paste buffer of the X server.
unicodePrompt :: String -> XPConfig -> X ()
unicodePrompt = mkUnicodePrompt "xsel" ["-i"]
data Unicode = Unicode
instance XPrompt Unicode where
showXPrompt Unicode = "Unicode: "
commandToComplete Unicode s = s
nextCompletion Unicode = getNextCompletion
-- | Prompt the user for a Unicode character to be typed by @xdotool@.
typeUnicodePrompt :: String -> XPConfig -> X ()
typeUnicodePrompt = mkUnicodePrompt "xdotool" ["type", "--clearmodifiers", "--file", "-"]

66
XMonad/Prompt/Window.hs
View File

@@ -20,7 +20,6 @@ module XMonad.Prompt.Window
-- $usage
WindowPrompt(..),
windowPrompt,
windowMultiPrompt,
allWindows,
wsWindows,
XWindowMap,
@@ -31,7 +30,6 @@ module XMonad.Prompt.Window
windowPromptBringCopy,
) where
import Control.Monad (forM)
import qualified Data.Map as M
import qualified XMonad.StackSet as W
@@ -81,36 +79,7 @@ instance XPrompt WindowPrompt where
commandToComplete _ c = c
nextCompletion _ = getNextCompletion
-- | Internal type used for the multiple mode prompt.
data WindowModePrompt =
WindowModePrompt WindowPrompt (M.Map String Window) (String -> String -> Bool)
instance XPrompt WindowModePrompt where
showXPrompt (WindowModePrompt action _ _) =
showXPrompt action
completionFunction (WindowModePrompt _ winmap predicate) =
\s -> return . filter (predicate s) . map fst . M.toList $ winmap
modeAction (WindowModePrompt action winmap _) buf auto = do
let name = if null auto then buf else auto
a = case action of
Goto -> gotoAction winmap
Bring -> bringAction winmap
BringCopy -> bringCopyAction winmap
BringToMaster -> bringToMaster winmap
a name
where
winAction a m = flip whenJust (windows . a) . flip M.lookup m
gotoAction = winAction W.focusWindow
bringAction = winAction bringWindow
bringCopyAction = winAction bringCopyWindow
bringToMaster = winAction (\w s -> W.shiftMaster . W.focusWindow w $ bringWindow w s)
-- | 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 c = windowPrompt c Goto windowMap
windowPromptBring c = windowPrompt c Bring windowMap
@@ -137,31 +106,22 @@ type XWindowMap = X (M.Map String Window)
-- selected window, according to WindowPrompt.
windowPrompt :: XPConfig -> WindowPrompt -> XWindowMap -> X ()
windowPrompt c t winmap = do
a <- case t of
Goto -> fmap gotoAction winmap
Bring -> fmap bringAction winmap
BringCopy -> fmap bringCopyAction winmap
BringToMaster -> fmap bringToMaster winmap
wm <- winmap
let mode = WindowModePrompt t wm (searchPredicate c)
action = modeAction mode
compList = completionFunction mode
mkXPrompt t c compList (\s -> action s s)
mkXPrompt t c (compList wm) a
-- | Like 'windowPrompt', but uses the multiple modes feature of
-- @Prompt@ (via 'mkXPromptWithModes').
--
-- Given a list of actions along with the windows they should work
-- with, display the appropriate prompt with the ability to switch
-- between them using the @changeModeKey@.
--
-- For example, to have a prompt that first shows you all windows, but
-- allows you to narrow the list down to just the windows on the
-- current workspace:
--
-- > windowMultiPrompt config [(Goto, allWindows), (Goto, wsWindows)]
windowMultiPrompt :: XPConfig -> [(WindowPrompt, XWindowMap)] -> X ()
windowMultiPrompt c modes = do
modes' <- forM modes $ \(t, wm) -> do
wm' <- wm
return . XPT $ WindowModePrompt t wm' (searchPredicate c)
where
winAction a m = flip whenJust (windows . a) . flip M.lookup m
gotoAction = winAction W.focusWindow
bringAction = winAction bringWindow
bringCopyAction = winAction bringCopyWindow
bringToMaster = winAction (\w s -> W.shiftMaster . W.focusWindow w $ bringWindow w s)
mkXPromptWithModes modes' c
compList m s = return . filter (searchPredicate c s) . map fst . M.toList $ m
-- | Brings a copy of the specified window into the current workspace.
bringCopyWindow :: Window -> WindowSet -> WindowSet

30
XMonad/Util/CustomKeys.hs
View File

@@ -4,9 +4,11 @@
-- Copyright : (c) 2007 Valery V. Vorotyntsev
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Valery V. Vorotynsev <valery.vv@gmail.com>
--
-- Customized key bindings.
--
-- See also "XMonad.Util.EZConfig" in xmonad-contrib.
-- (See also "XMonad.Util.EZConfig" in xmonad-contrib.)
--------------------------------------------------------------------
module XMonad.Util.CustomKeys (
@@ -23,30 +25,38 @@ import qualified Data.Map as M
-- $usage
--
-- In @~\/.xmonad\/xmonad.hs@ add:
-- 1. In @~\/.xmonad\/xmonad.hs@ add:
--
-- > import XMonad.Util.CustomKeys
--
-- Set key bindings with 'customKeys':
-- 2. Set key bindings with 'customKeys':
--
-- > main = xmonad def { keys = customKeys delkeys inskeys }
-- > where
-- > delkeys :: XConfig l -> [(KeyMask, KeySym)]
-- > delkeys XConfig {modMask = modm} =
-- > [ (modm .|. shiftMask, xK_Return) -- > terminal
-- > , (modm .|. shiftMask, xK_c) -- > close the focused window
-- > ]
-- > ++
-- > [ (modm .|. m, k) | m <- [0, shiftMask], k <- [xK_w, xK_e, xK_r] ]
-- > -- we're preferring Futurama to Xinerama here
-- > [ (modm .|. m, k) | (m, k) <- zip [0, shiftMask] [xK_w, xK_e, xK_r] ]
-- >
-- > inskeys :: XConfig l -> [((KeyMask, KeySym), X ())]
-- > inskeys conf@(XConfig {modMask = modm}) =
-- > [ ((mod1Mask, xK_F2 ), spawn $ terminal conf) -- mod1-f2 %! Run a terminal emulator
-- > , ((modm, xK_Delete), kill) -- %! Close the focused window
-- > [ ((mod1Mask, xK_F2 ), spawn $ terminal conf)
-- > , ((modm .|. controlMask, xK_F11 ), spawn "xscreensaver-command -lock")
-- > , ((mod1Mask, xK_Down), spawn "amixer set Master 1-")
-- > , ((mod1Mask, xK_Up ), spawn "amixer set Master 1+")
-- > ]
--
-- 0 (/hidden feature/). You can always replace bindings map
-- entirely. No need to import "CustomKeys" this time:
--
-- > import XMonad
-- > import System.Exit
-- > import qualified Data.Map as M
-- >
-- > main = xmonad def {
-- > keys = \_ -> M.fromList [
-- > -- Let me out of here! I want my KDE back! Help! Help!
-- > ( (0, xK_Escape), io (exitWith ExitSuccess) ) ] }
-- | Customize 'XMonad.Config.def' -- delete needless
-- shortcuts and insert those you will use.

23
XMonad/Util/Dmenu.hs
View File

@@ -24,7 +24,6 @@ import XMonad
import qualified XMonad.StackSet as W
import qualified Data.Map as M
import XMonad.Util.Run
import Control.Monad (liftM)
-- $usage
-- You can use this module with the following in your Config.hs file:
@@ -42,32 +41,28 @@ import Control.Monad (liftM)
-- <http://www.jcreigh.com/dmenu/dmenu-3.2-xinerama.patch>
dmenuXinerama :: [String] -> X String
dmenuXinerama opts = do
curscreen <-
(fromIntegral . W.screen . W.current) `fmap` gets windowset :: X Int
_ <-
runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts)
curscreen <- (fromIntegral . W.screen . W.current) `fmap` gets windowset :: X Int
runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts)
menuArgs "dmenu" ["-xs", show (curscreen+1)] opts
-- | Run dmenu to select an option from a list.
dmenu :: MonadIO m => [String] -> m String
dmenu :: [String] -> X String
dmenu opts = menu "dmenu" opts
-- | like 'dmenu' but also takes the command to run.
menu :: MonadIO m => String -> [String] -> m String
menu :: String -> [String] -> X String
menu menuCmd opts = menuArgs menuCmd [] opts
-- | Like 'menu' but also takes a list of command line arguments.
menuArgs :: MonadIO m => String -> [String] -> [String] -> m String
menuArgs menuCmd args opts = liftM (filter (/='\n')) $
runProcessWithInput menuCmd args (unlines opts)
menuArgs :: String -> [String] -> [String] -> X String
menuArgs menuCmd args opts = fmap (filter (/='\n')) $ runProcessWithInput menuCmd args (unlines opts)
-- | Like 'dmenuMap' but also takes the command to run.
menuMap :: MonadIO m => String -> M.Map String a -> m (Maybe a)
menuMap :: String -> M.Map String a -> X (Maybe a)
menuMap menuCmd selectionMap = menuMapArgs menuCmd [] selectionMap
-- | Like 'menuMap' but also takes a list of command line arguments.
menuMapArgs :: MonadIO m => String -> [String] -> M.Map String a ->
m (Maybe a)
menuMapArgs :: String -> [String] -> M.Map String a -> X (Maybe a)
menuMapArgs menuCmd args selectionMap = do
selection <- menuFunction (M.keys selectionMap)
return $ M.lookup selection selectionMap
@@ -75,5 +70,5 @@ menuMapArgs menuCmd args selectionMap = do
menuFunction = menuArgs menuCmd args
-- | Run dmenu to select an entry from a map based on the key.
dmenuMap :: MonadIO m => M.Map String a -> m (Maybe a)
dmenuMap :: M.Map String a -> X (Maybe a)
dmenuMap selectionMap = menuMap "dmenu" selectionMap

53
XMonad/Util/Dzen.hs
View File

@@ -25,11 +25,6 @@ module XMonad.Util.Dzen (
x,
y,
addArgs,
fgColor,
bgColor,
align,
slaveAlign,
lineCount,
-- * Legacy interface
dzen,
@@ -46,7 +41,6 @@ import Control.Monad
import XMonad
import XMonad.StackSet
import XMonad.Util.Run (runProcessWithInputAndWait, seconds)
import XMonad.Util.Font (Align (..))
type DzenConfig = (Int, [String]) -> X (Int, [String])
@@ -122,45 +116,6 @@ x n = addArgs ["-x", show n]
y :: Int -> DzenConfig
y n = addArgs ["-y", show n]
-- | Set the foreground color.
--
-- Please be advised that @fgColor@ and @bgColor@ also exist in "XMonad.Prompt".
-- If you use both modules, you might have to tell the compiler which one you mean:
--
-- > import XMonad.Prompt as P
-- > import XMonad.Util.Dzen as D
-- >
-- > dzenConfig (D.fgColor "#f0f0f0") "foobar"
fgColor :: String -> DzenConfig
fgColor c = addArgs ["-fg", c]
-- | Set the background color.
bgColor :: String -> DzenConfig
bgColor c = addArgs ["-bg", c]
-- | Set the alignment of the title (main) window content.
-- Note that @AlignRightOffset@ is treated as equal to @AlignRight@.
--
-- > import XMonad.Util.Font (Align(..))
-- >
-- > dzenConfig (align AlignLeft) "foobar"
align :: Align -> DzenConfig
align = align' "-ta"
-- | Set the alignment of the slave window content.
-- Using this option only makes sense if you also use the @lineCount@ parameter.
slaveAlign :: Align -> DzenConfig
slaveAlign = align' "-sa"
-- Set an alignment parameter
align' :: String -> Align -> DzenConfig
align' opt a = addArgs [opt, s] where
s = case a of
AlignCenter -> "c"
AlignLeft -> "l"
AlignRight -> "r"
AlignRightOffset _ -> "r"
-- | Specify the font. Check out xfontsel to get the format of the String
-- right; if your dzen supports xft, then you can supply that here, too.
font :: String -> DzenConfig
@@ -205,14 +160,6 @@ detailFromScreenId sc ws = fmap screenRect maybeSD where
mapping = map (\s -> (screen s, screenDetail s)) (c:v)
maybeSD = lookup sc mapping
-- | Enable slave window and specify the number of lines.
--
-- Dzen can optionally draw a second window underneath the title window.
-- By default, this window is only displayed if the mouse enters the title window.
-- This option is only useful if the string you want to display contains more than one line.
lineCount :: Int -> DzenConfig
lineCount n = addArgs ["-l", show n]
-- | @dzen str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds.
-- Example usage:
--

6
XMonad/Util/EZConfig.hs
View File

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

23
XMonad/Util/ExtensibleState.hs
View File

@@ -27,7 +27,6 @@ module XMonad.Util.ExtensibleState (
import Data.Typeable (typeOf,cast)
import qualified Data.Map as M
import XMonad.Core
import XMonad.Util.PureX
import qualified Control.Monad.State as State
import Data.Maybe (fromMaybe)
@@ -76,29 +75,27 @@ import Data.Maybe (fromMaybe)
--
-- | Modify the map of state extensions by applying the given function.
modifyStateExts
:: XLike m
=> (M.Map String (Either String StateExtension)
-> M.Map String (Either String StateExtension))
-> m ()
modifyStateExts :: (M.Map String (Either String StateExtension)
-> M.Map String (Either String StateExtension))
-> X ()
modifyStateExts f = State.modify $ \st -> st { extensibleState = f (extensibleState st) }
-- | Apply a function to a stored value of the matching type or the initial value if there
-- is none.
modify :: (ExtensionClass a, XLike m) => (a -> a) -> m ()
modify :: ExtensionClass a => (a -> a) -> X ()
modify f = put . f =<< get
-- | Add a value to the extensible state field. A previously stored value with the same
-- type will be overwritten. (More precisely: A value whose string representation of its type
-- is equal to the new one's)
put :: (ExtensionClass a, XLike m) => a -> m ()
put :: ExtensionClass a => a -> X ()
put v = modifyStateExts . M.insert (show . typeOf $ v) . Right . extensionType $ v
-- | Try to retrieve a value of the requested type, return an initial value if there is no such value.
get :: (ExtensionClass a, XLike m) => m a
get :: ExtensionClass a => X a
get = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables
where toValue val = maybe initialValue id $ cast val
getState' :: (ExtensionClass a, XLike m) => a -> m a
getState' :: ExtensionClass a => a -> X a
getState' k = do
v <- State.gets $ M.lookup (show . typeOf $ k) . extensibleState
case v of
@@ -113,14 +110,14 @@ get = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables
[(x,"")] -> Just x
_ -> Nothing
gets :: (ExtensionClass a, XLike m) => (a -> b) -> m b
gets :: ExtensionClass a => (a -> b) -> X b
gets = flip fmap get
-- | Remove the value from the extensible state field that has the same type as the supplied argument
remove :: (ExtensionClass a, XLike m) => a -> m ()
remove :: ExtensionClass a => a -> X ()
remove wit = modifyStateExts $ M.delete (show . typeOf $ wit)
modified :: (ExtensionClass a, Eq a, XLike m) => (a -> a) -> m Bool
modified :: (ExtensionClass a, Eq a) => (a -> a) -> X Bool
modified f = do
v <- get
case f v of

16
XMonad/Util/Font.hs
View File

@@ -29,7 +29,6 @@ module XMonad.Util.Font
, textExtentsXMF
, printStringXMF
, stringToPixel
, pixelToString
, fi
) where
@@ -38,8 +37,6 @@ import Foreign
import Control.Applicative
import Control.Exception as E
import Data.Maybe
import Data.Bits (shiftR)
import Text.Printf (printf)
#ifdef XFT
import Data.List
@@ -64,19 +61,6 @@ stringToPixel d s = fromMaybe fallBack <$> io getIt
where getIt = initColor d s
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 = const

37
XMonad/Util/Minimize.hs
View File

@@ -1,37 +0,0 @@
{-# LANGUAGE DeriveDataTypeable #-}
----------------------------------------------------------------------------
-- |
-- Module : XMonad.Util.Minimize
-- Copyright : (c) Bogdan Sinitsyn (2016)
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : bogdan.sinitsyn@gmail.com
-- Stability : unstable
-- Portability : not portable
--
-- Stores some common utilities for modules used for window minimizing/maximizing
--
-----------------------------------------------------------------------------
module XMonad.Util.Minimize
( RectMap
, Minimized(..)
) where
import XMonad
import qualified XMonad.StackSet as W
import qualified Data.Map as M
type RectMap = M.Map Window (Maybe W.RationalRect)
data Minimized = Minimized
{ rectMap :: RectMap
, minimizedStack :: [Window]
}
deriving (Eq, Typeable, Read, Show)
instance ExtensionClass Minimized where
initialValue = Minimized { rectMap = M.empty
, minimizedStack = []
}
extensionType = PersistentExtension

276
XMonad/Util/PureX.hs
View File

@@ -1,276 +0,0 @@
{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Util.PureX
-- Copyright : L. S. Leary 2018
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : L. S. Leary
-- Stability : unstable
-- Portability : not portable
--
-- Unlike the opaque @IO@ actions that @X@ actions can wrap, regular reads from
-- the 'XConf' and modifications to the 'XState' are fundamentally pure—contrary
-- to the current treatment of such actions in most xmonad code. Pure
-- modifications to the 'WindowSet' can be readily composed, but due to the need
-- for those modifications to be properly handled by 'windows', other pure
-- changes to the @XState@ cannot be interleaved with those changes to the
-- @WindowSet@ without superfluous refreshes, hence breaking composability.
--
-- This module aims to rectify that situation by drawing attention to it and
-- providing 'PureX': a pure type with the same monadic interface to state as
-- @X@. The 'XLike' typeclass enables writing actions generic over the two
-- monads; if pure, existing @X@ actions can be generalised with only a change
-- to the type signature. Various other utilities are provided, in particular
-- the 'defile' function which is needed by end-users.
--
-----------------------------------------------------------------------------
-- --< Imports & Exports >-- {{{
module XMonad.Util.PureX (
-- * Usage
-- $Usage
PureX, XLike(..), defile,
windowBracket', handlingRefresh,
runPureX, toXLike,
-- * Utility
-- ** Generalised when* functions
when', whenM', whenJust',
-- ** Infix operators
(<?), (&>),
-- ** @WindowSet@ operations
withWindowSet', withFocii,
modify'', modifyWindowSet',
getStack, putStack, peek,
view, greedyView, invisiView,
shift, curScreen, curWorkspace,
curTag, curScreenId,
) where
-- xmonad
import XMonad
import qualified XMonad.StackSet as W
-- mtl
import Control.Monad.State
import Control.Monad.Reader
-- base
import Data.Semigroup (Semigroup(..), Any(..))
import Control.Applicative (liftA2)
-- }}}
-- --< Usage >-- {{{
-- $Usage
--
-- The suggested pattern of usage for this module is to write composable, pure
-- actions as @XLike m => m Any@ or @PureX Any@ values, where the encapsulated
-- @Any@ value encodes whether or not a refresh is needed to properly institute
-- changes. These values can then be combined monoidally (i.e. with '<>' AKA
-- '<+>') or with operators such as '<*', '*>', '<?' and '&>' to build seamless
-- new actions. The end user can run and handle the effects of the pure actions
-- in the @X@ monad by applying the @defile@ function, which you may want to
-- re-export. Alternatively, if an action does not make stackset changes that
-- need to be handled by @windows@, it can be written with as an
-- @XLike m => m ()@ and used directly.
--
-- Unfortunately since layouts must handle messages in the @X@ monad, this
-- approach does not quite apply to actions involving them. However a relatively
-- direct translation to impure actions is possible: you can write composable,
-- refresh-tracking actions as @X Any@ values, making sure to eschew
-- refresh-inducing functions like @windows@ and @sendMessage@ in favour of
-- 'modifyWindowSet' and utilities provided by "XMonad.Actions.MessageFeedback".
-- The 'windowBracket_' function recently added to "XMonad.Operations" is the
-- impure analogue of @defile@. Note that @PureX Any@ actions can be composed
-- into impure ones after applying 'toX'; don't use @defile@ for this. E.g.
--
-- > windowBracket_ (composableImpureAction <> toX composablePureAction)
--
-- Although both @X@ and @PureX@ have Monoid instances over monoidal values,
-- @(XLike m, Monoid a)@ is not enough to infer @Monoid (m a)@ (due to the
-- open-world assumption). Hence a @Monoid (m Any)@ constraint may need to be
-- used when working with @XLike m => m Any@ where no context is forcing @m@ to
-- unify with @X@ or @PureX@. This can also be avoided by working with
-- @PureX Any@ values and generalising them with 'toXLike' where necessary.
--
-- @PureX@ also enables a more monadic style when writing windowset operations;
-- see the implementation of the utilities in this module for examples.
-- For an example of a whole module written in terms of this one, see
-- "XMonad.Hooks.RefocusLast".
--
-- }}}
-- --< Core >-- {{{
-- | The @PureX@ newtype over @ReaderT XConf (State XState) a@.
newtype PureX a = PureX (ReaderT XConf (State XState) a)
deriving (Functor, Applicative, Monad, MonadReader XConf, MonadState XState)
instance Semigroup a => Semigroup (PureX a) where
(<>) = liftA2 (<>)
instance Monoid a => Monoid (PureX a) where
mappend = liftA2 mappend
mempty = return mempty
-- | The @XLike@ typeclass over monads reading @XConf@ values and tracking
-- @XState@ state.
class (MonadReader XConf m, MonadState XState m) => XLike m where
toX :: m a -> X a
instance XLike X where
toX = id
instance XLike PureX where
toX = toXLike
-- | Consume a @PureX a@.
runPureX :: PureX a -> XConf -> XState -> (a, XState)
runPureX (PureX m) = runState . runReaderT m
-- | Despite appearing less general, @PureX a@ is actually isomorphic to
-- @XLike m => m a@.
toXLike :: XLike m => PureX a -> m a
toXLike pa = state =<< runPureX pa <$> ask
-- | A generalisation of 'windowBracket'. Handles refreshing for an action that
-- __performs no refresh of its own__ but can indicate that it needs one
-- through a return value that's tested against the supplied predicate. The
-- action can interleave changes to the @WindowSet@ with @IO@ or changes to
-- the @XState@.
windowBracket' :: XLike m => (a -> Bool) -> m a -> X a
windowBracket' p = windowBracket p . toX
-- | A version of @windowBracket'@ specialised to take a @PureX Any@ action and
-- handle windowset changes with a refresh when the @Any@ holds @True@.
-- Analogous to 'windowBracket_'. Don't bake this into your action; it's for
-- the end-user.
defile :: PureX Any -> X ()
defile = void . windowBracket' getAny
-- | A version of @windowBracket@ specialised to take an @X ()@ action and
-- perform a refresh handling any changes it makes.
handlingRefresh :: X () -> X ()
handlingRefresh = windowBracket (\_ -> True)
-- }}}
-- --< Utility >-- {{{
-- | A 'when' that accepts a monoidal return value.
when' :: (Monad m, Monoid a) => Bool -> m a -> m a
when' b ma = if b then ma else return mempty
-- | A @whenX@/@whenM@ that accepts a monoidal return value.
whenM' :: (Monad m, Monoid a) => m Bool -> m a -> m a
whenM' mb m = when' <$> mb >>= ($ m)
-- | A 'whenJust' that accepts a monoidal return value.
whenJust' :: (Monad m, Monoid b) => Maybe a -> (a -> m b) -> m b
whenJust' = flip $ maybe (return mempty)
-- | Akin to @<*@. Discarding the wrapped value in the second argument either
-- way, keep its effects iff the first argument returns @Any True@.
(<?) :: Monad m => m Any -> m a -> m Any
ifthis <? thenthis = do
Any b <- ifthis
when' b (Any b <$ thenthis)
infixl 4 <?
-- | Akin to a low precedence @<>@. Combines applicative effects left-to-right
-- and wrapped @Bool@s with @&&@ (instead of @||@).
(&>) :: Applicative f => f Any -> f Any -> f Any
(&>) = liftA2 $ \(Any b1) (Any b2) -> Any (b1 && b2)
infixl 1 &>
-- | A generalisation of 'withWindowSet'.
withWindowSet' :: XLike m => (WindowSet -> m a) -> m a
withWindowSet' = (=<< gets windowset)
-- | If there is a current tag and a focused window, perform an operation with
-- them, otherwise return mempty.
withFocii :: (XLike m, Monoid a) => (WorkspaceId -> Window -> m a) -> m a
withFocii f = join $ (whenJust' <$> peek) <*> (f <$> curTag)
-- | A generalisation of 'modifyWindowSet'.
modifyWindowSet' :: XLike m => (WindowSet -> WindowSet) -> m ()
modifyWindowSet' f = modify $ \xs -> xs { windowset = f (windowset xs) }
-- | A variant of @W.modify@ and @W.modify'@ handling the @Nothing@ and @Just@
-- cases uniformly.
modify''
:: (Maybe (W.Stack a) -> Maybe (W.Stack a))
-> (W.StackSet i l a s sd -> W.StackSet i l a s sd)
modify'' f = W.modify (f Nothing) (f . Just)
-- | Get the stack from the current workspace.
getStack :: XLike m => m (Maybe (W.Stack Window))
getStack = W.stack <$> curWorkspace
-- | Set the stack on the current workspace.
putStack :: XLike m => Maybe (W.Stack Window) -> m ()
putStack mst = modifyWindowSet' . modify'' $ \_ -> mst
-- | Get the focused window if there is one.
peek :: XLike m => m (Maybe Window)
peek = withWindowSet' (return . W.peek)
-- | Get the current screen.
curScreen
:: XLike m
=> m (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
curScreen = withWindowSet' (return . W.current)
-- | Get the current workspace.
curWorkspace :: XLike m => m WindowSpace
curWorkspace = W.workspace <$> curScreen
-- | Get the current tag.
curTag :: XLike m => m WorkspaceId
curTag = W.tag <$> curWorkspace
-- | Get the current @ScreenId@.
curScreenId :: XLike m => m ScreenId
curScreenId = W.screen <$> curScreen
-- | Internal. Refresh-tracking logic of view operations.
viewWith
:: XLike m => (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> m Any
viewWith viewer tag = do
itag <- curTag
when' (tag /= itag) $ do
modifyWindowSet' (viewer tag)
Any . (tag ==) <$> curTag
-- | A version of @W.view@ that tracks the need to refresh.
view :: XLike m => WorkspaceId -> m Any
view = viewWith W.view
-- | A version of @W.greedyView@ that tracks the need to refresh.
greedyView :: XLike m => WorkspaceId -> m Any
greedyView = viewWith W.greedyView
-- | View a workspace if it's not visible. An alternative to @view@ and
-- @greedyView@ that—rather than changing the current screen or affecting
-- another—opts not to act.
invisiView :: XLike m => WorkspaceId -> m Any
invisiView = viewWith $ \tag ws ->
if tag `elem` (W.tag . W.workspace <$> W.current ws : W.visible ws)
then W.view tag ws
else ws
-- | A refresh-tracking version of @W.Shift@.
shift :: XLike m => WorkspaceId -> m Any
shift tag = withFocii $ \ctag fw ->
when' (tag /= ctag) $ do
modifyWindowSet' (W.shiftWin tag fw)
mfw' <- peek
return (Any $ Just fw /= mfw')
-- }}}

214
XMonad/Util/Rectangle.hs
View File

@@ -1,214 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Util.Rectangle
-- Copyright : (c) 2018 Yclept Nemo
-- License : BSD-style (see LICENSE)
--
-- Maintainer :
-- Stability : unstable
-- Portability : unportable
--
-- A module for handling pixel rectangles: 'Rectangle'.
--
-----------------------------------------------------------------------------
module XMonad.Util.Rectangle
( -- * Usage
-- $usage
PointRectangle (..)
, pixelsToIndices, pixelsToCoordinates
, indicesToRectangle, coordinatesToRectangle
, empty
, intersects
, supersetOf
, difference
, withBorder
, center
, toRatio
) where
import XMonad
import qualified XMonad.StackSet as W
import Data.Ratio
-- $usage
-- > import XMonad.Util.Rectangle as R
-- > R.empty (Rectangle 0 0 1024 768)
-- | Rectangle as two points. What those points mean depends on the conversion
-- function.
data PointRectangle a = PointRectangle
{ point_x1::a -- ^ Point nearest to the origin.
, point_y1::a
, point_x2::a -- ^ Point furthest from the origin.
, point_y2::a
} deriving (Eq,Read,Show)
-- | There are three possible ways to convert rectangles to pixels:
--
-- * Consider integers as "gaps" between pixels; pixels range from @(N,N+1)@,
-- exclusively: @(0,1)@, @(1,2)@, and so on. This leads to interval ambiguity:
-- whether an integer endpoint contains a pixel depends on which direction the
-- interval approaches the pixel. Consider the adjacent pixels @(0,1)@ and
-- @(1,2)@ where @1@ can refer to either pixel @(0,1)@ or pixel @(1,2)@.
--
-- * Consider integers to demarcate the start of each pixel; pixels range from
-- @[N,N+1)@: @[0,1)@, @[1,2)@, and so on - or equivalently: @(N,N+1]@. This is
-- the most flexible coordinate system, and the convention used by the
-- 'Rectangle' type.
--
-- * Consider integers to demarcate the center of each pixel; pixels range from
-- @[N,N+1]@, as though each real-valued coordinate had been rounded (either
-- down or up) to the nearest integers. So each pixel, from zero, is listed as:
-- @[0,0]@, @[1,1]@, @[2,2]@, and so on. Rather than a coordinate system, this
-- considers pixels as row/colum indices. While easiest to reason with,
-- indices are unable to represent zero-dimension rectangles.
--
-- Consider pixels as indices. Do not use this on empty rectangles.
pixelsToIndices :: Rectangle -> (PointRectangle Integer)
pixelsToIndices (Rectangle px py dx dy) =
PointRectangle (fromIntegral px)
(fromIntegral py)
(fromIntegral px + fromIntegral dx - 1)
(fromIntegral py + fromIntegral dy - 1)
-- | Consider pixels as @[N,N+1)@ coordinates. Available for empty rectangles.
pixelsToCoordinates :: Rectangle -> (PointRectangle Integer)
pixelsToCoordinates (Rectangle px py dx dy) =
PointRectangle (fromIntegral px)
(fromIntegral py)
(fromIntegral px + fromIntegral dx)
(fromIntegral py + fromIntegral dy)
-- | Invert 'pixelsToIndices'.
indicesToRectangle :: (PointRectangle Integer) -> Rectangle
indicesToRectangle (PointRectangle x1 y1 x2 y2) =
Rectangle (fromIntegral x1)
(fromIntegral y1)
(fromIntegral $ x2 - x1 + 1)
(fromIntegral $ y2 - y1 + 1)
-- | Invert 'pixelsToCoordinates'.
coordinatesToRectangle :: (PointRectangle Integer) -> Rectangle
coordinatesToRectangle (PointRectangle x1 y1 x2 y2) =
Rectangle (fromIntegral x1)
(fromIntegral y1)
(fromIntegral $ x2 - x1)
(fromIntegral $ y2 - y1)
-- | True if either the 'rect_width' or 'rect_height' fields are zero, i.e. the
-- rectangle has no area.
empty :: Rectangle -> Bool
empty (Rectangle _ _ _ 0) = True
empty (Rectangle _ _ 0 _) = True
empty (Rectangle _ _ _ _) = False
-- | True if the intersection of the set of points comprising each rectangle is
-- not the empty set. Therefore any rectangle containing the initial points of
-- an empty rectangle will never intersect that rectangle - including the same
-- empty rectangle.
intersects :: Rectangle -> Rectangle -> Bool
intersects r1 r2 | empty r1 || empty r2 = False
| otherwise = r1_x1 < r2_x2
&& r1_x2 > r2_x1
&& r1_y1 < r2_y2
&& r1_y2 > r2_y1
where PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = pixelsToCoordinates r1
PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = pixelsToCoordinates r2
-- | True if the first rectangle contains at least all the points of the second
-- rectangle. Any rectangle containing the initial points of an empty rectangle
-- will be a superset of that rectangle - including the same empty rectangle.
supersetOf :: Rectangle -> Rectangle -> Bool
supersetOf r1 r2 = r1_x1 <= r2_x1
&& r1_y1 <= r2_y1
&& r1_x2 >= r2_x2
&& r1_y2 >= r2_y2
where PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = pixelsToCoordinates r1
PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = pixelsToCoordinates r2
-- | Return the smallest set of rectangles resulting from removing all the
-- points of the second rectangle from those of the first, i.e. @r1 - r2@, such
-- that @0 <= l <= 4@ where @l@ is the length of the resulting list.
difference :: Rectangle -> Rectangle -> [Rectangle]
difference r1 r2 | r1 `intersects` r2 = map coordinatesToRectangle $
concat [rt,rr,rb,rl]
| otherwise = [r1]
where PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = pixelsToCoordinates r1
PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = pixelsToCoordinates r2
-- top - assuming (0,0) is top-left
rt = if r2_y1 > r1_y1 && r2_y1 < r1_y2
then [PointRectangle (max r2_x1 r1_x1) r1_y1 r1_x2 r2_y1]
else []
-- right
rr = if r2_x2 > r1_x1 && r2_x2 < r1_x2
then [PointRectangle r2_x2 (max r2_y1 r1_y1) r1_x2 r1_y2]
else []
-- bottom
rb = if r2_y2 > r1_y1 && r2_y2 < r1_y2
then [PointRectangle r1_x1 r2_y2 (min r2_x2 r1_x2) r1_y2]
else []
-- left
rl = if r2_x1 > r1_x1 && r2_x1 < r1_x2
then [PointRectangle r1_x1 r1_y1 r2_x1 (min r2_y2 r1_y2)]
else []
-- | Fit a 'Rectangle' within the given borders of itself. Given insufficient
-- space, borders are minimized while preserving the ratio of opposite borders.
-- Origin is top-left, and yes, negative borders are allowed.
withBorder :: Integer -- ^ Top border.
-> Integer -- ^ Bottom border.
-> Integer -- ^ Right border.
-> Integer -- ^ Left border.
-> Integer -- ^ Smallest allowable rectangle dimensions, i.e.
-- width/height, with values @<0@ defaulting to @0@.
-> Rectangle -> Rectangle
withBorder t b r l i (Rectangle x y w h) =
let -- conversions
w' = fromIntegral w
h' = fromIntegral h
-- minimum window dimensions
i' = max i 0
iw = min i' w'
ih = min i' h'
-- maximum border dimensions
bh = w' - iw
bv = h' - ih
-- scaled border ratios
rh = if l + r <= 0
then 1
else min 1 $ bh % (l + r)
rv = if t + b <= 0
then 1
else min 1 $ bv % (t + b)
-- scaled border pixels
t' = truncate $ rv * fromIntegral t
b' = truncate $ rv * fromIntegral b
r' = truncate $ rh * fromIntegral r
l' = truncate $ rh * fromIntegral l
in Rectangle (x + l')
(y + t')
(w - r' - fromIntegral l')
(h - b' - fromIntegral t')
-- | Calculate the center - @(x,y)@ - as if the 'Rectangle' were bounded.
center :: Rectangle -> (Ratio Integer,Ratio Integer)
center (Rectangle x y w h) = (cx,cy)
where cx = fromIntegral x + (fromIntegral w) % 2
cy = fromIntegral y + (fromIntegral h) % 2
-- | Invert 'scaleRationalRect'. Since that operation is lossy a roundtrip
-- conversion may not result in the original value. The first 'Rectangle' is
-- scaled to the second:
--
-- >>> (Rectangle 2 2 6 6) `toRatio` (Rectangle 0 0 10 10)
-- RationalRect (1 % 5) (1 % 5) (3 % 5) (3 % 5)
toRatio :: Rectangle -> Rectangle -> W.RationalRect
toRatio (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2) =
let [x1n,y1n,x2n,y2n] = map fromIntegral [x1,y1,x2,y2]
[w1n,h1n,w2n,h2n] = map fromIntegral [w1,h1,w2,h2]
in W.RationalRect ((x1n-x2n)/w2n) ((y1n-y2n)/h2n) (w1n/w2n) (h1n/h2n)

64
XMonad/Util/SessionStart.hs
View File

@@ -1,64 +0,0 @@
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Util.SessionStart
-- Copyright : (c) Markus Ongyerth 2017
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : markus@ongy.net
-- Stability : unstable
-- Portability : not portable
--
-- A module for detectiong session startup. Useful to start
-- status bars, compositors and session initialization.
-- This is a more general approach than spawnOnce and allows spawnOn etc.
-----------------------------------------------------------------------------
module XMonad.Util.SessionStart
( doOnce
, isSessionStart
, setSessionStarted
)
where
import Control.Monad (when)
import Control.Applicative ((<$>))
import XMonad
import qualified XMonad.Util.ExtensibleState as XS
-- ---------------------------------------------------------------------
-- $usage
--
-- Add 'setSessionStarted' at the end of the 'startupHook' to set the
-- flag.
--
-- To do something only when the session is started up, use
-- 'isSessionStart' to query or wrap it in 'doOnce' to only do it when
-- the flag isn't set.
-- ---------------------------------------------------------------------
data SessionStart = SessionStart { unSessionStart :: Bool }
deriving (Read, Show, Typeable)
instance ExtensionClass SessionStart where
initialValue = SessionStart True
extensionType = PersistentExtension
-- | Use this to only do a part of your hook on session start
doOnce :: X () -> X ()
doOnce act = do
startup <- isSessionStart
when startup act
-- | Query if the current startup is the session start
isSessionStart :: X Bool
isSessionStart = unSessionStart <$> XS.get
-- This should become a noop/be deprecated when merged into master, and
-- the flag should be set when the state file is loaded.
-- | This currently has to be added to the end of the startup hook to
-- set the flag.
setSessionStarted :: X ()
setSessionStarted = XS.put $ SessionStart False

37
XMonad/Util/SpawnOnce.hs
View File

@@ -15,10 +15,9 @@
--
-----------------------------------------------------------------------------
module XMonad.Util.SpawnOnce (spawnOnce, spawnOnOnce, spawnNOnOnce, spawnAndDoOnce) where
module XMonad.Util.SpawnOnce (spawnOnce) where
import XMonad
import XMonad.Actions.SpawnOn
import Data.Set as Set
import qualified XMonad.Util.ExtensibleState as XS
import Control.Monad
@@ -30,31 +29,11 @@ instance ExtensionClass SpawnOnce where
initialValue = SpawnOnce Set.empty
extensionType = PersistentExtension
doOnce :: (String -> X ()) -> String -> X ()
doOnce f s = do
b <- XS.gets (Set.member s . unspawnOnce)
when (not b) $ do
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.
-- | 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
spawnOnce xs = do
b <- XS.gets (Set.member xs . unspawnOnce)
when (not b) $ do
spawn xs
XS.modify (SpawnOnce . Set.insert xs . unspawnOnce)

31
XMonad/Util/Stack.hs
View File

@@ -38,8 +38,6 @@ module XMonad.Util.Stack ( -- * Usage
, focusUpZ
, focusDownZ
, focusMasterZ
, findS
, findZ
-- ** Extraction
, getFocusZ
, getIZ
@@ -75,13 +73,10 @@ module XMonad.Util.Stack ( -- * Usage
, mapE_
, mapEM
, mapEM_
, reverseS
, reverseZ
) where
import qualified XMonad.StackSet as W
import Control.Applicative ((<|>),(<$>),(<$))
import Control.Monad (guard,liftM)
import Control.Monad (liftM)
import Data.List (sortBy)
@@ -180,22 +175,6 @@ focusMasterZ (Just (W.Stack f up down)) | not $ null up
= Just $ W.Stack (last up) [] (reverse (init up) ++ [f] ++ down)
focusMasterZ (Just s) = Just s
-- | Refocus a @Stack a@ on an element satisfying the predicate, or fail to
-- @Nothing@.
findS :: Eq a => (a -> Bool) -> W.Stack a -> Maybe (W.Stack a)
findS p st = st <$ (guard . p . W.focus) st <|> findUp st <|> findDown st
where findDown = reverseZ . findUp . reverseS
findUp s | u:ups <- W.up s = (if p u then Just else findUp)
$ W.Stack u ups (W.focus s : W.down s)
| otherwise = Nothing
-- | Refocus a @Zipper a@ on an element satisfying the predicate, or fail to
-- @Nothing@. Never returns @Just Nothing@, so the second layer of @Maybe@ is
-- actually redundant.
findZ :: Eq a => (a -> Bool) -> Zipper a -> Maybe (Zipper a)
findZ _ Nothing = Nothing
findZ p (Just st) = Just <$> findS p st
-- ** Extraction
-- | Get the focused element
@@ -359,11 +338,3 @@ fromE (Left a) = a
-- | Tag the element with 'Right' if the property is true, 'Left' otherwise
tagBy :: (a -> Bool) -> a -> Either a a
tagBy p a = if p a then Right a else Left a
-- | Reverse a @Stack a@; O(1).
reverseS :: W.Stack a -> W.Stack a
reverseS (W.Stack foc ups downs) = W.Stack foc downs ups
-- | Reverse a @Zipper a@; O(1).
reverseZ :: Zipper a -> Zipper a
reverseZ = (reverseS <$>)

18
XMonad/Util/Themes.hs
View File

@@ -20,7 +20,6 @@ module XMonad.Util.Themes
, xmonadTheme
, smallClean
, robertTheme
, darkTheme
, deiflTheme
, oxymor00nTheme
, donaldTheme
@@ -91,7 +90,6 @@ ppThemeInfo t = themeName t <> themeDescription t <> "by" <> themeAuthor t
listOfThemes :: [ThemeInfo]
listOfThemes = [ xmonadTheme
, smallClean
, darkTheme
, deiflTheme
, oxymor00nTheme
, robertTheme
@@ -165,22 +163,6 @@ robertTheme =
}
}
-- | Dark Theme, by Lucian Poston.
darkTheme :: ThemeInfo
darkTheme =
newTheme { themeName = "darkTheme"
, themeAuthor = "Lucian Poston"
, themeDescription = "Dark Theme"
, theme = def { inactiveBorderColor = "#202030"
, activeBorderColor = "#a0a0d0"
, inactiveColor = "#000000"
, activeColor = "#000000"
, inactiveTextColor = "#607070"
, activeTextColor = "#a0d0d0"
, decoHeight = 15
}
}
-- | deifl\'s Theme, by deifl.
deiflTheme :: ThemeInfo
deiflTheme =

8
XMonad/Util/WindowProperties.hs
View File

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

32
XMonad/Util/WorkspaceCompare.hs
View File

@@ -25,10 +25,10 @@ module XMonad.Util.WorkspaceCompare ( WorkspaceCompare, WorkspaceSort
import XMonad
import qualified XMonad.StackSet as S
import Data.List
import Data.Monoid
import Data.Ord
import Data.Maybe
import Data.Monoid (mconcat)
import XMonad.Actions.PhysicalScreens (ScreenComparator(ScreenComparator), getScreenIdAndRectangle, screenComparatorById)
import Data.Function (on)
import Data.Function
type WorkspaceCompare = WorkspaceId -> WorkspaceId -> Ordering
type WorkspaceSort = [WindowSpace] -> [WindowSpace]
@@ -64,22 +64,28 @@ getWsCompareByTag = return compare
-- and screen id. It produces the same ordering as
-- 'XMonad.Hooks.DynamicLog.pprWindowSetXinerama'.
getXineramaWsCompare :: X WorkspaceCompare
getXineramaWsCompare = getXineramaPhysicalWsCompare $ screenComparatorById compare
getXineramaWsCompare = getXineramaWsCompare' False
-- | A comparison function like 'getXineramaWsCompare', but uses physical locations for screens.
getXineramaPhysicalWsCompare :: ScreenComparator -> X WorkspaceCompare
getXineramaPhysicalWsCompare (ScreenComparator sc) = do
getXineramaPhysicalWsCompare :: X WorkspaceCompare
getXineramaPhysicalWsCompare = getXineramaWsCompare' True
getXineramaWsCompare' :: Bool -> X WorkspaceCompare
getXineramaWsCompare' phy = do
w <- gets windowset
return $ \ a b -> case (isOnScreen a w, isOnScreen b w) of
(True, True) -> compareUsingScreen w a b
(True, True) -> cmpPosition phy w a b
(False, False) -> compare a b
(True, False) -> LT
(False, True) -> GT
where
onScreen w = S.current w : S.visible w
isOnScreen a w = a `elem` map (S.tag . S.workspace) (onScreen w)
tagToScreen s x = fromJust $ find ((== x) . S.tag . S.workspace) s
compareUsingScreen w = sc `on` getScreenIdAndRectangle . tagToScreen (onScreen w)
tagToSid s x = S.screen $ fromJust $ find ((== x) . S.tag . S.workspace) s
cmpPosition False w a b = comparing (tagToSid $ onScreen w) a b
cmpPosition True w a b = comparing (rect.(tagToSid $ onScreen w)) a b
where rect i = let (Rectangle x y _ _) = screens !! fromIntegral i in (y,x)
screens = map (screenRect . S.screenDetail) $ sortBy (comparing S.screen) $ S.current w : S.visible w
-- | Create a workspace sorting function from a workspace comparison
-- function.
@@ -103,6 +109,8 @@ getSortByTag = mkWsSort getWsCompareByTag
-- sorted by tag.
getSortByXineramaRule :: X WorkspaceSort
getSortByXineramaRule = mkWsSort getXineramaWsCompare
-- | Like 'getSortByXineramaRule', but allow you to use physical locations for screens.
getSortByXineramaPhysicalRule :: ScreenComparator -> X WorkspaceSort
getSortByXineramaPhysicalRule sc = mkWsSort $ getXineramaPhysicalWsCompare sc
-- | Like 'getSortByXineramaRule', but uses physical locations for screens.
getSortByXineramaPhysicalRule :: X WorkspaceSort
getSortByXineramaPhysicalRule = mkWsSort getXineramaPhysicalWsCompare

2
XMonad/Util/XUtils.hs
View File

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

3
cabal.project
View File

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

9
stack.yaml
View File

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

65
xmonad-contrib.cabal
View File

@@ -1,5 +1,5 @@
name: xmonad-contrib
version: 0.15
version: 0.12
homepage: http://xmonad.org/
synopsis: Third party extensions for xmonad
description:
@@ -31,12 +31,14 @@ extra-source-files: README.md CHANGES.md scripts/generate-configs scripts/run-xm
tests/SwapWorkspaces.hs
tests/XPrompt.hs
XMonad/Config/dmwit.xmobarrc
XMonad/Config/Example.hs
cabal-version: >= 1.6
build-type: Simple
bug-reports: https://github.com/xmonad/xmonad-contrib/issues
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1
tested-with:
GHC==7.6.3,
GHC==7.8.4,
GHC==7.10.2
source-repository head
type: git
@@ -54,7 +56,7 @@ flag testing
library
build-depends: base >= 4.5 && < 5,
bytestring >= 0.10 && < 0.11,
containers >= 0.5 && < 0.7,
containers >= 0.5 && < 0.6,
directory,
extensible-exceptions,
filepath,
@@ -64,10 +66,9 @@ library
random,
mtl >= 1 && < 3,
unix,
X11>=1.6.1 && < 1.10,
xmonad >= 0.15 && < 0.16,
utf8-string,
semigroups
X11>=1.7 && < 1.8,
xmonad>=0.12 && < 0.13,
utf8-string
if flag(use_xft)
build-depends: X11-xft >= 0.2
@@ -82,22 +83,25 @@ library
if impl(ghc >= 6.12.1)
ghc-options: -fno-warn-unused-do-bind
exposed-modules: XMonad.Actions.AfterDrag
exposed-modules: XMonad.Doc
XMonad.Doc.Configuring
XMonad.Doc.Extending
XMonad.Doc.Developing
XMonad.Actions.AfterDrag
XMonad.Actions.BluetileCommands
XMonad.Actions.Commands
XMonad.Actions.ConstrainedResize
XMonad.Actions.CopyWindow
XMonad.Actions.CycleRecentWS
XMonad.Actions.CycleSelectedLayouts
XMonad.Actions.CycleWS
XMonad.Actions.CycleWindows
XMonad.Actions.CycleWorkspaceByScreen
XMonad.Actions.CycleWS
XMonad.Actions.DeManage
XMonad.Actions.DwmPromote
XMonad.Actions.DynamicProjects
XMonad.Actions.DynamicWorkspaces
XMonad.Actions.DynamicWorkspaceGroups
XMonad.Actions.DynamicWorkspaceOrder
XMonad.Actions.DynamicWorkspaces
XMonad.Actions.DynamicProjects
XMonad.Actions.FindEmptyWorkspace
XMonad.Actions.FlexibleManipulate
XMonad.Actions.FlexibleResize
@@ -106,11 +110,9 @@ library
XMonad.Actions.FocusNth
XMonad.Actions.GridSelect
XMonad.Actions.GroupNavigation
XMonad.Actions.KeyRemap
XMonad.Actions.Launcher
XMonad.Actions.LinkWorkspaces
XMonad.Actions.MessageFeedback
XMonad.Actions.Minimize
XMonad.Actions.MouseGestures
XMonad.Actions.MouseResize
XMonad.Actions.Navigation2D
@@ -121,6 +123,7 @@ library
XMonad.Actions.Plane
XMonad.Actions.Promote
XMonad.Actions.RandomBackground
XMonad.Actions.KeyRemap
XMonad.Actions.RotSlaves
XMonad.Actions.Search
XMonad.Actions.ShowText
@@ -129,7 +132,6 @@ library
XMonad.Actions.SpawnOn
XMonad.Actions.Submap
XMonad.Actions.SwapWorkspaces
XMonad.Actions.SwapPromote
XMonad.Actions.TagWindows
XMonad.Actions.TopicSpace
XMonad.Actions.TreeSelect
@@ -141,13 +143,13 @@ library
XMonad.Actions.WindowMenu
XMonad.Actions.WindowNavigation
XMonad.Actions.WithAll
XMonad.Actions.Workscreen
XMonad.Actions.WorkspaceCursors
XMonad.Actions.WorkspaceNames
XMonad.Actions.Workscreen
XMonad.Config.Arossato
XMonad.Config.Azerty
XMonad.Config.Bepo
XMonad.Config.Bluetile
XMonad.Config.Bepo
XMonad.Config.Desktop
XMonad.Config.Dmwit
XMonad.Config.Droundy
@@ -157,18 +159,14 @@ library
XMonad.Config.Prime
XMonad.Config.Sjanssen
XMonad.Config.Xfce
XMonad.Doc
XMonad.Doc.Configuring
XMonad.Doc.Developing
XMonad.Doc.Extending
XMonad.Hooks.CurrentWorkspaceOnTop
XMonad.Hooks.DebugEvents
XMonad.Hooks.DebugKeyEvents
XMonad.Hooks.DebugStack
XMonad.Hooks.DynamicBars
XMonad.Hooks.DynamicHooks
XMonad.Hooks.DynamicLog
XMonad.Hooks.DynamicProperty
XMonad.Hooks.DebugStack
XMonad.Hooks.EwmhDesktops
XMonad.Hooks.FadeInactive
XMonad.Hooks.FadeWindows
@@ -195,7 +193,6 @@ library
XMonad.Layout.Accordion
XMonad.Layout.AutoMaster
XMonad.Layout.AvoidFloats
XMonad.Layout.BinaryColumn
XMonad.Layout.BinarySpacePartition
XMonad.Layout.BorderResize
XMonad.Layout.BoringWindows
@@ -210,9 +207,8 @@ library
XMonad.Layout.DecorationAddons
XMonad.Layout.DecorationMadness
XMonad.Layout.Dishes
XMonad.Layout.MultiDishes
XMonad.Layout.DragPane
XMonad.Layout.DraggingVisualizer
XMonad.Layout.DragPane
XMonad.Layout.Drawer
XMonad.Layout.Dwindle
XMonad.Layout.DwmStyle
@@ -228,8 +224,8 @@ library
XMonad.Layout.Hidden
XMonad.Layout.HintedGrid
XMonad.Layout.HintedTile
XMonad.Layout.IM
XMonad.Layout.IfMax
XMonad.Layout.IM
XMonad.Layout.ImageButtonDecoration
XMonad.Layout.IndependentScreens
XMonad.Layout.LayoutBuilder
@@ -252,7 +248,6 @@ library
XMonad.Layout.MultiColumns
XMonad.Layout.MultiToggle
XMonad.Layout.MultiToggle.Instances
XMonad.Layout.MultiToggle.TabBarDecoration
XMonad.Layout.Named
XMonad.Layout.NoBorders
XMonad.Layout.NoFrillsDecoration
@@ -276,7 +271,6 @@ library
XMonad.Layout.Spiral
XMonad.Layout.Square
XMonad.Layout.StackTile
XMonad.Layout.StateFull
XMonad.Layout.Stoppable
XMonad.Layout.SubLayouts
XMonad.Layout.TabBarDecoration
@@ -291,13 +285,12 @@ library
XMonad.Layout.WorkspaceDir
XMonad.Layout.ZoomRow
XMonad.Prompt
XMonad.Prompt.AppLauncher
XMonad.Prompt.AppendFile
XMonad.Prompt.AppLauncher
XMonad.Prompt.ConfirmPrompt
XMonad.Prompt.DirExec
XMonad.Prompt.Directory
XMonad.Prompt.DirExec
XMonad.Prompt.Email
XMonad.Prompt.FuzzyMatch
XMonad.Prompt.Input
XMonad.Prompt.Layout
XMonad.Prompt.Man
@@ -315,29 +308,25 @@ library
XMonad.Util.DebugWindow
XMonad.Util.Dmenu
XMonad.Util.Dzen
XMonad.Util.EZConfig
XMonad.Util.ExtensibleState
XMonad.Util.EZConfig
XMonad.Util.Font
XMonad.Util.Image
XMonad.Util.Invisible
XMonad.Util.Loggers
XMonad.Util.Loggers.NamedScratchpad
XMonad.Util.Minimize
XMonad.Util.NamedActions
XMonad.Util.NamedScratchpad
XMonad.Util.NamedWindows
XMonad.Util.NoTaskbar
XMonad.Util.Paste
XMonad.Util.PositionStore
XMonad.Util.PureX
XMonad.Util.Rectangle
XMonad.Util.RemoteWindows
XMonad.Util.Replace
XMonad.Util.Run
XMonad.Util.Scratchpad
XMonad.Util.SpawnNamedPipe
XMonad.Util.SessionStart
XMonad.Util.SpawnOnce
XMonad.Util.SpawnNamedPipe
XMonad.Util.Stack
XMonad.Util.StringProp
XMonad.Util.Themes