mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-14 19:55:55 -07:00
Compare commits
1 Commits
v0.17.0
...
feature/fi
Author | SHA1 | Date | |
---|---|---|---|
|
1833003404 |
30
.github/ISSUE_TEMPLATE.md
vendored
30
.github/ISSUE_TEMPLATE.md
vendored
@@ -1,30 +0,0 @@
|
|||||||
### Problem Description
|
|
||||||
|
|
||||||
Describe the problem you are having and what you expect to happen
|
|
||||||
instead.
|
|
||||||
|
|
||||||
### Steps to Reproduce
|
|
||||||
|
|
||||||
Give detailed step-by-step instructions on how to reproduce the problem.
|
|
||||||
|
|
||||||
### Configuration File
|
|
||||||
|
|
||||||
Please include the smallest _full_ 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` version XXX (commit XXX if using git)
|
|
||||||
- [ ] With `xmonad-contrib` version XXX (commit XXX if using git)
|
|
13
.github/PULL_REQUEST_TEMPLATE.md
vendored
13
.github/PULL_REQUEST_TEMPLATE.md
vendored
@@ -1,13 +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've considered how to best test these changes (property, unit,
|
|
||||||
manually, ...) and concluded: XXX
|
|
||||||
|
|
||||||
- [ ] I updated the `CHANGES.md` file
|
|
115
.github/workflows/haskell-ci-hackage.patch
vendored
115
.github/workflows/haskell-ci-hackage.patch
vendored
@@ -1,115 +0,0 @@
|
|||||||
Piggy-back on the haskell-ci workflow for automatic releases to Hackage.
|
|
||||||
|
|
||||||
This extends the workflow with two additional triggers:
|
|
||||||
|
|
||||||
* When a release is created on GitHub, a candidate release is uploaded to
|
|
||||||
Hackage and docs are submitted for it as Hackage can't build them itself
|
|
||||||
(https://github.com/haskell/hackage-server/issues/925).
|
|
||||||
|
|
||||||
* To make a final release, the workflow can be triggered manually by entering
|
|
||||||
the correct version number matching the version in the cabal file. This is
|
|
||||||
here because promoting the candidate on Hackage discards the uploaded docs
|
|
||||||
(https://github.com/haskell/hackage-server/issues/70).
|
|
||||||
|
|
||||||
The automation uses a special Hackage user: https://hackage.haskell.org/user/xmonad
|
|
||||||
and each repo (X11, xmonad, xmonad-contrib) has its own HACKAGE_API_KEY token
|
|
||||||
set in GitHub repository secrets.
|
|
||||||
|
|
||||||
--- .github/workflows/haskell-ci.yml.orig
|
|
||||||
+++ .github/workflows/haskell-ci.yml
|
|
||||||
@@ -14,8 +14,17 @@
|
|
||||||
#
|
|
||||||
name: Haskell-CI
|
|
||||||
on:
|
|
||||||
- - push
|
|
||||||
- - pull_request
|
|
||||||
+ push:
|
|
||||||
+ pull_request:
|
|
||||||
+ release:
|
|
||||||
+ types:
|
|
||||||
+ - published
|
|
||||||
+ workflow_dispatch:
|
|
||||||
+ inputs:
|
|
||||||
+ version:
|
|
||||||
+ # releases to Hackage are final and cannot be reverted, thus require
|
|
||||||
+ # manual entry of version as a poor man's mistake avoidance
|
|
||||||
+ description: version (must match version in cabal file)
|
|
||||||
jobs:
|
|
||||||
linux:
|
|
||||||
name: Haskell-CI - Linux - ${{ matrix.compiler }}
|
|
||||||
@@ -28,6 +37,7 @@
|
|
||||||
include:
|
|
||||||
- compiler: ghc-9.0.1
|
|
||||||
allow-failure: false
|
|
||||||
+ upload: true
|
|
||||||
- compiler: ghc-8.10.4
|
|
||||||
allow-failure: false
|
|
||||||
- compiler: ghc-8.8.4
|
|
||||||
@@ -171,8 +181,66 @@
|
|
||||||
${CABAL} -vnormal check
|
|
||||||
- name: haddock
|
|
||||||
run: |
|
|
||||||
- $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
|
|
||||||
+ $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH --haddock-for-hackage --builddir $GITHUB_WORKSPACE/haddock all
|
|
||||||
- name: unconstrained build
|
|
||||||
run: |
|
|
||||||
rm -f cabal.project.local
|
|
||||||
$CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
|
|
||||||
+ - name: upload artifacts (sdist)
|
|
||||||
+ if: matrix.upload
|
|
||||||
+ uses: actions/upload-artifact@v2
|
|
||||||
+ with:
|
|
||||||
+ path: ${{ github.workspace }}/sdist/*.tar.gz
|
|
||||||
+ - name: upload artifacts (haddock)
|
|
||||||
+ if: matrix.upload
|
|
||||||
+ uses: actions/upload-artifact@v2
|
|
||||||
+ with:
|
|
||||||
+ path: ${{ github.workspace }}/haddock/*-docs.tar.gz
|
|
||||||
+ - name: hackage upload (candidate)
|
|
||||||
+ if: matrix.upload && github.event_name == 'release'
|
|
||||||
+ run: |
|
|
||||||
+ set -ex
|
|
||||||
+ PACKAGE_VERSION="${PACKAGE_VERSION#v}"
|
|
||||||
+ curl \
|
|
||||||
+ --silent --show-error --fail \
|
|
||||||
+ --header "Accept: text/plain" \
|
|
||||||
+ --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
|
||||||
+ --form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
|
|
||||||
+ https://hackage.haskell.org/packages/candidates/
|
|
||||||
+ curl \
|
|
||||||
+ --silent --show-error --fail \
|
|
||||||
+ -X PUT \
|
|
||||||
+ --header "Accept: text/plain" \
|
|
||||||
+ --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
|
||||||
+ --header "Content-Type: application/x-tar" \
|
|
||||||
+ --header "Content-Encoding: gzip" \
|
|
||||||
+ --data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
|
|
||||||
+ https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/candidate/docs
|
|
||||||
+ env:
|
|
||||||
+ HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
|
|
||||||
+ PACKAGE_NAME: ${{ github.event.repository.name }}
|
|
||||||
+ PACKAGE_VERSION: ${{ github.event.release.tag_name }}
|
|
||||||
+ - name: hackage upload (release)
|
|
||||||
+ if: matrix.upload && github.event_name == 'workflow_dispatch'
|
|
||||||
+ run: |
|
|
||||||
+ set -ex
|
|
||||||
+ PACKAGE_VERSION="${PACKAGE_VERSION#v}"
|
|
||||||
+ curl \
|
|
||||||
+ --silent --show-error --fail \
|
|
||||||
+ --header "Accept: text/plain" \
|
|
||||||
+ --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
|
||||||
+ --form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
|
|
||||||
+ https://hackage.haskell.org/packages/
|
|
||||||
+ curl \
|
|
||||||
+ --silent --show-error --fail \
|
|
||||||
+ -X PUT \
|
|
||||||
+ --header "Accept: text/plain" \
|
|
||||||
+ --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
|
||||||
+ --header "Content-Type: application/x-tar" \
|
|
||||||
+ --header "Content-Encoding: gzip" \
|
|
||||||
+ --data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
|
|
||||||
+ https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/docs
|
|
||||||
+ env:
|
|
||||||
+ HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
|
|
||||||
+ PACKAGE_NAME: ${{ github.event.repository.name }}
|
|
||||||
+ PACKAGE_VERSION: ${{ github.event.inputs.version }}
|
|
268
.github/workflows/haskell-ci.yml
vendored
268
.github/workflows/haskell-ci.yml
vendored
@@ -1,268 +0,0 @@
|
|||||||
# This GitHub workflow config has been generated by a script via
|
|
||||||
#
|
|
||||||
# haskell-ci 'github' 'cabal.project'
|
|
||||||
#
|
|
||||||
# To regenerate the script (for example after adjusting tested-with) run
|
|
||||||
#
|
|
||||||
# haskell-ci regenerate
|
|
||||||
#
|
|
||||||
# For more information, see https://github.com/haskell-CI/haskell-ci
|
|
||||||
#
|
|
||||||
# version: 0.12
|
|
||||||
#
|
|
||||||
# REGENDATA ("0.12",["github","cabal.project"])
|
|
||||||
#
|
|
||||||
name: Haskell-CI
|
|
||||||
on:
|
|
||||||
push:
|
|
||||||
pull_request:
|
|
||||||
release:
|
|
||||||
types:
|
|
||||||
- published
|
|
||||||
workflow_dispatch:
|
|
||||||
inputs:
|
|
||||||
version:
|
|
||||||
# releases to Hackage are final and cannot be reverted, thus require
|
|
||||||
# manual entry of version as a poor man's mistake avoidance
|
|
||||||
description: version (must match version in cabal file)
|
|
||||||
jobs:
|
|
||||||
linux:
|
|
||||||
name: Haskell-CI - Linux - ${{ matrix.compiler }}
|
|
||||||
runs-on: ubuntu-18.04
|
|
||||||
container:
|
|
||||||
image: buildpack-deps:bionic
|
|
||||||
continue-on-error: ${{ matrix.allow-failure }}
|
|
||||||
strategy:
|
|
||||||
matrix:
|
|
||||||
include:
|
|
||||||
- compiler: ghc-9.0.1
|
|
||||||
allow-failure: false
|
|
||||||
upload: true
|
|
||||||
- compiler: ghc-8.10.4
|
|
||||||
allow-failure: false
|
|
||||||
- compiler: ghc-8.8.4
|
|
||||||
allow-failure: false
|
|
||||||
- compiler: ghc-8.6.5
|
|
||||||
allow-failure: false
|
|
||||||
- compiler: ghc-8.4.4
|
|
||||||
allow-failure: false
|
|
||||||
fail-fast: false
|
|
||||||
steps:
|
|
||||||
- name: apt
|
|
||||||
run: |
|
|
||||||
apt-get update
|
|
||||||
apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common
|
|
||||||
apt-add-repository -y 'ppa:hvr/ghc'
|
|
||||||
apt-get update
|
|
||||||
apt-get install -y $CC cabal-install-3.4 libx11-dev libxext-dev libxft-dev libxinerama-dev libxrandr-dev libxss-dev
|
|
||||||
env:
|
|
||||||
CC: ${{ matrix.compiler }}
|
|
||||||
- name: Set PATH and environment variables
|
|
||||||
run: |
|
|
||||||
echo "$HOME/.cabal/bin" >> $GITHUB_PATH
|
|
||||||
echo "LANG=C.UTF-8" >> $GITHUB_ENV
|
|
||||||
echo "CABAL_DIR=$HOME/.cabal" >> $GITHUB_ENV
|
|
||||||
echo "CABAL_CONFIG=$HOME/.cabal/config" >> $GITHUB_ENV
|
|
||||||
HCDIR=$(echo "/opt/$CC" | sed 's/-/\//')
|
|
||||||
HCNAME=ghc
|
|
||||||
HC=$HCDIR/bin/$HCNAME
|
|
||||||
echo "HC=$HC" >> $GITHUB_ENV
|
|
||||||
echo "HCPKG=$HCDIR/bin/$HCNAME-pkg" >> $GITHUB_ENV
|
|
||||||
echo "HADDOCK=$HCDIR/bin/haddock" >> $GITHUB_ENV
|
|
||||||
echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV
|
|
||||||
HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
|
|
||||||
echo "HCNUMVER=$HCNUMVER" >> $GITHUB_ENV
|
|
||||||
echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV
|
|
||||||
echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV
|
|
||||||
echo "HEADHACKAGE=false" >> $GITHUB_ENV
|
|
||||||
echo "ARG_COMPILER=--$HCNAME --with-compiler=$HC" >> $GITHUB_ENV
|
|
||||||
echo "GHCJSARITH=0" >> $GITHUB_ENV
|
|
||||||
env:
|
|
||||||
CC: ${{ matrix.compiler }}
|
|
||||||
- name: env
|
|
||||||
run: |
|
|
||||||
env
|
|
||||||
- name: write cabal config
|
|
||||||
run: |
|
|
||||||
mkdir -p $CABAL_DIR
|
|
||||||
cat >> $CABAL_CONFIG <<EOF
|
|
||||||
remote-build-reporting: anonymous
|
|
||||||
write-ghc-environment-files: never
|
|
||||||
remote-repo-cache: $CABAL_DIR/packages
|
|
||||||
logs-dir: $CABAL_DIR/logs
|
|
||||||
world-file: $CABAL_DIR/world
|
|
||||||
extra-prog-path: $CABAL_DIR/bin
|
|
||||||
symlink-bindir: $CABAL_DIR/bin
|
|
||||||
installdir: $CABAL_DIR/bin
|
|
||||||
build-summary: $CABAL_DIR/logs/build.log
|
|
||||||
store-dir: $CABAL_DIR/store
|
|
||||||
install-dirs user
|
|
||||||
prefix: $CABAL_DIR
|
|
||||||
repository hackage.haskell.org
|
|
||||||
url: http://hackage.haskell.org/
|
|
||||||
EOF
|
|
||||||
cat $CABAL_CONFIG
|
|
||||||
- name: versions
|
|
||||||
run: |
|
|
||||||
$HC --version || true
|
|
||||||
$HC --print-project-git-commit-id || true
|
|
||||||
$CABAL --version || true
|
|
||||||
- name: update cabal index
|
|
||||||
run: |
|
|
||||||
$CABAL v2-update -v
|
|
||||||
- name: cache (tools)
|
|
||||||
uses: actions/cache@v2
|
|
||||||
with:
|
|
||||||
key: ${{ runner.os }}-${{ matrix.compiler }}-tools-6c71d9d3
|
|
||||||
path: ~/.haskell-ci-tools
|
|
||||||
- name: install cabal-plan
|
|
||||||
run: |
|
|
||||||
mkdir -p $HOME/.cabal/bin
|
|
||||||
curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.6.2.0/cabal-plan-0.6.2.0-x86_64-linux.xz > cabal-plan.xz
|
|
||||||
echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c -
|
|
||||||
xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
|
|
||||||
rm -f cabal-plan.xz
|
|
||||||
chmod a+x $HOME/.cabal/bin/cabal-plan
|
|
||||||
cabal-plan --version
|
|
||||||
- name: install hlint
|
|
||||||
run: |
|
|
||||||
if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then HLINTVER=$(cd /tmp && (${CABAL} v2-install -v $ARG_COMPILER --dry-run hlint --constraint='hlint >=3.2 && <3.3' | perl -ne 'if (/\bhlint-(\d+(\.\d+)*)\b/) { print "$1"; last; }')); echo "HLint version $HLINTVER" ; fi
|
|
||||||
if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then if [ ! -e $HOME/.haskell-ci-tools/hlint-$HLINTVER/hlint ]; then echo "Downloading HLint version $HLINTVER"; mkdir -p $HOME/.haskell-ci-tools; curl --write-out 'Status Code: %{http_code} Redirects: %{num_redirects} Total time: %{time_total} Total Dsize: %{size_download}\n' --silent --location --output $HOME/.haskell-ci-tools/hlint-$HLINTVER.tar.gz "https://github.com/ndmitchell/hlint/releases/download/v$HLINTVER/hlint-$HLINTVER-x86_64-linux.tar.gz"; tar -xzv -f $HOME/.haskell-ci-tools/hlint-$HLINTVER.tar.gz -C $HOME/.haskell-ci-tools; fi ; fi
|
|
||||||
if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then mkdir -p $CABAL_DIR/bin && ln -sf "$HOME/.haskell-ci-tools/hlint-$HLINTVER/hlint" $CABAL_DIR/bin/hlint ; fi
|
|
||||||
if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then hlint --version ; fi
|
|
||||||
- name: checkout
|
|
||||||
uses: actions/checkout@v2
|
|
||||||
with:
|
|
||||||
path: source
|
|
||||||
- name: initial cabal.project for sdist
|
|
||||||
run: |
|
|
||||||
touch cabal.project
|
|
||||||
echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project
|
|
||||||
cat cabal.project
|
|
||||||
- name: sdist
|
|
||||||
run: |
|
|
||||||
mkdir -p sdist
|
|
||||||
$CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
|
|
||||||
- name: unpack
|
|
||||||
run: |
|
|
||||||
mkdir -p unpacked
|
|
||||||
find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
|
|
||||||
- name: generate cabal.project
|
|
||||||
run: |
|
|
||||||
PKGDIR_xmonad_contrib="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/xmonad-contrib-[0-9.]*')"
|
|
||||||
echo "PKGDIR_xmonad_contrib=${PKGDIR_xmonad_contrib}" >> $GITHUB_ENV
|
|
||||||
touch cabal.project
|
|
||||||
touch cabal.project.local
|
|
||||||
echo "packages: ${PKGDIR_xmonad_contrib}" >> cabal.project
|
|
||||||
echo "package xmonad-contrib" >> cabal.project
|
|
||||||
echo " ghc-options: -Werror=missing-methods" >> cabal.project
|
|
||||||
cat >> cabal.project <<EOF
|
|
||||||
source-repository-package
|
|
||||||
type: git
|
|
||||||
location: https://github.com/xmonad/xmonad
|
|
||||||
branch: master
|
|
||||||
|
|
||||||
optimization: False
|
|
||||||
|
|
||||||
package xmonad-contrib
|
|
||||||
flags: +pedantic
|
|
||||||
ghc-options: -j
|
|
||||||
EOF
|
|
||||||
$HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(xmonad-contrib)$/; }' >> cabal.project.local
|
|
||||||
cat cabal.project
|
|
||||||
cat cabal.project.local
|
|
||||||
- name: dump install plan
|
|
||||||
run: |
|
|
||||||
$CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
|
|
||||||
cabal-plan
|
|
||||||
- name: cache
|
|
||||||
uses: actions/cache@v2
|
|
||||||
with:
|
|
||||||
key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
|
|
||||||
path: ~/.cabal/store
|
|
||||||
restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
|
|
||||||
- name: install dependencies
|
|
||||||
run: |
|
|
||||||
$CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
|
|
||||||
$CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
|
|
||||||
- name: build w/o tests
|
|
||||||
run: |
|
|
||||||
$CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
|
|
||||||
- name: build
|
|
||||||
run: |
|
|
||||||
$CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
|
|
||||||
- name: tests
|
|
||||||
run: |
|
|
||||||
$CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
|
|
||||||
- name: hlint
|
|
||||||
run: |
|
|
||||||
if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then (cd ${PKGDIR_xmonad_contrib} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml .) ; fi
|
|
||||||
- name: cabal check
|
|
||||||
run: |
|
|
||||||
cd ${PKGDIR_xmonad_contrib} || false
|
|
||||||
${CABAL} -vnormal check
|
|
||||||
- name: haddock
|
|
||||||
run: |
|
|
||||||
$CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH --haddock-for-hackage --builddir $GITHUB_WORKSPACE/haddock all
|
|
||||||
- name: unconstrained build
|
|
||||||
run: |
|
|
||||||
rm -f cabal.project.local
|
|
||||||
$CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
|
|
||||||
- name: upload artifacts (sdist)
|
|
||||||
if: matrix.upload
|
|
||||||
uses: actions/upload-artifact@v2
|
|
||||||
with:
|
|
||||||
path: ${{ github.workspace }}/sdist/*.tar.gz
|
|
||||||
- name: upload artifacts (haddock)
|
|
||||||
if: matrix.upload
|
|
||||||
uses: actions/upload-artifact@v2
|
|
||||||
with:
|
|
||||||
path: ${{ github.workspace }}/haddock/*-docs.tar.gz
|
|
||||||
- name: hackage upload (candidate)
|
|
||||||
if: matrix.upload && github.event_name == 'release'
|
|
||||||
run: |
|
|
||||||
set -ex
|
|
||||||
PACKAGE_VERSION="${PACKAGE_VERSION#v}"
|
|
||||||
curl \
|
|
||||||
--silent --show-error --fail \
|
|
||||||
--header "Accept: text/plain" \
|
|
||||||
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
|
||||||
--form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
|
|
||||||
https://hackage.haskell.org/packages/candidates/
|
|
||||||
curl \
|
|
||||||
--silent --show-error --fail \
|
|
||||||
-X PUT \
|
|
||||||
--header "Accept: text/plain" \
|
|
||||||
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
|
||||||
--header "Content-Type: application/x-tar" \
|
|
||||||
--header "Content-Encoding: gzip" \
|
|
||||||
--data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
|
|
||||||
https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/candidate/docs
|
|
||||||
env:
|
|
||||||
HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
|
|
||||||
PACKAGE_NAME: ${{ github.event.repository.name }}
|
|
||||||
PACKAGE_VERSION: ${{ github.event.release.tag_name }}
|
|
||||||
- name: hackage upload (release)
|
|
||||||
if: matrix.upload && github.event_name == 'workflow_dispatch'
|
|
||||||
run: |
|
|
||||||
set -ex
|
|
||||||
PACKAGE_VERSION="${PACKAGE_VERSION#v}"
|
|
||||||
curl \
|
|
||||||
--silent --show-error --fail \
|
|
||||||
--header "Accept: text/plain" \
|
|
||||||
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
|
||||||
--form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
|
|
||||||
https://hackage.haskell.org/packages/
|
|
||||||
curl \
|
|
||||||
--silent --show-error --fail \
|
|
||||||
-X PUT \
|
|
||||||
--header "Accept: text/plain" \
|
|
||||||
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
|
||||||
--header "Content-Type: application/x-tar" \
|
|
||||||
--header "Content-Encoding: gzip" \
|
|
||||||
--data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
|
|
||||||
https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/docs
|
|
||||||
env:
|
|
||||||
HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
|
|
||||||
PACKAGE_NAME: ${{ github.event.repository.name }}
|
|
||||||
PACKAGE_VERSION: ${{ github.event.inputs.version }}
|
|
28
.github/workflows/nix.yml
vendored
28
.github/workflows/nix.yml
vendored
@@ -1,28 +0,0 @@
|
|||||||
name: Nix
|
|
||||||
|
|
||||||
on:
|
|
||||||
push:
|
|
||||||
pull_request:
|
|
||||||
|
|
||||||
jobs:
|
|
||||||
build:
|
|
||||||
runs-on: ubuntu-latest
|
|
||||||
name: Nix Flake - Linux
|
|
||||||
permissions:
|
|
||||||
contents: read
|
|
||||||
steps:
|
|
||||||
- name: Install Nix
|
|
||||||
uses: cachix/install-nix-action@v13
|
|
||||||
with:
|
|
||||||
install_url: https://nixos-nix-install-tests.cachix.org/serve/i6laym9jw3wg9mw6ncyrk6gjx4l34vvx/install
|
|
||||||
install_options: '--tarball-url-prefix https://nixos-nix-install-tests.cachix.org/serve'
|
|
||||||
extra_nix_config: |
|
|
||||||
experimental-features = nix-command flakes
|
|
||||||
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
|
|
||||||
- name: Clone project
|
|
||||||
uses: actions/checkout@v2
|
|
||||||
- name: Build
|
|
||||||
# "nix build" builds with full optimization and includes a profiling
|
|
||||||
# build, so just the build of xmonad-contrib itself takes 3 minutes.
|
|
||||||
# As a workaround, we invoke cabal manually here.
|
|
||||||
run: nix develop -c cabal v2-build -O0 -j
|
|
42
.github/workflows/packdeps.yml
vendored
42
.github/workflows/packdeps.yml
vendored
@@ -1,42 +0,0 @@
|
|||||||
name: Packdeps
|
|
||||||
|
|
||||||
on:
|
|
||||||
workflow_dispatch:
|
|
||||||
schedule:
|
|
||||||
# Run every Saturday
|
|
||||||
- cron: '0 3 * * 6'
|
|
||||||
|
|
||||||
jobs:
|
|
||||||
packdeps:
|
|
||||||
name: Packdeps
|
|
||||||
runs-on: ubuntu-latest
|
|
||||||
|
|
||||||
steps:
|
|
||||||
- name: Clone project
|
|
||||||
uses: actions/checkout@v2
|
|
||||||
- name: Setup Haskell
|
|
||||||
uses: haskell/actions/setup@v1
|
|
||||||
with:
|
|
||||||
# packdeps doesn't build with newer as of 2021-10
|
|
||||||
ghc-version: '8.8'
|
|
||||||
- name: Install packdeps
|
|
||||||
run: |
|
|
||||||
set -ex
|
|
||||||
echo "$HOME/.cabal/bin" >> $GITHUB_PATH
|
|
||||||
cabal install packdeps
|
|
||||||
- name: Check package bounds (all)
|
|
||||||
continue-on-error: true
|
|
||||||
run: |
|
|
||||||
set -ex
|
|
||||||
packdeps \
|
|
||||||
--exclude X11 \
|
|
||||||
--exclude xmonad \
|
|
||||||
*.cabal
|
|
||||||
- name: Check package bounds (preferred)
|
|
||||||
run: |
|
|
||||||
set -ex
|
|
||||||
packdeps \
|
|
||||||
--preferred \
|
|
||||||
--exclude X11 \
|
|
||||||
--exclude xmonad \
|
|
||||||
*.cabal
|
|
113
.github/workflows/stack.yml
vendored
113
.github/workflows/stack.yml
vendored
@@ -1,113 +0,0 @@
|
|||||||
name: Stack
|
|
||||||
|
|
||||||
on:
|
|
||||||
push:
|
|
||||||
pull_request:
|
|
||||||
|
|
||||||
jobs:
|
|
||||||
build:
|
|
||||||
name: Stack CI - Linux - ${{ matrix.resolver }} - ${{ matrix.yaml }}
|
|
||||||
runs-on: ubuntu-latest
|
|
||||||
strategy:
|
|
||||||
fail-fast: false
|
|
||||||
matrix:
|
|
||||||
include:
|
|
||||||
# XXX: temporarily disabled until xmonad 0.17 release
|
|
||||||
# - resolver: lts-12
|
|
||||||
# ghc: 8.4.4
|
|
||||||
# yaml: stack.yaml
|
|
||||||
- resolver: lts-12
|
|
||||||
ghc: 8.4.4
|
|
||||||
yaml: stack-master.yaml
|
|
||||||
- resolver: lts-14
|
|
||||||
ghc: 8.6.5
|
|
||||||
yaml: stack-master.yaml
|
|
||||||
- resolver: lts-16
|
|
||||||
ghc: 8.8.4
|
|
||||||
yaml: stack-master.yaml
|
|
||||||
# - resolver: lts-17
|
|
||||||
# ghc: 8.10.4
|
|
||||||
# yaml: stack.yaml
|
|
||||||
- resolver: lts-17
|
|
||||||
ghc: 8.10.4
|
|
||||||
yaml: stack-master.yaml
|
|
||||||
- resolver: lts-18
|
|
||||||
ghc: 8.10.7
|
|
||||||
yaml: stack-master.yaml
|
|
||||||
|
|
||||||
steps:
|
|
||||||
- name: Clone project
|
|
||||||
uses: actions/checkout@v2
|
|
||||||
|
|
||||||
- name: Prepare apt sources
|
|
||||||
run: |
|
|
||||||
set -ex
|
|
||||||
sudo add-apt-repository -y ppa:hvr/ghc
|
|
||||||
sudo apt update -y
|
|
||||||
|
|
||||||
- name: Install C dependencies
|
|
||||||
run: |
|
|
||||||
set -ex
|
|
||||||
sudo apt install -y \
|
|
||||||
libx11-dev \
|
|
||||||
libxext-dev \
|
|
||||||
libxft-dev \
|
|
||||||
libxinerama-dev \
|
|
||||||
libxrandr-dev \
|
|
||||||
libxss-dev \
|
|
||||||
#
|
|
||||||
|
|
||||||
- name: Install GHC
|
|
||||||
# use system ghc (if available) in stack, don't waste GH Actions cache space
|
|
||||||
continue-on-error: true
|
|
||||||
run: |
|
|
||||||
set -ex
|
|
||||||
sudo apt install -y ghc-${{ matrix.ghc }}
|
|
||||||
echo /opt/ghc/${{ matrix.ghc }}/bin >> $GITHUB_PATH
|
|
||||||
|
|
||||||
- name: Refresh caches once a month
|
|
||||||
id: cache-date
|
|
||||||
# GHA writes caches on the first miss and then never updates them again;
|
|
||||||
# force updating the cache at least once a month
|
|
||||||
run: |
|
|
||||||
echo "::set-output name=date::$(date +%Y-%m)"
|
|
||||||
|
|
||||||
- name: Cache Haskell package metadata
|
|
||||||
uses: actions/cache@v2
|
|
||||||
with:
|
|
||||||
path: ~/.stack/pantry
|
|
||||||
key: stack-pantry-${{ runner.os }}-${{ steps.cache-date.outputs.date }}
|
|
||||||
restore-keys: |
|
|
||||||
stack-pantry-${{ runner.os }}-
|
|
||||||
|
|
||||||
- name: Cache Haskell dependencies
|
|
||||||
uses: actions/cache@v2
|
|
||||||
with:
|
|
||||||
path: |
|
|
||||||
~/.stack/*
|
|
||||||
!~/.stack/pantry
|
|
||||||
!~/.stack/programs
|
|
||||||
key: stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-${{ hashFiles(matrix.yaml) }}-${{ hashFiles('*.cabal') }}
|
|
||||||
restore-keys: |
|
|
||||||
stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-${{ hashFiles(matrix.yaml) }}-
|
|
||||||
stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-
|
|
||||||
stack-${{ runner.os }}-${{ matrix.resolver }}-
|
|
||||||
|
|
||||||
- name: Update hackage index
|
|
||||||
# always update index to prevent the shared ~/.stack/pantry cache from being empty
|
|
||||||
run: |
|
|
||||||
set -ex
|
|
||||||
stack update
|
|
||||||
|
|
||||||
- name: Build and test
|
|
||||||
run: |
|
|
||||||
set -ex
|
|
||||||
|
|
||||||
# workaround for stack/pantry caching of github archives
|
|
||||||
sed -e "s/@{today}/@{$(date -u --iso-8601=seconds)}/" -i ${{ matrix.yaml }}
|
|
||||||
|
|
||||||
stack test \
|
|
||||||
--fast --no-terminal \
|
|
||||||
--stack-yaml=${{ matrix.yaml }} \
|
|
||||||
--resolver=${{ matrix.resolver }} --system-ghc \
|
|
||||||
--flag=xmonad-contrib:pedantic
|
|
4
.gitignore
vendored
4
.gitignore
vendored
@@ -23,7 +23,3 @@ tags
|
|||||||
|
|
||||||
# stack artifacts
|
# stack artifacts
|
||||||
/.stack-work/
|
/.stack-work/
|
||||||
/cabal.project.local
|
|
||||||
|
|
||||||
stack.yaml.lock
|
|
||||||
|
|
||||||
|
@@ -1,2 +0,0 @@
|
|||||||
# Ignore these warnings.
|
|
||||||
- ignore: {name: "Evaluate"}
|
|
56
.mailmap
56
.mailmap
@@ -13,96 +13,90 @@ Bogdan Sinitsyn <bogdan.sinitsyn@gmail.com>
|
|||||||
Brandon S Allbery KF8NH <allbery.b@gmail.com>
|
Brandon S Allbery KF8NH <allbery.b@gmail.com>
|
||||||
Brandon S Allbery KF8NH <allbery.b@gmail.com> <allbery@ece.cmu.edu>
|
Brandon S Allbery KF8NH <allbery.b@gmail.com> <allbery@ece.cmu.edu>
|
||||||
Brent Yorgey <byorgey@gmail.com> <byorgey@cis.upenn.edu>
|
Brent Yorgey <byorgey@gmail.com> <byorgey@cis.upenn.edu>
|
||||||
Bruce Forte <fuererb@student.ethz.ch>
|
|
||||||
Carlos Lopez-Camey <c.lopez@kmels.net>
|
Carlos Lopez-Camey <c.lopez@kmels.net>
|
||||||
Carsten Otto <xmonad@c-otto.de>
|
Carsten Otto <xmonad@c-otto.de>
|
||||||
Cesar Crusius <ccrusius@google.com> <ccrusius@ccrusius-glaptop.roam.corp.google.com>
|
|
||||||
Christian Dietrich <stettberger@dokucode.de>
|
Christian Dietrich <stettberger@dokucode.de>
|
||||||
Christian Wills <cwills.dev@gmail.com>
|
Christian Wills <cwills.dev@gmail.com>
|
||||||
Daniel Neri <daniel.neri@sigicom.com> <daniel.neri@sigicom.se>
|
Daniel Neri <daniel.neri@sigicom.com> <daniel.neri@sigicom.se>
|
||||||
Daniel Schoepe <daniel.schoepe@gmail.com> <asgaroth_@gmx.de>
|
Daniel Schoepe <daniel.schoepe@googlemail.com> <asgaroth_@gmx.de>
|
||||||
Daniel Schoepe <daniel.schoepe@gmail.com> <daniel.schoepe@googlemail.com>
|
Daniel Schoepe <daniel.schoepe@googlemail.com> <daniel.schoepe@gmail.com>
|
||||||
Daniel Wagner <me@dmwit.com> <daniel@wagner-home.com>
|
Daniel Wagner <me@dmwit.com> <daniel@wagner-home.com>
|
||||||
Dave Harrison <dave@nullcube.com>
|
Dave Harrison <dave@nullcube.com>
|
||||||
Dave Macias <davama@gmail.com>
|
|
||||||
David Glasser <glasser@mit.edu>
|
David Glasser <glasser@mit.edu>
|
||||||
David McLean <gopsychonauts@gmail.com>
|
David McLean <gopsychonauts@gmail.com>
|
||||||
Devin Mullins <devin.mullins@gmail.com> <devinmullins@gmail.com>
|
|
||||||
Devin Mullins <devin.mullins@gmail.com> <me@twifkak.com>
|
Devin Mullins <devin.mullins@gmail.com> <me@twifkak.com>
|
||||||
Dominik Bruhn <dominik@dbruhn.de>
|
Dominik Bruhn <dominik@dbruhn.de>
|
||||||
Don Stewart <dons00@gmail.com> <dons@cse.unsw.edu.au>
|
Don Stewart <dons00@gmail.com> <dons@cse.unsw.edu.au>
|
||||||
Don Stewart <dons00@gmail.com> <dons@galois.com>
|
Don Stewart <dons00@gmail.com> <dons@galois.com>
|
||||||
Edward Z. Yang <ezyang@cs.stanford.edu>
|
Edward Z. Yang <ezyang@cs.stanford.edu>
|
||||||
Evgeny Kurnevsky <kurnevsky@gmail.com>
|
|
||||||
Gwern Branwen <gwern@gwern.net>
|
Gwern Branwen <gwern@gwern.net>
|
||||||
Gwern Branwen <gwern@gwern.net> <gwern0@gmail.com>
|
Gwern Branwen <gwern@gwern.net> <gwern0@gmail.com>
|
||||||
Henrique Abreu <hgabreu@gmail.com>
|
Henrique Abreu <hgabreu@gmail.com>
|
||||||
Ilya Portnov <portnov84@rambler.ru>
|
Ilya Portnov <portnov84@rambler.ru>
|
||||||
Ivan Brennen <ivan.brennan@gmail.com>
|
intrigeri <intrigeri@boum.org>
|
||||||
Ivan Brennen <ivan.brennan@gmail.com> <ivanbrennan@users.noreply.github.com>
|
|
||||||
Ivan Miljenovic <Ivan.Miljenovic@gmail.com>
|
Ivan Miljenovic <Ivan.Miljenovic@gmail.com>
|
||||||
Jan-David Quesel <quesel@informatik.uni-oldenburg.de>
|
Jan-David Quesel <quesel@informatik.uni-oldenburg.de>
|
||||||
Jens Petersen <juhp@community.haskell.org> <petersen@haskell.org>
|
Jens Petersen <juhp@community.haskell.org> <petersen@haskell.org>
|
||||||
Jeremy Apthorp <nornagon@gmail.com>
|
Jeremy Apthorp <nornagon@gmail.com>
|
||||||
Joachim Breitner <mail@joachim-breitner.de>
|
Joachim Breitner <mail@joachim-breitner.de>
|
||||||
Joachim Fasting <joachim.fasting@gmail.com>
|
Joachim Fasting <joachim.fasting@gmail.com>
|
||||||
Joan Milev <joantmilev@gmail.com> <51526053+exorcist365@users.noreply.github.com>
|
|
||||||
Joe Thornber <joe.thornber@gmail.com>
|
|
||||||
Joel Suovaniemi <joel.suovaniemi@iki.fi>
|
Joel Suovaniemi <joel.suovaniemi@iki.fi>
|
||||||
|
Joe Thornber <joe.thornber@gmail.com>
|
||||||
Johann Giwer <johanngiwer@web.de>
|
Johann Giwer <johanngiwer@web.de>
|
||||||
Jussi Maki <joamaki@gmail.com>
|
Jussi Maki <joamaki@gmail.com>
|
||||||
Konstantin Sobolev <konstantin.sobolev@gmail.com>
|
Konstantin Sobolev <konstantin.sobolev@gmail.com>
|
||||||
L. S. Leary <LSLeary@users.noreply.github.com>
|
|
||||||
Lanny Ripple <lan3ny@gmail.com>
|
Lanny Ripple <lan3ny@gmail.com>
|
||||||
Lei Chen <linxray@gmail.com>
|
Lei Chen <linxray@gmail.com>
|
||||||
Leon Kowarschick <lkowarschick@gmail.com>
|
|
||||||
Leon Kowarschick <lkowarschick@gmail.com> <5300871+elkowar@users.noreply.github.com>
|
|
||||||
Leonardo Serra <leoserra@minaslivre.org>
|
Leonardo Serra <leoserra@minaslivre.org>
|
||||||
Luc Duzan <lduzan@linagora.com>
|
|
||||||
Luc Duzan <lduzan@linagora.com> <stroky.l@gmail.com>
|
|
||||||
Luis Cabellos <zhen.sydow@gmail.com>
|
Luis Cabellos <zhen.sydow@gmail.com>
|
||||||
Lukas Mai <l.mai@web.de>
|
Lukas Mai <l.mai@web.de>
|
||||||
Mario Pastorelli <pastorelli.mario@gmail.com>
|
Mario Pastorelli <pastorelli.mario@gmail.com>
|
||||||
Mathias Stearn <redbeard0531@gmail.com>
|
Mathias Stearn <redbeard0531@gmail.com>
|
||||||
Matt Brown <deadguysfrom@gmail.com>
|
Matt Brown <deadguysfrom@gmail.com>
|
||||||
Matthew Hague <matthewhague@zoho.com>
|
Matthew Hague <matthewhague@zoho.com>
|
||||||
Michael G. Sloan <mgsloan@gmail.com>
|
|
||||||
Nathaniel Filardo <nwfilardo@gmail.com>
|
Nathaniel Filardo <nwfilardo@gmail.com>
|
||||||
Nelson Elhage <nelhage@mit.edu>
|
Nelson Elhage <nelhage@mit.edu>
|
||||||
Nicolas Dudebout <nicolas.dudebout@gatech.edu>
|
Nicolas Dudebout <nicolas.dudebout@gatech.edu>
|
||||||
Nicolas Pouillard <nicolas.pouillard@gmail.com>
|
Nicolas Pouillard <nicolas.pouillard@gmail.com>
|
||||||
Nils Schweinsberg <mail@n-sch.de>
|
Nils Schweinsberg <mail@n-sch.de>
|
||||||
Norbert Zeh <nzeh@cs.dal.ca>
|
Norbert Zeh <nzeh@cs.dal.ca>
|
||||||
Peter J. Jones <pjones@devalot.com>
|
|
||||||
Peter J. Jones <pjones@devalot.com> <pjones@pmade.com>
|
|
||||||
Peter Olson <polson2@hawk.iit.edu>
|
Peter Olson <polson2@hawk.iit.edu>
|
||||||
Quentin Moser <moserq@gmail.com>
|
Quentin Moser <moserq@gmail.com>
|
||||||
Quentin Moser <moserq@gmail.com> <quentin.moser@unifr.ch>
|
Quentin Moser <quentin.moser@unifr.ch>
|
||||||
Rickard Gustafsson <acura@allyourbase.se>
|
Rickard Gustafsson <acura@allyourbase.se>
|
||||||
Robert Marlow <bobstopper@bobturf.org>
|
Robert Marlow <bobstopper@bobturf.org>
|
||||||
Robert Marlow <bobstopper@bobturf.org> <robreim@bobturf.org>
|
Robert Marlow <bobstopper@bobturf.org> <robreim@bobturf.org>
|
||||||
Rohan Jain <crodjer@gmail.com>
|
Rohan Jain <crodjer@gmail.com>
|
||||||
|
Sibi Prabakaran <sibi@psibi.in> <psibi2000@gmail.com>
|
||||||
Sean Escriva <sean.escriva@gmail.com>
|
Sean Escriva <sean.escriva@gmail.com>
|
||||||
Sean McEligot <seanmce33@gmail.com>
|
Sean McEligot <seanmce33@gmail.com>
|
||||||
Sibi Prabakaran <sibi@psibi.in>
|
|
||||||
Spencer Janssen <spencerjanssen@gmail.com> <sjanssen@cse.unl.edu>
|
Spencer Janssen <spencerjanssen@gmail.com> <sjanssen@cse.unl.edu>
|
||||||
Timothy Hobbs <tim.thelion@gmail.com>
|
|
||||||
Tom Rauchenwald <its.sec@gmx.net>
|
|
||||||
Tom Smeets <tom.tsmeets@gmail.com> <Tom.TSmeets@Gmail.com>
|
|
||||||
Tomas Janousek <tomi@nomi.cz>
|
|
||||||
Tomohiro Matsuyama <matsuyama3@ariel-networks.com>
|
Tomohiro Matsuyama <matsuyama3@ariel-networks.com>
|
||||||
|
Tom Rauchenwald <its.sec@gmx.net>
|
||||||
Tony Morris <haskell@tmorris.net>
|
Tony Morris <haskell@tmorris.net>
|
||||||
Valery V. Vorotyntsev <valery.vv@gmail.com>
|
Valery V. Vorotyntsev <valery.vv@gmail.com>
|
||||||
Will Farrington <wcfarrington@gmail.com>
|
Will Farrington <wcfarrington@gmail.com>
|
||||||
Wirt Wolff <wirtwolff@gmail.com>
|
Wirt Wolff <wirtwolff@gmail.com>
|
||||||
Yaakov Nemoy <loupgaroublond@gmail.com>
|
Yaakov Nemoy <loupgaroublond@gmail.com>
|
||||||
Yclept Nemo <orbisvicis@gmail.com> <pscjtwjdjtAhnbjm/dpn>
|
|
||||||
Yecine Megdiche <yecine.megdiche@gmail.com> <megdiche@in.tum.de>
|
|
||||||
|
|
||||||
|
brian <brian@lorf.org>
|
||||||
|
cardboard42 <cardboard42@gmail.com>
|
||||||
|
daedalusinfinity <daedalusinfinity@gmail.com>
|
||||||
hexago.nl <xmonad-contrib@hexago.nl>
|
hexago.nl <xmonad-contrib@hexago.nl>
|
||||||
|
intrigeri <intrigeri@boum.org>
|
||||||
|
jakob <jakob@pipefour.org>
|
||||||
|
kedals0 <kedals0@gmail.com>
|
||||||
lithis <xmonad@selg.hethrael.org>
|
lithis <xmonad@selg.hethrael.org>
|
||||||
lithis <xmonad@selg.hethrael.org> <xmonad@s001.hethrael.com>
|
lithis <xmonad@selg.hethrael.org> <xmonad@s001.hethrael.com>
|
||||||
sam-barr <mail@samf.bar> <samfbarr@outlook.com>
|
longpoke <longpoke@gmail.com>
|
||||||
slotThe <soliditsallgood@mailbox.org> <50166980+slotThe@users.noreply.github.com>
|
md143rbh7f <md143rbh7f@gmail.com>
|
||||||
slotThe <soliditsallgood@mailbox.org> <soliditsallgood@tuta.io>
|
perlkat <perlkat@katspace.org>
|
||||||
spoonm <spoonm@spoonm.org>
|
rupa <rupa@lrrr.us> <rupa@lrrr.us>
|
||||||
|
timthelion <tim.thelion@gmail.com>
|
||||||
|
|
||||||
|
# for core only
|
||||||
|
Neil Mitchell <http://www.cs.york.ac.uk/~ndm/>, Neil Mitchell
|
||||||
|
Nick Burlett <nickburlett@mac.com>
|
||||||
|
Sam Hughes <hughes@rpi.edu>
|
||||||
|
Shae Erisson <shae@ScannedInAvian.com>
|
||||||
|
Conrad Irwin <conrad.irwin@gmail.com>
|
||||||
|
91
.travis.yml
Normal file
91
.travis.yml
Normal file
@@ -0,0 +1,91 @@
|
|||||||
|
# This file has been generated -- see https://github.com/hvr/multi-ghc-travis
|
||||||
|
language: c
|
||||||
|
sudo: false
|
||||||
|
|
||||||
|
cache:
|
||||||
|
directories:
|
||||||
|
- $HOME/.cabsnap
|
||||||
|
- $HOME/.cabal/packages
|
||||||
|
|
||||||
|
before_cache:
|
||||||
|
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
|
||||||
|
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
|
||||||
|
|
||||||
|
matrix:
|
||||||
|
include:
|
||||||
|
- 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 ];
|
||||||
|
then
|
||||||
|
zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >
|
||||||
|
$HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
|
||||||
|
fi
|
||||||
|
- travis_retry cabal update -v
|
||||||
|
- 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 installplan.txt $HOME/.cabsnap/installplan.txt;
|
||||||
|
then
|
||||||
|
echo "cabal build-cache HIT";
|
||||||
|
rm -rfv .ghc;
|
||||||
|
cp -a $HOME/.cabsnap/ghc $HOME/.ghc;
|
||||||
|
cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;
|
||||||
|
else
|
||||||
|
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
|
||||||
|
|
||||||
|
# snapshot package-db on cache miss
|
||||||
|
- if [ ! -d $HOME/.cabsnap ];
|
||||||
|
then
|
||||||
|
echo "snapshotting package-db to build-cache";
|
||||||
|
mkdir $HOME/.cabsnap;
|
||||||
|
cp -a $HOME/.ghc $HOME/.cabsnap/ghc;
|
||||||
|
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:
|
||||||
|
- if [ -f configure.ac ]; then autoreconf -i; fi
|
||||||
|
- cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging
|
||||||
|
- cabal build # this builds all libraries and executables (including tests/benchmarks)
|
||||||
|
- cabal test
|
||||||
|
# - cabal check # complains about -Werror even though it is
|
||||||
|
# hidden behind a manual flag with default false
|
||||||
|
- cabal sdist # tests that a source-distribution can be generated
|
||||||
|
|
||||||
|
# Check that the resulting source distribution can be built & installed.
|
||||||
|
# If there are no other `.tar.gz` files in `dist`, this can be even simpler:
|
||||||
|
# `cabal install --force-reinstalls dist/*-*.tar.gz`
|
||||||
|
- SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
|
||||||
|
(cd dist && cabal install --force-reinstalls "$SRC_TGZ")
|
||||||
|
|
||||||
|
# EOF
|
1329
CHANGES.md
1329
CHANGES.md
File diff suppressed because it is too large
Load Diff
@@ -1,5 +0,0 @@
|
|||||||
# Contributing to xmonad and xmonad-contrib
|
|
||||||
|
|
||||||
Please refer to XMonad's [CONTRIBUTING][gh:xmonad:contributing].
|
|
||||||
|
|
||||||
[gh:xmonad:contributing]: https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md
|
|
45
LICENSE
45
LICENSE
@@ -1,26 +1,27 @@
|
|||||||
Copyright (c) The Xmonad Community. All rights reserved.
|
Copyright (c) The Xmonad Community
|
||||||
|
|
||||||
Redistribution and use in source and binary forms, with or without modification,
|
All rights reserved.
|
||||||
are permitted provided that the following conditions are met:
|
|
||||||
|
|
||||||
1. Redistributions of source code must retain the above copyright notice,
|
Redistribution and use in source and binary forms, with or without
|
||||||
this list of conditions and the following disclaimer.
|
modification, are permitted provided that the following conditions
|
||||||
|
are met:
|
||||||
|
1. Redistributions of source code must retain the above copyright
|
||||||
|
notice, this list of conditions and the following disclaimer.
|
||||||
|
2. Redistributions in binary form must reproduce the above copyright
|
||||||
|
notice, this list of conditions and the following disclaimer in the
|
||||||
|
documentation and/or other materials provided with the distribution.
|
||||||
|
3. Neither the name of the author nor the names of his contributors
|
||||||
|
may be used to endorse or promote products derived from this software
|
||||||
|
without specific prior written permission.
|
||||||
|
|
||||||
2. Redistributions in binary form must reproduce the above copyright notice,
|
THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
|
||||||
this list of conditions and the following disclaimer in the documentation
|
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||||
and/or other materials provided with the distribution.
|
|
||||||
|
|
||||||
3. Neither the name of the copyright holder nor the names of its contributors
|
|
||||||
may be used to endorse or promote products derived from this software without
|
|
||||||
specific prior written permission.
|
|
||||||
|
|
||||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
|
||||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
||||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||||
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
|
ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
|
||||||
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
|
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
||||||
USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
||||||
|
SUCH DAMAGE.
|
||||||
|
107
README.md
107
README.md
@@ -1,97 +1,40 @@
|
|||||||
<p align="center">
|
# xmonad-contrib: Third Party Extensions to the xmonad Window Manager
|
||||||
<a href="https://xmonad.org/">
|
|
||||||
<img alt="XMonad logo" src="https://xmonad.org/images/logo-wrapped.svg" height=150>
|
|
||||||
</a>
|
|
||||||
</p>
|
|
||||||
<p align="center">
|
|
||||||
<a href="https://hackage.haskell.org/package/xmonad-contrib">
|
|
||||||
<img alt="Hackage" src="https://img.shields.io/hackage/v/xmonad-contrib?logo=haskell">
|
|
||||||
</a>
|
|
||||||
<a href="https://github.com/xmonad/xmonad-contrib/blob/readme/LICENSE">
|
|
||||||
<img alt="License" src="https://img.shields.io/github/license/xmonad/xmonad-contrib">
|
|
||||||
</a>
|
|
||||||
<a href="https://haskell.org/">
|
|
||||||
<img alt="Made in Haskell" src="https://img.shields.io/badge/Made%20in-Haskell-%235e5086?logo=haskell">
|
|
||||||
</a>
|
|
||||||
<br>
|
|
||||||
<a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/stack.yml">
|
|
||||||
<img alt="Stack" src="https://img.shields.io/github/workflow/status/xmonad/xmonad-contrib/Stack?label=Stack&logo=githubactions&logoColor=white">
|
|
||||||
</a>
|
|
||||||
<a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/haskell-ci.yml">
|
|
||||||
<img alt="Cabal" src="https://img.shields.io/github/workflow/status/xmonad/xmonad-contrib/Haskell-CI?label=Cabal&logo=githubactions&logoColor=white">
|
|
||||||
</a>
|
|
||||||
<a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/nix.yml">
|
|
||||||
<img alt="Nix" src="https://img.shields.io/github/workflow/status/xmonad/xmonad-contrib/Nix?label=Nix&logo=githubactions&logoColor=white">
|
|
||||||
</a>
|
|
||||||
<br>
|
|
||||||
<a href="https://github.com/sponsors/xmonad">
|
|
||||||
<img alt="GitHub Sponsors" src="https://img.shields.io/github/sponsors/xmonad?label=GitHub%20Sponsors&logo=githubsponsors">
|
|
||||||
</a>
|
|
||||||
<a href="https://opencollective.com/xmonad">
|
|
||||||
<img alt="Open Collective" src="https://img.shields.io/opencollective/all/xmonad?label=Open%20Collective&logo=opencollective">
|
|
||||||
</a>
|
|
||||||
</p>
|
|
||||||
|
|
||||||
# xmonad-contrib
|
You need the ghc compiler and xmonad window manager installed in
|
||||||
|
order to use these extensions.
|
||||||
|
|
||||||
**Community-maintained extensions for the [XMonad][web:xmonad] window manager.**
|
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 core][gh:xmonad] is minimal, stable, yet extensible.
|
## Getting or Updating XMonadContrib
|
||||||
[xmonad-contrib][gh:xmonad-contrib] is home to hundreds of additional tiling
|
|
||||||
algorithms and extension modules. The two combined make for a powerful X11
|
|
||||||
window-manager with endless customization possibilities. They are, quite
|
|
||||||
literally, libraries for creating your own window manager.
|
|
||||||
|
|
||||||
## Installation
|
* Latest release: <https://hackage.haskell.org/package/xmonad-contrib>
|
||||||
|
|
||||||
For installation and configuration instructions, please see:
|
* Git version: <https://github.com/xmonad/xmonad-contrib>
|
||||||
|
|
||||||
* [downloading and installing xmonad][web:download]
|
(To use git xmonad-contrib you must also use the
|
||||||
* [installing latest xmonad snapshot from git][web:install]
|
[git version of xmonad] [xmonad-git].)
|
||||||
* [configuring xmonad][web:tutorial]
|
|
||||||
|
|
||||||
If you run into any trouble, consult our [documentation][web:documentation] or
|
|
||||||
ask the [community][web:community] for help.
|
|
||||||
|
|
||||||
## Contributing
|
## Contributing
|
||||||
|
|
||||||
We welcome all forms of contributions:
|
Haskell code contributed to this repo should live under the
|
||||||
|
appropriate subdivision of the `XMonad` namespace (currently includes
|
||||||
|
`Actions`, `Config`, `Hooks`, `Layout`, `Prompt`, and `Util`). For
|
||||||
|
example, to use the Grid layout, one would import:
|
||||||
|
|
||||||
* [bug reports and feature ideas][gh:xmonad-contrib:issues]
|
XMonad.Layout.Grid
|
||||||
(also to [xmonad][gh:xmonad:issues])
|
|
||||||
* [bug fixes, new features, new extensions][gh:xmonad-contrib:pulls]
|
|
||||||
(also to [xmonad][gh:xmonad:pulls])
|
|
||||||
* documentation fixes and improvements: [xmonad][gh:xmonad],
|
|
||||||
[xmonad-contrib][gh:xmonad-contrib], [xmonad-web][gh:xmonad-web]
|
|
||||||
* helping others in the [community][web:community]
|
|
||||||
* financial support: [GitHub Sponsors][gh:xmonad:sponsors],
|
|
||||||
[Open Collective][opencollective:xmonad]
|
|
||||||
|
|
||||||
Please do read the [CONTRIBUTING][gh:xmonad:contributing] document for more
|
For further details, see the [documentation] [developing] for the
|
||||||
information about bug reporting and code contributions. For a brief overview
|
`XMonad.Doc.Developing` module and the [xmonad website] [xmonad].
|
||||||
of the architecture and code conventions, see the [documentation for the
|
|
||||||
`XMonad.Doc.Developing` module][doc:developing]. If in doubt, [talk to
|
|
||||||
us][web:community].
|
|
||||||
|
|
||||||
## License
|
## License
|
||||||
|
|
||||||
Code submitted to the xmonad-contrib repo is licensed under the same license
|
Code submitted to the contrib repo is licensed under the same license as
|
||||||
as xmonad core itself, with copyright held by the authors.
|
xmonad itself, with copyright held by the authors.
|
||||||
|
|
||||||
[doc:developing]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html
|
[xmonad]: http://xmonad.org
|
||||||
[gh:xmonad-contrib:issues]: https://github.com/xmonad/xmonad-contrib/issues
|
[xmonad-git]: https://github.com/xmonad/xmonad
|
||||||
[gh:xmonad-contrib:pulls]: https://github.com/xmonad/xmonad-contrib/pulls
|
[xmonad-docs]: http://www.xmonad.org/xmonad-docs
|
||||||
[gh:xmonad-contrib]: https://github.com/xmonad/xmonad-contrib
|
[developing]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html
|
||||||
[gh:xmonad-web]: https://github.com/xmonad/xmonad-web
|
|
||||||
[gh:xmonad:contributing]: https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md
|
|
||||||
[gh:xmonad:issues]: https://github.com/xmonad/xmonad/issues
|
|
||||||
[gh:xmonad:pulls]: https://github.com/xmonad/xmonad/pulls
|
|
||||||
[gh:xmonad:sponsors]: https://github.com/sponsors/xmonad
|
|
||||||
[gh:xmonad]: https://github.com/xmonad/xmonad
|
|
||||||
[opencollective:xmonad]: https://opencollective.com/xmonad
|
|
||||||
[web:community]: https://xmonad.org/community.html
|
|
||||||
[web:documentation]: https://xmonad.org/documentation.html
|
|
||||||
[web:download]: https://xmonad.org/download.html
|
|
||||||
[web:install]: https://xmonad.org/INSTALL.html
|
|
||||||
[web:tutorial]: https://xmonad.org/TUTORIAL.html
|
|
||||||
[web:xmonad]: https://xmonad.org/
|
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.AfterDrag
|
-- Module : XMonad.Actions.AfterDrag
|
||||||
-- Description : Allows you to add actions dependent on the current mouse drag.
|
|
||||||
-- Copyright : (c) 2014 Anders Engstrom <ankaan@gmail.com>
|
-- Copyright : (c) 2014 Anders Engstrom <ankaan@gmail.com>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -20,8 +19,7 @@ module XMonad.Actions.AfterDrag (
|
|||||||
ifClick') where
|
ifClick') where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
|
import System.Time
|
||||||
import Data.Time (NominalDiffTime, diffUTCTime, getCurrentTime)
|
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||||
@@ -65,9 +63,9 @@ ifClick'
|
|||||||
-> X () -- ^ The action to take if the dragging turned out to not be a click.
|
-> X () -- ^ The action to take if the dragging turned out to not be a click.
|
||||||
-> X ()
|
-> X ()
|
||||||
ifClick' ms click drag = do
|
ifClick' ms click drag = do
|
||||||
start <- io getCurrentTime
|
start <- io $ getClockTime
|
||||||
afterDrag $ do
|
afterDrag $ do
|
||||||
stop <- io getCurrentTime
|
stop <- io $ getClockTime
|
||||||
if diffUTCTime stop start <= (fromIntegral ms / 10^(3 :: Integer) :: NominalDiffTime)
|
if diffClockTimes stop start <= noTimeDiff { tdPicosec = fromIntegral ms * 10^(9 :: Integer) }
|
||||||
then click
|
then click
|
||||||
else drag
|
else drag
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
----------------------------------------------------------------------------
|
----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.BluetileCommands
|
-- Module : XMonad.Actions.BluetileCommands
|
||||||
-- Description : Interface with the [Bluetile](https://hackage.haskell.org/package/bluetile) tiling window manager.
|
|
||||||
-- Copyright : (c) Jan Vornberger 2009
|
-- Copyright : (c) Jan Vornberger 2009
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -25,6 +24,7 @@ module XMonad.Actions.BluetileCommands (
|
|||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
|
import XMonad.Layout.LayoutCombinators
|
||||||
import System.Exit
|
import System.Exit
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
@@ -43,7 +43,7 @@ import System.Exit
|
|||||||
|
|
||||||
workspaceCommands :: Int -> X [(String, X ())]
|
workspaceCommands :: Int -> X [(String, X ())]
|
||||||
workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return
|
workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return
|
||||||
[( "greedyView" ++ show i,
|
[(("greedyView" ++ show i),
|
||||||
activateScreen sid >> windows (W.greedyView i))
|
activateScreen sid >> windows (W.greedyView i))
|
||||||
| i <- spaces ]
|
| i <- spaces ]
|
||||||
|
|
||||||
@@ -66,7 +66,7 @@ masterAreaCommands sid = [ ("increase master n", activateScreen sid >>
|
|||||||
]
|
]
|
||||||
|
|
||||||
quitCommands :: [(String, X ())]
|
quitCommands :: [(String, X ())]
|
||||||
quitCommands = [ ("quit bluetile", io exitSuccess)
|
quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess))
|
||||||
, ("quit bluetile and start metacity", restart "metacity" False)
|
, ("quit bluetile and start metacity", restart "metacity" False)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.Commands
|
-- Module : XMonad.Actions.Commands
|
||||||
-- Description : Run internal xmonad commands using a dmenu menu.
|
|
||||||
-- Copyright : (c) David Glasser 2007
|
-- Copyright : (c) David Glasser 2007
|
||||||
-- License : BSD3
|
-- License : BSD3
|
||||||
--
|
--
|
||||||
@@ -20,7 +19,6 @@ module XMonad.Actions.Commands (
|
|||||||
-- $usage
|
-- $usage
|
||||||
commandMap,
|
commandMap,
|
||||||
runCommand,
|
runCommand,
|
||||||
runCommandConfig,
|
|
||||||
runCommand',
|
runCommand',
|
||||||
workspaceCommands,
|
workspaceCommands,
|
||||||
screenCommands,
|
screenCommands,
|
||||||
@@ -33,7 +31,7 @@ import XMonad.Util.Dmenu (dmenu)
|
|||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import XMonad.Prelude
|
import Data.Maybe
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
--
|
--
|
||||||
@@ -62,18 +60,18 @@ import XMonad.Prelude
|
|||||||
-- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a
|
-- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a
|
||||||
-- list of pairs.
|
-- list of pairs.
|
||||||
commandMap :: [(String, X ())] -> M.Map String (X ())
|
commandMap :: [(String, X ())] -> M.Map String (X ())
|
||||||
commandMap = M.fromList
|
commandMap c = M.fromList c
|
||||||
|
|
||||||
-- | Generate a list of commands to switch to\/send windows to workspaces.
|
-- | Generate a list of commands to switch to\/send windows to workspaces.
|
||||||
workspaceCommands :: X [(String, X ())]
|
workspaceCommands :: X [(String, X ())]
|
||||||
workspaceCommands = asks (workspaces . config) >>= \spaces -> return
|
workspaceCommands = asks (workspaces . config) >>= \spaces -> return
|
||||||
[( m ++ show i, windows $ f i)
|
[((m ++ show i), windows $ f i)
|
||||||
| i <- spaces
|
| i <- spaces
|
||||||
, (f, m) <- [(view, "view"), (shift, "shift")] ]
|
, (f, m) <- [(view, "view"), (shift, "shift")] ]
|
||||||
|
|
||||||
-- | Generate a list of commands dealing with multiple screens.
|
-- | Generate a list of commands dealing with multiple screens.
|
||||||
screenCommands :: [(String, X ())]
|
screenCommands :: [(String, X ())]
|
||||||
screenCommands = [( m ++ show sc, screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))
|
screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))
|
||||||
| sc <- [0, 1]::[Int] -- TODO: adapt to screen changes
|
| sc <- [0, 1]::[Int] -- TODO: adapt to screen changes
|
||||||
, (f, m) <- [(view, "screen"), (shift, "screen-to-")]
|
, (f, m) <- [(view, "screen"), (shift, "screen-to-")]
|
||||||
]
|
]
|
||||||
@@ -101,22 +99,15 @@ defaultCommands = do
|
|||||||
, ("swap-down" , windows swapDown )
|
, ("swap-down" , windows swapDown )
|
||||||
, ("swap-master" , windows swapMaster )
|
, ("swap-master" , windows swapMaster )
|
||||||
, ("sink" , withFocused $ windows . sink )
|
, ("sink" , withFocused $ windows . sink )
|
||||||
, ("quit-wm" , io exitSuccess )
|
, ("quit-wm" , io $ exitWith ExitSuccess )
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | Given a list of command\/action pairs, prompt the user to choose a
|
-- | 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 :: [(String, X ())] -> X ()
|
||||||
runCommand = runCommandConfig dmenu
|
runCommand cl = do
|
||||||
|
|
||||||
|
|
||||||
-- | 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
|
|
||||||
let m = commandMap cl
|
let m = commandMap cl
|
||||||
choice <- f (M.keys m)
|
choice <- dmenu (M.keys m)
|
||||||
fromMaybe (return ()) (M.lookup choice m)
|
fromMaybe (return ()) (M.lookup choice m)
|
||||||
|
|
||||||
-- | Given the name of a command from 'defaultCommands', return the
|
-- | Given the name of a command from 'defaultCommands', return the
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.ConstrainedResize
|
-- Module : XMonad.Actions.ConstrainedResize
|
||||||
-- Description : Constrain the aspect ratio of a floating window.
|
|
||||||
-- Copyright : (c) Dougal Stanton
|
-- Copyright : (c) Dougal Stanton
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -45,6 +44,7 @@ import XMonad
|
|||||||
-- | Resize (floating) window with optional aspect ratio constraints.
|
-- | Resize (floating) window with optional aspect ratio constraints.
|
||||||
mouseResizeWindow :: Window -> Bool -> X ()
|
mouseResizeWindow :: Window -> Bool -> X ()
|
||||||
mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do
|
mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do
|
||||||
|
io $ raiseWindow d w
|
||||||
wa <- io $ getWindowAttributes d w
|
wa <- io $ getWindowAttributes d w
|
||||||
sh <- io $ getWMNormalHints d w
|
sh <- io $ getWMNormalHints d w
|
||||||
io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
|
io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
|
||||||
@@ -53,6 +53,5 @@ mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do
|
|||||||
y = ey - fromIntegral (wa_y wa)
|
y = ey - fromIntegral (wa_y wa)
|
||||||
sz = if c then (max x y, max x y) else (x,y)
|
sz = if c then (max x y, max x y) else (x,y)
|
||||||
io $ resizeWindow d w `uncurry`
|
io $ resizeWindow d w `uncurry`
|
||||||
applySizeHintsContents sh sz
|
applySizeHintsContents sh sz)
|
||||||
float w)
|
|
||||||
(float w)
|
(float w)
|
||||||
|
@@ -1,9 +1,7 @@
|
|||||||
{-# LANGUAGE PatternGuards #-}
|
{-# LANGUAGE PatternGuards #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.CopyWindow
|
-- Module : XMonad.Actions.CopyWindow
|
||||||
-- Description : Duplicate a window on multiple workspaces.
|
|
||||||
-- Copyright : (c) David Roundy <droundy@darcs.net>, Ivan Veselov <veselov@gmail.com>, Lanny Ripple <lan3ny@gmail.com>
|
-- Copyright : (c) David Roundy <droundy@darcs.net>, Ivan Veselov <veselov@gmail.com>, Lanny Ripple <lan3ny@gmail.com>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -20,19 +18,17 @@ module XMonad.Actions.CopyWindow (
|
|||||||
-- * Usage
|
-- * Usage
|
||||||
-- $usage
|
-- $usage
|
||||||
copy, copyToAll, copyWindow, runOrCopy
|
copy, copyToAll, copyWindow, runOrCopy
|
||||||
, killAllOtherCopies, kill1, taggedWindows, copiesOfOn
|
, killAllOtherCopies, kill1
|
||||||
-- * Highlight workspaces containing copies in logHook
|
-- * Highlight workspaces containing copies in logHook
|
||||||
-- $logHook
|
-- $logHook
|
||||||
, wsContainingCopies, copiesPP
|
, wsContainingCopies
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude
|
|
||||||
import Control.Arrow ((&&&))
|
import Control.Arrow ((&&&))
|
||||||
import qualified Data.List as L
|
import qualified Data.List as L
|
||||||
|
|
||||||
import XMonad.Actions.WindowGo
|
import XMonad.Actions.WindowGo
|
||||||
import XMonad.Hooks.StatusBar.PP (PP(..), WS(..), isHidden)
|
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
@@ -80,24 +76,18 @@ import qualified XMonad.StackSet as W
|
|||||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||||
|
|
||||||
-- $logHook
|
-- $logHook
|
||||||
|
-- To distinguish workspaces containing copies of the focused window use
|
||||||
|
-- something like:
|
||||||
--
|
--
|
||||||
-- To distinguish workspaces containing copies of the focused window, use 'copiesPP'.
|
-- > sampleLogHook h = do
|
||||||
-- 'copiesPP' takes a pretty printer and makes it aware of copies of the focused window.
|
-- > copies <- wsContainingCopies
|
||||||
-- It can be applied when creating a 'XMonad.Hooks.StatusBar.StatusBarConfig'.
|
-- > let check ws | ws `elem` copies = pad . xmobarColor "red" "black" $ ws
|
||||||
--
|
-- > | otherwise = pad ws
|
||||||
-- A sample config looks like this:
|
-- > dynamicLogWithPP myPP {ppHidden = check, ppOutput = hPutStrLn h}
|
||||||
--
|
-- >
|
||||||
-- > mySB = statusBarProp "xmobar" (copiesPP (pad . xmobarColor "red" "black") xmobarPP)
|
-- > main = do
|
||||||
-- > main = xmonad $ withEasySB mySB defToggleStrutsKey def
|
-- > h <- spawnPipe "xmobar"
|
||||||
|
-- > xmonad def { logHook = sampleLogHook h }
|
||||||
-- | Take a pretty printer and make it aware of copies by using the provided function
|
|
||||||
-- to show hidden workspaces that contain copies of the focused window.
|
|
||||||
copiesPP :: (WorkspaceId -> String) -> PP -> X PP
|
|
||||||
copiesPP wtoS pp = do
|
|
||||||
copies <- wsContainingCopies
|
|
||||||
let check WS{..} = W.tag wsWS `elem` copies
|
|
||||||
let printer = (asks (isHidden <&&> check) >>= guard) $> wtoS
|
|
||||||
return pp{ ppPrinters = printer <|> ppPrinters pp }
|
|
||||||
|
|
||||||
-- | Copy the focused window to a workspace.
|
-- | Copy the focused window to a workspace.
|
||||||
copy :: (Eq s, Eq i, Eq a) => i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
|
copy :: (Eq s, Eq i, Eq a) => i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
|
||||||
@@ -106,7 +96,7 @@ copy n s | Just w <- W.peek s = copyWindow w n s
|
|||||||
|
|
||||||
-- | Copy the focused window to all workspaces.
|
-- | Copy the focused window to all workspaces.
|
||||||
copyToAll :: (Eq s, Eq i, Eq a) => W.StackSet i l a s sd -> W.StackSet i l a s sd
|
copyToAll :: (Eq s, Eq i, Eq a) => W.StackSet i l a s sd -> W.StackSet i l a s sd
|
||||||
copyToAll s = foldr (copy . W.tag) s (W.workspaces s)
|
copyToAll s = foldr copy s $ map W.tag (W.workspaces s)
|
||||||
|
|
||||||
-- | Copy an arbitrary window to a workspace.
|
-- | Copy an arbitrary window to a workspace.
|
||||||
copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
|
copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
|
||||||
@@ -152,9 +142,9 @@ killAllOtherCopies = do ss <- gets windowset
|
|||||||
W.view (W.currentTag ss) .
|
W.view (W.currentTag ss) .
|
||||||
delFromAllButCurrent w
|
delFromAllButCurrent w
|
||||||
where
|
where
|
||||||
delFromAllButCurrent w ss = foldr (delWinFromWorkspace w . W.tag)
|
delFromAllButCurrent w ss = foldr ($) ss $
|
||||||
ss
|
map (delWinFromWorkspace w . W.tag) $
|
||||||
(W.hidden ss ++ map W.workspace (W.visible ss))
|
W.hidden ss ++ map W.workspace (W.visible ss)
|
||||||
delWinFromWorkspace w wid = viewing wid $ W.modify Nothing (W.filter (/= w))
|
delWinFromWorkspace w wid = viewing wid $ W.modify Nothing (W.filter (/= w))
|
||||||
|
|
||||||
viewing wis f ss = W.view (W.currentTag ss) $ f $ W.view wis ss
|
viewing wis f ss = W.view (W.currentTag ss) $ f $ W.view wis ss
|
||||||
|
@@ -1,10 +1,6 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
|
||||||
{-# LANGUAGE PatternGuards #-}
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.CycleRecentWS
|
-- Module : XMonad.Actions.CycleRecentWS
|
||||||
-- Description : Cycle through most recently used workspaces.
|
|
||||||
-- Copyright : (c) Michal Janeczek <janeczek@gmail.com>
|
-- Copyright : (c) Michal Janeczek <janeczek@gmail.com>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -23,23 +19,11 @@ module XMonad.Actions.CycleRecentWS (
|
|||||||
-- * Usage
|
-- * Usage
|
||||||
-- $usage
|
-- $usage
|
||||||
cycleRecentWS,
|
cycleRecentWS,
|
||||||
cycleRecentNonEmptyWS,
|
cycleWindowSets
|
||||||
cycleWindowSets,
|
|
||||||
toggleRecentWS,
|
|
||||||
toggleRecentNonEmptyWS,
|
|
||||||
toggleWindowSets,
|
|
||||||
recentWS,
|
|
||||||
|
|
||||||
#ifdef TESTING
|
|
||||||
unView,
|
|
||||||
#endif
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad hiding (workspaces)
|
import XMonad hiding (workspaces)
|
||||||
import XMonad.StackSet hiding (filter)
|
import XMonad.StackSet
|
||||||
|
|
||||||
import Control.Arrow ((&&&))
|
|
||||||
import Data.Function (on)
|
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
|
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
|
||||||
@@ -63,61 +47,33 @@ cycleRecentWS :: [KeySym] -- ^ A list of modifier keys used when invoking this a
|
|||||||
-> KeySym -- ^ Key used to switch to previous (more recent) workspace.
|
-> KeySym -- ^ Key used to switch to previous (more recent) workspace.
|
||||||
-- If it's the same as the nextWorkspace key, it is effectively ignored.
|
-- If it's the same as the nextWorkspace key, it is effectively ignored.
|
||||||
-> X ()
|
-> X ()
|
||||||
cycleRecentWS = cycleWindowSets $ recentWS (const True)
|
cycleRecentWS = cycleWindowSets options
|
||||||
|
where options w = map (view `flip` w) (recentTags w)
|
||||||
|
recentTags w = map tag $ tail (workspaces w) ++ [head (workspaces w)]
|
||||||
|
|
||||||
|
|
||||||
-- | Like 'cycleRecentWS', but restricted to non-empty workspaces.
|
cycref :: [a] -> Int -> a
|
||||||
cycleRecentNonEmptyWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action.
|
cycref l i = l !! (i `mod` length l)
|
||||||
-- As soon as one of them is released, the final switch is made.
|
|
||||||
-> KeySym -- ^ Key used to switch to next (less recent) workspace.
|
|
||||||
-> KeySym -- ^ Key used to switch to previous (more recent) workspace.
|
|
||||||
-- If it's the same as the nextWorkspace key, it is effectively ignored.
|
|
||||||
-> X ()
|
|
||||||
cycleRecentNonEmptyWS = cycleWindowSets $ recentWS (not . null . stack)
|
|
||||||
|
|
||||||
|
-- | Cycle through a finite list of WindowSets with repeated presses of a key, while
|
||||||
-- | Switch to the most recent workspace. The stack of most recently used workspaces
|
|
||||||
-- is updated, so repeated use toggles between a pair of workspaces.
|
|
||||||
toggleRecentWS :: X ()
|
|
||||||
toggleRecentWS = toggleWindowSets $ recentWS (const True)
|
|
||||||
|
|
||||||
|
|
||||||
-- | Like 'toggleRecentWS', but restricted to non-empty workspaces.
|
|
||||||
toggleRecentNonEmptyWS :: X ()
|
|
||||||
toggleRecentNonEmptyWS = toggleWindowSets $ recentWS (not . null . stack)
|
|
||||||
|
|
||||||
|
|
||||||
-- | Given a predicate @p@ and the current 'WindowSet' @w@, create a
|
|
||||||
-- list of workspaces to choose from. They are ordered by recency and
|
|
||||||
-- have to satisfy @p@.
|
|
||||||
recentWS :: (WindowSpace -> Bool) -- ^ A workspace predicate.
|
|
||||||
-> WindowSet -- ^ The current WindowSet
|
|
||||||
-> [WorkspaceId]
|
|
||||||
recentWS p w = map tag
|
|
||||||
$ filter p
|
|
||||||
$ map workspace (visible w)
|
|
||||||
++ hidden w
|
|
||||||
++ [workspace (current w)]
|
|
||||||
|
|
||||||
-- | Cycle through a finite list of workspaces with repeated presses of a key, while
|
|
||||||
-- a modifier key is held down. For best effects use the same modkey+key combination
|
-- a modifier key is held down. For best effects use the same modkey+key combination
|
||||||
-- as the one used to invoke this action.
|
-- as the one used to invoke this action.
|
||||||
cycleWindowSets :: (WindowSet -> [WorkspaceId]) -- ^ A function used to create a list of workspaces to choose from
|
cycleWindowSets :: (WindowSet -> [WindowSet]) -- ^ A function used to create a list of WindowSets to choose from
|
||||||
-> [KeySym] -- ^ A list of modifier keys used when invoking this action.
|
-> [KeySym] -- ^ A list of modifier keys used when invoking this action.
|
||||||
-- As soon as one of them is released, the final workspace is chosen and the action exits.
|
-- As soon as one of them is released, the final WindowSet is chosen and the action exits.
|
||||||
-> KeySym -- ^ Key used to preview next workspace from the list of generated options
|
-> KeySym -- ^ Key used to preview next WindowSet from the list of generated options
|
||||||
-> KeySym -- ^ Key used to preview previous workspace from the list of generated options.
|
-> KeySym -- ^ Key used to preview previous WindowSet from the list of generated options.
|
||||||
-- If it's the same as nextOption key, it is effectively ignored.
|
-- If it's the same as nextOption key, it is effectively ignored.
|
||||||
-> X ()
|
-> X ()
|
||||||
cycleWindowSets genOptions mods keyNext keyPrev = do
|
cycleWindowSets genOptions mods keyNext keyPrev = do
|
||||||
(options, unView') <- gets $ (genOptions &&& unView) . windowset
|
options <- gets $ genOptions . windowset
|
||||||
XConf {theRoot = root, display = d} <- ask
|
XConf {theRoot = root, display = d} <- ask
|
||||||
let event = allocaXEvent $ \p -> do
|
let event = allocaXEvent $ \p -> do
|
||||||
maskEvent d (keyPressMask .|. keyReleaseMask) p
|
maskEvent d (keyPressMask .|. keyReleaseMask) p
|
||||||
KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
|
KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
|
||||||
s <- keycodeToKeysym d c 0
|
s <- keycodeToKeysym d c 0
|
||||||
return (t, s)
|
return (t, s)
|
||||||
let setOption n = do windows $ view (options `cycref` n) . unView'
|
let setOption n = do windows $ const $ options `cycref` n
|
||||||
(t, s) <- io event
|
(t, s) <- io event
|
||||||
case () of
|
case () of
|
||||||
() | t == keyPress && s == keyNext -> setOption (n+1)
|
() | t == keyPress && s == keyNext -> setOption (n+1)
|
||||||
@@ -127,37 +83,3 @@ cycleWindowSets genOptions mods keyNext keyPrev = do
|
|||||||
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
|
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
|
||||||
setOption 0
|
setOption 0
|
||||||
io $ ungrabKeyboard d currentTime
|
io $ ungrabKeyboard d currentTime
|
||||||
where
|
|
||||||
cycref :: [a] -> Int -> a
|
|
||||||
cycref l i = l !! (i `mod` length l)
|
|
||||||
|
|
||||||
-- | Given an old and a new 'WindowSet', which is __exactly__ one
|
|
||||||
-- 'view' away from the old one, restore the workspace order of the
|
|
||||||
-- former inside of the latter. This respects any new state that the
|
|
||||||
-- new 'WindowSet' may have accumulated.
|
|
||||||
unView :: forall i l a s sd. (Eq i, Eq s)
|
|
||||||
=> StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd
|
|
||||||
unView w0 w1 = fixOrderH . fixOrderV . view' (currentTag w0) $ w1
|
|
||||||
where
|
|
||||||
view' = if screen (current w0) == screen (current w1) then greedyView else view
|
|
||||||
fixOrderV w | v : vs <- visible w = w{ visible = insertAt (pfxV (visible w0) vs) v vs }
|
|
||||||
| otherwise = w
|
|
||||||
fixOrderH w | h : hs <- hidden w = w{ hidden = insertAt (pfxH (hidden w0) hs) h hs }
|
|
||||||
| otherwise = w
|
|
||||||
pfxV = commonPrefix `on` fmap (tag . workspace)
|
|
||||||
pfxH = commonPrefix `on` fmap tag
|
|
||||||
|
|
||||||
insertAt :: Int -> x -> [x] -> [x]
|
|
||||||
insertAt n x xs = let (l, r) = splitAt n xs in l ++ [x] ++ r
|
|
||||||
|
|
||||||
commonPrefix :: Eq x => [x] -> [x] -> Int
|
|
||||||
commonPrefix a b = length $ takeWhile id $ zipWith (==) a b
|
|
||||||
|
|
||||||
-- | Given some function that generates a list of workspaces from a
|
|
||||||
-- given 'WindowSet', switch to the first generated workspace.
|
|
||||||
toggleWindowSets :: (WindowSet -> [WorkspaceId]) -> X ()
|
|
||||||
toggleWindowSets genOptions = do
|
|
||||||
options <- gets $ genOptions . windowset
|
|
||||||
case options of
|
|
||||||
[] -> return ()
|
|
||||||
o:_ -> windows (view o)
|
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.CycleSelectedLayouts
|
-- Module : XMonad.Actions.CycleSelectedLayouts
|
||||||
-- Description : Cycle through the given subset of layouts.
|
|
||||||
-- Copyright : (c) Roman Cheplyaka
|
-- Copyright : (c) Roman Cheplyaka
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -19,21 +18,27 @@ module XMonad.Actions.CycleSelectedLayouts (
|
|||||||
cycleThroughLayouts) where
|
cycleThroughLayouts) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude (elemIndex, fromMaybe)
|
import Data.List (findIndex)
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import XMonad.Layout.LayoutCombinators (JumpToLayout(..))
|
||||||
import qualified XMonad.StackSet as S
|
import qualified XMonad.StackSet as S
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||||
--
|
--
|
||||||
-- > import XMonad
|
-- > import XMonad hiding ((|||))
|
||||||
|
-- > import XMonad.Layout.LayoutCombinators ((|||))
|
||||||
-- > import XMonad.Actions.CycleSelectedLayouts
|
-- > import XMonad.Actions.CycleSelectedLayouts
|
||||||
--
|
--
|
||||||
-- > , ((modm, xK_t ), cycleThroughLayouts ["Tall", "Mirror Tall"])
|
-- > , ((modm, xK_t ), cycleThroughLayouts ["Tall", "Mirror Tall"])
|
||||||
|
--
|
||||||
|
-- Make sure you are using NewSelect from XMonad.Layout.LayoutCombinators,
|
||||||
|
-- rather than the Select defined in xmonad core.
|
||||||
|
|
||||||
cycleToNext :: (Eq a) => [a] -> a -> Maybe a
|
cycleToNext :: (Eq a) => [a] -> a -> Maybe a
|
||||||
cycleToNext lst a = do
|
cycleToNext lst a = do
|
||||||
-- not beautiful but simple and readable
|
-- not beautiful but simple and readable
|
||||||
ind <- elemIndex a lst
|
ind <- findIndex (a==) lst
|
||||||
return $ lst !! if ind == length lst - 1 then 0 else ind+1
|
return $ lst !! if ind == length lst - 1 then 0 else ind+1
|
||||||
|
|
||||||
-- | If the current layout is in the list, cycle to the next layout. Otherwise,
|
-- | If the current layout is in the list, cycle to the next layout. Otherwise,
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.CycleWS
|
-- Module : XMonad.Actions.CycleWS
|
||||||
-- Description : Cycle through workspaces.
|
|
||||||
-- Copyright : (c) Joachim Breitner <mail@joachim-breitner.de>,
|
-- Copyright : (c) Joachim Breitner <mail@joachim-breitner.de>,
|
||||||
-- Nelson Elhage <nelhage@mit.edu> (`toggleWS' function)
|
-- Nelson Elhage <nelhage@mit.edu> (`toggleWS' function)
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
@@ -19,13 +18,13 @@
|
|||||||
--
|
--
|
||||||
-- Note that this module now subsumes the functionality of the former
|
-- Note that this module now subsumes the functionality of the former
|
||||||
-- @XMonad.Actions.RotView@. Former users of @rotView@ can simply replace
|
-- @XMonad.Actions.RotView@. Former users of @rotView@ can simply replace
|
||||||
-- @rotView True@ with @moveTo Next (Not emptyWS)@, and so on.
|
-- @rotView True@ with @moveTo Next NonEmptyWS@, and so on.
|
||||||
--
|
--
|
||||||
-- If you want to exactly replicate the action of @rotView@ (cycling
|
-- If you want to exactly replicate the action of @rotView@ (cycling
|
||||||
-- through workspace in order lexicographically by tag, instead of in
|
-- through workspace in order lexicographically by tag, instead of in
|
||||||
-- the order specified in the config), it can be implemented as:
|
-- the order specified in the config), it can be implemented as:
|
||||||
--
|
--
|
||||||
-- > rotView b = do t <- findWorkspace getSortByTag (bToDir b) (Not emptyWS) 1
|
-- > rotView b = do t <- findWorkspace getSortByTag (bToDir b) NonEmptyWS 1
|
||||||
-- > windows . greedyView $ t
|
-- > windows . greedyView $ t
|
||||||
-- > where bToDir True = Next
|
-- > where bToDir True = Next
|
||||||
-- > bToDir False = Prev
|
-- > bToDir False = Prev
|
||||||
@@ -64,11 +63,6 @@ module XMonad.Actions.CycleWS (
|
|||||||
|
|
||||||
, Direction1D(..)
|
, Direction1D(..)
|
||||||
, WSType(..)
|
, WSType(..)
|
||||||
, emptyWS
|
|
||||||
, hiddenWS
|
|
||||||
, anyWS
|
|
||||||
, wsTagGroup
|
|
||||||
, ignoringWSs
|
|
||||||
|
|
||||||
, shiftTo
|
, shiftTo
|
||||||
, moveTo
|
, moveTo
|
||||||
@@ -84,7 +78,9 @@ module XMonad.Actions.CycleWS (
|
|||||||
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad.Prelude (find, findIndex, isJust, isNothing, liftM2)
|
import Data.List ( find, findIndex )
|
||||||
|
import Data.Maybe ( isNothing, isJust )
|
||||||
|
|
||||||
import XMonad hiding (workspaces)
|
import XMonad hiding (workspaces)
|
||||||
import qualified XMonad.Hooks.WorkspaceHistory as WH
|
import qualified XMonad.Hooks.WorkspaceHistory as WH
|
||||||
import XMonad.StackSet hiding (filter)
|
import XMonad.StackSet hiding (filter)
|
||||||
@@ -116,9 +112,9 @@ import XMonad.Util.WorkspaceCompare
|
|||||||
-- You can also get fancier with 'moveTo', 'shiftTo', and 'findWorkspace'.
|
-- You can also get fancier with 'moveTo', 'shiftTo', and 'findWorkspace'.
|
||||||
-- For example:
|
-- For example:
|
||||||
--
|
--
|
||||||
-- > , ((modm , xK_f), moveTo Next emptyWS) -- find a free workspace
|
-- > , ((modm , xK_f), moveTo Next EmptyWS) -- find a free workspace
|
||||||
-- > , ((modm .|. controlMask, xK_Right), -- a crazy keybinding!
|
-- > , ((modm .|. controlMask, xK_Right), -- a crazy keybinding!
|
||||||
-- > do t <- findWorkspace getSortByXineramaRule Next (Not emptyWS) 2
|
-- > do t <- findWorkspace getSortByXineramaRule Next NonEmptyWS 2
|
||||||
-- > windows . view $ t )
|
-- > windows . view $ t )
|
||||||
--
|
--
|
||||||
-- For detailed instructions on editing your key bindings, see
|
-- For detailed instructions on editing your key bindings, see
|
||||||
@@ -205,7 +201,8 @@ skipTags wss ids = filter ((`notElem` ids) . tag) wss
|
|||||||
lastViewedHiddenExcept :: [WorkspaceId] -> X (Maybe WorkspaceId)
|
lastViewedHiddenExcept :: [WorkspaceId] -> X (Maybe WorkspaceId)
|
||||||
lastViewedHiddenExcept skips = do
|
lastViewedHiddenExcept skips = do
|
||||||
hs <- gets $ map tag . flip skipTags skips . hidden . windowset
|
hs <- gets $ map tag . flip skipTags skips . hidden . windowset
|
||||||
choose hs . find (`elem` hs) <$> WH.workspaceHistory
|
vs <- WH.workspaceHistory
|
||||||
|
return $ choose hs (find (`elem` hs) vs)
|
||||||
where choose [] _ = Nothing
|
where choose [] _ = Nothing
|
||||||
choose (h:_) Nothing = Just h
|
choose (h:_) Nothing = Just h
|
||||||
choose _ vh@(Just _) = vh
|
choose _ vh@(Just _) = vh
|
||||||
@@ -216,8 +213,8 @@ switchWorkspace d = wsBy d >>= windows . greedyView
|
|||||||
shiftBy :: Int -> X ()
|
shiftBy :: Int -> X ()
|
||||||
shiftBy d = wsBy d >>= windows . shift
|
shiftBy d = wsBy d >>= windows . shift
|
||||||
|
|
||||||
wsBy :: Int -> X WorkspaceId
|
wsBy :: Int -> X (WorkspaceId)
|
||||||
wsBy = findWorkspace getSortByIndex Next anyWS
|
wsBy = findWorkspace getSortByIndex Next AnyWS
|
||||||
|
|
||||||
{- $taketwo
|
{- $taketwo
|
||||||
|
|
||||||
@@ -226,7 +223,7 @@ through subsets of workspaces.
|
|||||||
|
|
||||||
For example,
|
For example,
|
||||||
|
|
||||||
> moveTo Next emptyWS
|
> moveTo Next EmptyWS
|
||||||
|
|
||||||
will move to the first available workspace with no windows, and
|
will move to the first available workspace with no windows, and
|
||||||
|
|
||||||
@@ -237,19 +234,11 @@ the letter 'p' in its name. =)
|
|||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# DEPRECATED EmptyWS "Use emptyWS instead." #-}
|
|
||||||
{-# DEPRECATED HiddenWS "Use hiddenWS instead." #-}
|
|
||||||
{-# DEPRECATED NonEmptyWS "Use Not emptyWS instead." #-}
|
|
||||||
{-# DEPRECATED HiddenNonEmptyWS "Use hiddenWS :&: Not emptyWS instead." #-}
|
|
||||||
{-# DEPRECATED HiddenEmptyWS "Use hiddenWS :&: emptyWS instead." #-}
|
|
||||||
{-# DEPRECATED AnyWS "Use anyWS instead." #-}
|
|
||||||
{-# DEPRECATED WSTagGroup "Use wsTagGroup instead." #-}
|
|
||||||
-- | What type of workspaces should be included in the cycle?
|
-- | What type of workspaces should be included in the cycle?
|
||||||
data WSType = EmptyWS -- ^ cycle through empty workspaces
|
data WSType = EmptyWS -- ^ cycle through empty workspaces
|
||||||
| NonEmptyWS -- ^ cycle through non-empty workspaces
|
| NonEmptyWS -- ^ cycle through non-empty workspaces
|
||||||
| HiddenWS -- ^ cycle through non-visible workspaces
|
| HiddenWS -- ^ cycle through non-visible workspaces
|
||||||
| HiddenNonEmptyWS -- ^ cycle through non-empty non-visible workspaces
|
| HiddenNonEmptyWS -- ^ cycle through non-empty non-visible workspaces
|
||||||
| HiddenEmptyWS -- ^ cycle through empty non-visible workspaces
|
|
||||||
| AnyWS -- ^ cycle through all workspaces
|
| AnyWS -- ^ cycle through all workspaces
|
||||||
| WSTagGroup Char
|
| WSTagGroup Char
|
||||||
-- ^ cycle through workspaces in the same group, the
|
-- ^ cycle through workspaces in the same group, the
|
||||||
@@ -258,11 +247,6 @@ data WSType = EmptyWS -- ^ cycle through empty workspaces
|
|||||||
| WSIs (X (WindowSpace -> Bool))
|
| WSIs (X (WindowSpace -> Bool))
|
||||||
-- ^ cycle through workspaces satisfying
|
-- ^ cycle through workspaces satisfying
|
||||||
-- an arbitrary predicate
|
-- an arbitrary predicate
|
||||||
| WSType :&: WSType -- ^ cycle through workspaces satisfying both
|
|
||||||
-- predicates.
|
|
||||||
| WSType :|: WSType -- ^ cycle through workspaces satisfying one of
|
|
||||||
-- the predicates.
|
|
||||||
| Not WSType -- ^ cycle through workspaces not satisfying the predicate
|
|
||||||
|
|
||||||
-- | Convert a WSType value to a predicate on workspaces.
|
-- | Convert a WSType value to a predicate on workspaces.
|
||||||
wsTypeToPred :: WSType -> X (WindowSpace -> Bool)
|
wsTypeToPred :: WSType -> X (WindowSpace -> Bool)
|
||||||
@@ -273,50 +257,11 @@ wsTypeToPred HiddenWS = do hs <- gets (map tag . hidden . windowset)
|
|||||||
wsTypeToPred HiddenNonEmptyWS = do ne <- wsTypeToPred NonEmptyWS
|
wsTypeToPred HiddenNonEmptyWS = do ne <- wsTypeToPred NonEmptyWS
|
||||||
hi <- wsTypeToPred HiddenWS
|
hi <- wsTypeToPred HiddenWS
|
||||||
return (\w -> hi w && ne w)
|
return (\w -> hi w && ne w)
|
||||||
wsTypeToPred HiddenEmptyWS = do ne <- wsTypeToPred EmptyWS
|
|
||||||
hi <- wsTypeToPred HiddenWS
|
|
||||||
return (\w -> hi w && ne w)
|
|
||||||
wsTypeToPred AnyWS = return (const True)
|
wsTypeToPred AnyWS = return (const True)
|
||||||
wsTypeToPred (WSTagGroup sep) = do cur <- groupName.workspace.current <$> gets windowset
|
wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) `fmap` gets windowset
|
||||||
return $ (cur ==).groupName
|
return $ (cur ==).groupName
|
||||||
where groupName = takeWhile (/=sep).tag
|
where groupName = takeWhile (/=sep).tag
|
||||||
wsTypeToPred (WSIs p ) = p
|
wsTypeToPred (WSIs p) = p
|
||||||
wsTypeToPred (p :&: q) = liftM2 (&&) <$> wsTypeToPred p <*> wsTypeToPred q
|
|
||||||
wsTypeToPred (p :|: q) = liftM2 (||) <$> wsTypeToPred p <*> wsTypeToPred q
|
|
||||||
wsTypeToPred (Not p ) = fmap not <$> wsTypeToPred p
|
|
||||||
|
|
||||||
-- | Cycle through empty workspaces
|
|
||||||
emptyWS :: WSType
|
|
||||||
emptyWS = WSIs . return $ isNothing . stack
|
|
||||||
|
|
||||||
-- | Cycle through non-visible workspaces
|
|
||||||
hiddenWS :: WSType
|
|
||||||
hiddenWS = WSIs $ do
|
|
||||||
hs <- gets (map tag . hidden . windowset)
|
|
||||||
return $ (`elem` hs) . tag
|
|
||||||
|
|
||||||
-- | Cycle through all workspaces
|
|
||||||
anyWS :: WSType
|
|
||||||
anyWS = WSIs . return $ const True
|
|
||||||
|
|
||||||
-- | Cycle through workspaces that are not in the given list. This could, for
|
|
||||||
-- example, be used for skipping the workspace reserved for
|
|
||||||
-- "XMonad.Util.NamedScratchpad":
|
|
||||||
--
|
|
||||||
-- > moveTo Next $ hiddenWS :&: Not emptyWS :&: ignoringWSs [scratchpadWorkspaceTag]
|
|
||||||
--
|
|
||||||
ignoringWSs :: [WorkspaceId] -> WSType
|
|
||||||
ignoringWSs ts = WSIs . return $ (`notElem` ts) . tag
|
|
||||||
|
|
||||||
-- | Cycle through workspaces in the same group, the
|
|
||||||
-- group name is all characters up to the first
|
|
||||||
-- separator character or the end of the tag
|
|
||||||
wsTagGroup :: Char -> WSType
|
|
||||||
wsTagGroup sep = WSIs $ do
|
|
||||||
cur <- groupName . workspace . current <$> gets windowset
|
|
||||||
return $ (cur ==) . groupName
|
|
||||||
where groupName = takeWhile (/= sep) . tag
|
|
||||||
|
|
||||||
|
|
||||||
-- | View the next workspace in the given direction that satisfies
|
-- | View the next workspace in the given direction that satisfies
|
||||||
-- the given condition.
|
-- the given condition.
|
||||||
@@ -350,7 +295,7 @@ findWorkspace :: X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceI
|
|||||||
findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n)
|
findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n)
|
||||||
where
|
where
|
||||||
maybeNegate Next d = d
|
maybeNegate Next d = d
|
||||||
maybeNegate Prev d = -d
|
maybeNegate Prev d = (-d)
|
||||||
|
|
||||||
findWorkspaceGen :: X WorkspaceSort -> X (WindowSpace -> Bool) -> Int -> X WorkspaceId
|
findWorkspaceGen :: X WorkspaceSort -> X (WindowSpace -> Bool) -> Int -> X WorkspaceId
|
||||||
findWorkspaceGen _ _ 0 = gets (currentTag . windowset)
|
findWorkspaceGen _ _ 0 = gets (currentTag . windowset)
|
||||||
@@ -360,7 +305,7 @@ findWorkspaceGen sortX wsPredX d = do
|
|||||||
ws <- gets windowset
|
ws <- gets windowset
|
||||||
let cur = workspace (current ws)
|
let cur = workspace (current ws)
|
||||||
sorted = sort (workspaces ws)
|
sorted = sort (workspaces ws)
|
||||||
pivoted = let (a,b) = span ((/= tag cur) . tag) sorted in b ++ a
|
pivoted = let (a,b) = span ((/= (tag cur)) . tag) sorted in b ++ a
|
||||||
ws' = filter wsPred pivoted
|
ws' = filter wsPred pivoted
|
||||||
mCurIx = findWsIndex cur ws'
|
mCurIx = findWsIndex cur ws'
|
||||||
d' = if d > 0 then d - 1 else d
|
d' = if d > 0 then d - 1 else d
|
||||||
@@ -372,7 +317,7 @@ findWorkspaceGen sortX wsPredX d = do
|
|||||||
return $ tag next
|
return $ tag next
|
||||||
|
|
||||||
findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int
|
findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int
|
||||||
findWsIndex ws = findIndex ((== tag ws) . tag)
|
findWsIndex ws wss = findIndex ((== tag ws) . tag) wss
|
||||||
|
|
||||||
-- | View next screen
|
-- | View next screen
|
||||||
nextScreen :: X ()
|
nextScreen :: X ()
|
||||||
@@ -400,7 +345,7 @@ the default screen keybindings:
|
|||||||
> , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
|
> , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
|
||||||
|
|
||||||
-}
|
-}
|
||||||
screenBy :: Int -> X ScreenId
|
screenBy :: Int -> X (ScreenId)
|
||||||
screenBy d = do ws <- gets windowset
|
screenBy d = do ws <- gets windowset
|
||||||
--let ss = sortBy screen (screens ws)
|
--let ss = sortBy screen (screens ws)
|
||||||
let now = screen (current ws)
|
let now = screen (current ws)
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.CycleWindows
|
-- Module : XMonad.Actions.CycleWindows
|
||||||
-- Description : Cycle windows while maintaining focus in place.
|
|
||||||
-- Copyright : (c) Wirt Wolff <wirtwolff@gmail.com>
|
-- Copyright : (c) Wirt Wolff <wirtwolff@gmail.com>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -117,7 +116,7 @@ cycleRecentWindows :: [KeySym] -- ^ A list of modifier keys used when invoking t
|
|||||||
-- If it's the same as the first key, it is effectively ignored.
|
-- If it's the same as the first key, it is effectively ignored.
|
||||||
-> X ()
|
-> X ()
|
||||||
cycleRecentWindows = cycleStacks' stacks where
|
cycleRecentWindows = cycleStacks' stacks where
|
||||||
stacks s = map (`shiftToFocus'` s) (wins s)
|
stacks s = map (shiftToFocus' `flip` s) (wins s)
|
||||||
wins (W.Stack t l r) = t : r ++ reverse l
|
wins (W.Stack t l r) = t : r ++ reverse l
|
||||||
|
|
||||||
|
|
||||||
@@ -206,7 +205,7 @@ rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a
|
|||||||
rotFocused' _ s@(W.Stack _ [] []) = s
|
rotFocused' _ s@(W.Stack _ [] []) = s
|
||||||
rotFocused' f (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus
|
rotFocused' f (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus
|
||||||
where (t':rs') = f (t:rs)
|
where (t':rs') = f (t:rs)
|
||||||
rotFocused' f s@W.Stack{} = rotSlaves' f s -- otherwise
|
rotFocused' f s@(W.Stack _ _ _) = rotSlaves' f s -- otherwise
|
||||||
|
|
||||||
|
|
||||||
-- $unfocused
|
-- $unfocused
|
||||||
|
@@ -1,100 +0,0 @@
|
|||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : XMonad.Actions.CycleWorkspaceByScreen
|
|
||||||
-- Description : Cycle workspaces in a screen-aware fashion.
|
|
||||||
-- 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 Data.IORef
|
|
||||||
|
|
||||||
import Graphics.X11.Xlib.Extras
|
|
||||||
|
|
||||||
import XMonad
|
|
||||||
import XMonad.Prelude
|
|
||||||
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
|
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.DeManage
|
-- Module : XMonad.Actions.DeManage
|
||||||
-- Description : Cease management of a window without unmapping it.
|
|
||||||
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.DwmPromote
|
-- Module : XMonad.Actions.DwmPromote
|
||||||
-- Description : DWM-like swap function for xmonad.
|
|
||||||
-- Copyright : (c) Miikka Koskinen 2007
|
-- Copyright : (c) Miikka Koskinen 2007
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
|
@@ -1,7 +1,8 @@
|
|||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.DynamicProjects
|
-- Module : XMonad.Actions.DynamicProjects
|
||||||
-- Description : Treat workspaces as individual project areas.
|
|
||||||
-- Copyright : (c) Peter J. Jones
|
-- Copyright : (c) Peter J. Jones
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -30,7 +31,6 @@ module XMonad.Actions.DynamicProjects
|
|||||||
, switchProjectPrompt
|
, switchProjectPrompt
|
||||||
, shiftToProjectPrompt
|
, shiftToProjectPrompt
|
||||||
, renameProjectPrompt
|
, renameProjectPrompt
|
||||||
, changeProjectDirPrompt
|
|
||||||
|
|
||||||
-- * Helper Functions
|
-- * Helper Functions
|
||||||
, switchProject
|
, switchProject
|
||||||
@@ -38,18 +38,22 @@ module XMonad.Actions.DynamicProjects
|
|||||||
, lookupProject
|
, lookupProject
|
||||||
, currentProject
|
, currentProject
|
||||||
, activateProject
|
, activateProject
|
||||||
, modifyProject
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
import Control.Applicative ((<|>))
|
||||||
|
import Control.Monad (when, unless)
|
||||||
|
import Data.List (sort, union, stripPrefix)
|
||||||
import Data.Map.Strict (Map)
|
import Data.Map.Strict (Map)
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import System.Directory (setCurrentDirectory, getHomeDirectory, makeAbsolute)
|
import Data.Maybe (fromMaybe, isNothing)
|
||||||
import XMonad.Prelude
|
import Data.Monoid ((<>))
|
||||||
|
import System.Directory (setCurrentDirectory, getHomeDirectory)
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Actions.DynamicWorkspaces
|
import XMonad.Actions.DynamicWorkspaces
|
||||||
import XMonad.Prompt
|
import XMonad.Prompt
|
||||||
import XMonad.Prompt.Directory
|
import XMonad.Prompt.Directory (directoryPrompt)
|
||||||
|
import XMonad.Prompt.Workspace (Wor(..))
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
import qualified XMonad.Util.ExtensibleState as XS
|
import qualified XMonad.Util.ExtensibleState as XS
|
||||||
|
|
||||||
@@ -125,62 +129,19 @@ data Project = Project
|
|||||||
{ projectName :: !ProjectName -- ^ Workspace name.
|
{ projectName :: !ProjectName -- ^ Workspace name.
|
||||||
, projectDirectory :: !FilePath -- ^ Working directory.
|
, projectDirectory :: !FilePath -- ^ Working directory.
|
||||||
, projectStartHook :: !(Maybe (X ())) -- ^ Optional start-up hook.
|
, projectStartHook :: !(Maybe (X ())) -- ^ Optional start-up hook.
|
||||||
}
|
} deriving Typeable
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Internal project state.
|
-- | Internal project state.
|
||||||
data ProjectState = ProjectState
|
data ProjectState = ProjectState
|
||||||
{ projects :: !ProjectTable
|
{ projects :: !ProjectTable
|
||||||
, previousProject :: !(Maybe WorkspaceId)
|
, previousProject :: !(Maybe WorkspaceId)
|
||||||
}
|
} deriving Typeable
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
instance ExtensionClass ProjectState where
|
instance ExtensionClass ProjectState where
|
||||||
initialValue = ProjectState Map.empty Nothing
|
initialValue = ProjectState Map.empty Nothing
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- Internal types for working with XPrompt.
|
|
||||||
data ProjectPrompt = ProjectPrompt XPConfig 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 c DirMode _) =
|
|
||||||
let xpt = directoryMultipleModes' (complCaseSensitivity c) "" (const $ return ())
|
|
||||||
in completionFunction xpt
|
|
||||||
completionFunction (ProjectPrompt c _ ns) = mkComplFunFromList' c 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
|
|
||||||
dir <- io $ makeAbsolute dir'
|
|
||||||
modifyProject (\p -> p { projectDirectory = dir })
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Add dynamic projects support to the given config.
|
-- | Add dynamic projects support to the given config.
|
||||||
dynamicProjects :: [Project] -> XConfig a -> XConfig a
|
dynamicProjects :: [Project] -> XConfig a -> XConfig a
|
||||||
@@ -226,7 +187,7 @@ dynamicProjectsStartupHook ps = XS.modify go
|
|||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Find a project based on its name.
|
-- | Find a project based on its name.
|
||||||
lookupProject :: ProjectName -> X (Maybe Project)
|
lookupProject :: ProjectName -> X (Maybe Project)
|
||||||
lookupProject name = Map.lookup name <$> XS.gets projects
|
lookupProject name = Map.lookup name `fmap` XS.gets projects
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Fetch the current project (the one being used for the currently
|
-- | Fetch the current project (the one being used for the currently
|
||||||
@@ -237,21 +198,6 @@ currentProject = do
|
|||||||
proj <- lookupProject name
|
proj <- lookupProject name
|
||||||
return $ fromMaybe (defProject name) proj
|
return $ fromMaybe (defProject name) proj
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | Modify the current project using a pure function.
|
|
||||||
modifyProject :: (Project -> Project) -> X ()
|
|
||||||
modifyProject f = do
|
|
||||||
p <- currentProject
|
|
||||||
ps <- XS.gets projects
|
|
||||||
|
|
||||||
-- If a project is renamed to match another project, the old project
|
|
||||||
-- will be removed and replaced with this one.
|
|
||||||
let new = f p
|
|
||||||
ps' = Map.insert (projectName new) new $ Map.delete (projectName p) ps
|
|
||||||
|
|
||||||
XS.modify $ \s -> s {projects = ps'}
|
|
||||||
activateProject new
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Switch to the given project.
|
-- | Switch to the given project.
|
||||||
switchProject :: Project -> X ()
|
switchProject :: Project -> X ()
|
||||||
@@ -274,11 +220,22 @@ switchProject p = do
|
|||||||
-- | Prompt for a project name and then switch to it. Automatically
|
-- | Prompt for a project name and then switch to it. Automatically
|
||||||
-- creates a project if a new name is returned from the prompt.
|
-- creates a project if a new name is returned from the prompt.
|
||||||
switchProjectPrompt :: XPConfig -> X ()
|
switchProjectPrompt :: XPConfig -> X ()
|
||||||
switchProjectPrompt = projectPrompt [ SwitchMode
|
switchProjectPrompt c = projectPrompt c switch
|
||||||
, ShiftMode
|
where
|
||||||
, RenameMode
|
switch :: ProjectTable -> ProjectName -> X ()
|
||||||
, DirMode
|
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.
|
-- | Shift the currently focused window to the given project.
|
||||||
@@ -291,44 +248,40 @@ shiftToProject p = do
|
|||||||
-- | Prompts for a project name and then shifts the currently focused
|
-- | Prompts for a project name and then shifts the currently focused
|
||||||
-- window to that project.
|
-- window to that project.
|
||||||
shiftToProjectPrompt :: XPConfig -> X ()
|
shiftToProjectPrompt :: XPConfig -> X ()
|
||||||
shiftToProjectPrompt = projectPrompt [ ShiftMode
|
shiftToProjectPrompt c = projectPrompt c go
|
||||||
, RenameMode
|
where
|
||||||
, SwitchMode
|
go :: ProjectTable -> ProjectName -> X ()
|
||||||
, DirMode
|
go ps name = shiftToProject . fromMaybe (defProject name) $
|
||||||
]
|
Map.lookup name ps
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Prompt for a project name.
|
||||||
|
projectPrompt :: XPConfig -> (ProjectTable -> ProjectName -> X ()) -> X ()
|
||||||
|
projectPrompt c f = do
|
||||||
|
ws <- map W.tag `fmap` gets (W.workspaces . windowset)
|
||||||
|
ps <- XS.gets projects
|
||||||
|
|
||||||
|
let names = sort (Map.keys ps `union` ws)
|
||||||
|
label = "Switch or Create Project: "
|
||||||
|
|
||||||
|
mkXPrompt (Wor label) c (mkComplFunFromList' names) (f ps)
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Rename the current project.
|
-- | Rename the current project.
|
||||||
renameProjectPrompt :: XPConfig -> X ()
|
renameProjectPrompt :: XPConfig -> X ()
|
||||||
renameProjectPrompt = projectPrompt [ RenameMode
|
renameProjectPrompt c = mkXPrompt (Wor "New Project Name: ") c (return . (:[])) go
|
||||||
, DirMode
|
where
|
||||||
, SwitchMode
|
go :: String -> X ()
|
||||||
, ShiftMode
|
go name = do
|
||||||
]
|
p <- currentProject
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | Change the working directory used for the current project.
|
|
||||||
--
|
|
||||||
-- NOTE: This will only affect new processed started in this project.
|
|
||||||
-- Existing processes will maintain the previous working directory.
|
|
||||||
changeProjectDirPrompt :: XPConfig -> X ()
|
|
||||||
changeProjectDirPrompt = projectPrompt [ DirMode
|
|
||||||
, SwitchMode
|
|
||||||
, ShiftMode
|
|
||||||
, RenameMode
|
|
||||||
]
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | Prompt for a project name.
|
|
||||||
projectPrompt :: [ProjectMode] -> XPConfig -> X ()
|
|
||||||
projectPrompt submodes c = do
|
|
||||||
ws <- map W.tag <$> gets (W.workspaces . windowset)
|
|
||||||
ps <- XS.gets projects
|
ps <- XS.gets projects
|
||||||
|
renameWorkspaceByName name
|
||||||
|
|
||||||
let names = sort (Map.keys ps `union` ws)
|
let p' = fromMaybe (p { projectName = name }) $ Map.lookup name ps
|
||||||
modes = map (\m -> XPT $ ProjectPrompt c m names) submodes
|
ps' = Map.insert name p' $ Map.delete (projectName p) ps
|
||||||
|
|
||||||
mkXPromptWithModes modes c
|
XS.modify $ \s -> s {projects = ps'}
|
||||||
|
activateProject p'
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Activate a project by updating the working directory and
|
-- | Activate a project by updating the working directory and
|
||||||
|
@@ -1,7 +1,8 @@
|
|||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.DynamicWorkspaceGroups
|
-- Module : XMonad.Actions.DynamicWorkspaceGroups
|
||||||
-- Description : Dynamically manage workspace groups in multi-head setups.
|
|
||||||
-- Copyright : (c) Brent Yorgey 2009
|
-- Copyright : (c) Brent Yorgey 2009
|
||||||
-- License : BSD-style (see LICENSE)
|
-- License : BSD-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -33,22 +34,17 @@ module XMonad.Actions.DynamicWorkspaceGroups
|
|||||||
, promptWSGroupForget
|
, promptWSGroupForget
|
||||||
|
|
||||||
, WSGPrompt
|
, WSGPrompt
|
||||||
-- * TopicSpace Integration
|
|
||||||
-- $topics
|
|
||||||
, viewTopicGroup
|
|
||||||
, promptTopicGroupView
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Data.List (find)
|
||||||
import Control.Arrow ((&&&))
|
import Control.Arrow ((&&&))
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude (find, for_)
|
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
import XMonad.Prompt
|
import XMonad.Prompt
|
||||||
import qualified XMonad.Util.ExtensibleState as XS
|
import qualified XMonad.Util.ExtensibleState as XS
|
||||||
import XMonad.Actions.TopicSpace
|
|
||||||
|
|
||||||
-- $usage
|
-- $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:
|
||||||
@@ -67,14 +63,14 @@ type WSGroup = [(ScreenId,WorkspaceId)]
|
|||||||
|
|
||||||
type WSGroupId = String
|
type WSGroupId = String
|
||||||
|
|
||||||
newtype WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }
|
data WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }
|
||||||
deriving (Read, Show)
|
deriving (Typeable, Read, Show)
|
||||||
|
|
||||||
withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage
|
withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage
|
||||||
withWSG f = WSG . f . unWSG
|
withWSG f = WSG . f . unWSG
|
||||||
|
|
||||||
instance ExtensionClass WSGroupStorage where
|
instance ExtensionClass WSGroupStorage where
|
||||||
initialValue = WSG M.empty
|
initialValue = WSG $ M.empty
|
||||||
extensionType = PersistentExtension
|
extensionType = PersistentExtension
|
||||||
|
|
||||||
-- | Add a new workspace group of the given name, mapping to an
|
-- | Add a new workspace group of the given name, mapping to an
|
||||||
@@ -89,7 +85,9 @@ addWSGroup :: WSGroupId -> [WorkspaceId] -> X ()
|
|||||||
addWSGroup name wids = withWindowSet $ \w -> do
|
addWSGroup name wids = withWindowSet $ \w -> do
|
||||||
let wss = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w
|
let wss = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w
|
||||||
wmap = mapM (strength . (flip lookup wss &&& id)) wids
|
wmap = mapM (strength . (flip lookup wss &&& id)) wids
|
||||||
for_ wmap (addRawWSGroup name)
|
case wmap of
|
||||||
|
Just ps -> addRawWSGroup name ps
|
||||||
|
Nothing -> return ()
|
||||||
where strength (ma, b) = ma >>= \a -> return (a,b)
|
where strength (ma, b) = ma >>= \a -> return (a,b)
|
||||||
|
|
||||||
-- | Give a name to the current workspace group.
|
-- | Give a name to the current workspace group.
|
||||||
@@ -105,23 +103,20 @@ forgetWSGroup = XS.modify . withWSG . M.delete
|
|||||||
|
|
||||||
-- | View the workspace group with the given name.
|
-- | View the workspace group with the given name.
|
||||||
viewWSGroup :: WSGroupId -> X ()
|
viewWSGroup :: WSGroupId -> X ()
|
||||||
viewWSGroup = viewGroup (windows . W.greedyView)
|
viewWSGroup name = do
|
||||||
|
|
||||||
-- | Internal function for viewing a group.
|
|
||||||
viewGroup :: (WorkspaceId -> X ()) -> WSGroupId -> X ()
|
|
||||||
viewGroup fview name = do
|
|
||||||
WSG m <- XS.get
|
WSG m <- XS.get
|
||||||
for_ (M.lookup name m) $
|
case M.lookup name m of
|
||||||
mapM_ (uncurry (viewWS fview))
|
Just grp -> mapM_ (uncurry viewWS) grp
|
||||||
|
Nothing -> return ()
|
||||||
|
|
||||||
-- | View the given workspace on the given screen, using the provided function.
|
-- | View the given workspace on the given screen.
|
||||||
viewWS :: (WorkspaceId -> X ()) -> ScreenId -> WorkspaceId -> X ()
|
viewWS :: ScreenId -> WorkspaceId -> X ()
|
||||||
viewWS fview sid wid = do
|
viewWS sid wid = do
|
||||||
mw <- findScreenWS sid
|
mw <- findScreenWS sid
|
||||||
case mw of
|
case mw of
|
||||||
Just w -> do
|
Just w -> do
|
||||||
windows $ W.view w
|
windows $ W.view w
|
||||||
fview wid
|
windows $ W.greedyView wid
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
|
|
||||||
-- | Find the workspace which is currently on the given screen.
|
-- | Find the workspace which is currently on the given screen.
|
||||||
@@ -129,20 +124,16 @@ findScreenWS :: ScreenId -> X (Maybe WorkspaceId)
|
|||||||
findScreenWS sid = withWindowSet $
|
findScreenWS sid = withWindowSet $
|
||||||
return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens
|
return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens
|
||||||
|
|
||||||
newtype WSGPrompt = WSGPrompt String
|
data WSGPrompt = WSGPrompt String
|
||||||
|
|
||||||
instance XPrompt WSGPrompt where
|
instance XPrompt WSGPrompt where
|
||||||
showXPrompt (WSGPrompt s) = s
|
showXPrompt (WSGPrompt s) = s
|
||||||
|
|
||||||
-- | Prompt for a workspace group to view.
|
-- | Prompt for a workspace group to view.
|
||||||
promptWSGroupView :: XPConfig -> String -> X ()
|
promptWSGroupView :: XPConfig -> String -> X ()
|
||||||
promptWSGroupView = promptGroupView viewWSGroup
|
promptWSGroupView xp s = do
|
||||||
|
|
||||||
-- | Internal function for making a prompt to view a workspace group
|
|
||||||
promptGroupView :: (WSGroupId -> X ()) -> XPConfig -> String -> X ()
|
|
||||||
promptGroupView fview xp s = do
|
|
||||||
gs <- fmap (M.keys . unWSG) XS.get
|
gs <- fmap (M.keys . unWSG) XS.get
|
||||||
mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' xp gs) fview
|
mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) viewWSGroup
|
||||||
|
|
||||||
-- | Prompt for a name for the current workspace group.
|
-- | Prompt for a name for the current workspace group.
|
||||||
promptWSGroupAdd :: XPConfig -> String -> X ()
|
promptWSGroupAdd :: XPConfig -> String -> X ()
|
||||||
@@ -153,25 +144,4 @@ promptWSGroupAdd xp s =
|
|||||||
promptWSGroupForget :: XPConfig -> String -> X ()
|
promptWSGroupForget :: XPConfig -> String -> X ()
|
||||||
promptWSGroupForget xp s = do
|
promptWSGroupForget xp s = do
|
||||||
gs <- fmap (M.keys . unWSG) XS.get
|
gs <- fmap (M.keys . unWSG) XS.get
|
||||||
mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' xp gs) forgetWSGroup
|
mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) forgetWSGroup
|
||||||
|
|
||||||
-- $topics
|
|
||||||
-- You can use this module with "XMonad.Actions.TopicSpace" — just replace
|
|
||||||
-- 'promptWSGroupView' with 'promptTopicGroupView':
|
|
||||||
--
|
|
||||||
-- > , ("M-y n", promptWSGroupAdd myXPConfig "Name this group: ")
|
|
||||||
-- > , ("M-y g", promptTopicGroupView myTopicConfig myXPConfig "Go to group: ")
|
|
||||||
-- > , ("M-y d", promptWSGroupForget myXPConfig "Forget group: ")
|
|
||||||
--
|
|
||||||
-- It's also a good idea to replace 'spawn' with
|
|
||||||
-- 'XMonad.Actions.SpawnOn.spawnOn' or 'XMonad.Actions.SpawnOn.spawnHere' in
|
|
||||||
-- your topic actions, so everything is spawned where it should be.
|
|
||||||
|
|
||||||
-- | Prompt for a workspace group to view, treating the workspaces as topics.
|
|
||||||
promptTopicGroupView :: TopicConfig -> XPConfig -> String -> X ()
|
|
||||||
promptTopicGroupView = promptGroupView . viewTopicGroup
|
|
||||||
|
|
||||||
-- | View the workspace group with the given name, treating the workspaces as
|
|
||||||
-- topics.
|
|
||||||
viewTopicGroup :: TopicConfig -> WSGroupId -> X ()
|
|
||||||
viewTopicGroup = viewGroup . switchTopic
|
|
||||||
|
@@ -1,7 +1,8 @@
|
|||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.DynamicWorkspaceOrder
|
-- Module : XMonad.Actions.DynamicWorkspaceOrder
|
||||||
-- Description : Remember a dynamically updateable ordering on workspaces.
|
|
||||||
-- Copyright : (c) Brent Yorgey 2009
|
-- Copyright : (c) Brent Yorgey 2009
|
||||||
-- License : BSD-style (see LICENSE)
|
-- License : BSD-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -11,7 +12,7 @@
|
|||||||
--
|
--
|
||||||
-- Remember a dynamically updateable ordering on workspaces, together
|
-- Remember a dynamically updateable ordering on workspaces, together
|
||||||
-- with tools for using this ordering with "XMonad.Actions.CycleWS"
|
-- with tools for using this ordering with "XMonad.Actions.CycleWS"
|
||||||
-- and "XMonad.Hooks.StatusBar.PP".
|
-- and "XMonad.Hooks.DynamicLog".
|
||||||
--
|
--
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
@@ -22,16 +23,11 @@ module XMonad.Actions.DynamicWorkspaceOrder
|
|||||||
getWsCompareByOrder
|
getWsCompareByOrder
|
||||||
, getSortByOrder
|
, getSortByOrder
|
||||||
, swapWith
|
, swapWith
|
||||||
, swapWithCurrent
|
|
||||||
, swapOrder
|
|
||||||
, updateName
|
|
||||||
, removeName
|
|
||||||
|
|
||||||
, moveTo
|
, moveTo
|
||||||
, moveToGreedy
|
, moveToGreedy
|
||||||
, shiftTo
|
, shiftTo
|
||||||
|
|
||||||
, withNthWorkspace'
|
|
||||||
, withNthWorkspace
|
, withNthWorkspace
|
||||||
|
|
||||||
) where
|
) where
|
||||||
@@ -45,7 +41,7 @@ import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), doTo)
|
|||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
import XMonad.Prelude (fromJust, fromMaybe)
|
import Data.Maybe (fromJust, fromMaybe)
|
||||||
import Data.Ord (comparing)
|
import Data.Ord (comparing)
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
@@ -68,10 +64,10 @@ import Data.Ord (comparing)
|
|||||||
-- order of workspaces must be updated to use the auxiliary ordering.
|
-- order of workspaces must be updated to use the auxiliary ordering.
|
||||||
--
|
--
|
||||||
-- To change the order in which workspaces are displayed by
|
-- To change the order in which workspaces are displayed by
|
||||||
-- "XMonad.Hooks.StatusBar.PP", use 'getSortByOrder' in your
|
-- "XMonad.Hooks.DynamicLog", use 'getSortByOrder' in your
|
||||||
-- 'XMonad.Hooks.StatusBar.PP.ppSort' field, for example:
|
-- 'XMonad.Hooks.DynamicLog.ppSort' field, for example:
|
||||||
--
|
--
|
||||||
-- > myPP = ... byorgeyPP {
|
-- > ... dynamicLogWithPP $ byorgeyPP {
|
||||||
-- > ...
|
-- > ...
|
||||||
-- > , ppSort = DO.getSortByOrder
|
-- > , ppSort = DO.getSortByOrder
|
||||||
-- > ...
|
-- > ...
|
||||||
@@ -90,8 +86,8 @@ import Data.Ord (comparing)
|
|||||||
-- tweak as desired.
|
-- tweak as desired.
|
||||||
|
|
||||||
-- | Extensible state storage for the workspace order.
|
-- | Extensible state storage for the workspace order.
|
||||||
newtype WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }
|
data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }
|
||||||
deriving (Read, Show)
|
deriving (Typeable, Read, Show)
|
||||||
|
|
||||||
instance ExtensionClass WSOrderStorage where
|
instance ExtensionClass WSOrderStorage where
|
||||||
initialValue = WSO Nothing
|
initialValue = WSO Nothing
|
||||||
@@ -156,21 +152,6 @@ swapOrder w1 w2 = do
|
|||||||
XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))
|
XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))
|
||||||
windows id -- force a status bar update
|
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,
|
-- | View the next workspace of the given type in the given direction,
|
||||||
-- where \"next\" is determined using the dynamic workspace order.
|
-- where \"next\" is determined using the dynamic workspace order.
|
||||||
moveTo :: Direction1D -> WSType -> X ()
|
moveTo :: Direction1D -> WSType -> X ()
|
||||||
@@ -185,19 +166,13 @@ moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView)
|
|||||||
shiftTo :: Direction1D -> WSType -> X ()
|
shiftTo :: Direction1D -> WSType -> X ()
|
||||||
shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)
|
shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)
|
||||||
|
|
||||||
-- | Do something with the nth workspace in the dynamic order after
|
|
||||||
-- transforming it. The callback is given the workspace's tag as well
|
|
||||||
-- as the 'WindowSet' of the workspace itself.
|
|
||||||
withNthWorkspace' :: ([WorkspaceId] -> [WorkspaceId]) -> (String -> WindowSet -> WindowSet) -> Int -> X ()
|
|
||||||
withNthWorkspace' tr job wnum = do
|
|
||||||
sort <- getSortByOrder
|
|
||||||
ws <- gets (tr . map W.tag . sort . W.workspaces . windowset)
|
|
||||||
case drop wnum ws of
|
|
||||||
(w:_) -> windows $ job w
|
|
||||||
[] -> return ()
|
|
||||||
|
|
||||||
-- | Do something with the nth workspace in the dynamic order. The
|
-- | Do something with the nth workspace in the dynamic order. The
|
||||||
-- callback is given the workspace's tag as well as the 'WindowSet'
|
-- callback is given the workspace's tag as well as the 'WindowSet'
|
||||||
-- of the workspace itself.
|
-- of the workspace itself.
|
||||||
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
|
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
|
||||||
withNthWorkspace = withNthWorkspace' id
|
withNthWorkspace job wnum = do
|
||||||
|
sort <- getSortByOrder
|
||||||
|
ws <- gets (map W.tag . sort . W.workspaces . windowset)
|
||||||
|
case drop wnum ws of
|
||||||
|
(w:_) -> windows $ job w
|
||||||
|
[] -> return ()
|
@@ -1,7 +1,8 @@
|
|||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.DynamicWorkspaces
|
-- Module : XMonad.Actions.DynamicWorkspaces
|
||||||
-- Description : Provides bindings to add and delete workspaces.
|
|
||||||
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
-- Copyright : (c) David Roundy <droundy@darcs.net>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -34,12 +35,14 @@ module XMonad.Actions.DynamicWorkspaces (
|
|||||||
WorkspaceIndex
|
WorkspaceIndex
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad.Prelude (find, isNothing, nub, when)
|
|
||||||
import XMonad hiding (workspaces)
|
import XMonad hiding (workspaces)
|
||||||
import XMonad.StackSet hiding (filter, modify, delete)
|
import XMonad.StackSet hiding (filter, modify, delete)
|
||||||
import XMonad.Prompt.Workspace ( Wor(Wor), workspacePrompt )
|
import XMonad.Prompt.Workspace ( Wor(Wor), workspacePrompt )
|
||||||
import XMonad.Prompt ( XPConfig, mkXPrompt )
|
import XMonad.Prompt ( XPConfig, mkXPrompt )
|
||||||
import XMonad.Util.WorkspaceCompare ( getSortByIndex )
|
import XMonad.Util.WorkspaceCompare ( getSortByIndex )
|
||||||
|
import Data.List (find)
|
||||||
|
import Data.Maybe (isNothing)
|
||||||
|
import Control.Monad (when)
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import qualified XMonad.Util.ExtensibleState as XS
|
import qualified XMonad.Util.ExtensibleState as XS
|
||||||
|
|
||||||
@@ -85,8 +88,8 @@ type WorkspaceIndex = Int
|
|||||||
|
|
||||||
-- | Internal dynamic project state that stores a mapping between
|
-- | Internal dynamic project state that stores a mapping between
|
||||||
-- workspace indexes and workspace tags.
|
-- workspace indexes and workspace tags.
|
||||||
newtype DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag}
|
data DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag}
|
||||||
deriving (Read, Show)
|
deriving (Typeable, Read, Show)
|
||||||
|
|
||||||
instance ExtensionClass DynamicWorkspaceState where
|
instance ExtensionClass DynamicWorkspaceState where
|
||||||
initialValue = DynamicWorkspaceState Map.empty
|
initialValue = DynamicWorkspaceState Map.empty
|
||||||
@@ -105,7 +108,7 @@ withWorkspaceIndex job widx = do
|
|||||||
maybe (return ()) (windows . job) wtag
|
maybe (return ()) (windows . job) wtag
|
||||||
where
|
where
|
||||||
ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag)
|
ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag)
|
||||||
ilookup idx = Map.lookup idx <$> XS.gets workspaceIndexMap
|
ilookup idx = Map.lookup idx `fmap` XS.gets workspaceIndexMap
|
||||||
|
|
||||||
|
|
||||||
mkCompl :: [String] -> String -> IO [String]
|
mkCompl :: [String] -> String -> IO [String]
|
||||||
@@ -129,9 +132,9 @@ renameWorkspaceByName w = do old <- gets (currentTag . windowset)
|
|||||||
sets q = q { current = setscr $ current q }
|
sets q = q { current = setscr $ current q }
|
||||||
in sets $ removeWorkspace' w s
|
in sets $ removeWorkspace' w s
|
||||||
updateIndexMap old w
|
updateIndexMap old w
|
||||||
where updateIndexMap oldIM newIM = do
|
where updateIndexMap old new = do
|
||||||
wmap <- XS.gets workspaceIndexMap
|
wmap <- XS.gets workspaceIndexMap
|
||||||
XS.modify $ \s -> s {workspaceIndexMap = Map.map (\t -> if t == oldIM then newIM else t) wmap}
|
XS.modify $ \s -> s {workspaceIndexMap = Map.map (\t -> if t == old then new else t) wmap}
|
||||||
|
|
||||||
toNthWorkspace :: (String -> X ()) -> Int -> X ()
|
toNthWorkspace :: (String -> X ()) -> Int -> X ()
|
||||||
toNthWorkspace job wnum = do sort <- getSortByIndex
|
toNthWorkspace job wnum = do sort <- getSortByIndex
|
||||||
@@ -238,20 +241,20 @@ isEmpty t = do wsl <- gets $ workspaces . windowset
|
|||||||
return $ maybe True (isNothing . stack) mws
|
return $ maybe True (isNothing . stack) mws
|
||||||
|
|
||||||
addHiddenWorkspace' :: (Workspace i l a -> [Workspace i l a] -> [Workspace i l a]) -> i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
|
addHiddenWorkspace' :: (Workspace i l a -> [Workspace i l a] -> [Workspace i l a]) -> i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
|
||||||
addHiddenWorkspace' add newtag l s@StackSet{ hidden = ws } = s { hidden = add (Workspace newtag l Nothing) ws }
|
addHiddenWorkspace' add newtag l s@(StackSet { hidden = ws }) = s { hidden = add (Workspace newtag l Nothing) ws }
|
||||||
|
|
||||||
-- | Remove the hidden workspace with the given tag from the StackSet, if
|
-- | Remove the hidden workspace with the given tag from the StackSet, if
|
||||||
-- it exists. All the windows in that workspace are moved to the current
|
-- it exists. All the windows in that workspace are moved to the current
|
||||||
-- workspace.
|
-- workspace.
|
||||||
removeWorkspace' :: (Eq i, Eq a) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
|
removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
|
||||||
removeWorkspace' torem s@StackSet{ current = scr@Screen { workspace = wc }
|
removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc })
|
||||||
, hidden = hs }
|
, hidden = hs })
|
||||||
= let (xs, ys) = break ((== torem) . tag) hs
|
= let (xs, ys) = break ((== torem) . tag) hs
|
||||||
in removeWorkspace'' xs ys
|
in removeWorkspace'' xs ys
|
||||||
where meld Nothing Nothing = Nothing
|
where meld Nothing Nothing = Nothing
|
||||||
meld x Nothing = x
|
meld x Nothing = x
|
||||||
meld Nothing x = x
|
meld Nothing x = x
|
||||||
meld (Just x) (Just y) = differentiate . nub $ integrate x ++ integrate y
|
meld (Just x) (Just y) = differentiate (integrate x ++ integrate y)
|
||||||
removeWorkspace'' xs (y:ys) = s { current = scr { workspace = wc { stack = meld (stack y) (stack wc) } }
|
removeWorkspace'' xs (y:ys) = s { current = scr { workspace = wc { stack = meld (stack y) (stack wc) } }
|
||||||
, hidden = xs ++ ys }
|
, hidden = xs ++ ys }
|
||||||
removeWorkspace'' _ _ = s
|
removeWorkspace'' _ _ = s
|
||||||
|
@@ -1,388 +0,0 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
|
||||||
{-# LANGUAGE MultiWayIf #-}
|
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : XMonad.Actions.EasyMotion
|
|
||||||
-- Description : Focus a visible window using a key chord.
|
|
||||||
-- Copyright : (c) Matt Kingston <mattkingston@gmail.com>
|
|
||||||
-- License : BSD3-style (see LICENSE)
|
|
||||||
--
|
|
||||||
-- Maintainer : mattkingston@gmail.com
|
|
||||||
-- Stability : unstable
|
|
||||||
-- Portability : unportable
|
|
||||||
--
|
|
||||||
-- Provides functionality to use key chords to focus a visible window. Overlays a unique key chord
|
|
||||||
-- (a string) above each visible window and allows the user to select a window by typing that
|
|
||||||
-- chord.
|
|
||||||
-- Inspired by <https://github.com/easymotion/vim-easymotion vim-easymotion>.
|
|
||||||
-- Thanks to <https://github.com/larkery Tom Hinton> for some feature inspiration and window
|
|
||||||
-- sorting code.
|
|
||||||
--
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
module XMonad.Actions.EasyMotion ( -- * Usage
|
|
||||||
-- $usage
|
|
||||||
selectWindow
|
|
||||||
|
|
||||||
-- * Configuration
|
|
||||||
, EasyMotionConfig(..)
|
|
||||||
, ChordKeys(..)
|
|
||||||
, def
|
|
||||||
|
|
||||||
-- * Creating overlays
|
|
||||||
, fullSize
|
|
||||||
, fixedSize
|
|
||||||
, textSize
|
|
||||||
, proportional
|
|
||||||
, bar
|
|
||||||
) where
|
|
||||||
|
|
||||||
import XMonad
|
|
||||||
import XMonad.Prelude
|
|
||||||
import qualified XMonad.StackSet as W
|
|
||||||
import XMonad.Util.Font (releaseXMF, initXMF, Align(AlignCenter), XMonadFont(..), textExtentsXMF)
|
|
||||||
import XMonad.Util.XUtils (createNewWindow, paintAndWrite, deleteWindow, showWindow)
|
|
||||||
|
|
||||||
import Control.Arrow ((&&&))
|
|
||||||
import qualified Data.Map.Strict as M (Map, elems, map, mapWithKey)
|
|
||||||
|
|
||||||
-- $usage
|
|
||||||
--
|
|
||||||
-- You can use this module's basic functionality with the following in your
|
|
||||||
-- @~\/.xmonad\/xmonad.hs@:
|
|
||||||
--
|
|
||||||
-- > import XMonad.Actions.EasyMotion (selectWindow)
|
|
||||||
--
|
|
||||||
-- To customise
|
|
||||||
--
|
|
||||||
-- > import XMonad.Actions.EasyMotion (selectWindow, EasyMotionConfig(..))
|
|
||||||
--
|
|
||||||
-- Then add a keybinding and an action to the 'selectWindow' function.
|
|
||||||
-- In this case @M-f@ to focus the selected window:
|
|
||||||
--
|
|
||||||
-- > , ((modm, xK_f), selectWindow def >>= (`whenJust` windows . W.focusWindow))
|
|
||||||
--
|
|
||||||
-- Similarly, to kill a window with @M-f@:
|
|
||||||
--
|
|
||||||
-- > , ((modm, xK_f), selectWindow def >>= (`whenJust` killWindow))
|
|
||||||
--
|
|
||||||
-- See 'EasyMotionConfig' for all configuration options. A short summary follows.
|
|
||||||
--
|
|
||||||
-- Default chord keys are @s,d,f,j,k,l@. To customise these and display options assign
|
|
||||||
-- different values to 'def' (the default configuration):
|
|
||||||
--
|
|
||||||
-- > , ((modm, xK_f), (selectWindow def{sKeys = AnyKeys [xK_f, xK_d]}) >>= (`whenJust` windows . W.focusWindow))
|
|
||||||
--
|
|
||||||
-- You must supply at least two different keys in the 'sKeys' list. Keys provided earlier in the list
|
|
||||||
-- will be used preferentially—therefore, keys you would like to use more frequently should be
|
|
||||||
-- earlier in the list.
|
|
||||||
--
|
|
||||||
-- To map different sets of keys to different screens. The following configuration maps keys @fdsa@
|
|
||||||
-- to screen 0 and @hjkl@ to screen 1. Keys provided earlier in the list will be used preferentially.
|
|
||||||
-- Providing the same key for multiple screens is possible but will break down in some scenarios.
|
|
||||||
--
|
|
||||||
-- > import qualified Data.Map.Strict as StrictMap (fromList)
|
|
||||||
-- > emConf :: EasyMotionConfig
|
|
||||||
-- > emConf = def { sKeys = PerScreenKeys $ StrictMap.fromList [(0, [xK_f, xK_d, xK_s, xK_a]), (1, [xK_h, xK_j, xK_k, xK_l])] }
|
|
||||||
-- > -- key bindings
|
|
||||||
-- > , ((modm, xK_f), selectWindow emConf >>= (`whenJust` windows . W.focusWindow))
|
|
||||||
--
|
|
||||||
-- To customise the font:
|
|
||||||
--
|
|
||||||
-- > , ((modm, xK_f), (selectWindow def{emFont = "xft: Sans-40"}) >>= (`whenJust` windows . W.focusWindow))
|
|
||||||
--
|
|
||||||
-- The 'emFont' field provided is supplied directly to the 'initXMF' function. The default is
|
|
||||||
-- @"xft:Sans-100"@. Some example options:
|
|
||||||
--
|
|
||||||
-- > "xft: Sans-40"
|
|
||||||
-- > "xft: Arial-100"
|
|
||||||
-- > "xft: Cambria-80"
|
|
||||||
--
|
|
||||||
-- Customise the overlay by supplying a function to 'overlayF'. The signature is
|
|
||||||
-- @'Position' -> 'Rectangle' -> 'Rectangle'@. The parameters are the height in pixels of
|
|
||||||
-- the selection chord and the rectangle of the window to be overlaid. Some are provided:
|
|
||||||
--
|
|
||||||
-- > import XMonad.Actions.EasyMotion (selectWindow, EasyMotionConfig(..), proportional, bar, fullSize)
|
|
||||||
-- > , ((modm, xK_f), (selectWindow def{ overlayF = proportional 0.3 }) >>= (`whenJust` windows . W.focusWindow))
|
|
||||||
-- > , ((modm, xK_f), (selectWindow def{ overlayF = bar 0.5 }) >>= (`whenJust` windows . W.focusWindow))
|
|
||||||
-- > , ((modm, xK_f), (selectWindow def{ overlayF = fullSize }) >>= (`whenJust` windows . W.focusWindow))
|
|
||||||
-- > , ((modm, xK_f), (selectWindow def{ overlayF = fixedSize 300 350 }) >>= (`whenJust` windows . W.focusWindow))
|
|
||||||
|
|
||||||
-- TODO:
|
|
||||||
-- - An overlay function that creates an overlay a proportion of the width XOR height of the
|
|
||||||
-- window it's over, and with a fixed w/h proportion? E.g. overlay-height = 0.3 *
|
|
||||||
-- target-window-height; overlay-width = 0.5 * overlay-height.
|
|
||||||
-- - An overlay function that creates an overlay of a fixed w,h, aligned mid,mid, or parametrised
|
|
||||||
-- alignment?
|
|
||||||
-- - Parametrise chord generation?
|
|
||||||
-- - W.shift example; bring window from other screen to current screen? Only useful if we don't
|
|
||||||
-- show chords on current workspace.
|
|
||||||
-- - Use stringToKeysym, keysymToKeycode, keycodeToKeysym, keysymToString to take a string from
|
|
||||||
-- the user?
|
|
||||||
-- - Think a bit more about improving functionality with floating windows.
|
|
||||||
-- - currently, floating window z-order is not respected
|
|
||||||
-- - could ignore floating windows
|
|
||||||
-- - may be able to calculate the visible section of a floating window, and display the chord in
|
|
||||||
-- that space
|
|
||||||
-- - Provide an option to prepend the screen key to the easymotion keys (i.e. w,e,r)?
|
|
||||||
-- - overlay alpha
|
|
||||||
-- - Delay after selection so the user can see what they've chosen? Min-delay: 0 seconds. If
|
|
||||||
-- there's a delay, perhaps keep the other windows covered briefly to naturally draw the user's
|
|
||||||
-- attention to the window they've selected? Or briefly highlight the border of the selected
|
|
||||||
-- window?
|
|
||||||
-- - Option to cover windows that will not be selected by the current chord, such that it's
|
|
||||||
-- slightly more obvious where to maintain focus.
|
|
||||||
-- - Something unpleasant happens when the user provides only two keys (let's say f, d) for
|
|
||||||
-- chords. When they have five windows open, the following chords are generated: ddd, ddf, dfd,
|
|
||||||
-- dff, fdd. When 'f' is pressed, all chords disappear unexpectedly because we know there are no
|
|
||||||
-- other valid options. The user expects to press 'fdd'. This is an optimisation in software but
|
|
||||||
-- pretty bad for usability, as the user continues firing keys into their
|
|
||||||
-- now-unexpectedly-active window. And is of course only one concrete example of a more general
|
|
||||||
-- problem.
|
|
||||||
-- Short-term solution:
|
|
||||||
-- - Keep displaying the chord until the user has fully entered it
|
|
||||||
-- Fix:
|
|
||||||
-- - Show the shortest possible chords
|
|
||||||
|
|
||||||
-- | Associates a user window, an overlay window created by this module and a rectangle
|
|
||||||
-- circumscribing these windows
|
|
||||||
data OverlayWindow =
|
|
||||||
OverlayWindow { win :: !Window -- ^ The window managed by xmonad
|
|
||||||
, attrs :: !WindowAttributes -- ^ Window attributes for @win@
|
|
||||||
, overlay :: !Window -- ^ Our window used to display the overlay
|
|
||||||
, rect :: !Rectangle -- ^ The rectangle of @overlay@
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | An overlay window and the chord used to select it
|
|
||||||
data Overlay =
|
|
||||||
Overlay { overlayWin :: !OverlayWindow -- ^ The window managed by xmonad
|
|
||||||
, chord :: ![KeySym] -- ^ The chord we'll display in the overlay
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
-- | Maps keys to windows. 'AnyKeys' maps keys to windows regardless which screen they're on.
|
|
||||||
-- 'PerScreenKeys' maps keys to screens to windows. See @Usage@ for more examples.
|
|
||||||
data ChordKeys = AnyKeys ![KeySym]
|
|
||||||
| PerScreenKeys !(M.Map ScreenId [KeySym])
|
|
||||||
|
|
||||||
-- | Configuration options for EasyMotion.
|
|
||||||
--
|
|
||||||
-- All colors are hex strings, e.g. "#000000"
|
|
||||||
--
|
|
||||||
-- If the number of windows for which chords are required exceeds 'maxChordLen', chords
|
|
||||||
-- will simply not be generated for these windows. In this way, single-key selection may be
|
|
||||||
-- preferred over the ability to select any window.
|
|
||||||
--
|
|
||||||
-- 'cancelKey', @xK_BackSpace@ and any duplicates will be removed from 'sKeys' if included.
|
|
||||||
-- See @Usage@ for examples of 'sKeys'.
|
|
||||||
data EasyMotionConfig =
|
|
||||||
EMConf { txtCol :: !String -- ^ Color of the text displayed
|
|
||||||
, bgCol :: !String -- ^ Color of the window overlaid
|
|
||||||
, overlayF :: !(Position -> Rectangle -> Rectangle) -- ^ Function to generate overlay rectangle
|
|
||||||
, borderCol :: !String -- ^ Color of the overlay window borders
|
|
||||||
, sKeys :: !ChordKeys -- ^ Keys to use for window selection
|
|
||||||
, cancelKey :: !KeySym -- ^ Key to use to cancel selection
|
|
||||||
, emFont :: !String -- ^ Font for selection characters (passed to 'initXMF')
|
|
||||||
, borderPx :: !Int -- ^ Width of border in pixels
|
|
||||||
, maxChordLen :: !Int -- ^ Maximum chord length. Use 0 for no maximum.
|
|
||||||
}
|
|
||||||
|
|
||||||
instance Default EasyMotionConfig where
|
|
||||||
def =
|
|
||||||
EMConf { txtCol = "#ffffff"
|
|
||||||
, bgCol = "#000000"
|
|
||||||
, overlayF = proportional (0.3::Double)
|
|
||||||
, borderCol = "#ffffff"
|
|
||||||
, sKeys = AnyKeys [xK_s, xK_d, xK_f, xK_j, xK_k, xK_l]
|
|
||||||
, cancelKey = xK_q
|
|
||||||
, borderPx = 1
|
|
||||||
, maxChordLen = 0
|
|
||||||
#ifdef XFT
|
|
||||||
, emFont = "xft:Sans-100"
|
|
||||||
#else
|
|
||||||
, emFont = "-misc-fixed-*-*-*-*-200-*-*-*-*-*-*-*"
|
|
||||||
#endif
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | Create overlay windows of the same size as the window they select
|
|
||||||
fullSize :: Position -> Rectangle -> Rectangle
|
|
||||||
fullSize _ = id
|
|
||||||
|
|
||||||
-- | Create overlay windows a proportion of the size of the window they select
|
|
||||||
proportional :: RealFrac f => f -> Position -> Rectangle -> Rectangle
|
|
||||||
proportional f th r = Rectangle { rect_width = newW
|
|
||||||
, rect_height = newH
|
|
||||||
, rect_x = rect_x r + fi (rect_width r - newW) `div` 2
|
|
||||||
, rect_y = rect_y r + fi (rect_height r - newH) `div` 2 }
|
|
||||||
where
|
|
||||||
newH = max (fi th) (round $ f * fi (rect_height r))
|
|
||||||
newW = newH
|
|
||||||
|
|
||||||
-- | Create fixed-size overlay windows
|
|
||||||
fixedSize :: (Integral a, Integral b) => a -> b -> Position -> Rectangle -> Rectangle
|
|
||||||
fixedSize w h th r = Rectangle { rect_width = rw
|
|
||||||
, rect_height = rh
|
|
||||||
, rect_x = rect_x r + fi (rect_width r - rw) `div` 2
|
|
||||||
, rect_y = rect_y r + fi (rect_height r - rh) `div` 2 }
|
|
||||||
where
|
|
||||||
rw = max (fi w) (fi th)
|
|
||||||
rh = max (fi h) (fi th)
|
|
||||||
|
|
||||||
-- | Create overlay windows the minimum size to contain their key chord
|
|
||||||
textSize :: Position -> Rectangle -> Rectangle
|
|
||||||
textSize th r = Rectangle { rect_width = fi th
|
|
||||||
, rect_height = fi th
|
|
||||||
, rect_x = rect_x r + (fi (rect_width r) - fi th) `div` 2
|
|
||||||
, rect_y = rect_y r + (fi (rect_height r) - fi th) `div` 2 }
|
|
||||||
|
|
||||||
-- | Create overlay windows the full width of the window they select, the minimum height to contain
|
|
||||||
-- their chord, and a proportion of the distance from the top of the window they select
|
|
||||||
bar :: RealFrac f => f -> Position -> Rectangle -> Rectangle
|
|
||||||
bar f th r = Rectangle { rect_width = rect_width r
|
|
||||||
, rect_height = fi th
|
|
||||||
, rect_x = rect_x r
|
|
||||||
, rect_y = rect_y r + round (f' * (fi (rect_height r) - fi th)) }
|
|
||||||
where
|
|
||||||
-- clamp f in [0,1] as other values will appear to lock up xmonad as the overlay will be
|
|
||||||
-- displayed off-screen
|
|
||||||
f' = min 0.0 $ max f 1.0
|
|
||||||
|
|
||||||
-- | Handles overlay display and window selection. Called after config has been sanitised.
|
|
||||||
handleSelectWindow :: EasyMotionConfig -> X (Maybe Window)
|
|
||||||
handleSelectWindow EMConf { sKeys = AnyKeys [] } = return Nothing
|
|
||||||
handleSelectWindow c = do
|
|
||||||
f <- initXMF $ emFont c
|
|
||||||
th <- (\(asc, dsc) -> asc + dsc + 2) <$> textExtentsXMF f (concatMap keysymToString (allKeys . sKeys $ c))
|
|
||||||
XConf { theRoot = rw, display = dpy } <- ask
|
|
||||||
XState { mapped = mappedWins, windowset = ws } <- get
|
|
||||||
-- build overlays depending on key configuration
|
|
||||||
overlays :: [Overlay] <- case sKeys c of
|
|
||||||
AnyKeys ks -> buildOverlays ks <$> sortedOverlayWindows
|
|
||||||
where
|
|
||||||
visibleWindows :: [Window]
|
|
||||||
visibleWindows = toList mappedWins
|
|
||||||
sortedOverlayWindows :: X [OverlayWindow]
|
|
||||||
sortedOverlayWindows = sortOverlayWindows <$> buildOverlayWindows dpy th visibleWindows
|
|
||||||
PerScreenKeys m ->
|
|
||||||
fmap concat
|
|
||||||
$ sequence
|
|
||||||
$ M.elems
|
|
||||||
$ M.mapWithKey (\sid ks -> buildOverlays ks <$> sortedOverlayWindows sid) m
|
|
||||||
where
|
|
||||||
screenById :: ScreenId -> Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
|
|
||||||
screenById sid = find ((== sid) . W.screen) (W.screens ws)
|
|
||||||
visibleWindowsOnScreen :: ScreenId -> [Window]
|
|
||||||
visibleWindowsOnScreen sid = filter (`elem` toList mappedWins) $ W.integrate' $ screenById sid >>= W.stack . W.workspace
|
|
||||||
sortedOverlayWindows :: ScreenId -> X [OverlayWindow]
|
|
||||||
sortedOverlayWindows sid = sortOverlayWindows <$> buildOverlayWindows dpy th (visibleWindowsOnScreen sid)
|
|
||||||
status <- io $ grabKeyboard dpy rw True grabModeAsync grabModeAsync currentTime
|
|
||||||
if status == grabSuccess
|
|
||||||
then do
|
|
||||||
resultWin <- handleKeyboard dpy (displayOverlay f) (cancelKey c) overlays []
|
|
||||||
io $ ungrabKeyboard dpy currentTime
|
|
||||||
mapM_ (deleteWindow . overlay . overlayWin) overlays
|
|
||||||
io $ sync dpy False
|
|
||||||
releaseXMF f
|
|
||||||
case resultWin of
|
|
||||||
-- focus the selected window
|
|
||||||
Selected o -> return . Just . win . overlayWin $ o
|
|
||||||
-- return focus correctly
|
|
||||||
_ -> whenJust (W.peek ws) (windows . W.focusWindow) $> Nothing
|
|
||||||
else releaseXMF f $> Nothing
|
|
||||||
where
|
|
||||||
allKeys :: ChordKeys -> [KeySym]
|
|
||||||
allKeys (AnyKeys ks) = ks
|
|
||||||
allKeys (PerScreenKeys m) = concat $ M.elems m
|
|
||||||
|
|
||||||
buildOverlays :: [KeySym] -> [OverlayWindow] -> [Overlay]
|
|
||||||
buildOverlays ks = appendChords (maxChordLen c) ks
|
|
||||||
|
|
||||||
buildOverlayWindows :: Display -> Position -> [Window] -> X [OverlayWindow]
|
|
||||||
buildOverlayWindows dpy th ws = sequence $ buildOverlayWin dpy th <$> ws
|
|
||||||
|
|
||||||
sortOverlayWindows :: [OverlayWindow] -> [OverlayWindow]
|
|
||||||
sortOverlayWindows = sortOn ((wa_x &&& wa_y) . attrs)
|
|
||||||
|
|
||||||
makeRect :: WindowAttributes -> Rectangle
|
|
||||||
makeRect wa = Rectangle (fi (wa_x wa)) (fi (wa_y wa)) (fi (wa_width wa)) (fi (wa_height wa))
|
|
||||||
|
|
||||||
buildOverlayWin :: Display -> Position -> Window -> X OverlayWindow
|
|
||||||
buildOverlayWin dpy th w = do
|
|
||||||
wAttrs <- io $ getWindowAttributes dpy w
|
|
||||||
let r = overlayF c th $ makeRect wAttrs
|
|
||||||
o <- createNewWindow r Nothing "" True
|
|
||||||
return OverlayWindow { rect=r, overlay=o, win=w, attrs=wAttrs }
|
|
||||||
|
|
||||||
-- | Display an overlay with the provided formatting
|
|
||||||
displayOverlay :: XMonadFont -> Overlay -> X ()
|
|
||||||
displayOverlay f Overlay { overlayWin = OverlayWindow { rect = r, overlay = o }, chord = ch } = do
|
|
||||||
showWindow o
|
|
||||||
paintAndWrite o f (fi (rect_width r)) (fi (rect_height r)) (fi (borderPx c)) (bgCol c) (borderCol c) (txtCol c) (bgCol c) [AlignCenter] [concatMap keysymToString ch]
|
|
||||||
|
|
||||||
-- | Display overlay windows and chords for window selection
|
|
||||||
selectWindow :: EasyMotionConfig -> X (Maybe Window)
|
|
||||||
selectWindow conf =
|
|
||||||
handleSelectWindow conf { sKeys = sanitiseKeys (sKeys conf) }
|
|
||||||
where
|
|
||||||
-- make sure the key lists don't contain: backspace, our cancel key, or duplicates
|
|
||||||
sanitise :: [KeySym] -> [KeySym]
|
|
||||||
sanitise = nub . filter (`notElem` [xK_BackSpace, cancelKey conf])
|
|
||||||
sanitiseKeys :: ChordKeys -> ChordKeys
|
|
||||||
sanitiseKeys cKeys =
|
|
||||||
case cKeys of
|
|
||||||
AnyKeys ks -> AnyKeys . sanitise $ ks
|
|
||||||
PerScreenKeys m -> PerScreenKeys $ M.map sanitise m
|
|
||||||
|
|
||||||
-- | Take a list of overlays lacking chords, return a list of overlays with key chords
|
|
||||||
appendChords :: Int -> [KeySym] -> [OverlayWindow] -> [Overlay]
|
|
||||||
appendChords _ [] _ = []
|
|
||||||
appendChords maxUserSelectedLen ks overlayWins =
|
|
||||||
zipWith Overlay overlayWins chords
|
|
||||||
where
|
|
||||||
chords = replicateM chordLen ks
|
|
||||||
-- the minimum necessary chord length to assign a unique chord to each visible window
|
|
||||||
minCoverLen = -((-(length overlayWins)) `div` length ks)
|
|
||||||
-- if the user has specified a max chord length we use this even if it will not cover all
|
|
||||||
-- windows, as they may prefer to focus windows with fewer keys over the ability to focus any
|
|
||||||
-- window
|
|
||||||
chordLen = if maxUserSelectedLen <= 0 then minCoverLen else min minCoverLen maxUserSelectedLen
|
|
||||||
|
|
||||||
-- | A three-state result for handling user-initiated selection cancellation, successful selection,
|
|
||||||
-- or backspace.
|
|
||||||
data HandleResult = Exit | Selected Overlay | Backspace
|
|
||||||
|
|
||||||
-- | Handle key press events for window selection.
|
|
||||||
handleKeyboard :: Display -> (Overlay -> X()) -> KeySym -> [Overlay] -> [Overlay] -> X HandleResult
|
|
||||||
handleKeyboard _ _ _ [] _ = return Exit
|
|
||||||
handleKeyboard dpy drawFn cancel selected deselected = do
|
|
||||||
redraw
|
|
||||||
ev <- io $ allocaXEvent $ \e -> do
|
|
||||||
maskEvent dpy (keyPressMask .|. keyReleaseMask .|. buttonPressMask) e
|
|
||||||
getEvent e
|
|
||||||
if | ev_event_type ev == keyPress -> do
|
|
||||||
s <- io $ keycodeToKeysym dpy (ev_keycode ev) 0
|
|
||||||
if | s == cancel -> return Exit
|
|
||||||
| s == xK_BackSpace -> return Backspace
|
|
||||||
| isNextOverlayKey s -> handleNextOverlayKey s
|
|
||||||
| otherwise -> handleKeyboard dpy drawFn cancel selected deselected
|
|
||||||
| ev_event_type ev == buttonPress -> do
|
|
||||||
-- See XMonad.Prompt Note [Allow ButtonEvents]
|
|
||||||
io $ allowEvents dpy replayPointer currentTime
|
|
||||||
handleKeyboard dpy drawFn cancel selected deselected
|
|
||||||
| otherwise -> handleKeyboard dpy drawFn cancel selected deselected
|
|
||||||
where
|
|
||||||
redraw = mapM (mapM_ drawFn) [selected, deselected]
|
|
||||||
retryBackspace x =
|
|
||||||
case x of
|
|
||||||
Backspace -> redraw >> handleKeyboard dpy drawFn cancel selected deselected
|
|
||||||
_ -> return x
|
|
||||||
isNextOverlayKey keySym = isJust (find ((== Just keySym) . listToMaybe .chord) selected)
|
|
||||||
handleNextOverlayKey keySym =
|
|
||||||
case fg of
|
|
||||||
[x] -> return $ Selected x
|
|
||||||
_ -> handleKeyboard dpy drawFn cancel (trim fg) (clear bg) >>= retryBackspace
|
|
||||||
where
|
|
||||||
(fg, bg) = partition ((== Just keySym) . listToMaybe . chord) selected
|
|
||||||
trim = map (\o -> o { chord = tail $ chord o })
|
|
||||||
clear = map (\o -> o { chord = [] })
|
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.FindEmptyWorkspace
|
-- Module : XMonad.Actions.FindEmptyWorkspace
|
||||||
-- Description : Find an empty workspace.
|
|
||||||
-- Copyright : (c) Miikka Koskinen 2007
|
-- Copyright : (c) Miikka Koskinen 2007
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -19,7 +18,9 @@ module XMonad.Actions.FindEmptyWorkspace (
|
|||||||
viewEmptyWorkspace, tagToEmptyWorkspace, sendToEmptyWorkspace
|
viewEmptyWorkspace, tagToEmptyWorkspace, sendToEmptyWorkspace
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad.Prelude
|
import Data.List
|
||||||
|
import Data.Maybe ( isNothing )
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.StackSet
|
import XMonad.StackSet
|
||||||
|
|
||||||
|
@@ -1,9 +1,8 @@
|
|||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.FlexibleManipulate
|
-- Module : XMonad.Actions.FlexibleManipulate
|
||||||
-- Description : Move and resize floating windows without warping the mouse.
|
|
||||||
-- Copyright : (c) Michael Sloan
|
-- Copyright : (c) Michael Sloan
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -24,9 +23,8 @@ module XMonad.Actions.FlexibleManipulate (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude ((<&>))
|
|
||||||
import qualified Prelude as P
|
import qualified Prelude as P
|
||||||
import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, map, otherwise, round, snd, uncurry, ($), (.))
|
import Prelude (($), (.), fst, snd, uncurry, const, id, Ord(..), Monad(..), fromIntegral, Double, Integer, map, round, otherwise)
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- First, add this import to your @~\/.xmonad\/xmonad.hs@:
|
-- First, add this import to your @~\/.xmonad\/xmonad.hs@:
|
||||||
@@ -81,23 +79,24 @@ position = const 0.5
|
|||||||
-- manipulation action.
|
-- manipulation action.
|
||||||
mouseWindow :: (Double -> Double) -> Window -> X ()
|
mouseWindow :: (Double -> Double) -> Window -> X ()
|
||||||
mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
|
mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||||
[wpos, wsize] <- io $ getWindowAttributes d w <&> winAttrs
|
io $ raiseWindow d w
|
||||||
|
[wpos, wsize] <- io $ getWindowAttributes d w >>= return . winAttrs
|
||||||
sh <- io $ getWMNormalHints d w
|
sh <- io $ getWMNormalHints d w
|
||||||
pointer <- io $ queryPointer d w <&> pointerPos
|
pointer <- io $ queryPointer d w >>= return . pointerPos
|
||||||
|
|
||||||
let uv = (pointer - wpos) / wsize
|
let uv = (pointer - wpos) / wsize
|
||||||
fc = mapP f uv
|
fc = mapP f uv
|
||||||
mul = mapP (\x -> 2 P.- 2 P.* P.abs(x P.- 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
|
mul = mapP (\x -> 2 P.- 2 P.* P.abs(x P.- 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
|
||||||
atl = ((1, 1) - fc) * mul
|
atl = ((1, 1) - fc) * mul
|
||||||
abr = fc * mul
|
abr = fc * mul
|
||||||
mouseDrag (\ex ey -> do
|
mouseDrag (\ex ey -> io $ do
|
||||||
let offset = (fromIntegral ex, fromIntegral ey) - pointer
|
let offset = (fromIntegral ex, fromIntegral ey) - pointer
|
||||||
npos = wpos + offset * atl
|
npos = wpos + offset * atl
|
||||||
nbr = (wpos + wsize) + offset * abr
|
nbr = (wpos + wsize) + offset * abr
|
||||||
ntl = minP (nbr - (32, 32)) npos --minimum size
|
ntl = minP (nbr - (32, 32)) npos --minimum size
|
||||||
nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl)
|
nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl)
|
||||||
io $ moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
|
moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
|
||||||
float w)
|
return ())
|
||||||
(float w)
|
(float w)
|
||||||
|
|
||||||
float w
|
float w
|
||||||
@@ -114,7 +113,7 @@ type Pnt = (Double, Double)
|
|||||||
pairUp :: [a] -> [(a,a)]
|
pairUp :: [a] -> [(a,a)]
|
||||||
pairUp [] = []
|
pairUp [] = []
|
||||||
pairUp [_] = []
|
pairUp [_] = []
|
||||||
pairUp (x:y:xs) = (x, y) : pairUp xs
|
pairUp (x:y:xs) = (x, y) : (pairUp xs)
|
||||||
|
|
||||||
mapP :: (a -> b) -> (a, a) -> (b, b)
|
mapP :: (a -> b) -> (a, a) -> (b, b)
|
||||||
mapP f (x, y) = (f x, f y)
|
mapP f (x, y) = (f x, f y)
|
||||||
@@ -133,3 +132,4 @@ infixl 7 *, /
|
|||||||
(*) = zipP (P.*)
|
(*) = zipP (P.*)
|
||||||
(/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a)
|
(/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a)
|
||||||
(/) = zipP (P./)
|
(/) = zipP (P./)
|
||||||
|
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.FlexibleResize
|
-- Module : XMonad.Actions.FlexibleResize
|
||||||
-- Description : Resize floating windows from any corner.
|
|
||||||
-- Copyright : (c) Lukas Mai
|
-- Copyright : (c) Lukas Mai
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -21,7 +20,7 @@ module XMonad.Actions.FlexibleResize (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude (fi)
|
import XMonad.Util.XUtils (fi)
|
||||||
import Foreign.C.Types
|
import Foreign.C.Types
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
@@ -51,6 +50,7 @@ mouseResizeEdgeWindow
|
|||||||
-> Window -- ^ The window to resize.
|
-> Window -- ^ The window to resize.
|
||||||
-> X ()
|
-> X ()
|
||||||
mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do
|
mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||||
|
io $ raiseWindow d w
|
||||||
wa <- io $ getWindowAttributes d w
|
wa <- io $ getWindowAttributes d w
|
||||||
sh <- io $ getWMNormalHints d w
|
sh <- io $ getWMNormalHints d w
|
||||||
(_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w
|
(_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w
|
||||||
@@ -62,17 +62,16 @@ mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do
|
|||||||
(cy, fy, gy) = mkSel north height pos_y
|
(cy, fy, gy) = mkSel north height pos_y
|
||||||
io $ warpPointer d none w 0 0 0 0 cx cy
|
io $ warpPointer d none w 0 0 0 0 cx cy
|
||||||
mouseDrag (\ex ey -> do let (nw,nh) = applySizeHintsContents sh (gx ex, gy ey)
|
mouseDrag (\ex ey -> do let (nw,nh) = applySizeHintsContents sh (gx ex, gy ey)
|
||||||
io $ moveResizeWindow d w (fx nw) (fy nh) nw nh
|
io $ moveResizeWindow d w (fx nw) (fy nh) nw nh)
|
||||||
float w)
|
|
||||||
(float w)
|
(float w)
|
||||||
where
|
where
|
||||||
findPos :: CInt -> Position -> Maybe Bool
|
findPos :: CInt -> Position -> Maybe Bool
|
||||||
findPos m s
|
findPos m s = if p < 0.5 - edge/2
|
||||||
| p < 0.5 - edge/2 = Just True
|
then Just True
|
||||||
| p < 0.5 + edge/2 = Nothing
|
else if p < 0.5 + edge/2
|
||||||
| otherwise = Just False
|
then Nothing
|
||||||
where
|
else Just False
|
||||||
p = fi m / fi s
|
where p = fi m / fi s
|
||||||
mkSel :: Maybe Bool -> Position -> Position -> (Position, Dimension -> Position, Position -> Dimension)
|
mkSel :: Maybe Bool -> Position -> Position -> (Position, Dimension -> Position, Position -> Dimension)
|
||||||
mkSel b k p = case b of
|
mkSel b k p = case b of
|
||||||
Just True -> (0, (fi k + fi p -).fi, (fi k + fi p -).fi)
|
Just True -> (0, (fi k + fi p -).fi, (fi k + fi p -).fi)
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.FloatKeys
|
-- Module : XMonad.Actions.FloatKeys
|
||||||
-- Description : Move and resize floating windows.
|
|
||||||
-- Copyright : (c) Karsten Schoelzel <kuser@gmx.de>
|
-- Copyright : (c) Karsten Schoelzel <kuser@gmx.de>
|
||||||
-- License : BSD
|
-- License : BSD
|
||||||
--
|
--
|
||||||
@@ -23,7 +22,6 @@ module XMonad.Actions.FloatKeys (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude (fi)
|
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||||
@@ -45,9 +43,10 @@ import XMonad.Prelude (fi)
|
|||||||
-- right and @dy@ pixels down.
|
-- right and @dy@ pixels down.
|
||||||
keysMoveWindow :: D -> Window -> X ()
|
keysMoveWindow :: D -> Window -> X ()
|
||||||
keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do
|
keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||||
|
io $ raiseWindow d w
|
||||||
wa <- io $ getWindowAttributes d w
|
wa <- io $ getWindowAttributes d w
|
||||||
io $ moveWindow d w (fi (fi (wa_x wa) + dx))
|
io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + dx))
|
||||||
(fi (fi (wa_y wa) + dy))
|
(fromIntegral (fromIntegral (wa_y wa) + dy))
|
||||||
float w
|
float w
|
||||||
|
|
||||||
-- | @keysMoveWindowTo (x, y) (gx, gy)@ moves the window relative
|
-- | @keysMoveWindowTo (x, y) (gx, gy)@ moves the window relative
|
||||||
@@ -62,14 +61,14 @@ keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do
|
|||||||
-- > keysMoveWindowTo (1024,0) (1, 0) -- put window in the top right corner
|
-- > keysMoveWindowTo (1024,0) (1, 0) -- put window in the top right corner
|
||||||
keysMoveWindowTo :: P -> G -> Window -> X ()
|
keysMoveWindowTo :: P -> G -> Window -> X ()
|
||||||
keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do
|
keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||||
|
io $ raiseWindow d w
|
||||||
wa <- io $ getWindowAttributes d w
|
wa <- io $ getWindowAttributes d w
|
||||||
io $ moveWindow d w (x - round (gx * fi (wa_width wa)))
|
io $ moveWindow d w (x - round (gx * fromIntegral (wa_width wa)))
|
||||||
(y - round (gy * fi (wa_height wa)))
|
(y - round (gy * fromIntegral (wa_height wa)))
|
||||||
float w
|
float w
|
||||||
|
|
||||||
type G = (Rational, Rational)
|
type G = (Rational, Rational)
|
||||||
type P = (Position, Position)
|
type P = (Position, Position)
|
||||||
type ChangeDim = (Int, Int)
|
|
||||||
|
|
||||||
-- | @keysResizeWindow (dx, dy) (gx, gy)@ changes the width by @dx@
|
-- | @keysResizeWindow (dx, dy) (gx, gy)@ changes the width by @dx@
|
||||||
-- and the height by @dy@, leaving the window-relative point @(gx,
|
-- and the height by @dy@, leaving the window-relative point @(gx,
|
||||||
@@ -81,7 +80,7 @@ type ChangeDim = (Int, Int)
|
|||||||
-- > keysResizeWindow (10, 0) (0, 1%2) -- does the same, unless sizeHints are applied
|
-- > keysResizeWindow (10, 0) (0, 1%2) -- does the same, unless sizeHints are applied
|
||||||
-- > keysResizeWindow (10, 10) (1%2, 1%2) -- add 5 pixels on each side
|
-- > keysResizeWindow (10, 10) (1%2, 1%2) -- add 5 pixels on each side
|
||||||
-- > keysResizeWindow (-10, -10) (0, 1) -- shrink the window in direction of the bottom-left corner
|
-- > keysResizeWindow (-10, -10) (0, 1) -- shrink the window in direction of the bottom-left corner
|
||||||
keysResizeWindow :: ChangeDim -> G -> Window -> X ()
|
keysResizeWindow :: D -> G -> Window -> X ()
|
||||||
keysResizeWindow = keysMoveResize keysResizeWindow'
|
keysResizeWindow = keysMoveResize keysResizeWindow'
|
||||||
|
|
||||||
-- | @keysAbsResizeWindow (dx, dy) (ax, ay)@ changes the width by @dx@
|
-- | @keysAbsResizeWindow (dx, dy) (ax, ay)@ changes the width by @dx@
|
||||||
@@ -91,34 +90,34 @@ keysResizeWindow = keysMoveResize keysResizeWindow'
|
|||||||
-- For example:
|
-- For example:
|
||||||
--
|
--
|
||||||
-- > keysAbsResizeWindow (10, 10) (0, 0) -- enlarge the window; if it is not in the top-left corner it will also be moved down and to the right.
|
-- > keysAbsResizeWindow (10, 10) (0, 0) -- enlarge the window; if it is not in the top-left corner it will also be moved down and to the right.
|
||||||
keysAbsResizeWindow :: ChangeDim -> D -> Window -> X ()
|
keysAbsResizeWindow :: D -> D -> Window -> X ()
|
||||||
keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow'
|
keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow'
|
||||||
|
|
||||||
keysAbsResizeWindow' :: SizeHints -> P -> D -> ChangeDim -> D -> (P,D)
|
keysAbsResizeWindow' :: SizeHints -> P -> D -> D -> D -> (P,D)
|
||||||
keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh))
|
keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh))
|
||||||
where
|
where
|
||||||
-- The width and height of a window are positive and thus
|
(nw, nh) = applySizeHintsContents sh (w + dx, h + dy)
|
||||||
-- converting to 'Dimension' should be safe.
|
|
||||||
(nw, nh) = applySizeHintsContents sh (fi w + dx, fi h + dy)
|
|
||||||
nx :: Rational
|
nx :: Rational
|
||||||
nx = fi (ax * w + nw * (fi x - ax)) / fi w
|
nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w
|
||||||
ny :: Rational
|
ny :: Rational
|
||||||
ny = fi (ay * h + nh * (fi y - ay)) / fi h
|
ny = fromIntegral (ay * h + nh * (fromIntegral y - ay)) / fromIntegral h
|
||||||
|
|
||||||
keysResizeWindow' :: SizeHints -> P -> D -> ChangeDim -> G -> (P,D)
|
keysResizeWindow' :: SizeHints -> P -> D -> D -> G -> (P,D)
|
||||||
keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh))
|
keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh))
|
||||||
where
|
where
|
||||||
(nw, nh) = applySizeHintsContents sh (fi w + dx, fi h + dy)
|
(nw, nh) = applySizeHintsContents sh (w + dx, h + dy)
|
||||||
nx = round $ fi x + gx * fi w - gx * fi nw
|
nx = round $ fromIntegral x + gx * fromIntegral w - gx * fromIntegral nw
|
||||||
ny = round $ fi y + gy * fi h - gy * fi nh
|
ny = round $ fromIntegral y + gy * fromIntegral h - gy * fromIntegral nh
|
||||||
|
|
||||||
keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X ()
|
keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X ()
|
||||||
keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do
|
keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||||
|
io $ raiseWindow d w
|
||||||
wa <- io $ getWindowAttributes d w
|
wa <- io $ getWindowAttributes d w
|
||||||
sh <- io $ getWMNormalHints d w
|
sh <- io $ getWMNormalHints d w
|
||||||
let wa_dim = (fi $ wa_width wa, fi $ wa_height wa)
|
let wa_dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)
|
||||||
wa_pos = (fi $ wa_x wa, fi $ wa_y wa)
|
wa_pos = (fromIntegral $ wa_x wa, fromIntegral $ wa_y wa)
|
||||||
(wn_pos, wn_dim) = f sh wa_pos wa_dim move resize
|
(wn_pos, wn_dim) = f sh wa_pos wa_dim move resize
|
||||||
io $ resizeWindow d w `uncurry` wn_dim
|
io $ resizeWindow d w `uncurry` wn_dim
|
||||||
io $ moveWindow d w `uncurry` wn_pos
|
io $ moveWindow d w `uncurry` wn_pos
|
||||||
float w
|
float w
|
||||||
|
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Layout.FloatSnap
|
-- Module : XMonad.Layout.FloatSnap
|
||||||
-- Description : Snap to other windows or the edge of the screen while moving or resizing.
|
|
||||||
-- Copyright : (c) 2009 Anders Engstrom <ankaan@gmail.com>
|
-- Copyright : (c) 2009 Anders Engstrom <ankaan@gmail.com>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -28,7 +27,9 @@ module XMonad.Actions.FloatSnap (
|
|||||||
ifClick') where
|
ifClick') where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude (fromJust, isNothing, listToMaybe, sort, when)
|
import Control.Applicative((<$>))
|
||||||
|
import Data.List (sort)
|
||||||
|
import Data.Maybe (listToMaybe,fromJust,isNothing)
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
|
||||||
@@ -95,14 +96,14 @@ snapMagicMouseResize
|
|||||||
snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
|
snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||||
wa <- io $ getWindowAttributes d w
|
wa <- io $ getWindowAttributes d w
|
||||||
(_, _, _, px, py, _, _, _) <- io $ queryPointer d w
|
(_, _, _, px, py, _, _, _) <- io $ queryPointer d w
|
||||||
let x = (fromIntegral px - wx wa)/ww wa
|
let x = (fromIntegral px - wx wa)/(ww wa)
|
||||||
y = (fromIntegral py - wy wa)/wh wa
|
y = (fromIntegral py - wy wa)/(wh wa)
|
||||||
ml = [L | x <= (0.5 - middle/2)]
|
ml = if x <= (0.5 - middle/2) then [L] else []
|
||||||
mr = [R | x > (0.5 + middle/2)]
|
mr = if x > (0.5 + middle/2) then [R] else []
|
||||||
mu = [U | y <= (0.5 - middle/2)]
|
mu = if y <= (0.5 - middle/2) then [U] else []
|
||||||
md = [D | y > (0.5 + middle/2)]
|
md = if y > (0.5 + middle/2) then [D] else []
|
||||||
mdir = ml++mr++mu++md
|
mdir = ml++mr++mu++md
|
||||||
dir = if null mdir
|
dir = if mdir == []
|
||||||
then [L,R,U,D]
|
then [L,R,U,D]
|
||||||
else mdir
|
else mdir
|
||||||
snapMagicResize dir collidedist snapdist w
|
snapMagicResize dir collidedist snapdist w
|
||||||
@@ -120,17 +121,18 @@ snapMagicResize
|
|||||||
-> Window -- ^ The window to move and resize.
|
-> Window -- ^ The window to move and resize.
|
||||||
-> X ()
|
-> X ()
|
||||||
snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
|
snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||||
|
io $ raiseWindow d w
|
||||||
wa <- io $ getWindowAttributes d w
|
wa <- io $ getWindowAttributes d w
|
||||||
|
|
||||||
(xbegin,xend) <- handleAxis True d wa
|
(xbegin,xend) <- handleAxis True d wa
|
||||||
(ybegin,yend) <- handleAxis False d wa
|
(ybegin,yend) <- handleAxis False d wa
|
||||||
|
|
||||||
let xbegin' = if L `elem` dir then xbegin else wx wa
|
let xbegin' = if L `elem` dir then xbegin else (wx wa)
|
||||||
xend' = if R `elem` dir then xend else wx wa + ww wa
|
xend' = if R `elem` dir then xend else (wx wa + ww wa)
|
||||||
ybegin' = if U `elem` dir then ybegin else wy wa
|
ybegin' = if U `elem` dir then ybegin else (wy wa)
|
||||||
yend' = if D `elem` dir then yend else wy wa + wh wa
|
yend' = if D `elem` dir then yend else (wy wa + wh wa)
|
||||||
|
|
||||||
io $ moveWindow d w (fromIntegral xbegin') (fromIntegral ybegin')
|
io $ moveWindow d w (fromIntegral $ xbegin') (fromIntegral $ ybegin')
|
||||||
io $ resizeWindow d w (fromIntegral $ xend' - xbegin') (fromIntegral $ yend' - ybegin')
|
io $ resizeWindow d w (fromIntegral $ xend' - xbegin') (fromIntegral $ yend' - ybegin')
|
||||||
float w
|
float w
|
||||||
where
|
where
|
||||||
@@ -150,13 +152,13 @@ snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $
|
|||||||
(Nothing,Nothing) -> wpos wa
|
(Nothing,Nothing) -> wpos wa
|
||||||
end = if fs
|
end = if fs
|
||||||
then wpos wa + wdim wa
|
then wpos wa + wdim wa
|
||||||
else case (if mfl==Just begin then Nothing else mfl,mfr) of
|
else case (if mfl==(Just begin) then Nothing else mfl,mfr) of
|
||||||
(Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr
|
(Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr
|
||||||
(Just fl,Nothing) -> fl
|
(Just fl,Nothing) -> fl
|
||||||
(Nothing,Just fr) -> fr
|
(Nothing,Just fr) -> fr
|
||||||
(Nothing,Nothing) -> wpos wa + wdim wa
|
(Nothing,Nothing) -> wpos wa + wdim wa
|
||||||
begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else wpos wa
|
begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else (wpos wa)
|
||||||
end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else wpos wa + wdim wa
|
end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else (wpos wa + wdim wa)
|
||||||
return (begin',end')
|
return (begin',end')
|
||||||
where
|
where
|
||||||
(wpos, wdim, _, _) = constructors horiz
|
(wpos, wdim, _, _) = constructors horiz
|
||||||
@@ -169,6 +171,7 @@ snapMagicMove
|
|||||||
-> Window -- ^ The window to move.
|
-> Window -- ^ The window to move.
|
||||||
-> X ()
|
-> X ()
|
||||||
snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
|
snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||||
|
io $ raiseWindow d w
|
||||||
wa <- io $ getWindowAttributes d w
|
wa <- io $ getWindowAttributes d w
|
||||||
|
|
||||||
nx <- handleAxis True d wa
|
nx <- handleAxis True d wa
|
||||||
@@ -191,8 +194,8 @@ snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
|
|||||||
(Just fl,Nothing) -> fl
|
(Just fl,Nothing) -> fl
|
||||||
(Nothing,Just fr) -> fr
|
(Nothing,Just fr) -> fr
|
||||||
(Nothing,Nothing) -> wpos wa
|
(Nothing,Nothing) -> wpos wa
|
||||||
newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else f - wdim wa
|
newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else (f - wdim wa)
|
||||||
in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else wpos wa
|
in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else (wpos wa)
|
||||||
where
|
where
|
||||||
(wpos, wdim, _, _) = constructors horiz
|
(wpos, wdim, _, _) = constructors horiz
|
||||||
|
|
||||||
@@ -209,6 +212,7 @@ snapMove D = doSnapMove False False
|
|||||||
|
|
||||||
doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X ()
|
doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X ()
|
||||||
doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
|
doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||||
|
io $ raiseWindow d w
|
||||||
wa <- io $ getWindowAttributes d w
|
wa <- io $ getWindowAttributes d w
|
||||||
((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w
|
((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w
|
||||||
|
|
||||||
@@ -248,6 +252,7 @@ snapShrink = snapResize False
|
|||||||
|
|
||||||
snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()
|
snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()
|
||||||
snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
|
snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||||
|
io $ raiseWindow d w
|
||||||
wa <- io $ getWindowAttributes d w
|
wa <- io $ getWindowAttributes d w
|
||||||
mr <- case dir of
|
mr <- case dir of
|
||||||
L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w
|
L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w
|
||||||
@@ -269,8 +274,9 @@ snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
|
|||||||
|
|
||||||
case mr of
|
case mr of
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
Just (nx,ny,nw,nh) -> when (nw>0 && nh>0) $ do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
|
Just (nx,ny,nw,nh) -> if nw>0 && nh>0 then do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
|
||||||
io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh)
|
io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh)
|
||||||
|
else return ()
|
||||||
float w
|
float w
|
||||||
where
|
where
|
||||||
wx = fromIntegral.wa_x
|
wx = fromIntegral.wa_x
|
||||||
@@ -285,8 +291,8 @@ getSnap horiz collidedist d w = do
|
|||||||
screen <- W.current <$> gets windowset
|
screen <- W.current <$> gets windowset
|
||||||
let sr = screenRect $ W.screenDetail screen
|
let sr = screenRect $ W.screenDetail screen
|
||||||
wl = W.integrate' . W.stack $ W.workspace screen
|
wl = W.integrate' . W.stack $ W.workspace screen
|
||||||
gr <- ($sr) <$> calcGap (S.fromList [minBound .. maxBound])
|
gr <- fmap ($sr) $ calcGap $ S.fromList [minBound .. maxBound]
|
||||||
wla <- filter (collides wa) <$> io (mapM (getWindowAttributes d) $ filter (/=w) wl)
|
wla <- filter (collides wa) `fmap` (io $ mapM (getWindowAttributes d) $ filter (/=w) wl)
|
||||||
|
|
||||||
return ( neighbours (back wa sr gr wla) (wpos wa)
|
return ( neighbours (back wa sr gr wla) (wpos wa)
|
||||||
, neighbours (front wa sr gr wla) (wpos wa + wdim wa)
|
, neighbours (front wa sr gr wla) (wpos wa + wdim wa)
|
||||||
@@ -300,8 +306,8 @@ getSnap horiz collidedist d w = do
|
|||||||
|
|
||||||
back wa sr gr wla = dropWhile (< rpos sr) $
|
back wa sr gr wla = dropWhile (< rpos sr) $
|
||||||
takeWhile (< rpos sr + rdim sr) $
|
takeWhile (< rpos sr + rdim sr) $
|
||||||
sort $ rpos sr:rpos gr:(rpos gr + rdim gr):
|
sort $ (rpos sr):(rpos gr):(rpos gr + rdim gr):
|
||||||
foldr (\a as -> wpos a:(wpos a + wdim a + wborder a + wborder wa):as) [] wla
|
foldr (\a as -> (wpos a):(wpos a + wdim a + wborder a + wborder wa):as) [] wla
|
||||||
|
|
||||||
front wa sr gr wla = dropWhile (<= rpos sr) $
|
front wa sr gr wla = dropWhile (<= rpos sr) $
|
||||||
takeWhile (<= rpos sr + rdim sr) $
|
takeWhile (<= rpos sr + rdim sr) $
|
||||||
@@ -315,8 +321,8 @@ getSnap horiz collidedist d w = do
|
|||||||
|
|
||||||
collides wa oa = case collidedist of
|
collides wa oa = case collidedist of
|
||||||
Nothing -> True
|
Nothing -> True
|
||||||
Just dist -> refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist
|
Just dist -> ( refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist
|
||||||
&& refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa
|
&& refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa )
|
||||||
|
|
||||||
|
|
||||||
constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int)
|
constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int)
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.FocusNth
|
-- Module : XMonad.Actions.FocusNth
|
||||||
-- Description : Focus the nth window of the current workspace.
|
|
||||||
-- Copyright : (c) Karsten Schoelzel <kuser@gmx.de>
|
-- Copyright : (c) Karsten Schoelzel <kuser@gmx.de>
|
||||||
-- License : BSD
|
-- License : BSD
|
||||||
--
|
--
|
||||||
@@ -40,7 +39,7 @@ focusNth :: Int -> X ()
|
|||||||
focusNth = windows . modify' . focusNth'
|
focusNth = windows . modify' . focusNth'
|
||||||
|
|
||||||
focusNth' :: Int -> Stack a -> Stack a
|
focusNth' :: Int -> Stack a -> Stack a
|
||||||
focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length ls + length rs) = s
|
focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s
|
||||||
| otherwise = listToStack n (integrate s)
|
| otherwise = listToStack n (integrate s)
|
||||||
|
|
||||||
-- | Swap current window with nth. Focus stays in the same position
|
-- | Swap current window with nth. Focus stays in the same position
|
||||||
@@ -53,8 +52,11 @@ swapNth' n s@(Stack c l r)
|
|||||||
| n < length l = let (nl, nc:nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r
|
| n < length l = let (nl, nc:nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r
|
||||||
| otherwise = let (nl, nc:nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr)
|
| otherwise = let (nl, nc:nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr)
|
||||||
|
|
||||||
|
|
||||||
listToStack :: Int -> [a] -> Stack a
|
listToStack :: Int -> [a] -> Stack a
|
||||||
listToStack n l = Stack t ls rs
|
listToStack n l = Stack t ls rs
|
||||||
where
|
where
|
||||||
(t:rs) = drop n l
|
(t:rs) = drop n l
|
||||||
ls = reverse (take n l)
|
ls = reverse (take n l)
|
||||||
|
|
||||||
|
|
||||||
|
@@ -1,8 +1,7 @@
|
|||||||
{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, TupleSections #-}
|
{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.GridSelect
|
-- Module : XMonad.Actions.GridSelect
|
||||||
-- Description : Display items in a 2D grid and select from it with the keyboard or the mouse.
|
|
||||||
-- Copyright : Clemens Fruhwirth <clemens@endorphin.org>
|
-- Copyright : Clemens Fruhwirth <clemens@endorphin.org>
|
||||||
-- License : BSD-style (see LICENSE)
|
-- License : BSD-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -29,6 +28,7 @@ module XMonad.Actions.GridSelect (
|
|||||||
-- * Configuration
|
-- * Configuration
|
||||||
GSConfig(..),
|
GSConfig(..),
|
||||||
def,
|
def,
|
||||||
|
defaultGSConfig,
|
||||||
TwoDPosition,
|
TwoDPosition,
|
||||||
buildDefaultGSConfig,
|
buildDefaultGSConfig,
|
||||||
|
|
||||||
@@ -48,7 +48,6 @@ module XMonad.Actions.GridSelect (
|
|||||||
fromClassName,
|
fromClassName,
|
||||||
stringColorizer,
|
stringColorizer,
|
||||||
colorRangeFromClassName,
|
colorRangeFromClassName,
|
||||||
stringToRatio,
|
|
||||||
|
|
||||||
-- * Navigation Mode assembly
|
-- * Navigation Mode assembly
|
||||||
TwoD,
|
TwoD,
|
||||||
@@ -80,14 +79,16 @@ module XMonad.Actions.GridSelect (
|
|||||||
-- * Types
|
-- * Types
|
||||||
TwoDState,
|
TwoDState,
|
||||||
) where
|
) where
|
||||||
import Control.Arrow ((***))
|
import Data.Maybe
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
|
import Data.Char
|
||||||
import Data.Ord (comparing)
|
import Data.Ord (comparing)
|
||||||
|
import Control.Applicative
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
import Control.Arrow
|
||||||
import Data.List as L
|
import Data.List as L
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import XMonad hiding (liftX)
|
import XMonad hiding (liftX)
|
||||||
import XMonad.Prelude
|
|
||||||
import XMonad.Util.Font
|
import XMonad.Util.Font
|
||||||
import XMonad.Prompt (mkUnmanagedWindow)
|
import XMonad.Prompt (mkUnmanagedWindow)
|
||||||
import XMonad.StackSet as W
|
import XMonad.StackSet as W
|
||||||
@@ -95,7 +96,7 @@ import XMonad.Layout.Decoration
|
|||||||
import XMonad.Util.NamedWindows
|
import XMonad.Util.NamedWindows
|
||||||
import XMonad.Actions.WindowBringer (bringWindow)
|
import XMonad.Actions.WindowBringer (bringWindow)
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
import System.Random (mkStdGen, randomR)
|
import System.Random (mkStdGen, genRange, next)
|
||||||
import Data.Word (Word8)
|
import Data.Word (Word8)
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
@@ -106,13 +107,13 @@ import Data.Word (Word8)
|
|||||||
--
|
--
|
||||||
-- Then add a keybinding, e.g.
|
-- Then add a keybinding, e.g.
|
||||||
--
|
--
|
||||||
-- > , ((modm, xK_g), goToSelected def)
|
-- > , ((modm, xK_g), goToSelected defaultGSConfig)
|
||||||
--
|
--
|
||||||
-- This module also supports displaying arbitrary information in a grid and letting
|
-- This module also supports displaying arbitrary information in a grid and letting
|
||||||
-- the user select from it. E.g. to spawn an application from a given list, you
|
-- the user select from it. E.g. to spawn an application from a given list, you
|
||||||
-- can use the following:
|
-- can use the following:
|
||||||
--
|
--
|
||||||
-- > , ((modm, xK_s), spawnSelected def ["xterm","gmplayer","gvim"])
|
-- > , ((modm, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"])
|
||||||
|
|
||||||
-- $commonGSConfig
|
-- $commonGSConfig
|
||||||
--
|
--
|
||||||
@@ -122,7 +123,7 @@ import Data.Word (Word8)
|
|||||||
-- > {-# LANGUAGE NoMonomorphismRestriction #-}
|
-- > {-# LANGUAGE NoMonomorphismRestriction #-}
|
||||||
-- > import XMonad
|
-- > import XMonad
|
||||||
-- > ...
|
-- > ...
|
||||||
-- > gsconfig1 = def { gs_cellheight = 30, gs_cellwidth = 100 }
|
-- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellwidth = 100 }
|
||||||
--
|
--
|
||||||
-- An example where 'buildDefaultGSConfig' is used instead of 'defaultGSConfig'
|
-- An example where 'buildDefaultGSConfig' is used instead of 'defaultGSConfig'
|
||||||
-- in order to specify a custom colorizer is @gsconfig2@ (found in
|
-- in order to specify a custom colorizer is @gsconfig2@ (found in
|
||||||
@@ -204,8 +205,7 @@ data GSConfig a = GSConfig {
|
|||||||
gs_navigate :: TwoD a (Maybe a),
|
gs_navigate :: TwoD a (Maybe a),
|
||||||
gs_rearranger :: Rearranger a,
|
gs_rearranger :: Rearranger a,
|
||||||
gs_originFractX :: Double,
|
gs_originFractX :: Double,
|
||||||
gs_originFractY :: Double,
|
gs_originFractY :: Double
|
||||||
gs_bordercolor :: String
|
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | That is 'fromClassName' if you are selecting a 'Window', or
|
-- | That is 'fromClassName' if you are selecting a 'Window', or
|
||||||
@@ -221,14 +221,18 @@ instance HasColorizer Window where
|
|||||||
instance HasColorizer String where
|
instance HasColorizer String where
|
||||||
defaultColorizer = stringColorizer
|
defaultColorizer = stringColorizer
|
||||||
|
|
||||||
instance {-# OVERLAPPABLE #-} HasColorizer a where
|
instance HasColorizer a where
|
||||||
defaultColorizer _ isFg =
|
defaultColorizer _ isFg =
|
||||||
let getColor = if isFg then focusedBorderColor else normalBorderColor
|
let getColor = if isFg then focusedBorderColor else normalBorderColor
|
||||||
in asks $ (, "black") . getColor . config
|
in asks $ flip (,) "black" . getColor . config
|
||||||
|
|
||||||
instance HasColorizer a => Default (GSConfig a) where
|
instance HasColorizer a => Default (GSConfig a) where
|
||||||
def = buildDefaultGSConfig defaultColorizer
|
def = buildDefaultGSConfig defaultColorizer
|
||||||
|
|
||||||
|
{-# DEPRECATED defaultGSConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.GridSelect) instead." #-}
|
||||||
|
defaultGSConfig :: HasColorizer a => GSConfig a
|
||||||
|
defaultGSConfig = def
|
||||||
|
|
||||||
type TwoDPosition = (Integer, Integer)
|
type TwoDPosition = (Integer, Integer)
|
||||||
|
|
||||||
type TwoDElementMap a = [(TwoDPosition,(String,a))]
|
type TwoDElementMap a = [(TwoDPosition,(String,a))]
|
||||||
@@ -259,7 +263,7 @@ generateElementmap s = do
|
|||||||
-- Sorts the elementmap
|
-- Sorts the elementmap
|
||||||
sortedElements = orderElementmap searchString filteredElements
|
sortedElements = orderElementmap searchString filteredElements
|
||||||
-- Case Insensitive version of isInfixOf
|
-- Case Insensitive version of isInfixOf
|
||||||
needle `isInfixOfI` haystack = upper needle `isInfixOf` upper haystack
|
needle `isInfixOfI` haystack = (upper needle) `isInfixOf` (upper haystack)
|
||||||
upper = map toUpper
|
upper = map toUpper
|
||||||
|
|
||||||
|
|
||||||
@@ -303,8 +307,8 @@ diamondLayer n =
|
|||||||
-- tr = top right
|
-- tr = top right
|
||||||
-- r = ur ++ 90 degree clock-wise rotation of ur
|
-- r = ur ++ 90 degree clock-wise rotation of ur
|
||||||
let tr = [ (x,n-x) | x <- [0..n-1] ]
|
let tr = [ (x,n-x) | x <- [0..n-1] ]
|
||||||
r = tr ++ map (\(x,y) -> (y,-x)) tr
|
r = tr ++ (map (\(x,y) -> (y,-x)) tr)
|
||||||
in r ++ map (negate *** negate) r
|
in r ++ (map (negate *** negate) r)
|
||||||
|
|
||||||
diamond :: (Enum a, Num a, Eq a) => [(a, a)]
|
diamond :: (Enum a, Num a, Eq a) => [(a, a)]
|
||||||
diamond = concatMap diamondLayer [0..]
|
diamond = concatMap diamondLayer [0..]
|
||||||
@@ -318,15 +322,15 @@ diamondRestrict x y originX originY =
|
|||||||
findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
|
findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
|
||||||
findInElementMap pos = find ((== pos) . fst)
|
findInElementMap pos = find ((== pos) . fst)
|
||||||
|
|
||||||
drawWinBox :: Window -> XMonadFont -> (String, String) -> String -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()
|
drawWinBox :: Window -> XMonadFont -> (String, String) -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()
|
||||||
drawWinBox win font (fg,bg) bc ch cw text x y cp =
|
drawWinBox win font (fg,bg) ch cw text x y cp =
|
||||||
withDisplay $ \dpy -> do
|
withDisplay $ \dpy -> do
|
||||||
gc <- liftIO $ createGC dpy win
|
gc <- liftIO $ createGC dpy win
|
||||||
bordergc <- liftIO $ createGC dpy win
|
bordergc <- liftIO $ createGC dpy win
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
Just fgcolor <- initColor dpy fg
|
Just fgcolor <- initColor dpy fg
|
||||||
Just bgcolor <- initColor dpy bg
|
Just bgcolor <- initColor dpy bg
|
||||||
Just bordercolor <- initColor dpy bc
|
Just bordercolor <- initColor dpy borderColor
|
||||||
setForeground dpy gc fgcolor
|
setForeground dpy gc fgcolor
|
||||||
setBackground dpy gc bgcolor
|
setBackground dpy gc bgcolor
|
||||||
setForeground dpy bordergc bordercolor
|
setForeground dpy bordergc bordercolor
|
||||||
@@ -334,12 +338,9 @@ drawWinBox win font (fg,bg) bc ch cw text x y cp =
|
|||||||
drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)
|
drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)
|
||||||
stext <- shrinkWhile (shrinkIt shrinkText)
|
stext <- shrinkWhile (shrinkIt shrinkText)
|
||||||
(\n -> do size <- liftIO $ textWidthXMF dpy font n
|
(\n -> do size <- liftIO $ textWidthXMF dpy font n
|
||||||
return $ size > fromInteger (cw-(2*cp)))
|
return $ size > (fromInteger (cw-(2*cp))))
|
||||||
text
|
text
|
||||||
-- calculate the offset to vertically centre the text based on the ascender and descender
|
printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+(div ch 2))) stext
|
||||||
(asc,desc) <- liftIO $ textExtentsXMF font stext
|
|
||||||
let offset = ((ch - fromIntegral (asc + desc)) `div` 2) + fromIntegral asc
|
|
||||||
printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+offset)) stext
|
|
||||||
liftIO $ freeGC dpy gc
|
liftIO $ freeGC dpy gc
|
||||||
liftIO $ freeGC dpy bordergc
|
liftIO $ freeGC dpy bordergc
|
||||||
|
|
||||||
@@ -377,7 +378,6 @@ updateElementsWithColorizer colorizer elementmap = do
|
|||||||
colors <- colorizer element (pos == curpos)
|
colors <- colorizer element (pos == curpos)
|
||||||
drawWinBox win font
|
drawWinBox win font
|
||||||
colors
|
colors
|
||||||
(gs_bordercolor gsconfig)
|
|
||||||
cellheight
|
cellheight
|
||||||
cellwidth
|
cellwidth
|
||||||
text
|
text
|
||||||
@@ -387,10 +387,10 @@ updateElementsWithColorizer colorizer elementmap = do
|
|||||||
mapM_ updateElement elementmap
|
mapM_ updateElement elementmap
|
||||||
|
|
||||||
stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
|
stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
|
||||||
stdHandle ButtonEvent{ ev_event_type = t, ev_x = x, ev_y = y } contEventloop
|
stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop
|
||||||
| t == buttonRelease = do
|
| t == buttonRelease = do
|
||||||
s@TwoDState { td_paneX = px, td_paneY = py,
|
s @ TwoDState { td_paneX = px, td_paneY = py,
|
||||||
td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get
|
td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _) } <- get
|
||||||
let gridX = (fi x - (px - cw) `div` 2) `div` cw
|
let gridX = (fi x - (px - cw) `div` 2) `div` cw
|
||||||
gridY = (fi y - (py - ch) `div` 2) `div` ch
|
gridY = (fi y - (py - ch) `div` 2) `div` ch
|
||||||
case lookup (gridX,gridY) (td_elementmap s) of
|
case lookup (gridX,gridY) (td_elementmap s) of
|
||||||
@@ -398,7 +398,7 @@ stdHandle ButtonEvent{ ev_event_type = t, ev_x = x, ev_y = y } contEventloop
|
|||||||
Nothing -> contEventloop
|
Nothing -> contEventloop
|
||||||
| otherwise = contEventloop
|
| otherwise = contEventloop
|
||||||
|
|
||||||
stdHandle ExposeEvent{} contEventloop = updateAllElements >> contEventloop
|
stdHandle (ExposeEvent { }) contEventloop = updateAllElements >> contEventloop
|
||||||
|
|
||||||
stdHandle _ contEventloop = contEventloop
|
stdHandle _ contEventloop = contEventloop
|
||||||
|
|
||||||
@@ -430,7 +430,7 @@ shadowWithKeymap keymap dflt keyEvent@(ks,_,m') = fromMaybe (dflt keyEvent) (M.l
|
|||||||
select :: TwoD a (Maybe a)
|
select :: TwoD a (Maybe a)
|
||||||
select = do
|
select = do
|
||||||
s <- get
|
s <- get
|
||||||
return $ snd . snd <$> findInElementMap (td_curpos s) (td_elementmap s)
|
return $ fmap (snd . snd) $ findInElementMap (td_curpos s) (td_elementmap s)
|
||||||
|
|
||||||
-- | Closes gridselect returning no element.
|
-- | Closes gridselect returning no element.
|
||||||
cancel :: TwoD a (Maybe a)
|
cancel :: TwoD a (Maybe a)
|
||||||
@@ -445,7 +445,7 @@ setPos newPos = do
|
|||||||
oldPos = td_curpos s
|
oldPos = td_curpos s
|
||||||
when (isJust newSelectedEl && newPos /= oldPos) $ do
|
when (isJust newSelectedEl && newPos /= oldPos) $ do
|
||||||
put s { td_curpos = newPos }
|
put s { td_curpos = newPos }
|
||||||
updateElements (catMaybes [findInElementMap oldPos elmap, newSelectedEl])
|
updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])
|
||||||
|
|
||||||
-- | Moves the cursor by the offsets specified
|
-- | Moves the cursor by the offsets specified
|
||||||
move :: (Integer, Integer) -> TwoD a ()
|
move :: (Integer, Integer) -> TwoD a ()
|
||||||
@@ -545,7 +545,7 @@ navNSearch = makeXEventhandler $ shadowWithKeymap navNSearchKeyMap navNSearchDef
|
|||||||
,((0,xK_Up) , move (0,-1) >> navNSearch)
|
,((0,xK_Up) , move (0,-1) >> navNSearch)
|
||||||
,((0,xK_Tab) , moveNext >> navNSearch)
|
,((0,xK_Tab) , moveNext >> navNSearch)
|
||||||
,((shiftMask,xK_Tab), movePrev >> navNSearch)
|
,((shiftMask,xK_Tab), movePrev >> navNSearch)
|
||||||
,((0,xK_BackSpace), transformSearchString (\s -> if s == "" then "" else init s) >> navNSearch)
|
,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> navNSearch)
|
||||||
]
|
]
|
||||||
-- The navigation handler ignores unknown key symbols, therefore we const
|
-- The navigation handler ignores unknown key symbols, therefore we const
|
||||||
navNSearchDefaultHandler (_,s,_) = do
|
navNSearchDefaultHandler (_,s,_) = do
|
||||||
@@ -559,7 +559,7 @@ substringSearch returnNavigation = fix $ \me ->
|
|||||||
let searchKeyMap = M.fromList [
|
let searchKeyMap = M.fromList [
|
||||||
((0,xK_Escape) , transformSearchString (const "") >> returnNavigation)
|
((0,xK_Escape) , transformSearchString (const "") >> returnNavigation)
|
||||||
,((0,xK_Return) , returnNavigation)
|
,((0,xK_Return) , returnNavigation)
|
||||||
,((0,xK_BackSpace), transformSearchString (\s -> if s == "" then "" else init s) >> me)
|
,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> me)
|
||||||
]
|
]
|
||||||
searchDefaultHandler (_,s,_) = do
|
searchDefaultHandler (_,s,_) = do
|
||||||
transformSearchString (++ s)
|
transformSearchString (++ s)
|
||||||
@@ -571,8 +571,8 @@ substringSearch returnNavigation = fix $ \me ->
|
|||||||
-- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space
|
-- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space
|
||||||
hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a)
|
hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a)
|
||||||
hsv2rgb (h,s,v) =
|
hsv2rgb (h,s,v) =
|
||||||
let hi = div h 60 `mod` 6 :: Integer
|
let hi = (div h 60) `mod` 6 :: Integer
|
||||||
f = ((fromInteger h/60) - fromInteger hi) :: Fractional a => a
|
f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a
|
||||||
q = v * (1-f)
|
q = v * (1-f)
|
||||||
p = v * (1-s)
|
p = v * (1-s)
|
||||||
t = v * (1-(1-f)*s)
|
t = v * (1-(1-f)*s)
|
||||||
@@ -589,19 +589,19 @@ hsv2rgb (h,s,v) =
|
|||||||
stringColorizer :: String -> Bool -> X (String, String)
|
stringColorizer :: String -> Bool -> X (String, String)
|
||||||
stringColorizer s active =
|
stringColorizer s active =
|
||||||
let seed x = toInteger (sum $ map ((*x).fromEnum) s) :: Integer
|
let seed x = toInteger (sum $ map ((*x).fromEnum) s) :: Integer
|
||||||
(r,g,b) = hsv2rgb (seed 83 `mod` 360,
|
(r,g,b) = hsv2rgb ((seed 83) `mod` 360,
|
||||||
fromInteger (seed 191 `mod` 1000)/2500+0.4,
|
(fromInteger ((seed 191) `mod` 1000))/2500+0.4,
|
||||||
fromInteger (seed 121 `mod` 1000)/2500+0.4)
|
(fromInteger ((seed 121) `mod` 1000))/2500+0.4)
|
||||||
in if active
|
in if active
|
||||||
then return ("#faff69", "black")
|
then return ("#faff69", "black")
|
||||||
else return ("#" ++ concatMap (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b], "white")
|
else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b] ), "white")
|
||||||
|
|
||||||
-- | Colorize a window depending on it's className.
|
-- | Colorize a window depending on it's className.
|
||||||
fromClassName :: Window -> Bool -> X (String, String)
|
fromClassName :: Window -> Bool -> X (String, String)
|
||||||
fromClassName w active = runQuery className w >>= flip defaultColorizer active
|
fromClassName w active = runQuery className w >>= flip defaultColorizer active
|
||||||
|
|
||||||
twodigitHex :: Word8 -> String
|
twodigitHex :: Word8 -> String
|
||||||
twodigitHex = printf "%02x"
|
twodigitHex a = printf "%02x" a
|
||||||
|
|
||||||
-- | A colorizer that picks a color inside a range,
|
-- | A colorizer that picks a color inside a range,
|
||||||
-- and depending on the window's class.
|
-- and depending on the window's class.
|
||||||
@@ -630,12 +630,15 @@ mix (r1, g1, b1) (r2, g2, b2) r = (mix' r1 r2, mix' g1 g2, mix' b1 b2)
|
|||||||
|
|
||||||
-- | Generates a Double from a string, trying to
|
-- | Generates a Double from a string, trying to
|
||||||
-- achieve a random distribution.
|
-- achieve a random distribution.
|
||||||
-- We create a random seed from the hash of all characters
|
-- We create a random seed from the sum of all characters
|
||||||
-- in the string, and use it to generate a ratio between 0 and 1
|
-- in the string, and use it to generate a ratio between 0 and 1
|
||||||
stringToRatio :: String -> Double
|
stringToRatio :: String -> Double
|
||||||
stringToRatio "" = 0
|
stringToRatio "" = 0
|
||||||
stringToRatio s = let gen = mkStdGen $ foldl' (\t c -> t * 31 + fromEnum c) 0 s
|
stringToRatio s = let gen = mkStdGen $ sum $ map fromEnum s
|
||||||
in fst $ randomR (0, 1) gen
|
range = (\(a, b) -> b - a) $ genRange gen
|
||||||
|
randomInt = foldr1 combine $ replicate 20 next
|
||||||
|
combine f1 f2 g = let (_, g') = f1 g in f2 g'
|
||||||
|
in fi (fst $ randomInt gen) / fi range
|
||||||
|
|
||||||
-- | Brings up a 2D grid of elements in the center of the screen, and one can
|
-- | Brings up a 2D grid of elements in the center of the screen, and one can
|
||||||
-- select an element with cursors keys. The selected element is returned.
|
-- select an element with cursors keys. The selected element is returned.
|
||||||
@@ -654,14 +657,14 @@ gridselect gsconfig elements =
|
|||||||
font <- initXMF (gs_font gsconfig)
|
font <- initXMF (gs_font gsconfig)
|
||||||
let screenWidth = toInteger $ rect_width scr
|
let screenWidth = toInteger $ rect_width scr
|
||||||
screenHeight = toInteger $ rect_height scr
|
screenHeight = toInteger $ rect_height scr
|
||||||
selectedElement <- if status == grabSuccess then do
|
selectedElement <- if (status == grabSuccess) then do
|
||||||
let restriction ss cs = (fromInteger ss/fromInteger (cs gsconfig)-1)/2 :: Double
|
let restriction ss cs = (fromInteger ss/fromInteger (cs gsconfig)-1)/2 :: Double
|
||||||
restrictX = floor $ restriction screenWidth gs_cellwidth
|
restrictX = floor $ restriction screenWidth gs_cellwidth
|
||||||
restrictY = floor $ restriction screenHeight gs_cellheight
|
restrictY = floor $ restriction screenHeight gs_cellheight
|
||||||
originPosX = floor $ (gs_originFractX gsconfig - (1/2)) * 2 * fromIntegral restrictX
|
originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX
|
||||||
originPosY = floor $ (gs_originFractY gsconfig - (1/2)) * 2 * fromIntegral restrictY
|
originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY
|
||||||
coords = diamondRestrict restrictX restrictY originPosX originPosY
|
coords = diamondRestrict restrictX restrictY originPosX originPosY
|
||||||
s = TwoDState { td_curpos = head coords,
|
s = TwoDState { td_curpos = (head coords),
|
||||||
td_availSlots = coords,
|
td_availSlots = coords,
|
||||||
td_elements = elements,
|
td_elements = elements,
|
||||||
td_gsconfig = gsconfig,
|
td_gsconfig = gsconfig,
|
||||||
@@ -672,7 +675,7 @@ gridselect gsconfig elements =
|
|||||||
td_searchString = "",
|
td_searchString = "",
|
||||||
td_elementmap = [] }
|
td_elementmap = [] }
|
||||||
m <- generateElementmap s
|
m <- generateElementmap s
|
||||||
evalTwoD (updateAllElements >> gs_navigate gsconfig)
|
evalTwoD (updateAllElements >> (gs_navigate gsconfig))
|
||||||
(s { td_elementmap = m })
|
(s { td_elementmap = m })
|
||||||
else
|
else
|
||||||
return Nothing
|
return Nothing
|
||||||
@@ -694,21 +697,27 @@ gridselectWindow gsconf = windowMap >>= gridselect gsconf
|
|||||||
withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X ()
|
withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X ()
|
||||||
withSelectedWindow callback conf = do
|
withSelectedWindow callback conf = do
|
||||||
mbWindow <- gridselectWindow conf
|
mbWindow <- gridselectWindow conf
|
||||||
for_ mbWindow callback
|
case mbWindow of
|
||||||
|
Just w -> callback w
|
||||||
|
Nothing -> return ()
|
||||||
|
|
||||||
windowMap :: X [(String,Window)]
|
windowMap :: X [(String,Window)]
|
||||||
windowMap = do
|
windowMap = do
|
||||||
ws <- gets windowset
|
ws <- gets windowset
|
||||||
mapM keyValuePair (W.allWindows ws)
|
wins <- mapM keyValuePair (W.allWindows ws)
|
||||||
where keyValuePair w = (, w) <$> decorateName' w
|
return wins
|
||||||
|
where keyValuePair w = flip (,) w `fmap` decorateName' w
|
||||||
|
|
||||||
decorateName' :: Window -> X String
|
decorateName' :: Window -> X String
|
||||||
decorateName' w = do
|
decorateName' w = do
|
||||||
show <$> getName w
|
fmap show $ getName w
|
||||||
|
|
||||||
-- | Builds a default gs config from a colorizer function.
|
-- | Builds a default gs config from a colorizer function.
|
||||||
buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
|
buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
|
||||||
buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "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.
|
-- | Brings selected window to the current workspace.
|
||||||
bringSelected :: GSConfig Window -> X ()
|
bringSelected :: GSConfig Window -> X ()
|
||||||
@@ -759,7 +768,7 @@ gridselectWorkspace' conf func = withWindowSet $ \ws -> do
|
|||||||
--
|
--
|
||||||
-- > import XMonad.Actions.DynamicWorkspaces (addWorkspace)
|
-- > import XMonad.Actions.DynamicWorkspaces (addWorkspace)
|
||||||
-- >
|
-- >
|
||||||
-- > gridselectWorkspace' def
|
-- > gridselectWorkspace' defaultGSConfig
|
||||||
-- > { gs_navigate = navNSearch
|
-- > { gs_navigate = navNSearch
|
||||||
-- > , gs_rearranger = searchStringRearrangerGenerator id
|
-- > , gs_rearranger = searchStringRearrangerGenerator id
|
||||||
-- > }
|
-- > }
|
||||||
@@ -778,7 +787,7 @@ noRearranger _ = return
|
|||||||
-- already present).
|
-- already present).
|
||||||
searchStringRearrangerGenerator :: (String -> a) -> Rearranger a
|
searchStringRearrangerGenerator :: (String -> a) -> Rearranger a
|
||||||
searchStringRearrangerGenerator f =
|
searchStringRearrangerGenerator f =
|
||||||
let r "" xs = return xs
|
let r "" xs = return $ xs
|
||||||
r s xs | s `elem` map fst xs = return xs
|
r s xs | s `elem` map fst xs = return $ xs
|
||||||
| otherwise = return $ xs ++ [(s, f s)]
|
| otherwise = return $ xs ++ [(s, f s)]
|
||||||
in r
|
in r
|
||||||
|
@@ -1,7 +1,8 @@
|
|||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.GroupNavigation
|
-- Module : XMonad.Actions.GroupNavigation
|
||||||
-- Description : Cycle through groups of windows across workspaces.
|
|
||||||
-- Copyright : (c) nzeh@cs.dal.ca
|
-- Copyright : (c) nzeh@cs.dal.ca
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -15,7 +16,7 @@
|
|||||||
-- query.
|
-- query.
|
||||||
--
|
--
|
||||||
-- Also provides a method for jumping back to the most recently used
|
-- Also provides a method for jumping back to the most recently used
|
||||||
-- window in any given group, and predefined groups.
|
-- window in any given group.
|
||||||
--
|
--
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
@@ -26,25 +27,18 @@ module XMonad.Actions.GroupNavigation ( -- * Usage
|
|||||||
, nextMatchOrDo
|
, nextMatchOrDo
|
||||||
, nextMatchWithThis
|
, nextMatchWithThis
|
||||||
, historyHook
|
, historyHook
|
||||||
|
|
||||||
-- * Utilities
|
|
||||||
-- $utilities
|
|
||||||
, isOnAnyVisibleWS
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.State
|
import Data.Foldable as Fold
|
||||||
import Data.Map ((!))
|
import Data.Map as Map
|
||||||
import qualified Data.Map as Map
|
import Data.Sequence as Seq
|
||||||
import Data.Sequence (Seq, ViewL (EmptyL, (:<)), viewl, (<|), (><), (|>))
|
import Data.Set as Set
|
||||||
import qualified Data.Sequence as Seq
|
|
||||||
import qualified Data.Set as Set
|
|
||||||
import Graphics.X11.Types
|
import Graphics.X11.Types
|
||||||
import Prelude hiding (concatMap, drop, elem, filter, null, reverse)
|
import Prelude hiding (concatMap, drop, elem, filter, null, reverse)
|
||||||
import XMonad.Core
|
import XMonad.Core
|
||||||
import XMonad.ManageHook
|
import XMonad.ManageHook
|
||||||
import XMonad.Operations (windows, withFocused)
|
import XMonad.Operations (windows, withFocused)
|
||||||
import XMonad.Prelude (elem, foldl')
|
|
||||||
import qualified XMonad.StackSet as SS
|
import qualified XMonad.StackSet as SS
|
||||||
import qualified XMonad.Util.ExtensibleState as XS
|
import qualified XMonad.Util.ExtensibleState as XS
|
||||||
|
|
||||||
@@ -128,12 +122,12 @@ focusNextMatchOrDo qry act = findM (runQuery qry)
|
|||||||
-- Returns the list of windows ordered by workspace as specified in
|
-- Returns the list of windows ordered by workspace as specified in
|
||||||
-- ~/.xmonad/xmonad.hs
|
-- ~/.xmonad/xmonad.hs
|
||||||
orderedWindowList :: Direction -> X (Seq Window)
|
orderedWindowList :: Direction -> X (Seq Window)
|
||||||
orderedWindowList History = fmap (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get
|
orderedWindowList History = liftM (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get
|
||||||
orderedWindowList dir = withWindowSet $ \ss -> do
|
orderedWindowList dir = withWindowSet $ \ss -> do
|
||||||
wsids <- asks (Seq.fromList . workspaces . config)
|
wsids <- asks (Seq.fromList . workspaces . config)
|
||||||
let wspcs = orderedWorkspaceList ss wsids
|
let wspcs = orderedWorkspaceList ss wsids
|
||||||
wins = dirfun dir
|
wins = dirfun dir
|
||||||
$ foldl' (><) Seq.empty
|
$ Fold.foldl' (><) Seq.empty
|
||||||
$ fmap (Seq.fromList . SS.integrate' . SS.stack) wspcs
|
$ fmap (Seq.fromList . SS.integrate' . SS.stack) wspcs
|
||||||
cur = SS.peek ss
|
cur = SS.peek ss
|
||||||
return $ maybe wins (rotfun wins) cur
|
return $ maybe wins (rotfun wins) cur
|
||||||
@@ -147,8 +141,8 @@ orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace
|
|||||||
orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'
|
orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'
|
||||||
where
|
where
|
||||||
wspcs = SS.workspaces ss
|
wspcs = SS.workspaces ss
|
||||||
wspcsMap = foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs
|
wspcsMap = Fold.foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs
|
||||||
wspcs' = fmap (wspcsMap !) wsids
|
wspcs' = fmap (\wsid -> wspcsMap ! wsid) wsids
|
||||||
isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss)
|
isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss)
|
||||||
|
|
||||||
--- History navigation, requires a layout modifier -------------------
|
--- History navigation, requires a layout modifier -------------------
|
||||||
@@ -156,7 +150,7 @@ orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'
|
|||||||
-- The state extension that holds the history information
|
-- The state extension that holds the history information
|
||||||
data HistoryDB = HistoryDB (Maybe Window) -- currently focused window
|
data HistoryDB = HistoryDB (Maybe Window) -- currently focused window
|
||||||
(Seq Window) -- previously focused windows
|
(Seq Window) -- previously focused windows
|
||||||
deriving (Read, Show)
|
deriving (Read, Show, Typeable)
|
||||||
|
|
||||||
instance ExtensionClass HistoryDB where
|
instance ExtensionClass HistoryDB where
|
||||||
|
|
||||||
@@ -173,11 +167,26 @@ updateHistory :: HistoryDB -> X HistoryDB
|
|||||||
updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do
|
updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do
|
||||||
let newcur = SS.peek ss
|
let newcur = SS.peek ss
|
||||||
wins = Set.fromList $ SS.allWindows ss
|
wins = Set.fromList $ SS.allWindows ss
|
||||||
newhist = Seq.filter (`Set.member` wins) (ins oldcur oldhist)
|
newhist = flt (flip Set.member wins) (ins oldcur oldhist)
|
||||||
return $ HistoryDB newcur (del newcur newhist)
|
return $ HistoryDB newcur (del newcur newhist)
|
||||||
where
|
where
|
||||||
ins x xs = maybe xs (<| xs) x
|
ins x xs = maybe xs (<| xs) x
|
||||||
del x xs = maybe xs (\x' -> Seq.filter (/= x') xs) x
|
del x xs = maybe xs (\x' -> flt (/= x') xs) x
|
||||||
|
|
||||||
|
--- Two replacements for Seq.filter and Seq.breakl available only in
|
||||||
|
--- containers-0.3.0.0, which only ships with ghc 6.12. Once we
|
||||||
|
--- decide to no longer support ghc < 6.12, these should be replaced
|
||||||
|
--- with Seq.filter and Seq.breakl.
|
||||||
|
|
||||||
|
flt :: (a -> Bool) -> Seq a -> Seq a
|
||||||
|
flt p = Fold.foldl (\xs x -> if p x then xs |> x else xs) Seq.empty
|
||||||
|
|
||||||
|
brkl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
|
||||||
|
brkl p xs = flip Seq.splitAt xs
|
||||||
|
$ snd
|
||||||
|
$ Fold.foldr (\x (i, j) -> if p x then (i-1, i-1) else (i-1, j)) (l, l) xs
|
||||||
|
where
|
||||||
|
l = Seq.length xs
|
||||||
|
|
||||||
--- Some sequence helpers --------------------------------------------
|
--- Some sequence helpers --------------------------------------------
|
||||||
|
|
||||||
@@ -191,7 +200,7 @@ rotate xs = rotate' (viewl xs)
|
|||||||
-- Rotates the sequence until an element matching the given condition
|
-- Rotates the sequence until an element matching the given condition
|
||||||
-- is at the beginning of the sequence.
|
-- is at the beginning of the sequence.
|
||||||
rotateTo :: (a -> Bool) -> Seq a -> Seq a
|
rotateTo :: (a -> Bool) -> Seq a -> Seq a
|
||||||
rotateTo cond xs = let (lxs, rxs) = Seq.breakl cond xs in rxs >< lxs
|
rotateTo cond xs = let (lxs, rxs) = brkl cond xs in rxs >< lxs
|
||||||
|
|
||||||
--- A monadic find ---------------------------------------------------
|
--- A monadic find ---------------------------------------------------
|
||||||
|
|
||||||
@@ -207,21 +216,3 @@ findM cond xs = findM' cond (viewl xs)
|
|||||||
if isMatch
|
if isMatch
|
||||||
then return (Just x')
|
then return (Just x')
|
||||||
else findM qry xs'
|
else findM qry xs'
|
||||||
|
|
||||||
|
|
||||||
-- $utilities
|
|
||||||
-- #utilities#
|
|
||||||
-- Below are handy queries for use with 'nextMatch', 'nextMatchOrDo',
|
|
||||||
-- and 'nextMatchWithThis'.
|
|
||||||
|
|
||||||
-- | A query that matches all windows on visible workspaces. This is
|
|
||||||
-- useful for configurations with multiple screens, and matches even
|
|
||||||
-- invisible windows.
|
|
||||||
isOnAnyVisibleWS :: Query Bool
|
|
||||||
isOnAnyVisibleWS = do
|
|
||||||
w <- ask
|
|
||||||
ws <- liftX $ gets windowset
|
|
||||||
let allVisible = concat $ maybe [] SS.integrate . SS.stack . SS.workspace <$> SS.current ws:SS.visible ws
|
|
||||||
visibleWs = w `elem` allVisible
|
|
||||||
unfocused = Just w /= SS.peek ws
|
|
||||||
return $ visibleWs && unfocused
|
|
||||||
|
@@ -1,7 +1,7 @@
|
|||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.KeyRemap
|
-- Module : XMonad.Actions.KeyRemap
|
||||||
-- Description : Remap Keybinding on the fly.
|
|
||||||
-- Copyright : (c) Christian Dietrich
|
-- Copyright : (c) Christian Dietrich
|
||||||
-- License : BSD-style (as xmonad)
|
-- License : BSD-style (as xmonad)
|
||||||
--
|
--
|
||||||
@@ -27,13 +27,14 @@ module XMonad.Actions.KeyRemap (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude
|
|
||||||
import XMonad.Util.Paste
|
import XMonad.Util.Paste
|
||||||
|
import Data.List
|
||||||
|
|
||||||
import qualified XMonad.Util.ExtensibleState as XS
|
import qualified XMonad.Util.ExtensibleState as XS
|
||||||
|
import Control.Monad
|
||||||
|
|
||||||
|
|
||||||
newtype KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Show)
|
data KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show)
|
||||||
|
|
||||||
instance ExtensionClass KeymapTable where
|
instance ExtensionClass KeymapTable where
|
||||||
initialValue = KeymapTable []
|
initialValue = KeymapTable []
|
||||||
@@ -124,8 +125,8 @@ extractKeyMapping (KeymapTable table) mask sym =
|
|||||||
buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())]
|
buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())]
|
||||||
buildKeyRemapBindings keyremaps =
|
buildKeyRemapBindings keyremaps =
|
||||||
[((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings]
|
[((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings]
|
||||||
where mappings = concatMap (\(KeymapTable table) -> table) keyremaps
|
where mappings = concat (map (\(KeymapTable table) -> table) keyremaps)
|
||||||
bindings = nub (map fst mappings)
|
bindings = nub (map (\binding -> fst binding) mappings)
|
||||||
|
|
||||||
|
|
||||||
-- Here come the Keymappings
|
-- Here come the Keymappings
|
||||||
@@ -137,7 +138,7 @@ emptyKeyRemap = KeymapTable []
|
|||||||
dvorakProgrammerKeyRemap :: KeymapTable
|
dvorakProgrammerKeyRemap :: KeymapTable
|
||||||
dvorakProgrammerKeyRemap =
|
dvorakProgrammerKeyRemap =
|
||||||
KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) |
|
KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) |
|
||||||
(maskFrom, from, maskTo, to) <- zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey]
|
(maskFrom, from, maskTo, to) <- (zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey)]
|
||||||
where
|
where
|
||||||
|
|
||||||
layoutUs = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?" :: [KeySym]
|
layoutUs = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?" :: [KeySym]
|
||||||
|
@@ -1,6 +1,5 @@
|
|||||||
{- |
|
{- |
|
||||||
Module : XMonad.Actions.Launcher
|
Module : XMonad.Actions.Launcher
|
||||||
Description : A set of prompts for XMonad.
|
|
||||||
Copyright : (C) 2012 Carlos López-Camey
|
Copyright : (C) 2012 Carlos López-Camey
|
||||||
License : None; public domain
|
License : None; public domain
|
||||||
|
|
||||||
@@ -19,9 +18,10 @@ module XMonad.Actions.Launcher(
|
|||||||
, launcherPrompt
|
, launcherPrompt
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Data.List (find, findIndex, isPrefixOf, tails)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
import Data.Maybe (isJust)
|
||||||
import XMonad hiding (config)
|
import XMonad hiding (config)
|
||||||
import XMonad.Prelude
|
|
||||||
import XMonad.Prompt
|
import XMonad.Prompt
|
||||||
import XMonad.Util.Run
|
import XMonad.Util.Run
|
||||||
|
|
||||||
@@ -62,8 +62,8 @@ type ExtensionActions = M.Map String (String -> X())
|
|||||||
instance XPrompt CalculatorMode where
|
instance XPrompt CalculatorMode where
|
||||||
showXPrompt CalcMode = "calc %s> "
|
showXPrompt CalcMode = "calc %s> "
|
||||||
commandToComplete CalcMode = id --send the whole string to `calc`
|
commandToComplete CalcMode = id --send the whole string to `calc`
|
||||||
completionFunction CalcMode = \s -> if null s then return [] else
|
completionFunction CalcMode = \s -> if (length s == 0) then return [] else do
|
||||||
lines <$> runProcessWithInput "calc" [s] ""
|
fmap lines $ runProcessWithInput "calc" [s] ""
|
||||||
modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard
|
modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard
|
||||||
|
|
||||||
-- | Uses the program `hoogle` to search for functions
|
-- | Uses the program `hoogle` to search for functions
|
||||||
@@ -88,7 +88,7 @@ instance XPrompt HoogleMode where
|
|||||||
|
|
||||||
-- | Creates an autocompletion function for a programm given the program's name and a list of args to send to the command.
|
-- | Creates an autocompletion function for a programm given the program's name and a list of args to send to the command.
|
||||||
completionFunctionWith :: String -> [String] -> IO [String]
|
completionFunctionWith :: String -> [String] -> IO [String]
|
||||||
completionFunctionWith cmd args = lines <$> runProcessWithInput cmd args ""
|
completionFunctionWith cmd args = do fmap lines $ runProcessWithInput cmd args ""
|
||||||
|
|
||||||
-- | Creates a prompt with the given modes
|
-- | Creates a prompt with the given modes
|
||||||
launcherPrompt :: XPConfig -> [XPMode] -> X()
|
launcherPrompt :: XPConfig -> [XPMode] -> X()
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.LinkWorkspaces
|
-- Module : XMonad.Actions.LinkWorkspaces
|
||||||
-- Description : Bindings to add and delete links between workspaces.
|
|
||||||
-- Copyright : (c) Jan-David Quesel <quesel@gmail.org>
|
-- Copyright : (c) Jan-David Quesel <quesel@gmail.org>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -15,6 +14,7 @@
|
|||||||
--
|
--
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
module XMonad.Actions.LinkWorkspaces (
|
module XMonad.Actions.LinkWorkspaces (
|
||||||
-- * Usage
|
-- * Usage
|
||||||
-- $usage
|
-- $usage
|
||||||
@@ -27,7 +27,6 @@ module XMonad.Actions.LinkWorkspaces (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude (for_)
|
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
import XMonad.Layout.IndependentScreens(countScreens)
|
import XMonad.Layout.IndependentScreens(countScreens)
|
||||||
import qualified XMonad.Util.ExtensibleState as XS (get, put)
|
import qualified XMonad.Util.ExtensibleState as XS (get, put)
|
||||||
@@ -60,7 +59,7 @@ import qualified Data.Map as M
|
|||||||
-- For detailed instructions on editing your key bindings, see
|
-- For detailed instructions on editing your key bindings, see
|
||||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||||
|
|
||||||
data MessageConfig = MessageConfig { messageFunction :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
|
data MessageConfig = MessageConfig { messageFunction :: (ScreenId -> [Char] -> [Char] -> [Char] -> X())
|
||||||
, foreground :: [Char]
|
, foreground :: [Char]
|
||||||
, alertedForeground :: [Char]
|
, alertedForeground :: [Char]
|
||||||
, background :: [Char]
|
, background :: [Char]
|
||||||
@@ -76,7 +75,7 @@ noMessageFn :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
|
|||||||
noMessageFn _ _ _ _ = return () :: X ()
|
noMessageFn _ _ _ _ = return () :: X ()
|
||||||
|
|
||||||
-- | Stuff for linking workspaces
|
-- | Stuff for linking workspaces
|
||||||
newtype WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show)
|
data WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable)
|
||||||
instance ExtensionClass WorkspaceMap
|
instance ExtensionClass WorkspaceMap
|
||||||
where initialValue = WorkspaceMap M.empty
|
where initialValue = WorkspaceMap M.empty
|
||||||
extensionType = PersistentExtension
|
extensionType = PersistentExtension
|
||||||
@@ -86,12 +85,12 @@ switchWS f m ws = switchWS' f m ws Nothing
|
|||||||
|
|
||||||
-- | Switch to the given workspace in a non greedy way, stop if we reached the first screen
|
-- | Switch to the given workspace in a non greedy way, stop if we reached the first screen
|
||||||
-- | we already did switching on
|
-- | we already did switching on
|
||||||
switchWS' :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> Maybe ScreenId -> X ()
|
switchWS' :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> (Maybe ScreenId) -> X ()
|
||||||
switchWS' switchFn message workspace stopAtScreen = do
|
switchWS' switchFn message workspace stopAtScreen = do
|
||||||
ws <- gets windowset
|
ws <- gets windowset
|
||||||
nScreens <- countScreens
|
nScreens <- countScreens
|
||||||
let now = W.screen (W.current ws)
|
let now = W.screen (W.current ws)
|
||||||
let next = (now + 1) `mod` nScreens
|
let next = ((now + 1) `mod` nScreens)
|
||||||
switchFn workspace
|
switchFn workspace
|
||||||
case stopAtScreen of
|
case stopAtScreen of
|
||||||
Nothing -> sTM now next (Just now)
|
Nothing -> sTM now next (Just now)
|
||||||
@@ -100,11 +99,11 @@ switchWS' switchFn message workspace stopAtScreen = do
|
|||||||
|
|
||||||
-- | Switch to the workspace that matches the current one, executing switches for that workspace as well.
|
-- | Switch to the workspace that matches the current one, executing switches for that workspace as well.
|
||||||
-- | The function switchWorkspaceNonGreedy' will take of stopping if we reached the first workspace again.
|
-- | The function switchWorkspaceNonGreedy' will take of stopping if we reached the first workspace again.
|
||||||
switchToMatching :: (WorkspaceId -> Maybe ScreenId -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId
|
switchToMatching :: (WorkspaceId -> (Maybe ScreenId) -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId
|
||||||
-> ScreenId -> Maybe ScreenId -> X ()
|
-> ScreenId -> (Maybe ScreenId) -> X ()
|
||||||
switchToMatching f message t now next stopAtScreen = do
|
switchToMatching f message t now next stopAtScreen = do
|
||||||
WorkspaceMap matchings <- XS.get :: X WorkspaceMap
|
WorkspaceMap matchings <- XS.get :: X WorkspaceMap
|
||||||
case M.lookup t matchings of
|
case (M.lookup t matchings) of
|
||||||
Nothing -> return () :: X()
|
Nothing -> return () :: X()
|
||||||
Just newWorkspace -> do
|
Just newWorkspace -> do
|
||||||
onScreen' (f newWorkspace stopAtScreen) FocusCurrent next
|
onScreen' (f newWorkspace stopAtScreen) FocusCurrent next
|
||||||
@@ -114,7 +113,7 @@ switchToMatching f message t now next stopAtScreen = do
|
|||||||
toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X ()
|
toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X ()
|
||||||
toggleMatching message t1 t2 = do
|
toggleMatching message t1 t2 = do
|
||||||
WorkspaceMap matchings <- XS.get :: X WorkspaceMap
|
WorkspaceMap matchings <- XS.get :: X WorkspaceMap
|
||||||
case M.lookup t1 matchings of
|
case (M.lookup t1 matchings) of
|
||||||
Nothing -> setMatching message t1 t2 matchings
|
Nothing -> setMatching message t1 t2 matchings
|
||||||
Just t -> if t == t2 then removeMatching' message t1 t2 matchings else setMatching message t1 t2 matchings
|
Just t -> if t == t2 then removeMatching' message t1 t2 matchings else setMatching message t1 t2 matchings
|
||||||
return ()
|
return ()
|
||||||
@@ -143,7 +142,7 @@ removeAllMatchings :: MessageConfig -> X ()
|
|||||||
removeAllMatchings message = do
|
removeAllMatchings message = do
|
||||||
ws <- gets windowset
|
ws <- gets windowset
|
||||||
let now = W.screen (W.current ws)
|
let now = W.screen (W.current ws)
|
||||||
XS.put $ WorkspaceMap M.empty
|
XS.put $ WorkspaceMap $ M.empty
|
||||||
messageFunction message now (alertedForeground message) (background message) "All links removed!"
|
messageFunction message now (alertedForeground message) (background message) "All links removed!"
|
||||||
|
|
||||||
-- | remove all matching regarding a given workspace
|
-- | remove all matching regarding a given workspace
|
||||||
@@ -164,6 +163,7 @@ toggleLinkWorkspaces' first message = do
|
|||||||
let now = W.screen (W.current ws)
|
let now = W.screen (W.current ws)
|
||||||
let next = (now + 1) `mod` nScreens
|
let next = (now + 1) `mod` nScreens
|
||||||
if next == first then return () else do -- this is also the case if there is only one screen
|
if next == first then return () else do -- this is also the case if there is only one screen
|
||||||
for_ (W.lookupWorkspace next ws)
|
case (W.lookupWorkspace next ws) of
|
||||||
(toggleMatching message (W.currentTag ws))
|
Nothing -> return ()
|
||||||
|
Just name -> toggleMatching message (W.currentTag ws) (name)
|
||||||
onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next
|
onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next
|
||||||
|
@@ -1,9 +1,7 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.MessageFeedback
|
-- Module : XMonad.Actions.MessageFeedback
|
||||||
-- Description : An alternative @sendMessage@.
|
-- Copyright : (c) Quentin Moser <moserq@gmail.com>
|
||||||
-- Copyright : (c) -- Quentin Moser <moserq@gmail.com>
|
|
||||||
-- 2018 Yclept Nemo
|
|
||||||
-- License : BSD3
|
-- License : BSD3
|
||||||
--
|
--
|
||||||
-- Maintainer : orphaned
|
-- Maintainer : orphaned
|
||||||
@@ -15,261 +13,87 @@
|
|||||||
-- this facility.
|
-- this facility.
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
module XMonad.Actions.MessageFeedback
|
module XMonad.Actions.MessageFeedback (
|
||||||
( -- * Usage
|
-- * Usage
|
||||||
-- $usage
|
-- $usage
|
||||||
|
|
||||||
-- * Messaging variants
|
send
|
||||||
|
, tryMessage
|
||||||
-- ** 'SomeMessage'
|
, tryMessage_
|
||||||
sendSomeMessageB, sendSomeMessage
|
, tryInOrder
|
||||||
, sendSomeMessageWithNoRefreshB, sendSomeMessageWithNoRefresh
|
, tryInOrder_
|
||||||
, sendSomeMessageWithNoRefreshToCurrentB, sendSomeMessageWithNoRefreshToCurrent
|
|
||||||
|
|
||||||
-- ** 'Message'
|
|
||||||
, sendMessageB
|
|
||||||
, sendMessageWithNoRefreshB
|
|
||||||
, sendMessageWithNoRefreshToCurrentB, sendMessageWithNoRefreshToCurrent
|
|
||||||
|
|
||||||
-- * Utility Functions
|
|
||||||
|
|
||||||
-- ** Send All
|
|
||||||
, sendSomeMessagesB, sendSomeMessages, sendMessagesB, sendMessages
|
|
||||||
|
|
||||||
-- ** Send Until
|
|
||||||
, tryInOrderB, tryInOrderWithNoRefreshToCurrentB, tryInOrderWithNoRefreshToCurrent
|
|
||||||
, tryMessageB, tryMessageWithNoRefreshToCurrentB, tryMessageWithNoRefreshToCurrent
|
|
||||||
|
|
||||||
-- ** Aliases
|
|
||||||
, sm
|
, sm
|
||||||
|
, sendSM
|
||||||
-- * Backwards Compatibility
|
, sendSM_
|
||||||
-- $backwardsCompatibility
|
|
||||||
, send, sendSM, sendSM_
|
|
||||||
, tryInOrder, tryInOrder_
|
|
||||||
, tryMessage, tryMessage_
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad ( Window )
|
import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX )
|
||||||
import XMonad.Core ( X(), Message, SomeMessage(..), LayoutClass(..), windowset, catchX, WorkspaceId, Layout, whenJust )
|
import XMonad.StackSet ( current, workspace, layout, tag )
|
||||||
import XMonad.Operations ( updateLayout, windowBracket, modifyWindowSet )
|
import XMonad.Operations ( updateLayout )
|
||||||
import XMonad.Prelude ( isJust, liftA2, void )
|
|
||||||
import XMonad.StackSet ( Workspace, current, workspace, layout, tag )
|
|
||||||
|
|
||||||
import Control.Monad.State ( gets )
|
import Control.Monad.State ( gets )
|
||||||
|
import Data.Maybe ( isJust )
|
||||||
|
import Control.Applicative ((<$>))
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||||
--
|
--
|
||||||
-- > import XMonad.Actions.MessageFeedback
|
-- > import XMonad.Actions.MessageFeedback
|
||||||
--
|
--
|
||||||
-- You can then use this module's functions wherever an action is expected. All
|
-- You can then use this module's functions wherever an action is expected.
|
||||||
-- 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.
|
|
||||||
--
|
--
|
||||||
-- Note that most functions in this module have a return type of @X Bool@
|
-- 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
|
-- whereas configuration options will expect a @X ()@ action.
|
||||||
-- key binding:
|
-- For example, the key binding
|
||||||
--
|
--
|
||||||
-- > -- Shrink the master area of a tiled layout, or move the focused window
|
-- > -- Shrink the master area of a tiled layout, or move the focused window
|
||||||
-- > -- to the left in a WindowArranger-based layout
|
-- > -- 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
|
-- is mis-typed. For this reason, this module provides alternatives (ending with
|
||||||
-- with an uppercase \"B\", e.g. 'XMonad.Operations.sendMessage' rather than
|
-- an underscore, e.g. tryMessage_) that discard their result and return an @X ()@.
|
||||||
-- 'sendMessageB') that discard their boolean result and return an @X ()@. For
|
-- For example, to correct the previous example:
|
||||||
-- 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
|
-- | Behaves like 'XMonad.Operations.sendMessage', but returns True of the
|
||||||
-- 'Message' see 'sendMessageB'. Returns @True@ if the message was handled,
|
-- message was handled by the layout, False otherwise.
|
||||||
-- @False@ otherwise. Instead of using 'sendSomeMessageWithNoRefreshToCurrentB'
|
send :: Message a => a -> X Bool
|
||||||
-- for efficiency this is pretty much an exact copy of the
|
send = sendSM . sm
|
||||||
-- 'XMonad.Operations.sendMessage' code - foregoes the O(n) 'updateLayout'.
|
|
||||||
sendSomeMessageB :: SomeMessage -> X Bool
|
|
||||||
sendSomeMessageB m = windowBracket id $ do
|
|
||||||
w <- gets ((workspace . current) . 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
|
|
||||||
|
|
||||||
-- | Variant of 'sendSomeMessageB' that discards the result.
|
-- | Sends the first message, and if it was not handled, sends the second.
|
||||||
sendSomeMessage :: SomeMessage -> X ()
|
-- Returns True if either message was handled, False otherwise.
|
||||||
sendSomeMessage = void . sendSomeMessageB
|
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
|
tryMessage_ :: (Message a, Message b) => a -> b -> X ()
|
||||||
-- 'SomeMessage'; to use 'Message' see 'sendMessageWithNoRefreshB'. Returns
|
tryMessage_ m1 m2 = tryMessage m1 m2 >> return ()
|
||||||
-- @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)
|
|
||||||
|
|
||||||
-- | Variant of 'sendSomeMessageWithNoRefreshB' that discards the result.
|
-- | Tries sending every message of the list in order until one of them
|
||||||
sendSomeMessageWithNoRefresh :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X ()
|
-- is handled. Returns True if one of the messages was handled, False otherwise.
|
||||||
sendSomeMessageWithNoRefresh m = void . sendSomeMessageWithNoRefreshB m
|
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
|
tryInOrder_ :: [SomeMessage] -> X ()
|
||||||
-- message to the current layout. Accepts 'SomeMessage'; to use 'Message' see
|
tryInOrder_ ms = tryInOrder ms >> return ()
|
||||||
-- '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
|
|
||||||
|
|
||||||
|
|
||||||
-- | Variant of 'sendSomeMessageB' which like 'XMonad.Operations.sendMessage'
|
-- | Convenience shorthand for 'XMonad.Core.SomeMessage'.
|
||||||
-- 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'.
|
|
||||||
sm :: Message a => a -> SomeMessage
|
sm :: Message a => a -> SomeMessage
|
||||||
sm = 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 :: 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_ :: SomeMessage -> X ()
|
||||||
sendSM_ = sendSomeMessageWithNoRefreshToCurrent
|
sendSM_ m = sendSM m >> return ()
|
||||||
|
|
||||||
-- | 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
|
|
@@ -1,143 +0,0 @@
|
|||||||
----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : XMonad.Actions.Minimize
|
|
||||||
-- Description : Actions for minimizing and maximizing windows.
|
|
||||||
-- 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 XMonad.Prelude (fromMaybe, join, listToMaybe)
|
|
||||||
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 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' (`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' (`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
|
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.MouseGestures
|
-- Module : XMonad.Actions.MouseGestures
|
||||||
-- Description : Support for simple mouse gestures.
|
|
||||||
-- Copyright : (c) Lukas Mai
|
-- Copyright : (c) Lukas Mai
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -22,13 +21,14 @@ module XMonad.Actions.MouseGestures (
|
|||||||
mkCollect
|
mkCollect
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad.Prelude
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Util.Types (Direction2D(..))
|
import XMonad.Util.Types (Direction2D(..))
|
||||||
|
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
|
import Data.Maybe
|
||||||
|
import Control.Monad
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
--
|
--
|
||||||
@@ -111,7 +111,7 @@ mouseGestureH moveHook endHook = do
|
|||||||
mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X ()
|
mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X ()
|
||||||
mouseGesture tbl win = do
|
mouseGesture tbl win = do
|
||||||
(mov, end) <- mkCollect
|
(mov, end) <- mkCollect
|
||||||
mouseGestureH (void . mov) $ end >>= \gest ->
|
mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest ->
|
||||||
case M.lookup gest tbl of
|
case M.lookup gest tbl of
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
Just f -> f win
|
Just f -> f win
|
||||||
|
@@ -1,9 +1,8 @@
|
|||||||
{-# LANGUAGE MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.MouseResize
|
-- Module : XMonad.Actions.MouseResize
|
||||||
-- Description : A layout modifier to resize windows with the mouse.
|
|
||||||
-- Copyright : (c) 2007 Andrea Rossato
|
-- Copyright : (c) 2007 Andrea Rossato
|
||||||
-- License : BSD-style (see xmonad/LICENSE)
|
-- License : BSD-style (see xmonad/LICENSE)
|
||||||
--
|
--
|
||||||
@@ -57,7 +56,7 @@ import XMonad.Util.XUtils
|
|||||||
mouseResize :: l a -> ModifiedLayout MouseResize l a
|
mouseResize :: l a -> ModifiedLayout MouseResize l a
|
||||||
mouseResize = ModifiedLayout (MR [])
|
mouseResize = ModifiedLayout (MR [])
|
||||||
|
|
||||||
newtype MouseResize a = MR [((a,Rectangle),Maybe a)]
|
data MouseResize a = MR [((a,Rectangle),Maybe a)]
|
||||||
instance Show (MouseResize a) where show _ = ""
|
instance Show (MouseResize a) where show _ = ""
|
||||||
instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)]
|
instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)]
|
||||||
|
|
||||||
@@ -69,7 +68,7 @@ instance LayoutModifier MouseResize Window where
|
|||||||
where
|
where
|
||||||
wrs' = wrs_to_state [] . filter (isInStack s . fst) $ wrs
|
wrs' = wrs_to_state [] . filter (isInStack s . fst) $ wrs
|
||||||
initState = mapM createInputWindow wrs'
|
initState = mapM createInputWindow wrs'
|
||||||
processState = mapM_ (deleteInputWin . snd) st >> mapM createInputWindow wrs'
|
processState = mapM (deleteInputWin . snd) st >> mapM createInputWindow wrs'
|
||||||
|
|
||||||
inputRectangle (Rectangle x y wh ht) = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10
|
inputRectangle (Rectangle x y wh ht) = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10
|
||||||
|
|
||||||
@@ -106,7 +105,7 @@ handleResize st ButtonEvent { ev_window = ew, ev_event_type = et }
|
|||||||
handleResize _ _ = return ()
|
handleResize _ _ = return ()
|
||||||
|
|
||||||
createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window)
|
createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window)
|
||||||
createInputWindow ((w,r),mr) =
|
createInputWindow ((w,r),mr) = do
|
||||||
case mr of
|
case mr of
|
||||||
Just tr -> withDisplay $ \d -> do
|
Just tr -> withDisplay $ \d -> do
|
||||||
tw <- mkInputWindow d tr
|
tw <- mkInputWindow d tr
|
||||||
|
@@ -1,9 +1,8 @@
|
|||||||
{-# LANGUAGE MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}
|
{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Layout.Navigation2D
|
-- Module : XMonad.Layout.Navigation2D
|
||||||
-- Description : Directional navigation of windows and screens.
|
|
||||||
-- Copyright : (c) 2011 Norbert Zeh <nzeh@cs.dal.ca>
|
-- Copyright : (c) 2011 Norbert Zeh <nzeh@cs.dal.ca>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -40,12 +39,10 @@ module XMonad.Actions.Navigation2D ( -- * Usage
|
|||||||
, withNavigation2DConfig
|
, withNavigation2DConfig
|
||||||
, Navigation2DConfig(..)
|
, Navigation2DConfig(..)
|
||||||
, def
|
, def
|
||||||
|
, defaultNavigation2DConfig
|
||||||
, Navigation2D
|
, Navigation2D
|
||||||
, lineNavigation
|
, lineNavigation
|
||||||
, centerNavigation
|
, centerNavigation
|
||||||
, sideNavigation
|
|
||||||
, sideNavigationWithBias
|
|
||||||
, hybridOf
|
|
||||||
, hybridNavigation
|
, hybridNavigation
|
||||||
, fullScreenRect
|
, fullScreenRect
|
||||||
, singleWindowRect
|
, singleWindowRect
|
||||||
@@ -58,10 +55,10 @@ module XMonad.Actions.Navigation2D ( -- * Usage
|
|||||||
, Direction2D(..)
|
, Direction2D(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Applicative
|
||||||
import qualified Data.List as L
|
import qualified Data.List as L
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Arrow (second)
|
import Data.Maybe
|
||||||
import XMonad.Prelude
|
|
||||||
import XMonad hiding (Screen)
|
import XMonad hiding (Screen)
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
import qualified XMonad.Util.ExtensibleState as XS
|
import qualified XMonad.Util.ExtensibleState as XS
|
||||||
@@ -73,17 +70,16 @@ import XMonad.Util.Types
|
|||||||
-- Navigation2D provides directional navigation (go left, right, up, down) for
|
-- Navigation2D provides directional navigation (go left, right, up, down) for
|
||||||
-- windows and screens. It treats floating and tiled windows as two separate
|
-- windows and screens. It treats floating and tiled windows as two separate
|
||||||
-- layers and provides mechanisms to navigate within each layer and to switch
|
-- layers and provides mechanisms to navigate within each layer and to switch
|
||||||
-- between layers. Navigation2D provides three different navigation strategies
|
-- between layers. Navigation2D provides two different navigation strategies
|
||||||
-- (see <#Technical_Discussion> for details): /Line navigation/ and
|
-- (see <#Technical_Discussion> for details): /Line navigation/ feels rather
|
||||||
-- /Side navigation/ feel rather natural but may make it impossible to navigate
|
-- natural but may make it impossible to navigate to a given window from the
|
||||||
-- to a given window from the current window, particularly in the floating
|
-- current window, particularly in the floating layer. /Center navigation/
|
||||||
-- layer. /Center navigation/ feels less natural in certain situations but
|
-- feels less natural in certain situations but ensures that all windows can be
|
||||||
-- ensures that all windows can be reached without the need to involve the
|
-- reached without the need to involve the mouse. A third option is to use
|
||||||
-- mouse. Another option is to use a /Hybrid/ of the three strategies,
|
-- /Hybrid navigation/, which automatically chooses between the two whenever
|
||||||
-- automatically choosing whichever first provides a suitable target window.
|
-- navigation is attempted. Navigation2D allows different navigation strategies
|
||||||
-- Navigation2D allows different navigation strategies to be used in the two
|
-- to be used in the two layers and allows customization of the navigation strategy
|
||||||
-- layers and allows customization of the navigation strategy for the tiled
|
-- for the tiled layer based on the layout currently in effect.
|
||||||
-- layer based on the layout currently in effect.
|
|
||||||
--
|
--
|
||||||
-- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:
|
-- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:
|
||||||
--
|
--
|
||||||
@@ -100,7 +96,7 @@ import XMonad.Util.Types
|
|||||||
--
|
--
|
||||||
-- Alternatively, you can use navigation2DP:
|
-- Alternatively, you can use navigation2DP:
|
||||||
--
|
--
|
||||||
-- > main = xmonad $ navigation2DP def
|
-- > main = xmonad $ navigation2D def
|
||||||
-- > ("<Up>", "<Left>", "<Down>", "<Right>")
|
-- > ("<Up>", "<Left>", "<Down>", "<Right>")
|
||||||
-- > [("M-", windowGo ),
|
-- > [("M-", windowGo ),
|
||||||
-- > ("M-S-", windowSwap)]
|
-- > ("M-S-", windowSwap)]
|
||||||
@@ -322,46 +318,12 @@ lineNavigation = N 1 doLineNavigation
|
|||||||
centerNavigation :: Navigation2D
|
centerNavigation :: Navigation2D
|
||||||
centerNavigation = N 2 doCenterNavigation
|
centerNavigation = N 2 doCenterNavigation
|
||||||
|
|
||||||
-- | Side navigation. Consider navigating to the right this time. The strategy
|
-- | Hybrid navigation. This attempts Line navigation, then falls back on Center
|
||||||
-- is to take the line segment forming the right boundary of the current window,
|
-- navigation if it does not find any suitable target windows. This is useful since
|
||||||
-- and push it to the right until it intersects with at least one other window.
|
-- Line navigation tends to fail on gaps, but provides more intuitive motions
|
||||||
-- Of those windows, one with a point that is the closest to the centre of the
|
-- when it succeeds—provided there are no floating windows.
|
||||||
-- 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." #-}
|
|
||||||
hybridNavigation :: Navigation2D
|
hybridNavigation :: Navigation2D
|
||||||
hybridNavigation = hybridOf lineNavigation centerNavigation
|
hybridNavigation = N 2 doHybridNavigation
|
||||||
|
|
||||||
-- | Stores the configuration of directional navigation. The 'Default' instance
|
-- | Stores the configuration of directional navigation. The 'Default' instance
|
||||||
-- uses line navigation for the tiled layer and for navigation between screens,
|
-- uses line navigation for the tiled layer and for navigation between screens,
|
||||||
@@ -385,7 +347,7 @@ data Navigation2DConfig = Navigation2DConfig
|
|||||||
-- function calculates a rectangle for a given unmapped
|
-- function calculates a rectangle for a given unmapped
|
||||||
-- window from the screen it is on and its window ID.
|
-- window from the screen it is on and its window ID.
|
||||||
-- See <#Finer_Points> for how to use this.
|
-- See <#Finer_Points> for how to use this.
|
||||||
}
|
} deriving Typeable
|
||||||
|
|
||||||
-- | Shorthand for the tedious screen type
|
-- | Shorthand for the tedious screen type
|
||||||
type Screen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
|
type Screen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
|
||||||
@@ -450,6 +412,10 @@ withNavigation2DConfig conf2d xconf = xconf { startupHook = startupHook xconf
|
|||||||
>> XS.put conf2d
|
>> XS.put conf2d
|
||||||
}
|
}
|
||||||
|
|
||||||
|
{-# DEPRECATED defaultNavigation2DConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.Navigation2D) instead." #-}
|
||||||
|
defaultNavigation2DConfig :: Navigation2DConfig
|
||||||
|
defaultNavigation2DConfig = def
|
||||||
|
|
||||||
instance Default Navigation2DConfig where
|
instance Default Navigation2DConfig where
|
||||||
def = Navigation2DConfig { defaultTiledNavigation = lineNavigation
|
def = Navigation2DConfig { defaultTiledNavigation = lineNavigation
|
||||||
, floatNavigation = centerNavigation
|
, floatNavigation = centerNavigation
|
||||||
@@ -477,7 +443,7 @@ switchLayer = actOnLayer otherLayer
|
|||||||
-- navigation should wrap around (e.g., from the left edge of the leftmost
|
-- navigation should wrap around (e.g., from the left edge of the leftmost
|
||||||
-- screen to the right edge of the rightmost screen).
|
-- screen to the right edge of the rightmost screen).
|
||||||
windowGo :: Direction2D -> Bool -> X ()
|
windowGo :: Direction2D -> Bool -> X ()
|
||||||
windowGo dir = actOnLayer thisLayer
|
windowGo dir wrap = actOnLayer thisLayer
|
||||||
( \ conf cur wins -> windows
|
( \ conf cur wins -> windows
|
||||||
$ doTiledNavigation conf dir W.focusWindow cur wins
|
$ doTiledNavigation conf dir W.focusWindow cur wins
|
||||||
)
|
)
|
||||||
@@ -487,6 +453,7 @@ windowGo dir = actOnLayer thisLayer
|
|||||||
( \ conf cur wspcs -> windows
|
( \ conf cur wspcs -> windows
|
||||||
$ doScreenNavigation conf dir W.view cur wspcs
|
$ doScreenNavigation conf dir W.view cur wspcs
|
||||||
)
|
)
|
||||||
|
wrap
|
||||||
|
|
||||||
-- | Swaps the current window with the next window in the given direction and in
|
-- | Swaps the current window with the next window in the given direction and in
|
||||||
-- the same layer as the current window. (In the floating layer, all that
|
-- the same layer as the current window. (In the floating layer, all that
|
||||||
@@ -495,7 +462,7 @@ windowGo dir = actOnLayer thisLayer
|
|||||||
-- window's screen but retains its position and size relative to the screen.)
|
-- window's screen but retains its position and size relative to the screen.)
|
||||||
-- The second argument indicates wrapping (see 'windowGo').
|
-- The second argument indicates wrapping (see 'windowGo').
|
||||||
windowSwap :: Direction2D -> Bool -> X ()
|
windowSwap :: Direction2D -> Bool -> X ()
|
||||||
windowSwap dir = actOnLayer thisLayer
|
windowSwap dir wrap = actOnLayer thisLayer
|
||||||
( \ conf cur wins -> windows
|
( \ conf cur wins -> windows
|
||||||
$ doTiledNavigation conf dir swap cur wins
|
$ doTiledNavigation conf dir swap cur wins
|
||||||
)
|
)
|
||||||
@@ -503,28 +470,32 @@ windowSwap dir = actOnLayer thisLayer
|
|||||||
$ doFloatNavigation conf dir swap cur wins
|
$ doFloatNavigation conf dir swap cur wins
|
||||||
)
|
)
|
||||||
( \ _ _ _ -> return () )
|
( \ _ _ _ -> return () )
|
||||||
|
wrap
|
||||||
|
|
||||||
-- | Moves the current window to the next screen in the given direction. The
|
-- | Moves the current window to the next screen in the given direction. The
|
||||||
-- second argument indicates wrapping (see 'windowGo').
|
-- second argument indicates wrapping (see 'windowGo').
|
||||||
windowToScreen :: Direction2D -> Bool -> X ()
|
windowToScreen :: Direction2D -> Bool -> X ()
|
||||||
windowToScreen dir = actOnScreens ( \ conf cur wspcs -> windows
|
windowToScreen dir wrap = actOnScreens ( \ conf cur wspcs -> windows
|
||||||
$ doScreenNavigation conf dir W.shift cur wspcs
|
$ doScreenNavigation conf dir W.shift cur wspcs
|
||||||
)
|
)
|
||||||
|
wrap
|
||||||
|
|
||||||
-- | Moves the focus to the next screen in the given direction. The second
|
-- | Moves the focus to the next screen in the given direction. The second
|
||||||
-- argument indicates wrapping (see 'windowGo').
|
-- argument indicates wrapping (see 'windowGo').
|
||||||
screenGo :: Direction2D -> Bool -> X ()
|
screenGo :: Direction2D -> Bool -> X ()
|
||||||
screenGo dir = actOnScreens ( \ conf cur wspcs -> windows
|
screenGo dir wrap = actOnScreens ( \ conf cur wspcs -> windows
|
||||||
$ doScreenNavigation conf dir W.view cur wspcs
|
$ doScreenNavigation conf dir W.view cur wspcs
|
||||||
)
|
)
|
||||||
|
wrap
|
||||||
|
|
||||||
-- | Swaps the workspace on the current screen with the workspace on the screen
|
-- | Swaps the workspace on the current screen with the workspace on the screen
|
||||||
-- in the given direction. The second argument indicates wrapping (see
|
-- in the given direction. The second argument indicates wrapping (see
|
||||||
-- 'windowGo').
|
-- 'windowGo').
|
||||||
screenSwap :: Direction2D -> Bool -> X ()
|
screenSwap :: Direction2D -> Bool -> X ()
|
||||||
screenSwap dir = actOnScreens ( \ conf cur wspcs -> windows
|
screenSwap dir wrap = actOnScreens ( \ conf cur wspcs -> windows
|
||||||
$ doScreenNavigation conf dir W.greedyView cur wspcs
|
$ doScreenNavigation conf dir W.greedyView cur wspcs
|
||||||
)
|
)
|
||||||
|
wrap
|
||||||
|
|
||||||
-- | Maps each window to a fullscreen rect. This may not be the same rectangle the
|
-- | Maps each window to a fullscreen rect. This may not be the same rectangle the
|
||||||
-- window maps to under the Full layout or a similar layout if the layout
|
-- window maps to under the Full layout or a similar layout if the layout
|
||||||
@@ -644,7 +615,7 @@ doFocusClosestWindow (cur, rect) winrects
|
|||||||
where
|
where
|
||||||
ctr = centerOf rect
|
ctr = centerOf rect
|
||||||
winctrs = filter ((cur /=) . fst)
|
winctrs = filter ((cur /=) . fst)
|
||||||
$ map (second centerOf) winrects
|
$ map (\(w, r) -> (w, centerOf r)) winrects
|
||||||
closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2
|
closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2
|
||||||
| otherwise = wc1
|
| otherwise = wc1
|
||||||
|
|
||||||
@@ -664,7 +635,8 @@ doTiledNavigation conf dir act cur winrects winset
|
|||||||
nav = maximum
|
nav = maximum
|
||||||
$ map ( fromMaybe (defaultTiledNavigation conf)
|
$ map ( fromMaybe (defaultTiledNavigation conf)
|
||||||
. flip L.lookup (layoutNavigation conf)
|
. flip L.lookup (layoutNavigation conf)
|
||||||
) layouts
|
)
|
||||||
|
$ layouts
|
||||||
|
|
||||||
-- | Implements navigation for the float layer
|
-- | Implements navigation for the float layer
|
||||||
doFloatNavigation :: Navigation2DConfig
|
doFloatNavigation :: Navigation2DConfig
|
||||||
@@ -709,7 +681,7 @@ doLineNavigation dir (cur, rect) winrects
|
|||||||
|
|
||||||
-- The list of windows that are candidates to receive focus.
|
-- The list of windows that are candidates to receive focus.
|
||||||
winrects' = filter dirFilter
|
winrects' = filter dirFilter
|
||||||
. filter ((cur /=) . fst)
|
$ filter ((cur /=) . fst)
|
||||||
$ winrects
|
$ winrects
|
||||||
|
|
||||||
-- Decides whether a given window matches the criteria to be a candidate to
|
-- Decides whether a given window matches the criteria to be a candidate to
|
||||||
@@ -750,8 +722,9 @@ doCenterNavigation dir (cur, rect) winrects
|
|||||||
-- center rotated so the right cone becomes the relevant cone.
|
-- center rotated so the right cone becomes the relevant cone.
|
||||||
-- The windows are ordered in the order they should be preferred
|
-- The windows are ordered in the order they should be preferred
|
||||||
-- when they are otherwise tied.
|
-- when they are otherwise tied.
|
||||||
winctrs = map (second (dirTransform . centerOf))
|
winctrs = map (\(w, r) -> (w, dirTransform . centerOf $ r))
|
||||||
$ stackTransform winrects
|
$ stackTransform
|
||||||
|
$ winrects
|
||||||
|
|
||||||
-- Give preference to windows later in the stack for going left or up and to
|
-- Give preference to windows later in the stack for going left or up and to
|
||||||
-- windows earlier in the stack for going right or down. (The stack order
|
-- windows earlier in the stack for going right or down. (The stack order
|
||||||
@@ -794,54 +767,12 @@ doCenterNavigation dir (cur, rect) winrects
|
|||||||
-- or it has the same distance but comes later
|
-- or it has the same distance but comes later
|
||||||
-- in the window stack
|
-- in the window stack
|
||||||
|
|
||||||
-- x -y w h format is a pain. Let's use side coordinates. We assume x1 <= x2 and
|
-- | Implements Hybrid navigation. This attempts Line navigation first,
|
||||||
-- y1 <= y2, and make the assumption valid by initialising SideRects with the
|
-- then falls back on Center navigation if it finds no suitable target window.
|
||||||
-- property and carefully preserving it over any individual transformation.
|
doHybridNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
|
||||||
data SideRect = SideRect { x1 :: Int, x2 :: Int, y1 :: Int, y2 :: Int }
|
doHybridNavigation = applyToBoth (<|>) doLineNavigation doCenterNavigation
|
||||||
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.sortOn dist . foldr acClosest []
|
|
||||||
. filter (`toRightOf` (cur, transform rect))
|
|
||||||
. map (fmap transform)
|
|
||||||
where
|
where
|
||||||
-- Getting the center of the current window so we can make it the new origin.
|
applyToBoth f g h a b c = f (g a b c) (h a b c)
|
||||||
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)
|
|
||||||
|
|
||||||
-- | Swaps the current window with the window given as argument
|
-- | Swaps the current window with the window given as argument
|
||||||
swap :: Window -> WindowSet -> WindowSet
|
swap :: Window -> WindowSet -> WindowSet
|
||||||
@@ -858,7 +789,7 @@ swap win winset = W.focusWindow cur
|
|||||||
visws = map W.workspace scrs
|
visws = map W.workspace scrs
|
||||||
|
|
||||||
-- The focused windows of the visible workspaces
|
-- The focused windows of the visible workspaces
|
||||||
focused = mapMaybe (fmap W.focus . W.stack) visws
|
focused = mapMaybe (\ws -> W.focus <$> W.stack ws) visws
|
||||||
|
|
||||||
-- The window lists of the visible workspaces
|
-- The window lists of the visible workspaces
|
||||||
wins = map (W.integrate' . W.stack) visws
|
wins = map (W.integrate' . W.stack) visws
|
||||||
@@ -883,10 +814,14 @@ swap win winset = W.focusWindow cur
|
|||||||
centerOf :: Rectangle -> (Position, Position)
|
centerOf :: Rectangle -> (Position, Position)
|
||||||
centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r) `div` 2)
|
centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r) `div` 2)
|
||||||
|
|
||||||
|
-- | Shorthand for integer conversions
|
||||||
|
fi :: (Integral a, Num b) => a -> b
|
||||||
|
fi = fromIntegral
|
||||||
|
|
||||||
-- | Functions to choose the subset of windows to operate on
|
-- | Functions to choose the subset of windows to operate on
|
||||||
thisLayer, otherLayer :: a -> a -> a
|
thisLayer, otherLayer :: a -> a -> a
|
||||||
thisLayer = const
|
thisLayer = curry fst
|
||||||
otherLayer _ x = x
|
otherLayer = curry snd
|
||||||
|
|
||||||
-- | Returns the list of visible workspaces and their screen rects
|
-- | Returns the list of visible workspaces and their screen rects
|
||||||
visibleWorkspaces :: WindowSet -> Bool -> [WSRect]
|
visibleWorkspaces :: WindowSet -> Bool -> [WSRect]
|
||||||
@@ -923,8 +858,8 @@ wrapOffsets winset = (max_x - min_x, max_y - min_y)
|
|||||||
where
|
where
|
||||||
min_x = fi $ minimum $ map rect_x rects
|
min_x = fi $ minimum $ map rect_x rects
|
||||||
min_y = fi $ minimum $ map rect_y rects
|
min_y = fi $ minimum $ map rect_y rects
|
||||||
max_x = fi $ maximum $ map (\r -> rect_x r + fi (rect_width r)) rects
|
max_x = fi $ maximum $ map (\r -> rect_x r + (fi $ rect_width r)) rects
|
||||||
max_y = fi $ maximum $ map (\r -> rect_y r + fi (rect_height r)) rects
|
max_y = fi $ maximum $ map (\r -> rect_y r + (fi $ rect_height r)) rects
|
||||||
rects = map snd $ visibleWorkspaces winset False
|
rects = map snd $ visibleWorkspaces winset False
|
||||||
|
|
||||||
|
|
||||||
@@ -934,16 +869,16 @@ sortedScreens :: WindowSet -> [Screen]
|
|||||||
sortedScreens winset = L.sortBy cmp
|
sortedScreens winset = L.sortBy cmp
|
||||||
$ W.screens winset
|
$ W.screens winset
|
||||||
where
|
where
|
||||||
cmp s1 s2 | x < x' = LT
|
cmp s1 s2 | x1 < x2 = LT
|
||||||
| x > x' = GT
|
| x1 > x2 = GT
|
||||||
| y < x' = LT
|
| y1 < x2 = LT
|
||||||
| y > y' = GT
|
| y1 > y2 = GT
|
||||||
| otherwise = EQ
|
| otherwise = EQ
|
||||||
where
|
where
|
||||||
(x , y ) = centerOf (screenRect . W.screenDetail $ s1)
|
(x1, y1) = centerOf (screenRect . W.screenDetail $ s1)
|
||||||
(x', y') = centerOf (screenRect . W.screenDetail $ s2)
|
(x2, y2) = centerOf (screenRect . W.screenDetail $ s2)
|
||||||
|
|
||||||
|
|
||||||
-- | Calculates the L1-distance between two points.
|
-- | Calculates the L1-distance between two points.
|
||||||
lDist :: (Position, Position) -> (Position, Position) -> Int
|
lDist :: (Position, Position) -> (Position, Position) -> Int
|
||||||
lDist (x, y) (x', y') = abs (fi $ x - x') + abs (fi $ y - y')
|
lDist (x1, y1) (x2, y2) = abs (fi $ x1 - x2) + abs (fi $ y1 - y2)
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.NoBorders
|
-- Module : XMonad.Actions.NoBorders
|
||||||
-- Description : Helper functions for dealing with window borders.
|
|
||||||
-- Copyright : (c) Lukas Mai
|
-- Copyright : (c) Lukas Mai
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -28,7 +27,7 @@ toggleBorder :: Window -> X ()
|
|||||||
toggleBorder w = do
|
toggleBorder w = do
|
||||||
bw <- asks (borderWidth . config)
|
bw <- asks (borderWidth . config)
|
||||||
withDisplay $ \d -> io $ do
|
withDisplay $ \d -> io $ do
|
||||||
cw <- wa_border_width <$> getWindowAttributes d w
|
cw <- wa_border_width `fmap` getWindowAttributes d w
|
||||||
if cw == 0
|
if cw == 0
|
||||||
then setWindowBorderWidth d w bw
|
then setWindowBorderWidth d w bw
|
||||||
else setWindowBorderWidth d w 0
|
else setWindowBorderWidth d w 0
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.OnScreen
|
-- Module : XMonad.Actions.OnScreen
|
||||||
-- Description : Control workspaces on different screens (in xinerama mode).
|
|
||||||
-- Copyright : (c) 2009 Nils Schweinsberg
|
-- Copyright : (c) 2009 Nils Schweinsberg
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -27,9 +26,12 @@ module XMonad.Actions.OnScreen (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude (fromMaybe, guard)
|
|
||||||
import XMonad.StackSet hiding (new)
|
import XMonad.StackSet hiding (new)
|
||||||
|
|
||||||
|
import Control.Monad (guard)
|
||||||
|
-- import Control.Monad.State.Class (gets)
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
|
||||||
|
|
||||||
-- | Focus data definitions
|
-- | Focus data definitions
|
||||||
data Focus = FocusNew -- ^ always focus the new screen
|
data Focus = FocusNew -- ^ always focus the new screen
|
||||||
|
@@ -1,61 +0,0 @@
|
|||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : XMonad.Actions.PerWindowKeys
|
|
||||||
-- Description : Define key-bindings on a per-window basis.
|
|
||||||
-- Copyright : (c) Wilson Sales, 2019
|
|
||||||
-- License : BSD3-style (see LICENSE)
|
|
||||||
--
|
|
||||||
-- Maintainer : Wilson Sales <spoonm@spoonm.org>
|
|
||||||
-- Stability : unstable
|
|
||||||
-- Portability : unportable
|
|
||||||
--
|
|
||||||
-- Define key-bindings on a per-window basis.
|
|
||||||
--
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
module XMonad.Actions.PerWindowKeys (
|
|
||||||
-- * Usage
|
|
||||||
-- $usage
|
|
||||||
bindAll,
|
|
||||||
bindFirst
|
|
||||||
) where
|
|
||||||
|
|
||||||
import XMonad
|
|
||||||
|
|
||||||
-- $usage
|
|
||||||
--
|
|
||||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
|
||||||
--
|
|
||||||
-- > import XMonad.Actions.PerWindowKeys
|
|
||||||
--
|
|
||||||
-- > ,((0, xK_F2), bindFirst [(className =? "firefox", spawn "dmenu"), (isFloat, withFocused $ windows . W.sink)])
|
|
||||||
--
|
|
||||||
-- > ,((0, xK_F3), bindAll [(isDialog, kill), (pure True, doSomething)])
|
|
||||||
--
|
|
||||||
-- If you want an action that will always run, but also want to do something for
|
|
||||||
-- other queries, you can use @'bindAll' [(query1, action1), ..., (pure True,
|
|
||||||
-- alwaysDoThisAction)]@.
|
|
||||||
--
|
|
||||||
-- Similarly, if you want a default action to be run if all the others failed,
|
|
||||||
-- you can use @'bindFirst' [(query1, action1), ..., (pure True,
|
|
||||||
-- doThisIfTheOthersFail)]@.
|
|
||||||
--
|
|
||||||
-- For detailed instructions on editing your key bindings, see
|
|
||||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
|
||||||
|
|
||||||
-- | Run an action if a Query holds true. Doesn't stop at the first one that
|
|
||||||
-- does, however, and could potentially run all actions.
|
|
||||||
bindAll :: [(Query Bool, X ())] -> X ()
|
|
||||||
bindAll = mapM_ choose where
|
|
||||||
choose (mh,action) = withFocused $ \w -> whenX (runQuery mh w) action
|
|
||||||
|
|
||||||
-- | Run the action paired with the first Query that holds true.
|
|
||||||
bindFirst :: [(Query Bool, X ())] -> X ()
|
|
||||||
bindFirst = withFocused . chooseOne
|
|
||||||
|
|
||||||
chooseOne :: [(Query Bool, X ())] -> Window -> X ()
|
|
||||||
chooseOne [] _ = return ()
|
|
||||||
chooseOne ((mh,a):bs) w = do
|
|
||||||
c <- runQuery mh w
|
|
||||||
if c then a
|
|
||||||
else chooseOne bs w
|
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.PerWorkspaceKeys
|
-- Module : XMonad.Actions.PerWorkspaceKeys
|
||||||
-- Description : Define key-bindings on per-workspace basis.
|
|
||||||
-- Copyright : (c) Roman Cheplyaka, 2008
|
-- Copyright : (c) Roman Cheplyaka, 2008
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -47,3 +46,4 @@ bindOn bindings = chooseAction chooser where
|
|||||||
Nothing -> case lookup "" bindings of
|
Nothing -> case lookup "" bindings of
|
||||||
Just action -> action
|
Just action -> action
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
|
|
||||||
|
@@ -2,7 +2,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.PhysicalScreens
|
-- Module : XMonad.Actions.PhysicalScreens
|
||||||
-- Description : Manipulate screens ordered by physical location instead of ID.
|
|
||||||
-- Copyright : (c) Nelson Elhage <nelhage@mit.edu>
|
-- Copyright : (c) Nelson Elhage <nelhage@mit.edu>
|
||||||
-- License : BSD
|
-- License : BSD
|
||||||
--
|
--
|
||||||
@@ -22,18 +21,14 @@ module XMonad.Actions.PhysicalScreens (
|
|||||||
, sendToScreen
|
, sendToScreen
|
||||||
, onNextNeighbour
|
, onNextNeighbour
|
||||||
, onPrevNeighbour
|
, onPrevNeighbour
|
||||||
, horizontalScreenOrderer
|
|
||||||
, verticalScreenOrderer
|
|
||||||
, ScreenComparator(ScreenComparator)
|
|
||||||
, getScreenIdAndRectangle
|
|
||||||
, screenComparatorById
|
|
||||||
, screenComparatorByRectangle
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy)
|
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
|
import Data.List (sortBy,findIndex)
|
||||||
|
import Data.Function (on)
|
||||||
|
|
||||||
{- $usage
|
{- $usage
|
||||||
|
|
||||||
This module allows you name Xinerama screens from XMonad using their
|
This module allows you name Xinerama screens from XMonad using their
|
||||||
@@ -41,20 +36,17 @@ physical location relative to each other (as reported by Xinerama),
|
|||||||
rather than their @ScreenID@ s, which are arbitrarily determined by
|
rather than their @ScreenID@ s, which are arbitrarily determined by
|
||||||
your X server and graphics hardware.
|
your X server and graphics hardware.
|
||||||
|
|
||||||
You can specify how to order the screen by giving a ScreenComparator.
|
Screens are ordered by the upper-left-most corner, from top-to-bottom
|
||||||
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
|
|
||||||
and then left-to-right.
|
and then left-to-right.
|
||||||
|
|
||||||
Example usage in your @~\/.xmonad\/xmonad.hs@ file:
|
Example usage in your @~\/.xmonad\/xmonad.hs@ file:
|
||||||
|
|
||||||
> import XMonad.Actions.PhysicalScreens
|
> import XMonad.Actions.PhysicalScreens
|
||||||
> import Data.Default
|
|
||||||
|
|
||||||
> , ((modMask, xK_a), onPrevNeighbour def W.view)
|
> , ((modMask, xK_a), onPrevNeighbour W.view)
|
||||||
> , ((modMask, xK_o), onNextNeighbour def W.view)
|
> , ((modMask, xK_o), onNextNeighbour W.view)
|
||||||
> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour def W.shift)
|
> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour W.shift)
|
||||||
> , ((modMask .|. shiftMask, xK_o), onNextNeighbour def W.shift)
|
> , ((modMask .|. shiftMask, xK_o), onNextNeighbour W.shift)
|
||||||
|
|
||||||
> --
|
> --
|
||||||
> -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3
|
> -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3
|
||||||
@@ -62,7 +54,7 @@ Example usage in your @~\/.xmonad\/xmonad.hs@ file:
|
|||||||
> --
|
> --
|
||||||
> [((modm .|. mask, key), f sc)
|
> [((modm .|. mask, key), f sc)
|
||||||
> | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
|
> | (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
|
For detailed instructions on editing your key bindings, see
|
||||||
"XMonad.Doc.Extending#Editing_key_bindings".
|
"XMonad.Doc.Extending#Editing_key_bindings".
|
||||||
@@ -71,78 +63,52 @@ For detailed instructions on editing your key bindings, see
|
|||||||
-- | The type of the index of a screen by location
|
-- | The type of the index of a screen by location
|
||||||
newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
|
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"
|
-- | Translate a physical screen index to a "ScreenId"
|
||||||
getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
|
getScreen :: PhysicalScreen -> X (Maybe ScreenId)
|
||||||
getScreen (ScreenComparator cmpScreen) (P i) = do w <- gets windowset
|
getScreen (P i) = do w <- gets windowset
|
||||||
let screens = W.current w : W.visible w
|
let screens = W.current w : W.visible w
|
||||||
if i<0 || i >= length screens
|
if i<0 || i >= length screens
|
||||||
then return Nothing
|
then return Nothing
|
||||||
else let ss = sortBy (cmpScreen `on` getScreenIdAndRectangle) screens
|
else let ss = sortBy (cmpScreen `on` (screenRect . W.screenDetail)) screens
|
||||||
in return $ Just $ W.screen $ ss !! i
|
in return $ Just $ W.screen $ ss !! i
|
||||||
|
|
||||||
-- | Switch to a given physical screen
|
-- | Switch to a given physical screen
|
||||||
viewScreen :: ScreenComparator -> PhysicalScreen -> X ()
|
viewScreen :: PhysicalScreen -> X ()
|
||||||
viewScreen sc p = do i <- getScreen sc p
|
viewScreen p = do i <- getScreen p
|
||||||
whenJust i $ \s -> do
|
whenJust i $ \s -> do
|
||||||
w <- screenWorkspace s
|
w <- screenWorkspace s
|
||||||
whenJust w $ windows . W.view
|
whenJust w $ windows . W.view
|
||||||
|
|
||||||
-- | Send the active window to a given physical screen
|
-- | Send the active window to a given physical screen
|
||||||
sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()
|
sendToScreen :: PhysicalScreen -> X ()
|
||||||
sendToScreen sc p = do i <- getScreen sc p
|
sendToScreen p = do i <- getScreen p
|
||||||
whenJust i $ \s -> do
|
whenJust i $ \s -> do
|
||||||
w <- screenWorkspace s
|
w <- screenWorkspace s
|
||||||
whenJust w $ windows . W.shift
|
whenJust w $ windows . W.shift
|
||||||
|
|
||||||
-- | A ScreenComparator allow to compare two screen based on their coordonate and Xinerama Id
|
-- | Compare two screens by their top-left corners, ordering
|
||||||
newtype ScreenComparator = ScreenComparator ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> 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.
|
-- | Get ScreenId for neighbours of the current screen based on position offset.
|
||||||
getNeighbour :: ScreenComparator -> Int -> X ScreenId
|
getNeighbour :: Int -> X ScreenId
|
||||||
getNeighbour (ScreenComparator cmpScreen) d =
|
getNeighbour d = do w <- gets windowset
|
||||||
do w <- gets windowset
|
let ss = map W.screen $ sortBy (cmpScreen `on` (screenRect . W.screenDetail)) $ W.current w : W.visible w
|
||||||
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
|
||||||
curPos = fromMaybe 0 $ elemIndex (W.screen (W.current w)) ss
|
|
||||||
pos = (curPos + d) `mod` length ss
|
pos = (curPos + d) `mod` length ss
|
||||||
return $ ss !! pos
|
return $ ss !! pos
|
||||||
|
|
||||||
neighbourWindows :: ScreenComparator -> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
|
neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
|
||||||
neighbourWindows sc d f = do s <- getNeighbour sc d
|
neighbourWindows d f = do s <- getNeighbour d
|
||||||
w <- screenWorkspace s
|
w <- screenWorkspace s
|
||||||
whenJust w $ windows . f
|
whenJust w $ windows . f
|
||||||
|
|
||||||
-- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter.
|
-- | 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 :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
|
||||||
onNextNeighbour sc = neighbourWindows sc 1
|
onNextNeighbour = neighbourWindows 1
|
||||||
|
|
||||||
-- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.
|
-- | 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 :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
|
||||||
onPrevNeighbour sc = neighbourWindows sc (-1)
|
onPrevNeighbour = neighbourWindows (-1)
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.Plane
|
-- Module : XMonad.Actions.Plane
|
||||||
-- Description : Navigate through workspaces in a bidimensional manner.
|
|
||||||
-- Copyright : (c) Marco Túlio Gontijo e Silva <marcot@riseup.net>,
|
-- Copyright : (c) Marco Túlio Gontijo e Silva <marcot@riseup.net>,
|
||||||
-- Leonardo Serra <leoserra@minaslivre.org>
|
-- Leonardo Serra <leoserra@minaslivre.org>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
@@ -39,9 +38,11 @@ module XMonad.Actions.Plane
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.Map (Map, fromList)
|
import Control.Monad
|
||||||
|
import Data.List
|
||||||
|
import Data.Map hiding (split)
|
||||||
|
import Data.Maybe
|
||||||
|
|
||||||
import XMonad.Prelude
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.StackSet hiding (workspaces)
|
import XMonad.StackSet hiding (workspaces)
|
||||||
import XMonad.Util.Run
|
import XMonad.Util.Run
|
||||||
|
@@ -1,212 +0,0 @@
|
|||||||
{-# LANGUAGE FlexibleContexts #-}
|
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : XMonad.Actions.Prefix
|
|
||||||
-- Description : Use an Emacs-style prefix argument for commands.
|
|
||||||
-- Copyright : (c) Matus Goljer <matus.goljer@gmail.com>
|
|
||||||
-- License : BSD3-style (see LICENSE)
|
|
||||||
--
|
|
||||||
-- Maintainer : Matus Goljer <matus.goljer@gmail.com>
|
|
||||||
-- Stability : unstable
|
|
||||||
-- Portability : unportable
|
|
||||||
--
|
|
||||||
-- A module that allows the user to use a prefix argument (raw or numeric).
|
|
||||||
--
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
module XMonad.Actions.Prefix
|
|
||||||
(
|
|
||||||
-- * Usage
|
|
||||||
-- $usage
|
|
||||||
|
|
||||||
-- * Installation
|
|
||||||
-- $installation
|
|
||||||
|
|
||||||
PrefixArgument(..)
|
|
||||||
, usePrefixArgument
|
|
||||||
, useDefaultPrefixArgument
|
|
||||||
, withPrefixArgument
|
|
||||||
, isPrefixRaw
|
|
||||||
, isPrefixNumeric
|
|
||||||
, ppFormatPrefix
|
|
||||||
) where
|
|
||||||
|
|
||||||
import qualified Data.Map as M
|
|
||||||
|
|
||||||
import XMonad.Prelude
|
|
||||||
import XMonad
|
|
||||||
import XMonad.Util.ExtensibleState as XS
|
|
||||||
import XMonad.Util.Paste (sendKey)
|
|
||||||
import XMonad.Actions.Submap (submapDefaultWithKey)
|
|
||||||
import XMonad.Util.EZConfig (readKeySequence)
|
|
||||||
|
|
||||||
{- $usage
|
|
||||||
|
|
||||||
This module implements Emacs-style prefix argument. The argument
|
|
||||||
comes in two flavours, "Raw" and "Numeric".
|
|
||||||
|
|
||||||
To initiate the "prefix mode" you hit the prefix keybinding (default
|
|
||||||
C-u). This sets the Raw argument value to 1. Repeatedly hitting this
|
|
||||||
key increments the raw value by 1. The Raw argument is usually used
|
|
||||||
as a toggle, changing the behaviour of the function called in some way.
|
|
||||||
|
|
||||||
An example might be calling "mpc add" to add new song to the playlist,
|
|
||||||
but with C-u we also clean up the playlist beforehand.
|
|
||||||
|
|
||||||
When in the "Raw mode", you can hit numeric keys 0..9 (with no
|
|
||||||
modifier) to enter a "Numeric argument". Numeric argument represents
|
|
||||||
a natural number. Hitting numeric keys in sequence produces the
|
|
||||||
decimal number that would result from typing them. That is, the
|
|
||||||
sequence C-u 4 2 sets the Numeric argument value to the number 42.
|
|
||||||
|
|
||||||
If you have a function which understands the prefix argument, for example:
|
|
||||||
|
|
||||||
> addMaybeClean :: PrefixArgument -> X ()
|
|
||||||
> addMaybeClean (Raw _) = spawn "mpc clear" >> spawn "mpc add <file>"
|
|
||||||
> addMaybeClean _ = spawn "mpc add <file>"
|
|
||||||
|
|
||||||
you can turn it into an X action with the function 'withPrefixArgument'.
|
|
||||||
|
|
||||||
Binding it in your config
|
|
||||||
|
|
||||||
> ((modm, xK_a), withPrefixArgument addMaybeClean)
|
|
||||||
|
|
||||||
Hitting MOD-a will add the <file> to the playlist while C-u MOD-a will
|
|
||||||
clear the playlist and then add the file.
|
|
||||||
|
|
||||||
You can of course use an anonymous action, like so:
|
|
||||||
|
|
||||||
> ((modm, xK_a), withPrefixArgument $ \prefix -> do
|
|
||||||
> case prefix of ...
|
|
||||||
> )
|
|
||||||
|
|
||||||
If the prefix key is followed by a binding which is unknown to XMonad,
|
|
||||||
the prefix along with that binding is sent to the active window.
|
|
||||||
|
|
||||||
There is one caveat: when you use an application which has a nested
|
|
||||||
C-u binding, for example C-c C-u in Emacs org-mode, you have to hit
|
|
||||||
C-g (or any other non-recognized key really) to get out of the "xmonad
|
|
||||||
grab" and let the C-c C-u be sent to the application.
|
|
||||||
|
|
||||||
-}
|
|
||||||
|
|
||||||
{- $installation
|
|
||||||
|
|
||||||
The simplest way to enable this is to use 'useDefaultPrefixArgument'
|
|
||||||
|
|
||||||
> xmonad $ useDefaultPrefixArgument $ def { .. }
|
|
||||||
|
|
||||||
The default prefix argument is C-u. If you want to customize the
|
|
||||||
prefix argument, 'usePrefixArgument' can be used:
|
|
||||||
|
|
||||||
> xmonad $ usePrefixArgument "M-u" $ def { .. }
|
|
||||||
|
|
||||||
where the key is entered in Emacs style (or "XMonad.Util.EZConfig"
|
|
||||||
style) notation. The letter `M` stands for your chosen modifier. The
|
|
||||||
function defaults to C-u if the argument could not be parsed.
|
|
||||||
-}
|
|
||||||
|
|
||||||
data PrefixArgument = Raw Int | Numeric Int | None
|
|
||||||
deriving (Read, Show)
|
|
||||||
instance ExtensionClass PrefixArgument where
|
|
||||||
initialValue = None
|
|
||||||
extensionType = PersistentExtension
|
|
||||||
|
|
||||||
-- | Run 'job' in the 'X' monad and then execute 'cleanup'. In case
|
|
||||||
-- of exception, 'cleanup' is executed anyway.
|
|
||||||
--
|
|
||||||
-- Return the return value of 'job'.
|
|
||||||
finallyX :: X a -> X a -> X a
|
|
||||||
finallyX job cleanup = catchX (job >>= \r -> cleanup >> return r) cleanup
|
|
||||||
|
|
||||||
-- | Set up Prefix. Defaults to C-u when given an invalid key.
|
|
||||||
--
|
|
||||||
-- See usage section.
|
|
||||||
usePrefixArgument :: LayoutClass l Window
|
|
||||||
=> String
|
|
||||||
-> XConfig l
|
|
||||||
-> XConfig l
|
|
||||||
usePrefixArgument prefix conf =
|
|
||||||
conf{ keys = M.insert binding (handlePrefixArg [binding]) . keys conf }
|
|
||||||
where
|
|
||||||
binding = case readKeySequence conf prefix of
|
|
||||||
Just [key] -> key
|
|
||||||
_ -> (controlMask, xK_u)
|
|
||||||
|
|
||||||
-- | Set Prefix up with default prefix key (C-u).
|
|
||||||
useDefaultPrefixArgument :: LayoutClass l Window
|
|
||||||
=> XConfig l
|
|
||||||
-> XConfig l
|
|
||||||
useDefaultPrefixArgument = usePrefixArgument "C-u"
|
|
||||||
|
|
||||||
handlePrefixArg :: [(KeyMask, KeySym)] -> X ()
|
|
||||||
handlePrefixArg events = do
|
|
||||||
ks <- asks keyActions
|
|
||||||
logger <- asks (logHook . config)
|
|
||||||
flip finallyX (XS.put None >> logger) $ do
|
|
||||||
prefix <- XS.get
|
|
||||||
case prefix of
|
|
||||||
Raw a -> XS.put $ Raw (a + 1)
|
|
||||||
None -> XS.put $ Raw 1
|
|
||||||
_ -> return ()
|
|
||||||
logger
|
|
||||||
submapDefaultWithKey defaultKey ks
|
|
||||||
where defaultKey key@(m, k) =
|
|
||||||
if k `elem` (xK_0 : [xK_1 .. xK_9]) && m == noModMask
|
|
||||||
then do
|
|
||||||
prefix <- XS.get
|
|
||||||
let x = fromJust (Prelude.lookup k keyToNum)
|
|
||||||
case prefix of
|
|
||||||
Raw _ -> XS.put $ Numeric x
|
|
||||||
Numeric a -> XS.put $ Numeric $ a * 10 + x
|
|
||||||
None -> return () -- should never happen
|
|
||||||
handlePrefixArg (key:events)
|
|
||||||
else do
|
|
||||||
prefix <- XS.get
|
|
||||||
mapM_ (uncurry sendKey) $ case prefix of
|
|
||||||
Raw a -> replicate a (head events) ++ [key]
|
|
||||||
_ -> reverse (key:events)
|
|
||||||
keyToNum = (xK_0, 0) : zip [xK_1 .. xK_9] [1..9]
|
|
||||||
|
|
||||||
-- | Turn a prefix-aware X action into an X-action.
|
|
||||||
--
|
|
||||||
-- First, fetch the current prefix, then pass it as argument to the
|
|
||||||
-- original function. You should use this to "run" your commands.
|
|
||||||
withPrefixArgument :: (PrefixArgument -> X ()) -> X ()
|
|
||||||
withPrefixArgument = (>>=) XS.get
|
|
||||||
|
|
||||||
-- | Test if 'PrefixArgument' is 'Raw' or not.
|
|
||||||
isPrefixRaw :: PrefixArgument -> Bool
|
|
||||||
isPrefixRaw (Raw _) = True
|
|
||||||
isPrefixRaw _ = False
|
|
||||||
|
|
||||||
-- | Test if 'PrefixArgument' is 'Numeric' or not.
|
|
||||||
isPrefixNumeric :: PrefixArgument -> Bool
|
|
||||||
isPrefixNumeric (Numeric _) = True
|
|
||||||
isPrefixNumeric _ = False
|
|
||||||
|
|
||||||
-- | Format the prefix using the Emacs convetion for use in a
|
|
||||||
-- statusbar, like xmobar.
|
|
||||||
--
|
|
||||||
-- To add this formatted prefix to printer output, you can set it up
|
|
||||||
-- like so
|
|
||||||
--
|
|
||||||
-- > myPrinter :: PP
|
|
||||||
-- > myPrinter = def { ppExtras = [ppFormatPrefix] }
|
|
||||||
--
|
|
||||||
-- And then add to your status bar using "XMonad.Hooks.StatusBar":
|
|
||||||
--
|
|
||||||
-- > mySB = statusBarProp "xmobar" myPrinter
|
|
||||||
-- > main = xmonad $ withEasySB mySB defToggleStrutsKey def
|
|
||||||
--
|
|
||||||
-- Or, directly in your 'logHook' configuration
|
|
||||||
--
|
|
||||||
-- > logHook = dynamicLogWithPP myPrinter
|
|
||||||
ppFormatPrefix :: X (Maybe String)
|
|
||||||
ppFormatPrefix = do
|
|
||||||
prefix <- XS.get
|
|
||||||
return $ case prefix of
|
|
||||||
Raw n -> Just $ foldr1 (\a b -> a ++ " " ++ b) $ replicate n "C-u"
|
|
||||||
Numeric n -> Just $ "C-u " ++ show n
|
|
||||||
None -> Nothing
|
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.Promote
|
-- Module : XMonad.Actions.Promote
|
||||||
-- Description : Alternate promote function for xmonad.
|
|
||||||
-- Copyright : (c) Miikka Koskinen 2007
|
-- Copyright : (c) Miikka Koskinen 2007
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.RandomBackground
|
-- Module : XMonad.Actions.RandomBackground
|
||||||
-- Description : Start terminals with a random background color.
|
|
||||||
-- Copyright : (c) 2009 Anze Slosar
|
-- Copyright : (c) 2009 Anze Slosar
|
||||||
-- translation to Haskell by Adam Vogt
|
-- translation to Haskell by Adam Vogt
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
@@ -25,6 +24,7 @@ module XMonad.Actions.RandomBackground (
|
|||||||
import XMonad(X, XConf(config), XConfig(terminal), io, spawn,
|
import XMonad(X, XConf(config), XConfig(terminal), io, spawn,
|
||||||
MonadIO, asks)
|
MonadIO, asks)
|
||||||
import System.Random
|
import System.Random
|
||||||
|
import Control.Monad(liftM)
|
||||||
import Numeric(showHex)
|
import Numeric(showHex)
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
@@ -55,7 +55,7 @@ randPermutation xs g = swap $ zip (randoms g) xs
|
|||||||
|
|
||||||
-- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@
|
-- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@
|
||||||
randomBg' :: (MonadIO m) => RandomColor -> m String
|
randomBg' :: (MonadIO m) => RandomColor -> m String
|
||||||
randomBg' (RGB l h) = io $ fmap (toHex . take 3 . randomRs (l,h)) newStdGen
|
randomBg' (RGB l h) = io $ liftM (toHex . take 3 . randomRs (l,h)) newStdGen
|
||||||
randomBg' (HSV s v) = io $ do
|
randomBg' (HSV s v) = io $ do
|
||||||
g <- newStdGen
|
g <- newStdGen
|
||||||
let x = (^(2::Int)) $ fst $ randomR (0,sqrt $ pi / 3) g
|
let x = (^(2::Int)) $ fst $ randomR (0,sqrt $ pi / 3) g
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.RotSlaves
|
-- Module : XMonad.Actions.RotSlaves
|
||||||
-- Description : Rotate all windows except the master window and keep the focus in place.
|
|
||||||
-- Copyright : (c) Hans Philipp Annen <haphi@gmx.net>, Mischa Dieterle <der_m@freenet.de>
|
-- Copyright : (c) Hans Philipp Annen <haphi@gmx.net>, Mischa Dieterle <der_m@freenet.de>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -41,8 +40,8 @@ import XMonad
|
|||||||
-- | Rotate the windows in the current stack, excluding the first one
|
-- | Rotate the windows in the current stack, excluding the first one
|
||||||
-- (master).
|
-- (master).
|
||||||
rotSlavesUp,rotSlavesDown :: X ()
|
rotSlavesUp,rotSlavesDown :: X ()
|
||||||
rotSlavesUp = windows $ modify' (rotSlaves' (\l -> tail l++[head l]))
|
rotSlavesUp = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l]))
|
||||||
rotSlavesDown = windows $ modify' (rotSlaves' (\l -> last l : init l))
|
rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l)))
|
||||||
|
|
||||||
-- | The actual rotation, as a pure function on the window stack.
|
-- | The actual rotation, as a pure function on the window stack.
|
||||||
rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a
|
rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a
|
||||||
@@ -50,12 +49,12 @@ rotSlaves' _ s@(Stack _ [] []) = s
|
|||||||
rotSlaves' f (Stack t [] rs) = Stack t [] (f rs) -- Master has focus
|
rotSlaves' f (Stack t [] rs) = Stack t [] (f rs) -- Master has focus
|
||||||
rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs' -- otherwise
|
rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs' -- otherwise
|
||||||
where (master:ws) = integrate s
|
where (master:ws) = integrate s
|
||||||
(revls',t':rs') = splitAt (length ls) (master:f ws)
|
(revls',t':rs') = splitAt (length ls) (master:(f ws))
|
||||||
|
|
||||||
-- | Rotate all the windows in the current stack.
|
-- | Rotate all the windows in the current stack.
|
||||||
rotAllUp,rotAllDown :: X ()
|
rotAllUp,rotAllDown :: X ()
|
||||||
rotAllUp = windows $ modify' (rotAll' (\l -> tail l++[head l]))
|
rotAllUp = windows $ modify' (rotAll' (\l -> (tail l)++[head l]))
|
||||||
rotAllDown = windows $ modify' (rotAll' (\l -> last l : init l))
|
rotAllDown = windows $ modify' (rotAll' (\l -> [last l]++(init l)))
|
||||||
|
|
||||||
-- | The actual rotation, as a pure function on the window stack.
|
-- | The actual rotation, as a pure function on the window stack.
|
||||||
rotAll' :: ([a] -> [a]) -> Stack a -> Stack a
|
rotAll' :: ([a] -> [a]) -> Stack a -> Stack a
|
||||||
|
@@ -1,161 +0,0 @@
|
|||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : XMonad.Actions.RotateSome
|
|
||||||
-- Description : Rotate some elements around the stack.
|
|
||||||
-- Copyright : (c) 2020 Ivan Brennan <ivanbrennan@gmail.com>
|
|
||||||
-- License : BSD3-style (see LICENSE)
|
|
||||||
--
|
|
||||||
-- Maintainer : Ivan Brennan <ivanbrennan@gmail.com>
|
|
||||||
-- Stability : stable
|
|
||||||
-- Portability : unportable
|
|
||||||
--
|
|
||||||
-- Functions for rotating some elements around the stack while keeping others
|
|
||||||
-- anchored in place. Useful in combination with layouts that dictate window
|
|
||||||
-- visibility based on stack position, such as "XMonad.Layout.LimitWindows".
|
|
||||||
--
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
module XMonad.Actions.RotateSome (
|
|
||||||
-- * Usage
|
|
||||||
-- $usage
|
|
||||||
-- * Example
|
|
||||||
-- $example
|
|
||||||
surfaceNext,
|
|
||||||
surfacePrev,
|
|
||||||
rotateSome,
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Control.Arrow ((***))
|
|
||||||
import XMonad.Prelude (partition, sortOn, (\\))
|
|
||||||
import qualified Data.Map as M
|
|
||||||
import XMonad (Window, WindowSpace, Rectangle, X, runLayout, screenRect, windows, withWindowSet)
|
|
||||||
import XMonad.StackSet (Screen (Screen), Stack (Stack), current, floating, modify', stack)
|
|
||||||
import XMonad.Util.Stack (reverseS)
|
|
||||||
|
|
||||||
{- $usage
|
|
||||||
You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
|
||||||
|
|
||||||
> import XMonad.Actions.RotateSome
|
|
||||||
|
|
||||||
and add keybindings such as the following:
|
|
||||||
|
|
||||||
> , ((modMask .|. controlMask, xK_n), surfaceNext)
|
|
||||||
> , ((modMask .|. controlMask, xK_p), surfacePrev)
|
|
||||||
|
|
||||||
-}
|
|
||||||
|
|
||||||
{- $example
|
|
||||||
#Example#
|
|
||||||
|
|
||||||
Consider a workspace whose stack contains five windows A B C D E but whose
|
|
||||||
layout limits how many will actually be shown, showing only the first plus
|
|
||||||
two additional windows, starting with the third:
|
|
||||||
|
|
||||||
> ┌─────┬─────┐
|
|
||||||
> │ │ C │
|
|
||||||
> │ A ├─────┤
|
|
||||||
> │ │ D │
|
|
||||||
> └─────┴─────┘
|
|
||||||
>
|
|
||||||
> A B C D E
|
|
||||||
> _ ____
|
|
||||||
|
|
||||||
If C has focus and we'd like to replace it with one of the unshown windows,
|
|
||||||
'surfaceNext' will move the next unshown window, E, into the focused position:
|
|
||||||
|
|
||||||
> ┌─────┬─────┐ ┌─────┬─────┐
|
|
||||||
> │ │ *C* │ │ │ *E* │
|
|
||||||
> │ A ├─────┤ surfaceNext -> │ A ├─────┤
|
|
||||||
> │ │ D │ │ │ D │
|
|
||||||
> └─────┴─────┘ └─────┴─────┘
|
|
||||||
>
|
|
||||||
> A B *C* D E A C *E* D B
|
|
||||||
> _ ____ _ ____
|
|
||||||
|
|
||||||
This repositioned windows B C E by treating them as a sequence that can be
|
|
||||||
rotated through the focused stack position. Windows A and D remain anchored
|
|
||||||
to their original (visible) positions.
|
|
||||||
|
|
||||||
A second call to 'surfaceNext' moves B into focus:
|
|
||||||
|
|
||||||
> ┌─────┬─────┐ ┌─────┬─────┐
|
|
||||||
> │ │ *E* │ │ │ *B* │
|
|
||||||
> │ A ├─────┤ surfaceNext -> │ A ├─────┤
|
|
||||||
> │ │ D │ │ │ D │
|
|
||||||
> └─────┴─────┘ └─────┴─────┘
|
|
||||||
>
|
|
||||||
> A C *E* D B A E *B* D C
|
|
||||||
> _ ____ _ ____
|
|
||||||
|
|
||||||
A third call would complete the cycle, bringing C back into focus.
|
|
||||||
|
|
||||||
-}
|
|
||||||
|
|
||||||
-- |
|
|
||||||
-- Treating the focused window and any unshown windows as a ring that can be
|
|
||||||
-- rotated through the focused position, surface the next element in the ring.
|
|
||||||
surfaceNext :: X ()
|
|
||||||
surfaceNext = do
|
|
||||||
ring <- surfaceRing
|
|
||||||
windows . modify' $ rotateSome (`elem` ring)
|
|
||||||
|
|
||||||
-- | Like 'surfaceNext' in reverse.
|
|
||||||
surfacePrev :: X ()
|
|
||||||
surfacePrev = do
|
|
||||||
ring <- surfaceRing
|
|
||||||
windows . modify' $ reverseS . rotateSome (`elem` ring) . reverseS
|
|
||||||
|
|
||||||
-- |
|
|
||||||
-- Return a list containing the current focus plus any unshown windows. Note
|
|
||||||
-- that windows are shown if 'runLayout' provides them with a rectangle or if
|
|
||||||
-- they are floating.
|
|
||||||
surfaceRing :: X [Window]
|
|
||||||
surfaceRing = withWindowSet $ \wset -> do
|
|
||||||
let Screen wsp _ sd = current wset
|
|
||||||
|
|
||||||
case stack wsp >>= filter' (`M.notMember` floating wset) of
|
|
||||||
Nothing -> pure []
|
|
||||||
Just st -> go st <$> layoutWindows wsp {stack = Just st} (screenRect sd)
|
|
||||||
where
|
|
||||||
go :: Stack Window -> [Window] -> [Window]
|
|
||||||
go (Stack t ls rs) shown = t : ((ls ++ rs) \\ shown)
|
|
||||||
|
|
||||||
layoutWindows :: WindowSpace -> Rectangle -> X [Window]
|
|
||||||
layoutWindows wsp rect = map fst . fst <$> runLayout wsp rect
|
|
||||||
|
|
||||||
-- | Like "XMonad.StackSet.filter" but won't move focus.
|
|
||||||
filter' :: (a -> Bool) -> Stack a -> Maybe (Stack a)
|
|
||||||
filter' p (Stack f ls rs)
|
|
||||||
| p f = Just $ Stack f (filter p ls) (filter p rs)
|
|
||||||
| otherwise = Nothing
|
|
||||||
|
|
||||||
-- |
|
|
||||||
-- @'rotateSome' p stack@ treats the elements of @stack@ that satisfy predicate
|
|
||||||
-- @p@ as a ring that can be rotated, while all other elements remain anchored
|
|
||||||
-- in place.
|
|
||||||
rotateSome :: (a -> Bool) -> Stack a -> Stack a
|
|
||||||
rotateSome p (Stack t ls rs) =
|
|
||||||
let
|
|
||||||
-- Flatten the stack, index each element relative to the focused position,
|
|
||||||
-- then partition into movable and anchored elements.
|
|
||||||
(movables, anchors) =
|
|
||||||
partition (p . snd) $
|
|
||||||
zip
|
|
||||||
[negate (length ls)..]
|
|
||||||
(reverse ls ++ t : rs)
|
|
||||||
|
|
||||||
-- Pair each movable element with the index of its next movable neighbor.
|
|
||||||
-- Append anchored elements, along with their unchanged indices, and sort
|
|
||||||
-- by index. Separate lefts (negative indices) from the rest, and grab the
|
|
||||||
-- new focus from the head of the remaining elements.
|
|
||||||
(ls', t':rs') =
|
|
||||||
(map snd *** map snd)
|
|
||||||
. span ((< 0) . fst)
|
|
||||||
. sortOn fst
|
|
||||||
. (++) anchors
|
|
||||||
$ zipWith (curry (fst *** snd)) movables (rotate movables)
|
|
||||||
in
|
|
||||||
Stack t' (reverse ls') rs'
|
|
||||||
|
|
||||||
rotate :: [a] -> [a]
|
|
||||||
rotate = uncurry (flip (++)) . splitAt 1
|
|
@@ -1,6 +1,4 @@
|
|||||||
{- |
|
{- | Module : XMonad.Actions.Search
|
||||||
Module : XMonad.Actions.Search
|
|
||||||
Description : Easily run Internet searches on web sites through xmonad.
|
|
||||||
Copyright : (C) 2007 Gwern Branwen
|
Copyright : (C) 2007 Gwern Branwen
|
||||||
License : None; public domain
|
License : None; public domain
|
||||||
|
|
||||||
@@ -20,7 +18,6 @@ module XMonad.Actions.Search ( -- * Usage
|
|||||||
searchEngineF,
|
searchEngineF,
|
||||||
promptSearch,
|
promptSearch,
|
||||||
promptSearchBrowser,
|
promptSearchBrowser,
|
||||||
promptSearchBrowser',
|
|
||||||
selectSearch,
|
selectSearch,
|
||||||
selectSearchBrowser,
|
selectSearchBrowser,
|
||||||
isPrefixOf,
|
isPrefixOf,
|
||||||
@@ -38,13 +35,12 @@ module XMonad.Actions.Search ( -- * Usage
|
|||||||
debbts,
|
debbts,
|
||||||
debpts,
|
debpts,
|
||||||
dictionary,
|
dictionary,
|
||||||
ebay,
|
|
||||||
github,
|
|
||||||
google,
|
google,
|
||||||
hackage,
|
hackage,
|
||||||
hoogle,
|
hoogle,
|
||||||
images,
|
images,
|
||||||
imdb,
|
imdb,
|
||||||
|
isohunt,
|
||||||
lucky,
|
lucky,
|
||||||
maps,
|
maps,
|
||||||
mathworld,
|
mathworld,
|
||||||
@@ -67,12 +63,13 @@ module XMonad.Actions.Search ( -- * Usage
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Codec.Binary.UTF8.String (encode)
|
import Codec.Binary.UTF8.String (encode)
|
||||||
|
import Data.Char (isAlphaNum, isAscii)
|
||||||
|
import Data.List (isPrefixOf)
|
||||||
import Text.Printf
|
import Text.Printf
|
||||||
import XMonad (X (), liftIO)
|
import XMonad (X (), liftIO)
|
||||||
import XMonad.Prompt (XPConfig (), XPrompt (showXPrompt, nextCompletion, commandToComplete),
|
import XMonad.Prompt (XPConfig (), XPrompt (showXPrompt, nextCompletion, commandToComplete),
|
||||||
getNextCompletion,
|
getNextCompletion,
|
||||||
historyCompletionP, mkXPrompt)
|
historyCompletionP, mkXPrompt)
|
||||||
import XMonad.Prelude (isAlphaNum, isAscii, isPrefixOf)
|
|
||||||
import XMonad.Prompt.Shell (getBrowser)
|
import XMonad.Prompt.Shell (getBrowser)
|
||||||
import XMonad.Util.Run (safeSpawn)
|
import XMonad.Util.Run (safeSpawn)
|
||||||
import XMonad.Util.XSelection (getSelection)
|
import XMonad.Util.XSelection (getSelection)
|
||||||
@@ -116,10 +113,6 @@ import XMonad.Util.XSelection (getSelection)
|
|||||||
|
|
||||||
* 'dictionary' -- dictionary.reference.com search.
|
* 'dictionary' -- dictionary.reference.com search.
|
||||||
|
|
||||||
* 'ebay' -- Ebay keyword search.
|
|
||||||
|
|
||||||
* 'github' -- GitHub keyword search.
|
|
||||||
|
|
||||||
* 'google' -- basic Google search.
|
* 'google' -- basic Google search.
|
||||||
|
|
||||||
* 'hackage' -- Hackage, the Haskell package database.
|
* 'hackage' -- Hackage, the Haskell package database.
|
||||||
@@ -132,6 +125,8 @@ import XMonad.Util.XSelection (getSelection)
|
|||||||
|
|
||||||
* 'imdb' -- the Internet Movie Database.
|
* 'imdb' -- the Internet Movie Database.
|
||||||
|
|
||||||
|
* 'isohunt' -- isoHunt search.
|
||||||
|
|
||||||
* 'lucky' -- Google "I'm feeling lucky" search.
|
* 'lucky' -- Google "I'm feeling lucky" search.
|
||||||
|
|
||||||
* 'maps' -- Google maps.
|
* 'maps' -- Google maps.
|
||||||
@@ -142,7 +137,7 @@ import XMonad.Util.XSelection (getSelection)
|
|||||||
|
|
||||||
* 'scholar' -- Google scholar academic search.
|
* 'scholar' -- Google scholar academic search.
|
||||||
|
|
||||||
* 'thesaurus' -- thesaurus.com search.
|
* 'thesaurus' -- thesaurus.reference.com search.
|
||||||
|
|
||||||
* 'wayback' -- the Wayback Machine.
|
* 'wayback' -- the Wayback Machine.
|
||||||
|
|
||||||
@@ -196,7 +191,7 @@ Or in combination with XMonad.Util.EZConfig:
|
|||||||
>
|
>
|
||||||
> searchList :: [(String, S.SearchEngine)]
|
> searchList :: [(String, S.SearchEngine)]
|
||||||
> searchList = [ ("g", S.google)
|
> searchList = [ ("g", S.google)
|
||||||
> , ("h", S.hoogle)
|
> , ("h", S.hoohle)
|
||||||
> , ("w", S.wikipedia)
|
> , ("w", S.wikipedia)
|
||||||
> ]
|
> ]
|
||||||
|
|
||||||
@@ -215,7 +210,7 @@ engine.
|
|||||||
Happy searching! -}
|
Happy searching! -}
|
||||||
|
|
||||||
-- | A customized prompt indicating we are searching, and the name of the site.
|
-- | A customized prompt indicating we are searching, and the name of the site.
|
||||||
newtype Search = Search Name
|
data Search = Search Name
|
||||||
instance XPrompt Search where
|
instance XPrompt Search where
|
||||||
showXPrompt (Search name)= "Search [" ++ name ++ "]: "
|
showXPrompt (Search name)= "Search [" ++ name ++ "]: "
|
||||||
nextCompletion _ = getNextCompletion
|
nextCompletion _ = getNextCompletion
|
||||||
@@ -253,7 +248,7 @@ search browser site query = safeSpawn browser [site query]
|
|||||||
appends it to the base. You can easily define a new engine locally using
|
appends it to the base. You can easily define a new engine locally using
|
||||||
exported functions without needing to modify "XMonad.Actions.Search":
|
exported functions without needing to modify "XMonad.Actions.Search":
|
||||||
|
|
||||||
> myNewEngine = searchEngine "site" "https://site.com/search="
|
> myNewEngine = searchEngine "site" "http://site.com/search="
|
||||||
|
|
||||||
The important thing is that the site has a interface which accepts the escaped query
|
The important thing is that the site has a interface which accepts the escaped query
|
||||||
string as part of the URL. Alas, the exact URL to feed searchEngine varies
|
string as part of the URL. Alas, the exact URL to feed searchEngine varies
|
||||||
@@ -262,21 +257,21 @@ search browser site query = safeSpawn browser [site query]
|
|||||||
Generally, examining the resultant URL of a search will allow you to reverse-engineer
|
Generally, examining the resultant URL of a search will allow you to reverse-engineer
|
||||||
it if you can't find the necessary URL already described in other projects such as Surfraw. -}
|
it if you can't find the necessary URL already described in other projects such as Surfraw. -}
|
||||||
searchEngine :: Name -> String -> SearchEngine
|
searchEngine :: Name -> String -> SearchEngine
|
||||||
searchEngine name site = searchEngineF name (\s -> site ++ escape s)
|
searchEngine name site = searchEngineF name (\s -> site ++ (escape s))
|
||||||
|
|
||||||
{- | If your search engine is more complex than this (you may want to identify
|
{- | If your search engine is more complex than this (you may want to identify
|
||||||
the kind of input and make the search URL dependent on the input or put the query
|
the kind of input and make the search URL dependent on the input or put the query
|
||||||
inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function.
|
inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function.
|
||||||
|
|
||||||
> searchFunc :: String -> String
|
> searchFunc :: String -> String
|
||||||
> searchFunc s | "wiki:" `isPrefixOf` s = "https://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)
|
> searchFunc s | "wiki:" `isPrefixOf` s = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)
|
||||||
> | "https://" `isPrefixOf` s = s
|
> | "http://" `isPrefixOf` s = s
|
||||||
> | otherwise = (use google) s
|
> | otherwise = (use google) s
|
||||||
> myNewEngine = searchEngineF "mymulti" searchFunc
|
> myNewEngine = searchEngineF "mymulti" searchFunc
|
||||||
|
|
||||||
@searchFunc@ here searches for a word in wikipedia if it has a prefix
|
@searchFunc@ here searches for a word in wikipedia if it has a prefix
|
||||||
of \"wiki:\" (you can use the 'escape' function to escape any forbidden characters), opens an address
|
of \"wiki:\" (you can use the 'escape' function to escape any forbidden characters), opens an address
|
||||||
directly if it starts with \"https:\/\/\" and otherwise uses the provided google search engine.
|
directly if it starts with \"http:\/\/\" and otherwise uses the provided google search engine.
|
||||||
You can use other engines inside of your own through the 'use' function as shown above to make
|
You can use other engines inside of your own through the 'use' function as shown above to make
|
||||||
complex searches.
|
complex searches.
|
||||||
|
|
||||||
@@ -286,39 +281,38 @@ searchEngineF :: Name -> Site -> SearchEngine
|
|||||||
searchEngineF = SearchEngine
|
searchEngineF = SearchEngine
|
||||||
|
|
||||||
-- The engines.
|
-- The engines.
|
||||||
amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, github, google, hackage, hoogle,
|
amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle,
|
||||||
images, imdb, lucky, maps, mathworld, openstreetmap, scholar, stackage, thesaurus, vocabulary, wayback, wikipedia, wiktionary,
|
images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, stackage, thesaurus, vocabulary, wayback, wikipedia, wiktionary,
|
||||||
youtube, duckduckgo :: SearchEngine
|
youtube, duckduckgo :: SearchEngine
|
||||||
amazon = searchEngine "amazon" "https://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords="
|
amazon = searchEngine "amazon" "http://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords="
|
||||||
alpha = searchEngine "alpha" "https://www.wolframalpha.com/input/?i="
|
alpha = searchEngine "alpha" "http://www.wolframalpha.com/input/?i="
|
||||||
codesearch = searchEngine "codesearch" "https://developers.google.com/s/results/code-search?q="
|
codesearch = searchEngine "codesearch" "http://www.google.com/codesearch?q="
|
||||||
deb = searchEngine "deb" "https://packages.debian.org/"
|
deb = searchEngine "deb" "http://packages.debian.org/"
|
||||||
debbts = searchEngine "debbts" "https://bugs.debian.org/"
|
debbts = searchEngine "debbts" "http://bugs.debian.org/"
|
||||||
debpts = searchEngine "debpts" "https://packages.qa.debian.org/"
|
debpts = searchEngine "debpts" "http://packages.qa.debian.org/"
|
||||||
dictionary = searchEngine "dict" "https://dictionary.reference.com/browse/"
|
dictionary = searchEngine "dict" "http://dictionary.reference.com/browse/"
|
||||||
ebay = searchEngine "ebay" "https://www.ebay.com/sch/i.html?_nkw="
|
google = searchEngine "google" "http://www.google.com/search?num=100&q="
|
||||||
github = searchEngine "github" "https://github.com/search?q="
|
hackage = searchEngine "hackage" "http://hackage.haskell.org/package/"
|
||||||
google = searchEngine "google" "https://www.google.com/search?num=100&q="
|
hoogle = searchEngine "hoogle" "http://www.haskell.org/hoogle/?q="
|
||||||
hackage = searchEngine "hackage" "https://hackage.haskell.org/package/"
|
images = searchEngine "images" "http://images.google.fr/images?q="
|
||||||
hoogle = searchEngine "hoogle" "https://hoogle.haskell.org/?hoogle="
|
imdb = searchEngine "imdb" "http://www.imdb.com/find?s=all&q="
|
||||||
images = searchEngine "images" "https://images.google.fr/images?q="
|
isohunt = searchEngine "isohunt" "http://isohunt.com/torrents/?ihq="
|
||||||
imdb = searchEngine "imdb" "https://www.imdb.com/find?s=all&q="
|
lucky = searchEngine "lucky" "http://www.google.com/search?btnI&q="
|
||||||
lucky = searchEngine "lucky" "https://www.google.com/search?btnI&q="
|
maps = searchEngine "maps" "http://maps.google.com/maps?q="
|
||||||
maps = searchEngine "maps" "https://maps.google.com/maps?q="
|
mathworld = searchEngine "mathworld" "http://mathworld.wolfram.com/search/?query="
|
||||||
mathworld = searchEngine "mathworld" "https://mathworld.wolfram.com/search/?query="
|
openstreetmap = searchEngine "openstreetmap" "http://gazetteer.openstreetmap.org/namefinder/?find="
|
||||||
openstreetmap = searchEngine "openstreetmap" "https://www.openstreetmap.org/search?query="
|
scholar = searchEngine "scholar" "http://scholar.google.com/scholar?q="
|
||||||
scholar = searchEngine "scholar" "https://scholar.google.com/scholar?q="
|
stackage = searchEngine "stackage" "www.stackage.org/lts/hoogle?q="
|
||||||
stackage = searchEngine "stackage" "https://www.stackage.org/lts/hoogle?q="
|
thesaurus = searchEngine "thesaurus" "http://thesaurus.reference.com/search?q="
|
||||||
thesaurus = searchEngine "thesaurus" "https://thesaurus.com/browse/"
|
wikipedia = searchEngine "wiki" "http://en.wikipedia.org/wiki/Special:Search?go=Go&search="
|
||||||
wikipedia = searchEngine "wiki" "https://en.wikipedia.org/wiki/Special:Search?go=Go&search="
|
wiktionary = searchEngine "wikt" "http://en.wiktionary.org/wiki/Special:Search?go=Go&search="
|
||||||
wiktionary = searchEngine "wikt" "https://en.wiktionary.org/wiki/Special:Search?go=Go&search="
|
youtube = searchEngine "youtube" "http://www.youtube.com/results?search_type=search_videos&search_query="
|
||||||
youtube = searchEngine "youtube" "https://www.youtube.com/results?search_type=search_videos&search_query="
|
wayback = searchEngineF "wayback" ("http://web.archive.org/web/*/"++)
|
||||||
wayback = searchEngineF "wayback" ("https://web.archive.org/web/*/"++)
|
vocabulary = searchEngine "vocabulary" "http://www.vocabulary.com/search?q="
|
||||||
vocabulary = searchEngine "vocabulary" "https://www.vocabulary.com/search?q="
|
|
||||||
duckduckgo = searchEngine "duckduckgo" "https://duckduckgo.com/?t=lm&q="
|
duckduckgo = searchEngine "duckduckgo" "https://duckduckgo.com/?t=lm&q="
|
||||||
|
|
||||||
multi :: SearchEngine
|
multi :: SearchEngine
|
||||||
multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, github, google, hackage, hoogle, images, imdb, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, prefixAware google]
|
multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, (prefixAware google)]
|
||||||
|
|
||||||
{- | This function wraps up a search engine and creates a new one, which works
|
{- | This function wraps up a search engine and creates a new one, which works
|
||||||
like the argument, but goes directly to a URL if one is given rather than
|
like the argument, but goes directly to a URL if one is given rather than
|
||||||
@@ -326,9 +320,9 @@ multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbt
|
|||||||
|
|
||||||
> myIntelligentGoogleEngine = intelligent google
|
> myIntelligentGoogleEngine = intelligent google
|
||||||
|
|
||||||
Now if you search for https:\/\/xmonad.org it will directly open in your browser-}
|
Now if you search for http:\/\/xmonad.org it will directly open in your browser-}
|
||||||
intelligent :: SearchEngine -> SearchEngine
|
intelligent :: SearchEngine -> SearchEngine
|
||||||
intelligent (SearchEngine name site) = searchEngineF name (\s -> if takeWhile (/= ':') s `elem` ["http", "https", "ftp"] then s else site s)
|
intelligent (SearchEngine name site) = searchEngineF name (\s -> if (fst $ break (==':') s) `elem` ["http", "https", "ftp"] then s else (site s))
|
||||||
|
|
||||||
-- | > removeColonPrefix "foo://bar" ~> "//bar"
|
-- | > removeColonPrefix "foo://bar" ~> "//bar"
|
||||||
-- > removeColonPrefix "foo//bar" ~> "foo//bar"
|
-- > removeColonPrefix "foo//bar" ~> "foo//bar"
|
||||||
@@ -348,7 +342,6 @@ removeColonPrefix s = if ':' `elem` s then drop 1 $ dropWhile (':' /=) s else s
|
|||||||
google. The use of intelligent will make sure that URLs are opened directly. -}
|
google. The use of intelligent will make sure that URLs are opened directly. -}
|
||||||
(!>) :: SearchEngine -> SearchEngine -> SearchEngine
|
(!>) :: SearchEngine -> SearchEngine -> SearchEngine
|
||||||
(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if (name1++":") `isPrefixOf` s then site1 (removeColonPrefix s) else site2 s)
|
(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if (name1++":") `isPrefixOf` s then site1 (removeColonPrefix s) else site2 s)
|
||||||
infixr 6 !>
|
|
||||||
|
|
||||||
{- | Makes a search engine prefix-aware. Especially useful together with '!>'.
|
{- | Makes a search engine prefix-aware. Especially useful together with '!>'.
|
||||||
It will automatically remove the prefix from a query so that you don\'t end
|
It will automatically remove the prefix from a query so that you don\'t end
|
||||||
@@ -365,18 +358,8 @@ namedEngine name (SearchEngine _ site) = searchEngineF name site
|
|||||||
Prompt's result, passes it to a given searchEngine and opens it in a given
|
Prompt's result, passes it to a given searchEngine and opens it in a given
|
||||||
browser. -}
|
browser. -}
|
||||||
promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()
|
promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()
|
||||||
promptSearchBrowser config browser (SearchEngine name site) = do
|
promptSearchBrowser config browser (SearchEngine name site) =
|
||||||
hc <- historyCompletionP ("Search [" `isPrefixOf`)
|
mkXPrompt (Search name) config (historyCompletionP ("Search [" `isPrefixOf`)) $ search browser site
|
||||||
mkXPrompt (Search name) config hc $ search browser site
|
|
||||||
|
|
||||||
{- | Like 'promptSearchBrowser', but only suggest previous searches for the
|
|
||||||
given 'SearchEngine' in the prompt. -}
|
|
||||||
promptSearchBrowser' :: XPConfig -> Browser -> SearchEngine -> X ()
|
|
||||||
promptSearchBrowser' config browser (SearchEngine name site) = do
|
|
||||||
hc <- historyCompletionP (searchName `isPrefixOf`)
|
|
||||||
mkXPrompt (Search name) config hc $ search browser site
|
|
||||||
where
|
|
||||||
searchName = showXPrompt (Search name)
|
|
||||||
|
|
||||||
{- | Like 'search', but in this case, the string is not specified but grabbed
|
{- | Like 'search', but in this case, the string is not specified but grabbed
|
||||||
from the user's response to a prompt. Example:
|
from the user's response to a prompt. Example:
|
||||||
|
@@ -1,8 +1,7 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.ShowText
|
-- Module : XMonad.Actions.ShowText
|
||||||
-- Description : Display text on the screen.
|
|
||||||
-- Copyright : (c) Mario Pastorelli (2012)
|
-- Copyright : (c) Mario Pastorelli (2012)
|
||||||
-- License : BSD-style (see xmonad/LICENSE)
|
-- License : BSD-style (see xmonad/LICENSE)
|
||||||
--
|
--
|
||||||
@@ -18,15 +17,17 @@ module XMonad.Actions.ShowText
|
|||||||
( -- * Usage
|
( -- * Usage
|
||||||
-- $usage
|
-- $usage
|
||||||
def
|
def
|
||||||
|
, defaultSTConfig
|
||||||
, handleTimerEvent
|
, handleTimerEvent
|
||||||
, flashText
|
, flashText
|
||||||
, ShowTextConfig(..)
|
, ShowTextConfig(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Monad (when)
|
||||||
import Data.Map (Map,empty,insert,lookup)
|
import Data.Map (Map,empty,insert,lookup)
|
||||||
|
import Data.Monoid (mempty, All)
|
||||||
import Prelude hiding (lookup)
|
import Prelude hiding (lookup)
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude (All, fi, when)
|
|
||||||
import XMonad.StackSet (current,screen)
|
import XMonad.StackSet (current,screen)
|
||||||
import XMonad.Util.Font (Align(AlignCenter)
|
import XMonad.Util.Font (Align(AlignCenter)
|
||||||
, initXMF
|
, initXMF
|
||||||
@@ -36,6 +37,7 @@ import XMonad.Util.Font (Align(AlignCenter)
|
|||||||
import XMonad.Util.Timer (startTimer)
|
import XMonad.Util.Timer (startTimer)
|
||||||
import XMonad.Util.XUtils (createNewWindow
|
import XMonad.Util.XUtils (createNewWindow
|
||||||
, deleteWindow
|
, deleteWindow
|
||||||
|
, fi
|
||||||
, showWindow
|
, showWindow
|
||||||
, paintAndWrite)
|
, paintAndWrite)
|
||||||
import qualified XMonad.Util.ExtensibleState as ES
|
import qualified XMonad.Util.ExtensibleState as ES
|
||||||
@@ -56,7 +58,7 @@ import qualified XMonad.Util.ExtensibleState as ES
|
|||||||
|
|
||||||
-- | ShowText contains the map with timers as keys and created windows as values
|
-- | ShowText contains the map with timers as keys and created windows as values
|
||||||
newtype ShowText = ShowText (Map Atom Window)
|
newtype ShowText = ShowText (Map Atom Window)
|
||||||
deriving (Read,Show)
|
deriving (Read,Show,Typeable)
|
||||||
|
|
||||||
instance ExtensionClass ShowText where
|
instance ExtensionClass ShowText where
|
||||||
initialValue = ShowText empty
|
initialValue = ShowText empty
|
||||||
@@ -73,22 +75,22 @@ data ShowTextConfig =
|
|||||||
|
|
||||||
instance Default ShowTextConfig where
|
instance Default ShowTextConfig where
|
||||||
def =
|
def =
|
||||||
#ifdef XFT
|
|
||||||
STC { st_font = "xft:monospace-20"
|
|
||||||
#else
|
|
||||||
STC { st_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
|
STC { st_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
|
||||||
#endif
|
|
||||||
, st_bg = "black"
|
, st_bg = "black"
|
||||||
, st_fg = "white"
|
, st_fg = "white"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
{-# DEPRECATED defaultSTConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.ShowText) instead." #-}
|
||||||
|
defaultSTConfig :: ShowTextConfig
|
||||||
|
defaultSTConfig = def
|
||||||
|
|
||||||
-- | Handles timer events that notify when a window should be removed
|
-- | Handles timer events that notify when a window should be removed
|
||||||
handleTimerEvent :: Event -> X All
|
handleTimerEvent :: Event -> X All
|
||||||
handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do
|
handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do
|
||||||
(ShowText m) <- ES.get :: X ShowText
|
(ShowText m) <- ES.get :: X ShowText
|
||||||
a <- io $ internAtom dis "XMONAD_TIMER" False
|
a <- io $ internAtom dis "XMONAD_TIMER" False
|
||||||
when (mtyp == a && not (null d))
|
when (mtyp == a && length d >= 1)
|
||||||
(whenJust (lookup (fromIntegral $ head d) m) deleteWindow)
|
(whenJust (lookup (fromIntegral $ d !! 0) m) deleteWindow)
|
||||||
mempty
|
mempty
|
||||||
handleTimerEvent _ = mempty
|
handleTimerEvent _ = mempty
|
||||||
|
|
||||||
|
@@ -1,56 +0,0 @@
|
|||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : XMonad.Actions.Sift
|
|
||||||
-- Description : Functions for sifting windows up and down.
|
|
||||||
-- Copyright : (c) 2020 Ivan Brennan <ivanbrennan@gmail.com>
|
|
||||||
-- License : BSD3-style (see LICENSE)
|
|
||||||
--
|
|
||||||
-- Maintainer : Ivan Brennan <ivanbrennan@gmail.com>
|
|
||||||
-- Stability : stable
|
|
||||||
-- Portability : unportable
|
|
||||||
--
|
|
||||||
-- Functions for sifting windows up and down. Sifts behave identically to
|
|
||||||
-- swaps (i.e. 'swapUp' and 'swapDown' from "XMonad.StackSet"), except in
|
|
||||||
-- the wrapping case: rather than rotating the entire stack by one position
|
|
||||||
-- like a swap would, a sift causes the windows at either end of the stack
|
|
||||||
-- to trade positions.
|
|
||||||
--
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
module XMonad.Actions.Sift (
|
|
||||||
-- * Usage
|
|
||||||
-- $usage
|
|
||||||
siftUp,
|
|
||||||
siftDown,
|
|
||||||
) where
|
|
||||||
|
|
||||||
import XMonad.StackSet (Stack (Stack), StackSet, modify')
|
|
||||||
import XMonad.Util.Stack (reverseS)
|
|
||||||
|
|
||||||
-- $usage
|
|
||||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
|
||||||
--
|
|
||||||
-- > import XMonad.Actions.Sift
|
|
||||||
--
|
|
||||||
-- and add keybindings such as the following:
|
|
||||||
--
|
|
||||||
-- > , ((modMask .|. shiftMask, xK_j ), windows siftDown)
|
|
||||||
-- > , ((modMask .|. shiftMask, xK_k ), windows siftUp )
|
|
||||||
--
|
|
||||||
|
|
||||||
-- |
|
|
||||||
-- siftUp, siftDown. Exchange the focused window with its neighbour in
|
|
||||||
-- the stack ordering, wrapping if we reach the end. Unlike 'swapUp' and
|
|
||||||
-- 'swapDown', wrapping is handled by trading positions with the window
|
|
||||||
-- at the other end of the stack.
|
|
||||||
--
|
|
||||||
siftUp, siftDown :: StackSet i l a s sd -> StackSet i l a s sd
|
|
||||||
siftUp = modify' siftUp'
|
|
||||||
siftDown = modify' (reverseS . siftUp' . reverseS)
|
|
||||||
|
|
||||||
siftUp' :: Stack a -> Stack a
|
|
||||||
siftUp' (Stack t (l:ls) rs) = Stack t ls (l:rs)
|
|
||||||
siftUp' (Stack t [] rs) =
|
|
||||||
case reverse rs of
|
|
||||||
(x:xs) -> Stack t (xs ++ [x]) []
|
|
||||||
[] -> Stack t [] []
|
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.SimpleDate
|
-- Module : XMonad.Actions.SimpleDate
|
||||||
-- Description : An example external contrib module for XMonad.
|
|
||||||
-- Copyright : (c) Don Stewart 2007
|
-- Copyright : (c) Don Stewart 2007
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.SinkAll
|
-- Module : XMonad.Actions.SinkAll
|
||||||
-- Description : (DEPRECATED) Push floating windows back into tiling.
|
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
-- Stability : unstable
|
-- Stability : unstable
|
||||||
-- Portability : unportable
|
-- Portability : unportable
|
||||||
|
@@ -1,7 +1,7 @@
|
|||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.SpawnOn
|
-- Module : XMonad.Actions.SpawnOn
|
||||||
-- Description : Modify a window spawned by a command.
|
|
||||||
-- Copyright : (c) Spencer Janssen
|
-- Copyright : (c) Spencer Janssen
|
||||||
-- License : BSD
|
-- License : BSD
|
||||||
--
|
--
|
||||||
@@ -28,14 +28,10 @@ module XMonad.Actions.SpawnOn (
|
|||||||
shellPromptOn
|
shellPromptOn
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Exception (tryJust)
|
import Data.List (isInfixOf)
|
||||||
import System.IO.Error (isDoesNotExistError)
|
|
||||||
import System.IO.Unsafe (unsafePerformIO)
|
|
||||||
import System.Posix.Types (ProcessID)
|
import System.Posix.Types (ProcessID)
|
||||||
import Text.Printf (printf)
|
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude
|
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
import XMonad.Hooks.ManageHelpers
|
import XMonad.Hooks.ManageHelpers
|
||||||
@@ -66,31 +62,12 @@ import qualified XMonad.Util.ExtensibleState as XS
|
|||||||
-- For detailed instructions on editing your key bindings, see
|
-- For detailed instructions on editing your key bindings, see
|
||||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||||
|
|
||||||
newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]}
|
newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]} deriving Typeable
|
||||||
|
|
||||||
instance ExtensionClass Spawner where
|
instance ExtensionClass Spawner where
|
||||||
initialValue = Spawner []
|
initialValue = Spawner []
|
||||||
|
|
||||||
|
|
||||||
getPPIDOf :: ProcessID -> Maybe ProcessID
|
|
||||||
getPPIDOf thisPid =
|
|
||||||
case unsafePerformIO . tryJust (guard . isDoesNotExistError) . readFile . printf "/proc/%d/stat" $ toInteger thisPid 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 thisPid = ppid_chain thisPid []
|
|
||||||
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.
|
-- | Get the current Spawner or create one if it doesn't exist.
|
||||||
modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
|
modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
|
||||||
modifySpawner f = XS.modify (Spawner . f . pidsRef)
|
modifySpawner f = XS.modify (Spawner . f . pidsRef)
|
||||||
@@ -106,17 +83,9 @@ manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)])
|
|||||||
manageSpawnWithGC garbageCollect = do
|
manageSpawnWithGC garbageCollect = do
|
||||||
Spawner pids <- liftX XS.get
|
Spawner pids <- liftX XS.get
|
||||||
mp <- pid
|
mp <- pid
|
||||||
let ppid_chain = case mp of
|
case flip lookup pids =<< mp of
|
||||||
Just winpid -> winpid : getPPIDChain winpid
|
Nothing -> idHook
|
||||||
Nothing -> []
|
Just mh -> do
|
||||||
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
|
|
||||||
whenJust mp $ \p -> liftX $ do
|
whenJust mp $ \p -> liftX $ do
|
||||||
ps <- XS.gets pidsRef
|
ps <- XS.gets pidsRef
|
||||||
XS.put . Spawner =<< garbageCollect (filter ((/= p) . fst) ps)
|
XS.put . Spawner =<< garbageCollect (filter ((/= p) . fst) ps)
|
||||||
@@ -124,7 +93,7 @@ manageSpawnWithGC garbageCollect = do
|
|||||||
|
|
||||||
mkPrompt :: (String -> X ()) -> XPConfig -> X ()
|
mkPrompt :: (String -> X ()) -> XPConfig -> X ()
|
||||||
mkPrompt cb c = do
|
mkPrompt cb c = do
|
||||||
cmds <- io getCommands
|
cmds <- io $ getCommands
|
||||||
mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) cb
|
mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) cb
|
||||||
|
|
||||||
-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
|
-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
|
||||||
@@ -145,13 +114,13 @@ spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd
|
|||||||
-- | Replacement for 'spawn' which launches
|
-- | Replacement for 'spawn' which launches
|
||||||
-- application on given workspace.
|
-- application on given workspace.
|
||||||
spawnOn :: WorkspaceId -> String -> X ()
|
spawnOn :: WorkspaceId -> String -> X ()
|
||||||
spawnOn ws = spawnAndDo (doShift ws)
|
spawnOn ws cmd = spawnAndDo (doShift ws) cmd
|
||||||
|
|
||||||
-- | Spawn an application and apply the manage hook when it opens.
|
-- | Spawn an application and apply the manage hook when it opens.
|
||||||
spawnAndDo :: ManageHook -> String -> X ()
|
spawnAndDo :: ManageHook -> String -> X ()
|
||||||
spawnAndDo mh cmd = do
|
spawnAndDo mh cmd = do
|
||||||
p <- spawnPID $ mangle cmd
|
p <- spawnPID $ mangle cmd
|
||||||
modifySpawner ((p,mh) :)
|
modifySpawner $ ((p,mh) :)
|
||||||
where
|
where
|
||||||
-- TODO this is silly, search for a better solution
|
-- TODO this is silly, search for a better solution
|
||||||
mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs
|
mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.Submap
|
-- Module : XMonad.Actions.Submap
|
||||||
-- Description : Create a sub-mapping of key bindings.
|
|
||||||
-- Copyright : (c) Jason Creighton <jcreigh@gmail.com>
|
-- Copyright : (c) Jason Creighton <jcreigh@gmail.com>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -21,9 +20,10 @@ module XMonad.Actions.Submap (
|
|||||||
submapDefaultWithKey
|
submapDefaultWithKey
|
||||||
) where
|
) where
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
import XMonad.Prelude (fix, fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import XMonad hiding (keys)
|
import XMonad hiding (keys)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
import Control.Monad.Fix (fix)
|
||||||
|
|
||||||
{- $usage
|
{- $usage
|
||||||
|
|
||||||
@@ -75,24 +75,17 @@ submapDefaultWithKey defAction keys = do
|
|||||||
XConf { theRoot = root, display = d } <- ask
|
XConf { theRoot = root, display = d } <- ask
|
||||||
|
|
||||||
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
|
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
|
(m, s) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
|
||||||
maskEvent d (keyPressMask .|. buttonPressMask) p
|
maskEvent d keyPressMask p
|
||||||
ev <- getEvent p
|
KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
|
||||||
case ev of
|
|
||||||
KeyEvent { ev_keycode = code, ev_state = m } -> do
|
|
||||||
keysym <- keycodeToKeysym d code 0
|
keysym <- keycodeToKeysym d code 0
|
||||||
if isModifierKey keysym
|
if isModifierKey keysym
|
||||||
then nextkey
|
then nextkey
|
||||||
else return (m, keysym)
|
else return (m, keysym)
|
||||||
_ -> return (0, 0)
|
|
||||||
-- Remove num lock mask and Xkb group state bits
|
-- Remove num lock mask and Xkb group state bits
|
||||||
m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1)
|
m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1)
|
||||||
|
|
||||||
io $ ungrabPointer d currentTime
|
|
||||||
io $ ungrabKeyboard d currentTime
|
io $ ungrabKeyboard d currentTime
|
||||||
io $ sync d False
|
|
||||||
|
|
||||||
fromMaybe (defAction (m', s)) (M.lookup (m', s) keys)
|
fromMaybe (defAction (m', s)) (M.lookup (m', s) keys)
|
||||||
|
@@ -1,403 +0,0 @@
|
|||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : XMonad.Actions.SwapPromote
|
|
||||||
-- Description : Track the master window history per workspace.
|
|
||||||
-- 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 XMonad.Prelude
|
|
||||||
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 Control.Arrow
|
|
||||||
|
|
||||||
|
|
||||||
-- $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)
|
|
||||||
|
|
||||||
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',map snd 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)
|
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.SwapWorkspaces
|
-- Module : XMonad.Actions.SwapWorkspaces
|
||||||
-- Description : Swap workspace tags without having to move individual windows.
|
|
||||||
-- Copyright : (c) Devin Mullins <me@twifkak.com>
|
-- Copyright : (c) Devin Mullins <me@twifkak.com>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -54,13 +53,12 @@ swapWithCurrent t s = swapWorkspaces t (currentTag s) s
|
|||||||
-- | Say @swapTo Next@ or @swapTo Prev@ to move your current workspace.
|
-- | Say @swapTo Next@ or @swapTo Prev@ to move your current workspace.
|
||||||
-- This is an @X ()@ so can be hooked up to your keybindings directly.
|
-- This is an @X ()@ so can be hooked up to your keybindings directly.
|
||||||
swapTo :: Direction1D -> X ()
|
swapTo :: Direction1D -> X ()
|
||||||
swapTo dir = findWorkspace getSortByIndex dir anyWS 1 >>= windows . swapWithCurrent
|
swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurrent
|
||||||
|
|
||||||
-- | Takes two workspace tags and an existing XMonad.StackSet and returns a new
|
-- | Takes two workspace tags and an existing XMonad.StackSet and returns a new
|
||||||
-- one with the two corresponding workspaces' tags swapped.
|
-- one with the two corresponding workspaces' tags swapped.
|
||||||
swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd
|
swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd
|
||||||
swapWorkspaces t1 t2 = mapWorkspace swap
|
swapWorkspaces t1 t2 = mapWorkspace swap
|
||||||
where swap w
|
where swap w = if tag w == t1 then w { tag = t2 }
|
||||||
| tag w == t1 = w { tag = t2 }
|
else if tag w == t2 then w { tag = t1 }
|
||||||
| tag w == t2 = w { tag = t1 }
|
else w
|
||||||
| otherwise = w
|
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.TagWindows
|
-- Module : XMonad.Actions.TagWindows
|
||||||
-- Description : Functions for tagging windows and selecting them by tags.
|
|
||||||
-- Copyright : (c) Karsten Schoelzel <kuser@gmx.de>
|
-- Copyright : (c) Karsten Schoelzel <kuser@gmx.de>
|
||||||
-- License : BSD
|
-- License : BSD
|
||||||
--
|
--
|
||||||
@@ -27,13 +26,15 @@ module XMonad.Actions.TagWindows (
|
|||||||
TagPrompt,
|
TagPrompt,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Data.List (nub,sortBy)
|
||||||
|
import Control.Monad
|
||||||
import Control.Exception as E
|
import Control.Exception as E
|
||||||
|
|
||||||
import XMonad hiding (workspaces)
|
|
||||||
import XMonad.Prelude
|
|
||||||
import XMonad.Prompt
|
|
||||||
import XMonad.StackSet hiding (filter)
|
import XMonad.StackSet hiding (filter)
|
||||||
|
|
||||||
|
import XMonad.Prompt
|
||||||
|
import XMonad hiding (workspaces)
|
||||||
|
|
||||||
econst :: Monad m => a -> IOException -> m a
|
econst :: Monad m => a -> IOException -> m a
|
||||||
econst = const . return
|
econst = const . return
|
||||||
|
|
||||||
@@ -83,17 +84,18 @@ getTags w = withDisplay $ \d ->
|
|||||||
io $ E.catch (internAtom d "_XMONAD_TAGS" False >>=
|
io $ E.catch (internAtom d "_XMONAD_TAGS" False >>=
|
||||||
getTextProperty d w >>=
|
getTextProperty d w >>=
|
||||||
wcTextPropertyToTextList d)
|
wcTextPropertyToTextList d)
|
||||||
(econst [[]]) <&> (words . unwords)
|
(econst [[]])
|
||||||
|
>>= return . words . unwords
|
||||||
|
|
||||||
-- | check a window for the given tag
|
-- | check a window for the given tag
|
||||||
hasTag :: String -> Window -> X Bool
|
hasTag :: String -> Window -> X Bool
|
||||||
hasTag s w = (s `elem`) <$> getTags w
|
hasTag s w = (s `elem`) `fmap` getTags w
|
||||||
|
|
||||||
-- | add a tag to the existing ones
|
-- | add a tag to the existing ones
|
||||||
addTag :: String -> Window -> X ()
|
addTag :: String -> Window -> X ()
|
||||||
addTag s w = do
|
addTag s w = do
|
||||||
tags <- getTags w
|
tags <- getTags w
|
||||||
when (s `notElem` tags) $ setTags (s:tags) w
|
if (s `notElem` tags) then setTags (s:tags) w else return ()
|
||||||
|
|
||||||
-- | remove a tag from a window, if it exists
|
-- | remove a tag from a window, if it exists
|
||||||
delTag :: String -> Window -> X ()
|
delTag :: String -> Window -> X ()
|
||||||
@@ -156,7 +158,7 @@ withTagged' t m = gets windowset >>= filterM (hasTag t) . index >>= m
|
|||||||
|
|
||||||
withTaggedGlobal' :: String -> ([Window] -> X ()) -> X ()
|
withTaggedGlobal' :: String -> ([Window] -> X ()) -> X ()
|
||||||
withTaggedGlobal' t m = gets windowset >>=
|
withTaggedGlobal' t m = gets windowset >>=
|
||||||
filterM (hasTag t) . concatMap (integrate' . stack) . workspaces >>= m
|
filterM (hasTag t) . concat . map (integrate' . stack) . workspaces >>= m
|
||||||
|
|
||||||
withFocusedP :: (Window -> WindowSet -> WindowSet) -> X ()
|
withFocusedP :: (Window -> WindowSet -> WindowSet) -> X ()
|
||||||
withFocusedP f = withFocused $ windows . f
|
withFocusedP f = withFocused $ windows . f
|
||||||
@@ -165,7 +167,7 @@ shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s
|
|||||||
shiftHere w s = shiftWin (currentTag s) w s
|
shiftHere w s = shiftWin (currentTag s) w s
|
||||||
|
|
||||||
shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd
|
shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd
|
||||||
shiftToScreen sid w s = case filter (\m -> sid /= screen m) (current s:visible s) of
|
shiftToScreen sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of
|
||||||
[] -> s
|
[] -> s
|
||||||
(t:_) -> shiftWin (tag . workspace $ t) w s
|
(t:_) -> shiftWin (tag . workspace $ t) w s
|
||||||
|
|
||||||
@@ -178,19 +180,20 @@ instance XPrompt TagPrompt where
|
|||||||
tagPrompt :: XPConfig -> (String -> X ()) -> X ()
|
tagPrompt :: XPConfig -> (String -> X ()) -> X ()
|
||||||
tagPrompt c f = do
|
tagPrompt c f = do
|
||||||
sc <- tagComplList
|
sc <- tagComplList
|
||||||
mkXPrompt TagPrompt c (mkComplFunFromList' c sc) f
|
mkXPrompt TagPrompt c (mkComplFunFromList' sc) f
|
||||||
|
|
||||||
tagComplList :: X [String]
|
tagComplList :: X [String]
|
||||||
tagComplList = gets (concatMap (integrate' . stack) . workspaces . windowset)
|
tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>=
|
||||||
>>= mapM getTags
|
mapM getTags >>=
|
||||||
<&> nub . concat
|
return . nub . concat
|
||||||
|
|
||||||
|
|
||||||
tagDelPrompt :: XPConfig -> X ()
|
tagDelPrompt :: XPConfig -> X ()
|
||||||
tagDelPrompt c = do
|
tagDelPrompt c = do
|
||||||
sc <- tagDelComplList
|
sc <- tagDelComplList
|
||||||
when (sc /= []) $
|
if (sc /= [])
|
||||||
mkXPrompt TagPrompt c (mkComplFunFromList' c sc) (withFocused . delTag)
|
then mkXPrompt TagPrompt c (mkComplFunFromList' sc) (\s -> withFocused (delTag s))
|
||||||
|
else return ()
|
||||||
|
|
||||||
tagDelComplList :: X [String]
|
tagDelComplList :: X [String]
|
||||||
tagDelComplList = gets windowset >>= maybe (return []) getTags . peek
|
tagDelComplList = gets windowset >>= maybe (return []) getTags . peek
|
||||||
|
@@ -1,94 +0,0 @@
|
|||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : XMonad.Actions.TiledWindowDragging
|
|
||||||
-- Description : Change the position of windows by dragging them.
|
|
||||||
-- Copyright : (c) 2020 Leon Kowarschick
|
|
||||||
-- License : BSD3-style (see LICENSE)
|
|
||||||
--
|
|
||||||
-- Maintainer : Leon Kowarschick. <thereal.elkowar@gmail.com>
|
|
||||||
-- Stability : unstable
|
|
||||||
-- Portability : unportable
|
|
||||||
--
|
|
||||||
-- Provides an action that allows you to change the position of windows by dragging them around.
|
|
||||||
--
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
module XMonad.Actions.TiledWindowDragging
|
|
||||||
(
|
|
||||||
-- * Usage
|
|
||||||
-- $usage
|
|
||||||
dragWindow
|
|
||||||
)
|
|
||||||
where
|
|
||||||
|
|
||||||
import XMonad
|
|
||||||
import XMonad.Prelude
|
|
||||||
import qualified XMonad.StackSet as W
|
|
||||||
import XMonad.Layout.DraggingVisualizer
|
|
||||||
|
|
||||||
-- $usage
|
|
||||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
|
||||||
--
|
|
||||||
-- > import XMonad.Actions.TiledWindowDragging
|
|
||||||
-- > import XMonad.Layout.DraggingVisualizer
|
|
||||||
--
|
|
||||||
-- then edit your 'layoutHook' by adding the draggingVisualizer to your layout:
|
|
||||||
--
|
|
||||||
-- > myLayout = draggingVisualizer $ layoutHook def
|
|
||||||
--
|
|
||||||
-- Then add a mouse binding for 'dragWindow':
|
|
||||||
--
|
|
||||||
-- > , ((modMask .|. shiftMask, button1), dragWindow)
|
|
||||||
--
|
|
||||||
-- For detailed instructions on editing your mouse bindings, see
|
|
||||||
-- "XMonad.Doc.Extending#Editing_mouse_bindings".
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
-- | Create a mouse binding for this to be able to drag your windows around.
|
|
||||||
-- You need "XMonad.Layout.DraggingVisualizer" for this to look good.
|
|
||||||
dragWindow :: Window -> X ()
|
|
||||||
dragWindow window = whenX (isClient window) $ do
|
|
||||||
focus window
|
|
||||||
(offsetX, offsetY) <- getPointerOffset window
|
|
||||||
(winX, winY, winWidth, winHeight) <- getWindowPlacement window
|
|
||||||
|
|
||||||
mouseDrag
|
|
||||||
(\posX posY ->
|
|
||||||
let rect = Rectangle (fi (fi winX + (posX - fi offsetX)))
|
|
||||||
(fi (fi winY + (posY - fi offsetY)))
|
|
||||||
(fi winWidth)
|
|
||||||
(fi winHeight)
|
|
||||||
in sendMessage $ DraggingWindow window rect
|
|
||||||
)
|
|
||||||
(sendMessage DraggingStopped >> performWindowSwitching window)
|
|
||||||
|
|
||||||
|
|
||||||
-- | get the pointer offset relative to the given windows root coordinates
|
|
||||||
getPointerOffset :: Window -> X (Int, Int)
|
|
||||||
getPointerOffset win = do
|
|
||||||
(_, _, _, oX, oY, _, _, _) <- withDisplay (\d -> io $ queryPointer d win)
|
|
||||||
return (fi oX, fi oY)
|
|
||||||
|
|
||||||
-- | return a tuple of windowX, windowY, windowWidth, windowHeight
|
|
||||||
getWindowPlacement :: Window -> X (Int, Int, Int, Int)
|
|
||||||
getWindowPlacement window = do
|
|
||||||
wa <- withDisplay (\d -> io $ getWindowAttributes d window)
|
|
||||||
return (fi $ wa_x wa, fi $ wa_y wa, fi $ wa_width wa, fi $ wa_height wa)
|
|
||||||
|
|
||||||
|
|
||||||
performWindowSwitching :: Window -> X ()
|
|
||||||
performWindowSwitching win = do
|
|
||||||
root <- asks theRoot
|
|
||||||
(_, _, selWin, _, _, _, _, _) <- withDisplay (\d -> io $ queryPointer d root)
|
|
||||||
ws <- gets windowset
|
|
||||||
let allWindows = W.index ws
|
|
||||||
when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do
|
|
||||||
let allWindowsSwitched = map (switchEntries win selWin) allWindows
|
|
||||||
let (ls, t : rs) = break (== win) allWindowsSwitched
|
|
||||||
let newStack = W.Stack t (reverse ls) rs
|
|
||||||
windows $ W.modify' $ const newStack
|
|
||||||
where
|
|
||||||
switchEntries a b x | x == a = b
|
|
||||||
| x == b = a
|
|
||||||
| otherwise = x
|
|
@@ -1,8 +1,7 @@
|
|||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.TopicSpace
|
-- Module : XMonad.Actions.TopicSpace
|
||||||
-- Description : Turns your workspaces into a more topic oriented system.
|
|
||||||
-- Copyright : (c) Nicolas Pouillard
|
-- Copyright : (c) Nicolas Pouillard
|
||||||
-- License : BSD-style (see LICENSE)
|
-- License : BSD-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -20,49 +19,21 @@ module XMonad.Actions.TopicSpace
|
|||||||
|
|
||||||
-- * Usage
|
-- * Usage
|
||||||
-- $usage
|
-- $usage
|
||||||
|
|
||||||
-- * Types for Building Topics
|
|
||||||
Topic
|
Topic
|
||||||
, Dir
|
, Dir
|
||||||
, TopicConfig(..)
|
, TopicConfig(..)
|
||||||
, TopicItem(..)
|
, def
|
||||||
|
, defaultTopicConfig
|
||||||
-- * Managing 'TopicItem's
|
, getLastFocusedTopics
|
||||||
, topicNames
|
, setLastFocusedTopic
|
||||||
, tiActions
|
, reverseLastFocusedTopics
|
||||||
, tiDirs
|
, pprWindowSet
|
||||||
, noAction
|
|
||||||
, inHome
|
|
||||||
|
|
||||||
-- * Switching and Shifting Topics
|
|
||||||
, switchTopic
|
|
||||||
, switchNthLastFocused
|
|
||||||
, switchNthLastFocusedByScreen
|
|
||||||
, switchNthLastFocusedExclude
|
|
||||||
, shiftNthLastFocused
|
|
||||||
|
|
||||||
-- * Topic Actions
|
|
||||||
, topicActionWithPrompt
|
, topicActionWithPrompt
|
||||||
, topicAction
|
, topicAction
|
||||||
, currentTopicAction
|
, currentTopicAction
|
||||||
|
, switchTopic
|
||||||
-- * Getting the Topic History
|
, switchNthLastFocused
|
||||||
, getLastFocusedTopics
|
, shiftNthLastFocused
|
||||||
, workspaceHistory
|
|
||||||
, workspaceHistoryByScreen
|
|
||||||
|
|
||||||
-- * Modifying the Topic History
|
|
||||||
, setLastFocusedTopic
|
|
||||||
, reverseLastFocusedTopics
|
|
||||||
|
|
||||||
-- * History hooks
|
|
||||||
, workspaceHistoryHook
|
|
||||||
, workspaceHistoryHookExclude
|
|
||||||
|
|
||||||
-- * Pretty Printing
|
|
||||||
, pprWindowSet
|
|
||||||
|
|
||||||
-- * Utility
|
|
||||||
, currentTopicDir
|
, currentTopicDir
|
||||||
, checkTopicConfig
|
, checkTopicConfig
|
||||||
, (>*>)
|
, (>*>)
|
||||||
@@ -70,26 +41,25 @@ module XMonad.Actions.TopicSpace
|
|||||||
where
|
where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude
|
|
||||||
|
|
||||||
import qualified Data.Map.Strict as M
|
import Data.List
|
||||||
import qualified XMonad.Hooks.StatusBar.PP as SBPP
|
import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust)
|
||||||
|
import Data.Ord
|
||||||
|
import qualified Data.Map as M
|
||||||
|
import Control.Monad (liftM2,when,unless,replicateM_)
|
||||||
|
import System.IO
|
||||||
|
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
import Data.Map (Map)
|
import XMonad.Prompt
|
||||||
|
import XMonad.Prompt.Workspace
|
||||||
|
|
||||||
import XMonad.Prompt (XPConfig)
|
import XMonad.Hooks.UrgencyHook
|
||||||
import XMonad.Prompt.Workspace (workspacePrompt)
|
import XMonad.Hooks.DynamicLog (PP(..))
|
||||||
|
import qualified XMonad.Hooks.DynamicLog as DL
|
||||||
|
|
||||||
import XMonad.Hooks.StatusBar.PP (PP(ppHidden, ppVisible))
|
import XMonad.Util.Run (spawnPipe)
|
||||||
import XMonad.Hooks.UrgencyHook (readUrgents)
|
import qualified XMonad.Util.ExtensibleState as XS
|
||||||
import XMonad.Hooks.WorkspaceHistory
|
|
||||||
( workspaceHistory
|
|
||||||
, workspaceHistoryByScreen
|
|
||||||
, workspaceHistoryHook
|
|
||||||
, workspaceHistoryHookExclude
|
|
||||||
, workspaceHistoryModify
|
|
||||||
)
|
|
||||||
|
|
||||||
-- $overview
|
-- $overview
|
||||||
-- This module allows to organize your workspaces on a precise topic basis. So
|
-- This module allows to organize your workspaces on a precise topic basis. So
|
||||||
@@ -105,128 +75,110 @@ import XMonad.Hooks.WorkspaceHistory
|
|||||||
-- of last focused topics.
|
-- of last focused topics.
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
-- Here is an example of configuration using TopicSpace:
|
||||||
--
|
--
|
||||||
-- > import qualified Data.Map.Strict as M
|
-- > -- The list of all topics/workspaces of your xmonad configuration.
|
||||||
-- > import qualified XMonad.StackSet as W
|
-- > -- The order is important, new topics must be inserted
|
||||||
-- >
|
-- > -- at the end of the list if you want hot-restarting
|
||||||
-- > import XMonad.Actions.TopicSpace
|
-- > -- to work.
|
||||||
-- > import XMonad.Util.EZConfig -- for the keybindings
|
-- > myTopics :: [Topic]
|
||||||
-- > import XMonad.Prompt.Workspace -- if you want to use the prompt
|
-- > myTopics =
|
||||||
--
|
-- > [ "dashboard" -- the first one
|
||||||
-- You will then have to
|
-- > , "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc"
|
||||||
--
|
-- > , "mail", "movie", "music", "talk", "text", "tools", "web", "xmonad"
|
||||||
-- * Define a new 'TopicConfig' via 'TopicItem's
|
-- > , "yi", "documents", "twitter", "pdf"
|
||||||
--
|
|
||||||
-- * Add the appropriate keybindings
|
|
||||||
--
|
|
||||||
-- * Replace the @workspaces@ field in your 'XConfig' with a list of
|
|
||||||
-- your topics names
|
|
||||||
--
|
|
||||||
-- * Optionally, if you want to use the history features, add
|
|
||||||
-- 'workspaceHistoryHook' from "XMonad.Hooks.WorkspaceHistory"
|
|
||||||
-- (re-exported by this module) or an equivalent function to your
|
|
||||||
-- @logHook@. See the documentation of
|
|
||||||
-- "XMonad.Hooks.WorkspaceHistory" for further details
|
|
||||||
--
|
|
||||||
-- Let us go through a full example together.
|
|
||||||
--
|
|
||||||
-- A 'TopicItem' consists of three things: the name of the topic, its
|
|
||||||
-- root directory, and the action associated to it—to be executed if the
|
|
||||||
-- topic is empty or the action is forced via a keybinding.
|
|
||||||
--
|
|
||||||
-- We start by specifying our chosen topics as a list of such
|
|
||||||
-- 'TopicItem's:
|
|
||||||
--
|
|
||||||
-- > topicItems :: [TopicItem]
|
|
||||||
-- > topicItems =
|
|
||||||
-- > [ inHome "1:WEB" (spawn "firefox")
|
|
||||||
-- > , noAction "2" "."
|
|
||||||
-- > , noAction "3:VID" "videos"
|
|
||||||
-- > , TI "4:VPN" "openvpn" (spawn "urxvt -e randomVPN.sh")
|
|
||||||
-- > , inHome "5:IM" (spawn "signal" *> spawn "telegram")
|
|
||||||
-- > , inHome "6:IRC" (spawn "urxvt -e weechat")
|
|
||||||
-- > , TI "dts" ".dotfiles" spawnShell
|
|
||||||
-- > , TI "xm-con" "hs/xm-con" (spawnShell *> spawnShellIn "hs/xm")
|
|
||||||
-- > ]
|
-- > ]
|
||||||
--
|
-- >
|
||||||
-- Then we just need to put together our topic config:
|
|
||||||
--
|
|
||||||
-- > myTopicConfig :: TopicConfig
|
-- > myTopicConfig :: TopicConfig
|
||||||
-- > myTopicConfig = def
|
-- > myTopicConfig = def
|
||||||
-- > { topicDirs = tiDirs topicItems
|
-- > { topicDirs = M.fromList $
|
||||||
-- > , topicActions = tiActions topicItems
|
-- > [ ("conf", "w/conf")
|
||||||
-- > , defaultTopicAction = const (pure ()) -- by default, do nothing
|
-- > , ("dashboard", "Desktop")
|
||||||
-- > , defaultTopic = "1:WEB" -- fallback
|
-- > , ("yi", "w/dev-haskell/yi")
|
||||||
|
-- > , ("darcs", "w/dev-haskell/darcs")
|
||||||
|
-- > , ("haskell", "w/dev-haskell")
|
||||||
|
-- > , ("xmonad", "w/dev-haskell/xmonad")
|
||||||
|
-- > , ("tools", "w/tools")
|
||||||
|
-- > , ("movie", "Movies")
|
||||||
|
-- > , ("talk", "w/talks")
|
||||||
|
-- > , ("music", "Music")
|
||||||
|
-- > , ("documents", "w/documents")
|
||||||
|
-- > , ("pdf", "w/documents")
|
||||||
|
-- > ]
|
||||||
|
-- > , defaultTopicAction = const $ spawnShell >*> 3
|
||||||
|
-- > , defaultTopic = "dashboard"
|
||||||
|
-- > , topicActions = M.fromList $
|
||||||
|
-- > [ ("conf", spawnShell >> spawnShellIn "wd/ertai/private")
|
||||||
|
-- > , ("darcs", spawnShell >*> 3)
|
||||||
|
-- > , ("yi", spawnShell >*> 3)
|
||||||
|
-- > , ("haskell", spawnShell >*> 2 >>
|
||||||
|
-- > spawnShellIn "wd/dev-haskell/ghc")
|
||||||
|
-- > , ("xmonad", spawnShellIn "wd/x11-wm/xmonad" >>
|
||||||
|
-- > spawnShellIn "wd/x11-wm/xmonad/contrib" >>
|
||||||
|
-- > spawnShellIn "wd/x11-wm/xmonad/utils" >>
|
||||||
|
-- > spawnShellIn ".xmonad" >>
|
||||||
|
-- > spawnShellIn ".xmonad")
|
||||||
|
-- > , ("mail", mailAction)
|
||||||
|
-- > , ("irc", ssh somewhere)
|
||||||
|
-- > , ("admin", ssh somewhere >>
|
||||||
|
-- > ssh nowhere)
|
||||||
|
-- > , ("dashboard", spawnShell)
|
||||||
|
-- > , ("twitter", spawnShell)
|
||||||
|
-- > , ("web", spawn browserCmd)
|
||||||
|
-- > , ("movie", spawnShell)
|
||||||
|
-- > , ("documents", spawnShell >*> 2 >>
|
||||||
|
-- > spawnShellIn "Documents" >*> 2)
|
||||||
|
-- > , ("pdf", spawn pdfViewerCmd)
|
||||||
|
-- > ]
|
||||||
-- > }
|
-- > }
|
||||||
--
|
-- >
|
||||||
-- Above, we have used the `spawnShell` and `spawnShellIn` helper
|
-- > -- extend your keybindings
|
||||||
-- functions; here they are:
|
-- > myKeys conf@XConfig{modMask=modm} =
|
||||||
--
|
-- > [ ((modm , xK_n ), spawnShell) -- %! Launch terminal
|
||||||
|
-- > , ((modm , xK_a ), currentTopicAction myTopicConfig)
|
||||||
|
-- > , ((modm , xK_g ), promptedGoto)
|
||||||
|
-- > , ((modm .|. shiftMask, xK_g ), promptedShift)
|
||||||
|
-- > {- more keys ... -}
|
||||||
|
-- > ]
|
||||||
|
-- > ++
|
||||||
|
-- > [ ((modm, k), switchNthLastFocused myTopicConfig i)
|
||||||
|
-- > | (i, k) <- zip [1..] workspaceKeys]
|
||||||
|
-- >
|
||||||
-- > spawnShell :: X ()
|
-- > spawnShell :: X ()
|
||||||
-- > spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
|
-- > spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
|
||||||
-- >
|
-- >
|
||||||
-- > spawnShellIn :: Dir -> X ()
|
-- > spawnShellIn :: Dir -> X ()
|
||||||
-- > spawnShellIn dir = spawn $ "alacritty --working-directory " ++ dir
|
-- > spawnShellIn dir = spawn $ "urxvt '(cd ''" ++ dir ++ "'' && " ++ myShell ++ " )'"
|
||||||
--
|
-- >
|
||||||
-- Next, we define some other other useful helper functions. It is
|
|
||||||
-- rather common to have a lot of topics—much more than available keys!
|
|
||||||
-- In a situation like that, it's very convenient to switch topics with
|
|
||||||
-- a prompt; the following use of 'workspacePrompt' does exactly that.
|
|
||||||
--
|
|
||||||
-- > goto :: Topic -> X ()
|
-- > goto :: Topic -> X ()
|
||||||
-- > goto = switchTopic myTopicConfig
|
-- > goto = switchTopic myTopicConfig
|
||||||
-- >
|
-- >
|
||||||
-- > promptedGoto :: X ()
|
-- > promptedGoto :: X ()
|
||||||
-- > promptedGoto = workspacePrompt def goto
|
-- > promptedGoto = workspacePrompt myXPConfig goto
|
||||||
-- >
|
-- >
|
||||||
-- > promptedShift :: X ()
|
-- > promptedShift :: X ()
|
||||||
-- > promptedShift = workspacePrompt def $ windows . W.shift
|
-- > promptedShift = workspacePrompt myXPConfig $ windows . W.shift
|
||||||
-- >
|
-- >
|
||||||
-- > -- Toggle between the two most recently used topics, but keep
|
-- > myConfig = do
|
||||||
-- > -- screens separate. This needs @workspaceHistoryHook@.
|
-- > checkTopicConfig myTopics myTopicConfig
|
||||||
-- > toggleTopic :: X ()
|
-- > myLogHook <- makeMyLogHook
|
||||||
-- > toggleTopic = switchNthLastFocusedByScreen myTopicConfig 1
|
-- > return $ def
|
||||||
--
|
-- > { borderWidth = 1 -- Width of the window border in pixels.
|
||||||
-- Hopefully you've gotten a general feeling of how to define these kind of
|
-- > , workspaces = myTopics
|
||||||
-- small helper functions using what's provided in this module.
|
-- > , layoutHook = myModifiers myLayout
|
||||||
--
|
-- > , manageHook = myManageHook
|
||||||
-- Adding the appropriate keybindings works as it normally would. Here,
|
-- > , logHook = myLogHook
|
||||||
-- we'll use "XMonad.Util.EZConfig" syntax:
|
-- > , handleEventHook = myHandleEventHook
|
||||||
--
|
-- > , terminal = myTerminal -- The preferred terminal program.
|
||||||
-- > myKeys :: [(String, X ())]
|
-- > , normalBorderColor = "#3f3c6d"
|
||||||
-- > myKeys =
|
-- > , focusedBorderColor = "#4f66ff"
|
||||||
-- > [ ("M-n" , spawnShell)
|
-- > , XMonad.modMask = mod1Mask
|
||||||
-- > , ("M-a" , currentTopicAction myTopicConfig)
|
-- > , keys = myKeys
|
||||||
-- > , ("M-g" , promptedGoto)
|
-- > , mouseBindings = myMouseBindings
|
||||||
-- > , ("M-S-g" , promptedShift)
|
|
||||||
-- > , ("M-S-<Space>", toggleTopic)
|
|
||||||
-- > ]
|
|
||||||
-- > ++
|
|
||||||
-- > -- The following does two things:
|
|
||||||
-- > -- 1. Switch topics (no modifier)
|
|
||||||
-- > -- 2. Move focused window to topic N (shift modifier)
|
|
||||||
-- > [ ("M-" ++ m ++ k, f i)
|
|
||||||
-- > | (i, k) <- zip (topicNames topicItems) (map show [1 .. 9 :: Int])
|
|
||||||
-- > , (f, m) <- [(goto, ""), (windows . W.shift, "S-")]
|
|
||||||
-- > ]
|
|
||||||
--
|
|
||||||
-- This makes @M-1@ to @M-9@ switch to the first nine topics that we
|
|
||||||
-- have specified in @topicItems@.
|
|
||||||
--
|
|
||||||
-- You can also switch to the nine last-used topics instead:
|
|
||||||
--
|
|
||||||
-- > [ ("M-" ++ show i, switchNthLastFocused myTopicConfig i)
|
|
||||||
-- > | i <- [1 .. 9]
|
|
||||||
-- > ]
|
|
||||||
--
|
|
||||||
-- We can now put the whole configuration together with the following:
|
|
||||||
--
|
|
||||||
-- > main :: IO ()
|
|
||||||
-- > main = xmonad $ def
|
|
||||||
-- > { workspaces = topicNames topicItems
|
|
||||||
-- > }
|
-- > }
|
||||||
-- > `additionalKeysP` myKeys
|
-- >
|
||||||
|
-- > main :: IO ()
|
||||||
|
-- > main = xmonad =<< myConfig
|
||||||
|
|
||||||
-- | An alias for @flip replicateM_@
|
-- | An alias for @flip replicateM_@
|
||||||
(>*>) :: Monad m => m a -> Int -> m ()
|
(>*>) :: Monad m => m a -> Int -> m ()
|
||||||
@@ -236,25 +188,24 @@ infix >*>
|
|||||||
-- | 'Topic' is just an alias for 'WorkspaceId'
|
-- | 'Topic' is just an alias for 'WorkspaceId'
|
||||||
type Topic = WorkspaceId
|
type Topic = WorkspaceId
|
||||||
|
|
||||||
-- | 'Dir' is just an alias for 'FilePath', but should point to a directory.
|
-- | 'Dir' is just an alias for 'FilePath' but should points to a directory.
|
||||||
type Dir = FilePath
|
type Dir = FilePath
|
||||||
|
|
||||||
-- | Here is the topic space configuration area.
|
-- | Here is the topic space configuration area.
|
||||||
data TopicConfig = TopicConfig { topicDirs :: Map Topic Dir
|
data TopicConfig = TopicConfig { topicDirs :: M.Map Topic Dir
|
||||||
-- ^ This mapping associates a directory to each topic.
|
-- ^ This mapping associate a directory to each topic.
|
||||||
, topicActions :: Map Topic (X ())
|
, topicActions :: M.Map Topic (X ())
|
||||||
-- ^ This mapping associates an action to trigger when
|
-- ^ This mapping associate an action to trigger when
|
||||||
-- switching to a given topic which workspace is empty.
|
-- switching to a given topic which workspace is empty.
|
||||||
, defaultTopicAction :: Topic -> X ()
|
, defaultTopicAction :: Topic -> X ()
|
||||||
-- ^ This is the default topic action.
|
-- ^ This is the default topic action.
|
||||||
, defaultTopic :: Topic
|
, defaultTopic :: Topic
|
||||||
-- ^ This is the default (= fallback) topic.
|
-- ^ This is the default topic.
|
||||||
, maxTopicHistory :: Int
|
, maxTopicHistory :: Int
|
||||||
-- ^ This specifies the maximum depth of the topic history;
|
-- ^ This setups the maximum depth of topic history, usually
|
||||||
-- usually 10 is a good default since we can bind all of
|
-- 10 is a good default since we can bind all of them using
|
||||||
-- them using numeric keypad.
|
-- numeric keypad.
|
||||||
}
|
}
|
||||||
{-# DEPRECATED maxTopicHistory "This field will be removed in the future; history is now handled by XMonad.Hooks.WorkspaceHistory" #-}
|
|
||||||
|
|
||||||
instance Default TopicConfig where
|
instance Default TopicConfig where
|
||||||
def = TopicConfig { topicDirs = M.empty
|
def = TopicConfig { topicDirs = M.empty
|
||||||
@@ -264,51 +215,58 @@ instance Default TopicConfig where
|
|||||||
, maxTopicHistory = 10
|
, maxTopicHistory = 10
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Return the (possibly empty) list of last focused topics.
|
{-# DEPRECATED defaultTopicConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.TopicSpace) instead." #-}
|
||||||
getLastFocusedTopics :: X [Topic]
|
defaultTopicConfig :: TopicConfig
|
||||||
getLastFocusedTopics = workspaceHistory
|
defaultTopicConfig = def
|
||||||
{-# DEPRECATED getLastFocusedTopics "Use XMonad.Hooks.WorkspaceHistory.workspaceHistory (re-exported by this module) instead" #-}
|
|
||||||
|
|
||||||
-- | Given a 'TopicConfig', a topic, and a predicate to select topics that one
|
newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable)
|
||||||
-- wants to keep, this function will cons the topic in front of the list of
|
instance ExtensionClass PrevTopics where
|
||||||
-- last focused topics and filter it according to the predicate. Note that we
|
initialValue = PrevTopics []
|
||||||
-- prune the list in case that its length exceeds 'maxTopicHistory'.
|
extensionType = PersistentExtension
|
||||||
setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()
|
|
||||||
setLastFocusedTopic tc w predicate = do
|
-- | Returns the list of last focused workspaces the empty list otherwise.
|
||||||
sid <- gets $ W.screen . W.current . windowset
|
getLastFocusedTopics :: X [String]
|
||||||
workspaceHistoryModify $
|
getLastFocusedTopics = XS.gets getPrevTopics
|
||||||
take (maxTopicHistory tc) . nub . filter (predicate . snd) . ((sid, w) :)
|
|
||||||
{-# DEPRECATED setLastFocusedTopic "Use XMonad.Hooks.WorkspaceHistory instead" #-}
|
-- | Given a 'TopicConfig', the last focused topic, and a predicate that will
|
||||||
|
-- select topics that one want to keep, this function will set the property
|
||||||
|
-- of last focused topics.
|
||||||
|
setLastFocusedTopic :: Topic -> (Topic -> Bool) -> X ()
|
||||||
|
setLastFocusedTopic w predicate =
|
||||||
|
XS.modify $ PrevTopics
|
||||||
|
. seqList . nub . (w:) . filter predicate
|
||||||
|
. getPrevTopics
|
||||||
|
where seqList xs = length xs `seq` xs
|
||||||
|
|
||||||
-- | Reverse the list of "last focused topics"
|
-- | Reverse the list of "last focused topics"
|
||||||
reverseLastFocusedTopics :: X ()
|
reverseLastFocusedTopics :: X ()
|
||||||
reverseLastFocusedTopics = workspaceHistoryModify reverse
|
reverseLastFocusedTopics =
|
||||||
|
XS.modify $ PrevTopics . reverse . getPrevTopics
|
||||||
|
|
||||||
-- | This function is a variant of 'SBPP.pprWindowSet' which takes a topic
|
-- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration
|
||||||
-- configuration and a pretty-printing record 'PP'. It will show the list of
|
-- and a pretty-printing record 'PP'. It will show the list of topics sorted historically
|
||||||
-- topics sorted historically and highlight topics with urgent windows.
|
-- and highlighting topics with urgent windows.
|
||||||
pprWindowSet :: TopicConfig -> PP -> X String
|
pprWindowSet :: TopicConfig -> PP -> X String
|
||||||
pprWindowSet tg pp = do
|
pprWindowSet tg pp = do
|
||||||
winset <- gets windowset
|
winset <- gets windowset
|
||||||
urgents <- readUrgents
|
urgents <- readUrgents
|
||||||
let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
|
let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
|
||||||
maxDepth = maxTopicHistory tg
|
maxDepth = maxTopicHistory tg
|
||||||
setLastFocusedTopic tg
|
setLastFocusedTopic (W.tag . W.workspace . W.current $ winset)
|
||||||
(W.tag . W.workspace . W.current $ winset)
|
|
||||||
(`notElem` empty_workspaces)
|
(`notElem` empty_workspaces)
|
||||||
lastWs <- workspaceHistory
|
lastWs <- getLastFocusedTopics
|
||||||
let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])
|
let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])
|
||||||
add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
|
add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
|
||||||
pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
|
pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
|
||||||
sortWindows = take maxDepth . sortOn (depth . W.tag)
|
sortWindows = take maxDepth . sortBy (comparing $ depth . W.tag)
|
||||||
return $ SBPP.pprWindowSet sortWindows urgents pp' winset
|
return $ DL.pprWindowSet sortWindows urgents pp' winset
|
||||||
|
|
||||||
-- | Given a prompt configuration and a topic configuration, trigger the action associated with
|
-- | Given a prompt configuration and a topic configuration, triggers the action associated with
|
||||||
-- the topic given in prompt.
|
-- the topic given in prompt.
|
||||||
topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()
|
topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()
|
||||||
topicActionWithPrompt xp tg = workspacePrompt xp (liftA2 (>>) (switchTopic tg) (topicAction tg))
|
topicActionWithPrompt xp tg = workspacePrompt xp (liftM2 (>>) (switchTopic tg) (topicAction tg))
|
||||||
|
|
||||||
-- | Given a configuration and a topic, trigger the action associated with the given topic.
|
-- | Given a configuration and a topic, triggers the action associated with the given topic.
|
||||||
topicAction :: TopicConfig -> Topic -> X ()
|
topicAction :: TopicConfig -> Topic -> X ()
|
||||||
topicAction tg topic = fromMaybe (defaultTopicAction tg topic) $ M.lookup topic $ topicActions tg
|
topicAction tg topic = fromMaybe (defaultTopicAction tg topic) $ M.lookup topic $ topicActions tg
|
||||||
|
|
||||||
@@ -318,56 +276,30 @@ currentTopicAction tg = topicAction tg =<< gets (W.tag . W.workspace . W.current
|
|||||||
|
|
||||||
-- | Switch to the given topic.
|
-- | Switch to the given topic.
|
||||||
switchTopic :: TopicConfig -> Topic -> X ()
|
switchTopic :: TopicConfig -> Topic -> X ()
|
||||||
switchTopic tc topic = do
|
switchTopic tg topic = do
|
||||||
-- Switch to topic and add it to the last seen topics
|
|
||||||
windows $ W.greedyView topic
|
windows $ W.greedyView topic
|
||||||
|
|
||||||
-- If applicable, execute the topic action
|
|
||||||
wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)
|
wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)
|
||||||
when (null wins) $ topicAction tc topic
|
when (null wins) $ topicAction tg topic
|
||||||
|
|
||||||
-- | Switch to the Nth last focused topic or fall back to the 'defaultTopic'.
|
-- | Switch to the Nth last focused topic or failback to the 'defaultTopic'.
|
||||||
switchNthLastFocused :: TopicConfig -> Int -> X ()
|
switchNthLastFocused :: TopicConfig -> Int -> X ()
|
||||||
switchNthLastFocused = switchNthLastFocusedExclude []
|
switchNthLastFocused tg depth = do
|
||||||
|
lastWs <- getLastFocusedTopics
|
||||||
|
switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth
|
||||||
|
|
||||||
-- | Like 'switchNthLastFocused', but also filter out certain topics.
|
-- | Shift the focused window to the Nth last focused topic, or fallback to doing nothing.
|
||||||
switchNthLastFocusedExclude :: [Topic] -> TopicConfig -> Int -> X ()
|
|
||||||
switchNthLastFocusedExclude excludes tc depth = do
|
|
||||||
lastWs <- filter (`notElem` excludes) <$> workspaceHistory
|
|
||||||
switchTopic tc $ (lastWs ++ repeat (defaultTopic tc)) !! depth
|
|
||||||
|
|
||||||
-- | Like 'switchNthLastFocused', but only consider topics that used to
|
|
||||||
-- be on the current screen.
|
|
||||||
--
|
|
||||||
-- For example, the following function allows one to toggle between the
|
|
||||||
-- currently focused and the last used topic, while treating different
|
|
||||||
-- screens completely independently from one another.
|
|
||||||
--
|
|
||||||
-- > toggleTopicScreen = switchNthLastFocusedByScreen myTopicConfig 1
|
|
||||||
switchNthLastFocusedByScreen :: TopicConfig -> Int -> X ()
|
|
||||||
switchNthLastFocusedByScreen tc depth = do
|
|
||||||
sid <- gets $ W.screen . W.current . windowset
|
|
||||||
sws <- fromMaybe []
|
|
||||||
. listToMaybe
|
|
||||||
. map snd
|
|
||||||
. filter ((== sid) . fst)
|
|
||||||
<$> workspaceHistoryByScreen
|
|
||||||
switchTopic tc $ (sws ++ repeat (defaultTopic tc)) !! depth
|
|
||||||
|
|
||||||
-- | Shift the focused window to the Nth last focused topic, or fall back to doing nothing.
|
|
||||||
shiftNthLastFocused :: Int -> X ()
|
shiftNthLastFocused :: Int -> X ()
|
||||||
shiftNthLastFocused n = do
|
shiftNthLastFocused n = do
|
||||||
ws <- fmap (listToMaybe . drop n) workspaceHistory
|
ws <- fmap (listToMaybe . drop n) getLastFocusedTopics
|
||||||
whenJust ws $ windows . W.shift
|
whenJust ws $ windows . W.shift
|
||||||
|
|
||||||
-- | Return the directory associated with the current topic, or return the empty
|
-- | Returns the directory associated with current topic returns the empty string otherwise.
|
||||||
-- string if the topic could not be found.
|
currentTopicDir :: TopicConfig -> X String
|
||||||
currentTopicDir :: TopicConfig -> X FilePath
|
|
||||||
currentTopicDir tg = do
|
currentTopicDir tg = do
|
||||||
topic <- gets (W.tag . W.workspace . W.current . windowset)
|
topic <- gets (W.tag . W.workspace . W.current . windowset)
|
||||||
return . fromMaybe "" . M.lookup topic $ topicDirs tg
|
return . fromMaybe "" . M.lookup topic $ topicDirs tg
|
||||||
|
|
||||||
-- | Check the given topic configuration for duplicate or undefined topics.
|
-- | Check the given topic configuration for duplicates topics or undefined topics.
|
||||||
checkTopicConfig :: [Topic] -> TopicConfig -> IO ()
|
checkTopicConfig :: [Topic] -> TopicConfig -> IO ()
|
||||||
checkTopicConfig tags tg = do
|
checkTopicConfig tags tg = do
|
||||||
-- tags <- gets $ map W.tag . workspaces . windowset
|
-- tags <- gets $ map W.tag . workspaces . windowset
|
||||||
@@ -381,31 +313,9 @@ checkTopicConfig tags tg = do
|
|||||||
check diffTopic "Seen but missing topics/workspaces"
|
check diffTopic "Seen but missing topics/workspaces"
|
||||||
check dups "Duplicate topics/workspaces"
|
check dups "Duplicate topics/workspaces"
|
||||||
|
|
||||||
-- | Convenience type for specifying topics.
|
-- | Display the given message using the @xmessage@ program.
|
||||||
data TopicItem = TI
|
xmessage :: String -> IO ()
|
||||||
{ tiName :: !Topic -- ^ 'Topic' ≡ 'String'
|
xmessage s = do
|
||||||
, tiDir :: !Dir -- ^ Directory associated with topic; 'Dir' ≡ 'String'
|
h <- spawnPipe "xmessage -file -"
|
||||||
, tiAction :: !(X ()) -- ^ Startup hook when topic is empty
|
hPutStr h s
|
||||||
}
|
hClose h
|
||||||
|
|
||||||
-- | Extract the names from a given list of 'TopicItem's.
|
|
||||||
topicNames :: [TopicItem] -> [Topic]
|
|
||||||
topicNames = map tiName
|
|
||||||
|
|
||||||
-- | From a list of 'TopicItem's, build a map that can be supplied as
|
|
||||||
-- the 'topicDirs'.
|
|
||||||
tiDirs :: [TopicItem] -> Map Topic Dir
|
|
||||||
tiDirs = M.fromList . map (\TI{ tiName, tiDir } -> (tiName, tiDir))
|
|
||||||
|
|
||||||
-- | From a list of 'TopicItem's, build a map that can be supplied as
|
|
||||||
-- the 'topicActions'.
|
|
||||||
tiActions :: [TopicItem] -> Map Topic (X ())
|
|
||||||
tiActions = M.fromList . map (\TI{ tiName, tiAction } -> (tiName, tiAction))
|
|
||||||
|
|
||||||
-- | Associate a directory with the topic, but don't spawn anything.
|
|
||||||
noAction :: Topic -> Dir -> TopicItem
|
|
||||||
noAction n d = TI n d (pure ())
|
|
||||||
|
|
||||||
-- | Topic with @tiDir = ~/@.
|
|
||||||
inHome :: Topic -> X () -> TopicItem
|
|
||||||
inHome n = TI n "."
|
|
||||||
|
@@ -1,12 +1,9 @@
|
|||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE MultiWayIf #-}
|
|
||||||
{-# LANGUAGE LambdaCase #-}
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.TreeSelect
|
-- Module : XMonad.Actions.TreeSelect
|
||||||
-- Description : Display workspaces or actions in a tree-like format.
|
|
||||||
-- Copyright : (c) Tom Smeets <tom.tsmeets@gmail.com>
|
-- Copyright : (c) Tom Smeets <tom.tsmeets@gmail.com>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -42,7 +39,6 @@ module XMonad.Actions.TreeSelect
|
|||||||
|
|
||||||
, TSConfig(..)
|
, TSConfig(..)
|
||||||
, tsDefaultConfig
|
, tsDefaultConfig
|
||||||
, def
|
|
||||||
|
|
||||||
-- * Navigation
|
-- * Navigation
|
||||||
-- $navigation
|
-- $navigation
|
||||||
@@ -64,13 +60,16 @@ module XMonad.Actions.TreeSelect
|
|||||||
, treeselectAt
|
, treeselectAt
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Applicative
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
import Data.List (find)
|
||||||
|
import Data.Maybe
|
||||||
import Data.Tree
|
import Data.Tree
|
||||||
import Foreign (shiftL, shiftR, (.&.))
|
import Foreign
|
||||||
import System.IO
|
import System.IO
|
||||||
|
import System.Posix.Process (forkProcess, executeFile)
|
||||||
import XMonad hiding (liftX)
|
import XMonad hiding (liftX)
|
||||||
import XMonad.Prelude
|
|
||||||
import XMonad.StackSet as W
|
import XMonad.StackSet as W
|
||||||
import XMonad.Util.Font
|
import XMonad.Util.Font
|
||||||
import XMonad.Util.NamedWindows
|
import XMonad.Util.NamedWindows
|
||||||
@@ -114,7 +113,7 @@ import Graphics.X11.Xrender
|
|||||||
--
|
--
|
||||||
-- Optionally, if you add 'workspaceHistoryHook' to your 'logHook' you can use the \'o\' and \'i\' keys to select from previously-visited workspaces
|
-- Optionally, if you add 'workspaceHistoryHook' to your 'logHook' you can use the \'o\' and \'i\' keys to select from previously-visited workspaces
|
||||||
--
|
--
|
||||||
-- > xmonad $ def { ...
|
-- > xmonad $ defaultConfig { ...
|
||||||
-- > , workspaces = toWorkspaces myWorkspaces
|
-- > , workspaces = toWorkspaces myWorkspaces
|
||||||
-- > , logHook = workspaceHistoryHook
|
-- > , logHook = workspaceHistoryHook
|
||||||
-- > }
|
-- > }
|
||||||
@@ -132,9 +131,9 @@ import Graphics.X11.Xrender
|
|||||||
-- $config
|
-- $config
|
||||||
-- The selection menu is very configurable, you can change the font, all colors and the sizes of the boxes.
|
-- The selection menu is very configurable, you can change the font, all colors and the sizes of the boxes.
|
||||||
--
|
--
|
||||||
-- The default config defined as 'def'
|
-- The default config defined as 'tsDefaultConfig'
|
||||||
--
|
--
|
||||||
-- > def = TSConfig { ts_hidechildren = True
|
-- > tsDefaultConfig = TSConfig { ts_hidechildren = True
|
||||||
-- > , ts_background = 0xc0c0c0c0
|
-- > , ts_background = 0xc0c0c0c0
|
||||||
-- > , ts_font = "xft:Sans-16"
|
-- > , ts_font = "xft:Sans-16"
|
||||||
-- > , ts_node = (0xff000000, 0xff50d0db)
|
-- > , ts_node = (0xff000000, 0xff50d0db)
|
||||||
@@ -161,8 +160,8 @@ import Graphics.X11.Xrender
|
|||||||
-- white = 0xffffffff
|
-- white = 0xffffffff
|
||||||
-- black = 0xff000000
|
-- black = 0xff000000
|
||||||
-- red = 0xffff0000
|
-- red = 0xffff0000
|
||||||
-- green = 0xff00ff00
|
-- blue = 0xff00ff00
|
||||||
-- blue = 0xff0000ff
|
-- green = 0xff0000ff
|
||||||
-- transparent = 0x00000000
|
-- transparent = 0x00000000
|
||||||
-- @
|
-- @
|
||||||
|
|
||||||
@@ -259,7 +258,6 @@ defaultNavigation = M.fromList
|
|||||||
-- Using nice alternating blue nodes
|
-- Using nice alternating blue nodes
|
||||||
tsDefaultConfig :: TSConfig a
|
tsDefaultConfig :: TSConfig a
|
||||||
tsDefaultConfig = def
|
tsDefaultConfig = def
|
||||||
{-# DEPRECATED tsDefaultConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.TreeSelect) instead." #-}
|
|
||||||
|
|
||||||
-- | Tree Node With a name and extra text
|
-- | Tree Node With a name and extra text
|
||||||
data TSNode a = TSNode { tsn_name :: String
|
data TSNode a = TSNode { tsn_name :: String
|
||||||
@@ -318,9 +316,7 @@ treeselectAt conf@TSConfig{..} zipper hist = withDisplay $ \display -> do
|
|||||||
set_colormap attributes colormap
|
set_colormap attributes colormap
|
||||||
set_background_pixel attributes ts_background
|
set_background_pixel attributes ts_background
|
||||||
set_border_pixel attributes 0
|
set_border_pixel attributes 0
|
||||||
w <- createWindow display rootw rect_x rect_y rect_width rect_height 0 (visualInfo_depth vinfo) inputOutput (visualInfo_visual vinfo) (cWColormap .|. cWBorderPixel .|. cWBackPixel) attributes
|
createWindow display rootw rect_x rect_y rect_width rect_height 0 (visualInfo_depth vinfo) inputOutput (visualInfo_visual vinfo) (cWColormap .|. cWBorderPixel .|. cWBackPixel) attributes
|
||||||
setClassHint display w (ClassHint "xmonad-tree_select" "xmonad")
|
|
||||||
pure w
|
|
||||||
|
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
-- TODO: move below?
|
-- TODO: move below?
|
||||||
@@ -409,7 +405,7 @@ treeselectWorkspace c xs f = do
|
|||||||
, "XConfig.workspaces: "
|
, "XConfig.workspaces: "
|
||||||
] ++ map tag ws
|
] ++ map tag ws
|
||||||
hPutStrLn stderr msg
|
hPutStrLn stderr msg
|
||||||
xmessage msg
|
_ <- forkProcess $ executeFile "xmessage" True [msg] Nothing
|
||||||
return ()
|
return ()
|
||||||
where
|
where
|
||||||
mkNode n w = do
|
mkNode n w = do
|
||||||
@@ -452,8 +448,8 @@ splitPath i = case break (== '.') i of
|
|||||||
-- > ]
|
-- > ]
|
||||||
-- > ]
|
-- > ]
|
||||||
treeselectAction :: TSConfig (X a) -> Forest (TSNode (X a)) -> X ()
|
treeselectAction :: TSConfig (X a) -> Forest (TSNode (X a)) -> X ()
|
||||||
treeselectAction c xs = treeselect c xs >>= \case
|
treeselectAction c xs = treeselect c xs >>= \x -> case x of
|
||||||
Just a -> void a
|
Just a -> a >> return ()
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
|
|
||||||
forMForest :: (Functor m, Applicative m, Monad m) => [Tree a] -> (a -> m b) -> m [Tree b]
|
forMForest :: (Functor m, Applicative m, Monad m) => [Tree a] -> (a -> m b) -> m [Tree b]
|
||||||
@@ -465,7 +461,7 @@ mapMTree f (Node x xs) = Node <$> f x <*> mapM (mapMTree f) xs
|
|||||||
|
|
||||||
-- | Quit returning the currently selected node
|
-- | Quit returning the currently selected node
|
||||||
select :: TreeSelect a (Maybe a)
|
select :: TreeSelect a (Maybe a)
|
||||||
select = gets (Just . (tsn_value . cursor . tss_tree))
|
select = Just <$> gets (tsn_value . cursor . tss_tree)
|
||||||
|
|
||||||
-- | Quit without returning anything
|
-- | Quit without returning anything
|
||||||
cancel :: TreeSelect a (Maybe a)
|
cancel :: TreeSelect a (Maybe a)
|
||||||
@@ -527,21 +523,18 @@ moveWith f = do
|
|||||||
-- | wait for keys and run navigation
|
-- | wait for keys and run navigation
|
||||||
navigate :: TreeSelect a (Maybe a)
|
navigate :: TreeSelect a (Maybe a)
|
||||||
navigate = gets tss_display >>= \d -> join . liftIO . allocaXEvent $ \e -> do
|
navigate = gets tss_display >>= \d -> join . liftIO . allocaXEvent $ \e -> do
|
||||||
maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask .|. buttonPressMask) e
|
maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e
|
||||||
|
|
||||||
ev <- getEvent e
|
ev <- getEvent e
|
||||||
|
|
||||||
if | ev_event_type ev == keyPress -> do
|
if ev_event_type ev == keyPress
|
||||||
|
then do
|
||||||
(ks, _) <- lookupString $ asKeyEvent e
|
(ks, _) <- lookupString $ asKeyEvent e
|
||||||
return $ do
|
return $ do
|
||||||
mask <- liftX $ cleanMask (ev_state ev)
|
mask <- liftX $ cleanMask (ev_state ev)
|
||||||
f <- asks ts_navigate
|
f <- asks ts_navigate
|
||||||
fromMaybe navigate $ M.lookup (mask, fromMaybe xK_VoidSymbol ks) f
|
fromMaybe navigate $ M.lookup (mask, fromMaybe xK_VoidSymbol ks) f
|
||||||
| ev_event_type ev == buttonPress -> do
|
else return navigate
|
||||||
-- See XMonad.Prompt Note [Allow ButtonEvents]
|
|
||||||
allowEvents d replayPointer currentTime
|
|
||||||
return navigate
|
|
||||||
| otherwise -> return navigate
|
|
||||||
|
|
||||||
-- | Request a full redraw
|
-- | Request a full redraw
|
||||||
redraw :: TreeSelect a ()
|
redraw :: TreeSelect a ()
|
||||||
@@ -606,7 +599,7 @@ drawNode ix iy TSNode{..} col = do
|
|||||||
colormap <- gets tss_colormap
|
colormap <- gets tss_colormap
|
||||||
visual <- gets tss_visual
|
visual <- gets tss_visual
|
||||||
liftIO $ drawWinBox window display visual colormap gc font col tsn_name ts_extra tsn_extra
|
liftIO $ drawWinBox window display visual colormap gc font col tsn_name ts_extra tsn_extra
|
||||||
(ix * ts_indent + ts_originX) (iy * ts_node_height + ts_originY)
|
(ix * ts_indent) (iy * ts_node_height)
|
||||||
ts_node_width ts_node_height
|
ts_node_width ts_node_height
|
||||||
|
|
||||||
-- TODO: draw extra text (transparent background? or ts_background)
|
-- TODO: draw extra text (transparent background? or ts_background)
|
||||||
@@ -657,16 +650,8 @@ drawStringXMF display window visual colormap gc font col x y text = case font of
|
|||||||
--
|
--
|
||||||
-- Note that it uses short to represent its components
|
-- Note that it uses short to represent its components
|
||||||
fromARGB :: Pixel -> XRenderColor
|
fromARGB :: Pixel -> XRenderColor
|
||||||
fromARGB x =
|
fromARGB x = XRenderColor (fromIntegral $ 0xff00 .&. shiftR x 8) -- red
|
||||||
#if MIN_VERSION_X11_xft(0, 3, 3)
|
(fromIntegral $ 0xff00 .&. x) -- green
|
||||||
XRenderColor r g b a
|
(fromIntegral $ 0xff00 .&. shiftL x 8) -- blue
|
||||||
#else
|
(fromIntegral $ 0xff00 .&. shiftR x 16) -- alpha
|
||||||
-- swapped green/blue as a workaround for the faulty Storable instance in X11-xft < 0.3.3
|
|
||||||
XRenderColor r b g a
|
|
||||||
#endif
|
|
||||||
where
|
|
||||||
r = fromIntegral $ 0xff00 .&. shiftR x 8
|
|
||||||
g = fromIntegral $ 0xff00 .&. x
|
|
||||||
b = fromIntegral $ 0xff00 .&. shiftL x 8
|
|
||||||
a = fromIntegral $ 0xff00 .&. shiftR x 16
|
|
||||||
#endif
|
#endif
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.UpdateFocus
|
-- Module : XMonad.Actions.UpdateFocus
|
||||||
-- Description : Updates the focus on mouse move in unfocused windows.
|
|
||||||
-- Copyright : (c) Daniel Schoepe
|
-- Copyright : (c) Daniel Schoepe
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -17,13 +16,13 @@ module XMonad.Actions.UpdateFocus (
|
|||||||
-- * Usage
|
-- * Usage
|
||||||
-- $usage
|
-- $usage
|
||||||
focusOnMouseMove,
|
focusOnMouseMove,
|
||||||
adjustEventInput,
|
adjustEventInput
|
||||||
focusUnderPointer,
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude
|
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
|
import Control.Monad (when)
|
||||||
|
import Data.Monoid
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- To make the focus update on mouse movement within an unfocused window, add the
|
-- To make the focus update on mouse movement within an unfocused window, add the
|
||||||
@@ -41,7 +40,7 @@ import qualified XMonad.StackSet as W
|
|||||||
|
|
||||||
-- | Changes the focus if the mouse is moved within an unfocused window.
|
-- | Changes the focus if the mouse is moved within an unfocused window.
|
||||||
focusOnMouseMove :: Event -> X All
|
focusOnMouseMove :: Event -> X All
|
||||||
focusOnMouseMove MotionEvent{ ev_x = x, ev_y = y, ev_window = root } = do
|
focusOnMouseMove (MotionEvent { ev_x = x, ev_y = y, ev_window = root }) = do
|
||||||
-- check only every 15 px to avoid excessive calls to translateCoordinates
|
-- check only every 15 px to avoid excessive calls to translateCoordinates
|
||||||
when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do
|
when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do
|
||||||
dpy <- asks display
|
dpy <- asks display
|
||||||
@@ -59,25 +58,3 @@ adjustEventInput = withDisplay $ \dpy -> do
|
|||||||
io $ selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask
|
io $ selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask
|
||||||
.|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
|
.|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
|
||||||
.|. buttonPressMask .|. pointerMotionMask
|
.|. buttonPressMask .|. pointerMotionMask
|
||||||
|
|
||||||
-- | Focus the window under the mouse pointer, unless we're currently changing
|
|
||||||
-- focus with the mouse or dragging. This is the inverse to
|
|
||||||
-- "XMonad.Actions.UpdatePointer": instead of moving the mouse pointer to
|
|
||||||
-- match the focus, we change the focus to match the mouse pointer.
|
|
||||||
--
|
|
||||||
-- This is meant to be used together with
|
|
||||||
-- 'XMonad.Actions.UpdatePointer.updatePointer' in individual key bindings.
|
|
||||||
-- Bindings that change focus should invoke
|
|
||||||
-- 'XMonad.Actions.UpdatePointer.updatePointer' at the end, bindings that
|
|
||||||
-- switch workspaces or change layouts should call 'focusUnderPointer' at the
|
|
||||||
-- end. Neither should go to 'logHook', as that would override the other.
|
|
||||||
--
|
|
||||||
-- This is more finicky to set up than 'focusOnMouseMove', but ensures that
|
|
||||||
-- focus is updated immediately, without having to touch the mouse.
|
|
||||||
focusUnderPointer :: X ()
|
|
||||||
focusUnderPointer = whenX (not <$> (asks mouseFocused <||> gets (isJust . dragging))) $ do
|
|
||||||
dpy <- asks display
|
|
||||||
root <- asks theRoot
|
|
||||||
(_, _, w', _, _, _, _, _) <- io $ queryPointer dpy root
|
|
||||||
w <- gets (W.peek . windowset)
|
|
||||||
when (w' /= none && Just w' /= w) (focus w')
|
|
||||||
|
@@ -1,9 +1,7 @@
|
|||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonadContrib.UpdatePointer
|
-- Module : XMonadContrib.UpdatePointer
|
||||||
-- Description : Causes the pointer to follow whichever window focus changes to.
|
-- Copyright : (c) Robert Marlow <robreim@bobturf.org>
|
||||||
-- Copyright : (c) Robert Marlow <robreim@bobturf.org>, 2015 Evgeny Kurnevsky
|
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
-- Maintainer : Robert Marlow <robreim@bobturf.org>
|
-- Maintainer : Robert Marlow <robreim@bobturf.org>
|
||||||
@@ -25,11 +23,11 @@ module XMonad.Actions.UpdatePointer
|
|||||||
where
|
where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude
|
import XMonad.Util.XUtils (fi)
|
||||||
|
import Control.Arrow
|
||||||
|
import Control.Monad
|
||||||
import XMonad.StackSet (member, peek, screenDetail, current)
|
import XMonad.StackSet (member, peek, screenDetail, current)
|
||||||
|
import Data.Maybe
|
||||||
import Control.Exception (SomeException, try)
|
|
||||||
import Control.Arrow ((&&&), (***))
|
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||||
@@ -61,22 +59,13 @@ import Control.Arrow ((&&&), (***))
|
|||||||
-- | Update the pointer's location to the currently focused
|
-- | Update the pointer's location to the currently focused
|
||||||
-- window or empty screen unless it's already there, or unless the user was changing
|
-- window or empty screen unless it's already there, or unless the user was changing
|
||||||
-- focus with the mouse
|
-- focus with the mouse
|
||||||
--
|
|
||||||
-- See also 'XMonad.Actions.UpdateFocus.focusUnderPointer' for an inverse
|
|
||||||
-- operation that updates the focus instead. The two can be combined in a
|
|
||||||
-- single config if neither goes into 'logHook' but are invoked explicitly in
|
|
||||||
-- individual key bindings.
|
|
||||||
updatePointer :: (Rational, Rational) -> (Rational, Rational) -> X ()
|
updatePointer :: (Rational, Rational) -> (Rational, Rational) -> X ()
|
||||||
updatePointer refPos ratio = do
|
updatePointer refPos ratio = do
|
||||||
ws <- gets windowset
|
ws <- gets windowset
|
||||||
dpy <- asks display
|
dpy <- asks display
|
||||||
let defaultRect = screenRect $ screenDetail $ current ws
|
|
||||||
rect <- case peek ws of
|
rect <- case peek ws of
|
||||||
Nothing -> return defaultRect
|
Nothing -> return $ (screenRect . screenDetail .current) ws
|
||||||
Just w -> do tryAttributes <- io $ try $ getWindowAttributes dpy w
|
Just w -> windowAttributesToRectangle `fmap` io (getWindowAttributes dpy w)
|
||||||
return $ case tryAttributes of
|
|
||||||
Left (_ :: SomeException) -> defaultRect
|
|
||||||
Right attributes -> windowAttributesToRectangle attributes
|
|
||||||
root <- asks theRoot
|
root <- asks theRoot
|
||||||
mouseIsMoving <- asks mouseFocused
|
mouseIsMoving <- asks mouseFocused
|
||||||
(_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root
|
(_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root
|
||||||
@@ -110,7 +99,6 @@ lerp :: (RealFrac r, Real a, Real b) => r -> a -> b -> r
|
|||||||
lerp r a b = (1 - r) * realToFrac a + r * realToFrac b
|
lerp r a b = (1 - r) * realToFrac a + r * realToFrac b
|
||||||
|
|
||||||
clip :: Ord a => (a, a) -> a -> a
|
clip :: Ord a => (a, a) -> a -> a
|
||||||
clip (lower, upper) x
|
clip (lower, upper) x = if x < lower then lower
|
||||||
| x < lower = lower
|
else if x > upper then upper else x
|
||||||
| x > upper = upper
|
|
||||||
| otherwise = x
|
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.Warp
|
-- Module : XMonad.Actions.Warp
|
||||||
-- Description : Warp the pointer to a given window or screen.
|
|
||||||
-- Copyright : (c) daniel@wagner-home.com
|
-- Copyright : (c) daniel@wagner-home.com
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -23,7 +22,7 @@ module XMonad.Actions.Warp (
|
|||||||
warpToWindow
|
warpToWindow
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad.Prelude
|
import Data.List
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.StackSet as W
|
import XMonad.StackSet as W
|
||||||
|
|
||||||
@@ -102,7 +101,7 @@ warpToWindow h v =
|
|||||||
warpToScreen :: ScreenId -> Rational -> Rational -> X ()
|
warpToScreen :: ScreenId -> Rational -> Rational -> X ()
|
||||||
warpToScreen n h v = do
|
warpToScreen n h v = do
|
||||||
root <- asks theRoot
|
root <- asks theRoot
|
||||||
StackSet{current = x, visible = xs} <- gets windowset
|
(StackSet {current = x, visible = xs}) <- gets windowset
|
||||||
whenJust (fmap (screenRect . W.screenDetail) . find ((n==) . W.screen) $ x : xs)
|
whenJust (fmap (screenRect . W.screenDetail) . find ((n==) . W.screen) $ x : xs)
|
||||||
$ \r ->
|
$ \r ->
|
||||||
warp root (rect_x r + fraction h (rect_width r))
|
warp root (rect_x r + fraction h (rect_width r))
|
||||||
|
@@ -2,7 +2,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.WindowBringer
|
-- Module : XMonad.Actions.WindowBringer
|
||||||
-- Description : Dmenu operations to bring windows to you, and bring you to windows.
|
|
||||||
-- Copyright : Devin Mullins <me@twifkak.com>
|
-- Copyright : Devin Mullins <me@twifkak.com>
|
||||||
-- License : BSD-style (see LICENSE)
|
-- License : BSD-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -22,17 +21,17 @@ module XMonad.Actions.WindowBringer (
|
|||||||
WindowBringerConfig(..),
|
WindowBringerConfig(..),
|
||||||
gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',
|
gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',
|
||||||
bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',
|
bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',
|
||||||
windowMap, windowAppMap, windowMap', bringWindow, actionMenu
|
windowMap, windowMap', bringWindow, actionMenu
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Applicative((<$>))
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
import XMonad
|
import XMonad
|
||||||
import qualified XMonad as X
|
import qualified XMonad as X
|
||||||
import XMonad.Util.Dmenu (menuMapArgs)
|
import XMonad.Util.Dmenu (menuMapArgs)
|
||||||
import XMonad.Util.NamedWindows (getName, getNameWMClass)
|
import XMonad.Util.NamedWindows (getName)
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
--
|
--
|
||||||
@@ -52,14 +51,12 @@ data WindowBringerConfig = WindowBringerConfig
|
|||||||
{ menuCommand :: String -- ^ The shell command that will handle window selection
|
{ menuCommand :: String -- ^ The shell command that will handle window selection
|
||||||
, menuArgs :: [String] -- ^ Arguments to be passed to menuCommand
|
, menuArgs :: [String] -- ^ Arguments to be passed to menuCommand
|
||||||
, windowTitler :: X.WindowSpace -> Window -> X String -- ^ A function that produces window titles given a workspace and a window
|
, windowTitler :: X.WindowSpace -> Window -> X String -- ^ A function that produces window titles given a workspace and a window
|
||||||
, windowFilter :: Window -> X Bool -- ^ Filter function to decide which windows to consider
|
|
||||||
}
|
}
|
||||||
|
|
||||||
instance Default WindowBringerConfig where
|
instance Default WindowBringerConfig where
|
||||||
def = WindowBringerConfig{ menuCommand = "dmenu"
|
def = WindowBringerConfig{ menuCommand = "dmenu"
|
||||||
, menuArgs = ["-i"]
|
, menuArgs = ["-i"]
|
||||||
, windowTitler = decorateName
|
, windowTitler = decorateName
|
||||||
, windowFilter = \_ -> return True
|
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Pops open a dmenu with window titles. Choose one, and you will be
|
-- | Pops open a dmenu with window titles. Choose one, and you will be
|
||||||
@@ -126,8 +123,11 @@ bringWindow w ws = W.shiftWin (W.currentTag ws) w ws
|
|||||||
-- | Calls dmenuMap to grab the appropriate Window, and hands it off to action
|
-- | Calls dmenuMap to grab the appropriate Window, and hands it off to action
|
||||||
-- if found.
|
-- if found.
|
||||||
actionMenu :: WindowBringerConfig -> (Window -> X.WindowSet -> X.WindowSet) -> X ()
|
actionMenu :: WindowBringerConfig -> (Window -> X.WindowSet -> X.WindowSet) -> X ()
|
||||||
actionMenu c@WindowBringerConfig{ menuCommand = cmd, menuArgs = args } action =
|
actionMenu WindowBringerConfig{ menuCommand = cmd
|
||||||
windowMap' c >>= menuMapFunction >>= flip X.whenJust (windows . action)
|
, menuArgs = args
|
||||||
|
, windowTitler = titler
|
||||||
|
} action
|
||||||
|
= windowMap' titler >>= menuMapFunction >>= flip X.whenJust (windows . action)
|
||||||
where
|
where
|
||||||
menuMapFunction :: M.Map String a -> X (Maybe a)
|
menuMapFunction :: M.Map String a -> X (Maybe a)
|
||||||
menuMapFunction = menuMapArgs cmd args
|
menuMapFunction = menuMapArgs cmd args
|
||||||
@@ -135,20 +135,15 @@ actionMenu c@WindowBringerConfig{ menuCommand = cmd, menuArgs = args } action =
|
|||||||
|
|
||||||
-- | A map from window names to Windows.
|
-- | A map from window names to Windows.
|
||||||
windowMap :: X (M.Map String Window)
|
windowMap :: X (M.Map String Window)
|
||||||
windowMap = windowMap' def
|
windowMap = windowMap' decorateName
|
||||||
|
|
||||||
-- | A map from application executable names to Windows.
|
|
||||||
windowAppMap :: X (M.Map String Window)
|
|
||||||
windowAppMap = windowMap' def { windowTitler = decorateAppName }
|
|
||||||
|
|
||||||
-- | A map from window names to Windows, given a windowTitler function.
|
-- | A map from window names to Windows, given a windowTitler function.
|
||||||
windowMap' :: WindowBringerConfig -> X (M.Map String Window)
|
windowMap' :: (X.WindowSpace -> Window -> X String) -> X (M.Map String Window)
|
||||||
windowMap' WindowBringerConfig{ windowTitler = titler, windowFilter = include } = do
|
windowMap' titler = do
|
||||||
windowSet <- gets X.windowset
|
ws <- gets X.windowset
|
||||||
M.fromList . concat <$> mapM keyValuePairs (W.workspaces windowSet)
|
M.fromList . concat <$> mapM keyValuePairs (W.workspaces ws)
|
||||||
where keyValuePairs ws = let wins = W.integrate' (W.stack ws)
|
where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws)
|
||||||
in mapM (keyValuePair ws) =<< filterM include wins
|
keyValuePair ws w = flip (,) w <$> titler ws w
|
||||||
keyValuePair ws w = (, w) <$> titler ws w
|
|
||||||
|
|
||||||
-- | Returns the window name as will be listed in dmenu.
|
-- | Returns the window name as will be listed in dmenu.
|
||||||
-- Tagged with the workspace ID, to guarantee uniqueness, and to let the user
|
-- Tagged with the workspace ID, to guarantee uniqueness, and to let the user
|
||||||
@@ -157,11 +152,3 @@ decorateName :: X.WindowSpace -> Window -> X String
|
|||||||
decorateName ws w = do
|
decorateName ws w = do
|
||||||
name <- show <$> getName w
|
name <- show <$> getName w
|
||||||
return $ name ++ " [" ++ W.tag ws ++ "]"
|
return $ name ++ " [" ++ W.tag ws ++ "]"
|
||||||
|
|
||||||
-- | Returns the window name as will be listed in dmenu. This will
|
|
||||||
-- return the executable name of the window along with it's workspace
|
|
||||||
-- ID.
|
|
||||||
decorateAppName :: X.WindowSpace -> Window -> X String
|
|
||||||
decorateAppName ws w = do
|
|
||||||
name <- show <$> getNameWMClass w
|
|
||||||
return $ name ++ " [" ++ W.tag ws ++ "]"
|
|
||||||
|
@@ -1,6 +1,5 @@
|
|||||||
{- |
|
{- |
|
||||||
Module : XMonad.Actions.WindowGo
|
Module : XMonad.Actions.WindowGo
|
||||||
Description : Operations for raising (traveling to) windows.
|
|
||||||
License : Public domain
|
License : Public domain
|
||||||
|
|
||||||
Maintainer : <gwern0@gmail.com>
|
Maintainer : <gwern0@gmail.com>
|
||||||
@@ -37,14 +36,15 @@ module XMonad.Actions.WindowGo (
|
|||||||
module XMonad.ManageHook
|
module XMonad.ManageHook
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.List as L (nub,sortBy)
|
import Control.Monad
|
||||||
import XMonad.Prelude
|
import Data.Char (toLower)
|
||||||
|
import Data.Monoid
|
||||||
import XMonad (Query(), X(), ManageHook, WindowSet, withWindowSet, runQuery, liftIO, ask)
|
import XMonad (Query(), X(), ManageHook, WindowSet, withWindowSet, runQuery, liftIO, ask)
|
||||||
import Graphics.X11 (Window)
|
import Graphics.X11 (Window)
|
||||||
import XMonad.ManageHook
|
import XMonad.ManageHook
|
||||||
import XMonad.Operations (windows)
|
import XMonad.Operations (windows)
|
||||||
import XMonad.Prompt.Shell (getBrowser, getEditor)
|
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)
|
import XMonad.Util.Run (safeSpawnProg)
|
||||||
{- $usage
|
{- $usage
|
||||||
|
|
||||||
@@ -66,20 +66,12 @@ appropriate one, or cover your bases by using instead something like:
|
|||||||
For detailed instructions on editing your key bindings, see
|
For detailed instructions on editing your key bindings, see
|
||||||
"XMonad.Doc.Extending#Editing_key_bindings". -}
|
"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
|
-- | If windows that satisfy the query exist, apply the supplied
|
||||||
-- function to them, otherwise run the action given as
|
-- function to them, otherwise run the action given as
|
||||||
-- second parameter.
|
-- second parameter.
|
||||||
ifWindows :: Query Bool -> ([Window] -> X ()) -> X () -> X ()
|
ifWindows :: Query Bool -> ([Window] -> X ()) -> X () -> X ()
|
||||||
ifWindows qry f el = withWindowSet $ \wins -> do
|
ifWindows qry f el = withWindowSet $ \wins -> do
|
||||||
matches <- filterM (runQuery qry) $ allWindowsSorted wins
|
matches <- filterM (runQuery qry) $ W.allWindows wins
|
||||||
case matches of
|
case matches of
|
||||||
[] -> el
|
[] -> el
|
||||||
ws -> f ws
|
ws -> f ws
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
----------------------------------------------------------------------------
|
----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.WindowMenu
|
-- Module : XMonad.Actions.WindowMenu
|
||||||
-- Description : Display window management actions in the center of the focused window.
|
|
||||||
-- Copyright : (c) Jan Vornberger 2009
|
-- Copyright : (c) Jan Vornberger 2009
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -29,8 +28,8 @@ import XMonad
|
|||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
import XMonad.Actions.GridSelect
|
import XMonad.Actions.GridSelect
|
||||||
import XMonad.Layout.Maximize
|
import XMonad.Layout.Maximize
|
||||||
import XMonad.Actions.Minimize
|
import XMonad.Layout.Minimize
|
||||||
import XMonad.Prelude (fi)
|
import XMonad.Util.XUtils (fi)
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
--
|
--
|
||||||
@@ -69,7 +68,7 @@ windowMenu = withFocused $ \w -> do
|
|||||||
| tag <- tags ]
|
| tag <- tags ]
|
||||||
runSelectedAction gsConfig actions
|
runSelectedAction gsConfig actions
|
||||||
|
|
||||||
getSize :: Window -> X Rectangle
|
getSize :: Window -> X (Rectangle)
|
||||||
getSize w = do
|
getSize w = do
|
||||||
d <- asks display
|
d <- asks display
|
||||||
wa <- io $ getWindowAttributes d w
|
wa <- io $ getWindowAttributes d w
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.WindowNavigation
|
-- Module : XMonad.Actions.WindowNavigation
|
||||||
-- Description : Experimental rewrite of "XMonad.Layout.WindowNavigation".
|
|
||||||
-- Copyright : (c) 2007 David Roundy <droundy@darcs.net>,
|
-- Copyright : (c) 2007 David Roundy <droundy@darcs.net>,
|
||||||
-- Devin Mullins <me@twifkak.com>
|
-- Devin Mullins <me@twifkak.com>
|
||||||
-- Maintainer : Devin Mullins <me@twifkak.com>
|
-- Maintainer : Devin Mullins <me@twifkak.com>
|
||||||
@@ -41,14 +40,17 @@ module XMonad.Actions.WindowNavigation (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortOn)
|
|
||||||
import XMonad.Util.Types (Direction2D(..))
|
import XMonad.Util.Types (Direction2D(..))
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
|
import Control.Applicative ((<$>))
|
||||||
import Control.Arrow (second)
|
import Control.Arrow (second)
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
|
import Data.List (sortBy)
|
||||||
import Data.Map (Map())
|
import Data.Map (Map())
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
|
||||||
|
import Data.Ord (comparing)
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
@@ -63,11 +65,6 @@ import qualified Data.Set as S
|
|||||||
-- > $ def { ... }
|
-- > $ def { ... }
|
||||||
-- > xmonad config
|
-- > xmonad config
|
||||||
--
|
--
|
||||||
-- Or, for the brave souls:
|
|
||||||
--
|
|
||||||
-- > main = xmonad =<< withWindowNavigation (xK_w, xK_a, xK_s, xK_d)
|
|
||||||
-- > $ def { ... }
|
|
||||||
--
|
|
||||||
-- Here, we pass in the keys for navigation in counter-clockwise order from up.
|
-- Here, we pass in the keys for navigation in counter-clockwise order from up.
|
||||||
-- It creates keybindings for @modMask@ to move to window, and @modMask .|. shiftMask@
|
-- It creates keybindings for @modMask@ to move to window, and @modMask .|. shiftMask@
|
||||||
-- to swap windows.
|
-- to swap windows.
|
||||||
@@ -128,12 +125,9 @@ swap = withTargetWindow swapWithFocused
|
|||||||
mapWindows (swapWin currentWin targetWin) winSet
|
mapWindows (swapWin currentWin targetWin) winSet
|
||||||
Nothing -> winSet
|
Nothing -> winSet
|
||||||
mapWindows f ss = W.mapWorkspace (mapWindows' f) ss
|
mapWindows f ss = W.mapWorkspace (mapWindows' f) ss
|
||||||
mapWindows' f ws@W.Workspace{ W.stack = s } = ws { W.stack = mapWindows'' f <$> s }
|
mapWindows' f ws@(W.Workspace { W.stack = s }) = ws { W.stack = mapWindows'' f <$> s }
|
||||||
mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down)
|
mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down)
|
||||||
swapWin win1 win2 win
|
swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win
|
||||||
| win == win1 = win2
|
|
||||||
| win == win2 = win1
|
|
||||||
| otherwise = win
|
|
||||||
|
|
||||||
withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()
|
withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()
|
||||||
withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
|
withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
|
||||||
@@ -143,11 +137,11 @@ withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
|
|||||||
setPosition posRef pos targetRect
|
setPosition posRef pos targetRect
|
||||||
|
|
||||||
trackMovement :: IORef WNState -> X ()
|
trackMovement :: IORef WNState -> X ()
|
||||||
trackMovement posRef = fromCurrentPoint posRef $ \win pos ->
|
trackMovement posRef = fromCurrentPoint posRef $ \win pos -> do
|
||||||
windowRect win >>= flip whenJust (setPosition posRef pos . snd)
|
windowRect win >>= flip whenJust (setPosition posRef pos . snd)
|
||||||
|
|
||||||
fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
|
fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
|
||||||
fromCurrentPoint posRef f = withFocused $ \win ->
|
fromCurrentPoint posRef f = withFocused $ \win -> do
|
||||||
currentPosition posRef >>= f win
|
currentPosition posRef >>= f win
|
||||||
|
|
||||||
-- Gets the current position from the IORef passed in, or if nothing (say, from
|
-- Gets the current position from the IORef passed in, or if nothing (say, from
|
||||||
@@ -199,7 +193,7 @@ windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped
|
|||||||
windowRect :: Window -> X (Maybe (Window, Rectangle))
|
windowRect :: Window -> X (Maybe (Window, Rectangle))
|
||||||
windowRect win = withDisplay $ \dpy -> do
|
windowRect win = withDisplay $ \dpy -> do
|
||||||
(_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
|
(_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
|
||||||
return $ Just (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))
|
return $ Just $ (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))
|
||||||
`catchX` return Nothing
|
`catchX` return Nothing
|
||||||
|
|
||||||
-- Modified from droundy's implementation of WindowNavigation:
|
-- Modified from droundy's implementation of WindowNavigation:
|
||||||
@@ -215,7 +209,7 @@ inr L (Point px py) (Rectangle rx ry w h) = px > rx + fromIntegral w
|
|||||||
py >= ry && py < ry + fromIntegral h
|
py >= ry && py < ry + fromIntegral h
|
||||||
|
|
||||||
sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
|
sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
|
||||||
sortby D = sortOn (rect_y . snd)
|
sortby D = sortBy $ comparing (rect_y . snd)
|
||||||
sortby R = sortOn (rect_x . snd)
|
sortby R = sortBy $ comparing (rect_x . snd)
|
||||||
sortby U = reverse . sortby D
|
sortby U = reverse . sortby D
|
||||||
sortby L = reverse . sortby R
|
sortby L = reverse . sortby R
|
||||||
|
@@ -1,23 +1,21 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.WithAll
|
-- Module : XMonad.Actions.WithAll
|
||||||
-- Description : Perform a given action on all or certain groups of windows.
|
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
-- Stability : unstable
|
-- Stability : unstable
|
||||||
-- Portability : unportable
|
-- Portability : unportable
|
||||||
--
|
--
|
||||||
-- Provides functions for performing a given action on all or certain
|
-- Provides functions for performing a given action on all windows of
|
||||||
-- groups of windows on the current workspace.
|
-- the current workspace.
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
module XMonad.Actions.WithAll (
|
module XMonad.Actions.WithAll (
|
||||||
-- * Usage
|
-- * Usage
|
||||||
-- $usage
|
-- $usage
|
||||||
sinkAll, withAll,
|
sinkAll, withAll,
|
||||||
withAll', killAll,
|
withAll', killAll) where
|
||||||
killOthers) where
|
|
||||||
|
|
||||||
import XMonad.Prelude hiding (foldr)
|
import Data.Foldable hiding (foldr)
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.StackSet
|
import XMonad.StackSet
|
||||||
@@ -52,7 +50,3 @@ withAll f = withWindowSet $ \ws -> let all' = integrate' . stack . workspace . c
|
|||||||
-- | Kill all the windows on the current workspace.
|
-- | Kill all the windows on the current workspace.
|
||||||
killAll :: X()
|
killAll :: X()
|
||||||
killAll = withAll killWindow
|
killAll = withAll killWindow
|
||||||
|
|
||||||
-- | Kill all the unfocused windows on the current workspace.
|
|
||||||
killOthers :: X ()
|
|
||||||
killOthers = withUnfocused killWindow
|
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.Workscreen
|
-- Module : XMonad.Actions.Workscreen
|
||||||
-- Description: Display a set of workspaces on several screens.
|
|
||||||
-- Copyright : (c) 2012 kedals0
|
-- Copyright : (c) 2012 kedals0
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -21,6 +20,7 @@
|
|||||||
-- This also permits to see all workspaces of a workscreen even if just
|
-- This also permits to see all workspaces of a workscreen even if just
|
||||||
-- one screen is present, and to move windows from workspace to workscreen.
|
-- one screen is present, and to move windows from workspace to workscreen.
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
|
|
||||||
module XMonad.Actions.Workscreen (
|
module XMonad.Actions.Workscreen (
|
||||||
-- * Usage
|
-- * Usage
|
||||||
@@ -58,23 +58,23 @@ import XMonad.Actions.OnScreen
|
|||||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||||
|
|
||||||
|
|
||||||
data Workscreen = Workscreen{workscreenId::Int,workspaces::[WorkspaceId]} deriving (Show)
|
data Workscreen = Workscreen{workscreenId::Int,workspaces::[WorkspaceId]} deriving (Show,Typeable)
|
||||||
type WorkscreenId=Int
|
type WorkscreenId=Int
|
||||||
|
|
||||||
data WorkscreenStorage = WorkscreenStorage WorkscreenId [Workscreen] deriving (Show)
|
data WorkscreenStorage = WorkscreenStorage WorkscreenId [Workscreen] deriving (Show,Typeable)
|
||||||
instance ExtensionClass WorkscreenStorage where
|
instance ExtensionClass WorkscreenStorage where
|
||||||
initialValue = WorkscreenStorage 0 []
|
initialValue = WorkscreenStorage 0 []
|
||||||
|
|
||||||
-- | Helper to group workspaces. Multiply workspace by screens number.
|
-- | Helper to group workspaces. Multiply workspace by screens number.
|
||||||
expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]
|
expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]
|
||||||
expandWorkspace nscr = concatMap expandId
|
expandWorkspace nscr ws = concat $ map expandId ws
|
||||||
where expandId wsId = let t = wsId ++ "_"
|
where expandId wsId = let t = wsId ++ "_"
|
||||||
in map ((++) t . show ) [1..nscr]
|
in map ((++) t . show ) [1..nscr]
|
||||||
|
|
||||||
-- | Create workscreen list from workspace list. Group workspaces to
|
-- | Create workscreen list from workspace list. Group workspaces to
|
||||||
-- packets of screens number size.
|
-- packets of screens number size.
|
||||||
fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen]
|
fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen]
|
||||||
fromWorkspace n ws = zipWith Workscreen [0..] (fromWorkspace' n ws)
|
fromWorkspace n ws = map (\(a,b) -> Workscreen a b) $ zip [0..] (fromWorkspace' n ws)
|
||||||
fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]
|
fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]
|
||||||
fromWorkspace' _ [] = []
|
fromWorkspace' _ [] = []
|
||||||
fromWorkspace' n ws = take n ws : fromWorkspace' n (drop n ws)
|
fromWorkspace' n ws = take n ws : fromWorkspace' n (drop n ws)
|
||||||
|
@@ -1,8 +1,7 @@
|
|||||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.WorkspaceCursors
|
-- Module : XMonad.Actions.WorkspaceCursors
|
||||||
-- Description : Like "XMonad.Actions.Plane" for an arbitrary number of dimensions.
|
|
||||||
-- Copyright : (c) 2009 Adam Vogt <vogt.adam@gmail.com>
|
-- Copyright : (c) 2009 Adam Vogt <vogt.adam@gmail.com>
|
||||||
-- License : BSD
|
-- License : BSD
|
||||||
--
|
--
|
||||||
@@ -47,10 +46,14 @@ import qualified XMonad.StackSet as W
|
|||||||
import XMonad.Actions.FocusNth(focusNth')
|
import XMonad.Actions.FocusNth(focusNth')
|
||||||
import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
|
import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
|
||||||
LayoutModifier(handleMess, redoLayout))
|
LayoutModifier(handleMess, redoLayout))
|
||||||
import XMonad(Message, WorkspaceId, X, XState(windowset),
|
import XMonad(Typeable, Message, WorkspaceId, X, XState(windowset),
|
||||||
fromMessage, sendMessage, windows, gets)
|
fromMessage, sendMessage, windows, gets)
|
||||||
import XMonad.Util.Stack (reverseS)
|
import Control.Monad((<=<), guard, liftM, liftM2, when)
|
||||||
import XMonad.Prelude (find, fromJust, guard, liftA2, toList, when, (<=<))
|
import Control.Applicative((<$>))
|
||||||
|
import Data.Foldable(Foldable(foldMap), toList)
|
||||||
|
import Data.Maybe(fromJust, listToMaybe)
|
||||||
|
import Data.Monoid(Monoid(mappend, mconcat))
|
||||||
|
import Data.Traversable(sequenceA)
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
--
|
--
|
||||||
@@ -58,10 +61,13 @@ import XMonad.Prelude (find, fromJust, guard, liftA2, toList, when, (<=<))
|
|||||||
--
|
--
|
||||||
-- > import XMonad
|
-- > import XMonad
|
||||||
-- > import XMonad.Actions.WorkspaceCursors
|
-- > import XMonad.Actions.WorkspaceCursors
|
||||||
|
-- > import XMonad.Hooks.DynamicLog
|
||||||
-- > import XMonad.Util.EZConfig
|
-- > import XMonad.Util.EZConfig
|
||||||
-- > import qualified XMonad.StackSet as W
|
-- > import qualified XMonad.StackSet as W
|
||||||
-- >
|
-- >
|
||||||
-- > main = xmonad conf
|
-- > main = do
|
||||||
|
-- > x <- xmobar conf
|
||||||
|
-- > xmonad x
|
||||||
-- >
|
-- >
|
||||||
-- > conf = additionalKeysP def
|
-- > conf = additionalKeysP def
|
||||||
-- > { layoutHook = workspaceCursors myCursors $ layoutHook def
|
-- > { layoutHook = workspaceCursors myCursors $ layoutHook def
|
||||||
@@ -86,8 +92,7 @@ import XMonad.Prelude (find, fromJust, guard, liftA2, toList, when, (<=<))
|
|||||||
-- workspaces. Or change it such that workspaces are created when you try to
|
-- workspaces. Or change it such that workspaces are created when you try to
|
||||||
-- view it.
|
-- view it.
|
||||||
--
|
--
|
||||||
-- * Function for pretty printing for "XMonad.Hooks.StatusBar.PP" that groups
|
-- * Function for pretty printing for DynamicLog that groups workspaces by
|
||||||
-- workspaces by
|
|
||||||
-- common prefixes
|
-- common prefixes
|
||||||
--
|
--
|
||||||
-- * Examples of adding workspaces to the cursors, having them appear multiple
|
-- * Examples of adding workspaces to the cursors, having them appear multiple
|
||||||
@@ -113,7 +118,7 @@ end = Cons . fromJust . W.differentiate . map End
|
|||||||
|
|
||||||
data Cursors a
|
data Cursors a
|
||||||
= Cons (W.Stack (Cursors a))
|
= Cons (W.Stack (Cursors a))
|
||||||
| End a deriving (Eq,Show,Read)
|
| End a deriving (Eq,Show,Read,Typeable)
|
||||||
|
|
||||||
instance Foldable Cursors where
|
instance Foldable Cursors where
|
||||||
foldMap f (End x) = f x
|
foldMap f (End x) = f x
|
||||||
@@ -139,7 +144,7 @@ getFocus (End x) = x
|
|||||||
|
|
||||||
-- This could be made more efficient, if the fact that the suffixes are grouped
|
-- This could be made more efficient, if the fact that the suffixes are grouped
|
||||||
focusTo :: (Eq t) => t -> Cursors t -> Maybe (Cursors t)
|
focusTo :: (Eq t) => t -> Cursors t -> Maybe (Cursors t)
|
||||||
focusTo x = find ((x==) . getFocus) . changeFocus (const True)
|
focusTo x = listToMaybe . filter ((x==) . getFocus) . changeFocus (const True)
|
||||||
|
|
||||||
-- | non-wrapping version of 'W.focusUp''
|
-- | non-wrapping version of 'W.focusUp''
|
||||||
noWrapUp :: W.Stack t -> W.Stack t
|
noWrapUp :: W.Stack t -> W.Stack t
|
||||||
@@ -148,19 +153,20 @@ noWrapUp x@(W.Stack _ [] _ ) = x
|
|||||||
|
|
||||||
-- | non-wrapping version of 'W.focusDown''
|
-- | non-wrapping version of 'W.focusDown''
|
||||||
noWrapDown :: W.Stack t -> W.Stack t
|
noWrapDown :: W.Stack t -> W.Stack t
|
||||||
noWrapDown = reverseS . noWrapUp . reverseS
|
noWrapDown = reverseStack . noWrapUp . reverseStack
|
||||||
|
where reverseStack (W.Stack t ls rs) = W.Stack t rs ls
|
||||||
|
|
||||||
focusDepth :: Cursors t -> Int
|
focusDepth :: Cursors t -> Int
|
||||||
focusDepth (Cons x) = 1 + focusDepth (W.focus x)
|
focusDepth (Cons x) = 1 + focusDepth (W.focus x)
|
||||||
focusDepth (End _) = 0
|
focusDepth (End _) = 0
|
||||||
|
|
||||||
descend :: Monad m =>(W.Stack (Cursors a) -> m (W.Stack (Cursors a)))-> Int-> Cursors a-> m (Cursors a)
|
descend :: Monad m =>(W.Stack (Cursors a) -> m (W.Stack (Cursors a)))-> Int-> Cursors a-> m (Cursors a)
|
||||||
descend f 1 (Cons x) = Cons <$> f x
|
descend f 1 (Cons x) = Cons `liftM` f x
|
||||||
descend f n (Cons x) | n > 1 = fmap Cons $ descend f (pred n) `onFocus` x
|
descend f n (Cons x) | n > 1 = liftM Cons $ descend f (pred n) `onFocus` x
|
||||||
descend _ _ x = return x
|
descend _ _ x = return x
|
||||||
|
|
||||||
onFocus :: (Monad m) => (a1 -> m a1) -> W.Stack a1 -> m (W.Stack a1)
|
onFocus :: (Monad m) => (a1 -> m a1) -> W.Stack a1 -> m (W.Stack a1)
|
||||||
onFocus f st = (\x -> st { W.focus = x}) <$> f (W.focus st)
|
onFocus f st = (\x -> st { W.focus = x}) `liftM` f (W.focus st)
|
||||||
|
|
||||||
-- | @modifyLayer@ is used to change the focus at a given depth
|
-- | @modifyLayer@ is used to change the focus at a given depth
|
||||||
modifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors String)) -> Int -> X ()
|
modifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors String)) -> Int -> X ()
|
||||||
@@ -186,10 +192,10 @@ modifyLayer' :: (W.Stack (Cursors String) -> X (W.Stack (Cursors String))) -> In
|
|||||||
modifyLayer' f depth = modifyCursors (descend f depth)
|
modifyLayer' f depth = modifyCursors (descend f depth)
|
||||||
|
|
||||||
modifyCursors :: (Cursors String -> X (Cursors String)) -> X ()
|
modifyCursors :: (Cursors String -> X (Cursors String)) -> X ()
|
||||||
modifyCursors = sendMessage . ChangeCursors . (liftA2 (>>) updateXMD return <=<)
|
modifyCursors = sendMessage . ChangeCursors . (liftM2 (>>) updateXMD return <=<)
|
||||||
|
|
||||||
newtype WorkspaceCursors a = WorkspaceCursors (Cursors String)
|
data WorkspaceCursors a = WorkspaceCursors (Cursors String)
|
||||||
deriving (Read,Show)
|
deriving (Typeable,Read,Show)
|
||||||
|
|
||||||
-- | The state is stored in the 'WorkspaceCursors' layout modifier. Put this as
|
-- | The state is stored in the 'WorkspaceCursors' layout modifier. Put this as
|
||||||
-- your outermost modifier, unless you want different cursors at different
|
-- your outermost modifier, unless you want different cursors at different
|
||||||
@@ -197,7 +203,8 @@ newtype WorkspaceCursors a = WorkspaceCursors (Cursors String)
|
|||||||
workspaceCursors :: Cursors String -> l a -> ModifiedLayout WorkspaceCursors l a
|
workspaceCursors :: Cursors String -> l a -> ModifiedLayout WorkspaceCursors l a
|
||||||
workspaceCursors = ModifiedLayout . WorkspaceCursors
|
workspaceCursors = ModifiedLayout . WorkspaceCursors
|
||||||
|
|
||||||
newtype ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) }
|
data ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) }
|
||||||
|
deriving (Typeable)
|
||||||
|
|
||||||
instance Message ChangeCursors
|
instance Message ChangeCursors
|
||||||
|
|
||||||
|
@@ -1,7 +1,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Actions.WorkspaceNames
|
-- Module : XMonad.Actions.WorkspaceNames
|
||||||
-- Description : Persistently rename workspace and swap them along with their names.
|
|
||||||
-- Copyright : (c) Tomas Janousek <tomi@nomi.cz>
|
-- Copyright : (c) Tomas Janousek <tomi@nomi.cz>
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -9,19 +8,22 @@
|
|||||||
-- Stability : experimental
|
-- Stability : experimental
|
||||||
-- Portability : unportable
|
-- Portability : unportable
|
||||||
--
|
--
|
||||||
-- Provides bindings to rename workspaces, show these names in a status bar and
|
-- Provides bindings to rename workspaces, show these names in DynamicLog and
|
||||||
-- swap workspaces along with their names. These names survive restart.
|
-- swap workspaces along with their names. These names survive restart.
|
||||||
-- Together with "XMonad.Layout.WorkspaceDir" this provides for a fully
|
-- Together with "XMonad.Layout.WorkspaceDir" this provides for a fully
|
||||||
-- dynamic topic space workflow.
|
-- dynamic topic space workflow.
|
||||||
--
|
--
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
|
|
||||||
module XMonad.Actions.WorkspaceNames (
|
module XMonad.Actions.WorkspaceNames (
|
||||||
-- * Usage
|
-- * Usage
|
||||||
-- $usage
|
-- $usage
|
||||||
|
|
||||||
-- * Workspace naming
|
-- * Workspace naming
|
||||||
renameWorkspace,
|
renameWorkspace,
|
||||||
|
workspaceNamesPP,
|
||||||
getWorkspaceNames',
|
getWorkspaceNames',
|
||||||
getWorkspaceNames,
|
getWorkspaceNames,
|
||||||
getWorkspaceName,
|
getWorkspaceName,
|
||||||
@@ -35,27 +37,23 @@ module XMonad.Actions.WorkspaceNames (
|
|||||||
swapWithCurrent,
|
swapWithCurrent,
|
||||||
|
|
||||||
-- * Workspace prompt
|
-- * Workspace prompt
|
||||||
workspaceNamePrompt,
|
workspaceNamePrompt
|
||||||
|
|
||||||
-- * StatusBar, EwmhDesktops integration
|
|
||||||
workspaceNamesPP,
|
|
||||||
workspaceNamesEwmh,
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude (fromMaybe, isInfixOf, (<&>), (>=>))
|
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
import qualified XMonad.Util.ExtensibleState as XS
|
import qualified XMonad.Util.ExtensibleState as XS
|
||||||
|
|
||||||
import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), anyWS)
|
import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..))
|
||||||
import qualified XMonad.Actions.SwapWorkspaces as Swap
|
import qualified XMonad.Actions.SwapWorkspaces as Swap
|
||||||
import XMonad.Hooks.StatusBar.PP (PP(..))
|
import XMonad.Hooks.DynamicLog (PP(..))
|
||||||
import XMonad.Hooks.EwmhDesktops (addEwmhWorkspaceRename)
|
|
||||||
import XMonad.Prompt (mkXPrompt, XPConfig)
|
import XMonad.Prompt (mkXPrompt, XPConfig)
|
||||||
import XMonad.Prompt.Workspace (Wor(Wor))
|
import XMonad.Prompt.Workspace (Wor(Wor))
|
||||||
import XMonad.Util.WorkspaceCompare (getSortByIndex)
|
import XMonad.Util.WorkspaceCompare (getSortByIndex)
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Data.List (isInfixOf)
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
|
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
|
||||||
@@ -66,17 +64,10 @@ import qualified Data.Map as M
|
|||||||
--
|
--
|
||||||
-- > , ((modm .|. shiftMask, xK_r ), renameWorkspace def)
|
-- > , ((modm .|. shiftMask, xK_r ), renameWorkspace def)
|
||||||
--
|
--
|
||||||
-- and apply workspaceNamesPP to your pretty-printer:
|
-- and apply workspaceNamesPP to your DynamicLog pretty-printer:
|
||||||
--
|
--
|
||||||
-- > myPP = workspaceNamesPP xmobarPP
|
-- > myLogHook =
|
||||||
--
|
-- > workspaceNamesPP xmobarPP >>= dynamicLogString >>= xmonadPropLog
|
||||||
-- Check "XMonad.Hooks.StatusBar" for more information on how to incorprate
|
|
||||||
-- this into your status bar.
|
|
||||||
--
|
|
||||||
-- To expose workspace names to pagers and other EWMH clients, integrate this
|
|
||||||
-- with "XMonad.Hooks.EwmhDesktops":
|
|
||||||
--
|
|
||||||
-- > main = xmonad $ … . workspaceNamesEwmh . ewmh . … $ def{…}
|
|
||||||
--
|
--
|
||||||
-- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s
|
-- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s
|
||||||
-- functionality, which may be used this way:
|
-- functionality, which may be used this way:
|
||||||
@@ -94,7 +85,7 @@ import qualified Data.Map as M
|
|||||||
|
|
||||||
-- | Workspace names container.
|
-- | Workspace names container.
|
||||||
newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String)
|
newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String)
|
||||||
deriving (Read, Show)
|
deriving (Typeable, Read, Show)
|
||||||
|
|
||||||
instance ExtensionClass WorkspaceNames where
|
instance ExtensionClass WorkspaceNames where
|
||||||
initialValue = WorkspaceNames M.empty
|
initialValue = WorkspaceNames M.empty
|
||||||
@@ -106,20 +97,21 @@ getWorkspaceNames' = do
|
|||||||
WorkspaceNames m <- XS.get
|
WorkspaceNames m <- XS.get
|
||||||
return (`M.lookup` m)
|
return (`M.lookup` m)
|
||||||
|
|
||||||
-- | Returns a function for 'ppRename' that appends @sep@ and the workspace
|
-- | Returns a function that maps workspace tag @\"t\"@ to @\"t:name\"@ for
|
||||||
-- name, if set.
|
-- workspaces with a name, and to @\"t\"@ otherwise.
|
||||||
getWorkspaceNames :: String -> X (String -> WindowSpace -> String)
|
getWorkspaceNames :: X (WorkspaceId -> String)
|
||||||
getWorkspaceNames sep = ren <$> getWorkspaceNames'
|
getWorkspaceNames = do
|
||||||
where
|
lookup <- getWorkspaceNames'
|
||||||
ren name s w = s ++ maybe "" (sep ++) (name (W.tag w))
|
return $ \wks -> wks ++ maybe "" (':' :) (lookup wks)
|
||||||
|
|
||||||
-- | Gets the name of a workspace, if set, otherwise returns nothing.
|
-- | Gets the name of a workspace, if set, otherwise returns nothing.
|
||||||
getWorkspaceName :: WorkspaceId -> X (Maybe String)
|
getWorkspaceName :: WorkspaceId -> X (Maybe String)
|
||||||
getWorkspaceName w = ($ w) <$> getWorkspaceNames'
|
getWorkspaceName w = ($ w) `fmap` getWorkspaceNames'
|
||||||
|
|
||||||
-- | Gets the name of the current workspace. See 'getWorkspaceName'
|
-- | Gets the name of the current workspace. See 'getWorkspaceName'
|
||||||
getCurrentWorkspaceName :: X (Maybe String)
|
getCurrentWorkspaceName :: X (Maybe String)
|
||||||
getCurrentWorkspaceName = getWorkspaceName =<< gets (W.currentTag . windowset)
|
getCurrentWorkspaceName = do
|
||||||
|
getWorkspaceName =<< gets (W.currentTag . windowset)
|
||||||
|
|
||||||
-- | Sets the name of a workspace. Empty string makes the workspace unnamed
|
-- | Sets the name of a workspace. Empty string makes the workspace unnamed
|
||||||
-- again.
|
-- again.
|
||||||
@@ -137,13 +129,27 @@ setCurrentWorkspaceName name = do
|
|||||||
|
|
||||||
-- | Prompt for a new name for the current workspace and set it.
|
-- | Prompt for a new name for the current workspace and set it.
|
||||||
renameWorkspace :: XPConfig -> X ()
|
renameWorkspace :: XPConfig -> X ()
|
||||||
renameWorkspace conf =
|
renameWorkspace conf = do
|
||||||
mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName
|
mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName
|
||||||
where pr = Wor "Workspace name: "
|
where pr = Wor "Workspace name: "
|
||||||
|
|
||||||
|
-- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to show
|
||||||
|
-- workspace names as well.
|
||||||
|
workspaceNamesPP :: PP -> X PP
|
||||||
|
workspaceNamesPP pp = do
|
||||||
|
names <- getWorkspaceNames
|
||||||
|
return $
|
||||||
|
pp {
|
||||||
|
ppCurrent = ppCurrent pp . names,
|
||||||
|
ppVisible = ppVisible pp . names,
|
||||||
|
ppHidden = ppHidden pp . names,
|
||||||
|
ppHiddenNoWindows = ppHiddenNoWindows pp . names,
|
||||||
|
ppUrgent = ppUrgent pp . names
|
||||||
|
}
|
||||||
|
|
||||||
-- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names.
|
-- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names.
|
||||||
swapTo :: Direction1D -> X ()
|
swapTo :: Direction1D -> X ()
|
||||||
swapTo dir = swapTo' dir anyWS
|
swapTo dir = swapTo' dir AnyWS
|
||||||
|
|
||||||
-- | Swap with the previous or next workspace of the given type.
|
-- | Swap with the previous or next workspace of the given type.
|
||||||
swapTo' :: Direction1D -> WSType -> X ()
|
swapTo' :: Direction1D -> WSType -> X ()
|
||||||
@@ -163,27 +169,19 @@ swapNames w1 w2 = do
|
|||||||
WorkspaceNames m <- XS.get
|
WorkspaceNames m <- XS.get
|
||||||
let getname w = fromMaybe "" $ M.lookup w m
|
let getname w = fromMaybe "" $ M.lookup w m
|
||||||
set w name m' = if null name then M.delete w m' else M.insert w name m'
|
set w name m' = if null name then M.delete w m' else M.insert w name m'
|
||||||
XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) m
|
XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m
|
||||||
|
|
||||||
-- | Same behavior than 'XMonad.Prompt.Workspace.workspacePrompt' excepted it acts on the workspace name provided by this module.
|
-- | Same behavior than 'XMonad.Prompt.Workspace.workspacePrompt' excepted it acts on the workspace name provided by this module.
|
||||||
workspaceNamePrompt :: XPConfig -> (WorkspaceId -> X ()) -> X ()
|
workspaceNamePrompt :: XPConfig -> (String -> X ()) -> X ()
|
||||||
workspaceNamePrompt conf job = do
|
workspaceNamePrompt conf job = do
|
||||||
myWorkspaces <- gets $ W.workspaces . windowset
|
myWorkspaces <- gets $ map W.tag . W.workspaces . windowset
|
||||||
myWorkspacesName <- getWorkspaceNames ":" <&> \n -> [n (W.tag w) w | w <- myWorkspaces]
|
myWorkspacesName <- getWorkspaceNames >>= \f -> return $ map f myWorkspaces
|
||||||
let pairs = zip myWorkspacesName (map W.tag myWorkspaces)
|
let pairs = zip myWorkspacesName myWorkspaces
|
||||||
mkXPrompt (Wor "Select workspace: ") conf
|
mkXPrompt (Wor "Select workspace: ") conf
|
||||||
(contains myWorkspacesName)
|
(contains myWorkspacesName)
|
||||||
(job . toWsId pairs)
|
(job . toWsId pairs)
|
||||||
where toWsId pairs name = fromMaybe "" (lookup name pairs)
|
where toWsId pairs name = case lookup name pairs of
|
||||||
|
Nothing -> ""
|
||||||
|
Just i -> i
|
||||||
contains completions input =
|
contains completions input =
|
||||||
return $ filter (isInfixOf input) completions
|
return $ filter (Data.List.isInfixOf input) completions
|
||||||
|
|
||||||
-- | Modify 'XMonad.Hooks.StatusBar.PP.PP'\'s pretty-printing format to show
|
|
||||||
-- workspace names as well.
|
|
||||||
workspaceNamesPP :: PP -> X PP
|
|
||||||
workspaceNamesPP pp = getWorkspaceNames ":" <&> \ren -> pp{ ppRename = ppRename pp >=> ren }
|
|
||||||
|
|
||||||
-- | Tell "XMonad.Hooks.EwmhDesktops" to append workspace names to desktop
|
|
||||||
-- names.
|
|
||||||
workspaceNamesEwmh :: XConfig l -> XConfig l
|
|
||||||
workspaceNamesEwmh = addEwmhWorkspaceRename $ getWorkspaceNames ":"
|
|
||||||
|
@@ -3,7 +3,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Config.Arossato
|
-- Module : XMonad.Config.Arossato
|
||||||
-- Description : Andrea Rossato's xmonad configuration.
|
|
||||||
-- Copyright : (c) Andrea Rossato 2007
|
-- Copyright : (c) Andrea Rossato 2007
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -23,7 +22,7 @@ module XMonad.Config.Arossato
|
|||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
import XMonad
|
import XMonad hiding ( (|||) )
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
import XMonad.Actions.CycleWS
|
import XMonad.Actions.CycleWS
|
||||||
@@ -31,6 +30,7 @@ import XMonad.Hooks.DynamicLog hiding (xmobar)
|
|||||||
import XMonad.Hooks.ManageDocks
|
import XMonad.Hooks.ManageDocks
|
||||||
import XMonad.Hooks.ServerMode
|
import XMonad.Hooks.ServerMode
|
||||||
import XMonad.Layout.Accordion
|
import XMonad.Layout.Accordion
|
||||||
|
import XMonad.Layout.LayoutCombinators
|
||||||
import XMonad.Layout.Magnifier
|
import XMonad.Layout.Magnifier
|
||||||
import XMonad.Layout.NoBorders
|
import XMonad.Layout.NoBorders
|
||||||
import XMonad.Layout.SimpleFloat
|
import XMonad.Layout.SimpleFloat
|
||||||
@@ -147,8 +147,8 @@ arossatoConfig = do
|
|||||||
, ((modMask x , xK_F3 ), shellPrompt def )
|
, ((modMask x , xK_F3 ), shellPrompt def )
|
||||||
, ((modMask x , xK_F4 ), sshPrompt def )
|
, ((modMask x , xK_F4 ), sshPrompt def )
|
||||||
, ((modMask x , xK_F5 ), themePrompt def )
|
, ((modMask x , xK_F5 ), themePrompt def )
|
||||||
, ((modMask x , xK_F6 ), windowPrompt def Goto allWindows )
|
, ((modMask x , xK_F6 ), windowPromptGoto def )
|
||||||
, ((modMask x , xK_F7 ), windowPrompt def Bring allWindows )
|
, ((modMask x , xK_F7 ), windowPromptBring def )
|
||||||
, ((modMask x , xK_comma ), prevWS )
|
, ((modMask x , xK_comma ), prevWS )
|
||||||
, ((modMask x , xK_period), nextWS )
|
, ((modMask x , xK_period), nextWS )
|
||||||
, ((modMask x , xK_Right ), windows W.focusDown )
|
, ((modMask x , xK_Right ), windows W.focusDown )
|
||||||
|
@@ -3,7 +3,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Config.Azerty
|
-- Module : XMonad.Config.Azerty
|
||||||
-- Description : Fix some keybindings for users of French keyboard layouts.
|
|
||||||
-- Copyright : (c) Devin Mullins <me@twifkak.com>
|
-- Copyright : (c) Devin Mullins <me@twifkak.com>
|
||||||
-- License : BSD
|
-- License : BSD
|
||||||
--
|
--
|
||||||
@@ -18,7 +17,7 @@
|
|||||||
module XMonad.Config.Azerty (
|
module XMonad.Config.Azerty (
|
||||||
-- * Usage
|
-- * Usage
|
||||||
-- $usage
|
-- $usage
|
||||||
azertyConfig, azertyKeys, belgianConfig, belgianKeys
|
azertyConfig, azertyKeys
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
@@ -41,17 +40,11 @@ import qualified Data.Map as M
|
|||||||
|
|
||||||
azertyConfig = def { keys = azertyKeys <+> keys def }
|
azertyConfig = def { keys = azertyKeys <+> keys def }
|
||||||
|
|
||||||
belgianConfig = def { keys = belgianKeys <+> keys def }
|
azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $
|
||||||
|
|
||||||
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 $
|
|
||||||
[((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
|
[((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
|
||||||
++
|
++
|
||||||
[((m .|. modm, k), windows $ f i)
|
[((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)]]
|
(f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
|
||||||
++
|
++
|
||||||
-- mod-{z,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3
|
-- mod-{z,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3
|
||||||
|
@@ -3,7 +3,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Config.Bepo
|
-- Module : XMonad.Config.Bepo
|
||||||
-- Description : Fix keybindings for the BEPO keyboard layout.
|
|
||||||
-- Copyright : (c) Yorick Laupa <yo.eight@gmail.com>
|
-- Copyright : (c) Yorick Laupa <yo.eight@gmail.com>
|
||||||
-- License : BSD
|
-- License : BSD
|
||||||
--
|
--
|
||||||
@@ -40,8 +39,9 @@ import qualified Data.Map as M
|
|||||||
|
|
||||||
bepoConfig = def { keys = bepoKeys <+> keys def }
|
bepoConfig = def { keys = bepoKeys <+> keys def }
|
||||||
|
|
||||||
bepoKeys conf@XConfig { modMask = modm } = M.fromList $
|
bepoKeys conf@(XConfig { modMask = modm }) = M.fromList $
|
||||||
((modm, xK_semicolon), sendMessage (IncMasterN (-1)))
|
[((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
|
||||||
: [((m .|. modm, k), windows $ f i)
|
++
|
||||||
|
[((m .|. modm, k), windows $ f i)
|
||||||
| (i, k) <- zip (workspaces conf) [0x22,0xab,0xbb,0x28,0x29,0x40,0x2b,0x2d,0x2f,0x2a],
|
| (i, k) <- zip (workspaces conf) [0x22,0xab,0xbb,0x28,0x29,0x40,0x2b,0x2d,0x2f,0x2a],
|
||||||
(f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
|
(f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
|
||||||
|
@@ -3,7 +3,6 @@
|
|||||||
----------------------------------------------------------------------------
|
----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Config.Bluetile
|
-- Module : XMonad.Config.Bluetile
|
||||||
-- Description : Default configuration of [Bluetile](http://projects.haskell.org/bluetile/).
|
|
||||||
-- Copyright : (c) Jan Vornberger 2009
|
-- Copyright : (c) Jan Vornberger 2009
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -26,7 +25,7 @@ module XMonad.Config.Bluetile (
|
|||||||
bluetileConfig
|
bluetileConfig
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad hiding ( (|||) )
|
||||||
|
|
||||||
import XMonad.Layout.BorderResize
|
import XMonad.Layout.BorderResize
|
||||||
import XMonad.Layout.BoringWindows
|
import XMonad.Layout.BoringWindows
|
||||||
@@ -34,6 +33,7 @@ import XMonad.Layout.ButtonDecoration
|
|||||||
import XMonad.Layout.Decoration
|
import XMonad.Layout.Decoration
|
||||||
import XMonad.Layout.DecorationAddons
|
import XMonad.Layout.DecorationAddons
|
||||||
import XMonad.Layout.DraggingVisualizer
|
import XMonad.Layout.DraggingVisualizer
|
||||||
|
import XMonad.Layout.LayoutCombinators
|
||||||
import XMonad.Layout.Maximize
|
import XMonad.Layout.Maximize
|
||||||
import XMonad.Layout.Minimize
|
import XMonad.Layout.Minimize
|
||||||
import XMonad.Layout.MouseResizableTile
|
import XMonad.Layout.MouseResizableTile
|
||||||
@@ -44,7 +44,6 @@ import XMonad.Layout.WindowSwitcherDecoration
|
|||||||
|
|
||||||
import XMonad.Actions.BluetileCommands
|
import XMonad.Actions.BluetileCommands
|
||||||
import XMonad.Actions.CycleWS
|
import XMonad.Actions.CycleWS
|
||||||
import XMonad.Actions.Minimize
|
|
||||||
import XMonad.Actions.WindowMenu
|
import XMonad.Actions.WindowMenu
|
||||||
|
|
||||||
import XMonad.Hooks.CurrentWorkspaceOnTop
|
import XMonad.Hooks.CurrentWorkspaceOnTop
|
||||||
@@ -62,7 +61,8 @@ import qualified XMonad.StackSet as W
|
|||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import XMonad.Prelude(when)
|
import Data.Monoid
|
||||||
|
import Control.Monad(when)
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
|
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
|
||||||
@@ -81,7 +81,7 @@ bluetileWorkspaces :: [String]
|
|||||||
bluetileWorkspaces = ["1","2","3","4","5","6","7","8","9","0"]
|
bluetileWorkspaces = ["1","2","3","4","5","6","7","8","9","0"]
|
||||||
|
|
||||||
bluetileKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
|
bluetileKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
|
||||||
bluetileKeys conf@XConfig{XMonad.modMask = modMask'} = M.fromList $
|
bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
|
||||||
-- launching and killing programs
|
-- launching and killing programs
|
||||||
[ ((modMask' , xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal
|
[ ((modMask' , xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal
|
||||||
, ((modMask', xK_p ), gnomeRun) -- %! Launch Gnome "Run application" dialog
|
, ((modMask', xK_p ), gnomeRun) -- %! Launch Gnome "Run application" dialog
|
||||||
@@ -112,14 +112,14 @@ bluetileKeys conf@XConfig{XMonad.modMask = modMask'} = M.fromList $
|
|||||||
|
|
||||||
-- floating layer support
|
-- floating layer support
|
||||||
, ((modMask', xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling
|
, ((modMask', xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling
|
||||||
, ((modMask' .|. shiftMask, xK_t ), withFocused float ) -- %! Float window
|
, ((modMask' .|. shiftMask, xK_t ), withFocused $ float ) -- %! Float window
|
||||||
|
|
||||||
-- increase or decrease number of windows in the master area
|
-- increase or decrease number of windows in the master area
|
||||||
, ((modMask' , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area
|
, ((modMask' , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area
|
||||||
, ((modMask' , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
|
, ((modMask' , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
|
||||||
|
|
||||||
-- quit, or restart
|
-- quit, or restart
|
||||||
, ((modMask' .|. shiftMask, xK_q ), io exitSuccess) -- %! Quit
|
, ((modMask' .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit
|
||||||
, ((modMask' , xK_q ), restart "xmonad" True) -- %! Restart
|
, ((modMask' , xK_q ), restart "xmonad" True) -- %! Restart
|
||||||
|
|
||||||
-- Metacity-like workspace switching
|
-- Metacity-like workspace switching
|
||||||
@@ -143,7 +143,7 @@ bluetileKeys conf@XConfig{XMonad.modMask = modMask'} = M.fromList $
|
|||||||
|
|
||||||
-- Minimizing
|
-- Minimizing
|
||||||
, ((modMask', xK_m ), withFocused minimizeWindow)
|
, ((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
|
-- mod-[1..9] ++ [0] %! Switch to workspace N
|
||||||
@@ -159,19 +159,19 @@ bluetileKeys conf@XConfig{XMonad.modMask = modMask'} = M.fromList $
|
|||||||
, (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
|
, (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
|
||||||
|
|
||||||
bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
|
bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
|
||||||
bluetileMouseBindings XConfig{XMonad.modMask = modMask'} = M.fromList
|
bluetileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $
|
||||||
-- mod-button1 %! Move a floated window by dragging
|
-- mod-button1 %! Move a floated window by dragging
|
||||||
[ ((modMask', button1), \w -> isFloating w >>= \isF -> when isF $
|
[ ((modMask', button1), (\w -> isFloating w >>= \isF -> when (isF) $
|
||||||
focus w >> mouseMoveWindow w >> windows W.shiftMaster)
|
focus w >> mouseMoveWindow w >> windows W.shiftMaster))
|
||||||
-- mod-button2 %! Switch to next and first layout
|
-- mod-button2 %! Switch to next and first layout
|
||||||
, ((modMask', button2), \_ -> sendMessage NextLayout)
|
, ((modMask', button2), (\_ -> sendMessage NextLayout))
|
||||||
, ((modMask' .|. shiftMask, button2), \_ -> sendMessage $ JumpToLayout "Floating")
|
, ((modMask' .|. shiftMask, button2), (\_ -> sendMessage $ JumpToLayout "Floating"))
|
||||||
-- mod-button3 %! Resize a floated window by dragging
|
-- mod-button3 %! Resize a floated window by dragging
|
||||||
, ((modMask', button3), \w -> isFloating w >>= \isF -> when isF $
|
, ((modMask', button3), (\w -> isFloating w >>= \isF -> when (isF) $
|
||||||
focus w >> mouseResizeWindow w >> windows W.shiftMaster)
|
focus w >> mouseResizeWindow w >> windows W.shiftMaster))
|
||||||
]
|
]
|
||||||
|
|
||||||
isFloating :: Window -> X Bool
|
isFloating :: Window -> X (Bool)
|
||||||
isFloating w = do
|
isFloating w = do
|
||||||
ws <- gets windowset
|
ws <- gets windowset
|
||||||
return $ M.member w (W.floating ws)
|
return $ M.member w (W.floating ws)
|
||||||
@@ -182,28 +182,31 @@ bluetileManageHook = composeAll
|
|||||||
, className =? "MPlayer" --> doFloat
|
, className =? "MPlayer" --> doFloat
|
||||||
, isFullscreen --> doFullFloat]
|
, isFullscreen --> doFullFloat]
|
||||||
|
|
||||||
bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $
|
bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ (
|
||||||
named "Floating" floating |||
|
named "Floating" floating |||
|
||||||
named "Tiled1" tiled1 |||
|
named "Tiled1" tiled1 |||
|
||||||
named "Tiled2" tiled2 |||
|
named "Tiled2" tiled2 |||
|
||||||
named "Fullscreen" fullscreen
|
named "Fullscreen" fullscreen
|
||||||
|
)
|
||||||
where
|
where
|
||||||
floating = floatingDeco $ maximize $ borderResize positionStoreFloat
|
floating = floatingDeco $ maximize $ borderResize $ positionStoreFloat
|
||||||
tiled1 = tilingDeco $ maximize mouseResizableTileMirrored
|
tiled1 = tilingDeco $ maximize $ mouseResizableTileMirrored
|
||||||
tiled2 = tilingDeco $ maximize mouseResizableTile
|
tiled2 = tilingDeco $ maximize $ mouseResizableTile
|
||||||
fullscreen = tilingDeco $ maximize $ smartBorders Full
|
fullscreen = tilingDeco $ maximize $ smartBorders Full
|
||||||
|
|
||||||
tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l)
|
tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l)
|
||||||
floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l
|
floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l
|
||||||
|
|
||||||
bluetileConfig =
|
bluetileConfig =
|
||||||
docks . ewmhFullscreen . ewmh $
|
docks $
|
||||||
def
|
def
|
||||||
{ modMask = mod4Mask, -- logo key
|
{ modMask = mod4Mask, -- logo key
|
||||||
manageHook = bluetileManageHook,
|
manageHook = bluetileManageHook,
|
||||||
layoutHook = bluetileLayoutHook,
|
layoutHook = bluetileLayoutHook,
|
||||||
logHook = currentWorkspaceOnTop,
|
logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook,
|
||||||
handleEventHook = minimizeEventHook
|
handleEventHook = ewmhDesktopsEventHook
|
||||||
|
`mappend` fullscreenEventHook
|
||||||
|
`mappend` minimizeEventHook
|
||||||
`mappend` serverModeEventHook' bluetileCommands
|
`mappend` serverModeEventHook' bluetileCommands
|
||||||
`mappend` positionStoreEventHook,
|
`mappend` positionStoreEventHook,
|
||||||
workspaces = bluetileWorkspaces,
|
workspaces = bluetileWorkspaces,
|
||||||
|
@@ -3,7 +3,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Config.Desktop
|
-- Module : XMonad.Config.Desktop
|
||||||
-- Description : Core settings for interfacing with desktop environments.
|
|
||||||
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
||||||
-- License : BSD
|
-- License : BSD
|
||||||
--
|
--
|
||||||
@@ -58,7 +57,6 @@ module XMonad.Config.Desktop (
|
|||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Hooks.ManageDocks
|
import XMonad.Hooks.ManageDocks
|
||||||
import XMonad.Hooks.EwmhDesktops
|
import XMonad.Hooks.EwmhDesktops
|
||||||
import XMonad.Layout.LayoutModifier (ModifiedLayout)
|
|
||||||
import XMonad.Util.Cursor
|
import XMonad.Util.Cursor
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
@@ -166,16 +164,13 @@ import qualified Data.Map as M
|
|||||||
-- > adjustEventInput
|
-- > adjustEventInput
|
||||||
--
|
--
|
||||||
|
|
||||||
desktopConfig :: XConfig (ModifiedLayout AvoidStruts
|
|
||||||
(Choose Tall (Choose (Mirror Tall) Full)))
|
|
||||||
desktopConfig = docks $ ewmh def
|
desktopConfig = docks $ ewmh def
|
||||||
{ startupHook = setDefaultCursor xC_left_ptr <+> startupHook def
|
{ startupHook = setDefaultCursor xC_left_ptr <+> startupHook def
|
||||||
, layoutHook = desktopLayoutModifiers $ layoutHook def
|
, layoutHook = desktopLayoutModifiers $ layoutHook def
|
||||||
, keys = desktopKeys <+> keys def }
|
, keys = desktopKeys <+> keys def }
|
||||||
|
|
||||||
desktopKeys :: XConfig l -> M.Map (KeyMask, KeySym) (X ())
|
desktopKeys (XConfig {modMask = modm}) = M.fromList $
|
||||||
desktopKeys XConfig{modMask = modm} = M.fromList
|
|
||||||
[ ((modm, xK_b), sendMessage ToggleStruts) ]
|
[ ((modm, xK_b), sendMessage ToggleStruts) ]
|
||||||
|
|
||||||
desktopLayoutModifiers :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a
|
desktopLayoutModifiers layout = avoidStruts layout
|
||||||
desktopLayoutModifiers = avoidStruts
|
|
||||||
|
@@ -1,16 +1,14 @@
|
|||||||
-- boilerplate {{{
|
-- boilerplate {{{
|
||||||
{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances #-}
|
{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances #-}
|
||||||
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults #-}
|
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults #-}
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : XMonad.Config.Dmwit
|
|
||||||
-- Description : Daniel Wagner's xmonad configuration.
|
|
||||||
--
|
|
||||||
------------------------------------------------------------------------
|
|
||||||
module XMonad.Config.Dmwit where
|
module XMonad.Config.Dmwit where
|
||||||
|
|
||||||
-- system imports
|
-- system imports
|
||||||
|
import Control.Applicative
|
||||||
|
import Control.Monad
|
||||||
import Control.Monad.Trans
|
import Control.Monad.Trans
|
||||||
|
import Data.Char
|
||||||
|
import Data.List
|
||||||
import Data.Map (Map, fromList)
|
import Data.Map (Map, fromList)
|
||||||
import Data.Ratio
|
import Data.Ratio
|
||||||
import Data.Word
|
import Data.Word
|
||||||
@@ -31,10 +29,9 @@ import XMonad.Hooks.DynamicLog
|
|||||||
import XMonad.Hooks.ManageDocks
|
import XMonad.Hooks.ManageDocks
|
||||||
import XMonad.Hooks.ManageHelpers
|
import XMonad.Hooks.ManageHelpers
|
||||||
import XMonad.Layout.Grid
|
import XMonad.Layout.Grid
|
||||||
import XMonad.Layout.IndependentScreens hiding (withScreen)
|
import XMonad.Layout.IndependentScreens
|
||||||
import XMonad.Layout.Magnifier
|
import XMonad.Layout.Magnifier
|
||||||
import XMonad.Layout.NoBorders
|
import XMonad.Layout.NoBorders
|
||||||
import XMonad.Prelude
|
|
||||||
import XMonad.Util.Dzen hiding (x, y)
|
import XMonad.Util.Dzen hiding (x, y)
|
||||||
import XMonad.Util.SpawnOnce
|
import XMonad.Util.SpawnOnce
|
||||||
-- }}}
|
-- }}}
|
||||||
@@ -115,6 +112,7 @@ fullscreenMPlayer = className =? "MPlayer" --> do
|
|||||||
Just (16 :% 9) -> viewFullOn 1 "5" win
|
Just (16 :% 9) -> viewFullOn 1 "5" win
|
||||||
_ -> doFloat
|
_ -> doFloat
|
||||||
where
|
where
|
||||||
|
fi = fromIntegral :: Dimension -> Double
|
||||||
approx (n, d) = approxRational (fi n / fi d) (1/100)
|
approx (n, d) = approxRational (fi n / fi d) (1/100)
|
||||||
|
|
||||||
operationOn f s n w = do
|
operationOn f s n w = do
|
||||||
@@ -238,7 +236,7 @@ keyBindings conf = let m = modMask conf in fromList . anyMask $ [
|
|||||||
((m .|. shiftMask , xK_p ), spawnHere termLauncher),
|
((m .|. shiftMask , xK_p ), spawnHere termLauncher),
|
||||||
((m .|. shiftMask , xK_c ), kill),
|
((m .|. shiftMask , xK_c ), kill),
|
||||||
((m , xK_q ), restart "xmonad" True),
|
((m , xK_q ), restart "xmonad" True),
|
||||||
((m .|. shiftMask , xK_q ), io exitSuccess),
|
((m .|. shiftMask , xK_q ), io (exitWith ExitSuccess)),
|
||||||
((m , xK_grave ), sendMessage NextLayout),
|
((m , xK_grave ), sendMessage NextLayout),
|
||||||
((m .|. shiftMask , xK_grave ), setLayout $ layoutHook conf),
|
((m .|. shiftMask , xK_grave ), setLayout $ layoutHook conf),
|
||||||
((m , xK_o ), sendMessage Toggle),
|
((m , xK_o ), sendMessage Toggle),
|
||||||
|
@@ -2,20 +2,19 @@
|
|||||||
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
|
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Config.Droundy
|
|
||||||
-- Description : David Roundy's xmonad config.
|
|
||||||
-- Copyright : (c) Spencer Janssen 2007
|
-- Copyright : (c) Spencer Janssen 2007
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
||||||
|
|
||||||
module XMonad.Config.Droundy ( config, mytab ) where
|
module XMonad.Config.Droundy ( config, mytab ) where
|
||||||
|
|
||||||
import XMonad hiding (keys, config)
|
import XMonad hiding (keys, config, (|||))
|
||||||
import qualified XMonad (keys)
|
import qualified XMonad (keys)
|
||||||
|
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import System.Exit ( exitSuccess )
|
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
|
||||||
|
|
||||||
import XMonad.Layout.Tabbed ( tabbed,
|
import XMonad.Layout.Tabbed ( tabbed,
|
||||||
shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) )
|
shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) )
|
||||||
@@ -40,8 +39,8 @@ import XMonad.Prompt.Shell ( shellPrompt )
|
|||||||
import XMonad.Actions.CopyWindow ( kill1, copy )
|
import XMonad.Actions.CopyWindow ( kill1, copy )
|
||||||
import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace,
|
import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace,
|
||||||
selectWorkspace, renameWorkspace, removeWorkspace )
|
selectWorkspace, renameWorkspace, removeWorkspace )
|
||||||
import XMonad.Actions.CycleWS ( moveTo, hiddenWS, emptyWS,
|
import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ),
|
||||||
Direction1D( Prev, Next), WSType ((:&:), Not) )
|
Direction1D( Prev, Next) )
|
||||||
|
|
||||||
import XMonad.Hooks.ManageDocks ( avoidStruts, docks )
|
import XMonad.Hooks.ManageDocks ( avoidStruts, docks )
|
||||||
import XMonad.Hooks.EwmhDesktops ( ewmh )
|
import XMonad.Hooks.EwmhDesktops ( ewmh )
|
||||||
@@ -78,11 +77,11 @@ keys x = M.fromList $
|
|||||||
, ((modMask x, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling
|
, ((modMask x, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling
|
||||||
|
|
||||||
-- quit, or restart
|
-- quit, or restart
|
||||||
, ((modMask x .|. shiftMask, xK_Escape), io exitSuccess) -- %! Quit xmonad
|
, ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad
|
||||||
, ((modMask x , xK_Escape), restart "xmonad" True) -- %! Restart xmonad
|
, ((modMask x , xK_Escape), restart "xmonad" True) -- %! Restart xmonad
|
||||||
|
|
||||||
, ((modMask x .|. shiftMask, xK_Right), moveTo Next $ hiddenWS :&: Not emptyWS)
|
, ((modMask x .|. shiftMask, xK_Right), moveTo Next HiddenNonEmptyWS)
|
||||||
, ((modMask x .|. shiftMask, xK_Left), moveTo Prev $ hiddenWS :&: Not emptyWS)
|
, ((modMask x .|. shiftMask, xK_Left), moveTo Prev HiddenNonEmptyWS)
|
||||||
, ((modMask x, xK_Right), sendMessage $ Go R)
|
, ((modMask x, xK_Right), sendMessage $ Go R)
|
||||||
, ((modMask x, xK_Left), sendMessage $ Go L)
|
, ((modMask x, xK_Left), sendMessage $ Go L)
|
||||||
, ((modMask x, xK_Up), sendMessage $ Go U)
|
, ((modMask x, xK_Up), sendMessage $ Go U)
|
||||||
|
@@ -1,79 +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)
|
|
||||||
<+> logHook desktopConfig
|
|
||||||
}
|
|
||||||
|
|
||||||
`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
|
|
||||||
-- Handle floating windows:
|
|
||||||
[ transience -- move transient windows to their parent
|
|
||||||
, isDialog -?> doCenterFloat
|
|
||||||
] <+> composeAll
|
|
||||||
[ className =? "Pidgin" --> doFloat
|
|
||||||
, className =? "XCalc" --> doFloat
|
|
||||||
, className =? "mpv" --> doFloat
|
|
||||||
]
|
|
@@ -3,7 +3,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Config.Gnome
|
-- Module : XMonad.Config.Gnome
|
||||||
-- Description : Config for integrating xmonad with GNOME.
|
|
||||||
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
||||||
-- License : BSD
|
-- License : BSD
|
||||||
--
|
--
|
||||||
@@ -46,9 +45,9 @@ gnomeConfig = desktopConfig
|
|||||||
, keys = gnomeKeys <+> keys desktopConfig
|
, keys = gnomeKeys <+> keys desktopConfig
|
||||||
, startupHook = gnomeRegister >> startupHook desktopConfig }
|
, startupHook = gnomeRegister >> startupHook desktopConfig }
|
||||||
|
|
||||||
gnomeKeys XConfig{modMask = modm} = M.fromList
|
gnomeKeys (XConfig {modMask = modm}) = M.fromList $
|
||||||
[ ((modm, xK_p), gnomeRun)
|
[ ((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
|
-- | Launch the "Run Application" dialog. gnome-panel must be running for this
|
||||||
-- to work.
|
-- to work.
|
||||||
@@ -73,7 +72,7 @@ gnomeRun = withDisplay $ \dpy -> do
|
|||||||
-- > gconftool-2 -s /desktop/gnome/session/required_components/windowmanager xmonad --type string
|
-- > gconftool-2 -s /desktop/gnome/session/required_components/windowmanager xmonad --type string
|
||||||
gnomeRegister :: MonadIO m => m ()
|
gnomeRegister :: MonadIO m => m ()
|
||||||
gnomeRegister = io $ do
|
gnomeRegister = io $ do
|
||||||
x <- lookup "DESKTOP_AUTOSTART_ID" <$> getEnvironment
|
x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment
|
||||||
whenJust x $ \sessionId -> safeSpawn "dbus-send"
|
whenJust x $ \sessionId -> safeSpawn "dbus-send"
|
||||||
["--session"
|
["--session"
|
||||||
,"--print-reply=literal"
|
,"--print-reply=literal"
|
||||||
|
@@ -3,7 +3,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Config.Kde
|
-- Module : XMonad.Config.Kde
|
||||||
-- Description : Config for integrating xmonad with KDE.
|
|
||||||
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
||||||
-- License : BSD
|
-- License : BSD
|
||||||
--
|
--
|
||||||
@@ -48,12 +47,12 @@ kde4Config = desktopConfig
|
|||||||
{ terminal = "konsole"
|
{ terminal = "konsole"
|
||||||
, keys = kde4Keys <+> keys desktopConfig }
|
, keys = kde4Keys <+> keys desktopConfig }
|
||||||
|
|
||||||
kdeKeys XConfig{modMask = modm} = M.fromList
|
kdeKeys (XConfig {modMask = modm}) = M.fromList $
|
||||||
[ ((modm, xK_p), spawn "dcop kdesktop default popupExecuteCommand")
|
[ ((modm, xK_p), spawn "dcop kdesktop default popupExecuteCommand")
|
||||||
, ((modm .|. shiftMask, xK_q), spawn "dcop kdesktop default logout")
|
, ((modm .|. shiftMask, xK_q), spawn "dcop kdesktop default logout")
|
||||||
]
|
]
|
||||||
|
|
||||||
kde4Keys XConfig{modMask = modm} = M.fromList
|
kde4Keys (XConfig {modMask = modm}) = M.fromList $
|
||||||
[ ((modm, xK_p), spawn "krunner")
|
[ ((modm, xK_p), spawn "krunner")
|
||||||
, ((modm .|. shiftMask, xK_q), spawn "dbus-send --print-reply --dest=org.kde.ksmserver /KSMServer org.kde.KSMServerInterface.logout int32:1 int32:0 int32:1")
|
, ((modm .|. shiftMask, xK_q), spawn "dbus-send --print-reply --dest=org.kde.ksmserver /KSMServer org.kde.KSMServerInterface.logout int32:1 int32:0 int32:1")
|
||||||
]
|
]
|
||||||
|
@@ -1,46 +0,0 @@
|
|||||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : XMonad.Config.LXQt
|
|
||||||
-- Description : Config for integrating xmonad with LXQt.
|
|
||||||
-- Copyright : (c) Petr Shevtsov <petr.shevtsov@gmail.com>
|
|
||||||
-- License : BSD
|
|
||||||
--
|
|
||||||
-- Maintainer : none
|
|
||||||
-- Stability : unstable
|
|
||||||
-- Portability : unportable
|
|
||||||
--
|
|
||||||
-- This module provides a config suitable for use with the LXQt desktop
|
|
||||||
-- environment.
|
|
||||||
|
|
||||||
module XMonad.Config.LXQt (
|
|
||||||
-- * Usage
|
|
||||||
-- $usage
|
|
||||||
lxqtConfig,
|
|
||||||
desktopLayoutModifiers
|
|
||||||
) where
|
|
||||||
|
|
||||||
import XMonad
|
|
||||||
import XMonad.Config.Desktop
|
|
||||||
|
|
||||||
import qualified Data.Map as M
|
|
||||||
|
|
||||||
-- $usage
|
|
||||||
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
|
|
||||||
--
|
|
||||||
-- > import XMonad
|
|
||||||
-- > import XMonad.Config.LXQt
|
|
||||||
-- >
|
|
||||||
-- > main = xmonad lxqtConfig
|
|
||||||
--
|
|
||||||
-- For example of how to further customize @lxqtConfig@ see "XMonad.Config.Desktop".
|
|
||||||
|
|
||||||
lxqtConfig = desktopConfig
|
|
||||||
{ terminal = "qterminal"
|
|
||||||
, keys = lxqtKeys <+> keys desktopConfig }
|
|
||||||
|
|
||||||
lxqtKeys XConfig{modMask = modm} = M.fromList
|
|
||||||
[ ((modm, xK_p), spawn "lxqt-runner")
|
|
||||||
, ((modm .|. shiftMask, xK_q), spawn "lxqt-leave")
|
|
||||||
]
|
|
@@ -3,7 +3,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Config.Mate
|
-- Module : XMonad.Config.Mate
|
||||||
-- Description : Config for integrating xmonad with MATE.
|
|
||||||
-- Copyright : (c) Brandon S Allbery KF8NH, 2014
|
-- Copyright : (c) Brandon S Allbery KF8NH, 2014
|
||||||
-- License : BSD
|
-- License : BSD
|
||||||
--
|
--
|
||||||
@@ -21,18 +20,13 @@ module XMonad.Config.Mate (
|
|||||||
-- $usage
|
-- $usage
|
||||||
mateConfig,
|
mateConfig,
|
||||||
mateRun,
|
mateRun,
|
||||||
matePanel,
|
|
||||||
mateRegister,
|
mateRegister,
|
||||||
mateLogout,
|
|
||||||
mateShutdown,
|
|
||||||
desktopLayoutModifiers
|
desktopLayoutModifiers
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Config.Desktop
|
import XMonad.Config.Desktop
|
||||||
import XMonad.Util.Run (safeSpawn)
|
import XMonad.Util.Run (safeSpawn)
|
||||||
import XMonad.Util.Ungrab
|
|
||||||
import XMonad.Prelude (toUpper)
|
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
@@ -53,29 +47,21 @@ mateConfig = desktopConfig
|
|||||||
, keys = mateKeys <+> keys desktopConfig
|
, keys = mateKeys <+> keys desktopConfig
|
||||||
, startupHook = mateRegister >> startupHook desktopConfig }
|
, startupHook = mateRegister >> startupHook desktopConfig }
|
||||||
|
|
||||||
mateKeys XConfig{modMask = modm} = M.fromList
|
mateKeys (XConfig {modMask = modm}) = M.fromList $
|
||||||
[ ((modm, xK_p), mateRun)
|
[ ((modm, xK_p), mateRun)
|
||||||
, ((modm, xK_d), unGrab >> matePanel "MAIN_MENU")
|
, ((modm .|. shiftMask, xK_q), spawn "mate-session-save --logout-dialog") ]
|
||||||
, ((modm .|. shiftMask, xK_q), mateLogout) ]
|
|
||||||
|
|
||||||
-- | Launch the "Run Application" dialog. mate-panel must be running for this
|
-- | Launch the "Run Application" dialog. mate-panel must be running for this
|
||||||
-- to work. partial application for existing keybinding compatibility.
|
-- to work.
|
||||||
mateRun :: X ()
|
mateRun :: X ()
|
||||||
mateRun = matePanel "RUN_DIALOG"
|
mateRun = withDisplay $ \dpy -> do
|
||||||
|
|
||||||
-- | Launch a panel action. Either the "Run Application" dialog ("run_dialog" parameter,
|
|
||||||
-- see above) or the main menu ("main_menu" parameter). mate-panel must be running
|
|
||||||
-- for this to work.
|
|
||||||
matePanel :: String -> X ()
|
|
||||||
matePanel action = withDisplay $ \dpy -> do
|
|
||||||
let panel = "_MATE_PANEL_ACTION"
|
|
||||||
rw <- asks theRoot
|
rw <- asks theRoot
|
||||||
mate_panel <- getAtom panel
|
mate_panel <- getAtom "_MATE_PANEL_ACTION"
|
||||||
panel_action <- getAtom (panel ++ "_" ++ map toUpper action)
|
panel_run <- getAtom "_MATE_PANEL_ACTION_RUN_DIALOG"
|
||||||
|
|
||||||
io $ allocaXEvent $ \e -> do
|
io $ allocaXEvent $ \e -> do
|
||||||
setEventType e clientMessage
|
setEventType e clientMessage
|
||||||
setClientMessageEvent e rw mate_panel 32 panel_action 0
|
setClientMessageEvent e rw mate_panel 32 panel_run 0
|
||||||
sendEvent dpy rw False structureNotifyMask e
|
sendEvent dpy rw False structureNotifyMask e
|
||||||
sync dpy False
|
sync dpy False
|
||||||
|
|
||||||
@@ -91,7 +77,7 @@ matePanel action = withDisplay $ \dpy -> do
|
|||||||
-- (the extra quotes are required by dconf)
|
-- (the extra quotes are required by dconf)
|
||||||
mateRegister :: MonadIO m => m ()
|
mateRegister :: MonadIO m => m ()
|
||||||
mateRegister = io $ do
|
mateRegister = io $ do
|
||||||
x <- lookup "DESKTOP_AUTOSTART_ID" <$> getEnvironment
|
x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment
|
||||||
whenJust x $ \sessionId -> safeSpawn "dbus-send"
|
whenJust x $ \sessionId -> safeSpawn "dbus-send"
|
||||||
["--session"
|
["--session"
|
||||||
,"--print-reply=literal"
|
,"--print-reply=literal"
|
||||||
@@ -100,12 +86,3 @@ mateRegister = io $ do
|
|||||||
,"org.mate.SessionManager.RegisterClient"
|
,"org.mate.SessionManager.RegisterClient"
|
||||||
,"string:xmonad"
|
,"string:xmonad"
|
||||||
,"string:"++sessionId]
|
,"string:"++sessionId]
|
||||||
|
|
||||||
-- | Display MATE logout dialog. This is the default mod-q action.
|
|
||||||
mateLogout :: MonadIO m => m ()
|
|
||||||
mateLogout = spawn "mate-session-save --logout-dialog"
|
|
||||||
|
|
||||||
-- | Display MATE shutdown dialog. You can override mod-q to invoke this, or bind it
|
|
||||||
-- to another key if you prefer.
|
|
||||||
mateShutdown :: MonadIO m => m ()
|
|
||||||
mateShutdown = spawn "mate-session-save --shutdown-dialog"
|
|
||||||
|
@@ -20,7 +20,7 @@ module XMonad.Config.Monad where
|
|||||||
import XMonad hiding (terminal, keys)
|
import XMonad hiding (terminal, keys)
|
||||||
import qualified XMonad as X
|
import qualified XMonad as X
|
||||||
import Control.Monad.Writer
|
import Control.Monad.Writer
|
||||||
import XMonad.Prelude
|
import Data.Monoid
|
||||||
import Data.Accessor
|
import Data.Accessor
|
||||||
import Data.Accessor.Basic hiding (set)
|
import Data.Accessor.Basic hiding (set)
|
||||||
|
|
||||||
@@ -45,5 +45,5 @@ add r x = tell (mkW (r ^: mappend x))
|
|||||||
--
|
--
|
||||||
example :: Config ()
|
example :: Config ()
|
||||||
example = do
|
example = do
|
||||||
add layout $ LL [Layout Full] -- make this better
|
add layout $ LL [Layout $ Full] -- make this better
|
||||||
set terminal "urxvt"
|
set terminal "urxvt"
|
||||||
|
@@ -1,9 +1,8 @@
|
|||||||
{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, UndecidableInstances #-}
|
{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, MultiParamTypeClasses, UndecidableInstances #-}
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Config.Prime
|
-- Module : XMonad.Config.Prime
|
||||||
-- Description : Draft of a brand new config syntax for xmonad.
|
|
||||||
-- Copyright : Devin Mullins <devin.mullins@gmail.com>
|
-- Copyright : Devin Mullins <devin.mullins@gmail.com>
|
||||||
-- License : BSD-style (see LICENSE)
|
-- License : BSD-style (see LICENSE)
|
||||||
--
|
--
|
||||||
@@ -116,7 +115,7 @@ ifThenElse,
|
|||||||
import Prelude hiding ((>>), mod)
|
import Prelude hiding ((>>), mod)
|
||||||
import qualified Prelude as P ((>>=), (>>))
|
import qualified Prelude as P ((>>=), (>>))
|
||||||
|
|
||||||
import XMonad.Prelude (All)
|
import Data.Monoid (All)
|
||||||
|
|
||||||
import XMonad hiding (xmonad, XConfig(..))
|
import XMonad hiding (xmonad, XConfig(..))
|
||||||
import XMonad (XConfig(XConfig))
|
import XMonad (XConfig(XConfig))
|
||||||
@@ -479,7 +478,7 @@ wsActions = Summable wsActions_ (\x c -> c { wsActions_ = x }) (++)
|
|||||||
-- > wsSetName 1 "mail"
|
-- > wsSetName 1 "mail"
|
||||||
-- > wsSetName 2 "web"
|
-- > wsSetName 2 "web"
|
||||||
wsSetName :: Int -> String -> Arr WorkspaceConfig WorkspaceConfig
|
wsSetName :: Int -> String -> Arr WorkspaceConfig WorkspaceConfig
|
||||||
wsSetName index newName = wsNames =. zipWith (curry maybeSet) [0..]
|
wsSetName index newName = wsNames =. (map maybeSet . zip [0..])
|
||||||
where maybeSet (i, oldName) | i == (index - 1) = newName
|
where maybeSet (i, oldName) | i == (index - 1) = newName
|
||||||
| otherwise = oldName
|
| otherwise = oldName
|
||||||
|
|
||||||
@@ -498,8 +497,8 @@ withScreens :: Arr ScreenConfig ScreenConfig -> Prime l l
|
|||||||
withScreens sarr xconf = (P.>>=) (sarr def) $ \sconf -> sprime sconf xconf
|
withScreens sarr xconf = (P.>>=) (sarr def) $ \sconf -> sprime sconf xconf
|
||||||
where sprime :: ScreenConfig -> Prime l l
|
where sprime :: ScreenConfig -> Prime l l
|
||||||
sprime sconf =
|
sprime sconf =
|
||||||
keys =+ [(mod ++ key, action sid) | (sid, key) <- zip [0..] (sKeys_ sconf),
|
(keys =+ [(mod ++ key, action sid) | (sid, key) <- zip [0..] (sKeys_ sconf),
|
||||||
(mod, action) <- sActions_ sconf]
|
(mod, action) <- sActions_ sconf])
|
||||||
|
|
||||||
data ScreenConfig = ScreenConfig {
|
data ScreenConfig = ScreenConfig {
|
||||||
sKeys_ :: [String],
|
sKeys_ :: [String],
|
||||||
|
@@ -1,78 +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
|
|
@@ -1,10 +1,4 @@
|
|||||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||||
-----------------------------------------------------------------------------
|
|
||||||
-- |
|
|
||||||
-- Module : XMonad.Config.Sjanssen
|
|
||||||
-- Description : Spencer Janssen's xmonad config.
|
|
||||||
--
|
|
||||||
------------------------------------------------------------------------
|
|
||||||
module XMonad.Config.Sjanssen (sjanssenConfig) where
|
module XMonad.Config.Sjanssen (sjanssenConfig) where
|
||||||
|
|
||||||
import XMonad hiding (Tall(..))
|
import XMonad hiding (Tall(..))
|
||||||
@@ -30,10 +24,10 @@ sjanssenConfig =
|
|||||||
docks $ ewmh $ def
|
docks $ ewmh $ def
|
||||||
{ terminal = "exec urxvt"
|
{ terminal = "exec urxvt"
|
||||||
, workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]
|
, workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]
|
||||||
, mouseBindings = \XConfig {modMask = modm} -> M.fromList
|
, mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $
|
||||||
[ ((modm, button1), \w -> focus w >> mouseMoveWindow w)
|
[ ((modm, button1), (\w -> focus w >> mouseMoveWindow w))
|
||||||
, ((modm, button2), \w -> focus w >> windows W.swapMaster)
|
, ((modm, button2), (\w -> focus w >> windows W.swapMaster))
|
||||||
, ((modm.|. shiftMask, button1), \w -> focus w >> mouseResizeWindow w) ]
|
, ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ]
|
||||||
, keys = \c -> mykeys c `M.union` keys def c
|
, keys = \c -> mykeys c `M.union` keys def c
|
||||||
, logHook = dynamicLogString sjanssenPP >>= xmonadPropLog
|
, logHook = dynamicLogString sjanssenPP >>= xmonadPropLog
|
||||||
, layoutHook = modifiers layouts
|
, layoutHook = modifiers layouts
|
||||||
@@ -56,12 +50,12 @@ sjanssenConfig =
|
|||||||
, "trayer --transparent true --expand true --align right "
|
, "trayer --transparent true --expand true --align right "
|
||||||
++ "--edge bottom --widthtype request" ]
|
++ "--edge bottom --widthtype request" ]
|
||||||
|
|
||||||
mykeys XConfig{modMask = modm} = M.fromList
|
mykeys (XConfig {modMask = modm}) = M.fromList $
|
||||||
[((modm, xK_p ), shellPromptHere myPromptConfig)
|
[((modm, xK_p ), shellPromptHere myPromptConfig)
|
||||||
,((modm .|. shiftMask, xK_Return), spawnHere =<< asks (terminal . config))
|
,((modm .|. shiftMask, xK_Return), spawnHere =<< asks (terminal . config))
|
||||||
,((modm .|. shiftMask, xK_c ), kill1)
|
,((modm .|. shiftMask, xK_c ), kill1)
|
||||||
,((modm .|. shiftMask .|. controlMask, xK_c ), kill)
|
,((modm .|. shiftMask .|. controlMask, xK_c ), kill)
|
||||||
,((modm .|. shiftMask, xK_0 ), windows copyToAll)
|
,((modm .|. shiftMask, xK_0 ), windows $ copyToAll)
|
||||||
,((modm, xK_z ), layoutScreens 2 $ TwoPane 0.5 0.5)
|
,((modm, xK_z ), layoutScreens 2 $ TwoPane 0.5 0.5)
|
||||||
,((modm .|. shiftMask, xK_z ), rescreen)
|
,((modm .|. shiftMask, xK_z ), rescreen)
|
||||||
, ((modm , xK_b ), sendMessage ToggleStruts)
|
, ((modm , xK_b ), sendMessage ToggleStruts)
|
||||||
|
@@ -3,7 +3,6 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Config.Xfce
|
-- Module : XMonad.Config.Xfce
|
||||||
-- Description : Config for integrating xmonad with Xfce.
|
|
||||||
-- Copyright : (c) Ivan Miljenovic <Ivan.Miljenovic@gmail.com>
|
-- Copyright : (c) Ivan Miljenovic <Ivan.Miljenovic@gmail.com>
|
||||||
-- License : BSD
|
-- License : BSD
|
||||||
--
|
--
|
||||||
@@ -37,10 +36,10 @@ import qualified Data.Map as M
|
|||||||
-- For examples of how to further customize @xfceConfig@ see "XMonad.Config.Desktop".
|
-- For examples of how to further customize @xfceConfig@ see "XMonad.Config.Desktop".
|
||||||
|
|
||||||
xfceConfig = desktopConfig
|
xfceConfig = desktopConfig
|
||||||
{ terminal = "xfce4-terminal"
|
{ terminal = "Terminal"
|
||||||
, keys = xfceKeys <+> keys desktopConfig }
|
, keys = xfceKeys <+> keys desktopConfig }
|
||||||
|
|
||||||
xfceKeys XConfig{modMask = modm} = M.fromList
|
xfceKeys (XConfig {modMask = modm}) = M.fromList $
|
||||||
[ ((modm, xK_p), spawn "xfrun4")
|
[ ((modm, xK_p), spawn "xfrun4")
|
||||||
, ((modm .|. shiftMask, xK_p), spawn "xfce4-appfinder")
|
, ((modm .|. shiftMask, xK_p), spawn "xfce4-appfinder")
|
||||||
, ((modm .|. shiftMask, xK_q), spawn "xfce4-session-logout")
|
, ((modm .|. shiftMask, xK_q), spawn "xfce4-session-logout")
|
||||||
|
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user