xmonad-contrib-0.12/0000755000000000000000000000000012636047674012565 5ustar0000000000000000xmonad-contrib-0.12/README.md0000644000000000000000000000261512636047674014050 0ustar0000000000000000# xmonad-contrib: Third Party Extensions to the xmonad Window Manager You need the ghc compiler and xmonad window manager installed in order to use these extensions. For installation and configuration instructions, please see the [xmonad website] [xmonad], the documents included with the [xmonad source distribution] [xmonad-git], and the [online haddock documentation] [xmonad-docs]. ## Getting or Updating XMonadContrib * Latest release: * Git version: (To use git xmonad-contrib you must also use the [git version of xmonad] [xmonad-git].) ## Contributing 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: XMonad.Layout.Grid For further details, see the [documentation] [developing] for the `XMonad.Doc.Developing` module and the [xmonad website] [xmonad]. ## License Code submitted to the contrib repo is licensed under the same license as xmonad itself, with copyright held by the authors. [xmonad]: http://xmonad.org [xmonad-git]: https://github.com/xmonad/xmonad [xmonad-docs]: http://www.xmonad.org/xmonad-docs [developing]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html xmonad-contrib-0.12/xmonad-contrib.cabal0000644000000000000000000003471212636047674016504 0ustar0000000000000000name: xmonad-contrib version: 0.12 homepage: http://xmonad.org/ synopsis: Third party extensions for xmonad description: Third party tiling algorithms, configurations and scripts to xmonad, a tiling window manager for X. . For an introduction to building, configuring and using xmonad extensions, see "XMonad.Doc". In particular: . "XMonad.Doc.Configuring", a guide to configuring xmonad . "XMonad.Doc.Extending", using the contributed extensions library . "XMonad.Doc.Developing", introduction to xmonad internals and writing your own extensions. . category: System license: BSD3 license-file: LICENSE author: Spencer Janssen & others maintainer: xmonad@haskell.org extra-source-files: README.md CHANGES.md scripts/generate-configs scripts/run-xmonad.sh scripts/window-properties.sh scripts/xinitrc scripts/xmonad-acpi.c scripts/xmonad-clock.c tests/genMain.hs tests/ManageDocks.hs tests/Selective.hs tests/SwapWorkspaces.hs tests/XPrompt.hs XMonad/Config/dmwit.xmobarrc cabal-version: >= 1.6 build-type: Simple bug-reports: https://github.com/xmonad/xmonad-contrib/issues tested-with: GHC==7.6.3, GHC==7.8.4, GHC==7.10.2 source-repository head type: git location: https://github.com/xmonad/xmonad-contrib flag use_xft description: Use Xft to render text flag testing description: Testing mode manual: True default: False library build-depends: base >= 3 && < 5, containers, directory, extensible-exceptions, filepath, old-locale, old-time, process, random, mtl >= 1 && < 3, unix, X11>=1.6.1 && < 1.7, xmonad>=0.12 && < 0.13, utf8-string if flag(use_xft) build-depends: X11-xft >= 0.2 cpp-options: -DXFT if true ghc-options: -fwarn-tabs -Wall if flag(testing) ghc-options: -fwarn-tabs -Werror if impl(ghc >= 6.12.1) ghc-options: -fno-warn-unused-do-bind if impl (ghc == 6.10.1) && arch (x86_64) ghc-options: -O0 exposed-modules: XMonad.Doc XMonad.Doc.Configuring XMonad.Doc.Extending XMonad.Doc.Developing XMonad.Actions.AfterDrag XMonad.Actions.BluetileCommands XMonad.Actions.Commands XMonad.Actions.ConstrainedResize XMonad.Actions.CopyWindow XMonad.Actions.CycleRecentWS XMonad.Actions.CycleSelectedLayouts XMonad.Actions.CycleWindows XMonad.Actions.CycleWS XMonad.Actions.DeManage XMonad.Actions.DwmPromote XMonad.Actions.DynamicWorkspaces XMonad.Actions.DynamicWorkspaceGroups XMonad.Actions.DynamicWorkspaceOrder XMonad.Actions.DynamicProjects XMonad.Actions.FindEmptyWorkspace XMonad.Actions.FlexibleManipulate XMonad.Actions.FlexibleResize XMonad.Actions.FloatKeys XMonad.Actions.FloatSnap XMonad.Actions.FocusNth XMonad.Actions.GridSelect XMonad.Actions.GroupNavigation XMonad.Actions.Launcher XMonad.Actions.LinkWorkspaces XMonad.Actions.MessageFeedback XMonad.Actions.MouseGestures XMonad.Actions.MouseResize XMonad.Actions.Navigation2D XMonad.Actions.NoBorders XMonad.Actions.OnScreen XMonad.Actions.PerWorkspaceKeys XMonad.Actions.PhysicalScreens XMonad.Actions.Plane XMonad.Actions.Promote XMonad.Actions.RandomBackground XMonad.Actions.KeyRemap XMonad.Actions.RotSlaves XMonad.Actions.Search XMonad.Actions.ShowText XMonad.Actions.SimpleDate XMonad.Actions.SinkAll XMonad.Actions.SpawnOn XMonad.Actions.Submap XMonad.Actions.SwapWorkspaces XMonad.Actions.TagWindows XMonad.Actions.TopicSpace XMonad.Actions.UpdateFocus XMonad.Actions.UpdatePointer XMonad.Actions.Warp XMonad.Actions.WindowBringer XMonad.Actions.WindowGo XMonad.Actions.WindowMenu XMonad.Actions.WindowNavigation XMonad.Actions.WithAll XMonad.Actions.WorkspaceCursors XMonad.Actions.WorkspaceNames XMonad.Actions.Workscreen XMonad.Config.Arossato XMonad.Config.Azerty XMonad.Config.Bluetile XMonad.Config.Bepo XMonad.Config.Desktop XMonad.Config.Dmwit XMonad.Config.Droundy XMonad.Config.Gnome XMonad.Config.Kde XMonad.Config.Mate XMonad.Config.Prime XMonad.Config.Sjanssen XMonad.Config.Xfce XMonad.Hooks.CurrentWorkspaceOnTop XMonad.Hooks.DebugEvents XMonad.Hooks.DebugKeyEvents XMonad.Hooks.DynamicBars XMonad.Hooks.DynamicHooks XMonad.Hooks.DynamicLog XMonad.Hooks.DynamicProperty XMonad.Hooks.DebugStack XMonad.Hooks.EwmhDesktops XMonad.Hooks.FadeInactive XMonad.Hooks.FadeWindows XMonad.Hooks.FloatNext XMonad.Hooks.ICCCMFocus XMonad.Hooks.InsertPosition XMonad.Hooks.ManageDebug XMonad.Hooks.ManageDocks XMonad.Hooks.ManageHelpers XMonad.Hooks.Minimize XMonad.Hooks.Place XMonad.Hooks.PositionStoreHooks XMonad.Hooks.RestoreMinimized XMonad.Hooks.ScreenCorners XMonad.Hooks.Script XMonad.Hooks.ServerMode XMonad.Hooks.SetWMName XMonad.Hooks.ToggleHook XMonad.Hooks.UrgencyHook XMonad.Hooks.WallpaperSetter XMonad.Hooks.WorkspaceByPos XMonad.Hooks.WorkspaceHistory XMonad.Hooks.XPropManage XMonad.Layout.Accordion XMonad.Layout.AutoMaster XMonad.Layout.AvoidFloats XMonad.Layout.BinarySpacePartition XMonad.Layout.BorderResize XMonad.Layout.BoringWindows XMonad.Layout.ButtonDecoration XMonad.Layout.CenteredMaster XMonad.Layout.Circle XMonad.Layout.Column XMonad.Layout.Combo XMonad.Layout.ComboP XMonad.Layout.Cross XMonad.Layout.Decoration XMonad.Layout.DecorationAddons XMonad.Layout.DecorationMadness XMonad.Layout.Dishes XMonad.Layout.DraggingVisualizer XMonad.Layout.DragPane XMonad.Layout.Drawer XMonad.Layout.Dwindle XMonad.Layout.DwmStyle XMonad.Layout.FixedColumn XMonad.Layout.Fullscreen XMonad.Layout.Gaps XMonad.Layout.Grid XMonad.Layout.GridVariants XMonad.Layout.Groups XMonad.Layout.Groups.Examples XMonad.Layout.Groups.Helpers XMonad.Layout.Groups.Wmii XMonad.Layout.Hidden XMonad.Layout.HintedGrid XMonad.Layout.HintedTile XMonad.Layout.IfMax XMonad.Layout.IM XMonad.Layout.ImageButtonDecoration XMonad.Layout.IndependentScreens XMonad.Layout.LayoutBuilder XMonad.Layout.LayoutBuilderP XMonad.Layout.LayoutCombinators XMonad.Layout.LayoutHints XMonad.Layout.LayoutModifier XMonad.Layout.LayoutScreens XMonad.Layout.LimitWindows XMonad.Layout.MagicFocus XMonad.Layout.Magnifier XMonad.Layout.Master XMonad.Layout.Maximize XMonad.Layout.MessageControl XMonad.Layout.Minimize XMonad.Layout.Monitor XMonad.Layout.Mosaic XMonad.Layout.MosaicAlt XMonad.Layout.MouseResizableTile XMonad.Layout.MultiColumns XMonad.Layout.MultiToggle XMonad.Layout.MultiToggle.Instances XMonad.Layout.Named XMonad.Layout.NoBorders XMonad.Layout.NoFrillsDecoration XMonad.Layout.OnHost XMonad.Layout.OneBig XMonad.Layout.PerScreen XMonad.Layout.PerWorkspace XMonad.Layout.PositionStoreFloat XMonad.Layout.Reflect XMonad.Layout.Renamed XMonad.Layout.ResizableTile XMonad.Layout.ResizeScreen XMonad.Layout.Roledex XMonad.Layout.ShowWName XMonad.Layout.SimpleDecoration XMonad.Layout.SimpleFloat XMonad.Layout.Simplest XMonad.Layout.SimplestFloat XMonad.Layout.Spacing XMonad.Layout.Spiral XMonad.Layout.Square XMonad.Layout.StackTile XMonad.Layout.Stoppable XMonad.Layout.SubLayouts XMonad.Layout.TabBarDecoration XMonad.Layout.Tabbed XMonad.Layout.ThreeColumns XMonad.Layout.ToggleLayouts XMonad.Layout.TrackFloating XMonad.Layout.TwoPane XMonad.Layout.WindowArranger XMonad.Layout.WindowNavigation XMonad.Layout.WindowSwitcherDecoration XMonad.Layout.WorkspaceDir XMonad.Layout.ZoomRow XMonad.Prompt XMonad.Prompt.AppendFile XMonad.Prompt.AppLauncher XMonad.Prompt.ConfirmPrompt XMonad.Prompt.Directory XMonad.Prompt.DirExec XMonad.Prompt.Email XMonad.Prompt.Input XMonad.Prompt.Layout XMonad.Prompt.Man XMonad.Prompt.Pass XMonad.Prompt.RunOrRaise XMonad.Prompt.Shell XMonad.Prompt.Ssh XMonad.Prompt.Theme XMonad.Prompt.Window XMonad.Prompt.Workspace XMonad.Prompt.XMonad XMonad.Util.Cursor XMonad.Util.CustomKeys XMonad.Util.DebugWindow XMonad.Util.Dmenu XMonad.Util.Dzen XMonad.Util.ExtensibleState XMonad.Util.EZConfig XMonad.Util.Font XMonad.Util.Image XMonad.Util.Invisible XMonad.Util.Loggers XMonad.Util.NamedActions XMonad.Util.NamedScratchpad XMonad.Util.NamedWindows XMonad.Util.Paste XMonad.Util.PositionStore XMonad.Util.RemoteWindows XMonad.Util.Replace XMonad.Util.Run XMonad.Util.Scratchpad XMonad.Util.SpawnOnce XMonad.Util.SpawnNamedPipe XMonad.Util.Stack XMonad.Util.StringProp XMonad.Util.Themes XMonad.Util.Timer XMonad.Util.Types XMonad.Util.WindowProperties XMonad.Util.WindowState XMonad.Util.WorkspaceCompare XMonad.Util.XSelection XMonad.Util.XUtils xmonad-contrib-0.12/LICENSE0000644000000000000000000000270012636047674013571 0ustar0000000000000000Copyright (c) The Xmonad Community All rights reserved. Redistribution and use in source and binary forms, with or without 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. THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xmonad-contrib-0.12/CHANGES.md0000644000000000000000000001623012636047674014161 0ustar0000000000000000# Change Log / Release Notes ## 0.12 (December 14, 2015) ### Breaking Changes * `XMonad.Actions.UpdatePointer.updatePointer` arguments were changed. This allows including aspects of both of the `TowardsCentre` and `Relative` methods. To keep the same behavior, replace the entry in the left column with the entry on the right: | < 0.12 | >= 0.12 | |-------------------------------------|----------------------------------| | `updatePointer Nearest` | `updatePointer (0.5, 0.5) (1,1)` | | `updatePointer (Relative x y)` | `updatePointer (x,y) (1,1)` | | `updatePointer (TowardsCentre x y)` | `updatePointer (0.5,0.5) (x,y)` | ### New Modules * `XMonad.Actions.AfterDrag` Perform an action after the current mouse drag is completed. * `XMonad.Actions.DynamicProjects` Imbues workspaces with additional features so they can be treated as individual project areas. * `XMonad.Actions.LinkWorkspaces` Provides bindings to add and delete links between workspaces. It is aimed at providing useful links between workspaces in a multihead setup. Linked workspaces are viewed at the same time. * `XMonad.Config.Bepo` This module fixes some of the keybindings for the francophone among you who use a BEPO keyboard layout. Based on `XMonad.Config.Azerty` * `XMonad.Config.Dmwit` Daniel Wagner's configuration. * `XMonad.Config.Mate` This module provides a config suitable for use with the MATE desktop environment. * `XMonad.Config.Prime` A draft of a brand new config syntax for xmonad. * `XMonad.Hooks.DynamicProperty` Module to apply a `ManageHook` to an already-mapped window when a property changes. This would commonly be used to match browser windows by title, since the final title will only be set after (a) the window is mapped, (b) its document has been loaded, (c) all load-time scripts have run. * `XMonad.Hooks.ManageDebug` A `manageHook` and associated `logHook` for debugging `ManageHook`s. Simplest usage: wrap your xmonad config in the `debugManageHook` combinator. Or use `debugManageHookOn` for a triggerable version, specifying the triggering key sequence in `XMonad.Util.EZConfig` syntax. Or use the individual hooks in whatever way you see fit. * `XMonad.Hooks.WallpaperSetter` Log hook which changes the wallpapers depending on visible workspaces. * `XMonad.Hooks.WorkspaceHistory` Keeps track of workspace viewing order. * `XMonad.Layout.AvoidFloats` Find a maximum empty rectangle around floating windows and use that area to display non-floating windows. * `XMonad.Layout.BinarySpacePartition` Layout where new windows will split the focused window in half, based off of BSPWM. * `XMonad.Layout.Dwindle` Three layouts: The first, `Spiral`, is a reimplementation of `XMonad.Layout.Spiral.spiral` with, at least to me, more intuitive semantics. The second, `Dwindle`, is inspired by a similar layout in awesome and produces the same sequence of decreasing window sizes as Spiral but pushes the smallest windows into a screen corner rather than the centre. The third, `Squeeze` arranges all windows in one row or in one column, with geometrically decreasing sizes. * `XMonad.Layout.Hidden` Similar to `XMonad.Layout.Minimize` but completely removes windows from the window set so `XMonad.Layout.BoringWindows` isn't necessary. Perfect companion to `XMonad.Layout.BinarySpacePartition` since it can be used to move windows to another part of the BSP tree. * `XMonad.Layout.IfMax` Provides `IfMax` layout, which will run one layout if there are maximum `N` windows on workspace, and another layout, when number of windows is greater than `N`. * `XMonad.Layout.PerScreen` Configure layouts based on the width of your screen; use your favorite multi-column layout for wide screens and a full-screen layout for small ones. * `XMonad.Layout.Stoppable` This module implements a special kind of layout modifier, which when applied to a layout, causes xmonad to stop all non-visible processes. In a way, this is a sledge-hammer for applications that drain power. For example, given a web browser on a stoppable workspace, once the workspace is hidden the web browser will be stopped. * `XMonad.Prompt.ConfirmPrompt` A module for setting up simple confirmation prompts for keybindings. * `XMonad.Prompt.Pass` This module provides 3 `XMonad.Prompt`s to ease passwords manipulation (generate, read, remove) via [pass][]. * `XMonad.Util.RemoteWindows` This module implements a proper way of finding out whether the window is remote or local. * `XMonad.Util.SpawnNamedPipe` A module for spawning a pipe whose `Handle` lives in the xmonad state. * `XMonad.Util.WindowState` Functions for saving per-window data. ### Miscellaneous Changes * Fix issue #9: `XMonad.Prompt.Shell` `searchPredicate` is ignored, defaults to `isPrefixOf` * Fix moveHistory when alwaysHighlight is enabled * `XMonad.Actions.DynamicWorkspaceGroups` now exports `addRawWSGroup` * Side tabs were added to the tabbed layout * `XMonad/Layout/IndependentScreens` now exports `marshallSort` * `XMonad/Hooks/UrgencyHook` now exports `clearUrgency` * Exceptions are now caught when finding commands on `PATH` in `Prompt.Shell` * Switched to `Data.Default` wherever possible * `XMonad.Layout.IndependentScreens` now exports `whenCurrentOn` * `XMonad.Util.NamedActions` now exports `addDescrKeys'` * EWMH `DEMANDS_ATTENTION` support added to `UrgencyHook` * New `useTransientFor` modifier in `XMonad.Layout.TrackFloating` * Added the ability to remove arbitrary workspaces ## 0.9 (October 26, 2009) ### Updates that Require Changes in `xmonad.hs` * `XMonad.Hooks.EwmhDesktops` no longer uses `layoutHook`, the `ewmhDesktopsLayout` modifier has been removed from xmonad-contrib. It uses `logHook`, `handleEventHook`, and `startupHook` instead and provides a convenient function `ewmh` to add EWMH support to a `defaultConfig`. * Most `DynamicLog` users can continue with configs unchanged, but users of the quickbar functions `xmobar` or `dzen` will need to change `xmonad.hs`: their types have changed to allow easier composition with other `XConfig` modifiers. The `dynamicLogDzen` and `dynamicLogXmobar` functions have been removed. * `WindowGo` or `safeSpawn` users may need to change command lines due to `safeSpawn` changes. * People explicitly referencing the "SP" scratchpad workspace should change it to "NSP" which is also used by the new `Util.NamedScratchpad` module. * (Optional) People who explicitly use `swapMaster` in key or mouse bindings should change it to `shiftMaster`. It's the current default used where `swapMaster` had been used previously. It works better than `swapMaster` when using floating and tiled windows together on the same workspace. ## See Also [pass]: http://www.passwordstore.org/ xmonad-contrib-0.12/Setup.lhs0000644000000000000000000000011412636047674014371 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain xmonad-contrib-0.12/scripts/0000755000000000000000000000000012636047674014254 5ustar0000000000000000xmonad-contrib-0.12/scripts/generate-configs0000644000000000000000000002572012636047674017425 0ustar0000000000000000#!/bin/bash # generate-configs - Docstring parser for generating xmonad build configs with # default settings for extensions # Author: Alex Tarkovsky # Released into the public domain # This script parses custom docstrings specifying build-time configuration data # from xmonad extension source files, then inserts the data into copies of # xmonad's Config.hs and xmonad.cabal files accordingly. # # Usage: generate-configs [ OPTIONS ] --main MAIN_DIR --contrib CONTRIB_DIR # # OPTIONS: # --active, -a Insert data in active mode (default: passive) # --contrib, -c CONTRIB_DIR Path to contrib repository base directory # --help, -h Show help # --main, -m MAIN_DIR Path to main repository base directory # --output, -o OUTPUT_DIR Output directory (default: CONTRIB_DIR) # # Data parsed from the extension source files is inserted into Config.hs in # either active or passive mode. The default is passive mode, in which the # inserted data is commented out. The --active option inserts the data # uncommented. Data inserted into xmonad.cabal is always inserted in active # mode regardless of specified options. # # The docstring markup can be extended as needed. Currently the following tags # are defined, shown with some examples: # # ~~~~~ # # %cabalbuilddep # # Cabal build dependency. Value is appended to the "build-depends" line in # xmonad.cabal and automatically prefixed with ", ". NB: Don't embed # comments in this tag! # # -- %cabalbuilddep readline>=1.0 # # %def # # General definition. Value is appended to the end of Config.sh. # # -- %def commands :: [(String, X ())] # -- %def commands = defaultCommands # # %import # # Module needed by Config.sh to build the extension. Value is appended to # the end of the default import list in Config.sh and automatically # prefixed with "import ". # # -- %import XMonad.Layout.Accordion # -- %import qualified XMonad.Actions.FlexibleManipulate as Flex # # %keybind # # Tuple defining a key binding. Must be prefixed with ", ". Value is # inserted at the end of the "keys" list in Config.sh. # # -- %keybind , ((modMask, xK_d), date) # # %keybindlist # # Same as %keybind, but instead of a key binding tuple the definition is a # list of key binding tuples (or a list comprehension producing them). This # list is concatenated to the "keys" list must begin with the "++" operator # rather than ", ". # # -- %keybindlist ++ # -- %keybindlist -- mod-[1..9] @@ Switch to workspace N # -- %keybindlist -- mod-shift-[1..9] @@ Move client to workspace N # -- %keybindlist -- mod-control-shift-[1..9] @@ Copy client to workspace N # -- %keybindlist [((m .|. modMask, k), f i) # -- %keybindlist | (i, k) <- zip [0..fromIntegral (workspaces-1)] [xK_1 ..] # -- %keybindlist , (f, m) <- [(view, 0), (shift, shiftMask), (copy, shiftMask .|. controlMask)]] # # %layout # # A layout. Must be prefixed with ", ". Value is inserted at the end of the # "defaultLayouts" list in Config.sh. # # -- %layout , accordion # # %mousebind # # Tuple defining a mouse binding. Must be prefixed with ", ". Value is # inserted at the end of the "mouseBindings" list in Config.sh. # # -- %mousebind , ((modMask, button3), (\\w -> focus w >> Flex.mouseResizeWindow w)) # # ~~~~~ # # NB: '/' and '\' characters must be escaped with a '\' character! # # Tags may also contain comments, as illustrated in the %keybindlist examples # above. Comments are a good place for special user instructions: # # -- %def -- comment out default logHook definition above if you uncomment this: # -- %def logHook = dynamicLog # Markup tag to search for in source files. TAG_CABALBUILDDEP="%cabalbuilddep" TAG_DEF="%def" TAG_IMPORT="%import" TAG_KEYBIND="%keybind" TAG_KEYBINDLIST="%keybindlist" TAG_LAYOUT="%layout" TAG_MOUSEBIND="%mousebind" # Insert markers to search for in Config.sh and xmonad.cabal. Values are # extended sed regular expressions. INS_MARKER_CABALBUILDDEP='^build-depends:.*' INS_MARKER_IMPORT='-- % Extension-provided imports$' INS_MARKER_LAYOUT='-- % Extension-provided layouts$' INS_MARKER_KEYBIND='-- % Extension-provided key bindings$' INS_MARKER_KEYBINDLIST='-- % Extension-provided key bindings lists$' INS_MARKER_MOUSEBIND='-- % Extension-provided mouse bindings$' INS_MARKER_DEF='-- % Extension-provided definitions$' # Literal indentation strings. Values may contain escaped chars such as \t. INS_INDENT_CABALBUILDDEP="" INS_INDENT_DEF="" INS_INDENT_IMPORT="" INS_INDENT_KEYBIND=" " INS_INDENT_KEYBINDLIST=" " INS_INDENT_LAYOUT=" " INS_INDENT_MOUSEBIND=" " # Prefix applied to inserted passive data after indent strings have been applied. INS_PREFIX_DEF="-- " INS_PREFIX_IMPORT="--import " INS_PREFIX_KEYBIND="-- " INS_PREFIX_KEYBINDLIST="-- " INS_PREFIX_LAYOUT="-- " INS_PREFIX_MOUSEBIND="-- " # Prefix applied to inserted active data after indent strings have been applied. ACTIVE_INS_PREFIX_CABALBUILDDEP=", " ACTIVE_INS_PREFIX_DEF="" ACTIVE_INS_PREFIX_IMPORT="import " ACTIVE_INS_PREFIX_KEYBIND="" ACTIVE_INS_PREFIX_KEYBINDLIST="" ACTIVE_INS_PREFIX_LAYOUT="" ACTIVE_INS_PREFIX_MOUSEBIND="" # Don't touch these opt_active=0 opt_contrib="" opt_main="" opt_output="" generate_configs() { for extension_srcfile in $(ls --color=never -1 "${opt_contrib}"/*.hs | head -n -1 | sort -r) ; do for tag in $TAG_CABALBUILDDEP \ $TAG_DEF \ $TAG_IMPORT \ $TAG_KEYBIND \ $TAG_KEYBINDLIST \ $TAG_LAYOUT \ $TAG_MOUSEBIND ; do ifs="$IFS" IFS=$'\n' tags=( $(sed -n -r -e "s/^.*--\s*${tag}\s//p" "${extension_srcfile}") ) IFS="${ifs}" case $tag in $TAG_CABALBUILDDEP) ins_indent=$INS_INDENT_CABALBUILDDEP ins_marker=$INS_MARKER_CABALBUILDDEP ins_prefix=$ACTIVE_INS_PREFIX_CABALBUILDDEP ;; $TAG_DEF) ins_indent=$INS_INDENT_DEF ins_marker=$INS_MARKER_DEF ins_prefix=$INS_PREFIX_DEF ;; $TAG_IMPORT) ins_indent=$INS_INDENT_IMPORT ins_marker=$INS_MARKER_IMPORT ins_prefix=$INS_PREFIX_IMPORT ;; $TAG_KEYBIND) ins_indent=$INS_INDENT_KEYBIND ins_marker=$INS_MARKER_KEYBIND ins_prefix=$INS_PREFIX_KEYBIND ;; $TAG_KEYBINDLIST) ins_indent=$INS_INDENT_KEYBINDLIST ins_marker=$INS_MARKER_KEYBINDLIST ins_prefix=$INS_PREFIX_KEYBINDLIST ;; $TAG_LAYOUT) ins_indent=$INS_INDENT_LAYOUT ins_marker=$INS_MARKER_LAYOUT ins_prefix=$INS_PREFIX_LAYOUT ;; $TAG_MOUSEBIND) ins_indent=$INS_INDENT_MOUSEBIND ins_marker=$INS_MARKER_MOUSEBIND ins_prefix=$INS_PREFIX_MOUSEBIND ;; esac # Insert in reverse so values will ultimately appear in correct order. for i in $( seq $(( ${#tags[*]} - 1 )) -1 0 ) ; do [ -z "${tags[i]}" ] && continue if [[ $tag == $TAG_CABALBUILDDEP ]] ; then sed -i -r -e "s/${ins_marker}/\\0${ins_prefix}${tags[i]}/" "${CABAL_FILE}" else sed -i -r -e "/${ins_marker}/{G;s/$/${ins_indent}${ins_prefix}${tags[i]}/;}" "${CONFIG_FILE}" fi done if [[ $tag != $TAG_CABALBUILDDEP && -n "${tags}" ]] ; then ins_group_comment="${ins_indent}-- For extension $(basename $extension_srcfile .hs):" sed -i -r -e "/${ins_marker}/{G;s/$/${ins_group_comment}/;}" "${CONFIG_FILE}" fi done done } parse_opts() { [[ -z "$1" ]] && show_usage 1 while [[ $# > 0 ]] ; do case "$1" in --active|-a) opt_active=1 shift ;; --contrib|-c) shift if [[ -z "$1" || ! -d "$1" ]] ; then echo "Error: Option --contrib requires a directory as argument. See: generate-configs -h" exit 1 fi opt_contrib="$1" shift ;; --help|-h) show_usage ;; --main|-m) shift if [[ -z "$1" || ! -d "$1" ]] ; then echo "Error: Option --main requires a directory as argument. See: generate-configs -h" exit 1 fi opt_main="$1" shift ;; --output|-o) shift if [[ -z "$1" || ! -d "$1" ]] ; then echo "Error: Option --output requires a directory as argument. See: generate-configs -h" exit 1 fi opt_output="$1" shift ;; -*) echo "Error: Unknown option ${1}. See: generate-configs -h" exit 1 ;; *) show_usage 1 ;; esac done if [[ -z "$opt_main" ]] ; then echo "Error: Missing required option --main. See: generate-configs -h" exit 1 fi if [[ -z "$opt_contrib" ]] ; then echo "Error: Missing required option --contrib. See: generate-configs -h" exit 1 fi } show_usage() { cat << EOF Usage: generate-configs [ OPTIONS ] --main MAIN_DIR --contrib CONTRIB_DIR OPTIONS: --active, -a Insert data in active mode (default: passive) --contrib, -c CONTRIB_DIR Path to contrib repository base directory --help, -h Show help --main, -m MAIN_DIR Path to main repository base directory --output, -o OUTPUT_DIR Output directory (default: CONTRIB_DIR) EOF exit ${1:-0} } parse_opts $* [[ -z "$opt_output" ]] && opt_output="$opt_contrib" CABAL_FILE="${opt_output}/xmonad.cabal" CONFIG_FILE="${opt_output}/Config.hs" cp -f "${opt_main}/xmonad.cabal" "${CABAL_FILE}" cp -f "${opt_main}/Config.hs" "${CONFIG_FILE}" if [[ $opt_active == 1 ]] ; then INS_PREFIX_DEF=$ACTIVE_INS_PREFIX_DEF INS_PREFIX_IMPORT=$ACTIVE_INS_PREFIX_IMPORT INS_PREFIX_KEYBIND=$ACTIVE_INS_PREFIX_KEYBIND INS_PREFIX_KEYBINDLIST=$ACTIVE_INS_PREFIX_KEYBINDLIST INS_PREFIX_LAYOUT=$ACTIVE_INS_PREFIX_LAYOUT INS_PREFIX_MOUSEBIND=$ACTIVE_INS_PREFIX_MOUSEBIND fi generate_configs xmonad-contrib-0.12/scripts/run-xmonad.sh0000644000000000000000000000151112636047674016676 0ustar0000000000000000#!/bin/sh # # launch xmonad, with a couple of dzens to run the status bar # send xmonad state over a named pipe # FG='#a8a3f7' BG='#3f3c6d' FONT="-xos4-terminus-medium-r-normal--16-160-72-72-c-80-iso8859-1" PATH=${HOME}/bin:$PATH # simple xmonad use, no interactive status bar. # #clock | dzen2 -ta r -fg $FG -bg $BG -fn $FONT & #xmonad # # with a pipe talking to an external program # PIPE=$HOME/.xmonad-status rm -f $PIPE PATH=${PATH}:/sbin mkfifo -m 600 $PIPE [ -p $PIPE ] || exit # launch the external 60 second clock, and launch the workspace status bar xmonad-clock | dzen2 -e '' -x 300 -w 768 -ta r -fg $FG -bg $BG -fn $FONT & # and a workspace status bar dzen2 -e '' -w 300 -ta l -fg $FG -bg $BG -fn $FONT < $PIPE & # go for it xmonad > $PIPE & # wait for xmonad wait $! pkill -HUP dzen2 pkill -HUP -f xmonad-clock wait xmonad-contrib-0.12/scripts/xmonad-clock.c0000644000000000000000000000363012636047674017001 0ustar0000000000000000/* dwm/xmonad status bar provider. launch from your .xinitrc, and pipe into dzen2. to compile: gcc -Os -s -o xmonad-clock xmonad-clock.c Copyright (c) 2007, Tom Menari Copyright (c) 2007, Don Stewart Permission to use, copy, modify, and distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ #include #include #include #include #include /* configuration */ #define REFRESH_RATE 60 #define TIME_FORMAT "%H.%M %a %b %d" #define TIME_FORMAT2 "SYD %H.%M" int main(void) { char b[34]; char c[34]; time_t epochtime; struct tm *realtime; time_t pdttime; struct tm *pdtrealtime; double load[3]; signal(SIGPIPE, SIG_IGN); for(;;) { getloadavg(load, 3); epochtime = time(NULL); realtime = localtime(&epochtime); strftime(b, sizeof(b), TIME_FORMAT, realtime); setenv("TZ","Australia/Sydney", 1); pdttime = time(NULL); pdtrealtime = localtime(&pdttime); strftime(c, sizeof(c), TIME_FORMAT2, pdtrealtime); unsetenv("TZ"); fprintf(stdout, "%s | %s | %.2f %.2f %.2f | xmonad 0.3 \n", b, c, load[0], load[1], load[2]); fflush(stdout); sleep(REFRESH_RATE); } return EXIT_SUCCESS; } xmonad-contrib-0.12/scripts/xinitrc0000644000000000000000000000176512636047674015670 0ustar0000000000000000# .xinitrc xrandr -s 0 xrdb $HOME/.Xresources xsetroot -cursor_name left_ptr xsetroot -solid '#80a0af' # if we have private ssh key(s), start ssh-agent and add the key(s) id1=$HOME/.ssh/identity id2=$HOME/.ssh/id_dsa id3=$HOME/.ssh/id_rsa if [ -x /usr/bin/ssh-agent ] && [ -f $id1 -o -f $id2 -o -f $id3 ]; then eval `ssh-agent -s` ssh-add < /dev/null fi xset fp+ /usr/local/lib/X11/fonts/terminus xset fp+ /usr/local/lib/X11/fonts/ghostscript xset fp+ /usr/X11R6/lib/X11/fonts/TTF/ # xset fp rehash xset b 100 0 0 xset r rate 140 200 xmodmap -e "keycode 233 = Page_Down" xmodmap -e "keycode 234 = Page_Up" xmodmap -e "remove Lock = Caps_Lock" xmodmap -e "keysym Caps_Lock = Control_L" xmodmap -e "add Control = Control_L" PATH=/home/dons/bin:$PATH # launch the external 60 second clock, and launch the workspace status bar FG='#a8a3f7' BG='#3f3c6d' xmonad-clock | dzen2 -e '' -x 400 -w 1200 -ta r -fg $FG -bg $BG & xmonad & # wait for xmonad wait $! pkill -HUP dzen2 pkill -HUP -f xmonad-clock wait xmonad-contrib-0.12/scripts/xmonad-acpi.c0000644000000000000000000000464512636047674016631 0ustar0000000000000000/* dwm/xmonad status bar provider. launch from your .xinitrc, and pipe into dzen2. to compile: gcc -Os -s -o xmonad-acpi xmonad-acpi.c Copyright (c) 2007, Tom Menari Copyright (c) 2007, Don Stewart Permission to use, copy, modify, and distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ #include #include #include #include #include /* configuration */ #define REFRESH_RATE 2 #define TIME_FORMAT "%a %b %d %H:%M:%S" #define BATTERY_INFO "/proc/acpi/battery/BAT0/info" #define BATTERY_STATE "/proc/acpi/battery/BAT0/state" int main(void) { FILE *acpi; char b[34]; time_t epochtime; struct tm *realtime; int last_full, remaining; double load[3]; signal(SIGPIPE, SIG_IGN); if ((acpi = fopen(BATTERY_INFO, "r")) == NULL) { perror("couldn't open "BATTERY_INFO); exit(-1); } while (fgets(b, sizeof(b), acpi)) if (sscanf(b, "last full capacity: %d", &last_full) == 1) break; fclose(acpi); for(;;) { /* Load */ getloadavg(load, 3); /* Battery */ if ((acpi = fopen(BATTERY_STATE, "r")) == NULL) { perror("couldn't open "BATTERY_STATE); exit(-1); } while (fgets(b, sizeof(b), acpi)) if (sscanf(b, "remaining capacity: %d", &remaining) == 1) break; fclose(acpi); /* Time */ epochtime = time(NULL); realtime = localtime(&epochtime); strftime(b, sizeof(b), TIME_FORMAT, realtime); fprintf(stdout, "%s | %.2f %.2f %.2f | %.1f%% \n", b, load[0], load[1], load[2], (float) (remaining * 100) / last_full); fflush(stdout); sleep(REFRESH_RATE); } return EXIT_SUCCESS; } xmonad-contrib-0.12/scripts/window-properties.sh0000644000000000000000000000105712636047674020314 0ustar0000000000000000#! /bin/sh # Script to print common window properties in ManageHook format, # via xprop. All xprop options may be used, although anything other # than -display, -id, and -name is probably a bad idea. # # Written and placed into the public domain by Brandon S Allbery # KF8NH # exec xprop -notype \ -f WM_NAME 8s ':\n title =\? $0\n' \ -f WM_CLASS 8s ':\n appName =\? $0\n className =\? $1\n' \ -f WM_WINDOW_ROLE 8s ':\n stringProperty "WM_WINDOW_ROLE" =\? $0\n' \ WM_NAME WM_CLASS WM_WINDOW_ROLE \ ${1+"$@"} xmonad-contrib-0.12/XMonad/0000755000000000000000000000000012636047674013753 5ustar0000000000000000xmonad-contrib-0.12/XMonad/Doc.hs0000644000000000000000000000475012636047674015022 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Doc -- Copyright : (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : portable -- -- This is the main documentation module for the xmonad-contrib -- library. It provides a brief overview of xmonad and a link to -- documentation for configuring and extending xmonad. -- -- A link to documentation describing xmonad internals is also provided. -- This module is mainly intended for those wanting to contribute code, -- or for those who are curious to know what's going on behind the scenes. ----------------------------------------------------------------------------- module XMonad.Doc ( -- * Overview -- $overview -- * Configuring xmonad -- $configuring -- * Extending xmonad with the xmonad-contrib library -- $extending -- * Developing xmonad: a brief code commentary -- $developing ) where import XMonad.Doc.Configuring () import XMonad.Doc.Extending () import XMonad.Doc.Developing () -------------------------------------------------------------------------------- -- -- Overview -- -------------------------------------------------------------------------------- {- $overview #Overview# xmonad is a tiling window manager for X. The xmonad-contrib library collects third party tiling algorithms, hooks, configurations, scripts, and other extensions to xmonad. The source for this library is available from via git: > git clone https://github.com/xmonad/xmonad-contrib.git Each stable release of xmonad is accompanied by a stable release of the contrib library, which you should use if (and only if) you're using a stable release of xmonad. You can find the most recent tarball here: -} {- $configuring "XMonad.Doc.Configuring" documents the process of configuring xmonad. A brief tutorial will guide you through the basic configuration steps. -} {- $extending "XMonad.Doc.Extending" is dedicated to the xmonad-contrib library itself. You will find an overview of extensions available in the library and instructions for using them. -} {- $developing "XMonad.Doc.Developing" consists of a brief description of the xmonad internals. It is mainly intended for contributors and provides a brief code commentary with links to the source documentation. -} xmonad-contrib-0.12/XMonad/Prompt.hs0000644000000000000000000013576312636047674015607 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ExistentialQuantification #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt -- Copyright : (C) 2007 Andrea Rossato, 2015 Evgeny Kurnevsky -- License : BSD3 -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- A module for writing graphical prompts for XMonad -- ----------------------------------------------------------------------------- module XMonad.Prompt ( -- * Usage -- $usage mkXPrompt , mkXPromptWithReturn , mkXPromptWithModes , def , amberXPConfig , defaultXPConfig , greenXPConfig , XPMode , XPType (..) , XPPosition (..) , XPConfig (..) , XPrompt (..) , XP , defaultXPKeymap, defaultXPKeymap' , emacsLikeXPKeymap, emacsLikeXPKeymap' , quit , killBefore, killAfter, startOfLine, endOfLine , pasteString, moveCursor , setInput, getInput , moveWord, moveWord', killWord, killWord', deleteString , moveHistory, setSuccess, setDone , Direction1D(..) , ComplFunction -- * X Utilities -- $xutils , mkUnmanagedWindow , fillDrawable -- * Other Utilities -- $utils , mkComplFunFromList , mkComplFunFromList' -- * @nextCompletion@ implementations , getNextOfLastWord , getNextCompletion -- * List utilities , getLastWord , skipLastWord , splitInSubListsAt , breakAtSpace , uniqSort , historyCompletion , historyCompletionP -- * History filters , deleteAllDuplicates , deleteConsecutive , HistoryMatches , initMatches , historyUpMatching , historyDownMatching -- * Types , XPState ) where import XMonad hiding (cleanMask, config) import qualified XMonad as X (numberlockMask) import qualified XMonad.StackSet as W import XMonad.Util.Font import XMonad.Util.Types import XMonad.Util.XSelection (getSelection) import Codec.Binary.UTF8.String (decodeString,isUTF8Encoded) import Control.Applicative ((<$>)) import Control.Arrow (first, (&&&), (***)) import Control.Concurrent (threadDelay) import Control.Exception.Extensible as E hiding (handle) import Control.Monad.State import Data.Bits import Data.Char (isSpace) import Data.IORef import Data.List import qualified Data.Map as M import Data.Maybe (fromMaybe) import Data.Set (fromList, toList) import System.Directory (getAppUserDataDirectory) import System.IO import System.Posix.Files -- $usage -- For usage examples see "XMonad.Prompt.Shell", -- "XMonad.Prompt.XMonad" or "XMonad.Prompt.Ssh" -- -- TODO: -- -- * scrolling the completions that don't fit in the window (?) type XP = StateT XPState IO data XPState = XPS { dpy :: Display , rootw :: !Window , win :: !Window , screen :: !Rectangle , complWin :: Maybe Window , complWinDim :: Maybe ComplWindowDim , complIndex :: !(Int,Int) , showComplWin :: Bool , operationMode :: XPOperationMode , highlightedCompl :: Maybe String , gcon :: !GC , fontS :: !XMonadFont , commandHistory :: W.Stack String , offset :: !Int , config :: XPConfig , successful :: Bool , numlockMask :: KeyMask , done :: Bool } data XPConfig = XPC { font :: String -- ^ Font , bgColor :: String -- ^ Background color , fgColor :: String -- ^ Font color , fgHLight :: String -- ^ Font color of a highlighted completion entry , bgHLight :: String -- ^ Background color of a highlighted completion entry , borderColor :: String -- ^ Border color , promptBorderWidth :: !Dimension -- ^ Border width , position :: XPPosition -- ^ Position: 'Top' or 'Bottom' , alwaysHighlight :: !Bool -- ^ Always highlight an item, overriden to True with multiple modes. This implies having *one* column of autocompletions only. , height :: !Dimension -- ^ Window height , maxComplRows :: Maybe Dimension -- ^ Just x: maximum number of rows to show in completion window , historySize :: !Int -- ^ The number of history entries to be saved , historyFilter :: [String] -> [String] -- ^ a filter to determine which -- history entries to remember , promptKeymap :: M.Map (KeyMask,KeySym) (XP ()) -- ^ Mapping from key combinations to actions , completionKey :: KeySym -- ^ Key that should trigger completion , changeModeKey :: KeySym -- ^ Key to change mode (when the prompt has multiple modes) , defaultText :: String -- ^ The text by default in the prompt line , autoComplete :: Maybe Int -- ^ Just x: if only one completion remains, auto-select it, , showCompletionOnTab :: Bool -- ^ Only show list of completions when Tab was pressed -- and delay by x microseconds , searchPredicate :: String -> String -> Bool -- ^ Given the typed string and a possible -- completion, is the completion valid? } data XPType = forall p . XPrompt p => XPT p type ComplFunction = String -> IO [String] type XPMode = XPType data XPOperationMode = XPSingleMode ComplFunction XPType | XPMultipleModes (W.Stack XPType) instance Show XPType where show (XPT p) = showXPrompt p instance XPrompt XPType where showXPrompt = show nextCompletion (XPT t) = nextCompletion t commandToComplete (XPT t) = commandToComplete t completionToCommand (XPT t) = completionToCommand t completionFunction (XPT t) = completionFunction t modeAction (XPT t) = modeAction t -- | The class prompt types must be an instance of. In order to -- create a prompt you need to create a data type, without parameters, -- and make it an instance of this class, by implementing a simple -- method, 'showXPrompt', which will be used to print the string to be -- displayed in the command line window. -- -- This is an example of a XPrompt instance definition: -- -- > instance XPrompt Shell where -- > showXPrompt Shell = "Run: " class XPrompt t where -- | This method is used to print the string to be -- displayed in the command line window. showXPrompt :: t -> String -- | This method is used to generate the next completion to be -- printed in the command line when tab is pressed, given the -- string presently in the command line and the list of -- completion. -- This function is not used when in multiple modes (because alwaysHighlight in XPConfig is True) nextCompletion :: t -> String -> [String] -> String nextCompletion = getNextOfLastWord -- | This method is used to generate the string to be passed to -- the completion function. commandToComplete :: t -> String -> String commandToComplete _ = getLastWord -- | This method is used to process each completion in order to -- generate the string that will be compared with the command -- presently displayed in the command line. If the prompt is using -- 'getNextOfLastWord' for implementing 'nextCompletion' (the -- default implementation), this method is also used to generate, -- from the returned completion, the string that will form the -- next command line when tab is pressed. completionToCommand :: t -> String -> String completionToCommand _ c = c -- | When the prompt has multiple modes, this is the function -- used to generate the autocompletion list. -- The argument passed to this function is given by `commandToComplete` -- The default implementation shows an error message. completionFunction :: t -> ComplFunction completionFunction t = \_ -> return ["Completions for " ++ (showXPrompt t) ++ " could not be loaded"] -- | When the prompt has multiple modes (created with mkXPromptWithModes), this function is called -- when the user picks an item from the autocompletion list. -- The first argument is the prompt (or mode) on which the item was picked -- The first string argument is the autocompleted item's text. -- The second string argument is the query made by the user (written in the prompt's buffer). -- See XMonad/Actions/Launcher.hs for a usage example. modeAction :: t -> String -> String -> X () modeAction _ _ _ = return () data XPPosition = Top | Bottom deriving (Show,Read) amberXPConfig, defaultXPConfig, greenXPConfig :: XPConfig instance Default XPConfig where def = XPC { font = "-misc-fixed-*-*-*-*-12-*-*-*-*-*-*-*" , bgColor = "grey22" , fgColor = "grey80" , fgHLight = "black" , bgHLight = "grey" , borderColor = "white" , promptBorderWidth = 1 , promptKeymap = defaultXPKeymap , completionKey = xK_Tab , changeModeKey = xK_grave , position = Bottom , height = 18 , maxComplRows = Nothing , historySize = 256 , historyFilter = id , defaultText = [] , autoComplete = Nothing , showCompletionOnTab = False , searchPredicate = isPrefixOf , alwaysHighlight = False } {-# DEPRECATED defaultXPConfig "Use def (from Data.Default, and re-exported from XMonad.Prompt) instead." #-} defaultXPConfig = def greenXPConfig = def { fgColor = "green", bgColor = "black", promptBorderWidth = 0 } amberXPConfig = def { fgColor = "#ca8f2d", bgColor = "black", fgHLight = "#eaaf4c" } initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode -> GC -> XMonadFont -> [String] -> XPConfig -> KeyMask -> XPState initState d rw w s opMode gc fonts h c nm = XPS { dpy = d , rootw = rw , win = w , screen = s , complWin = Nothing , complWinDim = Nothing , showComplWin = not (showCompletionOnTab c) , operationMode = opMode , highlightedCompl = Nothing , gcon = gc , fontS = fonts , commandHistory = W.Stack { W.focus = defaultText c , W.up = [] , W.down = h } , complIndex = (0,0) --(column index, row index), used when `alwaysHighlight` in XPConfig is True , offset = length (defaultText c) , config = c , successful = False , done = False , numlockMask = nm } -- Returns the current XPType currentXPMode :: XPState -> XPType currentXPMode st = case operationMode st of XPMultipleModes modes -> W.focus modes XPSingleMode _ xptype -> xptype -- When in multiple modes, this function sets the next mode -- in the list of modes as active setNextMode :: XPState -> XPState setNextMode st = case operationMode st of XPMultipleModes modes -> case W.down modes of [] -> st -- there is no next mode, return same state (m:ms) -> let currentMode = W.focus modes in st { operationMode = XPMultipleModes W.Stack { W.up = [], W.focus = m, W.down = ms ++ [currentMode]}} --set next and move previous current mode to the of the stack _ -> st --nothing to do, the prompt's operation has only one mode -- Returns the highlighted item highlightedItem :: XPState -> [String] -> Maybe String highlightedItem st' completions = case complWinDim st' of Nothing -> Nothing -- when there isn't any compl win, we can't say how many cols,rows there are Just winDim -> let (_,_,_,_,xx,yy) = winDim complMatrix = splitInSubListsAt (length yy) (take (length xx * length yy) completions) (col_index,row_index) = (complIndex st') in case completions of [] -> Nothing _ -> Just $ complMatrix !! col_index !! row_index -- this would be much easier with functional references command :: XPState -> String command = W.focus . commandHistory setCommand :: String -> XPState -> XPState setCommand xs s = s { commandHistory = (commandHistory s) { W.focus = xs }} setHighlightedCompl :: Maybe String -> XPState -> XPState setHighlightedCompl hc st = st { highlightedCompl = hc} -- | Sets the input string to the given value. setInput :: String -> XP () setInput = modify . setCommand -- | Returns the current input string. Intented for use in custom keymaps -- where the 'get' or similar can't be used to retrieve it. getInput :: XP String getInput = gets command -- | Same as 'mkXPrompt', except that the action function can have -- type @String -> X a@, for any @a@, and the final action returned -- by 'mkXPromptWithReturn' will have type @X (Maybe a)@. @Nothing@ -- is yielded if the user cancels the prompt (by e.g. hitting Esc or -- Ctrl-G). For an example of use, see the 'XMonad.Prompt.Input' -- module. mkXPromptWithReturn :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X a) -> X (Maybe a) mkXPromptWithReturn t conf compl action = do XConf { display = d, theRoot = rw } <- ask s <- gets $ screenRect . W.screenDetail . W.current . windowset hist <- io readHistory w <- io $ createWin d rw conf s io $ selectInput d w $ exposureMask .|. keyPressMask gc <- io $ createGC d w io $ setGraphicsExposures d gc False fs <- initXMF (font conf) numlock <- gets $ X.numberlockMask let hs = fromMaybe [] $ M.lookup (showXPrompt t) hist om = (XPSingleMode compl (XPT t)) --operation mode st = initState d rw w s om gc fs hs conf numlock st' <- io $ execStateT runXP st releaseXMF fs io $ freeGC d gc if successful st' then do let prune = take (historySize conf) io $ writeHistory $ M.insertWith (\xs ys -> prune . historyFilter conf $ xs ++ ys) (showXPrompt t) (prune $ historyFilter conf [command st']) hist -- we need to apply historyFilter before as well, since -- otherwise the filter would not be applied if -- there is no history --When alwaysHighlight is True, autocompletion is handled with indexes. --When it is false, it is handled depending on the prompt buffer's value let selectedCompletion = case alwaysHighlight (config st') of False -> command st' True -> fromMaybe (command st') $ highlightedCompl st' Just <$> action selectedCompletion else return Nothing -- | Creates a prompt given: -- -- * a prompt type, instance of the 'XPrompt' class. -- -- * a prompt configuration ('def' can be used as a starting point) -- -- * a completion function ('mkComplFunFromList' can be used to -- create a completions function given a list of possible completions) -- -- * an action to be run: the action must take a string and return 'XMonad.X' () mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X () mkXPrompt t conf compl action = mkXPromptWithReturn t conf compl action >> return () -- | Creates a prompt with multiple modes given: -- -- * A non-empty list of modes -- * A prompt configuration -- -- The created prompt allows to switch between modes with `changeModeKey` in `conf`. The modes are -- instances of XPrompt. See XMonad.Actions.Launcher for more details -- -- The argument supplied to the action to execute is always the current highlighted item, -- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True. mkXPromptWithModes :: [XPType] -> XPConfig -> X () mkXPromptWithModes modes conf = do XConf { display = d, theRoot = rw } <- ask s <- gets $ screenRect . W.screenDetail . W.current . windowset hist <- io readHistory w <- io $ createWin d rw conf s io $ selectInput d w $ exposureMask .|. keyPressMask gc <- io $ createGC d w io $ setGraphicsExposures d gc False fs <- initXMF (font conf) numlock <- gets $ X.numberlockMask let defaultMode = head modes hs = fromMaybe [] $ M.lookup (showXPrompt defaultMode) hist modeStack = W.Stack{ W.focus = defaultMode --current mode , W.up = [] , W.down = tail modes --other modes } st = initState d rw w s (XPMultipleModes modeStack) gc fs hs conf { alwaysHighlight = True} numlock st' <- io $ execStateT runXP st releaseXMF fs io $ freeGC d gc if successful st' then do let prune = take (historySize conf) -- insert into history the buffers value io $ writeHistory $ M.insertWith (\xs ys -> prune . historyFilter conf $ xs ++ ys) (showXPrompt defaultMode) (prune $ historyFilter conf [command st']) hist case operationMode st' of XPMultipleModes ms -> let action = modeAction $ W.focus ms in action (command st') $ (fromMaybe "" $ highlightedCompl st') _ -> error "The impossible occurred: This prompt runs with multiple modes but they could not be found." --we are creating a prompt with multiple modes, so its operationMode should have been constructed with XPMultipleMode else return () runXP :: XP () runXP = do (d,w) <- gets (dpy &&& win) status <- io $ grabKeyboard d w True grabModeAsync grabModeAsync currentTime when (status == grabSuccess) $ do updateWindows eventLoop handle io $ ungrabKeyboard d currentTime io $ destroyWindow d w destroyComplWin io $ sync d False type KeyStroke = (KeySym, String) eventLoop :: (KeyStroke -> Event -> XP ()) -> XP () eventLoop action = do d <- gets dpy (keysym,string,event) <- io $ allocaXEvent $ \e -> do maskEvent d (exposureMask .|. keyPressMask) e ev <- getEvent e (ks,s) <- if ev_event_type ev == keyPress then lookupString $ asKeyEvent e else return (Nothing, "") return (ks,s,ev) action (fromMaybe xK_VoidSymbol keysym,string) event gets done >>= flip unless (eventLoop handle) -- | Removes numlock and capslock from a keymask. -- Duplicate of cleanMask from core, but in the -- XP monad instead of X. cleanMask :: KeyMask -> XP KeyMask cleanMask msk = do numlock <- gets numlockMask let highMasks = 1 `shiftL` 12 - 1 return (complement (numlock .|. lockMask) .&. msk .&. highMasks) -- Main event handler handle :: KeyStroke -> Event -> XP () handle ks@(sym,_) e@(KeyEvent {ev_event_type = t, ev_state = m}) = do complKey <- gets $ completionKey . config chgModeKey <- gets $ changeModeKey . config c <- getCompletions when (length c > 1) $ modify (\s -> s { showComplWin = True }) if complKey == sym then completionHandle c ks e else if (sym == chgModeKey) then do modify setNextMode updateWindows else when (t == keyPress) $ keyPressHandle m ks handle _ (ExposeEvent {ev_window = w}) = do st <- get when (win st == w) updateWindows handle _ _ = return () -- completion event handler completionHandle :: [String] -> KeyStroke -> Event -> XP () completionHandle c ks@(sym,_) (KeyEvent { ev_event_type = t, ev_state = m }) = do complKey <- gets $ completionKey . config alwaysHlight <- gets $ alwaysHighlight . config case () of () | t == keyPress && sym == complKey -> do st <- get let updateState l = case alwaysHlight of -- modify the buffer's value False -> let newCommand = nextCompletion (currentXPMode st) (command st) l in modify $ \s -> setCommand newCommand $ s { offset = length newCommand, highlightedCompl = Just newCommand} --TODO: Scroll or paginate results True -> let complIndex' = nextComplIndex st (length l) highlightedCompl' = highlightedItem st { complIndex = complIndex'} c in modify $ \s -> setHighlightedCompl highlightedCompl' $ s { complIndex = complIndex' } updateWins l = redrawWindows l >> eventLoop (completionHandle l) case c of [] -> updateWindows >> eventLoop handle [x] -> updateState [x] >> getCompletions >>= updateWins l -> updateState l >> updateWins l | t == keyRelease && sym == complKey -> eventLoop (completionHandle c) | otherwise -> keyPressHandle m ks -- some other key, handle it normally -- some other event: go back to main loop completionHandle _ k e = handle k e --Receives an state of the prompt, the size of the autocompletion list and returns the column,row --which should be highlighted next nextComplIndex :: XPState -> Int -> (Int,Int) nextComplIndex st nitems = case complWinDim st of Nothing -> (0,0) --no window dims (just destroyed or not created) Just (_,_,_,_,_,yy) -> let (ncols,nrows) = (nitems `div` length yy + if (nitems `mod` length yy > 0) then 1 else 0, length yy) (currentcol,currentrow) = complIndex st in if (currentcol + 1 >= ncols) then --hlight is in the last column if (currentrow + 1 < nrows ) then --hlight is still not at the last row (currentcol, currentrow + 1) else (0,0) else if(currentrow + 1 < nrows) then --hlight not at the last row (currentcol, currentrow + 1) else (currentcol + 1, 0) tryAutoComplete :: XP Bool tryAutoComplete = do ac <- gets (autoComplete . config) case ac of Just d -> do cs <- getCompletions case cs of [c] -> runCompleted c d >> return True _ -> return False Nothing -> return False where runCompleted cmd delay = do st <- get let new_command = nextCompletion (currentXPMode st) (command st) [cmd] modify $ setCommand "autocompleting..." updateWindows io $ threadDelay delay modify $ setCommand new_command return True -- KeyPresses -- | Default key bindings for prompts. Click on the \"Source\" link -- to the right to see the complete list. See also 'defaultXPKeymap''. defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) defaultXPKeymap = defaultXPKeymap' isSpace -- | A variant of 'defaultXPKeymap' which lets you specify a custom -- predicate for identifying non-word characters, which affects all -- the word-oriented commands (move\/kill word). The default is -- 'isSpace'. For example, by default a path like @foo\/bar\/baz@ -- would be considered as a single word. You could use a predicate -- like @(\\c -> isSpace c || c == \'\/\')@ to move through or -- delete components of the path one at a time. defaultXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ()) defaultXPKeymap' p = M.fromList $ map (first $ (,) controlMask) -- control + [ (xK_u, killBefore) , (xK_k, killAfter) , (xK_a, startOfLine) , (xK_e, endOfLine) , (xK_y, pasteString) , (xK_Right, moveWord' p Next) , (xK_Left, moveWord' p Prev) , (xK_Delete, killWord' p Next) , (xK_BackSpace, killWord' p Prev) , (xK_w, killWord' p Prev) , (xK_g, quit) , (xK_bracketleft, quit) ] ++ map (first $ (,) 0) [ (xK_Return, setSuccess True >> setDone True) , (xK_KP_Enter, setSuccess True >> setDone True) , (xK_BackSpace, deleteString Prev) , (xK_Delete, deleteString Next) , (xK_Left, moveCursor Prev) , (xK_Right, moveCursor Next) , (xK_Home, startOfLine) , (xK_End, endOfLine) , (xK_Down, moveHistory W.focusUp') , (xK_Up, moveHistory W.focusDown') , (xK_Escape, quit) ] -- | A keymap with many emacs-like key bindings. Click on the -- \"Source\" link to the right to see the complete list. -- See also 'emacsLikeXPKeymap''. emacsLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ()) emacsLikeXPKeymap = emacsLikeXPKeymap' isSpace -- | A variant of 'emacsLikeXPKeymap' which lets you specify a custom -- predicate for identifying non-word characters, which affects all -- the word-oriented commands (move\/kill word). The default is -- 'isSpace'. For example, by default a path like @foo\/bar\/baz@ -- would be considered as a single word. You could use a predicate -- like @(\\c -> isSpace c || c == \'\/\')@ to move through or -- delete components of the path one at a time. emacsLikeXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ()) emacsLikeXPKeymap' p = M.fromList $ map (first $ (,) controlMask) -- control + [ (xK_z, killBefore) --kill line backwards , (xK_k, killAfter) -- kill line fowards , (xK_a, startOfLine) --move to the beginning of the line , (xK_e, endOfLine) -- move to the end of the line , (xK_d, deleteString Next) -- delete a character foward , (xK_b, moveCursor Prev) -- move cursor forward , (xK_f, moveCursor Next) -- move cursor backward , (xK_BackSpace, killWord' p Prev) -- kill the previous word , (xK_y, pasteString) , (xK_g, quit) , (xK_bracketleft, quit) ] ++ map (first $ (,) mod1Mask) -- meta key + [ (xK_BackSpace, killWord' p Prev) , (xK_f, moveWord' p Next) -- move a word forward , (xK_b, moveWord' p Prev) -- move a word backward , (xK_d, killWord' p Next) -- kill the next word , (xK_n, moveHistory W.focusUp') , (xK_p, moveHistory W.focusDown') ] ++ map (first $ (,) 0) -- [ (xK_Return, setSuccess True >> setDone True) , (xK_KP_Enter, setSuccess True >> setDone True) , (xK_BackSpace, deleteString Prev) , (xK_Delete, deleteString Next) , (xK_Left, moveCursor Prev) , (xK_Right, moveCursor Next) , (xK_Home, startOfLine) , (xK_End, endOfLine) , (xK_Down, moveHistory W.focusUp') , (xK_Up, moveHistory W.focusDown') , (xK_Escape, quit) ] keyPressHandle :: KeyMask -> KeyStroke -> XP () keyPressHandle m (ks,str) = do km <- gets (promptKeymap . config) kmask <- cleanMask m -- mask is defined in ghc7 case M.lookup (kmask,ks) km of Just action -> action >> updateWindows Nothing -> case str of "" -> eventLoop handle _ -> when (kmask .&. controlMask == 0) $ do let str' = if isUTF8Encoded str then decodeString str else str insertString str' updateWindows updateHighlightedCompl completed <- tryAutoComplete when completed $ setSuccess True >> setDone True setSuccess :: Bool -> XP () setSuccess b = modify $ \s -> s { successful = b } setDone :: Bool -> XP () setDone b = modify $ \s -> s { done = b } -- KeyPress and State -- | Quit. quit :: XP () quit = flushString >> setSuccess False >> setDone True -- | Kill the portion of the command before the cursor killBefore :: XP () killBefore = modify $ \s -> setCommand (drop (offset s) (command s)) $ s { offset = 0 } -- | Kill the portion of the command including and after the cursor killAfter :: XP () killAfter = modify $ \s -> setCommand (take (offset s) (command s)) s -- | Kill the next\/previous word, using 'isSpace' as the default -- predicate for non-word characters. See 'killWord''. killWord :: Direction1D -> XP () killWord = killWord' isSpace -- | Kill the next\/previous word, given a predicate to identify -- non-word characters. First delete any consecutive non-word -- characters; then delete consecutive word characters, stopping -- just before the next non-word character. -- -- For example, by default (using 'killWord') a path like -- @foo\/bar\/baz@ would be deleted in its entirety. Instead you can -- use something like @killWord' (\\c -> isSpace c || c == \'\/\')@ to -- delete the path one component at a time. killWord' :: (Char -> Bool) -> Direction1D -> XP () killWord' p d = do o <- gets offset c <- gets command let (f,ss) = splitAt o c delNextWord = snd . break p . dropWhile p delPrevWord = reverse . delNextWord . reverse (ncom,noff) = case d of Next -> (f ++ delNextWord ss, o) Prev -> (delPrevWord f ++ ss, length $ delPrevWord f) -- laziness!! modify $ \s -> setCommand ncom $ s { offset = noff} -- | Put the cursor at the end of line endOfLine :: XP () endOfLine = modify $ \s -> s { offset = length (command s)} -- | Put the cursor at the start of line startOfLine :: XP () startOfLine = modify $ \s -> s { offset = 0 } -- | Flush the command string and reset the offset flushString :: XP () flushString = modify $ \s -> setCommand "" $ s { offset = 0} --reset index if config has `alwaysHighlight`. The inserted char could imply fewer autocompletions. --If the current index was column 2, row 1 and now there are only 4 autocompletion rows with 1 column, what should we highlight? Set it to the first and start navigation again resetComplIndex :: XPState -> XPState resetComplIndex st = if (alwaysHighlight $ config st) then st { complIndex = (0,0) } else st -- | Insert a character at the cursor position insertString :: String -> XP () insertString str = modify $ \s -> let cmd = (c (command s) (offset s)) st = resetComplIndex $ s { offset = o (offset s)} in setCommand cmd st where o oo = oo + length str c oc oo | oo >= length oc = oc ++ str | otherwise = f ++ str ++ ss where (f,ss) = splitAt oo oc -- | Insert the current X selection string at the cursor position. pasteString :: XP () pasteString = join $ io $ liftM insertString getSelection -- | Remove a character at the cursor position deleteString :: Direction1D -> XP () deleteString d = modify $ \s -> setCommand (c (command s) (offset s)) $ s { offset = o (offset s)} where o oo = if d == Prev then max 0 (oo - 1) else oo c oc oo | oo >= length oc && d == Prev = take (oo - 1) oc | oo < length oc && d == Prev = take (oo - 1) f ++ ss | oo < length oc && d == Next = f ++ tail ss | otherwise = oc where (f,ss) = splitAt oo oc -- | move the cursor one position moveCursor :: Direction1D -> XP () moveCursor d = modify $ \s -> s { offset = o (offset s) (command s)} where o oo c = if d == Prev then max 0 (oo - 1) else min (length c) (oo + 1) -- | Move the cursor one word, using 'isSpace' as the default -- predicate for non-word characters. See 'moveWord''. moveWord :: Direction1D -> XP () moveWord = moveWord' isSpace -- | Move the cursor one word, given a predicate to identify non-word -- characters. First move past any consecutive non-word characters; -- then move to just before the next non-word character. moveWord' :: (Char -> Bool) -> Direction1D -> XP () moveWord' p d = do c <- gets command o <- gets offset let (f,ss) = splitAt o c len = uncurry (+) . (length *** (length . fst . break p)) . break (not . p) newoff = case d of Prev -> o - len (reverse f) Next -> o + len ss modify $ \s -> s { offset = newoff } moveHistory :: (W.Stack String -> W.Stack String) -> XP () moveHistory f = do modify $ \s -> let ch = f $ commandHistory s in s { commandHistory = ch , offset = length $ W.focus ch , complIndex = (0,0) } updateWindows updateHighlightedCompl updateHighlightedCompl :: XP () updateHighlightedCompl = do st <- get cs <- getCompletions alwaysHighlight' <- gets $ alwaysHighlight . config when (alwaysHighlight') $ modify $ \s -> s {highlightedCompl = highlightedItem st cs} -- X Stuff updateWindows :: XP () updateWindows = do d <- gets dpy drawWin c <- getCompletions case c of [] -> destroyComplWin >> return () l -> redrawComplWin l io $ sync d False redrawWindows :: [String] -> XP () redrawWindows c = do d <- gets dpy drawWin case c of [] -> return () l -> redrawComplWin l io $ sync d False createWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window createWin d rw c s = do let (x,y) = case position c of Top -> (0,0) Bottom -> (0, rect_height s - height c) w <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rw (rect_x s + x) (rect_y s + fi y) (rect_width s) (height c) mapWindow d w return w drawWin :: XP () drawWin = do st <- get let (c,(d,(w,gc))) = (config &&& dpy &&& win &&& gcon) st scr = defaultScreenOfDisplay d wh = widthOfScreen scr ht = height c bw = promptBorderWidth c Just bgcolor <- io $ initColor d (bgColor c) Just border <- io $ initColor d (borderColor c) p <- io $ createPixmap d w wh ht (defaultDepthOfScreen scr) io $ fillDrawable d p gc border bgcolor (fi bw) wh ht printPrompt p io $ copyArea d p w gc 0 0 wh ht 0 0 io $ freePixmap d p printPrompt :: Drawable -> XP () printPrompt drw = do st <- get let (gc,(c,(d,fs))) = (gcon &&& config &&& dpy &&& fontS) st (prt,(com,off)) = (show . currentXPMode &&& command &&& offset) st str = prt ++ com -- break the string in 3 parts: till the cursor, the cursor and the rest (f,p,ss) = if off >= length com then (str, " ","") -- add a space: it will be our cursor ;-) else let (a,b) = (splitAt off com) in (prt ++ a, [head b], tail b) ht = height c fsl <- io $ textWidthXMF (dpy st) fs f psl <- io $ textWidthXMF (dpy st) fs p (asc,desc) <- io $ textExtentsXMF fs str let y = fi $ ((ht - fi (asc + desc)) `div` 2) + fi asc x = (asc + desc) `div` 2 let draw = printStringXMF d drw fs gc -- print the first part draw (fgColor c) (bgColor c) x y f -- reverse the colors and print the "cursor" ;-) draw (bgColor c) (fgColor c) (x + fromIntegral fsl) y p -- reverse the colors and print the rest of the string draw (fgColor c) (bgColor c) (x + fromIntegral (fsl + psl)) y ss -- get the current completion function depending on the active mode getCompletionFunction :: XPState -> ComplFunction getCompletionFunction st = case operationMode st of XPSingleMode compl _ -> compl XPMultipleModes modes -> completionFunction $ W.focus modes -- Completions getCompletions :: XP [String] getCompletions = do s <- get io $ getCompletionFunction s (commandToComplete (currentXPMode s) (command s)) `E.catch` \(SomeException _) -> return [] setComplWin :: Window -> ComplWindowDim -> XP () setComplWin w wi = modify (\s -> s { complWin = Just w, complWinDim = Just wi }) destroyComplWin :: XP () destroyComplWin = do d <- gets dpy cw <- gets complWin case cw of Just w -> do io $ destroyWindow d w modify (\s -> s { complWin = Nothing, complWinDim = Nothing }) Nothing -> return () type ComplWindowDim = (Position,Position,Dimension,Dimension,Columns,Rows) type Rows = [Position] type Columns = [Position] createComplWin :: ComplWindowDim -> XP Window createComplWin wi@(x,y,wh,ht,_,_) = do st <- get let d = dpy st scr = defaultScreenOfDisplay d w <- io $ mkUnmanagedWindow d scr (rootw st) x y wh ht io $ mapWindow d w setComplWin w wi return w getComplWinDim :: [String] -> XP ComplWindowDim getComplWinDim compl = do st <- get let (c,(scr,fs)) = (config &&& screen &&& fontS) st wh = rect_width scr ht = height c tws <- mapM (textWidthXMF (dpy st) fs) compl let max_compl_len = fromIntegral ((fi ht `div` 2) + maximum tws) columns = max 1 $ wh `div` fi max_compl_len rem_height = rect_height scr - ht (rows,r) = length compl `divMod` fi columns needed_rows = max 1 (rows + if r == 0 then 0 else 1) limit_max_number = case maxComplRows c of Nothing -> id Just m -> min m actual_max_number_of_rows = limit_max_number $ rem_height `div` ht actual_rows = min actual_max_number_of_rows (fi needed_rows) actual_height = actual_rows * ht (x,y) = case position c of Top -> (0,ht) Bottom -> (0, (0 + rem_height - actual_height)) (asc,desc) <- io $ textExtentsXMF fs $ head compl let yp = fi $ (ht + fi (asc - desc)) `div` 2 xp = (asc + desc) `div` 2 yy = map fi . take (fi actual_rows) $ [yp,(yp + ht)..] xx = take (fi columns) [xp,(xp + max_compl_len)..] return (rect_x scr + x, rect_y scr + fi y, wh, actual_height, xx, yy) drawComplWin :: Window -> [String] -> XP () drawComplWin w compl = do st <- get let c = config st d = dpy st scr = defaultScreenOfDisplay d bw = promptBorderWidth c gc = gcon st Just bgcolor <- io $ initColor d (bgColor c) Just border <- io $ initColor d (borderColor c) (_,_,wh,ht,xx,yy) <- getComplWinDim compl p <- io $ createPixmap d w wh ht (defaultDepthOfScreen scr) io $ fillDrawable d p gc border bgcolor (fi bw) wh ht let ac = splitInSubListsAt (length yy) (take (length xx * length yy) compl) printComplList d p gc (fgColor c) (bgColor c) xx yy ac --lift $ spawn $ "xmessage " ++ " ac: " ++ show ac ++ " xx: " ++ show xx ++ " length xx: " ++ show (length xx) ++ " yy: " ++ show (length yy) io $ copyArea d p w gc 0 0 wh ht 0 0 io $ freePixmap d p redrawComplWin :: [String] -> XP () redrawComplWin compl = do st <- get nwi <- getComplWinDim compl let recreate = do destroyComplWin w <- createComplWin nwi drawComplWin w compl if compl /= [] && showComplWin st then case complWin st of Just w -> case complWinDim st of Just wi -> if nwi == wi -- complWinDim did not change then drawComplWin w compl -- so update else recreate Nothing -> recreate Nothing -> recreate else destroyComplWin -- Finds the column and row indexes in which a string appears. -- if the string is not in the matrix, the indexes default to (0,0) findComplIndex :: String -> [[String]] -> (Int,Int) findComplIndex x xss = let colIndex = fromMaybe 0 $ findIndex (\cols -> x `elem` cols) xss rowIndex = fromMaybe 0 $ elemIndex x $ (!!) xss colIndex in (colIndex,rowIndex) printComplList :: Display -> Drawable -> GC -> String -> String -> [Position] -> [Position] -> [[String]] -> XP () printComplList d drw gc fc bc xs ys sss = zipWithM_ (\x ss -> zipWithM_ (\y item -> do st <- get alwaysHlight <- gets $ alwaysHighlight . config let (f,b) = case alwaysHlight of True -> -- default to the first item, the one in (0,0) let (colIndex,rowIndex) = findComplIndex item sss in -- assign some colors if ((complIndex st) == (colIndex,rowIndex)) then (fgHLight $ config st,bgHLight $ config st) else (fc,bc) False -> -- compare item with buffer's value if completionToCommand (currentXPMode st) item == commandToComplete (currentXPMode st) (command st) then (fgHLight $ config st,bgHLight $ config st) else (fc,bc) printStringXMF d drw (fontS st) gc f b x y item) ys ss) xs sss -- History type History = M.Map String [String] emptyHistory :: History emptyHistory = M.empty getHistoryFile :: IO FilePath getHistoryFile = fmap (++ "/history") $ getAppUserDataDirectory "xmonad" readHistory :: IO History readHistory = readHist `E.catch` \(SomeException _) -> return emptyHistory where readHist = do path <- getHistoryFile xs <- bracket (openFile path ReadMode) hClose hGetLine readIO xs writeHistory :: History -> IO () writeHistory hist = do path <- getHistoryFile let filtered = M.filter (not . null) hist writeFile path (show filtered) `E.catch` \(SomeException e) -> hPutStrLn stderr ("error writing history: "++show e) setFileMode path mode where mode = ownerReadMode .|. ownerWriteMode -- $xutils -- | Fills a 'Drawable' with a rectangle and a border fillDrawable :: Display -> Drawable -> GC -> Pixel -> Pixel -> Dimension -> Dimension -> Dimension -> IO () fillDrawable d drw gc border bgcolor bw wh ht = do -- we start with the border setForeground d gc border fillRectangle d drw gc 0 0 wh ht -- here foreground means the background of the text setForeground d gc bgcolor fillRectangle d drw gc (fi bw) (fi bw) (wh - (bw * 2)) (ht - (bw * 2)) -- | Creates a window with the attribute override_redirect set to True. -- Windows Managers should not touch this kind of windows. mkUnmanagedWindow :: Display -> Screen -> Window -> Position -> Position -> Dimension -> Dimension -> IO Window mkUnmanagedWindow d s rw x y w h = do let visual = defaultVisualOfScreen s attrmask = cWOverrideRedirect allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes True createWindow d rw x y w h 0 (defaultDepthOfScreen s) inputOutput visual attrmask attributes -- $utils -- | This function takes a list of possible completions and returns a -- completions function to be used with 'mkXPrompt' mkComplFunFromList :: [String] -> String -> IO [String] mkComplFunFromList _ [] = return [] mkComplFunFromList l s = return $ filter (\x -> take (length s) x == s) l -- | This function takes a list of possible completions and returns a -- completions function to be used with 'mkXPrompt'. If the string is -- null it will return all completions. mkComplFunFromList' :: [String] -> String -> IO [String] mkComplFunFromList' l [] = return l mkComplFunFromList' l s = return $ filter (\x -> take (length s) x == s) l -- | Given the prompt type, the command line and the completion list, -- return the next completion in the list for the last word of the -- command line. This is the default 'nextCompletion' implementation. getNextOfLastWord :: XPrompt t => t -> String -> [String] -> String getNextOfLastWord t c l = skipLastWord c ++ completionToCommand t (l !! ni) where ni = case commandToComplete t c `elemIndex` map (completionToCommand t) l of Just i -> if i >= length l - 1 then 0 else i + 1 Nothing -> 0 -- | An alternative 'nextCompletion' implementation: given a command -- and a completion list, get the next completion in the list matching -- the whole command line. getNextCompletion :: String -> [String] -> String getNextCompletion c l = l !! idx where idx = case c `elemIndex` l of Just i -> if i >= length l - 1 then 0 else i + 1 Nothing -> 0 -- | Given a maximum length, splits a list into sublists splitInSubListsAt :: Int -> [a] -> [[a]] splitInSubListsAt _ [] = [] splitInSubListsAt i x = f : splitInSubListsAt i rest where (f,rest) = splitAt i x -- | Gets the last word of a string or the whole string if formed by -- only one word getLastWord :: String -> String getLastWord = reverse . fst . breakAtSpace . reverse -- | Skips the last word of the string, if the string is composed by -- more then one word. Otherwise returns the string. skipLastWord :: String -> String skipLastWord = reverse . snd . breakAtSpace . reverse breakAtSpace :: String -> (String, String) breakAtSpace s | " \\" `isPrefixOf` s2 = (s1 ++ " " ++ s1', s2') | otherwise = (s1, s2) where (s1, s2 ) = break isSpace s (s1',s2') = breakAtSpace $ tail s2 -- | 'historyCompletion' provides a canned completion function much like -- 'getShellCompl'; you pass it to mkXPrompt, and it will make completions work -- from the query history stored in ~\/.xmonad\/history. historyCompletion :: ComplFunction historyCompletion = historyCompletionP (const True) -- | Like 'historyCompletion' but only uses history data from Prompts whose -- name satisfies the given predicate. historyCompletionP :: (String -> Bool) -> ComplFunction historyCompletionP p x = fmap (toComplList . M.filterWithKey (const . p)) readHistory where toComplList = deleteConsecutive . filter (isInfixOf x) . M.fold (++) [] -- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off -- laziness and stability for efficiency. uniqSort :: Ord a => [a] -> [a] uniqSort = toList . fromList -- | Functions to be used with the 'historyFilter' setting. -- 'deleteAllDuplicates' will remove all duplicate entries. -- 'deleteConsecutive' will only remove duplicate elements -- immediately next to each other. deleteAllDuplicates, deleteConsecutive :: [String] -> [String] deleteAllDuplicates = nub deleteConsecutive = map head . group newtype HistoryMatches = HistoryMatches (IORef ([String],Maybe (W.Stack String))) -- | Initializes a new HistoryMatches structure to be passed -- to historyUpMatching initMatches :: (Functor m, MonadIO m) => m HistoryMatches initMatches = HistoryMatches <$> liftIO (newIORef ([],Nothing)) historyNextMatching :: HistoryMatches -> (W.Stack String -> W.Stack String) -> XP () historyNextMatching hm@(HistoryMatches ref) next = do (completed,completions) <- io $ readIORef ref input <- getInput if input `elem` completed then case completions of Just cs -> do let cmd = W.focus cs modify $ setCommand cmd modify $ \s -> s { offset = length cmd } io $ writeIORef ref (cmd:completed,Just $ next cs) Nothing -> return () else do -- the user typed something new, recompute completions io . writeIORef ref . ((,) [input]) . filterMatching input =<< gets commandHistory historyNextMatching hm next where filterMatching :: String -> W.Stack String -> Maybe (W.Stack String) filterMatching prefix = W.filter (prefix `isPrefixOf`) . next -- | Retrieve the next history element that starts with -- the current input. Pass it the result of initMatches -- when creating the prompt. Example: -- -- > .. -- > ((modMask,xK_p), shellPrompt . myPrompt =<< initMatches) -- > .. -- > myPrompt ref = def -- > { promptKeymap = M.union [((0,xK_Up), historyUpMatching ref) -- > ,((0,xK_Down), historyDownMatching ref)] -- > (promptKeymap def) -- > , .. } -- historyUpMatching, historyDownMatching :: HistoryMatches -> XP () historyUpMatching hm = historyNextMatching hm W.focusDown' historyDownMatching hm = historyNextMatching hm W.focusUp' xmonad-contrib-0.12/XMonad/Hooks/0000755000000000000000000000000012636047674015036 5ustar0000000000000000xmonad-contrib-0.12/XMonad/Hooks/Place.hs0000644000000000000000000004153612636047674016427 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.Place -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Automatic placement of floating windows. -- ----------------------------------------------------------------------------- module XMonad.Hooks.Place ( -- * Usage -- $usage -- * Placement actions placeFocused , placeHook -- * Placement policies -- $placements , Placement , smart , simpleSmart , fixed , underMouse , inBounds , withGaps -- * Others , purePlaceWindow ) where import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.WindowArranger import XMonad.Actions.FloatKeys import XMonad.Util.XUtils import qualified Data.Map as M import Data.Ratio ((%)) import Data.List (sortBy, minimumBy, partition) import Data.Maybe (fromMaybe, catMaybes) import Data.Monoid (Endo(..)) import Control.Monad (guard, join) import Control.Monad.Trans (lift) -- $usage -- This module provides a 'ManageHook' that automatically places -- floating windows at appropriate positions on the screen, as well -- as an 'X' action to manually trigger repositioning. -- -- You can use this module by including the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.Place -- -- and adding 'placeHook' to your 'manageHook', for example: -- -- > main = xmonad $ def { manageHook = placeHook simpleSmart -- > <+> manageHook def } -- -- Note that 'placeHook' should be applied after most other hooks, especially hooks -- such as 'doFloat' and 'doShift'. Since hooks combined with '<+>' are applied from -- right to left, this means that 'placeHook' should be the /first/ hook in your chain. -- -- You can also define a key to manually trigger repositioning with 'placeFocused' by -- adding the following to your keys definition: -- -- > , ((modm, xK_w), placeFocused simpleSmart) -- -- Both 'placeHook' and 'placeFocused' take a 'Placement' parameter, which specifies -- the placement policy to use (smart, under the mouse, fixed position, etc.). See -- 'Placement' for a list of available policies. {- Placement policies -} -- $placements -- Placement policies determine how windows will be placed by 'placeFocused' and 'placeHook'. -- -- A few examples: -- -- * Basic smart placement -- -- > myPlacement = simpleSmart -- -- * Under the mouse (pointer at the top-left corner), but constrained -- inside of the screen area -- -- > myPlacement = inBounds (underMouse (0, 0)) -- -- * Smart placement with a preference for putting windows near -- the center of the screen, and with 16px gaps at the top and bottom -- of the screen where no window will be placed -- -- > myPlacement = withGaps (16,0,16,0) (smart (0.5,0.5)) -- | The type of placement policies data Placement = Smart (Rational, Rational) | Fixed (Rational, Rational) | UnderMouse (Rational, Rational) | Bounds (Dimension, Dimension, Dimension, Dimension) Placement deriving (Show, Read, Eq) -- | Try to place windows with as little overlap as possible smart :: (Rational, Rational) -- ^ Where the window should be placed inside -- the available area. See 'fixed'. -> Placement smart = Smart simpleSmart :: Placement simpleSmart = inBounds $ smart (0,0) -- | Place windows at a fixed position fixed :: (Rational, Rational) -- ^ Where windows should go. -- -- * (0,0) -> top left of the screen -- -- * (1,0) -> top right of the screen -- -- * etc -> Placement fixed = Fixed -- | Place windows under the mouse underMouse :: (Rational, Rational) -- ^ Where the pointer should be relative to -- the window's frame; see 'fixed'. -> Placement underMouse = UnderMouse -- | Apply the given placement policy, constraining the -- placed windows inside the screen boundaries. inBounds :: Placement -> Placement inBounds = Bounds (0,0,0,0) -- | Same as 'inBounds', but allows specifying gaps along the screen's edges withGaps :: (Dimension, Dimension, Dimension, Dimension) -- ^ top, right, bottom and left gaps -> Placement -> Placement withGaps = Bounds {- Placement functions -} -- | Repositions the focused window according to a placement policy. Works for -- both \"real\" floating windows and windows in a 'WindowArranger'-based -- layout. placeFocused :: Placement -> X () placeFocused p = withFocused $ \window -> do info <- gets $ screenInfo . S.current . windowset floats <- gets $ M.keys . S.floating . windowset r'@(Rectangle x' y' _ _) <- placeWindow p window info floats -- use X.A.FloatKeys if the window is floating, send -- a WindowArranger message otherwise. case elem window floats of True -> keysMoveWindowTo (x', y') (0, 0) window False -> sendMessage $ SetGeometry r' -- | Hook to automatically place windows when they are created. placeHook :: Placement -> ManageHook placeHook p = do window <- ask r <- Query $ lift $ getWindowRectangle window allRs <- Query $ lift $ getAllRectangles pointer <- Query $ lift $ getPointer window return $ Endo $ \theWS -> fromMaybe theWS $ do let currentRect = screenRect $ S.screenDetail $ S.current theWS floats = M.keys $ S.floating theWS guard(window `elem` floats ) -- Look for the workspace(s) on which the window is to be -- spawned. Each of them also needs an associated screen -- rectangle; for hidden workspaces, we use the current -- workspace's screen. let infos = filter ((window `elem`) . stackContents . S.stack . fst) $ [screenInfo $ S.current theWS] ++ (map screenInfo $ S.visible theWS) ++ zip (S.hidden theWS) (repeat currentRect) guard(not $ null infos) let (workspace, screen) = head infos rs = catMaybes $ map (flip M.lookup allRs) $ organizeClients workspace window floats r' = purePlaceWindow p screen rs pointer r newRect = r2rr screen r' newFloats = M.insert window newRect (S.floating theWS) return $ theWS { S.floating = newFloats } placeWindow :: Placement -> Window -> (S.Workspace WorkspaceId (Layout Window) Window, Rectangle) -- ^ The workspace with reference to which the window should be placed, -- and the screen's geometry. -> [Window] -- ^ The list of floating windows. -> X Rectangle placeWindow p window (ws, s) floats = do (r, rs, pointer) <- getNecessaryData window ws floats return $ purePlaceWindow p s rs pointer r -- | Compute the new position of a window according to a placement policy. purePlaceWindow :: Placement -- ^ The placement strategy -> Rectangle -- ^ The screen -> [Rectangle] -- ^ The other visible windows -> (Position, Position) -- ^ The pointer's position. -> Rectangle -- ^ The window to be placed -> Rectangle purePlaceWindow (Bounds (t,r,b,l) p') (Rectangle sx sy sw sh) rs p w = let s' = (Rectangle (sx + fi l) (sy + fi t) (sw - l - r) (sh - t - b)) in checkBounds s' $ purePlaceWindow p' s' rs p w purePlaceWindow (Fixed ratios) s _ _ w = placeRatio ratios s w purePlaceWindow (UnderMouse (rx, ry)) _ _ (px, py) (Rectangle _ _ w h) = Rectangle (px - truncate (rx * fi w)) (py - truncate (ry * fi h)) w h purePlaceWindow (Smart ratios) s rs _ w = placeSmart ratios s rs (rect_width w) (rect_height w) -- | Helper: Places a Rectangle at a fixed position indicated by two Rationals -- inside another, placeRatio :: (Rational, Rational) -> Rectangle -> Rectangle -> Rectangle placeRatio (rx, ry) (Rectangle x1 y1 w1 h1) (Rectangle _ _ w2 h2) = Rectangle (scale rx x1 (x1 + fi w1 - fi w2)) (scale ry y1 (y1 + fi h1 - fi h2)) w2 h2 -- | Helper: Ensures its second parameter is contained inside the first -- by possibly moving it. checkBounds :: Rectangle -> Rectangle -> Rectangle checkBounds (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2) = Rectangle (max x1 (min (x1 + fi w1 - fi w2) x2)) (max y1 (min (y1 + fi h1 - fi h2) y2)) w2 h2 {- Utilities -} scale :: (RealFrac a, Integral b) => a -> b -> b -> b scale r n1 n2 = truncate $ r * fi n2 + (1 - r) * fi n1 r2rr :: Rectangle -> Rectangle -> S.RationalRect r2rr (Rectangle x0 y0 w0 h0) (Rectangle x y w h) = S.RationalRect ((fi x-fi x0) % fi w0) ((fi y-fi y0) % fi h0) (fi w % fi w0) (fi h % fi h0) {- Querying stuff -} stackContents :: Maybe (S.Stack w) -> [w] stackContents = maybe [] S.integrate screenInfo :: S.Screen i l a sid ScreenDetail -> (S.Workspace i l a, Rectangle) screenInfo (S.Screen { S.workspace = ws, S.screenDetail = (SD s)}) = (ws, s) getWindowRectangle :: Window -> X Rectangle getWindowRectangle window = do d <- asks display (_, x, y, w, h, _, _) <- io $ getGeometry d window -- We can't use the border width returned by -- getGeometry because it will be 0 if the -- window isn't mapped yet. b <- asks $ borderWidth . config return $ Rectangle x y (w + 2*b) (h + 2*b) getAllRectangles :: X (M.Map Window Rectangle) getAllRectangles = do ws <- gets windowset let allWindows = join $ map (stackContents . S.stack) $ (S.workspace . S.current) ws : (map S.workspace . S.visible) ws ++ S.hidden ws allRects <- mapM getWindowRectangle allWindows return $ M.fromList $ zip allWindows allRects organizeClients :: S.Workspace a b Window -> Window -> [Window] -> [Window] organizeClients ws w floats = let (floatCs, layoutCs) = partition (`elem` floats) $ filter (/= w) $ stackContents $ S.stack ws in reverse layoutCs ++ reverse floatCs -- About the ordering: the smart algorithm will overlap windows -- starting ith the head of the list. So: -- - we put the non-floating windows first since they'll -- probably be below the floating ones, -- - we reverse the lists, since the newer/more important -- windows are usually near the head. getPointer :: Window -> X (Position, Position) getPointer window = do d <- asks display (_,_,_,x,y,_,_,_) <- io $ queryPointer d window return (fi x,fi y) -- | Return values are, in order: window's rectangle, -- other windows' rectangles and pointer's coordinates. getNecessaryData :: Window -> S.Workspace WorkspaceId (Layout Window) Window -> [Window] -> X (Rectangle, [Rectangle], (Position, Position)) getNecessaryData window ws floats = do r <- getWindowRectangle window rs <- return (organizeClients ws window floats) >>= mapM getWindowRectangle pointer <- getPointer window return (r, rs, pointer) {- Smart placement algorithm -} -- | Alternate representation for rectangles. data SmartRectangle a = SR { sr_x0, sr_y0 :: a -- ^ Top left coordinates, inclusive , sr_x1, sr_y1 :: a -- ^ Bottom right coorsinates, exclusive } deriving (Show, Eq) r2sr :: Rectangle -> SmartRectangle Position r2sr (Rectangle x y w h) = SR x y (x + fi w) (y + fi h) sr2r :: SmartRectangle Position -> Rectangle sr2r (SR x0 y0 x1 y1) = Rectangle x0 y0 (fi $ x1 - x0) (fi $ y1 - y0) width :: Num a => SmartRectangle a -> a width r = sr_x1 r - sr_x0 r height :: Num a => SmartRectangle a -> a height r = sr_y1 r - sr_y0 r isEmpty :: Real a => SmartRectangle a -> Bool isEmpty r = (width r <= 0) || (height r <= 0) contains :: Real a => SmartRectangle a -> SmartRectangle a -> Bool contains r1 r2 = sr_x0 r1 <= sr_x0 r2 && sr_y0 r1 <= sr_y0 r2 && sr_x1 r1 >= sr_x1 r2 && sr_y1 r1 >= sr_y1 r2 -- | Main placement function placeSmart :: (Rational, Rational) -- ^ point of the screen where windows -- should be placed first, if possible. -> Rectangle -- ^ screen -> [Rectangle] -- ^ other clients -> Dimension -- ^ width -> Dimension -- ^ height -> Rectangle placeSmart (rx, ry) s@(Rectangle sx sy sw sh) rs w h = let free = map sr2r $ findSpace (r2sr s) (map r2sr rs) (fi w) (fi h) in position free (scale rx sx (sx + fi sw - fi w)) (scale ry sy (sy + fi sh - fi h)) w h -- | Second part of the algorithm: -- Chooses the best position in which to place a window, -- according to a list of free areas and an ideal position for -- the top-left corner. -- We can't use semi-open surfaces for this, so we go back to -- X11 Rectangles/Positions/etc instead. position :: [Rectangle] -- ^ Free areas -> Position -> Position -- ^ Ideal coordinates -> Dimension -> Dimension -- ^ Width and height of the window -> Rectangle position rs x y w h = minimumBy distanceOrder $ map closest rs where distanceOrder r1 r2 = compare (distance (rect_x r1,rect_y r1) (x,y) :: Dimension) (distance (rect_x r2,rect_y r2) (x,y) :: Dimension) distance (x1,y1) (x2,y2) = truncate $ (sqrt :: Double -> Double) $ fi $ (x1 - x2)^(2::Int) + (y1 - y2)^(2::Int) closest r = checkBounds r (Rectangle x y w h) -- | First part of the algorithm: -- Tries to find an area in which to place a new -- rectangle so that it overlaps as little as possible with -- other rectangles already present. The first rectangles in -- the list will be overlapped first. findSpace :: Real a => SmartRectangle a -- ^ The total available area -> [SmartRectangle a] -- ^ The parts already in use -> a -- ^ Width of the rectangle to place -> a -- ^ Height of the rectangle to place -> [SmartRectangle a] findSpace total [] _ _ = [total] findSpace total rs@(_:rs') w h = case filter largeEnough $ cleanup $ subtractRects total rs of [] -> findSpace total rs' w h as -> as where largeEnough r = width r >= w && height r >= h -- | Subtracts smaller rectangles from a total rectangle -- , returning a list of remaining rectangular areas. subtractRects :: Real a => SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a] subtractRects total [] = [total] subtractRects total (r:rs) = do total' <- subtractRects total rs filter (not . isEmpty) [ total' {sr_y1 = min (sr_y1 total') (sr_y0 r)} -- Above , total' {sr_x0 = max (sr_x0 total') (sr_x1 r)} -- Right , total' {sr_y0 = max (sr_y0 total') (sr_y1 r)} -- Below , total' {sr_x1 = min (sr_x1 total') (sr_x0 r)} -- Left ] -- | "Nubs" a list of rectangles, dropping all those that are -- already contained in another rectangle of the list. cleanup :: Real a => [SmartRectangle a] -> [SmartRectangle a] cleanup rs = foldr dropIfContained [] $ sortBy sizeOrder rs sizeOrder :: Real a => SmartRectangle a -> SmartRectangle a -> Ordering sizeOrder r1 r2 | w1 < w2 = LT | w1 == w2 && h1 < h2 = LT | w1 == w2 && h1 == h2 = EQ | otherwise = GT where w1 = width r1 w2 = width r2 h1 = height r1 h2 = height r2 dropIfContained :: Real a => SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a] dropIfContained r rs = if any (`contains` r) rs then rs else r:rs xmonad-contrib-0.12/XMonad/Hooks/ICCCMFocus.hs0000644000000000000000000000222112636047674017205 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ICCCMFocus -- License : BSD -- -- Maintainer : Tony Morris -- -- Implemented in your @logHook@, Java swing applications will not misbehave -- when it comes to taking and losing focus. -- -- This has been done by taking the patch in and refactoring it so that it can be included in @~\/.xmonad\/xmonad.hs@. -- -- @ -- conf' = -- conf { -- logHook = takeTopFocus -- } -- @ ----------------------------------------------------------------------------- module XMonad.Hooks.ICCCMFocus {-# DEPRECATED "XMonad.Hooks.ICCCMFocus: xmonad>0.10 core merged issue 177" #-} ( atom_WM_TAKE_FOCUS , takeFocusX , takeTopFocus ) where import XMonad import XMonad.Hooks.SetWMName import qualified XMonad.StackSet as W takeFocusX :: Window -> X () takeFocusX _w = return () -- | The value to add to your log hook configuration. takeTopFocus :: X () takeTopFocus = (withWindowSet $ maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D" xmonad-contrib-0.12/XMonad/Hooks/DynamicBars.hs0000644000000000000000000001062212636047674017567 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.DynamicBars -- Copyright : (c) Ben Boeckel 2012 -- License : BSD-style (as xmonad) -- -- Maintainer : mathstuf@gmail.com -- Stability : unstable -- Portability : unportable -- -- Manage per-screen status bars. -- ----------------------------------------------------------------------------- module XMonad.Hooks.DynamicBars ( -- * Usage -- $usage DynamicStatusBar , DynamicStatusBarCleanup , dynStatusBarStartup , dynStatusBarEventHook , multiPP ) where import Prelude import Control.Monad import Control.Monad.Trans (lift) import Control.Monad.Writer (WriterT, execWriterT, tell) import Data.Maybe import Data.Monoid import Data.Traversable (traverse) import Graphics.X11.Xinerama import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras import Graphics.X11.Xrandr import System.IO import XMonad import qualified XMonad.StackSet as W import XMonad.Hooks.DynamicLog import qualified XMonad.Util.ExtensibleState as XS -- $usage -- Provides a few helper functions to manage per-screen status bars while -- dynamically responding to screen changes. A startup action, event hook, and -- a way to separate PP styles based on the screen's focus are provided: -- -- * The 'dynStatusBarStartup' hook which initializes the status bars. -- -- * The 'dynStatusBarEventHook' hook which respawns status bars when the -- number of screens changes. -- -- * The 'multiPP' function which allows for different output based on whether -- the screen for the status bar has focus. -- -- The hooks take a 'DynamicStatusBar' function which is given the id of the -- screen to start up and returns the 'Handle' to the pipe to write to. The -- 'DynamicStatusBarCleanup' argument should tear down previous instances. It -- is called when the number of screens changes and on startup. -- data DynStatusBarInfo = DynStatusBarInfo { dsbInfoScreens :: [ScreenId] , dsbInfoHandles :: [Handle] } deriving (Typeable) instance ExtensionClass DynStatusBarInfo where initialValue = DynStatusBarInfo [] [] type DynamicStatusBar = ScreenId -> IO Handle type DynamicStatusBarCleanup = IO () dynStatusBarStartup :: DynamicStatusBar -> DynamicStatusBarCleanup -> X () dynStatusBarStartup sb cleanup = do dpy <- asks display root <- asks theRoot io $ xrrSelectInput dpy root rrScreenChangeNotifyMask updateStatusBars sb cleanup dynStatusBarEventHook :: DynamicStatusBar -> DynamicStatusBarCleanup -> Event -> X All dynStatusBarEventHook sb cleanup (RRScreenChangeNotifyEvent {}) = updateStatusBars sb cleanup >> return (All True) dynStatusBarEventHook _ _ _ = return (All True) updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> X () updateStatusBars sb cleanup = do dsbInfo <- XS.get screens <- getScreens when (screens /= dsbInfoScreens dsbInfo) $ do newHandles <- liftIO $ do hClose `mapM_` dsbInfoHandles dsbInfo cleanup mapM sb screens XS.put $ DynStatusBarInfo screens newHandles ----------------------------------------------------------------------------- -- The following code is from adamvo's xmonad.hs file. -- http://www.haskell.org/haskellwiki/Xmonad/Config_archive/adamvo%27s_xmonad.hs multiPP :: PP -- ^ The PP to use if the screen is focused -> PP -- ^ The PP to use otherwise -> X () multiPP focusPP unfocusPP = do dsbInfo <- XS.get multiPP' dynamicLogString focusPP unfocusPP (dsbInfoHandles dsbInfo) multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X () multiPP' dynlStr focusPP unfocusPP handles = do st <- get let pickPP :: WorkspaceId -> WriterT (Last XState) X String pickPP ws = do let isFoc = (ws ==) . W.tag . W.workspace . W.current $ windowset st put st{ windowset = W.view ws $ windowset st } out <- lift $ dynlStr $ if isFoc then focusPP else unfocusPP when isFoc $ get >>= tell . Last . Just return out traverse put . getLast =<< execWriterT . (io . zipWithM_ hPutStrLn handles <=< mapM pickPP) . catMaybes =<< mapM screenWorkspace (zipWith const [0 .. ] handles) return () getScreens :: MonadIO m => m [ScreenId] getScreens = liftIO $ do screens <- do dpy <- openDisplay "" rects <- getScreenInfo dpy closeDisplay dpy return rects let ids = zip [0 .. ] screens return $ map fst ids xmonad-contrib-0.12/XMonad/Hooks/FadeInactive.hs0000644000000000000000000001012112636047674017707 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.FadeInactive -- Copyright : (c) 2008 Justin Bogner -- License : BSD -- -- Maintainer : Justin Bogner -- Stability : unstable -- Portability : unportable -- -- Makes XMonad set the _NET_WM_WINDOW_OPACITY atom for inactive windows, -- which causes those windows to become slightly translucent if something -- like xcompmgr is running ----------------------------------------------------------------------------- module XMonad.Hooks.FadeInactive ( -- * Usage -- $usage setOpacity, isUnfocused, isUnfocusedOnCurrentWS, fadeIn, fadeOut, fadeIf, fadeInactiveLogHook, fadeInactiveCurrentWSLogHook, fadeOutLogHook ) where import XMonad import qualified XMonad.StackSet as W import Control.Monad -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad -- > import XMonad.Hooks.FadeInactive -- > -- > myLogHook :: X () -- > myLogHook = fadeInactiveLogHook fadeAmount -- > where fadeAmount = 0.8 -- > -- > main = xmonad def { logHook = myLogHook } -- -- fadeAmount can be any rational between 0 and 1. -- you will need to have xcompmgr -- or something similar for this to do anything -- -- For more detailed instructions on editing the logHook see: -- -- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- | Converts a percentage to the format required for _NET_WM_WINDOW_OPACITY rationalToOpacity :: Integral a => Rational -> a rationalToOpacity perc | perc < 0 || perc > 1 = round perc -- to maintain backwards-compatability | otherwise = round $ perc * 0xffffffff -- | Sets the opacity of a window setOpacity :: Window -> Rational -> X () setOpacity w t = withDisplay $ \dpy -> do a <- getAtom "_NET_WM_WINDOW_OPACITY" c <- getAtom "CARDINAL" io $ changeProperty32 dpy w a c propModeReplace [rationalToOpacity t] -- | Fades a window out by setting the opacity fadeOut :: Rational -> Window -> X () fadeOut = flip setOpacity -- | Makes a window completely opaque fadeIn :: Window -> X () fadeIn = fadeOut 1 -- | Fades a window by the specified amount if it satisfies the first query, otherwise -- makes it opaque. fadeIf :: Query Bool -> Rational -> Query Rational fadeIf qry amt = qry >>= \b -> return $ if b then amt else 1 -- | Sets the opacity of inactive windows to the specified amount fadeInactiveLogHook :: Rational -> X () fadeInactiveLogHook = fadeOutLogHook . fadeIf isUnfocused -- | Set the opacity of inactive windows, on the current workspace, to the -- specified amount. This is specifically usefull in a multi monitor setup. See -- 'isUnfocusedOnCurrentWS'. fadeInactiveCurrentWSLogHook :: Rational -> X () fadeInactiveCurrentWSLogHook = fadeOutLogHook . fadeIf isUnfocusedOnCurrentWS -- | Returns True if the window doesn't have the focus. isUnfocused :: Query Bool isUnfocused = ask >>= \w -> liftX . gets $ maybe True (w /=) . W.peek . windowset -- | Returns True if the window doesn't have the focus, and the window is on the -- current workspace. This is specifically handy in a multi monitor setup -- (xinerama) where multiple workspaces are visible. Using this, non-focused -- workspaces are are not faded out making it easier to look and read the -- content on them. isUnfocusedOnCurrentWS :: Query Bool isUnfocusedOnCurrentWS = do w <- ask ws <- liftX $ gets windowset let thisWS = w `elem` W.index ws unfocused = maybe True (w /=) $ W.peek ws return $ thisWS && unfocused -- | Fades out every window by the amount returned by the query. fadeOutLogHook :: Query Rational -> X () fadeOutLogHook qry = withWindowSet $ \s -> do let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++ concatMap (W.integrate' . W.stack . W.workspace) (W.visible s) forM_ visibleWins $ liftM2 (=<<) setOpacity (runQuery qry) xmonad-contrib-0.12/XMonad/Hooks/Script.hs0000644000000000000000000000256212636047674016643 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.Script -- Copyright : (c) Trevor Elliott -- License : BSD3-style (see LICENSE) -- -- Maintainer : Trevor Elliott -- Stability : unstable -- Portability : unportable -- -- Provides a simple interface for running a ~\/.xmonad\/hooks script with the -- name of a hook. -- ----------------------------------------------------------------------------- module XMonad.Hooks.Script ( -- * Usage -- $usage -- * Script Hook Interface execScriptHook ) where -- -- Useful Imports -- import XMonad -- $usage -- -- This module allows you to run a centrally located script with the text -- name of a hook. The script is assumed to be located at @~\/.xmonad\/hooks@. -- -- For example, if you wanted to run the hook "startup" in your script every -- time your startup hook ran, you could modify your xmonad config as such: -- -- > main = xmonad $ def { -- > ... -- > startupHook = execScriptHook "startup" -- > ... -- > } -- -- Now, every time the startup hook runs, the command -- @~\/.xmonad\/hooks startup@ will also. -- | Execute a named script hook execScriptHook :: MonadIO m => String -> m () execScriptHook hook = do xmonadDir <- getXMonadDir let script = xmonadDir ++ "/hooks " spawn (script ++ hook) xmonad-contrib-0.12/XMonad/Hooks/ManageHelpers.hs0000644000000000000000000001725212636047674020114 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ManageHelpers -- Copyright : (c) Lukas Mai -- License : BSD -- -- Maintainer : Lukas Mai -- Stability : unstable -- Portability : unportable -- -- This module provides helper functions to be used in @manageHook@. Here's -- how you might use this: -- -- > import XMonad.Hooks.ManageHelpers -- > main = -- > xmonad def{ -- > ... -- > manageHook = composeOne [ -- > isKDETrayWindow -?> doIgnore, -- > transience, -- > isFullscreen -?> doFullFloat, -- > resource =? "stalonetray" -?> doIgnore -- > ], -- > ... -- > } module XMonad.Hooks.ManageHelpers ( Side(..), composeOne, (-?>), (/=?), (<==?), (>), (-?>>), currentWs, isInProperty, isKDETrayWindow, isFullscreen, isDialog, pid, transientTo, maybeToDefinite, MaybeManageHook, transience, transience', doRectFloat, doFullFloat, doCenterFloat, doSideFloat, doFloatAt, doFloatDep, doHideIgnore, Match, ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Util.WindowProperties (getProp32s) import Data.Maybe import Data.Monoid import System.Posix (ProcessID) -- | Denotes a side of a screen. @S@ stands for South, @NE@ for Northeast -- etc. @C@ stands for Center. data Side = SC | NC | CE | CW | SE | SW | NE | NW | C deriving (Read, Show, Eq) -- | A ManageHook that may or may not have been executed; the outcome is embedded in the Maybe type MaybeManageHook = Query (Maybe (Endo WindowSet)) -- | A grouping type, which can hold the outcome of a predicate Query. -- This is analogous to group types in regular expressions. -- TODO: create a better API for aggregating multiple Matches logically data Match a = Match Bool a -- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as -- a candidate returns a 'Just' value, effectively running only the first match -- (whereas 'composeAll' continues and executes all matching rules). composeOne :: [MaybeManageHook] -> ManageHook composeOne = foldr try idHook where try q z = do x <- q case x of Just h -> return h Nothing -> z infixr 0 -?>, -->>, -?>> -- | q \/=? x. if the result of q equals x, return False (/=?) :: Eq a => Query a -> a -> Query Bool q /=? x = fmap (/= x) q -- | q <==? x. if the result of q equals x, return True grouped with q (<==?) :: Eq a => Query a -> a -> Query (Match a) q <==? x = fmap (`eq` x) q where eq q' x' = Match (q' == x') q' -- | q <\/=? x. if the result of q notequals x, return True grouped with q ( Query a -> a -> Query (Match a) q ) :: Query Bool -> ManageHook -> MaybeManageHook p -?> f = do x <- p if x then fmap Just f else return Nothing -- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action. If 'p' is true, it executes the resulting action. (-->>) :: Query (Match a) -> (a -> ManageHook) -> ManageHook p -->> f = do Match b m <- p if b then (f m) else mempty -- | A helper operator for use in 'composeOne'. It takes a condition and a function taking a groupdatum to action. If 'p' is true, it executes the resulting action. If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule. (-?>>) :: Query (Match a) -> (a -> ManageHook) -> MaybeManageHook p -?>> f = do Match b m <- p if b then fmap Just (f m) else return Nothing -- | Return the current workspace currentWs :: Query WorkspaceId currentWs = liftX (withWindowSet $ return . W.currentTag) -- | A predicate to check whether a window is a KDE system tray icon. isKDETrayWindow :: Query Bool isKDETrayWindow = ask >>= \w -> liftX $ do r <- getProp32s "_KDE_NET_WM_SYSTEM_TRAY_WINDOW_FOR" w return $ case r of Just [_] -> True _ -> False -- | Helper to check if a window property contains certain value. isInProperty :: String -> String -> Query Bool isInProperty p v = ask >>= \w -> liftX $ do va <- getAtom v r <- getProp32s p w return $ case r of Just xs -> fromIntegral va `elem` xs _ -> False -- | A predicate to check whether a window wants to fill the whole screen. -- See also 'doFullFloat'. isFullscreen :: Query Bool isFullscreen = isInProperty "_NET_WM_STATE" "_NET_WM_STATE_FULLSCREEN" -- | A predicate to check whether a window is a dialog. isDialog :: Query Bool isDialog = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG" pid :: Query (Maybe ProcessID) pid = ask >>= \w -> liftX $ do p <- getProp32s "_NET_WM_PID" w return $ case p of Just [x] -> Just (fromIntegral x) _ -> Nothing -- | A predicate to check whether a window is Transient. -- It holds the result which might be the window it is transient to -- or it might be 'Nothing'. transientTo :: Query (Maybe Window) transientTo = do w <- ask d <- (liftX . asks) display liftIO $ getTransientForHint d w -- | A convenience 'MaybeManageHook' that will check to see if a window -- is transient, and then move it to its parent. transience :: MaybeManageHook transience = transientTo > move where move mw = maybe idHook (doF . move') mw move' w s = maybe s (`W.shift` s) (W.findTag w s) -- | 'transience' set to a 'ManageHook' transience' :: ManageHook transience' = maybeToDefinite transience -- | converts 'MaybeManageHook's to 'ManageHook's maybeToDefinite :: MaybeManageHook -> ManageHook maybeToDefinite = fmap (fromMaybe mempty) -- | Floats the new window in the given rectangle. doRectFloat :: W.RationalRect -- ^ The rectangle to float the window in. 0 to 1; x, y, w, h. -> ManageHook doRectFloat r = ask >>= \w -> doF (W.float w r) -- | Floats the window and makes it use the whole screen. Equivalent to -- @'doRectFloat' $ 'W.RationalRect' 0 0 1 1@. doFullFloat :: ManageHook doFullFloat = doRectFloat $ W.RationalRect 0 0 1 1 -- | Floats a new window using a rectangle computed as a function of -- the rectangle that it would have used by default. doFloatDep :: (W.RationalRect -> W.RationalRect) -> ManageHook doFloatDep move = ask >>= \w -> doF . W.float w . move . snd =<< liftX (floatLocation w) -- | Floats a new window with its original size, and its top left -- corner at a specific point on the screen (both coordinates should -- be in the range 0 to 1). doFloatAt :: Rational -> Rational -> ManageHook doFloatAt x y = doFloatDep move where move (W.RationalRect _ _ w h) = W.RationalRect x y w h -- | Floats a new window with its original size on the specified side of a -- screen doSideFloat :: Side -> ManageHook doSideFloat side = doFloatDep move where move (W.RationalRect _ _ w h) = W.RationalRect cx cy w h where cx = if side `elem` [SC,C ,NC] then (1-w)/2 else if side `elem` [SW,CW,NW] then 0 else {- side `elem` [SE,CE,NE] -} 1-w cy = if side `elem` [CE,C ,CW] then (1-h)/2 else if side `elem` [NE,NC,NW] then 0 else {- side `elem` [SE,SC,SW] -} 1-h -- | Floats a new window with its original size, but centered. doCenterFloat :: ManageHook doCenterFloat = doSideFloat C -- | Hides window and ignores it. doHideIgnore :: ManageHook doHideIgnore = ask >>= \w -> liftX (hide w) >> doF (W.delete w) xmonad-contrib-0.12/XMonad/Hooks/PositionStoreHooks.hs0000644000000000000000000001121512636047674021217 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.PositionStoreHooks -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- This module contains two hooks for the -- PositionStore (see "XMonad.Util.PositionStore") - a ManageHook and -- an EventHook. -- -- The ManageHook can be used to fill the PositionStore with position and size -- information about new windows. The advantage of using this hook is, that the -- information is recorded independent of the currently active layout. So the -- floating shape of the window can later be restored even if it was opened in a -- tiled layout initially. -- -- For windows, that do not request a particular position, a random position will -- be assigned. This prevents windows from piling up exactly on top of each other. -- -- The EventHook makes sure that windows are deleted from the PositionStore -- when they are closed. -- ----------------------------------------------------------------------------- module XMonad.Hooks.PositionStoreHooks ( -- * Usage -- $usage positionStoreManageHook, positionStoreEventHook ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Util.PositionStore import XMonad.Hooks.ManageDocks import XMonad.Layout.Decoration import System.Random(randomRIO) import Control.Applicative((<$>)) import Control.Monad(when) import Data.Maybe import Data.Monoid import qualified Data.Set as S -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.PositionStoreHooks -- -- and adding 'positionStoreManageHook' to your 'ManageHook' as well -- as 'positionStoreEventHook' to your event hooks. To be accurate -- about window sizes, the module needs to know if any decoration is in effect. -- This is specified with the first argument: Supply 'Nothing' for no decoration, -- otherwise use 'Just def' or similar to inform the module about the -- decoration theme used. -- -- > myManageHook = positionStoreManageHook Nothing <+> manageHook def -- > myHandleEventHook = positionStoreEventHook -- > -- > main = xmonad def { manageHook = myManageHook -- > , handleEventHook = myHandleEventHook -- > } -- positionStoreManageHook :: Maybe Theme -> ManageHook positionStoreManageHook mDecoTheme = ask >>= liftX . positionStoreInit mDecoTheme >> idHook positionStoreInit :: Maybe Theme -> Window -> X () positionStoreInit mDecoTheme w = withDisplay $ \d -> do let decoH = maybe 0 decoHeight mDecoTheme -- take decoration into account, which - in its current -- form - makes windows smaller to make room for it wa <- io $ getWindowAttributes d w ws <- gets windowset arbitraryOffsetX <- randomIntOffset arbitraryOffsetY <- randomIntOffset if (wa_x wa == 0) && (wa_y wa == 0) then do let sr@(Rectangle srX srY _ _) = screenRect . W.screenDetail . W.current $ ws modifyPosStore (\ps -> posStoreInsert ps w (Rectangle (srX + fi arbitraryOffsetX) (srY + fi arbitraryOffsetY) (fi $ wa_width wa) (decoH + fi (wa_height wa))) sr ) else do sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) let sr = screenRect . W.screenDetail $ sc sr' <- fmap ($ sr) (calcGap $ S.fromList [minBound .. maxBound]) -- take docks into account, accepting -- a somewhat unfortunate inter-dependency -- with 'XMonad.Hooks.ManageDocks' modifyPosStore (\ps -> posStoreInsert ps w (Rectangle (fi $ wa_x wa) (fi (wa_y wa) - fi decoH) (fi $ wa_width wa) (decoH + fi (wa_height wa))) sr' ) where randomIntOffset :: X (Int) randomIntOffset = io $ randomRIO (42, 242) positionStoreEventHook :: Event -> X All positionStoreEventHook (DestroyWindowEvent {ev_window = w, ev_event_type = et}) = do when (et == destroyNotify) $ do modifyPosStore (\ps -> posStoreRemove ps w) return (All True) positionStoreEventHook _ = return (All True) xmonad-contrib-0.12/XMonad/Hooks/FadeWindows.hs0000644000000000000000000002137212636047674017611 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.FadeWindows -- Copyright : Brandon S Allbery KF8NH -- License : BSD -- -- Maintainer : Brandon S Allbery KF8NH -- Stability : unstable -- Portability : unportable -- -- A more flexible and general compositing interface than FadeInactive. -- Windows can be selected and opacity specified by means of FadeHooks, -- which are very similar to ManageHooks and use the same machinery. -- ----------------------------------------------------------------------------- module XMonad.Hooks.FadeWindows (-- * Usage -- $usage -- * The 'logHook' for window fading fadeWindowsLogHook -- * The 'FadeHook' ,FadeHook ,Opacity ,idFadeHook -- * Predefined 'FadeHook's ,opaque ,solid ,transparent ,invisible ,transparency ,translucence ,fadeBy ,opacity ,fadeTo -- * 'handleEventHook' for mapped/unmapped windows ,fadeWindowsEventHook -- * 'doF' for simple hooks ,doS -- * Useful 'Query's for 'FadeHook's ,isFloating ,isUnfocused ) where import XMonad.Core import XMonad.ManageHook (liftX) import qualified XMonad.StackSet as W import XMonad.Hooks.FadeInactive (setOpacity ,isUnfocused ) import Control.Monad (forM_) import Control.Monad.Reader (ask ,asks) import Control.Monad.State (gets) import qualified Data.Map as M import Data.Monoid import Graphics.X11.Xlib.Extras (Event(..)) -- $usage -- To use this module, make sure your @xmonad@ core supports generalized -- 'ManageHook's (check the type of 'idHook'; if it's @ManageHook@ then -- your @xmonad@ is too old) and then add @fadeWindowsLogHook@ to your -- 'logHook' and @fadeWindowsEventHook@ to your 'handleEventHook': -- -- > , logHook = fadeWindowsLogHook myFadeHook -- > , handleEventHook = fadeWindowsEventHook -- > {- ... -} -- > -- > myFadeHook = composeAll [isUnfocused --> transparency 0.2 -- > , opaque -- > ] -- -- The above is like FadeInactive with a fade value of 0.2. -- -- FadeHooks do not accumulate; instead, they compose from right to -- left like 'ManageHook's, so the above example @myFadeHook@ will -- render unfocused windows at 4/5 opacity and the focused window -- as opaque. The 'opaque' hook above is optional, by the way, as any -- unmatched window will be opaque by default. -- -- This module is best used with "XMonad.Hooks.MoreManageHelpers", which -- exports a number of Queries that can be used in either @ManageHook@ -- or @FadeHook@. -- -- Note that you need a compositing manager such as @xcompmgr@, -- @dcompmgr@, or @cairo-compmgr@ for window fading to work. If you -- aren't running a compositing manager, the opacity will be recorded -- but won't take effect until a compositing manager is started. -- -- For more detailed instructions on editing the 'logHook' see: -- -- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" -- -- For more detailed instructions on editing the 'handleEventHook', -- see: -- -- "XMonad.Doc.Extending#Editing_the_event_hook" -- (which sadly doesnt exist at the time of writing...) -- -- /WARNING:/ This module is very good at triggering bugs in -- compositing managers. Symptoms range from windows not being -- repainted until the compositing manager is restarted or the -- window is unmapped and remapped, to the machine becoming sluggish -- until the compositing manager is restarted (at which point a -- popup/dialog will suddenly appear; apparently it's getting into -- a tight loop trying to fade the popup in). I find it useful to -- have a key binding to restart the compositing manager; for example, -- -- main = xmonad $ def { -- {- ... -} -- } -- `additionalKeysP` -- [("M-S-4",spawn "killall xcompmgr; sleep 1; xcompmgr -cCfF &")] -- {- ... -} -- ] -- -- (See "XMonad.Util.EZConfig" for 'additionalKeysP'.) -- a window opacity to be carried in a Query. OEmpty is sort of a hack -- to make it obay the monoid laws data Opacity = Opacity Rational | OEmpty instance Monoid Opacity where mempty = OEmpty r `mappend` OEmpty = r _ `mappend` r = r -- | A FadeHook is similar to a ManageHook, but records window opacity. type FadeHook = Query Opacity -- | Render a window fully opaque. opaque :: FadeHook opaque = doS (Opacity 1) -- | Render a window fully transparent. transparent :: FadeHook transparent = doS (Opacity 0) -- | Specify a window's transparency. transparency :: Rational -- ^ The window's transparency as a fraction. -- @transparency 1@ is the same as 'transparent', -- whereas @transparency 0@ is the same as 'opaque'. -> FadeHook transparency = doS . Opacity . (1-) . clampRatio -- | Specify a window's opacity; this is the inverse of 'transparency'. opacity :: Rational -- ^ The opacity of a window as a fraction. -- @opacity 1@ is the same as 'opaque', -- whereas @opacity 0@ is the same as 'transparent'. -> FadeHook opacity = doS . Opacity . clampRatio fadeTo, translucence, fadeBy :: Rational -> FadeHook -- ^ An alias for 'transparency'. fadeTo = transparency -- ^ An alias for 'transparency'. translucence = transparency -- ^ An alias for 'transparency'. fadeBy = opacity invisible, solid :: FadeHook -- ^ An alias for 'transparent'. invisible = transparent -- ^ An alias for 'opaque'. solid = opaque -- | Like 'doF', but usable with 'ManageHook'-like hooks that -- aren't 'Query' wrapped around transforming functions ('Endo'). doS :: Monoid m => m -> Query m doS = return -- | The identity 'FadeHook', which renders windows 'opaque'. idFadeHook :: FadeHook idFadeHook = opaque -- | A Query to determine if a window is floating. isFloating :: Query Bool isFloating = ask >>= \w -> liftX . gets $ M.member w . W.floating . windowset -- boring windows can't be seen outside of a layout, so we watch messages with -- a dummy LayoutModifier and stow them in a persistent bucket. this is not -- entirely reliable given that boringAuto still isn't observable; we just hope -- those aren't visible and won;t be affected anyway -- @@@ punted for now, will be a separate module. it's still slimy, though -- | A 'logHook' to fade windows under control of a 'FadeHook', which is -- similar to but not identical to 'ManageHook'. fadeWindowsLogHook :: FadeHook -> X () fadeWindowsLogHook h = withWindowSet $ \s -> do let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++ concatMap (W.integrate' . W.stack . W.workspace) (W.visible s) forM_ visibleWins $ \w -> do o <- userCodeDef (Opacity 1) (runQuery h w) setOpacity w $ case o of OEmpty -> 0.93 Opacity r -> r -- | A 'handleEventHook' to handle fading and unfading of newly mapped -- or unmapped windows; this avoids problems with layouts such as -- "XMonad.Layout.Full" or "XMonad.Layout.Tabbed". This hook may -- also be useful with "XMonad.Hooks.FadeInactive". fadeWindowsEventHook :: Event -> X All fadeWindowsEventHook (MapNotifyEvent {}) = -- we need to run the fadeWindowsLogHook. only one way... asks config >>= logHook >> return (All True) fadeWindowsEventHook _ = return (All True) -- A utility to clamp opacity fractions to the range (0,1) clampRatio :: Rational -> Rational clampRatio r | r >= 0 && r <= 1 = r | r < 0 = 0 | otherwise = 1 xmonad-contrib-0.12/XMonad/Hooks/DebugKeyEvents.hs0000644000000000000000000001041312636047674020255 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.DebugKeyEvents -- Copyright : (c) 2011 Brandon S Allbery -- License : BSD -- -- Maintainer : Brandon S Allbery -- Stability : unstable -- Portability : unportable -- -- A debugging module to track key events, useful when you can't tell whether -- xmonad is processing some or all key events. ----------------------------------------------------------------------------- module XMonad.Hooks.DebugKeyEvents (-- * Usage -- $usage debugKeyEvents ) where import XMonad.Core import XMonad.Operations (cleanMask) import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras import Control.Monad.State (gets) import Data.Bits import Data.List (intercalate) import Data.Monoid import Numeric (showHex) import System.IO (hPutStrLn ,stderr) -- $usage -- Add this to your handleEventHook to print received key events to the -- log (the console if you use @startx@/@xinit@, otherwise usually -- @~/.xsession-errors@). -- -- > , handleEventHook = debugKeyEvents -- -- If you already have a handleEventHook then you should append it: -- -- > , handleEventHook = ... <+> debugKeyEvents -- -- Logged key events look like: -- -- @keycode 53 sym 120 (0x78, "x") mask 0x0 () clean 0x0 ()@ -- -- The @mask@ and @clean@ indicate the modifiers pressed along with -- the key; @mask@ is raw, and @clean@ is what @xmonad@ sees after -- sanitizing it (removing @numberLockMask@, etc.) -- -- For more detailed instructions on editing the logHook see: -- -- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" -- | Print key events to stderr for debugging debugKeyEvents :: Event -> X All debugKeyEvents (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code}) | t == keyPress = withDisplay $ \dpy -> do sym <- io $ keycodeToKeysym dpy code 0 msk <- cleanMask m nl <- gets numberlockMask io $ hPutStrLn stderr $ intercalate " " ["keycode" ,show code ,"sym" ,show sym ," (" ,hex sym ," \"" ,keysymToString sym ,"\") mask" ,hex m ,"(" ++ vmask nl m ++ ")" ,"clean" ,hex msk ,"(" ++ vmask nl msk ++ ")" ] return (All True) debugKeyEvents _ = return (All True) -- | Convenient showHex variant hex :: (Integral n, Show n) => n -> String hex v = "0x" ++ showHex v "" -- | Convert a modifier mask into a useful string vmask :: KeyMask -> KeyMask -> String vmask numLockMask msk = intercalate " " $ reverse $ fst $ foldr vmask' ([],msk) masks where #if __GLASGOW_HASKELL__ < 707 finiteBitSize x = bitSize x #endif masks = map (\m -> (m,show m)) [0..toEnum (finiteBitSize msk - 1)] ++ [(numLockMask,"num" ) ,( lockMask,"lock" ) ,(controlMask,"ctrl" ) ,( shiftMask,"shift") ,( mod5Mask,"mod5" ) ,( mod4Mask,"mod4" ) ,( mod3Mask,"mod3" ) ,( mod2Mask,"mod2" ) ,( mod1Mask,"mod1" ) ] vmask' _ a@( _,0) = a vmask' (m,s) (ss,v) | v .&. m == m = (s:ss,v .&. complement m) vmask' _ r = r xmonad-contrib-0.12/XMonad/Hooks/WallpaperSetter.hs0000644000000000000000000002134112636047674020511 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------- -- | -- Module : XMonad.Hooks.WallpaperSetter -- Copyright : (c) Anton Pirogov, 2014 -- License : BSD3 -- -- Maintainer : Anton Pirogov -- Stability : unstable -- Portability : unportable -- -- Log hook which changes the wallpapers depending on visible workspaces. ----------------------------------- module XMonad.Hooks.WallpaperSetter ( -- * Usage -- $usage wallpaperSetter , WallpaperConf(..) , Wallpaper(..) , WallpaperList(..) , defWallpaperConf , defWPNames -- *TODO -- $todo ) where import XMonad import qualified XMonad.StackSet as S import qualified XMonad.Util.ExtensibleState as XS import System.IO import System.Process import System.Directory (getHomeDirectory, doesFileExist, doesDirectoryExist, getDirectoryContents) import System.FilePath (()) import System.Random (randomRIO) import qualified Data.Map as M import Data.List (intersperse, sortBy) import Data.Char (isAlphaNum) import Data.Ord (comparing) import Control.Monad import Control.Applicative import Data.Maybe import Data.Monoid -- $usage -- This module requires imagemagick and feh to be installed, as these are utilized -- for the required image transformations and the actual setting of the wallpaper. -- -- This was especially tested with multi-head setups - if you have two monitors and swap -- the workspaces, the wallpapers will be swapped too, scaled accordingly and rotated if necessary -- (e.g. if you are using your monitor rotated but only have wide wallpapers). -- -- Add a log hook like this: -- -- > myWorkspaces = ["1:main","2:misc","3","4"] -- > ... -- > main = xmonad $ defaultConfig { -- > logHook = wallpaperSetter defWallpaperConf { -- > wallpapers = defWPNames myWorkspaces -- > <> WallpaperList [("1:main",WallpaperDir "1")] -- > } -- > } -- > ... -- $todo -- * implement a kind of image cache like in wallpaperd to remove or at least reduce the lag -- -- * find out how to merge multiple images from stdin to one (-> for caching all pictures in memory) -- | internal. to use XMonad state for memory in-between log-hook calls and remember PID of old external call data WCState = WCState (Maybe [WorkspaceId]) (Maybe ProcessHandle) deriving Typeable instance ExtensionClass WCState where initialValue = WCState Nothing Nothing -- | Represents a wallpaper data Wallpaper = WallpaperFix FilePath -- ^ Single, fixed wallpaper | WallpaperDir FilePath -- ^ Random wallpaper from this subdirectory deriving (Eq, Show, Read) newtype WallpaperList = WallpaperList [(WorkspaceId, Wallpaper)] deriving (Show,Read) instance Monoid WallpaperList where mempty = WallpaperList [] mappend (WallpaperList w1) (WallpaperList w2) = WallpaperList $ M.toList $ (M.fromList w2) `M.union` (M.fromList w1) -- | Complete wallpaper configuration passed to the hook data WallpaperConf = WallpaperConf { wallpaperBaseDir :: FilePath -- ^ Where the wallpapers reside (if empty, will look in \~\/.wallpapers/) , wallpapers :: WallpaperList -- ^ List of the wallpaper associations for workspaces } deriving (Show, Read) -- | default configuration. looks in \~\/.wallpapers/ for WORKSPACEID.jpg defWallpaperConf :: WallpaperConf defWallpaperConf = WallpaperConf "" $ WallpaperList [] instance Default WallpaperConf where def = defWallpaperConf -- |returns the default association list (maps name to name.jpg, non-alphanumeric characters are omitted) defWPNames :: [WorkspaceId] -> WallpaperList defWPNames xs = WallpaperList $ map (\x -> (x,WallpaperFix (filter isAlphaNum x++".jpg"))) xs -- | Add this to your log hook with the workspace configuration as argument. wallpaperSetter :: WallpaperConf -> X () wallpaperSetter wpconf = do WCState oldws h <- XS.get visws <- getVisibleWorkspaces when (Just visws /= oldws) $ do wpconf' <- completeWPConf wpconf wspicpaths <- getPicPathsAndWSRects wpconf' -- terminate old call if any to prevent unnecessary CPU overload when switching WS too fast case h of Nothing -> return () Just pid -> liftIO $ terminateProcess pid handle <- applyWallpaper wspicpaths XS.put $ WCState (Just visws) $ Just handle -- Helper functions ------------------- -- | Picks a random element from a list pickFrom :: [a] -> IO a pickFrom list = do i <- randomRIO (0,length list - 1) return $ list !! i -- | get absolute picture path of the given wallpaper picture -- or select a random one if it is a directory getPicPath :: WallpaperConf -> Wallpaper -> IO (Maybe FilePath) getPicPath conf (WallpaperDir dir) = do direxists <- doesDirectoryExist $ wallpaperBaseDir conf dir if direxists then do files <- getDirectoryContents $ wallpaperBaseDir conf dir let files' = filter ((/='.').head) files file <- pickFrom files' return $ Just $ wallpaperBaseDir conf dir file else return Nothing getPicPath conf (WallpaperFix file) = do exist <- doesFileExist path return $ if exist then Just path else Nothing where path = wallpaperBaseDir conf file -- | Take a path to a picture, return (width, height) if the path is a valid picture -- (requires imagemagick tool identify to be installed) getPicRes :: FilePath -> IO (Maybe (Int,Int)) getPicRes picpath = do (_, Just outh,_,_pid) <- createProcess $ (proc "identify" ["-format", "%w %h", picpath]) { std_out = CreatePipe } output <- hGetContents outh return $ case map reads (words output) of -- mapM Text.Read.readMaybe is better but only in ghc>=7.6 [[(w,"")],[(h,"")]] -> Just (w,h) _ -> Nothing -- |complete unset fields to default values (wallpaper directory = ~/.wallpapers, -- expects a file "NAME.jpg" for each workspace named NAME) completeWPConf :: WallpaperConf -> X WallpaperConf completeWPConf (WallpaperConf dir (WallpaperList ws)) = do home <- liftIO getHomeDirectory winset <- gets windowset let tags = map S.tag $ S.workspaces winset dir' = if null dir then home ".wallpapers" else dir ws' = if null ws then defWPNames tags else WallpaperList ws return (WallpaperConf dir' ws') getVisibleWorkspaces :: X [WorkspaceId] getVisibleWorkspaces = do winset <- gets windowset return $ map (S.tag . S.workspace) . sortBy (comparing S.screen) $ S.current winset : S.visible winset getPicPathsAndWSRects :: WallpaperConf -> X [(Rectangle, FilePath)] getPicPathsAndWSRects wpconf = do winset <- gets windowset paths <- liftIO getPicPaths visws <- getVisibleWorkspaces let visscr = S.current winset : S.visible winset visrects = M.fromList $ map (\x -> ((S.tag . S.workspace) x, S.screenDetail x)) visscr hasPicAndIsVisible (n, mp) = n `elem` visws && (isJust mp) getRect tag = screenRect $ fromJust $ M.lookup tag visrects foundpaths = map (\(n,Just p)->(getRect n,p)) $ filter hasPicAndIsVisible paths return foundpaths where getPicPaths = mapM (\(x,y) -> getPicPath wpconf y >>= \p -> return (x,p)) wl WallpaperList wl = wallpapers wpconf -- | Gets a list of geometry rectangles and filenames, builds and sets wallpaper applyWallpaper :: [(Rectangle, FilePath)] -> X ProcessHandle applyWallpaper parts = do winset <- gets windowset let (vx,vy) = getVScreenDim winset layers <- liftIO $ mapM layerCommand parts let basepart ="convert -size "++show vx++"x"++show vy++" xc:black " endpart =" jpg:- | feh --no-xinerama --bg-tile --no-fehbg -" cmd = basepart ++ (concat $ intersperse " " layers) ++ endpart liftIO $ runCommand cmd getVScreenDim :: S.StackSet i l a sid ScreenDetail -> (Integer, Integer) getVScreenDim = foldr maxXY (0,0) . map (screenRect . S.screenDetail) . S.screens where maxXY (Rectangle x y w h) (mx,my) = ( fromIntegral ((fromIntegral x)+w) `max` mx , fromIntegral ((fromIntegral y)+h) `max` my ) needsRotation :: Rectangle -> (Int,Int) -> Bool needsRotation rect (px,py) = let wratio, pratio :: Double wratio = (fromIntegral $ rect_width rect) / (fromIntegral $ rect_height rect) pratio = fromIntegral px / fromIntegral py in wratio > 1 && pratio < 1 || wratio < 1 && pratio > 1 layerCommand :: (Rectangle, FilePath) -> IO String layerCommand (rect, path) = do res <- getPicRes path return $ case needsRotation rect <$> res of Nothing -> "" Just rotate -> " \\( '"++path++"' "++(if rotate then "-rotate 90 " else "") ++ " -scale "++(show$rect_width rect)++"x"++(show$rect_height rect)++"! \\)" ++ " -geometry +"++(show$rect_x rect)++"+"++(show$rect_y rect)++" -composite " xmonad-contrib-0.12/XMonad/Hooks/InsertPosition.hs0000644000000000000000000000531212636047674020364 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.InsertPosition -- Copyright : (c) 2009 Adam Vogt -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : vogt.adam@gmail.com -- Stability : unstable -- Portability : portable -- -- Configure where new windows should be added and which window should be -- focused. -- ----------------------------------------------------------------------------- module XMonad.Hooks.InsertPosition ( -- * Usage -- $usage insertPosition ,Focus(..), Position(..) ) where import XMonad(ManageHook, MonadReader(ask)) import qualified XMonad.StackSet as W import Control.Applicative((<$>)) import Data.Maybe(fromMaybe) import Data.List(find) import Data.Monoid(Endo(Endo)) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.InsertPosition -- > xmonad def { manageHook = insertPosition Master Newer <+> myManageHook } -- -- You should you put the manageHooks that use 'doShift' to take effect -- /before/ 'insertPosition', so that the window order will be consistent. -- Because ManageHooks compose from right to left (like function composition -- '.'), this means that 'insertPosition' should be the leftmost ManageHook. data Position = Master | End | Above | Below data Focus = Newer | Older -- | insertPosition. A manage hook for placing new windows. XMonad's default is -- the same as using: @insertPosition Above Newer@. insertPosition :: Position -> Focus -> ManageHook insertPosition pos foc = Endo . g <$> ask where g w = viewingWs w (updateFocus w . ins w . W.delete' w) ins w = (\f ws -> fromMaybe id (W.focusWindow <$> W.peek ws) $ f ws) $ case pos of Master -> W.insertUp w . W.focusMaster End -> insertDown w . W.modify' focusLast' Above -> W.insertUp w Below -> insertDown w updateFocus = case foc of Older -> const id Newer -> W.focusWindow -- | Modify the StackSet when the workspace containing w is focused viewingWs :: (Eq a, Eq s, Eq i, Show i) =>a-> (W.StackSet i l a s sd -> W.StackSet i l a s sd)-> W.StackSet i l a s sd-> W.StackSet i l a s sd viewingWs w f = do i <- W.tag . W.workspace . W.current ws <- find (elem w . W.integrate' . W.stack) . W.workspaces maybe id (fmap (W.view i . f) . W.view . W.tag) ws -- | 'insertDown' and 'focusLast' belong in XMonad.StackSet? insertDown :: (Eq a) => a -> W.StackSet i l a s sd -> W.StackSet i l a s sd insertDown w = W.swapDown . W.insertUp w focusLast' :: W.Stack a -> W.Stack a focusLast' st = let ws = W.integrate st in W.Stack (last ws) (tail $ reverse ws) [] xmonad-contrib-0.12/XMonad/Hooks/SetWMName.hs0000644000000000000000000001133712636047674017177 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.SetWMName -- Copyright : © 2007 Ivan Tarasov -- License : BSD -- -- Maintainer : Ivan.Tarasov@gmail.com -- Stability : experimental -- Portability : unportable -- -- Sets the WM name to a given string, so that it could be detected using -- _NET_SUPPORTING_WM_CHECK protocol. -- -- May be useful for making Java GUI programs work, just set WM name to "LG3D" -- and use Java 1.6u1 (1.6.0_01-ea-b03 works for me) or later. -- -- To your @~\/.xmonad\/xmonad.hs@ file, add the following line: -- -- > import XMonad.Hooks.SetWMName -- -- Then edit your @startupHook@: -- -- > startupHook = setWMName "LG3D" -- -- For details on the problems with running Java GUI programs in non-reparenting -- WMs, see and -- related bugs. -- -- Setting WM name to "compiz" does not solve the problem, because of yet -- another bug in AWT code (related to insets). For LG3D insets are explicitly -- set to 0, while for other WMs the insets are \"guessed\" and the algorithm -- fails miserably by guessing absolutely bogus values. -- -- For detailed instructions on editing your hooks, see -- "XMonad.Doc.Extending#4". ----------------------------------------------------------------------------- module XMonad.Hooks.SetWMName ( setWMName) where import Control.Monad (join) import Data.Char (ord) import Data.List (nub) import Data.Maybe (fromJust, listToMaybe, maybeToList) import Foreign.C.Types (CChar) import Foreign.Marshal.Alloc (alloca) import XMonad -- | sets WM name setWMName :: String -> X () setWMName name = do atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom atom_NET_WM_NAME <- getAtom "_NET_WM_NAME" atom_NET_SUPPORTED_ATOM <- getAtom "_NET_SUPPORTED" atom_UTF8_STRING <- getAtom "UTF8_STRING" root <- asks theRoot supportWindow <- getSupportWindow dpy <- asks display io $ do -- _NET_SUPPORTING_WM_CHECK atom of root and support windows refers to the support window mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW 0 [fromIntegral supportWindow]) [root, supportWindow] -- set WM_NAME in supportWindow (now only accepts latin1 names to eliminate dependency on utf8 encoder) changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToCCharList name) -- declare which _NET protocols are supported (append to the list if it exists) supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList) where netSupportingWMCheckAtom :: X Atom netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK" latin1StringToCCharList :: String -> [CChar] latin1StringToCCharList str = map (fromIntegral . ord) str getSupportWindow :: X Window getSupportWindow = withDisplay $ \dpy -> do atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom root <- asks theRoot supportWindow <- fmap (join . fmap listToMaybe) $ io $ getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root validateWindow (fmap fromIntegral supportWindow) validateWindow :: Maybe Window -> X Window validateWindow w = do valid <- maybe (return False) isValidWindow w if valid then return $ fromJust w else createSupportWindow -- is there a better way to check the validity of the window? isValidWindow :: Window -> X Bool isValidWindow w = withDisplay $ \dpy -> io $ alloca $ \p -> do status <- xGetWindowAttributes dpy w p return (status /= 0) -- this code was translated from C (see OpenBox WM, screen.c) createSupportWindow :: X Window createSupportWindow = withDisplay $ \dpy -> do root <- asks theRoot let visual = defaultVisual dpy (defaultScreen dpy) -- should be CopyFromParent (=0), but the constructor is hidden in X11.XLib window <- io $ allocaSetWindowAttributes $ \winAttrs -> do set_override_redirect winAttrs True -- WM cannot decorate/move/close this window set_event_mask winAttrs propertyChangeMask -- not sure if this is needed let bogusX = -100 bogusY = -100 in createWindow dpy root bogusX bogusY 1 1 0 0 inputOutput visual (cWEventMask .|. cWOverrideRedirect) winAttrs io $ mapWindow dpy window -- not sure if this is needed io $ lowerWindow dpy window -- not sure if this is needed return window xmonad-contrib-0.12/XMonad/Hooks/XPropManage.hs0000644000000000000000000000636412636047674017564 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.XPropManage -- Copyright : (c) Karsten Schoelzel -- License : BSD -- -- Maintainer : Karsten Schoelzel -- Stability : unstable -- Portability : unportable -- -- A ManageHook matching on XProperties. ----------------------------------------------------------------------------- module XMonad.Hooks.XPropManage ( -- * Usage -- $usage xPropManageHook, XPropMatch, pmX, pmP ) where import Control.Exception as E import Data.Char (chr) import Data.Monoid (mconcat, Endo(..)) import Control.Monad.Trans (lift) import XMonad -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.XPropManage -- > import qualified XMonad.StackSet as W -- > import XMonad.Actions.TagWindows -- > import Data.List -- -- > manageHook = xPropManageHook xPropMatches -- > -- > xPropMatches :: [XPropMatch] -- > xPropMatches = [ ([ (wM_CLASS, any ("gimp"==))], (\w -> float w >> return (W.shift "2"))) -- > , ([ (wM_COMMAND, any ("screen" ==)), (wM_CLASS, any ("xterm" ==))], pmX (addTag "screen")) -- > , ([ (wM_NAME, any ("Iceweasel" `isInfixOf`))], pmP (W.shift "3")) -- > ] -- -- Properties known to work: wM_CLASS, wM_NAME, wM_COMMAND -- -- A XPropMatch consists of a list of conditions and function telling what to do. -- -- The list entries are pairs of an XProperty to match on (like wM_CLASS, wM_NAME)^1, -- and an function which matches onto the value of the property (represented as a List -- of Strings). -- -- If a match succeeds the function is called immediately, can perform any action and then return -- a function to apply in 'windows' (see Operations.hs). So if the action does only work on the -- WindowSet use just 'pmP function'. -- -- \*1 You can get the available properties of an application with the xprop utility. STRING properties -- should work fine. Others might not work. -- type XPropMatch = ([(Atom, [String] -> Bool)], (Window -> X (WindowSet -> WindowSet))) pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet) pmX f w = f w >> return id pmP :: (WindowSet -> WindowSet) -> Window -> X (WindowSet -> WindowSet) pmP f _ = return f xPropManageHook :: [XPropMatch] -> ManageHook xPropManageHook tms = mconcat $ map propToHook tms where propToHook (ms, f) = fmap and (mapM mkQuery ms) --> mkHook f mkQuery (a, tf) = fmap tf (getQuery a) mkHook func = ask >>= Query . lift . fmap Endo . func getProp :: Display -> Window -> Atom -> X ([String]) getProp d w p = do prop <- io $ E.catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\(_ :: IOException) -> return [[]]) let filt q | q == wM_COMMAND = concat . map splitAtNull | otherwise = id return (filt p prop) getQuery :: Atom -> Query [String] getQuery p = ask >>= \w -> Query . lift $ withDisplay $ \d -> getProp d w p splitAtNull :: String -> [String] splitAtNull s = case dropWhile (== (chr 0)) s of "" -> [] s' -> w : splitAtNull s'' where (w, s'') = break (== (chr 0)) s' xmonad-contrib-0.12/XMonad/Hooks/Minimize.hs0000644000000000000000000000325412636047674017157 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.Minimize -- Copyright : (c) Justin Bogner 2010 -- License : BSD3-style (see LICENSE) -- -- Maintainer : Justin Bogner -- Stability : unstable -- Portability : not portable -- -- Handles window manager hints to minimize and restore windows. Use -- this with "XMonad.Layout.Minimize". -- ----------------------------------------------------------------------------- module XMonad.Hooks.Minimize ( -- * Usage -- $usage minimizeEventHook ) where import Data.Monoid import Control.Monad(when) import XMonad import XMonad.Layout.Minimize -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.Minimize -- > import XMonad.Layout.Minimize -- > -- > myHandleEventHook = minimizeEventHook -- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout -- > , handleEventHook = myHandleEventHook } minimizeEventHook :: Event -> X All minimizeEventHook (ClientMessageEvent {ev_window = w, ev_message_type = mt, ev_data = dt}) = do a_aw <- getAtom "_NET_ACTIVE_WINDOW" a_cs <- getAtom "WM_CHANGE_STATE" when (mt == a_aw) $ sendMessage (RestoreMinimizedWin w) when (mt == a_cs) $ do let message = fromIntegral . head $ dt when (message == normalState) $ sendMessage (RestoreMinimizedWin w) when (message == iconicState) $ minimizeWindow w return (All True) minimizeEventHook _ = return (All True) xmonad-contrib-0.12/XMonad/Hooks/CurrentWorkspaceOnTop.hs0000644000000000000000000000502312636047674021653 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.CurrentWorkspaceOnTop -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- Ensures that the windows of the current workspace are always in front -- of windows that are located on other visible screens. This becomes important -- if you use decoration and drag windows from one screen to another. Using this -- module, the dragged window will always be in front of other windows. -- ----------------------------------------------------------------------------- module XMonad.Hooks.CurrentWorkspaceOnTop ( -- * Usage -- $usage currentWorkspaceOnTop ) where import XMonad import qualified XMonad.StackSet as S import qualified XMonad.Util.ExtensibleState as XS import Control.Monad(when) import qualified Data.Map as M -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.CurrentWorkspaceOnTop -- > -- > main = xmonad $ def { -- > ... -- > logHook = currentWorkspaceOnTop -- > ... -- > } -- data CWOTState = CWOTS String deriving Typeable instance ExtensionClass CWOTState where initialValue = CWOTS "" currentWorkspaceOnTop :: X () currentWorkspaceOnTop = withDisplay $ \d -> do ws <- gets windowset (CWOTS lastTag) <- XS.get let curTag = S.tag . S.workspace . S.current $ ws when (curTag /= lastTag) $ do -- the following is more or less a reimplementation of what's happening in "XMonad.Operation" let s = S.current ws wsp = S.workspace s viewrect = screenRect $ S.screenDetail s tmpStack = (S.stack wsp) >>= S.filter (`M.notMember` S.floating ws) (rs, ml') <- runLayout wsp { S.stack = tmpStack } viewrect updateLayout curTag ml' let this = S.view curTag ws fltWins = filter (flip M.member (S.floating ws)) $ S.index this wins = fltWins ++ (map fst rs) -- order: first all floating windows, then the order the layout returned -- end of reimplementation when (not . null $ wins) $ do io $ raiseWindow d (head wins) -- raise first window of current workspace to the very top, io $ restackWindows d wins -- then use restackWindows to let all other windows from the workspace follow XS.put(CWOTS curTag) xmonad-contrib-0.12/XMonad/Hooks/UrgencyHook.hs0000644000000000000000000005462012636047674017636 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards, DeriveDataTypeable, FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.UrgencyHook -- Copyright : Devin Mullins -- License : BSD3-style (see LICENSE) -- -- Maintainer : Devin Mullins -- Stability : unstable -- Portability : unportable -- -- UrgencyHook lets you configure an action to occur when a window demands -- your attention. (In traditional WMs, this takes the form of \"flashing\" -- on your \"taskbar.\" Blech.) -- ----------------------------------------------------------------------------- module XMonad.Hooks.UrgencyHook ( -- * Usage -- $usage -- ** Pop up a temporary dzen -- $temporary -- ** Highlight in existing dzen -- $existing -- ** Useful keybinding -- $keybinding -- ** Note -- $note -- * Troubleshooting -- $troubleshooting -- * Example: Setting up irssi + rxvt-unicode -- $example -- ** Configuring irssi -- $irssi -- ** Configuring screen -- $screen -- ** Configuring rxvt-unicode -- $urxvt -- ** Configuring xmonad -- $xmonad -- * Stuff for your config file: withUrgencyHook, withUrgencyHookC, UrgencyConfig(..), urgencyConfig, SuppressWhen(..), RemindWhen(..), focusUrgent, clearUrgents, dzenUrgencyHook, DzenUrgencyHook(..), NoUrgencyHook(..), BorderUrgencyHook(..), FocusHook(..), filterUrgencyHook, minutes, seconds, -- * Stuff for developers: readUrgents, withUrgents, StdoutUrgencyHook(..), SpawnUrgencyHook(..), UrgencyHook(urgencyHook), Interval, borderUrgencyHook, focusHook, spawnUrgencyHook, stdoutUrgencyHook ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Util.Dzen (dzenWithArgs, seconds) import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.NamedWindows (getName) import XMonad.Util.Timer (TimerId, startTimer, handleTimer) import XMonad.Util.WindowProperties (getProp32) import Control.Applicative ((<$>)) import Control.Monad (when) import Data.Bits (testBit) import Data.List (delete, (\\)) import Data.Maybe (listToMaybe, maybeToList, fromMaybe) import qualified Data.Set as S import System.IO (hPutStrLn, stderr) import Foreign.C.Types (CLong) -- $usage -- -- To wire this up, first add: -- -- > import XMonad.Hooks.UrgencyHook -- -- to your import list in your config file. Now, you have a decision to make: -- When a window deems itself urgent, do you want to pop up a temporary dzen -- bar telling you so, or do you have an existing dzen wherein you would like to -- highlight urgent workspaces? -- $temporary -- -- Enable your urgency hook by wrapping your config record in a call to -- 'withUrgencyHook'. For example: -- -- > main = xmonad $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] } -- > $ def -- -- This will pop up a dzen bar for five seconds telling you you've got an -- urgent window. -- $existing -- -- In order for xmonad to track urgent windows, you must install an urgency hook. -- You can use the above 'dzenUrgencyHook', or if you're not interested in the -- extra popup, install NoUrgencyHook, as so: -- -- > main = xmonad $ withUrgencyHook NoUrgencyHook -- > $ def -- -- Now, your "XMonad.Hooks.DynamicLog" must be set up to display the urgent -- windows. If you're using the 'dzen' or 'dzenPP' functions from that module, -- then you should be good. Otherwise, you want to figure out how to set -- 'ppUrgent'. -- $keybinding -- -- You can set up a keybinding to jump to the window that was recently marked -- urgent. See an example at 'focusUrgent'. -- $note -- Note: UrgencyHook installs itself as a LayoutModifier, so if you modify your -- urgency hook and restart xmonad, you may need to rejigger your layout by -- hitting mod-shift-space. -- $troubleshooting -- -- There are three steps to get right: -- -- 1. The X client must set the UrgencyHint flag. How to configure this -- depends on the application. If you're using a terminal app, this is in -- two parts: -- -- * The console app must send a ^G (bell). In bash, a helpful trick is -- @sleep 1; echo -e \'\\a\'@. -- -- * The terminal must convert the bell into UrgencyHint. -- -- 2. XMonad must be configured to notice UrgencyHints. If you've added -- withUrgencyHook, you may need to hit mod-shift-space to reset the layout. -- -- 3. The dzen must run when told. Run @dzen2 -help@ and make sure that it -- supports all of the arguments you told DzenUrgencyHook to pass it. Also, -- set up a keybinding to the 'dzen' action in "XMonad.Util.Dzen" to test -- if that works. -- -- As best you can, try to isolate which one(s) of those is failing. -- $example -- -- This is a commonly asked example. By default, the window doesn't get flagged -- urgent when somebody messages you in irssi. You will have to configure some -- things. If you're using different tools than this, your mileage will almost -- certainly vary. (For example, in Xchat2, it's just a simple checkbox.) -- $irssi -- @Irssi@ is not an X11 app, so it can't set the @UrgencyHint@ flag on @XWMHints@. -- However, on all console applications is bestown the greatest of all notification -- systems: the bell. That's right, Ctrl+G, ASCII code 7, @echo -e '\a'@, your -- friend, the bell. To configure @irssi@ to send a bell when you receive a message: -- -- > /set beep_msg_level MSGS NOTICES INVITES DCC DCCMSGS HILIGHT -- -- Consult your local @irssi@ documentation for more detail. -- $screen -- A common way to run @irssi@ is within the lovable giant, @screen@. Some distros -- (e.g. Ubuntu) like to configure @screen@ to trample on your poor console -- applications -- in particular, to turn bell characters into evil, smelly -- \"visual bells.\" To turn this off, add: -- -- > vbell off # or remove the existing 'vbell on' line -- -- to your .screenrc, or hit @C-a C-g@ within a running @screen@ session for an -- immediate but temporary fix. -- $urxvt -- Rubber, meet road. Urxvt is the gateway between console apps and X11. To tell -- urxvt to set an @UrgencyHint@ when it receives a bell character, first, have -- an urxvt version 8.3 or newer, and second, set the following in your -- @.Xdefaults@: -- -- > urxvt.urgentOnBell: true -- -- Depending on your setup, you may need to @xrdb@ that. -- $xmonad -- Hopefully you already read the section on how to configure xmonad. If not, -- hopefully you know where to find it. -- | This is the method to enable an urgency hook. It uses the default -- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHookC' -- instead. withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) => h -> XConfig l -> XConfig l withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf -- | This lets you modify the defaults set in 'urgencyConfig'. An example: -- -- > withUrgencyHookC dzenUrgencyHook { ... } urgencyConfig { suppressWhen = Focused } -- -- (Don't type the @...@, you dolt.) See 'UrgencyConfig' for details on configuration. withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) => h -> UrgencyConfig -> XConfig l -> XConfig l withUrgencyHookC hook urgConf conf = conf { handleEventHook = \e -> handleEvent (WithUrgencyHook hook urgConf) e >> handleEventHook conf e, logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf } data Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show,Typeable) onUrgents :: ([Window] -> [Window]) -> Urgents -> Urgents onUrgents f = Urgents . f . fromUrgents instance ExtensionClass Urgents where initialValue = Urgents [] extensionType = PersistentExtension -- | Global configuration, applied to all types of 'UrgencyHook'. See -- 'urgencyConfig' for the defaults. data UrgencyConfig = UrgencyConfig { suppressWhen :: SuppressWhen -- ^ when to trigger the urgency hook , remindWhen :: RemindWhen -- ^ when to re-trigger the urgency hook } deriving (Read, Show) -- | A set of choices as to /when/ you should (or rather, shouldn't) be notified of an urgent window. -- The default is 'Visible'. Prefix each of the following with \"don't bug me when\": data SuppressWhen = Visible -- ^ the window is currently visible | OnScreen -- ^ the window is on the currently focused physical screen | Focused -- ^ the window is currently focused | Never -- ^ ... aww, heck, go ahead and bug me, just in case. deriving (Read, Show) -- | A set of choices as to when you want to be re-notified of an urgent -- window. Perhaps you focused on something and you miss the dzen popup bar. Or -- you're AFK. Or you feel the need to be more distracted. I don't care. -- -- The interval arguments are in seconds. See the 'minutes' helper. data RemindWhen = Dont -- ^ triggering once is enough | Repeatedly Int Interval -- ^ repeat times every seconds | Every Interval -- ^ repeat every until the urgency hint is cleared deriving (Read, Show) -- | A prettified way of multiplying by 60. Use like: @(5 `minutes`)@. minutes :: Rational -> Rational minutes secs = secs * 60 -- | The default 'UrgencyConfig'. suppressWhen = Visible, remindWhen = Dont. -- Use a variation of this in your config just as you use a variation of -- 'def' for your xmonad definition. urgencyConfig :: UrgencyConfig urgencyConfig = UrgencyConfig { suppressWhen = Visible, remindWhen = Dont } -- | Focuses the most recently urgent window. Good for what ails ya -- I mean, your keybindings. -- Example keybinding: -- -- > , ((modm , xK_BackSpace), focusUrgent) focusUrgent :: X () focusUrgent = withUrgents $ flip whenJust (windows . W.focusWindow) . listToMaybe -- | Just makes the urgents go away. -- Example keybinding: -- -- > , ((modm .|. shiftMask, xK_BackSpace), clearUrgents) clearUrgents :: X () clearUrgents = adjustUrgents (const []) >> adjustReminders (const []) -- | X action that returns a list of currently urgent windows. You might use -- it, or 'withUrgents', in your custom logHook, to display the workspaces that -- contain urgent windows. readUrgents :: X [Window] readUrgents = XS.gets fromUrgents -- | An HOF version of 'readUrgents', for those who prefer that sort of thing. withUrgents :: ([Window] -> X a) -> X a withUrgents f = readUrgents >>= f adjustUrgents :: ([Window] -> [Window]) -> X () adjustUrgents = XS.modify . onUrgents type Interval = Rational -- | An urgency reminder, as reified for 'RemindWhen'. -- The last value is the countdown number, for 'Repeatedly'. data Reminder = Reminder { timer :: TimerId , window :: Window , interval :: Interval , remaining :: Maybe Int } deriving (Show,Read,Eq,Typeable) instance ExtensionClass [Reminder] where initialValue = [] extensionType = PersistentExtension -- | Stores the list of urgency reminders. readReminders :: X [Reminder] readReminders = XS.get adjustReminders :: ([Reminder] -> [Reminder]) -> X () adjustReminders = XS.modify data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig deriving (Read, Show) -- | Change the _NET_WM_STATE property by applying a function to the list of atoms. changeNetWMState :: Display -> Window -> ([CLong] -> [CLong]) -> X () changeNetWMState dpy w f = do wmstate <- getAtom "_NET_WM_STATE" wstate <- fromMaybe [] `fmap` getProp32 wmstate w let ptype = 4 -- atom property type for changeProperty io $ changeProperty32 dpy w wmstate ptype propModeReplace (f wstate) return () -- | Add an atom to the _NET_WM_STATE property. addNetWMState :: Display -> Window -> Atom -> X () addNetWMState dpy w atom = changeNetWMState dpy w $ ((fromIntegral atom):) -- | Remove an atom from the _NET_WM_STATE property. removeNetWMState :: Display -> Window -> Atom -> X () removeNetWMState dpy w atom = changeNetWMState dpy w $ delete (fromIntegral atom) -- | Get the _NET_WM_STATE propertly as a [CLong] getNetWMState :: Window -> X [CLong] getNetWMState w = do a_wmstate <- getAtom "_NET_WM_STATE" fromMaybe [] `fmap` getProp32 a_wmstate w -- The Non-ICCCM Manifesto: -- Note: Some non-standard choices have been made in this implementation to -- account for the fact that things are different in a tiling window manager: -- 1. In normal window managers, windows may overlap, so clients wait for focus to -- be set before urgency is cleared. In a tiling WM, it's sufficient to be able -- see the window, since we know that means you can see it completely. -- 2. The urgentOnBell setting in rxvt-unicode sets urgency even when the window -- has focus, and won't clear until it loses and regains focus. This is stupid. -- In order to account for these quirks, we track the list of urgent windows -- ourselves, allowing us to clear urgency when a window is visible, and not to -- set urgency if a window is visible. If you have a better idea, please, let us -- know! handleEvent :: UrgencyHook h => WithUrgencyHook h -> Event -> X () handleEvent wuh event = case event of -- WM_HINTS urgency flag PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do WMHints { wmh_flags = flags } <- io $ getWMHints dpy w if (testBit flags urgencyHintBit) then markUrgent w else markNotUrgent w -- Window destroyed DestroyWindowEvent {ev_window = w} -> markNotUrgent w -- _NET_WM_STATE_DEMANDS_ATTENTION requested by client ClientMessageEvent {ev_event_display = dpy, ev_window = w, ev_message_type = t, ev_data = action:atoms} -> do a_wmstate <- getAtom "_NET_WM_STATE" a_da <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION" wstate <- getNetWMState w let demandsAttention = fromIntegral a_da `elem` wstate remove = 0 add = 1 toggle = 2 when (t == a_wmstate && fromIntegral a_da `elem` atoms) $ do when (action == add || (action == toggle && not demandsAttention)) $ do markUrgent w addNetWMState dpy w a_da when (action == remove || (action == toggle && demandsAttention)) $ do markNotUrgent w removeNetWMState dpy w a_da _ -> mapM_ handleReminder =<< readReminders where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder markUrgent w = do adjustUrgents (\ws -> if elem w ws then ws else w : ws) callUrgencyHook wuh w userCodeDef () =<< asks (logHook . config) markNotUrgent w = do adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window) userCodeDef () =<< asks (logHook . config) callUrgencyHook :: UrgencyHook h => WithUrgencyHook h -> Window -> X () callUrgencyHook (WithUrgencyHook hook UrgencyConfig { suppressWhen = sw, remindWhen = rw }) w = whenX (not <$> shouldSuppress sw w) $ do userCodeDef () $ urgencyHook hook w case rw of Repeatedly times int -> addReminder w int $ Just times Every int -> addReminder w int Nothing Dont -> return () addReminder :: Window -> Rational -> Maybe Int -> X () addReminder w int times = do timerId <- startTimer int let reminder = Reminder timerId w int times adjustReminders (\rs -> if w `elem` map window rs then rs else reminder : rs) reminderHook :: UrgencyHook h => WithUrgencyHook h -> Reminder -> X (Maybe a) reminderHook (WithUrgencyHook hook _) reminder = do case remaining reminder of Just x | x > 0 -> remind $ Just (x - 1) Just _ -> adjustReminders $ delete reminder Nothing -> remind Nothing return Nothing where remind remaining' = do userCode $ urgencyHook hook (window reminder) adjustReminders $ delete reminder addReminder (window reminder) (interval reminder) remaining' shouldSuppress :: SuppressWhen -> Window -> X Bool shouldSuppress sw w = elem w <$> suppressibleWindows sw cleanupUrgents :: SuppressWhen -> X () cleanupUrgents sw = do sw' <- suppressibleWindows sw a_da <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION" dpy <- withDisplay (\dpy -> return dpy) mapM_ (\w -> removeNetWMState dpy w a_da) sw' adjustUrgents (\\ sw') >> adjustReminders (filter $ ((`notElem` sw') . window)) suppressibleWindows :: SuppressWhen -> X [Window] suppressibleWindows Visible = gets $ S.toList . mapped suppressibleWindows OnScreen = gets $ W.index . windowset suppressibleWindows Focused = gets $ maybeToList . W.peek . windowset suppressibleWindows Never = return [] -------------------------------------------------------------------------------- -- Urgency Hooks -- | The class definition, and some pre-defined instances. class UrgencyHook h where urgencyHook :: h -> Window -> X () instance UrgencyHook (Window -> X ()) where urgencyHook = id data NoUrgencyHook = NoUrgencyHook deriving (Read, Show) instance UrgencyHook NoUrgencyHook where urgencyHook _ _ = return () -- | Your set of options for configuring a dzenUrgencyHook. data DzenUrgencyHook = DzenUrgencyHook { duration :: Int, -- ^ number of microseconds to display the dzen -- (hence, you'll probably want to use 'seconds') args :: [String] -- ^ list of extra args (as 'String's) to pass to dzen } deriving (Read, Show) instance UrgencyHook DzenUrgencyHook where urgencyHook DzenUrgencyHook { duration = d, args = a } w = do name <- getName w ws <- gets windowset whenJust (W.findTag w ws) (flash name) where flash name index = dzenWithArgs (show name ++ " requests your attention on workspace " ++ index) a d {- | A hook which will automatically send you to anything which sets the urgent flag (as opposed to printing some sort of message. You would use this as usual, eg. > withUrgencyHook FocusHook $ myconfig { ... -} focusHook :: Window -> X () focusHook = urgencyHook FocusHook data FocusHook = FocusHook deriving (Read, Show) instance UrgencyHook FocusHook where urgencyHook _ _ = focusUrgent -- | A hook that sets the border color of an urgent window. The color -- will remain until the next time the window gains or loses focus, at -- which point the standard border color from the XConfig will be applied. -- You may want to use suppressWhen = Never with this: -- -- > withUrgencyHookC BorderUrgencyHook { urgencyBorderColor = "#ff0000" } urgencyConfig { suppressWhen = Never } ... -- -- (This should be @urgentBorderColor@ but that breaks "XMonad.Layout.Decoration". -- @borderColor@ breaks anyone using 'XPConfig' from "XMonad.Prompt". We need to -- think a bit more about namespacing issues, maybe.) borderUrgencyHook :: String -> Window -> X () borderUrgencyHook = urgencyHook . BorderUrgencyHook data BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: !String } deriving (Read, Show) instance UrgencyHook BorderUrgencyHook where urgencyHook BorderUrgencyHook { urgencyBorderColor = cs } w = withDisplay $ \dpy -> io $ do c' <- initColor dpy cs case c' of Just c -> setWindowBorder dpy w c _ -> hPutStrLn stderr $ concat ["Warning: bad urgentBorderColor " ,show cs ," in BorderUrgencyHook" ] -- | Flashes when a window requests your attention and you can't see it. -- Defaults to a duration of five seconds, and no extra args to dzen. -- See 'DzenUrgencyHook'. dzenUrgencyHook :: DzenUrgencyHook dzenUrgencyHook = DzenUrgencyHook { duration = seconds 5, args = [] } -- | Spawn a commandline thing, appending the window id to the prefix string -- you provide. (Make sure to add a space if you need it.) Do your crazy -- xcompmgr thing. spawnUrgencyHook :: String -> Window -> X () spawnUrgencyHook = urgencyHook . SpawnUrgencyHook newtype SpawnUrgencyHook = SpawnUrgencyHook String deriving (Read, Show) instance UrgencyHook SpawnUrgencyHook where urgencyHook (SpawnUrgencyHook prefix) w = spawn $ prefix ++ show w -- | For debugging purposes, really. stdoutUrgencyHook :: Window -> X () stdoutUrgencyHook = urgencyHook StdoutUrgencyHook data StdoutUrgencyHook = StdoutUrgencyHook deriving (Read, Show) instance UrgencyHook StdoutUrgencyHook where urgencyHook _ w = io $ putStrLn $ "Urgent: " ++ show w -- | urgencyhook such that windows on certain workspaces -- never get urgency set. -- -- Useful for scratchpad workspaces perhaps: -- -- > main = xmonad (withUrgencyHook (filterUrgencyHook ["NSP", "SP"]) defaultConfig) filterUrgencyHook :: [WorkspaceId] -> Window -> X () filterUrgencyHook skips w = do ws <- gets windowset case W.findTag w ws of Just tag -> when (tag `elem` skips) $ adjustUrgents (delete w) _ -> return () xmonad-contrib-0.12/XMonad/Hooks/ServerMode.hs0000644000000000000000000001523412636047674017452 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ServerMode -- Copyright : (c) Peter Olson 2013 and Andrea Rossato and David Roundy 2007 -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : polson2@hawk.iit.edu -- Stability : unstable -- Portability : unportable -- -- This is an 'EventHook' that will receive commands from an external -- client. Also consider "XMonad.Hooks.EwmhDesktops" together with -- @wmctrl@. -- -- This is the example of a client: -- -- > import Graphics.X11.Xlib -- > import Graphics.X11.Xlib.Extras -- > import System.Environment -- > import System.IO -- > import Data.Char -- > -- > main :: IO () -- > main = parse True "XMONAD_COMMAND" =<< getArgs -- > -- > parse :: Bool -> String -> [String] -> IO () -- > parse input addr args = case args of -- > ["--"] | input -> repl addr -- > | otherwise -> return () -- > ("--":xs) -> sendAll addr xs -- > ("-a":a:xs) -> parse input a xs -- > ("-h":_) -> showHelp -- > ("--help":_) -> showHelp -- > ("-?":_) -> showHelp -- > (a@('-':_):_) -> hPutStrLn stderr ("Unknown option " ++ a) -- > -- > (x:xs) -> sendCommand addr x >> parse False addr xs -- > [] | input -> repl addr -- > | otherwise -> return () -- > -- > -- > repl :: String -> IO () -- > repl addr = do e <- isEOF -- > case e of -- > True -> return () -- > False -> do l <- getLine -- > sendCommand addr l -- > repl addr -- > -- > sendAll :: String -> [String] -> IO () -- > sendAll addr ss = foldr (\a b -> sendCommand addr a >> b) (return ()) ss -- > -- > sendCommand :: String -> String -> IO () -- > sendCommand addr s = do -- > d <- openDisplay "" -- > rw <- rootWindow d $ defaultScreen d -- > a <- internAtom d addr False -- > m <- internAtom d s False -- > allocaXEvent $ \e -> do -- > setEventType e clientMessage -- > setClientMessageEvent e rw a 32 m currentTime -- > sendEvent d rw False structureNotifyMask e -- > sync d False -- > -- > showHelp :: IO () -- > showHelp = do pn <- getProgName -- > putStrLn ("Send commands to a running instance of xmonad. xmonad.hs must be configured with XMonad.Hooks.ServerMode to work.\n-a atomname can be used at any point in the command line arguments to change which atom it is sending on.\nIf sent with no arguments or only -a atom arguments, it will read commands from stdin.\nEx:\n" ++ pn ++ " cmd1 cmd2\n" ++ pn ++ " -a XMONAD_COMMAND cmd1 cmd2 cmd3 -a XMONAD_PRINT hello world\n" ++ pn ++ " -a XMONAD_PRINT # will read data from stdin.\nThe atom defaults to XMONAD_COMMAND.") -- -- -- compile with: @ghc --make xmonadctl.hs@ -- -- run with -- -- > xmonadctl command -- -- or with -- -- > $ xmonadctl -- > command1 -- > command2 -- > . -- > . -- > . -- > ^D -- -- Usage will change depending on which event hook(s) you use. More examples are shown below. -- ----------------------------------------------------------------------------- module XMonad.Hooks.ServerMode ( -- * Usage -- $usage serverModeEventHook , serverModeEventHook' , serverModeEventHookCmd , serverModeEventHookCmd' , serverModeEventHookF ) where import Control.Monad (when) import Data.Maybe import Data.Monoid import System.IO import XMonad import XMonad.Actions.Commands -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.ServerMode -- -- Then edit your @handleEventHook@ by adding the appropriate event hook from below -- | Executes a command of the list when receiving its index via a special ClientMessageEvent -- (indexing starts at 1). Sending index 0 will ask xmonad to print the list of command numbers -- in stderr (so that you can read it in @~\/.xsession-errors@). Uses "XMonad.Actions.Commands#defaultCommands" as the default. -- -- > main = xmonad def { handleEventHook = serverModeEventHook } -- -- > xmonadctl 0 # tells xmonad to output command list -- > xmonadctl 1 # tells xmonad to switch to workspace 1 -- serverModeEventHook :: Event -> X All serverModeEventHook = serverModeEventHook' defaultCommands -- | serverModeEventHook' additionally takes an action to generate the list of -- commands. serverModeEventHook' :: X [(String,X ())] -> Event -> X All serverModeEventHook' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev where helper cmd = do cl <- cmdAction case lookup cmd (zip (map show [1 :: Integer ..]) cl) of Just (_,action) -> action Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl listOfCommands cl = map (uncurry (++)) $ zip (map show ([1..] :: [Int])) $ map ((++) " - " . fst) cl -- | Executes a command of the list when receiving its name via a special ClientMessageEvent. -- Uses "XMonad.Actions.Commands#defaultCommands" as the default. -- -- > main = xmonad def { handleEventHook = serverModeEventHookCmd } -- -- > xmonadctl run # Tells xmonad to generate a run prompt -- serverModeEventHookCmd :: Event -> X All serverModeEventHookCmd = serverModeEventHookCmd' defaultCommands -- | Additionally takes an action to generate the list of commands serverModeEventHookCmd' :: X [(String,X ())] -> Event -> X All serverModeEventHookCmd' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev where helper cmd = do cl <- cmdAction fromMaybe (io $ hPutStrLn stderr ("Couldn't find command " ++ cmd)) (lookup cmd cl) -- | Listens for an atom, then executes a callback function whenever it hears it. -- A trivial example that prints everything supplied to it on xmonad's standard out: -- -- > main = xmonad def { handleEventHook = serverModeEventHookF "XMONAD_PRINT" (io . putStrLn) } -- -- > xmonadctl -a XMONAD_PRINT "hello world" -- serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All serverModeEventHookF key func (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do d <- asks display atm <- io $ internAtom d key False when (mt == atm && dt /= []) $ do let atom = fromIntegral $ toInteger $ foldr1 (\a b -> a + (b*2^(32::Int))) dt cmd <- io $ getAtomName d atom case cmd of Just command -> func command Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ (show atom)) return (All True) serverModeEventHookF _ _ _ = return (All True) xmonad-contrib-0.12/XMonad/Hooks/DebugStack.hs0000644000000000000000000001053112636047674017406 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.DebugStack -- Copyright : (c) Brandon S Allbery KF8NH, 2014 -- License : BSD3-style (see LICENSE) -- -- Maintainer : allbery.b@gmail.com -- Stability : unstable -- Portability : not portable -- -- Dump the state of the 'StackSet'. A @logHook@ and @handleEventHook@ are -- also provided. -- ----------------------------------------------------------------------------- module XMonad.Hooks.DebugStack (debugStack ,debugStackFull ,debugStackString ,debugStackFullString ,debugStackLogHook ,debugStackFullLogHook ,debugStackEventHook ,debugStackFullEventHook ) where import XMonad.Core import qualified XMonad.StackSet as W import XMonad.Util.DebugWindow import Graphics.X11.Types (Window) import Graphics.X11.Xlib.Extras (Event) import Control.Monad (foldM) import Data.Map (member) import Data.Monoid (All(..)) import Data.List (intercalate) -- | Print the state of the current window stack for the current workspace to -- @stderr@, which for most installations goes to @~/.xsession-errors@. -- "XMonad.Util.DebugWindow" is used to display the individual windows. debugStack :: X () debugStack = debugStackString >>= trace -- | Print the state of the current window stack for all workspaces to -- @stderr@, which for most installations goes to @~/.xsession-errors@. -- "XMonad.Util.DebugWindow" is used to display the individual windows. debugStackFull :: X () debugStackFull = debugStackFullString >>= trace -- | 'debugStack' packaged as a 'logHook'. (Currently this is identical.) debugStackLogHook :: X () debugStackLogHook = debugStack -- | 'debugStackFull packaged as a 'logHook'. (Currently this is identical.) debugStackFullLogHook :: X () debugStackFullLogHook = debugStackFull -- | 'debugStack' packaged as a 'handleEventHook'. You almost certainly do not -- want to use this unconditionally, as it will cause massive amounts of -- output and possibly slow @xmonad@ down severely. debugStackEventHook :: Event -> X All debugStackEventHook _ = debugStack >> return (All True) -- | 'debugStackFull' packaged as a 'handleEventHook'. You almost certainly do -- not want to use this unconditionally, as it will cause massive amounts of -- output and possibly slow @xmonad@ down severely. debugStackFullEventHook :: Event -> X All debugStackFullEventHook _ = debugStackFull >> return (All True) -- | Dump the state of the current workspace in the 'StackSet' as a multiline 'String'. debugStackString :: X String debugStackString = withWindowSet $ debugStackWs . W.workspace . W.current -- | Dump the state of all workspaces in the 'StackSet' as a multiline 'String'. -- @@@ this is in stackset order, which is roughly lru-ish debugStackFullString :: X String debugStackFullString = withWindowSet $ fmap (intercalate "\n") . mapM debugStackWs . W.workspaces -- | Dump the state of a workspace in the current 'StackSet' as a multiline 'String'. -- @ -- Workspace "foo:: -- mm -- * ww -- ^ww -- @ -- * indicates the focused window, ^ indicates a floating window debugStackWs :: W.Workspace String (Layout Window) Window -> X String debugStackWs w = withWindowSet $ \ws -> do let cur = if wt == W.currentTag ws then " (current)" else "" wt = W.tag w s <- emit ws $ W.integrate' . W.stack $ w return $ intercalate "\n" $ ("Workspace " ++ show wt ++ cur):s where emit :: WindowSet -> [Window] -> X [String] emit _ [] = return [" -empty workspace-"] emit ww ws = do (_,ss) <- foldM emit' (ww,[]) ws return ss emit' :: (WindowSet,[String]) -> Window -> X (WindowSet,[String]) emit' (ws,a) w' = do let focus = if Just w' == W.peek ws then '*' else ' ' float = if w' `member` W.floating ws then '^' else ' ' s <- debugWindow w' return (ws,(focus:float:s):a) xmonad-contrib-0.12/XMonad/Hooks/FloatNext.hs0000644000000000000000000000754312636047674017307 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.FloatNext -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Hook and keybindings for automatically sending the next -- spawned window(s) to the floating layer. -- ----------------------------------------------------------------------------- module XMonad.Hooks.FloatNext ( -- * Usage -- $usage -- * The hook floatNextHook -- * Actions , floatNext , toggleFloatNext , floatAllNew , toggleFloatAllNew -- * Queries , willFloatNext , willFloatAllNew -- * 'DynamicLog' utilities -- $pp , willFloatNextPP , willFloatAllNewPP , runLogHook ) where import XMonad import XMonad.Hooks.ToggleHook hookName :: String hookName = "__float" -- $usage -- This module provides actions (that can be set as keybindings) -- to automatically send the next spawned window(s) to the floating -- layer. -- -- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.FloatNext -- -- and adding 'floatNextHook' to your 'ManageHook': -- -- > myManageHook = floatNextHook <+> manageHook def -- -- The 'floatNext' and 'toggleFloatNext' functions can be used in key -- bindings to float the next spawned window: -- -- > , ((modm, xK_e), toggleFloatNext) -- -- 'floatAllNew' and 'toggleFloatAllNew' are similar but float all -- spawned windows until disabled again. -- -- > , ((modm, xK_r), toggleFloatAllNew) -- | This 'ManageHook' will selectively float windows as set -- by 'floatNext' and 'floatAllNew'. floatNextHook :: ManageHook floatNextHook = toggleHook hookName doFloat -- | @floatNext True@ arranges for the next spawned window to be -- sent to the floating layer, @floatNext False@ cancels it. floatNext :: Bool -> X () floatNext = hookNext hookName toggleFloatNext :: X () toggleFloatNext = toggleHookNext hookName -- | @floatAllNew True@ arranges for new windows to be -- sent to the floating layer, @floatAllNew False@ cancels it floatAllNew :: Bool -> X () floatAllNew = hookAllNew hookName toggleFloatAllNew :: X () toggleFloatAllNew = toggleHookAllNew hookName -- | Whether the next window will be set floating willFloatNext :: X Bool willFloatNext = willHookNext hookName -- | Whether new windows will be set floating willFloatAllNew :: X Bool willFloatAllNew = willHookAllNew hookName -- $pp -- The following functions are used to display the current -- state of 'floatNext' and 'floatAllNew' in your -- 'XMonad.Hooks.DynamicLog.dynamicLogWithPP'. -- 'willFloatNextPP' and 'willFloatAllNewPP' should be added -- to the 'XMonad.Hooks.DynamicLog.ppExtras' field of your -- 'XMonad.Hooks.DynamicLog.PP'. -- -- Use 'runLogHook' to refresh the output of your 'logHook', so -- that the effects of a 'floatNext'/... will be visible -- immediately: -- -- > , ((modm, xK_e), toggleFloatNext >> runLogHook) -- -- The @String -> String@ parameters to 'willFloatNextPP' and -- 'willFloatAllNewPP' will be applied to their output, you -- can use them to set the text color, etc., or you can just -- pass them 'id'. willFloatNextPP :: (String -> String) -> X (Maybe String) willFloatNextPP = willHookNextPP hookName willFloatAllNewPP :: (String -> String) -> X (Maybe String) willFloatAllNewPP = willHookAllNewPP hookName xmonad-contrib-0.12/XMonad/Hooks/DynamicLog.hs0000644000000000000000000005146712636047674017435 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.DynamicLog -- Copyright : (c) Don Stewart -- License : BSD3-style (see LICENSE) -- -- Maintainer : Don Stewart -- Stability : unstable -- Portability : unportable -- -- xmonad calls the logHook with every internal state update, which is -- useful for (among other things) outputting status information to an -- external status bar program such as xmobar or dzen. DynamicLog -- provides several drop-in logHooks for this purpose, as well as -- flexible tools for specifying your own formatting. -- ----------------------------------------------------------------------------- module XMonad.Hooks.DynamicLog ( -- * Usage -- $usage -- * Drop-in loggers dzen, xmobar, statusBar, dynamicLog, dynamicLogXinerama, xmonadPropLog', xmonadPropLog, -- * Build your own formatter dynamicLogWithPP, dynamicLogString, PP(..), defaultPP, def, -- * Example formatters dzenPP, xmobarPP, sjanssenPP, byorgeyPP, -- * Formatting utilities wrap, pad, trim, shorten, xmobarColor, xmobarStrip, xmobarStripTags, dzenColor, dzenEscape, dzenStrip, -- * Internal formatting functions pprWindowSet, pprWindowSetXinerama -- * To Do -- $todo ) where -- Useful imports import Codec.Binary.UTF8.String (encodeString) import Control.Monad (liftM2, msum) import Data.Char ( isSpace, ord ) import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy) import Data.Maybe ( isJust, catMaybes, mapMaybe ) import Data.Ord ( comparing ) import qualified Data.Map as M import qualified XMonad.StackSet as S import Foreign.C (CChar) import XMonad import XMonad.Util.WorkspaceCompare import XMonad.Util.NamedWindows import XMonad.Util.Run import XMonad.Layout.LayoutModifier import XMonad.Hooks.UrgencyHook import XMonad.Hooks.ManageDocks -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad -- > import XMonad.Hooks.DynamicLog -- -- If you just want a quick-and-dirty status bar with zero effort, try -- the 'xmobar' or 'dzen' functions: -- -- > main = xmonad =<< xmobar myConfig -- > -- > myConfig = def { ... } -- -- There is also 'statusBar' if you'd like to use another status bar, or would -- like to use different formatting options. The 'xmobar', 'dzen', and -- 'statusBar' functions are preferred over the other options listed below, as -- they take care of all the necessary plumbing -- no shell scripting required! -- -- Alternatively, you can choose among several default status bar formats -- ('dynamicLog' or 'dynamicLogXinerama') by simply setting your logHook to the -- appropriate function, for instance: -- -- > main = xmonad $ def { -- > ... -- > logHook = dynamicLog -- > ... -- > } -- -- For more flexibility, you can also use 'dynamicLogWithPP' and supply -- your own pretty-printing format (by either defining one from scratch, -- or customizing one of the provided examples). -- For example: -- -- > -- use sjanssen's pretty-printer format, but with the sections -- > -- in reverse -- > logHook = dynamicLogWithPP $ sjanssenPP { ppOrder = reverse } -- -- Note that setting the @logHook@ only sets up xmonad's output; you -- are responsible for starting your own status bar program (e.g. dzen -- or xmobar) and making sure xmonad's output is piped into it -- appropriately, either by putting it in your @.xsession@ or similar -- file, or by using @spawnPipe@ in your @main@ function, for example: -- -- > import XMonad.Util.Run -- for spawnPipe and hPutStrLn -- > -- > main = do -- > h <- spawnPipe "xmobar -options -foo -bar" -- > xmonad $ def { -- > ... -- > logHook = dynamicLogWithPP $ def { ppOutput = hPutStrLn h } -- -- If you use @spawnPipe@, be sure to redefine the 'ppOutput' field of -- your pretty-printer as in the example above; by default the status -- will be printed to stdout rather than the pipe you create. -- -- Even if you don't use a statusbar, you can still use -- 'dynamicLogString' to show on-screen notifications in response to -- some events. For example, to show the current layout when it -- changes, you could make a keybinding to cycle the layout and -- display the current status: -- -- > , ((mod1Mask, xK_a ), sendMessage NextLayout >> (dynamicLogString myPP >>= \d->spawn $"xmessage "++d)) -- -- $todo -- -- * incorporate dynamicLogXinerama into the PP framework somehow -- -- * add an xmobarEscape function ------------------------------------------------------------------------ -- | Run xmonad with a dzen status bar set to some nice defaults. -- -- > main = xmonad =<< dzen myConfig -- > -- > myConfig = def { ... } -- -- The intent is that the above config file should provide a nice -- status bar with minimal effort. -- -- If you wish to customize the status bar format at all, you'll have to -- use the 'statusBar' function instead. -- -- The binding uses the XMonad.Hooks.ManageDocks module to automatically -- handle screen placement for dzen, and enables 'mod-b' for toggling -- the menu bar. -- dzen :: LayoutClass l Window => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l)) dzen conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf where fg = "'#a8a3f7'" -- n.b quoting bg = "'#3f3c6d'" flags = "-e 'onstart=lower' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg -- | Run xmonad with a xmobar status bar set to some nice defaults. -- -- > main = xmonad =<< xmobar myConfig -- > -- > myConfig = def { ... } -- -- This works pretty much the same as 'dzen' function above. -- xmobar :: LayoutClass l Window => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l)) xmobar conf = statusBar "xmobar" xmobarPP toggleStrutsKey conf -- | Modifies the given base configuration to launch the given status bar, -- send status information to that bar, and allocate space on the screen edges -- for the bar. statusBar :: LayoutClass l Window => String -- ^ the command line to launch the status bar -> PP -- ^ the pretty printing options -> (XConfig Layout -> (KeyMask, KeySym)) -- ^ the desired key binding to toggle bar visibility -> XConfig l -- ^ the base config -> IO (XConfig (ModifiedLayout AvoidStruts l)) statusBar cmd pp k conf = do h <- spawnPipe cmd return $ conf { layoutHook = avoidStruts (layoutHook conf) , logHook = do logHook conf dynamicLogWithPP pp { ppOutput = hPutStrLn h } , manageHook = manageHook conf <+> manageDocks , keys = liftM2 M.union keys' (keys conf) } where keys' = (`M.singleton` sendMessage ToggleStruts) . k -- | Write a string to a property on the root window. This property is of -- type UTF8_STRING. The string must have been processed by encodeString -- (dynamicLogString does this). xmonadPropLog' :: String -> String -> X () xmonadPropLog' prop msg = do d <- asks display r <- asks theRoot xlog <- getAtom prop ustring <- getAtom "UTF8_STRING" io $ changeProperty8 d r xlog ustring propModeReplace (encodeCChar msg) where encodeCChar :: String -> [CChar] encodeCChar = map (fromIntegral . ord) -- | Write a string to the _XMONAD_LOG property on the root window. xmonadPropLog :: String -> X () xmonadPropLog = xmonadPropLog' "_XMONAD_LOG" -- | -- Helper function which provides ToggleStruts keybinding -- toggleStrutsKey :: XConfig t -> (KeyMask, KeySym) toggleStrutsKey XConfig{modMask = modm} = (modm, xK_b ) ------------------------------------------------------------------------ -- | An example log hook, which prints status information to stdout in -- the default format: -- -- > 1 2 [3] 4 7 : full : title -- -- That is, the currently populated workspaces, the current -- workspace layout, and the title of the focused window. -- -- To customize the output format, see 'dynamicLogWithPP'. -- dynamicLog :: X () dynamicLog = dynamicLogWithPP def -- | Format the current status using the supplied pretty-printing format, -- and write it to stdout. dynamicLogWithPP :: PP -> X () dynamicLogWithPP pp = dynamicLogString pp >>= io . ppOutput pp -- | The same as 'dynamicLogWithPP', except it simply returns the status -- as a formatted string without actually printing it to stdout, to -- allow for further processing, or use in some application other than -- a status bar. dynamicLogString :: PP -> X String dynamicLogString pp = do winset <- gets windowset urgents <- readUrgents sort' <- ppSort pp -- layout description let ld = description . S.layout . S.workspace . S.current $ winset -- workspace list let ws = pprWindowSet sort' urgents pp winset -- window title wt <- maybe (return "") (fmap show . getName) . S.peek $ winset -- run extra loggers, ignoring any that generate errors. extras <- mapM (flip catchX (return Nothing)) $ ppExtras pp return $ encodeString . sepBy (ppSep pp) . ppOrder pp $ [ ws , ppLayout pp ld , ppTitle pp $ ppTitleSanitize pp wt ] ++ catMaybes extras -- | Format the workspace information, given a workspace sorting function, -- a list of urgent windows, a pretty-printer format, and the current -- WindowSet. pprWindowSet :: WorkspaceSort -> [Window] -> PP -> WindowSet -> String pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $ map S.workspace (S.current s : S.visible s) ++ S.hidden s where this = S.currentTag s visibles = map (S.tag . S.workspace) (S.visible s) fmt w = printer pp (S.tag w) where printer | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents = ppUrgent | S.tag w == this = ppCurrent | S.tag w `elem` visibles = ppVisible | isJust (S.stack w) = ppHidden | otherwise = ppHiddenNoWindows -- | -- Workspace logger with a format designed for Xinerama: -- -- > [1 9 3] 2 7 -- -- where 1, 9, and 3 are the workspaces on screens 1, 2 and 3, respectively, -- and 2 and 7 are non-visible, non-empty workspaces. -- -- At the present time, the current layout and window title -- are not shown. The xinerama workspace format shown above can be (mostly) replicated -- using 'dynamicLogWithPP' by setting 'ppSort' to /getSortByXineramaRule/ from -- "XMonad.Util.WorkspaceCompare". For example, -- -- > def { ppCurrent = dzenColor "red" "#efebe7" -- > , ppVisible = wrap "[" "]" -- > , ppSort = getSortByXineramaRule -- > } dynamicLogXinerama :: X () dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama pprWindowSetXinerama :: WindowSet -> String pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen where onscreen = map (S.tag . S.workspace) . sortBy (comparing S.screen) $ S.current ws : S.visible ws offscreen = map S.tag . filter (isJust . S.stack) . sortBy (comparing S.tag) $ S.hidden ws -- | Wrap a string in delimiters, unless it is empty. wrap :: String -- ^ left delimiter -> String -- ^ right delimiter -> String -- ^ output string -> String wrap _ _ "" = "" wrap l r m = l ++ m ++ r -- | Pad a string with a leading and trailing space. pad :: String -> String pad = wrap " " " " -- | Trim leading and trailing whitespace from a string. trim :: String -> String trim = f . f where f = reverse . dropWhile isSpace -- | Limit a string to a certain length, adding "..." if truncated. shorten :: Int -> String -> String shorten n xs | length xs < n = xs | otherwise = take (n - length end) xs ++ end where end = "..." -- | Output a list of strings, ignoring empty ones and separating the -- rest with the given separator. sepBy :: String -- ^ separator -> [String] -- ^ fields to output -> String sepBy sep = concat . intersperse sep . filter (not . null) -- | Use dzen escape codes to output a string with given foreground -- and background colors. dzenColor :: String -- ^ foreground color: a color name, or #rrggbb format -> String -- ^ background color -> String -- ^ output string -> String dzenColor fg bg = wrap (fg1++bg1) (fg2++bg2) where (fg1,fg2) | null fg = ("","") | otherwise = ("^fg(" ++ fg ++ ")","^fg()") (bg1,bg2) | null bg = ("","") | otherwise = ("^bg(" ++ bg ++ ")","^bg()") -- | Escape any dzen metacharacters. dzenEscape :: String -> String dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x]) -- | Strip dzen formatting or commands. dzenStrip :: String -> String dzenStrip = strip [] where strip keep x | null x = keep | "^^" `isPrefixOf` x = strip (keep ++ "^") (drop 2 x) | '^' == head x = strip keep (drop 1 . dropWhile (/= ')') $ x) | otherwise = let (good,x') = span (/= '^') x in strip (keep ++ good) x' -- | Use xmobar escape codes to output a string with given foreground -- and background colors. xmobarColor :: String -- ^ foreground color: a color name, or #rrggbb format -> String -- ^ background color -> String -- ^ output string -> String xmobarColor fg bg = wrap t "" where t = concat [""] -- ??? add an xmobarEscape function? -- | Strip xmobar markup, specifically the , and tags and -- the matching tags like . xmobarStrip :: String -> String xmobarStrip = converge (xmobarStripTags ["fc","icon","action"]) where converge :: (Eq a) => (a -> a) -> a -> a converge f a = let xs = iterate f a in fst $ head $ dropWhile (uncurry (/=)) $ zip xs $ tail xs xmobarStripTags :: [String] -- ^ tags -> String -> String -- ^ with all ... removed xmobarStripTags tags = strip [] where strip keep [] = keep strip keep x | rest: _ <- mapMaybe dropTag tags = strip keep rest | '<':xs <- x = strip (keep ++ "<") xs | (good,x') <- span (/= '<') x = strip (keep ++ good) x' -- this is n^2 bad... but titles have few tags where dropTag :: String -> Maybe String dropTag tag = msum [fmap dropTilClose (openTag tag `stripPrefix` x), closeTag tag `stripPrefix` x] dropTilClose, openTag, closeTag :: String -> String dropTilClose = drop 1 . dropWhile (/= '>') openTag str = "<" ++ str ++ "=" closeTag str = "" -- | The 'PP' type allows the user to customize the formatting of -- status information. data PP = PP { ppCurrent :: WorkspaceId -> String -- ^ how to print the tag of the currently focused -- workspace , ppVisible :: WorkspaceId -> String -- ^ how to print tags of visible but not focused -- workspaces (xinerama only) , ppHidden :: WorkspaceId -> String -- ^ how to print tags of hidden workspaces which -- contain windows , ppHiddenNoWindows :: WorkspaceId -> String -- ^ how to print tags of empty hidden workspaces , ppUrgent :: WorkspaceId -> String -- ^ format to be applied to tags of urgent workspaces. , ppSep :: String -- ^ separator to use between different log sections -- (window name, layout, workspaces) , ppWsSep :: String -- ^ separator to use between workspace tags , ppTitle :: String -> String -- ^ window title format , ppTitleSanitize :: String -> String -- ^ escape / sanitizes input to 'ppTitle' , ppLayout :: String -> String -- ^ layout name format , ppOrder :: [String] -> [String] -- ^ how to order the different log sections. By -- default, this function receives a list with three -- formatted strings, representing the workspaces, -- the layout, and the current window title, -- respectively. If you have specified any extra -- loggers in 'ppExtras', their output will also be -- appended to the list. To get them in the reverse -- order, you can just use @ppOrder = reverse@. If -- you don't want to display the current layout, you -- could use something like @ppOrder = \\(ws:_:t:_) -> -- [ws,t]@, and so on. , ppSort :: X ([WindowSpace] -> [WindowSpace]) -- ^ how to sort the workspaces. See -- "XMonad.Util.WorkspaceCompare" for some useful -- sorts. , ppExtras :: [X (Maybe String)] -- ^ loggers for generating extra information such as -- time and date, system load, battery status, and so -- on. See "XMonad.Util.Loggers" for examples, or create -- your own! , ppOutput :: String -> IO () -- ^ applied to the entire formatted string in order to -- output it. Can be used to specify an alternative -- output method (e.g. write to a pipe instead of -- stdout), and\/or to perform some last-minute -- formatting. } -- | The default pretty printing options, as seen in 'dynamicLog'. {-# DEPRECATED defaultPP "Use def (from Data.Default, and re-exported by XMonad.Hooks.DynamicLog) instead." #-} defaultPP :: PP defaultPP = def instance Default PP where def = PP { ppCurrent = wrap "[" "]" , ppVisible = wrap "<" ">" , ppHidden = id , ppHiddenNoWindows = const "" , ppUrgent = id , ppSep = " : " , ppWsSep = " " , ppTitle = shorten 80 , ppTitleSanitize = xmobarStrip . dzenEscape , ppLayout = id , ppOrder = id , ppOutput = putStrLn , ppSort = getSortByIndex , ppExtras = [] } -- | Settings to emulate dwm's statusbar, dzen only. dzenPP :: PP dzenPP = def { ppCurrent = dzenColor "white" "#2b4f98" . pad , ppVisible = dzenColor "black" "#999999" . pad , ppHidden = dzenColor "black" "#cccccc" . pad , ppHiddenNoWindows = const "" , ppUrgent = dzenColor "red" "yellow" . pad , ppWsSep = "" , ppSep = "" , ppLayout = dzenColor "black" "#cccccc" . (\ x -> pad $ case x of "TilePrime Horizontal" -> "TTT" "TilePrime Vertical" -> "[]=" "Hinted Full" -> "[ ]" _ -> x ) , ppTitle = ("^bg(#324c80) " ++) . dzenEscape } -- | Some nice xmobar defaults. xmobarPP :: PP xmobarPP = def { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" , ppTitle = xmobarColor "green" "" . shorten 40 , ppVisible = wrap "(" ")" , ppUrgent = xmobarColor "red" "yellow" } -- | The options that sjanssen likes to use with xmobar, as an -- example. Note the use of 'xmobarColor' and the record update on -- 'def'. sjanssenPP :: PP sjanssenPP = def { ppCurrent = xmobarColor "white" "black" , ppTitle = xmobarColor "#00ee00" "" . shorten 120 } -- | The options that byorgey likes to use with dzen, as another example. byorgeyPP :: PP byorgeyPP = def { ppHiddenNoWindows = showNamedWorkspaces , ppHidden = dzenColor "black" "#a8a3f7" . pad , ppCurrent = dzenColor "yellow" "#a8a3f7" . pad , ppUrgent = dzenColor "red" "yellow" . pad , ppSep = " | " , ppWsSep = "" , ppTitle = shorten 70 , ppOrder = reverse } where showNamedWorkspaces wsId = if any (`elem` wsId) ['a'..'z'] then pad wsId else "" xmonad-contrib-0.12/XMonad/Hooks/RestoreMinimized.hs0000644000000000000000000000307612636047674020671 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.RestoreMinimized -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- (Deprecated: Use XMonad.Hooks.Minimize) Lets you restore minimized -- windows (see "XMonad.Layout.Minimize") by selecting them on a -- taskbar (listens for _NET_ACTIVE_WINDOW and WM_CHANGE_STATE). -- ----------------------------------------------------------------------------- module XMonad.Hooks.RestoreMinimized ( -- * Usage -- $usage RestoreMinimized (..) , restoreMinimizedEventHook ) where import Data.Monoid import Control.Monad(when) import XMonad import XMonad.Layout.Minimize -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.RestoreMinimized -- > -- > myHandleEventHook = restoreMinimizedEventHook -- > -- > main = xmonad def { handleEventHook = myHandleEventHook } data RestoreMinimized = RestoreMinimized deriving ( Show, Read ) restoreMinimizedEventHook :: Event -> X All restoreMinimizedEventHook (ClientMessageEvent {ev_window = w, ev_message_type = mt}) = do a_aw <- getAtom "_NET_ACTIVE_WINDOW" a_cs <- getAtom "WM_CHANGE_STATE" when (mt == a_aw || mt == a_cs) $ do sendMessage (RestoreMinimizedWin w) return (All True) restoreMinimizedEventHook _ = return (All True) xmonad-contrib-0.12/XMonad/Hooks/ManageDebug.hs0000644000000000000000000001013112636047674017525 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ManageDebug -- Copyright : (c) Brandon S Allbery KF8NH, 2014 -- License : BSD3-style (see LICENSE) -- -- Maintainer : allbery.b@gmail.com -- Stability : unstable -- Portability : not portable -- -- A @manageHook@ and associated @logHook@ for debugging 'ManageHook's. -- Simplest usage: wrap your xmonad config in the @debugManageHook@ combinator. -- Or use @debugManageHookOn@ for a triggerable version, specifying the -- triggering key sequence in 'XMonad.Util.EZConfig' syntax. Or use the -- individual hooks in whatever way you see fit. -- ----------------------------------------------------------------------------- -- -- module XMonad.Hooks.ManageDebug (debugManageHook ,debugManageHookOn ,manageDebug ,maybeManageDebug ,manageDebugLogHook ,debugNextManagedWindow ) where import XMonad import XMonad.Hooks.DebugStack import XMonad.Util.DebugWindow import XMonad.Util.EZConfig import qualified XMonad.Util.ExtensibleState as XS import Control.Monad (when) -- persistent state for manageHook debugging to trigger logHook debugging data ManageStackDebug = MSD (Bool,Bool) deriving Typeable instance ExtensionClass ManageStackDebug where initialValue = MSD (False,False) -- | A combinator to add full 'ManageHook' debugging in a single operation. debugManageHook :: XConfig l -> XConfig l debugManageHook cf = cf {logHook = manageDebugLogHook <+> logHook cf ,manageHook = manageDebug <+> manageHook cf } -- | A combinator to add triggerable 'ManageHook' debugging in a single operation. -- Specify a key sequence as a string in 'XMonad.Util.EZConfig' syntax; press -- this key before opening the window to get just that logged. debugManageHookOn :: String -> XConfig l -> XConfig l debugManageHookOn key cf = cf {logHook = manageDebugLogHook <+> logHook cf ,manageHook = maybeManageDebug <+> manageHook cf } `additionalKeysP` [(key,debugNextManagedWindow)] -- | Place this at the start of a 'ManageHook', or possibly other places for a -- more limited view. It will show the current 'StackSet' state and the new -- window, and set a flag so that @manageDebugLogHook@ will display the -- final 'StackSet' state. -- -- Note that the initial state shows only the current workspace; the final -- one shows all workspaces, since your 'ManageHook' might use e.g. 'doShift', manageDebug :: ManageHook manageDebug = do w <- ask liftX $ do trace "== manageHook; current stack ==" debugStackString >>= trace ws <- debugWindow w trace $ "new:\n " ++ ws XS.modify $ \(MSD (_,key)) -> MSD (True,key) idHook -- | @manageDebug@ only if the user requested it with @debugNextManagedWindow@. maybeManageDebug :: ManageHook maybeManageDebug = do go <- liftX $ do MSD (log_,go') <- XS.get XS.put $ MSD (log_,False) return go' if go then manageDebug else idHook -- | If @manageDebug@ has set the debug-stack flag, show the stack. manageDebugLogHook :: X () manageDebugLogHook = do MSD (go,key) <- XS.get when go $ do trace "== manageHook; final stack ==" debugStackFullString >>= trace XS.put $ MSD (False,key) idHook -- | Request that the next window to be managed be @manageDebug@-ed. This can -- be used anywhere an X action can, such as key bindings, mouse bindings -- (presumably with 'const'), 'startupHook', etc. debugNextManagedWindow :: X () debugNextManagedWindow = XS.modify $ \(MSD (log_,_)) -> MSD (log_,True) xmonad-contrib-0.12/XMonad/Hooks/DynamicHooks.hs0000644000000000000000000000631212636047674017764 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.DynamicHooks -- Copyright : (c) Braden Shepherdson 2008 -- License : BSD-style (as xmonad) -- -- Maintainer : Braden.Shepherdson@gmail.com -- Stability : unstable -- Portability : unportable -- -- One-shot and permanent ManageHooks that can be updated at runtime. -- ----------------------------------------------------------------------------- module XMonad.Hooks.DynamicHooks ( -- * Usage -- $usage dynamicMasterHook ,addDynamicHook ,updateDynamicHook ,oneShotHook ) where import XMonad import qualified XMonad.Util.ExtensibleState as XS import Data.List import Data.Maybe (listToMaybe) import Data.Monoid -- $usage -- Provides two new kinds of 'ManageHooks' that can be defined at runtime. -- -- * One-shot 'ManageHooks' that are deleted after they execute. -- -- * Permanent 'ManageHooks' (unless you want to destroy them) -- -- Note that you will lose all dynamically defined 'ManageHook's when you @mod+q@! -- If you want them to last, you should create them as normal in your @xmonad.hs@. -- -- To use this module, add 'dynamicMasterHook' to your 'manageHook': -- -- > xmonad { manageHook = myManageHook <+> dynamicMasterHook } -- -- You can then use the supplied functions in your keybindings: -- -- > ((modMask,xK_a), oneShotHook (className =? "example") doFloat) -- data DynamicHooks = DynamicHooks { transients :: [(Query Bool, ManageHook)] , permanent :: ManageHook } deriving Typeable instance ExtensionClass DynamicHooks where initialValue = DynamicHooks [] idHook -- this hook is always executed, and the contents of the stored hooks checked. -- note that transient hooks are run second, therefore taking precedence -- over permanent ones on matters such as which workspace to shift to. -- doFloat and doIgnore are idempotent. -- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'. dynamicMasterHook :: ManageHook dynamicMasterHook = (ask >>= \w -> liftX (do dh <- XS.get (Endo f) <- runQuery (permanent dh) w ts <- mapM (\(q,a) -> runQuery q w >>= \x -> return (x,(q, a))) (transients dh) let (ts',nts) = partition fst ts gs <- mapM (flip runQuery w . snd . snd) ts' let (Endo g) = maybe (Endo id) id $ listToMaybe gs XS.put $ dh { transients = map snd nts } return $ Endo $ f . g )) -- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'. addDynamicHook :: ManageHook -> X () addDynamicHook m = updateDynamicHook (<+> m) -- | Modifies the permanent 'ManageHook' with an arbitrary function. updateDynamicHook :: (ManageHook -> ManageHook) -> X () updateDynamicHook f = XS.modify $ \dh -> dh { permanent = f (permanent dh) } -- | Creates a one-shot 'ManageHook'. Note that you have to specify the two -- parts of the 'ManageHook' separately. Where you would usually write: -- -- > className =? "example" --> doFloat -- -- you must call 'oneShotHook' as -- -- > oneShotHook dynHooksRef (className =? "example) doFloat -- oneShotHook :: Query Bool -> ManageHook -> X () oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):(transients dh) } xmonad-contrib-0.12/XMonad/Hooks/WorkspaceHistory.hs0000644000000000000000000000444712636047674020723 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.WorkspaceHistory -- Copyright : (c) 2013 Dmitri Iouchtchenko -- License : BSD3-style (see LICENSE) -- -- Maintainer : Dmitri Iouchtchenko -- Stability : unstable -- Portability : unportable -- -- Keeps track of workspace viewing order. -- ----------------------------------------------------------------------------- module XMonad.Hooks.WorkspaceHistory ( -- * Usage -- $usage -- * Hooking workspaceHistoryHook -- * Querying , workspaceHistory ) where import XMonad import XMonad.StackSet (currentTag) import qualified XMonad.Util.ExtensibleState as XS -- $usage -- To record the order in which you view workspaces, you can use this -- module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.WorkspaceHistory (workspaceHistoryHook) -- -- Then add the hook to your 'logHook': -- -- > main = xmonad $ def -- > { ... -- > , logHook = ... >> workspaceHistoryHook >> ... -- > , ... -- > } -- -- To make use of the collected data, a query function is provided. data WorkspaceHistory = WorkspaceHistory { history :: [WorkspaceId] -- ^ Workspaces in reverse-chronological order. } deriving (Typeable, Read, Show) instance ExtensionClass WorkspaceHistory where initialValue = WorkspaceHistory [] extensionType = PersistentExtension -- | A 'logHook' that keeps track of the order in which workspaces have -- been viewed. workspaceHistoryHook :: X () workspaceHistoryHook = gets (currentTag . windowset) >>= (XS.modify . makeFirst) -- | A list of workspace tags in the order they have been viewed, with the -- most recent first. No duplicates are present, but not all workspaces are -- guaranteed to appear, and there may be workspaces that no longer exist. workspaceHistory :: X [WorkspaceId] workspaceHistory = XS.gets history -- | Cons the 'WorkspaceId' onto the 'WorkspaceHistory' if it is not -- already there, or move it to the front if it is. makeFirst :: WorkspaceId -> WorkspaceHistory -> WorkspaceHistory makeFirst w v = let (xs, ys) = break (w ==) $ history v in v { history = w : (xs ++ drop 1 ys) } xmonad-contrib-0.12/XMonad/Hooks/ManageDocks.hs0000644000000000000000000002606112636047674017553 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ManageDocks -- Copyright : (c) Joachim Breitner -- License : BSD -- -- Maintainer : Joachim Breitner -- Stability : unstable -- Portability : unportable -- -- This module provides tools to automatically manage 'dock' type programs, -- such as gnome-panel, kicker, dzen, and xmobar. module XMonad.Hooks.ManageDocks ( -- * Usage -- $usage manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn, docksEventHook, ToggleStruts(..), SetStruts(..), module XMonad.Util.Types, #ifdef TESTING r2c, c2r, RectC(..), #endif -- for XMonad.Actions.FloatSnap calcGap ) where ----------------------------------------------------------------------------- import XMonad import Foreign.C.Types (CLong) import XMonad.Layout.LayoutModifier import XMonad.Util.Types import XMonad.Util.WindowProperties (getProp32s) import XMonad.Util.XUtils (fi) import Data.Monoid (All(..), mempty) import qualified Data.Set as S -- $usage -- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.ManageDocks -- -- The first component is a 'ManageHook' which recognizes these -- windows and de-manages them, so that xmonad does not try to tile -- them. To enable it: -- -- > manageHook = ... <+> manageDocks -- -- The second component is a layout modifier that prevents windows -- from overlapping these dock windows. It is intended to replace -- xmonad's so-called \"gap\" support. First, you must add it to your -- list of layouts: -- -- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...) -- > where tall = Tall 1 (3/100) (1/2) -- -- The third component is an event hook that causes new docks to appear -- immediately, instead of waiting for the next focus change. -- -- > handleEventHook = ... <+> docksEventHook -- -- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding -- similar to: -- -- > ,((modm, xK_b ), sendMessage ToggleStruts) -- -- If you have multiple docks, you can toggle their gaps individually. -- For example, to toggle only the top gap: -- -- > ,((modm .|. controlMask, xK_t), sendMessage $ ToggleStrut U) -- -- Similarly, you can use 'D', 'L', and 'R' to individually toggle -- gaps on the bottom, left, or right. -- -- If you want certain docks to be avoided but others to be covered by -- default, you can manually specify the sides of the screen on which -- docks should be avoided, using 'avoidStrutsOn'. For example: -- -- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...) -- -- /Important note/: if you are switching from manual gaps -- (defaultGaps in your config) to avoidStruts (recommended, since -- manual gaps will probably be phased out soon), be sure to switch -- off all your gaps (with mod-b) /before/ reloading your config with -- avoidStruts! Toggling struts with a 'ToggleStruts' message will -- not work unless your gaps are set to zero. -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- -- | Detects if the given window is of type DOCK and if so, reveals -- it, but does not manage it. manageDocks :: ManageHook manageDocks = checkDock --> (doIgnore <+> clearGapCache) where clearGapCache = do liftX (broadcastMessage ClearGapCache) mempty -- | Checks if a window is a DOCK or DESKTOP window checkDock :: Query Bool checkDock = ask >>= \w -> liftX $ do dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK" desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP" mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w case mbr of Just rs -> return $ any (`elem` [dock,desk]) (map fromIntegral rs) _ -> return False -- | Whenever a new dock appears, refresh the layout immediately to avoid the -- new dock. docksEventHook :: Event -> X All docksEventHook (MapNotifyEvent {ev_window = w}) = do whenX ((not `fmap` (isClient w)) <&&> runQuery checkDock w) $ do broadcastMessage ClearGapCache refresh return (All True) docksEventHook _ = return (All True) -- | Gets the STRUT config, if present, in xmonad gap order getStrut :: Window -> X [Strut] getStrut w = do msp <- getProp32s "_NET_WM_STRUT_PARTIAL" w case msp of Just sp -> return $ parseStrutPartial sp Nothing -> fmap (maybe [] parseStrut) $ getProp32s "_NET_WM_STRUT" w where parseStrut xs@[_, _, _, _] = parseStrutPartial . take 12 $ xs ++ cycle [minBound, maxBound] parseStrut _ = [] parseStrutPartial [l, r, t, b, ly1, ly2, ry1, ry2, tx1, tx2, bx1, bx2] = filter (\(_, n, _, _) -> n /= 0) [(L, l, ly1, ly2), (R, r, ry1, ry2), (U, t, tx1, tx2), (D, b, bx1, bx2)] parseStrutPartial _ = [] -- | Goes through the list of windows and find the gap so that all -- STRUT settings are satisfied. calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle) calcGap ss = withDisplay $ \dpy -> do rootw <- asks theRoot -- We don't keep track of dock like windows, so we find all of them here (_,_,wins) <- io $ queryTree dpy rootw struts <- (filter careAbout . concat) `fmap` mapM getStrut wins -- we grab the window attributes of the root window rather than checking -- the width of the screen because xlib caches this info and it tends to -- be incorrect after RAndR wa <- io $ getWindowAttributes dpy rootw let screen = r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa) return $ \r -> c2r $ foldr (reduce screen) (r2c r) struts where careAbout (s,_,_,_) = s `S.member` ss -- | Adjust layout automagically: don't cover up any docks, status -- bars, etc. avoidStruts :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a avoidStruts = avoidStrutsOn [U,D,L,R] -- | Adjust layout automagically: don't cover up docks, status bars, -- etc. on the indicated sides of the screen. Valid sides are U -- (top), D (bottom), R (right), or L (left). avoidStrutsOn :: LayoutClass l a => [Direction2D] -> l a -> ModifiedLayout AvoidStruts l a avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss) Nothing data AvoidStruts a = AvoidStruts { avoidStrutsDirection :: S.Set Direction2D, avoidStrutsRectCache :: Maybe (S.Set Direction2D, Rectangle, Rectangle ) } deriving ( Read, Show ) -- | Message type which can be sent to an 'AvoidStruts' layout -- modifier to alter its behavior. data ToggleStruts = ToggleStruts | ToggleStrut Direction2D deriving (Read,Show,Typeable) instance Message ToggleStruts -- | message sent to ensure that caching the gaps won't give a wrong result -- because a new dock has been added data ClearGapCache = ClearGapCache deriving (Read,Show,Typeable) instance Message ClearGapCache -- | SetStruts is a message constructor used to set or unset specific struts, -- regardless of whether or not the struts were originally set. Here are some -- example bindings: -- -- Show all gaps: -- -- > ,((modm .|. shiftMask ,xK_b),sendMessage $ SetStruts [minBound .. maxBound] []) -- -- Hide all gaps: -- -- > ,((modm .|. controlMask,xK_b),sendMessage $ SetStruts [] [minBound .. maxBound]) -- -- Show only upper and left gaps: -- -- > ,((modm .|. controlMask .|. shiftMask,xK_b),sendMessage $ SetStruts [U,L] [minBound .. maxBound]) -- -- Hide the bottom keeping whatever the other values were: -- -- > ,((modm .|. controlMask .|. shiftMask,xK_g),sendMessage $ SetStruts [] [D]) data SetStruts = SetStruts { addedStruts :: [Direction2D] , removedStruts :: [Direction2D] -- ^ These are removed from the currently set struts before 'addedStruts' are added. } deriving (Read,Show,Typeable) instance Message SetStruts instance LayoutModifier AvoidStruts a where modifyLayoutWithUpdate as@(AvoidStruts ss cache) w r = do nr <- case cache of Just (ss', r', nr) | ss' == ss, r' == r -> return nr _ -> do nr <- fmap ($ r) (calcGap ss) setWorkarea nr return nr arranged <- runLayout w nr let newCache = Just (ss, r, nr) return (arranged, if newCache == cache then Nothing else Just as{ avoidStrutsRectCache = newCache } ) pureMess as@(AvoidStruts { avoidStrutsDirection = ss }) m | Just ToggleStruts <- fromMessage m = Just $ as { avoidStrutsDirection = toggleAll ss } | Just (ToggleStrut s) <- fromMessage m = Just $ as { avoidStrutsDirection = toggleOne s ss } | Just (SetStruts n k) <- fromMessage m , let newSS = S.fromList n `S.union` (ss S.\\ S.fromList k) , newSS /= ss = Just $ as { avoidStrutsDirection = newSS } | Just ClearGapCache <- fromMessage m = Just $ as { avoidStrutsRectCache = Nothing } | otherwise = Nothing where toggleAll x | S.null x = S.fromList [minBound .. maxBound] | otherwise = S.empty toggleOne x xs | x `S.member` xs = S.delete x xs | otherwise = x `S.insert` xs setWorkarea :: Rectangle -> X () setWorkarea (Rectangle x y w h) = withDisplay $ \dpy -> do a <- getAtom "_NET_WORKAREA" c <- getAtom "CARDINAL" r <- asks theRoot io $ changeProperty32 dpy r a c propModeReplace [fi x, fi y, fi w, fi h] -- | (Direction, height\/width, initial pixel, final pixel). type Strut = (Direction2D, CLong, CLong, CLong) -- | (Initial x pixel, initial y pixel, -- final x pixel, final y pixel). newtype RectC = RectC (CLong, CLong, CLong, CLong) deriving (Eq,Show) -- | Invertible conversion. r2c :: Rectangle -> RectC r2c (Rectangle x y w h) = RectC (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1) -- | Invertible conversion. c2r :: RectC -> Rectangle c2r (RectC (x1, y1, x2, y2)) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1) reduce :: RectC -> Strut -> RectC -> RectC reduce (RectC (sx0, sy0, sx1, sy1)) (s, n, l, h) (RectC (x0, y0, x1, y1)) = RectC $ case s of L | p (y0, y1) && qh x1 -> (mx x0 sx0, y0 , x1 , y1 ) R | p (y0, y1) && qv sx1 x0 -> (x0 , y0 , mn x1 sx1, y1 ) U | p (x0, x1) && qh y1 -> (x0 , mx y0 sy0, x1 , y1 ) D | p (x0, x1) && qv sy1 y0 -> (x0 , y0 , x1 , mn y1 sy1) _ -> (x0 , y0 , x1 , y1 ) where mx a b = max a (b + n) mn a b = min a (b - n) p r = r `overlaps` (l, h) -- Filter out struts that cover the entire rectangle: qh d1 = n <= d1 qv sd1 d0 = sd1 - n >= d0 -- | Do the two ranges overlap? -- -- Precondition for every input range @(x, y)@: @x '<=' y@. -- -- A range @(x, y)@ is assumed to include every pixel from @x@ to @y@. overlaps :: Ord a => (a, a) -> (a, a) -> Bool (a, b) `overlaps` (x, y) = inRange (a, b) x || inRange (a, b) y || inRange (x, y) a where inRange (i, j) k = i <= k && k <= j xmonad-contrib-0.12/XMonad/Hooks/WorkspaceByPos.hs0000644000000000000000000000340012636047674020302 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.WorkspaceByPos -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- Useful in a dual-head setup: Looks at the requested geometry of -- new windows and moves them to the workspace of the non-focused -- screen if necessary. -- ----------------------------------------------------------------------------- module XMonad.Hooks.WorkspaceByPos ( -- * Usage -- $usage workspaceByPos ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Util.XUtils (fi) import Data.Maybe import Control.Applicative((<$>)) import Control.Monad.Error ((<=<),guard,lift,runErrorT,throwError) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.WorkspaceByPos -- > -- > myManageHook = workspaceByPos <+> manageHook def -- > -- > main = xmonad def { manageHook = myManageHook } workspaceByPos :: ManageHook workspaceByPos = (maybe idHook doShift <=< liftX . needsMoving) =<< ask needsMoving :: Window -> X (Maybe WorkspaceId) needsMoving w = withDisplay $ \d -> do -- only relocate windows with non-zero position wa <- io $ getWindowAttributes d w fmap (const Nothing `either` Just) . runErrorT $ do guard $ wa_x wa /= 0 || wa_y wa /= 0 ws <- gets windowset sc <- lift $ fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) Just wkspc <- lift $ screenWorkspace (W.screen sc) guard $ W.currentTag ws /= wkspc return wkspc `asTypeOf` throwError "" xmonad-contrib-0.12/XMonad/Hooks/ToggleHook.hs0000644000000000000000000001357612636047674017450 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ToggleHook -- Copyright : Ben Boeckel -- License : BSD-style (see LICENSE) -- -- Maintainer : Ben Boeckel -- Stability : unstable -- Portability : unportable -- -- Hook and keybindings for toggling hook behavior. ----------------------------------------------------------------------------- module XMonad.Hooks.ToggleHook ( -- * Usage -- $usage -- * The hook toggleHook , toggleHook' -- * Actions , hookNext , toggleHookNext , hookAllNew , toggleHookAllNew -- * Queries , willHook , willHookNext , willHookAllNew -- * 'DynamicLog' utilities -- $pp , willHookNextPP , willHookAllNewPP , runLogHook ) where import Prelude hiding (all) import XMonad import qualified XMonad.Util.ExtensibleState as XS import Control.Monad (join,guard) import Control.Applicative ((<$>)) import Control.Arrow (first, second) import Data.Map {- Helper functions -} _set :: String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X () _set n f b = modify' n (f $ const b) _toggle :: String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X () _toggle n f = modify' n (f not) _get :: String -> ((Bool, Bool) -> a) -> X a _get n f = XS.gets $ f . (findWithDefault (False, False) n . hooks) _pp :: String -> ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String) _pp n f s st = (\b -> guard b >> Just (st s)) <$> _get n f {- The current state is kept here -} data HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable, Read, Show) instance ExtensionClass HookState where initialValue = HookState empty extensionType = PersistentExtension modify' :: String -> ((Bool, Bool) -> (Bool, Bool)) -> X () modify' n f = XS.modify (HookState . setter . hooks) where setter m = insert n (f (findWithDefault (False, False) n m)) m -- $usage -- This module provides actions (that can be set as keybindings) -- to be able to cause hooks to be occur on a conditional basis. -- -- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.ToggleHook -- -- and adding 'toggleHook name hook' to your 'ManageHook' where @name@ is the -- name of the hook and @hook@ is the hook to execute based on the state. -- -- > myManageHook = toggleHook "float" doFloat <+> manageHook def -- -- Additionally, toggleHook' is provided to toggle between two hooks (rather -- than on/off). -- -- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <+> manageHook def -- -- The 'hookNext' and 'toggleHookNext' functions can be used in key -- bindings to set whether the hook is applied or not. -- -- > , ((modm, xK_e), toggleHookNext "float") -- -- 'hookAllNew' and 'toggleHookAllNew' are similar but float all -- spawned windows until disabled again. -- -- > , ((modm, xK_r), toggleHookAllNew "float") -- | This 'ManageHook' will selectively apply a hook as set -- by 'hookNext' and 'hookAllNew'. toggleHook :: String -> ManageHook -> ManageHook toggleHook n h = toggleHook' n h idHook toggleHook' :: String -> ManageHook -> ManageHook -> ManageHook toggleHook' n th fh = do m <- liftX $ XS.gets hooks (next, all) <- return $ findWithDefault (False, False) n m liftX $ XS.put $ HookState $ insert n (False, all) m if next || all then th else fh -- | @hookNext name True@ arranges for the next spawned window to -- have the hook @name@ applied, @hookNext name False@ cancels it. hookNext :: String -> Bool -> X () hookNext n = _set n first toggleHookNext :: String -> X () toggleHookNext n = _toggle n first -- | @hookAllNew name True@ arranges for new windows to -- have the hook @name@ applied, @hookAllNew name False@ cancels it hookAllNew :: String -> Bool -> X () hookAllNew n = _set n second toggleHookAllNew :: String -> X () toggleHookAllNew n = _toggle n second -- | Query what will happen at the next ManageHook call for the hook @name@. willHook :: String -> X Bool willHook n = willHookNext n <||> willHookAllNew n -- | Whether the next window will trigger the hook @name@. willHookNext :: String -> X Bool willHookNext n = _get n fst -- | Whether new windows will trigger the hook @name@. willHookAllNew :: String -> X Bool willHookAllNew n = _get n snd -- $pp -- The following functions are used to display the current -- state of 'hookNext' and 'hookAllNew' in your -- 'XMonad.Hooks.DynamicLog.dynamicLogWithPP'. -- 'willHookNextPP' and 'willHookAllNewPP' should be added -- to the 'XMonad.Hooks.DynamicLog.ppExtras' field of your -- 'XMonad.Hooks.DynamicLog.PP'. -- -- Use 'runLogHook' to refresh the output of your 'logHook', so -- that the effects of a 'hookNext'/... will be visible -- immediately: -- -- > , ((modm, xK_e), toggleHookNext "float" >> runLogHook) -- -- The @String -> String@ parameters to 'willHookNextPP' and -- 'willHookAllNewPP' will be applied to their output, you -- can use them to set the text color, etc., or you can just -- pass them 'id'. willHookNextPP :: String -> (String -> String) -> X (Maybe String) willHookNextPP n = _pp n fst "Next" willHookAllNewPP :: String -> (String -> String) -> X (Maybe String) willHookAllNewPP n = _pp n snd "All" runLogHook :: X () runLogHook = join $ asks $ logHook . config xmonad-contrib-0.12/XMonad/Hooks/EwmhDesktops.hs0000644000000000000000000002243312636047674020013 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.EwmhDesktops -- Copyright : (c) 2007, 2008 Joachim Breitner -- License : BSD -- -- Maintainer : Joachim Breitner -- Stability : unstable -- Portability : unportable -- -- Makes xmonad use the EWMH hints to tell panel applications about its -- workspaces and the windows therein. It also allows the user to interact -- with xmonad by clicking on panels and window lists. ----------------------------------------------------------------------------- module XMonad.Hooks.EwmhDesktops ( -- * Usage -- $usage ewmh, ewmhDesktopsStartup, ewmhDesktopsLogHook, ewmhDesktopsLogHookCustom, ewmhDesktopsEventHook, ewmhDesktopsEventHookCustom, fullscreenEventHook ) where import Codec.Binary.UTF8.String (encode) import Data.List import Data.Maybe import Data.Monoid import XMonad import Control.Monad import qualified XMonad.StackSet as W import XMonad.Hooks.SetWMName import XMonad.Util.XUtils (fi) import XMonad.Util.WorkspaceCompare import XMonad.Util.WindowProperties (getProp32) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad -- > import XMonad.Hooks.EwmhDesktops -- > -- > main = xmonad $ ewmh def{ handleEventHook = -- > handleEventHook def <+> fullscreenEventHook } -- -- You may also be interested in 'avoidStruts' from "XMonad.Hooks.ManageDocks". -- | Add EWMH functionality to the given config. See above for an example. ewmh :: XConfig a -> XConfig a ewmh c = c { startupHook = startupHook c +++ ewmhDesktopsStartup , handleEventHook = handleEventHook c +++ ewmhDesktopsEventHook , logHook = logHook c +++ ewmhDesktopsLogHook } -- @@@ will fix this correctly later with the rewrite where x +++ y = mappend y x -- | -- Initializes EwmhDesktops and advertises EWMH support to the X -- server ewmhDesktopsStartup :: X () ewmhDesktopsStartup = setSupported -- | -- Notifies pagers and window lists, such as those in the gnome-panel -- of the current state of workspaces and windows. ewmhDesktopsLogHook :: X () ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id -- | -- Generalized version of ewmhDesktopsLogHook that allows an arbitrary -- user-specified function to transform the workspace list (post-sorting) ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X () ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do sort' <- getSortByIndex let ws = f $ sort' $ W.workspaces s -- Number of Workspaces setNumberOfDesktops (length ws) -- Names thereof setDesktopNames (map W.tag ws) -- all windows, with focused windows last let wins = nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws setClientList wins -- Current desktop case (elemIndex (W.currentTag s) $ map W.tag ws) of Nothing -> return () Just curr -> do setCurrentDesktop curr -- Per window Desktop -- To make gnome-panel accept our xinerama stuff, we display -- all visible windows on the current desktop. forM_ (W.current s : W.visible s) $ \x -> forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do setWindowDesktop win curr forM_ (W.hidden s) $ \w -> case elemIndex (W.tag w) (map W.tag ws) of Nothing -> return () Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do setWindowDesktop win wn setActiveWindow return () -- | -- Intercepts messages from pagers and similar applications and reacts on them. -- Currently supports: -- -- * _NET_CURRENT_DESKTOP (switching desktops) -- -- * _NET_WM_DESKTOP (move windows to other desktops) -- -- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed) ewmhDesktopsEventHook :: Event -> X All ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id -- | -- Generalized version of ewmhDesktopsEventHook that allows an arbitrary -- user-specified function to transform the workspace list (post-sorting) ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All ewmhDesktopsEventHookCustom f e = handle f e >> return (All True) handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X () handle f (ClientMessageEvent { ev_window = w, ev_message_type = mt, ev_data = d }) = withWindowSet $ \s -> do sort' <- getSortByIndex let ws = f $ sort' $ W.workspaces s a_cd <- getAtom "_NET_CURRENT_DESKTOP" a_d <- getAtom "_NET_WM_DESKTOP" a_aw <- getAtom "_NET_ACTIVE_WINDOW" a_cw <- getAtom "_NET_CLOSE_WINDOW" a_ignore <- mapM getAtom ["XMONAD_TIMER"] if mt == a_cd then do let n = head d if 0 <= n && fi n < length ws then windows $ W.view (W.tag (ws !! fi n)) else trace $ "Bad _NET_CURRENT_DESKTOP with data[0]="++show n else if mt == a_d then do let n = head d if 0 <= n && fi n < length ws then windows $ W.shiftWin (W.tag (ws !! fi n)) w else trace $ "Bad _NET_DESKTOP with data[0]="++show n else if mt == a_aw then do windows $ W.focusWindow w else if mt == a_cw then do killWindow w else if mt `elem` a_ignore then do return () else do -- The Message is unknown to us, but that is ok, not all are meant -- to be handled by the window manager return () handle _ _ = return () -- | -- An event hook to handle applications that wish to fullscreen using the -- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen() -- function, such as Totem, Evince and OpenOffice.org. -- -- Note this is not included in 'ewmh'. fullscreenEventHook :: Event -> X All fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do wmstate <- getAtom "_NET_WM_STATE" fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN" wstate <- fromMaybe [] `fmap` getProp32 wmstate win let isFull = fromIntegral fullsc `elem` wstate -- Constants for the _NET_WM_STATE protocol: remove = 0 add = 1 toggle = 2 ptype = 4 -- The atom property type for changeProperty chWstate f = io $ changeProperty32 dpy win wmstate ptype propModeReplace (f wstate) when (typ == wmstate && fi fullsc `elem` dats) $ do when (action == add || (action == toggle && not isFull)) $ do chWstate (fi fullsc:) windows $ W.float win $ W.RationalRect 0 0 1 1 when (action == remove || (action == toggle && isFull)) $ do chWstate $ delete (fi fullsc) windows $ W.sink win return $ All True fullscreenEventHook _ = return $ All True setNumberOfDesktops :: (Integral a) => a -> X () setNumberOfDesktops n = withDisplay $ \dpy -> do a <- getAtom "_NET_NUMBER_OF_DESKTOPS" c <- getAtom "CARDINAL" r <- asks theRoot io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n] setCurrentDesktop :: (Integral a) => a -> X () setCurrentDesktop i = withDisplay $ \dpy -> do a <- getAtom "_NET_CURRENT_DESKTOP" c <- getAtom "CARDINAL" r <- asks theRoot io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i] setDesktopNames :: [String] -> X () setDesktopNames names = withDisplay $ \dpy -> do -- Names thereof r <- asks theRoot a <- getAtom "_NET_DESKTOP_NAMES" c <- getAtom "UTF8_STRING" let names' = map fromIntegral $ concatMap ((++[0]) . encode) names io $ changeProperty8 dpy r a c propModeReplace names' setClientList :: [Window] -> X () setClientList wins = withDisplay $ \dpy -> do -- (What order do we really need? Something about age and stacking) r <- asks theRoot c <- getAtom "WINDOW" a <- getAtom "_NET_CLIENT_LIST" io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins) a' <- getAtom "_NET_CLIENT_LIST_STACKING" io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins) setWindowDesktop :: (Integral a) => Window -> a -> X () setWindowDesktop win i = withDisplay $ \dpy -> do a <- getAtom "_NET_WM_DESKTOP" c <- getAtom "CARDINAL" io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i] setSupported :: X () setSupported = withDisplay $ \dpy -> do r <- asks theRoot a <- getAtom "_NET_SUPPORTED" c <- getAtom "ATOM" supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN" ,"_NET_NUMBER_OF_DESKTOPS" ,"_NET_CLIENT_LIST" ,"_NET_CLIENT_LIST_STACKING" ,"_NET_CURRENT_DESKTOP" ,"_NET_DESKTOP_NAMES" ,"_NET_ACTIVE_WINDOW" ,"_NET_WM_DESKTOP" ,"_NET_WM_STRUT" ] io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp) setWMName "xmonad" setActiveWindow :: X () setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do let w = fromMaybe none (W.peek s) r <- asks theRoot a <- getAtom "_NET_ACTIVE_WINDOW" c <- getAtom "WINDOW" io $ changeProperty32 dpy r a c propModeReplace [fromIntegral w] xmonad-contrib-0.12/XMonad/Hooks/DebugEvents.hs0000644000000000000000000015231412636047674017613 0ustar0000000000000000{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.DebugEvents -- Copyright : (c) Brandon S Allbery KF8NH, 2012 -- License : BSD3-style (see LICENSE) -- -- Maintainer : allbery.b@gmail.com -- Stability : unstable -- Portability : not portable -- -- Module to dump diagnostic information about X11 events received by -- @xmonad@. This is incomplete due to 'Event' being incomplete and not -- providing information about a number of events, and enforcing artificial -- constraints on others (for example 'ClientMessage'); the @X11@ package -- will require a number of changes to fix these problems. -- ----------------------------------------------------------------------------- module XMonad.Hooks.DebugEvents (debugEventsHook) where import Prelude import XMonad hiding (windowEvent ,(-->) ) import XMonad.Hooks.DebugKeyEvents (debugKeyEvents) import XMonad.Util.DebugWindow (debugWindow) -- import Graphics.X11.Xlib.Extras.GetAtomName (getAtomName) import Control.Exception.Extensible as E import Control.Monad.State import Control.Monad.Reader import Data.Char (isDigit) import Data.List (genericIndex ,genericLength ,unfoldr ) import Codec.Binary.UTF8.String import Data.Maybe (fromMaybe) import Data.Monoid import Foreign import Foreign.C.Types import Numeric (showHex) import System.Exit import System.IO import System.Process import Control.Applicative -- | Event hook to dump all received events. You should probably not use this -- unconditionally; it will produce massive amounts of output. debugEventsHook :: Event -> X All debugEventsHook e = debugEventsHook' e >> return (All True) -- | Dump an X11 event. Can't be used directly as a 'handleEventHook'. debugEventsHook' :: Event -> X () debugEventsHook' (ConfigureRequestEvent {ev_window = w ,ev_parent = p ,ev_x = x ,ev_y = y ,ev_width = wid ,ev_height = ht ,ev_border_width = bw ,ev_above = above ,ev_detail = place ,ev_value_mask = msk }) = do windowEvent "ConfigureRequest" w windowEvent " parent" p -- mask <- quickFormat msk $ dumpBits wmCRMask -- say " requested parameters" $ concat ['(':show wid -- ,'x':show ht -- ,')':if bw == 0 then "" else '+':show bw -- ,'@':'(':show x -- ,',':show y -- ,") mask " -- ,mask -- ] s <- quickFormat [x,y,wid,ht,bw,fromIntegral above,place] $ dumpListByMask' msk [("x" ,dump32 ,cARDINAL) ,("y" ,dump32 ,cARDINAL) ,("width" ,dump32 ,cARDINAL) ,("height" ,dump32 ,cARDINAL) ,("border_width",dump32 ,cARDINAL) ,("sibling" ,dumpWindow ,wINDOW ) ,("detail" ,dumpEnum wmPlacement,cARDINAL) ] say " requested" s debugEventsHook' (ConfigureEvent {ev_window = w ,ev_above = above }) = do windowEvent "Configure" w -- most of the content is covered by debugWindow when (above /= none) $ debugWindow above >>= say " above" debugEventsHook' (MapRequestEvent {ev_window = w ,ev_parent = p }) = windowEvent "MapRequest" w >> windowEvent " parent" p debugEventsHook' e@(KeyEvent {ev_event_type = t}) | t == keyPress = io (hPutStr stderr "KeyPress ") >> debugKeyEvents e >> return () debugEventsHook' (ButtonEvent {ev_window = w ,ev_state = s ,ev_button = b }) = do windowEvent "Button" w nl <- gets numberlockMask let msk | s == 0 = "" | otherwise = "modifiers " ++ vmask nl s say " button" $ show b ++ msk debugEventsHook' (DestroyWindowEvent {ev_window = w }) = windowEvent "DestroyWindow" w debugEventsHook' (UnmapEvent {ev_window = w }) = windowEvent "Unmap" w debugEventsHook' (MapNotifyEvent {ev_window = w }) = windowEvent "MapNotify" w {- way too much output; suppressed. debugEventsHook' (CrossingEvent {ev_window = w ,ev_subwindow = s }) = windowEvent "Crossing" w >> windowEvent " subwindow" s -} debugEventsHook' (CrossingEvent {}) = return () debugEventsHook' (SelectionRequest {ev_requestor = rw ,ev_owner = ow ,ev_selection = a }) = windowEvent "SelectionRequest" rw >> windowEvent " owner" ow >> atomEvent " atom" a debugEventsHook' (PropertyEvent {ev_window = w ,ev_atom = a ,ev_propstate = s }) = do a' <- atomName a -- too many of these, and they're not real useful if a' `elem` ["_NET_WM_USER_TIME" -- ,"_NET_WM_WINDOW_OPACITY" ] then return () else do windowEvent "Property on" w s' <- case s of 1 -> return "deleted" 0 -> dumpProperty a a' w (7 + length a') _ -> error "Illegal propState; Xlib corrupted?" say " atom" $ a' ++ s' debugEventsHook' (ExposeEvent {ev_window = w }) = windowEvent "Expose" w debugEventsHook' (ClientMessageEvent {ev_window = w ,ev_message_type = a -- @@@ they did it again! no ev_format, -- and ev_data is [CInt] -- @@@ and get a load of the trainwreck -- that is setClientMessageEvent! -- ,ev_format = b ,ev_data = vs' }) = do windowEvent "ClientMessage on" w n <- atomName a -- this is a sort of custom property -- @@@ this likely won't work as is; type information varies, I think (ta,b,l) <- case lookup n clientMessages of Nothing -> return (a,32,length vs') Just (ta',b,l) -> do ta <- getAtom ta' return (ta,b,l) let wl = bytes b vs <- io $ take (l * wl) `fmap` splitCInt vs' s <- dumpProperty' w a n ta b vs 0 (10 + length n) say " message" $ n ++ s debugEventsHook' _ = return () -- | Emit information about an atom. atomName :: Atom -> X String atomName a = withDisplay $ \d -> io $ fromMaybe ("(unknown atom " ++ show a ++ ")") `fmap` getAtomName d a -- | Emit an atom with respect to the current event. atomEvent :: String -> Atom -> X () atomEvent l a = atomName a >>= say l -- | Emit a window with respect to the current event. windowEvent :: String -> Window -> X () windowEvent l w = debugWindow w >>= say l -- | Helper to emit tagged event information. say :: String -> String -> X () say l s = trace $ l ++ ' ':s -- | Deconstuct a list of 'CInt's into raw bytes splitCInt :: [CInt] -> IO Raw splitCInt vs = io $ withArray vs $ \p -> peekArray (4 * length vs) (castPtr p :: Ptr CUChar) -- | Specify how to decode some common client messages. clientMessages :: [(String,(String,Int,Int))] clientMessages = [("_NET_ACTIVE_WINDOW",("_NET_ACTIVE_WINDOW",32,1)) ,("WM_CHANGE_STATE" ,("WM_STATE" ,32,2)) ,("WM_COMMAND" ,("STRING" , 8,0)) ,("WM_SAVE_YOURSELF" ,("STRING" , 8,0)) ] #if __GLASGOW_HASKELL__ < 707 finiteBitSize :: Bits a => a -> Int finiteBitSize x = bitSize x #endif -- | Convert a modifier mask into a useful string vmask :: KeyMask -> KeyMask -> String vmask numLockMask msk = unwords $ reverse $ fst $ foldr vmask' ([],msk) masks where masks = map (\m -> (m,show m)) [0..toEnum (finiteBitSize msk - 1)] ++ [(numLockMask,"num" ) ,( lockMask,"lock" ) ,(controlMask,"ctrl" ) ,( shiftMask,"shift") ,( mod5Mask,"mod5" ) ,( mod4Mask,"mod4" ) ,( mod3Mask,"mod3" ) ,( mod2Mask,"mod2" ) ,( mod1Mask,"mod1" ) ] vmask' _ a@( _,0) = a vmask' (m,s) (ss,v) | v .&. m == m = (s : ss,v .&. complement m) vmask' _ r = r -- formatting properties. ick. -- -- @@@ Document the parser. Someday. type Raw = [CUChar] data Decode = Decode {property :: Atom -- original property atom ,pName :: String -- its name ,pType :: Atom -- base property type atom ,width :: Int -- declared data width ,window :: Window -- source window ,indent :: Int -- current indent (via local) ,limit :: Int -- line length } -- the result accumulates here mainly for the benefit of the indenter data DecodeState = DecS {value :: Raw -- unconsumed raw property value ,accum :: String -- output accumulator ,joint :: String -- separator when adding to accumulator } newtype Decoder a = Decoder (ReaderT Decode (StateT DecodeState X) a) #ifndef __HADDOCK__ deriving (Functor ,Applicative ,Monad ,MonadIO ,MonadState DecodeState ,MonadReader Decode ) #endif -- | Retrive, parse, and dump a window property. As all the high-level property -- interfaces lose information necessary to decode properties correctly, we -- work at the lowest level available. dumpProperty :: Atom -> String -> Window -> Int -> X String dumpProperty a n w i = do prop <- withDisplay $ \d -> io $ alloca $ \fmtp -> alloca $ \szp -> alloca $ \lenp -> alloca $ \ackp -> alloca $ \vsp -> do rc <- xGetWindowProperty d w a 0 maxBound False anyPropertyType fmtp szp lenp ackp vsp case rc of 0 -> do fmt <- fromIntegral `fmap` peek fmtp vs' <- peek vsp sz <- fromIntegral `fmap` peek szp case () of () | fmt == none -> xFree vs' >> return (Left "(property deleted)" ) | sz < 0 -> xFree vs' >> return (Left $ "(illegal bit size " ++ show sz ++ ")" ) | sz `mod` 8 /= 0 -> xFree vs' >> return (Left $ "(illegal bit size " ++ show sz ++ ")" ) | otherwise -> do len <- fromIntegral `fmap` peek lenp -- that's as in "ack! it's fugged!" ack <- fromIntegral `fmap` peek ackp vs <- peekArray (len * bytes sz) vs' _ <- xFree vs' return $ Right (fmt,sz,ack,vs) e -> return $ Left $ "getWindowProperty failed: " ++ show e case prop of Left _ -> return "" Right (fmt,sz,ack,vs) -> dumpProperty' w a n fmt sz vs ack i -- @@@ am I better off passing in the Decode and DecodeState? -- | Parse and dump a property (or a 'ClientMessage'). dumpProperty' :: Window -- source window -> Atom -- property id -> String -- property name -> Atom -- property type -> Int -- bit width -> Raw -- raw value -> CULong -- size of un-dumped content -> Int -- indent for output formatting -> X String dumpProperty' w a n fmt sz vs ack i = do ptn <- atomName fmt let dec = Decode {property = a ,pName = n ,pType = fmt ,width = sz ,indent = i + length ptn + 6 ,window = w ,limit = 96 } dec' = dec {pType = cARDINAL ,width = 8 } ds = DecS {value = vs -- @@@ probably should push this outside, since it doesn't -- make sense for ClientMessage ,accum = " (" ++ ptn ++ ") " ,joint = "= " } (_,ds') <- runDecode dec ds $ dumpProp a n let fin = length (value ds') len = length vs lost = if ack == 0 then "" else "and " ++ show ack ++ " lost bytes" unk = case () of () | fin == len -> "undecodeable " | fin == 0 -> "." | otherwise -> "and remainder (" ++ show (len - fin) ++ '/':show len ++ ")" (_,ds'') <- if fin == 0 then return (True,ds') else runDecode dec' (withJoint' unk ds' ) $ dumpArray dump8 (_,ds''') <- if ack == 0 then return (True,ds'') else runDecode dec' (withJoint' " " ds'') $ propSimple lost -- @@@ return $ accum ds''' -- | A simplified version of 'dumpProperty\'', to format random values from -- events. quickFormat :: (Storable i, Integral i) => [i] -> Decoder Bool -> X String quickFormat v f = do let vl = length v vs <- io $ allocaArray vl $ \p -> pokeArray p (map fromIntegral v :: [CULong]) >> peekArray (4 * vl) (castPtr p :: Ptr CUChar) let dec = Decode {property = none ,pName = "" ,pType = cARDINAL ,width = 32 ,indent = 0 ,window = none ,limit = maxBound } ds = DecS {value = vs ,accum = "" ,joint = "" } (r,ds') <- runDecode dec ds f return $ accum ds' ++ if r then "" else "?" -- | Launch a decoding parser, returning success and final state. runDecode :: Decode -> DecodeState -> Decoder Bool -> X (Bool,DecodeState) runDecode c s (Decoder p) = runStateT (runReaderT p c) s -- Coerce bit size to bytes. bytes :: Int -> Int bytes w = w `div` 8 -- | The top level property decoder, for a wide variety of standard ICCCM and -- EWMH window properties. We pass part of the 'ReaderT' as arguments for -- pattern matching. dumpProp :: Atom -> String -> Decoder Bool dumpProp _ "CLIPBOARD" = dumpSelection dumpProp _ "_NET_SUPPORTED" = dumpArray dumpAtom dumpProp _ "_NET_CLIENT_LIST" = dumpArray dumpWindow dumpProp _ "_NET_CLIENT_LIST_STACKING" = dumpArray dumpWindow dumpProp _ "_NET_NUMBER_OF_DESKTOPS" = dump32 dumpProp _ "_NET_VIRTUAL_ROOTS" = dumpArray dumpWindow dumpProp _ "_NET_DESKTOP_GEOMETRY" = dumpArray dump32 dumpProp _ "_NET_DESKTOP_VIEWPORT" = dumpList [("w",dump32) ,("h",dump32) ] dumpProp _ "_NET_CURRENT_DESKTOP" = dump32 dumpProp _ "_NET_DESKTOP_NAMES" = dumpArray dumpUTF dumpProp _ "_NET_ACTIVE_WINDOW" = dumpActiveWindow dumpProp _ "_NET_WORKAREA" = dumpList [("start" ,dumpList [("x",dump32) ,("y",dump32) ] ) ,("size" ,dumpList [("w",dump32) ,("h",dump32) ] ) ] dumpProp _ "_NET_SUPPORTING_WM_CHECK" = dumpWindow dumpProp _ "_NET_DESKTOP_LAYOUT" = dumpList [("orientation" ,dumpEnum nwmOrientation ) ,("size" ,dumpList [("cols",dump32) ,("rows",dump32) ] ) ,("origin" ,dumpEnum nwmOrigin ) ] dumpProp _ "_NET_SHOWING_DESKTOP" = dump32 dumpProp _ "_NET_WM_NAME" = dumpUTF dumpProp _ "_NET_WM_VISIBLE_NAME" = dumpUTF dumpProp _ "_NET_WM_ICON_NAME" = dumpUTF dumpProp _ "_NET_WM_VISIBLE_ICON_NAME" = dumpUTF dumpProp _ "_NET_WM_DESKTOP" = dumpExcept [(0xFFFFFFFF,"all")] dump32 dumpProp _ "_NET_WM_WINDOW_TYPE" = dumpArray dumpAtom dumpProp _ "_NET_WM_STATE" = dumpArray dumpAtom dumpProp _ "_NET_WM_ALLOWED_ACTIONS" = dumpArray dumpAtom dumpProp _ "_NET_WM_STRUT" = dumpList [("left gap" ,dump32) ,("right gap" ,dump32) ,("top gap" ,dump32) ,("bottom gap",dump32) ] dumpProp _ "_NET_WM_STRUT_PARTIAL" = dumpList [("left gap" ,dump32) ,("right gap" ,dump32) ,("top gap" ,dump32) ,("bottom gap" ,dump32) ,("left start" ,dump32) ,("left end" ,dump32) ,("right start" ,dump32) ,("right end" ,dump32) ,("top start" ,dump32) ,("top end" ,dump32) ,("bottom start",dump32) ,("bottom end" ,dump32) ] dumpProp _ "_NET_WM_ICON_GEOMETRY" = dumpList [("x",dump32) ,("y",dump32) ,("w",dump32) ,("h",dump32) ] -- no, I'm not going to duplicate xprop *completely*! dumpProp _ "_NET_WM_ICON" = propSimple "(icon)" dumpProp _ "_NET_WM_PID" = dumpPid dumpProp _ "_NET_WM_HANDLED_ICONS" = propSimple "(defined)" dumpProp _ "_NET_WM_USER_TIME" = dumpExcept [(0,"do not map initially")] dumpTime dumpProp _ "_NET_FRAME_EXTENTS" = dumpList [("left" ,dump32) ,("right" ,dump32) ,("top" ,dump32) ,("bottom",dump32) ] dumpProp _ "_NET_WM_SYNC_REQUEST_COUNTER" = dumpExcept [(0,"illegal value 0")] dump64 dumpProp _ "_NET_STARTUP_ID" = dumpUTF dumpProp _ "WM_PROTOCOLS" = dumpArray dumpAtom dumpProp _ "WM_COLORMAP_WINDOWS" = dumpArray dumpWindow dumpProp _ "WM_STATE" = dumpState dumpProp _ "WM_LOCALE_NAME" = dumpString dumpProp _ "WM_CLIENT_LEADER" = dumpWindow dumpProp _ "_NET_WM_WINDOW_OPACITY" = dumpPercent dumpProp _ "XdndAware" = dumpArray dumpAtom dumpProp _ "_XKLAVIER_TRANSPARENT" = dumpInteger 32 dumpProp _ "_XKLAVIER_STATE" = dumpList [("state" ,dumpInteger 32) ,("indicators",dumpXKlInds) ] dumpProp _ "_MOTIF_DRAG_RECEIVER_INFO" = dumpMotifDragReceiver dumpProp _ "_OL_WIN_ATTR" = dumpOLAttrs dumpProp _ "_OL_DECOR_ADD" = dumpArray dumpAtom dumpProp _ "_OL_DECOR_DEL" = dumpArray dumpAtom dumpProp _ "_MOTIF_WM_HINTS" = dumpMwmHints dumpProp _ "_MOTIF_WM_INFO" = dumpMwmInfo dumpProp _ "_XMONAD_DECORATED_BY" = dumpWindow dumpProp _ "_XMONAD_DECORATION_FOR" = dumpWindow dumpProp a _ | a == wM_NAME = dumpString | a == pRIMARY = dumpSelection | a == sECONDARY = dumpSelection -- this is gross | a == wM_TRANSIENT_FOR = do root <- fromIntegral `fmap` inX (asks theRoot) w <- asks window WMHints {wmh_window_group = group} <- inX $ asks display >>= io . flip getWMHints w dumpExcept [(0 ,"window group " ++ show group) ,(root,"window group " ++ show group) ] dumpWindow | a == rESOURCE_MANAGER = dumpString | a == wM_COMMAND = dumpString | a == wM_HINTS = dumpWmHints | a == wM_CLIENT_MACHINE = dumpString | a == wM_ICON_NAME = dumpString | a == wM_ICON_SIZE = dumpList [("min size" ,dumpList [("w",dump32) ,("h",dump32) ] ) ,("max size" ,dumpList [("w",dump32) ,("h",dump32) ] ) ,("increment" ,dumpList [("w",dump32) ,("h",dump32) ] ) ] | a == wM_NORMAL_HINTS = (...) | a == wM_ZOOM_HINTS = (...) -- same as previous | a == rGB_DEFAULT_MAP = (...) -- XStandardColormap | a == rGB_BEST_MAP = (...) -- " | a == rGB_RED_MAP = (...) -- " | a == rGB_GREEN_MAP = (...) -- " | a == rGB_BLUE_MAP = (...) -- " | a == rGB_GRAY_MAP = (...) -- " | a == wM_CLASS = dumpList [("name" ,dumpString) ,("class",dumpString) ] dumpProp _ s | s `isCountOf` "WM_S" = dumpSelection | s `isCountOf` "_NET_WM_CM_S" = dumpSelection | s `isCountOf` "_NET_DESKTOP_LAYOUT_S" = dumpSelection | s `isCountOf` "CUT_BUFFER" = dumpString -- and dumpProperties does the rest | otherwise = return False -- lower level decoders -- -- alter the current joint withJoint :: String -> Decoder a -> Decoder a withJoint j = ((modify $ withJoint' j) >>) withJoint' :: String -> DecodeState -> DecodeState withJoint' j s = s {joint = j} -- lift an X into a Decoder inX :: X a -> Decoder a inX = Decoder . lift . lift -- flip isPrefixOf, but the remainder must be all digits isCountOf :: String -> String -> Bool -- note that \NUL is safe because atom names have to be C strings s `isCountOf` pfx = null $ dropWhile isDigit $ map fst $ dropWhile (uncurry (==)) $ zip s $ pfx ++ repeat '\NUL' -- localize an increased indent withIndent :: Int -> Decoder a -> Decoder a withIndent w = local (\r -> r {indent = indent r + w}) -- dump an array of items. this dumps the entire property dumpArray :: Decoder Bool -> Decoder Bool dumpArray item = do withIndent 1 $ append "[" >> withJoint "" (dumpArray' item "") -- step through values as an array, ending on parse error or end of list dumpArray' :: Decoder Bool -> String -> Decoder Bool dumpArray' item pfx = do vs <- gets value if vs == [] then append "]" else append pfx >> whenD item (dumpArray' item ",") -- keep parsing until a parse step fails -- @@@ which points out that all my uses of @whenX (return ...)@ are actually 'when', -- which suggests that 'whenX' is *also* the same function... yep. ISAGN whenD :: Monad m => m Bool -> m Bool -> m Bool whenD p f = p >>= \b -> if b then f else return False -- verify a decoder parameter, else call error reporter -- once again, it's more general than I originally wrote guardR :: (MonadReader r m, Eq v) => (r -> v) -- value selector -> v -- expected value -> (v -> v -> m a) -- error reporter -> m a -- continuation (hush) -> m a guardR sel val err good = do v <- asks sel if v == val then good else err v val -- this is kinda dumb fi :: Bool -> a -> a -> a fi p n y = if p then y else n -- flip (if' p), if that existed -- verify we have the expected word size guardSize :: Int -> Decoder Bool -> Decoder Bool -- see XSync documentation for this insanity guardSize 64 = guardR width 32 propSizeErr . guardSize' 8 propShortErr guardSize w = guardR width w propSizeErr . guardSize' (bytes w) propShortErr guardSize' :: Int -> Decoder a -> Decoder a -> Decoder a guardSize' l n y = gets value >>= \vs -> fi (length vs >= l) n y -- verify we have the expected property type guardType :: Atom -> Decoder Bool -> Decoder Bool guardType t = guardR pType t propTypeErr -- dump a structure as a named tuple dumpList :: [(String,Decoder Bool)] -> Decoder Bool dumpList proto = do a <- asks pType dumpList'' (maxBound :: CULong) (map (\(s,d) -> (s,d,a)) proto) "(" -- same but elements have their own distinct types dumpList' :: [(String,Decoder Bool,Atom)] -> Decoder Bool dumpList' proto = dumpList'' (maxBound :: CULong) proto "(" -- same but only dump elements identified by provided mask dumpListByMask :: CULong -> [(String,Decoder Bool)] -> Decoder Bool dumpListByMask m p = do a <- asks pType dumpList'' m (map (\(s,d) -> (s,d,a)) p) "(" -- and the previous two combined dumpListByMask' :: CULong -> [(String,Decoder Bool,Atom)] -> Decoder Bool dumpListByMask' m p = dumpList'' m p "(" dumpList'' :: CULong -> [(String,Decoder Bool,Atom)] -> String -> Decoder Bool dumpList'' _ [] _ = append ")" >> return True dumpList'' 0 _ _ = append ")" >> return True dumpList'' m ((l,p,t):ps) sep = do (e,sep') <- if m .&. 1 == 0 then do -- @@@ ew st <- get e <- local (\r -> r {pType = t}) p v' <- gets value put $ st {value = v'} return (e,sep) else do let label = sep ++ l ++ " = " append label e <- withJoint "" $ do local (\r -> r {pType = t ,indent = indent r + length label }) p return (e,",") if e then dumpList'' (m `shiftR` 1) ps sep' else return e -- do the getTextProperty dance, the hard way. -- @@@ @COMPOUND_TEXT@ not supported yet. dumpString :: Decoder Bool dumpString = do fmt <- asks pType [cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"] case () of () | fmt == cOMPOUND_TEXT -> guardSize 16 (...) | fmt == sTRING -> guardSize 8 $ do vs <- gets value modify (\r -> r {value = []}) let ss = flip unfoldr (map twiddle vs) $ \s -> if null s then Nothing else let (w,s'') = break (== '\NUL') s s' = if null s'' then s'' else tail s'' in Just (w,s') case ss of [s] -> append $ show s ss' -> let go (s:ss'') c = append c >> append (show s) >> go ss'' "," go [] _ = append "]" in append "[" >> go ss' "" | fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :) | otherwise -> (inX $ atomName fmt) >>= failure . ("unrecognized string type " ++) -- show who owns a selection dumpSelection :: Decoder Bool dumpSelection = do -- system selections contain a window ID; others are random -- note that the window ID will be the same as the owner, so -- we don't really care anyway. we *do* want the selection owner a <- asks property owner <- inX $ withDisplay $ \d -> io $ xGetSelectionOwner d a if owner == none then append "unowned" else do w <- inX $ debugWindow owner append $ "owned by " ++ w -- for now, not querying Xkb dumpXKlInds :: Decoder Bool dumpXKlInds = guardType iNTEGER $ do n <- fmap fromIntegral `fmap` getInt' 32 case n of Nothing -> propShortErr Just is -> append $ "indicators " ++ unwords (dumpInds is 1 1 []) where dumpInds :: Word32 -> Word32 -> Int -> [String] -> [String] dumpInds n bt c bs | n == 0 && c == 1 = ["none"] | n == 0 = bs | n .&. bt /= 0 = dumpInds (n .&. complement bt) (bt `shiftL` 1) (c + 1) ((show c):bs) | otherwise = dumpInds n (bt `shiftL` 1) (c + 1) bs -- decode an Atom dumpAtom :: Decoder Bool dumpAtom = guardType aTOM $ do a <- getInt' 32 case a of Nothing -> return False Just a' -> do an <- inX $ atomName $ fromIntegral a' append an dumpWindow :: Decoder Bool dumpWindow = guardSize 32 $ guardType wINDOW $ do w <- getInt' 32 case w of Nothing -> return False Just w' -> inX (debugWindow (fromIntegral w')) >>= append -- a bit of a hack; as a Property it's a wINDOW, as a ClientMessage it's a list dumpActiveWindow :: Decoder Bool dumpActiveWindow = guardSize 32 $ do t <- asks pType nAW <- inX $ getAtom "_NET_ACTIVE_WINDOW" case () of () | t == wINDOW -> dumpWindow | t == nAW -> dumpList' [("source" ,dumpEnum awSource,cARDINAL) ,("timestamp" ,dumpTime ,cARDINAL) ,("active window",dumpWindow ,wINDOW ) ] _ -> do t' <- inX $ atomName t failure $ concat ["(bad type " ,t' ,"; expected WINDOW or _NET_ACTIVE_WINDOW" ] -- dump a generic CARDINAL value dumpInt :: Int -> Decoder Bool dumpInt w = guardSize w $ guardType cARDINAL $ getInt w show -- INTEGER is the signed version of CARDINAL dumpInteger :: Int -> Decoder Bool dumpInteger w = guardSize w $ guardType iNTEGER $ getInt w (show . signed w) -- reinterpret an unsigned as a signed signed :: Int -> Integer -> Integer signed w i = bit (w + 1) - i -- and wrappers to keep the parse list in bounds dump64 :: Decoder Bool dump64 = dumpInt 64 dump32 :: Decoder Bool dump32 = dumpInt 32 {- not used in standard properties dump16 :: Decoder Bool dump16 = dumpInt 16 -} dump8 :: Decoder Bool dump8 = dumpInt 8 -- I am assuming for the moment that this is a single string. -- This might be false; consider the way the STRING properties -- handle lists. dumpUTF :: Decoder Bool dumpUTF = do uTF8_STRING <- inX $ getAtom "UTF8_STRING" guardType uTF8_STRING $ guardSize 8 $ do s <- gets value modify (\r -> r {value = []}) append . show . decode . map fromIntegral $ s return True -- dump an enumerated value using a translation table dumpEnum' :: [String] -> Atom -> Decoder Bool dumpEnum' ss fmt = guardType fmt $ getInt 32 $ \r -> case () of () | r < 0 -> "undefined value " ++ show r | r >= genericLength ss -> "undefined value " ++ show r | otherwise -> genericIndex ss r -- we do not, unlike @xev@, try to ascii-art pixmaps. dumpPixmap :: Decoder Bool dumpPixmap = guardType pIXMAP $ do p' <- getInt' 32 case p' of Nothing -> return False Just p -> do append $ "pixmap " ++ showHex p "" g' <- inX $ withDisplay $ \d -> io $ Just `fmap` getGeometry d (fromIntegral p) `E.catch` \e -> case fromException e of Just x -> throw e `const` (x `asTypeOf` ExitSuccess) _ -> return Nothing case g' of Nothing -> append " (deleted)" Just (_,x,y,wid,ht,bw,dp) -> append $ concat [" (" ,show wid ,'x':show ht ,'x':show dp ,')':if bw == 0 then "" else '+':show bw ,"@(" ,show x ,',':show y ,")" ] dumpOLAttrs :: Decoder Bool dumpOLAttrs = do pt <- inX $ getAtom "_OL_WIN_ATTR" guardType pt $ do msk <- getInt' 32 case msk of Nothing -> propShortErr Just msk' -> dumpListByMask (fromIntegral msk') [("window type" ,dumpAtom ) ,("menu" ,dump32 ) -- @@@ unk ,("pushpin" ,dumpEnum bool) ,("limited menu",dump32 ) -- @@@ unk ] dumpMwmHints :: Decoder Bool dumpMwmHints = do ta <- asks property guardType ta $ do msk <- getInt' 32 case msk of Nothing -> propShortErr Just msk' -> dumpListByMask (fromIntegral msk') [("functions" ,dumpBits mwmFuncs ) ,("decorations",dumpBits mwmDecos ) ,("input mode" ,dumpEnum mwmInputMode) ,("status" ,dumpBits mwmState ) ] dumpMwmInfo :: Decoder Bool dumpMwmInfo = do ta <- asks property guardType ta $ dumpList' [("flags" ,dumpBits mwmHints,cARDINAL) ,("window",dumpWindow ,wINDOW ) ] -- the most common case dumpEnum :: [String] -> Decoder Bool dumpEnum ss = dumpEnum' ss cARDINAL -- implement exceptional cases atop a normal dumper -- @@@ there's gotta be a better way dumpExcept :: [(Integer,String)] -> Decoder Bool -> Decoder Bool dumpExcept xs item = do -- this horror brought to you by reparsing to get the right value for our use sp <- get rc <- item if not rc then return False else do that <- get -- if none match then we just restore the value parse vs <- gets value let w = (length (value sp) - length vs) * 8 -- now we get to reparse again so we get our copy of it put sp Just v <- getInt' w -- and after all that, we can process the exception list dumpExcept' xs that v dumpExcept' :: [(Integer,String)] -> DecodeState -> Integer -> Decoder Bool dumpExcept' [] that _ = put that >> return True dumpExcept' ((exc,str):xs) that val | exc == val = append str | otherwise = dumpExcept' xs that val -- use @ps@ to get process information. -- @@@@ assumes a POSIX @ps@, not a BSDish one. dumpPid :: Decoder Bool dumpPid = guardType cARDINAL $ do n <- getInt' 32 case n of Nothing -> return False Just pid' -> do let pid = show pid' ps = (proc "/bin/ps" ["-fp" ++ pid]) {std_out = CreatePipe} (_,o,_,_) <- io $ createProcess ps case o of Nothing -> append $ "pid " ++ pid Just p' -> do prc <- io $ lines `fmap` hGetContents p' -- deliberately forcing it append $ if length prc < 2 then "pid " ++ pid else prc !! 1 dumpTime :: Decoder Bool dumpTime = append "server event # " >> dump32 dumpState :: Decoder Bool dumpState = do wM_STATE <- inX $ getAtom "WM_STATE" guardType wM_STATE $ dumpList' [("state" ,dumpEnum wmState,cARDINAL) ,("icon window",dumpWindow ,wINDOW ) ] dumpMotifDragReceiver :: Decoder Bool dumpMotifDragReceiver = do ta <- inX $ getAtom "_MOTIF_DRAG_RECEIVER_INFO" guardType ta $ dumpList' [("endian" ,dumpMotifEndian,cARDINAL) ,("version" ,dump8 ,cARDINAL) ,("style" ,dumpMDropStyle ,cARDINAL) -- @@@ dummy ] dumpMDropStyle :: Decoder Bool dumpMDropStyle = do d <- getInt' 8 pad 1 $ case d of Nothing -> propShortErr Just ps | ps == 0 -> pad 12 $ append "none" | ps == 1 -> pad 12 $ append "drop only" | ps == 2 -> append "prefer preregister " >> dumpMDPrereg | ps == 3 -> append "preregister " >> dumpMDPrereg | ps == 4 -> pad 12 $ append "prefer dynamic" | ps == 5 -> pad 12 $ append "dynamic" | ps == 6 -> pad 12 $ append "prefer receiver" | otherwise -> failure $ "unknown drop style " ++ show ps dumpMDPrereg :: Decoder Bool dumpMDPrereg = do -- this is a bit ugly; we pretend to be extending the above dumpList' append "," append "proxy window = " withIndent 15 dumpWindow append "," append "drop sites = " dsc' <- getInt' 16 case dsc' of Nothing -> propShortErr Just dsc -> do withIndent 13 $ append (show dsc) pad 2 $ do append "," append "total size = " withIndent 13 dump32 dumpMDBlocks $ fromIntegral dsc dumpMDBlocks :: Int -> Decoder Bool dumpMDBlocks _ = propSimple "(drop site info)" -- @@@ maybe later if needed dumpMotifEndian :: Decoder Bool dumpMotifEndian = guardType cARDINAL $ guardSize 8 $ do c <- map twiddle `fmap` eat 1 case c of ['l'] -> append "little" ['B'] -> append "big" _ -> failure "bad endian flag" pad :: Int -> Decoder Bool -> Decoder Bool pad n p = do vs <- gets value if length vs < n then propShortErr else modify (\r -> r {value = drop n vs}) >> p dumpPercent :: Decoder Bool dumpPercent = guardType cARDINAL $ do n <- getInt' 32 case n of Nothing -> return False Just n' -> let pct = 100 * fromIntegral n' / fromIntegral (maxBound :: Word32) pct :: Double in append $ show (round pct :: Integer) ++ "%" dumpWmHints :: Decoder Bool dumpWmHints = guardType wM_HINTS $ do msk <- getInt' 32 case msk of Nothing -> return False Just msk' -> dumpListByMask' (fromIntegral msk') [("input" ,dumpEnum bool ,cARDINAL) ,("initial_state",dumpEnum wmState,cARDINAL) ,("icon_pixmap" ,dumpPixmap ,pIXMAP ) ,("icon_window" ,dumpWindow ,wINDOW ) ,("icon_x" ,dump32 ,cARDINAL) ,("icon_y" ,dump32 ,cARDINAL) ,("icon_mask" ,dumpPixmap ,pIXMAP ) ,("window_group" ,dumpWindow ,wINDOW ) ] dumpBits :: [String] -> Decoder Bool dumpBits bs = guardType cARDINAL $ do n <- getInt' 32 case n of Nothing -> return False Just n' -> dumpBits' bs 1 (fromIntegral n') "" dumpBits' :: [String] -> Int -> Int -> String -> Decoder Bool dumpBits' [] _ n p = if n == 0 then return True else append (p ++ show n) dumpBits' (s:ss) b n p = do p' <- if n .&. b /= 0 then append (p ++ s) >> return "|" else return p dumpBits' ss (b `shiftL` 1) (n .&. complement b) p' -- enum definitions -- mwmFuncs :: [String] mwmFuncs = ["all except" ,"resize" ,"move" ,"minimize" ,"maximize" ,"close" ] mwmDecos :: [String] mwmDecos = ["all except" ,"border" ,"resize handle" ,"title" ,"menu button" ,"maximize button" ,"minimize button" ] mwmInputMode :: [String] mwmInputMode = ["modeless" ,"application modal" ,"system model" ,"full application modal" ] mwmState :: [String] mwmState = ["tearoff window" ] mwmHints :: [String] mwmHints = ["standard startup" ,"custom startup" ] awSource :: [String] awSource = ["unspecified" ,"application" ,"pager/task list" ] {- eventually... wmHintsFlags :: [String] wmHintsFlags = ["Input" ,"State" ,"IconPixmap" ,"IconWindow" ,"IconX" ,"IconY" ,"IconMask" ,"WindowGroup" ] wmCRMask :: [String] wmCRMask = ["X" ,"Y" ,"Width" ,"Height" ,"BorderWidth" ,"Sibling" ,"StackMode" ] -} wmPlacement :: [String] wmPlacement = ["Above" ,"Below" ,"TopIf" ,"BottomIf" ,"Opposite" ] bool :: [String] bool = ["False","True"] nwmOrientation :: [String] nwmOrientation = nwmEnum (Just "ORIENTATION") ["HORZ","VERT"] nwmOrigin :: [String] nwmOrigin = nwmEnum Nothing ["TOPLEFT","TOPRIGHT","BOTTOMRIGHT","BOTTOMLEFT"] wmState :: [String] wmState = ["Withdrawn","Normal","Zoomed (obsolete)","Iconified","Inactive"] nwmEnum :: Maybe String -> [String] -> [String] nwmEnum Nothing vs = map ( "_NET_WM_" ++) vs nwmEnum (Just prefix) vs = map (("_NET_WM_" ++ prefix ++ "_") ++) vs -- and the lowest level coercions -- -- parse and return an integral value getInt' :: Int -> Decoder (Maybe Integer) -- see XSync documentation for this insanity getInt' 64 = guardR width 32 (\a e -> propSizeErr a e >> return Nothing) $ guardSize' 8 (propShortErr >> return Nothing) $ do lo <- inhale 32 hi <- inhale 32 return $ Just $ lo + hi * (fromIntegral (maxBound :: Word32) + 1) getInt' w = guardR width w (\a e -> propSizeErr a e >> return Nothing) $ guardSize' (bytes w) (propShortErr >> return Nothing) $ Just `fmap` inhale w -- parse an integral value and feed it to a show-er of some kind getInt :: Int -> (Integer -> String) -> Decoder Bool getInt w f = getInt' w >>= maybe (return False) (append . f) -- bottommost level: parse an integral value out of the stream. -- Not much in the way of error checking; it is assumed you used -- the appropriate guards. -- @@@@@@@@@ evil beyond evil. there *has* to be a better way inhale :: Int -> Decoder Integer inhale 8 = do [b] <- eat 1 return $ fromIntegral b inhale 16 = do [b0,b1] <- eat 2 io $ allocaArray 2 $ \p -> do pokeArray p [b0,b1] [v] <- peekArray 1 (castPtr p :: Ptr Word16) return $ fromIntegral v inhale 32 = do [b0,b1,b2,b3] <- eat 4 io $ allocaArray 4 $ \p -> do pokeArray p [b0,b1,b2,b3] [v] <- peekArray 1 (castPtr p :: Ptr Word32) return $ fromIntegral v inhale b = error $ "inhale " ++ show b eat :: Int -> Decoder Raw eat n = do (bs,rest) <- splitAt n `fmap` gets value modify (\r -> r {value = rest}) return bs -- actually do formatting type stuffs -- sorta stubbed for the moment -- eventually we should do indentation foo here append :: String -> Decoder Bool append = append' True -- and the same but for errors failure :: String -> Decoder Bool failure = append' False -- common appender append' :: Bool -> String -> Decoder Bool append' b s = do j <- gets joint modify (\r -> r {accum = accum r ++ j ++ s}) return b -- consume all and output a constant string propSimple :: String -> Decoder Bool propSimple s = modify (\r -> r {value = []}) >> append s -- report various errors propShortErr :: Decoder Bool propShortErr = failure "(property ended prematurely)" propSizeErr :: Int -> Int -> Decoder Bool propSizeErr e a = failure $ "(bad bit width " ++ show a ++ "; expected " ++ show e ++ ")" propTypeErr :: Atom -> Atom -> Decoder Bool propTypeErr a e = do e' <- inX $ atomName e a' <- inX $ atomName a failure $ "(bad type " ++ a' ++"; expected " ++ e' ++ ")" -- for stubs (...) :: Decoder Bool (...) = do fmt <- asks pType >>= inX . atomName propSimple $ "(unimplemented type " ++ fmt ++ ")" -- you like fi, I like this twiddle :: (Enum a, Enum b) => a -> b twiddle = toEnum . fromEnum xmonad-contrib-0.12/XMonad/Hooks/ScreenCorners.hs0000644000000000000000000001443412636047674020153 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ScreenCorners -- Copyright : (c) 2009 Nils Schweinsberg, 2015 Evgeny Kurnevsky -- License : BSD3-style (see LICENSE) -- -- Maintainer : Nils Schweinsberg -- Stability : unstable -- Portability : unportable -- -- Run @X ()@ actions by touching the edge of your screen with your mouse. -- ----------------------------------------------------------------------------- module XMonad.Hooks.ScreenCorners ( -- * Usage -- $usage -- * Adding screen corners ScreenCorner (..) , addScreenCorner , addScreenCorners -- * Event hook , screenCornerEventHook -- * Layout hook , screenCornerLayoutHook ) where import Data.Monoid import Data.List (find) import XMonad import XMonad.Util.XUtils (fi) import XMonad.Layout.LayoutModifier import qualified Data.Map as M import qualified XMonad.Util.ExtensibleState as XS data ScreenCorner = SCUpperLeft | SCUpperRight | SCLowerLeft | SCLowerRight deriving (Eq, Ord, Show) -------------------------------------------------------------------------------- -- ExtensibleState modifications -------------------------------------------------------------------------------- newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ())) deriving Typeable instance ExtensionClass ScreenCornerState where initialValue = ScreenCornerState M.empty -- | Add one single @X ()@ action to a screen corner addScreenCorner :: ScreenCorner -> X () -> X () addScreenCorner corner xF = do ScreenCornerState m <- XS.get (win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions Nothing -> flip (,) xF `fmap` createWindowAt corner XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m' -- | Add a list of @(ScreenCorner, X ())@ tuples addScreenCorners :: [ (ScreenCorner, X ()) ] -> X () addScreenCorners = mapM_ (\(corner, xF) -> addScreenCorner corner xF) -------------------------------------------------------------------------------- -- Xlib functions -------------------------------------------------------------------------------- -- "Translate" a ScreenCorner to real (x,y) Positions createWindowAt :: ScreenCorner -> X Window createWindowAt SCUpperLeft = createWindowAt' 0 0 createWindowAt SCUpperRight = withDisplay $ \dpy -> let w = displayWidth dpy (defaultScreen dpy) - 1 in createWindowAt' (fi w) 0 createWindowAt SCLowerLeft = withDisplay $ \dpy -> let h = displayHeight dpy (defaultScreen dpy) - 1 in createWindowAt' 0 (fi h) createWindowAt SCLowerRight = withDisplay $ \dpy -> let w = displayWidth dpy (defaultScreen dpy) - 1 h = displayHeight dpy (defaultScreen dpy) - 1 in createWindowAt' (fi w) (fi h) -- Create a new X window at a (x,y) Position createWindowAt' :: Position -> Position -> X Window createWindowAt' x y = withDisplay $ \dpy -> io $ do rootw <- rootWindow dpy (defaultScreen dpy) let visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy attrmask = cWOverrideRedirect w <- allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes True createWindow dpy -- display rootw -- parent window x -- x y -- y 1 -- width 1 -- height 0 -- border width 0 -- depth inputOnly -- class visual -- visual attrmask -- valuemask attributes -- attributes -- we only need mouse entry events selectInput dpy w enterWindowMask mapWindow dpy w sync dpy False return w -------------------------------------------------------------------------------- -- Event hook -------------------------------------------------------------------------------- -- | Handle screen corner events screenCornerEventHook :: Event -> X All screenCornerEventHook CrossingEvent { ev_window = win } = do ScreenCornerState m <- XS.get case M.lookup win m of Just (_, xF) -> xF Nothing -> return () return (All True) screenCornerEventHook _ = return (All True) -------------------------------------------------------------------------------- -- Layout hook -------------------------------------------------------------------------------- data ScreenCornerLayout a = ScreenCornerLayout deriving ( Read, Show ) instance LayoutModifier ScreenCornerLayout a where hook ScreenCornerLayout = withDisplay $ \dpy -> do ScreenCornerState m <- XS.get io $ mapM_ (raiseWindow dpy) $ M.keys m unhook = hook screenCornerLayoutHook :: l a -> ModifiedLayout ScreenCornerLayout l a screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout -------------------------------------------------------------------------------- -- $usage -- -- This extension adds KDE-like screen corners to XMonad. By moving your cursor -- into one of your screen corners you can trigger an @X ()@ action, for -- example @"XMonad.Actions.GridSelect".goToSelected@ or -- @"XMonad.Actions.CycleWS".nextWS@ etc. -- -- To use it, import it on top of your @xmonad.hs@: -- -- > import XMonad.Hooks.ScreenCorners -- -- Then add your screen corners in our startup hook: -- -- > myStartupHook = do -- > ... -- > addScreenCorner SCUpperRight (goToSelected defaultGSConfig { gs_cellwidth = 200}) -- > addScreenCorners [ (SCLowerRight, nextWS) -- > , (SCLowerLeft, prevWS) -- > ] -- -- Then add layout hook: -- > myLayout = screenCornerLayoutHook $ tiled ||| Mirror tiled ||| Full where -- > tiled = Tall nmaster delta ratio -- > nmaster = 1 -- > ratio = 1 / 2 -- > delta = 3 / 100 -- -- And finally wait for screen corner events in your event hook: -- -- > myEventHook e = do -- > ... -- > screenCornerEventHook e xmonad-contrib-0.12/XMonad/Hooks/DynamicProperty.hs0000644000000000000000000000604012636047674020523 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.DynamicProperty -- Copyright : (c) Brandon S Allbery, 2015 -- License : BSD3-style (see LICENSE) -- -- Maintainer : allbery.b@gmail.com -- Stability : unstable -- Portability : not portable -- -- Module to apply a ManageHook to an already-mapped window when a property -- changes. This would commonly be used to match browser windows by title, -- since the final title will only be set after (a) the window is mapped, -- (b) its document has been loaded, (c) all load-time scripts have run. -- (Don't blame browsers for this; it's inherent in HTML and the DOM. And -- changing title dynamically is explicitly permitted by ICCCM and EWMH; -- you don't really want to have your editor window umapped/remapped to -- show the current document and modified state in the titlebar, do you?) -- -- This is a handleEventHook that triggers on a PropertyChange event. It -- currently ignores properties being removed, in part because you can't -- do anything useful in a ManageHook involving nonexistence of a property. -- ----------------------------------------------------------------------------- module XMonad.Hooks.DynamicProperty where import XMonad import Data.Monoid import Control.Applicative import Control.Monad (when) -- | -- Run a 'ManageHook' when a specific property is changed on a window. Note -- that this will run on any window which changes the property, so you should -- be very specific in your 'MansgeHook' matching (lots of windows change -- their titles on the fly!): -- -- dynamicPropertyChange "WM_NAME" (className =? "Iceweasel" <&&> title =? "whatever" --> doShift "2") -- -- Note that the fixity of (-->) won't allow it to be mixed with ($), so you -- can't use the obvious $ shorthand. -- -- > dynamicPropertyChange "WM_NAME" $ title =? "Foo" --> doFloat -- won't work! -- -- Consider instead phrasing it like any -- other 'ManageHook': -- -- > , handleEventHook = dynamicPropertyChange "WM_NAME" myDynHook <+> handleEventHook baseConfig -- > -- > {- ... -} -- > -- > myDynHook = composeAll [...] -- dynamicPropertyChange :: String -> ManageHook -> Event -> X All dynamicPropertyChange prop hook PropertyEvent { ev_window = w, ev_atom = a, ev_propstate = ps } = do pa <- getAtom prop when (ps == propertyNewValue && a == pa) $ do g <- appEndo <$> userCodeDef (Endo id) (runQuery hook w) windows g return (All False) -- so anything else also processes it dynamicPropertyChange _ _ _ = return (All False) -- | A shorthand for the most common case, dynamic titles dynamicTitle :: ManageHook -> Event -> X All -- strictly, this should also check _NET_WM_NAME. practically, both will -- change and each gets its own PropertyEvent, so we'd need to record that -- we saw the event for that window and ignore the second one. Instead, just -- trust that nobody sets only _NET_WM_NAME. (I'm sure this will prove false, -- since there's always someone who can't bother being compliant.) dynamicTitle = dynamicPropertyChange "WM_NAME" xmonad-contrib-0.12/XMonad/Util/0000755000000000000000000000000012636047674014670 5ustar0000000000000000xmonad-contrib-0.12/XMonad/Util/Themes.hs0000644000000000000000000003441212636047674016455 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Themes -- Copyright : (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A (hopefully) growing collection of themes for decorated layouts. -- ----------------------------------------------------------------------------- module XMonad.Util.Themes ( -- * Usage -- $usage listOfThemes , ppThemeInfo , xmonadTheme , smallClean , robertTheme , deiflTheme , oxymor00nTheme , donaldTheme , wfarrTheme , kavonForestTheme , kavonLakeTheme , kavonPeacockTheme , kavonVioGreenTheme , kavonBluesTheme , kavonAutumnTheme , kavonFireTheme , kavonChristmasTheme , ThemeInfo (..) ) where import XMonad.Layout.Decoration -- $usage -- This module stores some user contributed themes which can be used -- with decorated layouts (such as Tabbed). (Note that these themes -- only apply to decorated layouts, such as those found in -- "XMonad.Layout.Tabbed" and "XMonad.Layout.DecorationMadness"; they -- do not apply to xmonad as a whole.) -- -- If you want to use one of them with one of your decorated layouts, -- you need to substitute def with, for instance, (theme smallClean). -- -- Here is an example: -- -- > import XMonad -- > import XMonad.Util.Themes -- > import XMonad.Layout.Tabbed -- > -- > myLayout = tabbed shrinkText (theme smallClean) -- > -- > main = xmonad def {layoutHook = myLayout} -- -- If you have a theme you would like to share, adding it to this -- module is very easy. -- -- You can use 'xmonadTheme' or 'smallClean' as a template. -- -- At the present time only the 'themeName' field is used. But please -- provide all the other information, which will be used at a later -- time. -- -- Please, remember to add your theme to the list of exported -- functions, and to the 'listOfThemes'. -- -- Thanks for your contribution! data ThemeInfo = TI { themeName :: String , themeAuthor :: String , themeDescription :: String , theme :: Theme } newTheme :: ThemeInfo newTheme = TI "" "" "" def ppThemeInfo :: ThemeInfo -> String ppThemeInfo t = themeName t <> themeDescription t <> "by" <> themeAuthor t where "" <> x = x x <> y = x ++ " - " ++ y listOfThemes :: [ThemeInfo] listOfThemes = [ xmonadTheme , smallClean , deiflTheme , oxymor00nTheme , robertTheme , donaldTheme , wfarrTheme , kavonForestTheme , kavonLakeTheme , kavonPeacockTheme , kavonVioGreenTheme , kavonBluesTheme , kavonAutumnTheme , kavonFireTheme , kavonChristmasTheme ] -- | The default xmonad theme, by David Roundy. xmonadTheme :: ThemeInfo xmonadTheme = newTheme { themeName = "xmonadTheme" , themeAuthor = "David Roundy" , themeDescription = "The default xmonad theme" , theme = def } -- | Small decorations with a Ion3 remembrance, by Andrea Rossato. smallClean :: ThemeInfo smallClean = newTheme { themeName = "smallClean" , themeAuthor = "Andrea Rossato" , themeDescription = "Small decorations with a Ion3 remembrance" , theme = def { activeColor = "#8a999e" , inactiveColor = "#545d75" , activeBorderColor = "white" , inactiveBorderColor = "grey" , activeTextColor = "white" , inactiveTextColor = "grey" , decoHeight = 14 } } -- | Don's preferred colors - from DynamicLog...;) donaldTheme :: ThemeInfo donaldTheme = newTheme { themeName = "donaldTheme" , themeAuthor = "Andrea Rossato" , themeDescription = "Don's preferred colors - from DynamicLog...;)" , theme = def { activeColor = "#2b4f98" , inactiveColor = "#cccccc" , activeBorderColor = "#2b4f98" , inactiveBorderColor = "#cccccc" , activeTextColor = "white" , inactiveTextColor = "black" , decoHeight = 16 } } -- | Ffrom Robert Manea's prompt theme. robertTheme :: ThemeInfo robertTheme = newTheme { themeName = "robertTheme" , themeAuthor = "Andrea Rossato" , themeDescription = "From Robert Manea's prompt theme" , theme = def { activeColor = "#aecf96" , inactiveColor = "#111111" , activeBorderColor = "#aecf96" , inactiveBorderColor = "#111111" , activeTextColor = "black" , inactiveTextColor = "#d5d3a7" , fontName = "-*-profont-*-*-*-*-11-*-*-*-*-*-iso8859" , decoHeight = 16 } } -- | deifl\'s Theme, by deifl. deiflTheme :: ThemeInfo deiflTheme = newTheme { themeName = "deiflTheme" , themeAuthor = "deifl" , themeDescription = "deifl's Theme" , theme = def { inactiveBorderColor = "#708090" , activeBorderColor = "#5f9ea0" , activeColor = "#000000" , inactiveColor = "#333333" , inactiveTextColor = "#888888" , activeTextColor = "#87cefa" , fontName = "-xos4-terminus-*-*-*-*-12-*-*-*-*-*-*-*" , decoHeight = 15 } } -- | oxymor00n\'s theme, by Tom Rauchenwald. oxymor00nTheme :: ThemeInfo oxymor00nTheme = newTheme { themeName = "oxymor00nTheme" , themeAuthor = "Tom Rauchenwald" , themeDescription = "oxymor00n's theme" , theme = def { inactiveBorderColor = "#000" , activeBorderColor = "aquamarine3" , activeColor = "aquamarine3" , inactiveColor = "DarkSlateGray4" , inactiveTextColor = "#222" , activeTextColor = "#222" -- This font can be found in the package ttf-alee -- on debian-systems , fontName = "-*-Bandal-*-*-*-*-12-*-*-*-*-*-*-*" , decoHeight = 15 , urgentColor = "#000" , urgentTextColor = "#63b8ff" } } wfarrTheme :: ThemeInfo wfarrTheme = newTheme { themeName = "wfarrTheme" , themeAuthor = "Will Farrington" , themeDescription = "A nice blue/black theme." , theme = def { activeColor = "#4c7899" , inactiveColor = "#333333" , activeBorderColor = "#285577" , inactiveBorderColor = "#222222" , activeTextColor = "#ffffff" , inactiveTextColor = "#888888" , fontName = "-*-fixed-medium-r-*--10-*-*-*-*-*-iso8859-1" , decoHeight = 12 } } -- | Forest colours, by Kathryn Andersen kavonForestTheme :: ThemeInfo kavonForestTheme = newTheme { themeName = "kavonForestTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Forest colours" , theme = def { activeColor = "#115422" , activeBorderColor = "#1a8033" , activeTextColor = "white" , inactiveColor = "#543211" , inactiveBorderColor = "#804c19" , inactiveTextColor = "#ffcc33" } } -- | Lake (blue/green) colours, by Kathryn Andersen kavonLakeTheme :: ThemeInfo kavonLakeTheme = newTheme { themeName = "kavonLakeTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Lake (blue/green) colours" , theme = def { activeColor = "#001166" , activeBorderColor = "#1f3999" , activeTextColor = "white" , inactiveColor = "#09592a" , inactiveBorderColor = "#198044" , inactiveTextColor = "#73e6a3" } } -- | Peacock colours, by Kathryn Andersen kavonPeacockTheme :: ThemeInfo kavonPeacockTheme = newTheme { themeName = "kavonPeacockTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Peacock colours" , theme = def { activeColor = "#190f4c" , activeBorderColor = "#2b1980" , activeTextColor = "white" , inactiveColor = "#225173" , inactiveBorderColor = "#2a638c" , inactiveTextColor = "#8fb2cc" } } -- | Violet-Green colours, by Kathryn Andersen kavonVioGreenTheme :: ThemeInfo kavonVioGreenTheme = newTheme { themeName = "kavonVioGreenTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Violet-Green colours" , theme = def { activeColor = "#37174c" , activeBorderColor = "#333399" , activeTextColor = "white" , inactiveColor = "#174c17" , inactiveBorderColor = "#336633" , inactiveTextColor = "#aaccaa" } } -- | Blue colours, by Kathryn Andersen kavonBluesTheme :: ThemeInfo kavonBluesTheme = newTheme { themeName = "kavonBluesTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Blue colours" , theme = def { activeColor = "#000066" , activeBorderColor = "#111199" , activeTextColor = "white" , inactiveColor = "#9999ee" , inactiveBorderColor = "#6666cc" , inactiveTextColor = "black" } } -- | Christmas colours, by Kathryn Andersen kavonChristmasTheme :: ThemeInfo kavonChristmasTheme = newTheme { themeName = "kavonChristmasTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Christmas (green + red) colours" , theme = def { activeColor = "#660000" , activeBorderColor = "#990000" , activeTextColor = "white" , inactiveColor = "#006600" , inactiveBorderColor = "#003300" , inactiveTextColor = "#99bb99" } } -- | Autumn colours, by Kathryn Andersen kavonAutumnTheme :: ThemeInfo kavonAutumnTheme = newTheme { themeName = "kavonAutumnTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Autumn (brown + red) colours" , theme = def { activeColor = "#660000" , activeBorderColor = "#990000" , activeTextColor = "white" , inactiveColor = "#542d11" , inactiveBorderColor = "#804d1A" , inactiveTextColor = "#ffcc33" } } -- | Fire colours, by Kathryn Andersen kavonFireTheme :: ThemeInfo kavonFireTheme = newTheme { themeName = "kavonFireTheme" , themeAuthor = "Kathryn Andersen" , themeDescription = "Fire (orange + red) colours" , theme = def { activeColor = "#660000" , activeBorderColor = "#990000" , activeTextColor = "white" , inactiveColor = "#ff8000" , inactiveBorderColor = "#d9b162" , inactiveTextColor = "black" } } xmonad-contrib-0.12/XMonad/Util/StringProp.hs0000644000000000000000000000412112636047674017331 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.StringProp -- Copyright : (c) Nicolas Pouillard 2009 -- License : BSD-style (see LICENSE) -- -- Maintainer : Nicolas Pouillard -- Stability : unstable -- Portability : unportable -- -- Internal utility functions for storing Strings with the root window. -- -- Used for global state like IORefs with string keys, but more latency, -- persistent between xmonad restarts. module XMonad.Util.StringProp ( StringProp, getStringProp, setStringProp, getStringListProp, setStringListProp, ) where import XMonad import Control.Monad(liftM) import Control.Applicative((<$>)) import Foreign.C.String (castCCharToChar,castCharToCChar) type StringProp = String withStringProp :: (MonadIO m) => StringProp -> Display -> (Window -> Atom -> m b) -> m b withStringProp prop dpy f = do rootw <- io $ rootWindow dpy $ defaultScreen dpy a <- io $ internAtom dpy prop False f rootw a -- | Set the value of a string property. setStringProp :: (MonadIO m) => Display -> StringProp -> [Char] -> m () setStringProp dpy prop string = withStringProp prop dpy $ \rootw a -> io $ changeProperty8 dpy rootw a a propModeReplace $ map castCharToCChar string -- | Get the name of a string property and returns it as a 'Maybe'. getStringProp :: (MonadIO m) => Display -> StringProp -> m (Maybe [Char]) getStringProp dpy prop = withStringProp prop dpy $ \rootw a -> do p <- io $ getWindowProperty8 dpy a rootw return $ map castCCharToChar <$> p -- | Given a property name, returns its contents as a list. It uses the empty -- list as default value. getStringListProp :: (MonadIO m) => Display -> StringProp -> m [String] getStringListProp dpy prop = maybe [] words `liftM` getStringProp dpy prop -- | Given a property name and a list, sets the value of this property with -- the list given as argument. setStringListProp :: (MonadIO m) => Display -> StringProp -> [String] -> m () setStringListProp dpy prop str = setStringProp dpy prop (unwords str) xmonad-contrib-0.12/XMonad/Util/XSelection.hs0000644000000000000000000001134212636047674017302 0ustar0000000000000000{-# LANGUAGE CPP #-} {- | Module : XMonad.Util.XSelection Copyright : (C) 2007 Andrea Rossato, Matthew Sackman License : BSD3 Maintainer : Gwern Branwen Stability : unstable Portability : unportable A module for accessing and manipulating X Window's mouse selection (the buffer used in copy and pasting). 'getSelection' is an adaptation of Hxsel.hs and Hxput.hs from the XMonad-utils, available: > $ darcs get -} module XMonad.Util.XSelection ( -- * Usage -- $usage getSelection, promptSelection, safePromptSelection, transformPromptSelection, transformSafePromptSelection) where import Control.Exception.Extensible as E (catch,SomeException(..)) import Control.Monad (liftM, join) import Data.Maybe (fromMaybe) import XMonad import XMonad.Util.Run (safeSpawn, unsafeSpawn) import Codec.Binary.UTF8.String (decode) {- $usage Add @import XMonad.Util.XSelection@ to the top of Config.hs Then make use of getSelection or promptSelection as needed; if one wanted to run Firefox with the selection as an argument (perhaps the selection string is an URL you just highlighted), then one could add to the xmonad.hs a line like thus: > , ((modm .|. shiftMask, xK_b), promptSelection "firefox") Future improvements for XSelection: * More elaborate functionality: Emacs' registers are nice; if you don't know what they are, see -} -- | Returns a String corresponding to the current mouse selection in X; -- if there is none, an empty string is returned. -- -- WARNING: this function is fundamentally implemented incorrectly and may, among other possible failure modes, -- deadlock or crash. For details, see . -- (These errors are generally very rare in practice, but still exist.) getSelection :: MonadIO m => m String getSelection = io $ do dpy <- openDisplay "" let dflt = defaultScreen dpy rootw <- rootWindow dpy dflt win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0 p <- internAtom dpy "PRIMARY" True ty <- E.catch (E.catch (internAtom dpy "UTF8_STRING" False) (\(E.SomeException _) -> internAtom dpy "COMPOUND_TEXT" False)) (\(E.SomeException _) -> internAtom dpy "sTring" False) clp <- internAtom dpy "BLITZ_SEL_STRING" False xConvertSelection dpy p ty clp win currentTime allocaXEvent $ \e -> do nextEvent dpy e ev <- getEvent e result <- if ev_event_type ev == selectionNotify then do res <- getWindowProperty8 dpy clp win return $ decode . map fromIntegral . fromMaybe [] $ res else destroyWindow dpy win >> return "" closeDisplay dpy return result {- | A wrapper around 'getSelection'. Makes it convenient to run a program with the current selection as an argument. This is convenient for handling URLs, in particular. For example, in your Config.hs you could bind a key to @promptSelection \"firefox\"@; this would allow you to highlight a URL string and then immediately open it up in Firefox. 'promptSelection' passes strings through the system shell, \/bin\/sh; if you do not wish your selected text to be interpreted or mangled by the shell, use 'safePromptSelection'. safePromptSelection will bypass the shell using 'safeSpawn' from "XMonad.Util.Run"; see its documentation for more details on the advantages and disadvantages of using safeSpawn. -} promptSelection, safePromptSelection, unsafePromptSelection :: String -> X () promptSelection = unsafePromptSelection safePromptSelection app = join $ io $ liftM (safeSpawn app . return) getSelection unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection {- | A wrapper around 'promptSelection' and its safe variant. They take two parameters, the first is a function that transforms strings, and the second is the application to run. The transformer essentially transforms the selection in X. One example is to wrap code, such as a command line action copied out of the browser to be run as @"sudo" ++ cmd@ or @"su - -c \""++ cmd ++"\""@. -} transformPromptSelection, transformSafePromptSelection :: (String -> String) -> String -> X () transformPromptSelection f app = join $ io $ liftM (safeSpawn app . return) (fmap f getSelection) transformSafePromptSelection f app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) (fmap f getSelection) xmonad-contrib-0.12/XMonad/Util/Timer.hs0000644000000000000000000000346712636047674016316 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Timer -- Copyright : (c) Andrea Rossato and David Roundy 2007 -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A module for setting up timers ----------------------------------------------------------------------------- module XMonad.Util.Timer ( -- * Usage -- $usage startTimer , handleTimer , TimerId ) where import XMonad import Control.Applicative import Control.Concurrent import Data.Unique -- $usage -- This module can be used to setup a timer to handle deferred events. -- See 'XMonad.Layout.ShowWName' for an usage example. type TimerId = Int -- | Start a timer, which will send a ClientMessageEvent after some -- time (in seconds). startTimer :: Rational -> X TimerId startTimer s = io $ do u <- hashUnique <$> newUnique xfork $ do d <- openDisplay "" rw <- rootWindow d $ defaultScreen d threadDelay (fromEnum $ s * 1000000) a <- internAtom d "XMONAD_TIMER" False allocaXEvent $ \e -> do setEventType e clientMessage setClientMessageEvent e rw a 32 (fromIntegral u) currentTime sendEvent d rw False structureNotifyMask e sync d False return u -- | Given a 'TimerId' and an 'Event', run an action when the 'Event' -- has been sent by the timer specified by the 'TimerId' handleTimer :: TimerId -> Event -> X (Maybe a) -> X (Maybe a) handleTimer ti (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) action = do d <- asks display a <- io $ internAtom d "XMONAD_TIMER" False if mt == a && dt /= [] && fromIntegral (head dt) == ti then action else return Nothing handleTimer _ _ _ = return Nothing xmonad-contrib-0.12/XMonad/Util/XUtils.hs0000644000000000000000000001740512636047674016463 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.XUtils -- Copyright : (c) 2007 Andrea Rossato -- 2010 Alejandro Serrano -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A module for painting on the screen -- ----------------------------------------------------------------------------- module XMonad.Util.XUtils ( -- * Usage: -- $usage averagePixels , createNewWindow , showWindow , showWindows , hideWindow , hideWindows , deleteWindow , deleteWindows , paintWindow , paintAndWrite , paintTextAndIcons , stringToPixel , fi ) where import Data.Maybe import XMonad import XMonad.Util.Font import XMonad.Util.Image import Control.Monad -- $usage -- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" or -- "XMonad.Layout.Decoration" for usage examples -- | Compute the weighted average the colors of two given Pixel values. averagePixels :: Pixel -> Pixel -> Double -> X Pixel averagePixels p1 p2 f = do d <- asks display let cm = defaultColormap d (defaultScreen d) [Color _ r1 g1 b1 _,Color _ r2 g2 b2 _] <- io $ queryColors d cm [Color p1 0 0 0 0,Color p2 0 0 0 0] let mn x1 x2 = round (fromIntegral x1 * f + fromIntegral x2 * (1-f)) Color p _ _ _ _ <- io $ allocColor d cm (Color 0 (mn r1 r2) (mn g1 g2) (mn b1 b2) 0) return p -- | Create a simple window given a rectangle. If Nothing is given -- only the exposureMask will be set, otherwise the Just value. -- Use 'showWindow' to map and hideWindow to unmap. createNewWindow :: Rectangle -> Maybe EventMask -> String -> Bool -> X Window createNewWindow (Rectangle x y w h) m col o = do d <- asks display rw <- asks theRoot c <- stringToPixel d col win <- io $ mkWindow d (defaultScreenOfDisplay d) rw x y w h c o case m of Just em -> io $ selectInput d win em Nothing -> io $ selectInput d win exposureMask -- @@@ ugly hack to prevent compositing whenX (return $ isJust m) $ flip catchX (return ()) $ do wINDOW_TYPE <- getAtom "_NET_WM_WINDOW_TYPE" dESKTOP <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP" io $ changeProperty32 d win wINDOW_TYPE aTOM propModeReplace [fi dESKTOP] return win -- | Map a window showWindow :: Window -> X () showWindow w = do d <- asks display io $ mapWindow d w -- | the list version showWindows :: [Window] -> X () showWindows = mapM_ showWindow -- | unmap a window hideWindow :: Window -> X () hideWindow w = do d <- asks display io $ unmapWindow d w -- | the list version hideWindows :: [Window] -> X () hideWindows = mapM_ hideWindow -- | destroy a window deleteWindow :: Window -> X () deleteWindow w = do d <- asks display io $ destroyWindow d w -- | the list version deleteWindows :: [Window] -> X () deleteWindows = mapM_ deleteWindow -- | Fill a window with a rectangle and a border paintWindow :: Window -- ^ The window where to draw -> Dimension -- ^ Window width -> Dimension -- ^ Window height -> Dimension -- ^ Border width -> String -- ^ Window background color -> String -- ^ Border color -> X () paintWindow w wh ht bw c bc = paintWindow' w (Rectangle 0 0 wh ht) bw c bc Nothing Nothing -- | Fill a window with a rectangle and a border, and write -- | a number of strings to given positions paintAndWrite :: Window -- ^ The window where to draw -> XMonadFont -- ^ XMonad Font for drawing -> Dimension -- ^ Window width -> Dimension -- ^ Window height -> Dimension -- ^ Border width -> String -- ^ Window background color -> String -- ^ Border color -> String -- ^ String color -> String -- ^ String background color -> [Align] -- ^ String 'Align'ments -> [String] -- ^ Strings to be printed -> X () paintAndWrite w fs wh ht bw bc borc ffc fbc als strs = do d <- asks display strPositions <- forM (zip als strs) $ \(al, str) -> stringPosition d fs (Rectangle 0 0 wh ht) al str let ms = Just (fs,ffc,fbc, zip strs strPositions) paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms Nothing -- | Fill a window with a rectangle and a border, and write -- | a number of strings and a number of icons to given positions paintTextAndIcons :: Window -- ^ The window where to draw -> XMonadFont -- ^ XMonad Font for drawing -> Dimension -- ^ Window width -> Dimension -- ^ Window height -> Dimension -- ^ Border width -> String -- ^ Window background color -> String -- ^ Border color -> String -- ^ String color -> String -- ^ String background color -> [Align] -- ^ String 'Align'ments -> [String] -- ^ Strings to be printed -> [Placement] -- ^ Icon 'Placements' -> [[[Bool]]] -- ^ Icons to be printed -> X () paintTextAndIcons w fs wh ht bw bc borc ffc fbc als strs i_als icons = do d <- asks display strPositions <- forM (zip als strs) $ \(al, str) -> stringPosition d fs (Rectangle 0 0 wh ht) al str let iconPositions = map ( \(al, icon) -> iconPosition (Rectangle 0 0 wh ht) al icon ) (zip i_als icons) ms = Just (fs,ffc,fbc, zip strs strPositions) is = Just (ffc, fbc, zip iconPositions icons) paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms is -- This stuff is not exported -- | Paints a titlebar with some strings and icons -- drawn inside it. -- Not exported. paintWindow' :: Window -> Rectangle -> Dimension -> String -> String -> Maybe (XMonadFont,String,String,[(String, (Position, Position))]) -> Maybe (String, String, [((Position, Position), [[Bool]])]) -> X () paintWindow' win (Rectangle _ _ wh ht) bw color b_color strStuff iconStuff = do d <- asks display p <- io $ createPixmap d win wh ht (defaultDepthOfScreen $ defaultScreenOfDisplay d) gc <- io $ createGC d p -- draw io $ setGraphicsExposures d gc False [color',b_color'] <- mapM (stringToPixel d) [color,b_color] -- we start with the border io $ setForeground d gc b_color' io $ fillRectangle d p gc 0 0 wh ht -- and now again io $ setForeground d gc color' io $ fillRectangle d p gc (fi bw) (fi bw) (wh - (bw * 2)) (ht - (bw * 2)) -- paint strings when (isJust strStuff) $ do let (xmf,fc,bc,strAndPos) = fromJust strStuff forM_ strAndPos $ \(s, (x, y)) -> printStringXMF d p xmf gc fc bc x y s -- paint icons when (isJust iconStuff) $ do let (fc, bc, iconAndPos) = fromJust iconStuff forM_ iconAndPos $ \((x, y), icon) -> drawIcon d p gc fc bc x y icon -- copy the pixmap over the window io $ copyArea d p win gc 0 0 wh ht 0 0 -- free the pixmap and GC io $ freePixmap d p io $ freeGC d gc -- | Creates a window with the possibility of setting some attributes. -- Not exported. mkWindow :: Display -> Screen -> Window -> Position -> Position -> Dimension -> Dimension -> Pixel -> Bool -> IO Window mkWindow d s rw x y w h p o = do let visual = defaultVisualOfScreen s attrmask = cWOverrideRedirect .|. cWBackPixel .|. cWBorderPixel allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes o set_border_pixel attributes p set_background_pixel attributes p createWindow d rw x y w h 0 (defaultDepthOfScreen s) inputOutput visual attrmask attributes xmonad-contrib-0.12/XMonad/Util/Invisible.hs0000644000000000000000000000300212636047674017143 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Invisible -- Copyright : (c) 2007 Andrea Rossato, David Roundy -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A data type to store the layout state -- ----------------------------------------------------------------------------- module XMonad.Util.Invisible ( -- * Usage: -- $usage Invisible (..) , whenIJust , fromIMaybe ) where import Control.Applicative -- $usage -- A wrapper data type to store layout state that shouldn't be persisted across -- restarts. A common wrapped type to use is @Maybe a@. -- Invisible derives trivial definitions for Read and Show, so the wrapped data -- type need not do so. newtype Invisible m a = I (m a) deriving (Monad, Applicative, Functor) instance (Functor m, Monad m) => Read (Invisible m a) where readsPrec _ s = [(fail "Read Invisible", s)] instance Monad m => Show (Invisible m a) where show _ = "" whenIJust :: (Monad m) => Invisible Maybe a -> (a -> m ()) -> m () whenIJust (I (Just x)) f = f x whenIJust (I Nothing) _ = return () fromIMaybe :: a -> Invisible Maybe a -> a fromIMaybe _ (I (Just x)) = x fromIMaybe a (I Nothing) = a xmonad-contrib-0.12/XMonad/Util/ExtensibleState.hs0000644000000000000000000001126212636047674020331 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.ExtensibleState -- Copyright : (c) Daniel Schoepe 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : daniel.schoepe@gmail.com -- Stability : unstable -- Portability : not portable -- -- Module for storing custom mutable state in xmonad. -- ----------------------------------------------------------------------------- module XMonad.Util.ExtensibleState ( -- * Usage -- $usage put , modify , remove , get , gets ) where import Data.Typeable (typeOf,cast) import qualified Data.Map as M import XMonad.Core import qualified Control.Monad.State as State import Data.Maybe (fromMaybe) -- --------------------------------------------------------------------- -- $usage -- -- To utilize this feature in a contrib module, create a data type -- and make it an instance of ExtensionClass. You can then use -- the functions from this module for storing and retrieving your data: -- -- > {-# LANGUAGE DeriveDataTypeable #-} -- > import qualified XMonad.Util.ExtensibleState as XS -- > -- > data ListStorage = ListStorage [Integer] deriving Typeable -- > instance ExtensionClass ListStorage where -- > initialValue = ListStorage [] -- > -- > .. XS.put (ListStorage [23,42]) -- -- To retrieve the stored value call: -- -- > .. XS.get -- -- If the type can't be inferred from the usage of the retrieved data, you -- have to add an explicit type signature: -- -- > .. XS.get :: X ListStorage -- -- To make your data persistent between restarts, the data type needs to be -- an instance of Read and Show and the instance declaration has to be changed: -- -- > data ListStorage = ListStorage [Integer] deriving (Typeable,Read,Show) -- > -- > instance ExtensionClass ListStorage where -- > initialValue = ListStorage [] -- > extensionType = PersistentExtension -- -- One should take care that the string representation of the chosen type -- is unique among the stored values, otherwise it will be overwritten. -- Normally these string representations contain fully qualified module names -- when automatically deriving Typeable, so -- name collisions should not be a problem in most cases. -- A module should not try to store common datatypes(e.g. a list of Integers) -- without a custom data type as a wrapper to avoid collisions with other modules -- trying to store the same data type without a wrapper. -- -- | Modify the map of state extensions by applying the given function. modifyStateExts :: (M.Map String (Either String StateExtension) -> M.Map String (Either String StateExtension)) -> X () modifyStateExts f = State.modify $ \st -> st { extensibleState = f (extensibleState st) } -- | Apply a function to a stored value of the matching type or the initial value if there -- is none. modify :: ExtensionClass a => (a -> a) -> X () modify f = put . f =<< get -- | Add a value to the extensible state field. A previously stored value with the same -- type will be overwritten. (More precisely: A value whose string representation of its type -- is equal to the new one's) put :: ExtensionClass a => a -> X () put v = modifyStateExts . M.insert (show . typeOf $ v) . Right . extensionType $ v -- | Try to retrieve a value of the requested type, return an initial value if there is no such value. get :: ExtensionClass a => X a get = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables where toValue val = maybe initialValue id $ cast val getState' :: ExtensionClass a => a -> X a getState' k = do v <- State.gets $ M.lookup (show . typeOf $ k) . extensibleState case v of Just (Right (StateExtension val)) -> return $ toValue val Just (Right (PersistentExtension val)) -> return $ toValue val Just (Left str) | PersistentExtension x <- extensionType k -> do let val = fromMaybe initialValue $ cast =<< safeRead str `asTypeOf` Just x put (val `asTypeOf` k) return val _ -> return $ initialValue safeRead str = case reads str of [(x,"")] -> Just x _ -> Nothing gets :: ExtensionClass a => (a -> b) -> X b gets = flip fmap get -- | Remove the value from the extensible state field that has the same type as the supplied argument remove :: ExtensionClass a => a -> X () remove wit = modifyStateExts $ M.delete (show . typeOf $ wit) xmonad-contrib-0.12/XMonad/Util/SpawnNamedPipe.hs0000644000000000000000000000470212636047674020102 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.SpawnNamedPipe -- Copyright : (c) Christian Wills 2014 -- License : BSD3-style (see LICENSE) -- -- Maintainer : cwills.dev@gmail.com -- Stability : unstable -- Portability : not portable -- -- A module for spawning a pipe whose "Handle" lives in the Xmonad state. -- ----------------------------------------------------------------------------- module XMonad.Util.SpawnNamedPipe ( -- * Usage -- $usage spawnNamedPipe , getNamedPipe ) where import XMonad import XMonad.Util.Run import System.IO import qualified XMonad.Util.ExtensibleState as XS import Control.Monad import qualified Data.Map as Map -- $usage -- This module makes it possible to spawn a pipe to Dzen2 in the startupHook -- and write to it from inside the logHook without the need for global -- variables. -- -- > import XMonad.Util.SpawnNamedPipe -- > import Data.Maybe -- > -- > -- StartupHook -- > startupHook' = spawnNamedPipe "dzen2" "dzenPipe" -- > -- > -- LogHook -- > logHook' = do -- > mh <- getNamedPipeHandle "dzenPipe" -- > dynamicLogWithPP $ defaultPP { -- > ppOutput = maybe (\s -> return ()) (hPutStrLn) mh} -- > -- > -- Main -- > main = xmonad $ defaultConfig { -- > startupHook = startupHook' -- > , logHook = logHook'} -- data NamedPipes = NamedPipes { pipeMap :: Map.Map String Handle } deriving (Show, Typeable) instance ExtensionClass NamedPipes where initialValue = NamedPipes Map.empty -- | When 'spawnNamedPipe' is executed with a command "String" and a name -- "String" respectively. The command string is spawned with 'spawnPipe' (as -- long as the name chosen hasn't been used already) and the "Handle" returned -- is saved in Xmonad's state associated with the name "String". spawnNamedPipe :: String -> String -> X () spawnNamedPipe cmd name = do b <- XS.gets (Map.member name . pipeMap) unless b $ do h <- spawnPipe cmd XS.modify (NamedPipes . Map.insert name h . pipeMap) -- | Attempts to retrieve a "Handle" to a pipe previously stored in Xmonad's -- state associated with the given string via a call to 'spawnNamedPipe'. If the -- given string doesn't exist in the map stored in Xmonad's state Nothing is -- returned. getNamedPipe :: String -> X (Maybe Handle) getNamedPipe name = XS.gets (Map.lookup name . pipeMap) xmonad-contrib-0.12/XMonad/Util/Stack.hs0000644000000000000000000003006612636047674016276 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Stack -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Utility functions for manipulating @Maybe Stack@s. -- ----------------------------------------------------------------------------- module XMonad.Util.Stack ( -- * Usage -- | This is a developer-oriented module, intended to be used -- for writing new extentions. Zipper , emptyZ , singletonZ -- * Conversions , fromIndex , toIndex , fromTags , toTags -- * 'Zipper' manipulation functions -- ** Insertion, movement , insertUpZ , insertDownZ , swapUpZ , swapDownZ , swapMasterZ -- ** Focus movement , focusUpZ , focusDownZ , focusMasterZ -- ** Extraction , getFocusZ , getIZ -- ** Sorting , sortZ , sortByZ -- ** Maps , mapZ , mapZ_ , mapZM , mapZM_ , onFocusedZ , onFocusedZM , onIndexZ , onIndexZM -- ** Filters , filterZ , filterZ_ , deleteFocusedZ , deleteIndexZ -- ** Folds , foldrZ , foldlZ , foldrZ_ , foldlZ_ , elemZ -- * Other utility functions , getI , tagBy , fromE , mapE , mapE_ , mapEM , mapEM_ ) where import qualified XMonad.StackSet as W import Control.Monad (liftM) import Data.List (sortBy) type Zipper a = Maybe (W.Stack a) emptyZ :: Zipper a emptyZ = Nothing singletonZ :: a -> Zipper a singletonZ a = Just $ W.Stack a [] [] -- * Conversions -- | Create a stack from a list, and the 0-based index of the focused element. -- If the index is out of bounds, focus will go to the first element. fromIndex :: [a] -> Int -> Zipper a fromIndex as i = fromTags $ zipWith ($) (replicate i Left ++ [Right] ++ repeat Left) as -- | Turn a stack into a list and the index of its focused element. toIndex :: Zipper a -> ([a], Maybe Int) toIndex Nothing = ([], Nothing) toIndex (Just s) = (W.integrate s, Just $ length $ W.up s) -- | Create a stack from a list of 'Either'-tagged values. Focus will go to -- the first 'Right' value, or if there is none, to the first 'Left' one. fromTags :: [Either a a] -> Zipper a fromTags = finalize . foldr step ([], Nothing, []) where step (Right a) (u, Just f, d) = ([], Just a, u++f:d) step (Right a) (u, Nothing, d) = (u, Just a, d) step (Left a) (u, Just f, d) = (a:u, Just f, d) step (Left a) (u, Nothing, d) = (u, Nothing, a:d) finalize (u, Just f, d) = Just $ W.Stack f (reverse u) d finalize (u, Nothing, a:d) = Just $ W.Stack a (reverse u) d finalize (_, Nothing, []) = Nothing -- | Turn a stack into an 'Either'-tagged list. The focused element -- will be tagged with 'Right', the others with 'Left'. toTags :: Zipper a -> [Either a a] toTags Nothing = [] toTags (Just s) = map Left (reverse . W.up $ s) ++ [Right . W.focus $ s] ++ map Left (W.down s) -- * Zipper functions -- ** Insertion, movement -- | Insert an element before the focused one, and focus it insertUpZ :: a -> Zipper a -> Zipper a insertUpZ a Nothing = W.differentiate [a] insertUpZ a (Just s) = Just s { W.focus = a , W.down = W.focus s : W.down s } -- | Insert an element after the focused one, and focus it insertDownZ :: a -> Zipper a -> Zipper a insertDownZ a Nothing = W.differentiate [a] insertDownZ a (Just s) = Just s { W.focus = a, W.up = W.focus s : W.up s } -- | Swap the focused element with the previous one swapUpZ :: Zipper a -> Zipper a swapUpZ Nothing = Nothing swapUpZ (Just s) | u:up <- W.up s = Just s { W.up = up, W.down = u:W.down s} swapUpZ (Just s) = Just s { W.up = reverse (W.down s), W.down = [] } -- | Swap the focused element with the next one swapDownZ :: Zipper a -> Zipper a swapDownZ Nothing = Nothing swapDownZ (Just s) | d:down <- W.down s = Just s { W.down = down, W.up = d:W.up s } swapDownZ (Just s) = Just s { W.up = [], W.down = reverse (W.up s) } -- | Swap the focused element with the first one swapMasterZ :: Zipper a -> Zipper a swapMasterZ Nothing = Nothing swapMasterZ (Just (W.Stack f up down)) = Just $ W.Stack f [] (reverse up ++ down) -- ** Focus movement -- | Move the focus to the previous element focusUpZ :: Zipper a -> Zipper a focusUpZ Nothing = Nothing focusUpZ (Just s) | u:up <- W.up s = Just $ W.Stack u up (W.focus s:W.down s) focusUpZ (Just s) | null $ W.down s = Just s focusUpZ (Just (W.Stack f _ down)) = Just $ W.Stack (last down) (reverse (init down) ++ [f]) [] -- | Move the focus to the next element focusDownZ :: Zipper a -> Zipper a focusDownZ Nothing = Nothing focusDownZ (Just s) | d:down <- W.down s = Just $ W.Stack d (W.focus s:W.up s) down focusDownZ (Just s) | null $ W.up s = Just s focusDownZ (Just (W.Stack f up _)) = Just $ W.Stack (last up) [] (reverse (init up) ++ [f]) -- | Move the focus to the first element focusMasterZ :: Zipper a -> Zipper a focusMasterZ Nothing = Nothing focusMasterZ (Just (W.Stack f up down)) | not $ null up = Just $ W.Stack (last up) [] (reverse (init up) ++ [f] ++ down) focusMasterZ (Just s) = Just s -- ** Extraction -- | Get the focused element getFocusZ :: Zipper a -> Maybe a getFocusZ = fmap W.focus -- | Get the element at a given index getIZ :: Int -> Zipper a -> Maybe a getIZ i = getI i . W.integrate' -- ** Sorting -- | Sort a stack of elements supporting 'Ord' sortZ :: Ord a => Zipper a -> Zipper a sortZ = sortByZ compare -- | Sort a stack with an arbitrary sorting function sortByZ :: (a -> a -> Ordering) -> Zipper a -> Zipper a sortByZ f = fromTags . sortBy (adapt f) . toTags where adapt g e1 e2 = g (fromE e1) (fromE e2) -- ** Maps -- | Map a function over a stack. The boolean argument indcates whether -- the current element is the focused one mapZ :: (Bool -> a -> b) -> Zipper a -> Zipper b mapZ f as = fromTags . map (mapE f) . toTags $ as -- | 'mapZ' without the 'Bool' argument mapZ_ :: (a -> b) -> Zipper a -> Zipper b mapZ_ = mapZ . const -- | Monadic version of 'mapZ' mapZM :: Monad m => (Bool -> a -> m b) -> Zipper a -> m (Zipper b) mapZM f as = fromTags `liftM` (mapM (mapEM f) . toTags) as -- | Monadic version of 'mapZ_' mapZM_ :: Monad m => (a -> m b) -> Zipper a -> m (Zipper b) mapZM_ = mapZM . const -- | Apply a function to the focused element onFocusedZ :: (a -> a) -> Zipper a -> Zipper a onFocusedZ f = mapZ $ \b a -> if b then f a else a -- | Monadic version of 'onFocusedZ' onFocusedZM :: Monad m => (a -> m a) -> Zipper a -> m (Zipper a) onFocusedZM f = mapZM $ \b a -> if b then f a else return a -- | Apply a function to the element at the given index onIndexZ :: Int -> (a -> a) -> Zipper a -> Zipper a onIndexZ i _ as | i < 0 = as onIndexZ i f as = case splitAt i $ toTags as of (before, []) -> fromTags before (before, a:after) -> fromTags $ before ++ mapE (const f) a : after -- | Monadic version of 'onIndexZ' onIndexZM :: Monad m => Int -> (a -> m a) -> Zipper a -> m (Zipper a) onIndexZM i f as = case splitAt i $ toTags as of (before, []) -> return $ fromTags before (before, a:after) -> do a' <- mapEM (const f) a return $ fromTags $ before ++ a' : after -- ** Filters -- | Fiter a stack according to a predicate. The refocusing behavior -- mimics XMonad's usual one. The boolean argument indicates whether the current -- element is the focused one. filterZ :: (Bool -> a -> Bool) -> Zipper a -> Zipper a filterZ _ Nothing = Nothing filterZ p (Just s) = case ( p True (W.focus s) , filter (p False) (W.up s) , filter (p False) (W.down s) ) of (True, up', down') -> Just s { W.up = up', W.down = down' } (False, [], []) -> Nothing (False, f:up', []) -> Just s { W.focus = f, W.up = up', W.down = [] } (False, up', f:down') -> Just s { W.focus = f , W.up = up' , W.down = down' } -- | 'filterZ' without the 'Bool' argument filterZ_ :: (a -> Bool) -> Zipper a -> Zipper a filterZ_ = filterZ . const -- | Delete the focused element deleteFocusedZ :: Zipper a -> Zipper a deleteFocusedZ = filterZ (\b _ -> not b) -- | Delete the ith element deleteIndexZ :: Int -> Zipper a -> Zipper a deleteIndexZ i z = let numbered = (fromTags . zipWith number [0..] . toTags) z number j ea = mapE (\_ a -> (j,a)) ea in mapZ_ snd $ filterZ_ ((/=i) . fst) numbered -- ** Folds -- | Analogous to 'foldr'. The 'Bool' argument to the step functions indicates -- whether the current element is the focused one foldrZ :: (Bool -> a -> b -> b) -> b -> Zipper a -> b foldrZ _ b Nothing = b foldrZ f b (Just s) = let b1 = foldr (f False) b (W.down s) b2 = f True (W.focus s) b1 b3 = foldl (flip $ f False) b2 (W.up s) in b3 -- | Analogous to 'foldl'. The 'Bool' argument to the step functions indicates -- whether the current element is the focused one foldlZ :: (Bool -> b -> a -> b) -> b -> Zipper a -> b foldlZ _ b Nothing = b foldlZ f b (Just s) = let b1 = foldr (flip $ f False) b (W.up s) b2 = f True b1 (W.focus s) b3 = foldl (f False) b2 (W.down s) in b3 -- | 'foldrZ' without the 'Bool' argument. foldrZ_ :: (a -> b -> b) -> b -> Zipper a -> b foldrZ_ = foldrZ . const -- | 'foldlZ' without the 'Bool' argument. foldlZ_ :: (b -> a -> b) -> b -> Zipper a -> b foldlZ_ = foldlZ . const -- | Find whether an element is present in a stack. elemZ :: Eq a => a -> Zipper a -> Bool elemZ a as = foldlZ_ step False as where step True _ = True step False a' = a' == a -- * Other utility functions -- | Safe version of '!!' getI :: Int -> [a] -> Maybe a getI _ [] = Nothing getI 0 (a:_) = Just a getI i (_:as) = getI (i-1) as -- | Map a function across both 'Left's and 'Right's. -- The 'Bool' argument is 'True' in a 'Right', 'False' -- in a 'Left'. mapE :: (Bool -> a -> b) -> Either a a -> Either b b mapE f (Left a) = Left $ f False a mapE f (Right a) = Right $ f True a mapE_ :: (a -> b) -> Either a a -> Either b b mapE_ = mapE . const -- | Monadic version of 'mapE' mapEM :: Monad m => (Bool -> a -> m b) -> Either a a -> m (Either b b) mapEM f (Left a) = Left `liftM` f False a mapEM f (Right a) = Right `liftM` f True a mapEM_ :: Monad m => (a -> m b) -> Either a a -> m (Either b b) mapEM_ = mapEM . const -- | Get the @a@ from an @Either a a@ fromE :: Either a a -> a fromE (Right a) = a fromE (Left a) = a -- | Tag the element with 'Right' if the property is true, 'Left' otherwise tagBy :: (a -> Bool) -> a -> Either a a tagBy p a = if p a then Right a else Left a xmonad-contrib-0.12/XMonad/Util/WindowProperties.hs0000644000000000000000000000622312636047674020553 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.WindowProperties -- Copyright : (c) Roman Cheplyaka -- License : BSD-style (see LICENSE) -- -- Maintainer : Roman Cheplyaka -- Stability : unstable -- Portability : unportable -- -- EDSL for specifying window properties; various utilities related to window -- properties. -- ----------------------------------------------------------------------------- module XMonad.Util.WindowProperties ( -- * EDSL for window properties -- $edsl Property(..), hasProperty, focusedHasProperty, allWithProperty, propertyToQuery, -- * Helper functions -- $helpers getProp32, getProp32s) where import XMonad import qualified XMonad.StackSet as W import Foreign.C.Types (CLong) import Control.Monad -- $edsl -- Allows to specify window properties, such as title, classname or -- resource, and to check them. -- -- In contrast to ManageHook properties, these are instances of Show and Read, -- so they can be used in layout definitions etc. For example usage see "XMonad.Layout.IM" -- | Most of the property constructors are quite self-explaining. data Property = Title String | ClassName String | Resource String | Role String -- ^ WM_WINDOW_ROLE property | Machine String -- ^ WM_CLIENT_MACHINE property | And Property Property | Or Property Property | Not Property | Const Bool deriving (Read, Show) infixr 9 `And` infixr 8 `Or` -- | Does given window have this property? hasProperty :: Property -> Window -> X Bool hasProperty p w = runQuery (propertyToQuery p) w -- | Does the focused window have this property? focusedHasProperty :: Property -> X Bool focusedHasProperty p = do ws <- gets windowset let ms = W.stack $ W.workspace $ W.current ws case ms of Just s -> hasProperty p $ W.focus s Nothing -> return False -- | Find all existing windows with specified property allWithProperty :: Property -> X [Window] allWithProperty prop = withDisplay $ \dpy -> do rootw <- asks theRoot (_,_,wins) <- io $ queryTree dpy rootw hasProperty prop `filterM` wins -- | Convert property to 'Query' 'Bool' (see "XMonad.ManageHook") propertyToQuery :: Property -> Query Bool propertyToQuery (Title s) = title =? s propertyToQuery (Resource s) = resource =? s propertyToQuery (ClassName s) = className =? s propertyToQuery (Role s) = stringProperty "WM_WINDOW_ROLE" =? s propertyToQuery (Machine s) = stringProperty "WM_CLIENT_MACHINE" =? s propertyToQuery (And p1 p2) = propertyToQuery p1 <&&> propertyToQuery p2 propertyToQuery (Or p1 p2) = propertyToQuery p1 <||> propertyToQuery p2 propertyToQuery (Not p) = not `fmap` propertyToQuery p propertyToQuery (Const b) = return b -- $helpers -- | Get a window property from atom getProp32 :: Atom -> Window -> X (Maybe [CLong]) getProp32 a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w -- | Get a window property from string getProp32s :: String -> Window -> X (Maybe [CLong]) getProp32s str w = do { a <- getAtom str; getProp32 a w } xmonad-contrib-0.12/XMonad/Util/NamedActions.hs0000644000000000000000000003064312636047674017577 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE ExistentialQuantification, FlexibleContexts, FlexibleInstances, StandaloneDeriving #-} -------------------------------------------------------------------- -- | -- Module : XMonad.Util.NamedActions -- Copyright : 2009 Adam Vogt -- License : BSD3-style (see LICENSE) -- -- Maintainer : Adam Vogt -- Stability : unstable -- Portability : unportable -- -- A wrapper for keybinding configuration that can list the available -- keybindings. -- -- Note that xmonad>=0.11 has by default a list of the default keybindings -- bound to @M-S-/@ or @M-?@. -------------------------------------------------------------------- module XMonad.Util.NamedActions ( -- * Usage: -- $usage sendMessage', spawn', submapName, addDescrKeys, addDescrKeys', xMessage, showKmSimple, showKm, noName, oneName, addName, separator, subtitle, (^++^), NamedAction(..), HasName, defaultKeysDescr ) where import XMonad.Actions.Submap(submap) import XMonad import System.Posix.Process(executeFile) import Control.Arrow(Arrow((&&&), second, (***))) import Data.Bits(Bits((.&.), complement)) import Data.List (groupBy) import System.Exit(ExitCode(ExitSuccess), exitWith) import Control.Applicative ((<*>)) import qualified Data.Map as M import qualified XMonad.StackSet as W -- $usage -- Here is an example config that demonstrates the usage of 'sendMessage'', -- 'mkNamedKeymap', 'addDescrKeys', and '^++^' -- -- > import XMonad -- > import XMonad.Util.NamedActions -- > import XMonad.Util.EZConfig -- > -- > main = xmonad $ addDescrKeys ((mod4Mask, xK_F1), xMessage) myKeys -- > def { modMask = mod4Mask } -- > -- > myKeys c = (subtitle "Custom Keys":) $ mkNamedKeymap c $ -- > [("M-x a", addName "useless message" $ spawn "xmessage foo"), -- > ("M-c", sendMessage' Expand)] -- > ^++^ -- > [("", spawn "mpc toggle" :: X ()), -- > ("", spawn "mpc next")] -- -- Using '^++^', you can combine bindings whose actions are @X ()@ -- as well as actions that have descriptions. However you cannot mix the two in -- a single list, unless each is prefixed with 'addName' or 'noName'. -- -- If you don't like EZConfig, you can still use '^++^' with the basic XMonad -- keybinding configuration too. -- -- Also note the unfortunate necessity of a type annotation, since 'spawn' is -- too general. -- TODO: squeeze titles that have no entries (consider titles containing \n) -- -- Output to Multiple columns -- -- Devin Mullin's suggestions: -- -- Reduce redundancy wrt mkNamedSubmaps, mkSubmaps and mkNamedKeymap to have a -- HasName context (and leave mkKeymap as a specific case of it?) -- Currently kept separate to aid error messages, common lines factored out -- -- Suggestions for UI: -- -- - An IO () -> IO () that wraps the main xmonad action and wrests control -- from it if the user asks for --keys. -- -- Just a separate binary: keep this as the only way to show keys for simplicity -- -- - An X () that toggles a cute little overlay like the ? window for gmail -- and reader. -- -- Add dzen binding deriving instance Show XMonad.Resize deriving instance Show XMonad.IncMasterN -- | 'sendMessage' but add a description that is @show message@. Note that not -- all messages have show instances. sendMessage' :: (Message a, Show a) => a -> NamedAction sendMessage' x = NamedAction $ (XMonad.sendMessage x,show x) -- | 'spawn' but the description is the string passed spawn' :: String -> NamedAction spawn' x = addName x $ spawn x class HasName a where showName :: a -> [String] showName = const [""] getAction :: a -> X () instance HasName (X ()) where getAction = id instance HasName (IO ()) where getAction = io instance HasName [Char] where getAction _ = return () showName = (:[]) instance HasName (X (),String) where showName = (:[]) . snd getAction = fst instance HasName (X (),[String]) where showName = snd getAction = fst -- show only the outermost description instance HasName (NamedAction,String) where showName = (:[]) . snd getAction = getAction . fst instance HasName NamedAction where showName (NamedAction x) = showName x getAction (NamedAction x) = getAction x -- | An existential wrapper so that different types can be combined in lists, -- and maps data NamedAction = forall a. HasName a => NamedAction a -- | 'submap', but propagate the descriptions of the actions. Does this belong -- in "XMonad.Actions.Submap"? submapName :: (HasName a) => [((KeyMask, KeySym), a)] -> NamedAction submapName = NamedAction . (submap . M.map getAction . M.fromList &&& showKm) . map (second NamedAction) -- | Combine keymap lists with actions that may or may not have names (^++^) :: (HasName b, HasName b1) => [(d, b)] -> [(d, b1)] -> [(d, NamedAction)] a ^++^ b = map (second NamedAction) a ++ map (second NamedAction) b -- | Or allow another lookup table? modToString :: KeyMask -> String modToString mask = concatMap (++"-") $ filter (not . null) $ map (uncurry pick) [(mod1Mask, "M1") ,(mod2Mask, "M2") ,(mod3Mask, "M3") ,(mod4Mask, "M4") ,(mod5Mask, "M5") ,(controlMask, "C") ,(shiftMask,"Shift")] where pick m str = if m .&. complement mask == 0 then str else "" keyToString :: (KeyMask, KeySym) -> [Char] keyToString = uncurry (++) . (modToString *** keysymToString) showKmSimple :: [((KeyMask, KeySym), NamedAction)] -> [[Char]] showKmSimple = concatMap (\(k,e) -> if snd k == 0 then "":showName e else map ((keyToString k ++) . smartSpace) $ showName e) smartSpace :: String -> String smartSpace [] = [] smartSpace xs = ' ':xs _test :: String _test = unlines $ showKm $ defaultKeysDescr XMonad.def { XMonad.layoutHook = XMonad.Layout $ XMonad.layoutHook XMonad.def } showKm :: [((KeyMask, KeySym), NamedAction)] -> [String] showKm keybindings = padding $ do (k,e) <- keybindings if snd k == 0 then map ((,) "") $ showName e else map ((,) (keyToString k) . smartSpace) $ showName e where padding = let pad n (k,e) = if null k then "\n>> "++e else take n (k++repeat ' ') ++ e expand xs n = map (pad n) xs getMax = map (maximum . map (length . fst)) in concat . (zipWith expand <*> getMax) . groupBy (const $ not . null . fst) -- | An action to send to 'addDescrKeys' for showing the keybindings. See also 'showKm' and 'showKmSimple' xMessage :: [((KeyMask, KeySym), NamedAction)] -> NamedAction xMessage x = addName "Show Keybindings" $ io $ do xfork $ executeFile "xmessage" True ["-default", "okay", unlines $ showKm x] Nothing return () -- | Merge the supplied keys with 'defaultKeysDescr', also adding a keybinding -- to run an action for showing the keybindings. addDescrKeys :: (HasName b1, HasName b) => ((KeyMask, KeySym),[((KeyMask, KeySym), NamedAction)] -> b) -> (XConfig Layout -> [((KeyMask, KeySym), b1)]) -> XConfig l -> XConfig l addDescrKeys k ks = addDescrKeys' k (\l -> defaultKeysDescr l ^++^ ks l) -- | Without merging with 'defaultKeysDescr' addDescrKeys' :: (HasName b) => ((KeyMask, KeySym),[((KeyMask, KeySym), NamedAction)] -> b) -> (XConfig Layout -> [((KeyMask, KeySym), NamedAction)]) -> XConfig l -> XConfig l addDescrKeys' (k,f) ks conf = let shk l = f $ [(k,f $ ks l)] ^++^ ks l keylist l = M.map getAction $ M.fromList $ ks l ^++^ [(k, shk l)] in conf { keys = keylist } -- | A version of the default keys from the default configuration, but with -- 'NamedAction' instead of @X ()@ defaultKeysDescr :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)] defaultKeysDescr conf@(XConfig {XMonad.modMask = modm}) = [ subtitle "launching and killing programs" , ((modm .|. shiftMask, xK_Return), addName "Launch Terminal" $ spawn $ XMonad.terminal conf) -- %! Launch terminal , ((modm, xK_p ), addName "Launch dmenu" $ spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu , ((modm .|. shiftMask, xK_p ), addName "Launch gmrun" $ spawn "gmrun") -- %! Launch gmrun , ((modm .|. shiftMask, xK_c ), addName "Close the focused window" kill) -- %! Close the focused window , subtitle "changing layouts" , ((modm, xK_space ), sendMessage' NextLayout) -- %! Rotate through the available layout algorithms , ((modm .|. shiftMask, xK_space ), addName "Reset the layout" $ setLayout $ XMonad.layoutHook conf) -- %! Reset the layouts on the current workspace to default , separator , ((modm, xK_n ), addName "Refresh" refresh) -- %! Resize viewed windows to the correct size , subtitle "move focus up or down the window stack" , ((modm, xK_Tab ), addName "Focus down" $ windows W.focusDown) -- %! Move focus to the next window , ((modm .|. shiftMask, xK_Tab ), addName "Focus up" $ windows W.focusUp ) -- %! Move focus to the previous window , ((modm, xK_j ), addName "Focus down" $ windows W.focusDown) -- %! Move focus to the next window , ((modm, xK_k ), addName "Focus up" $ windows W.focusUp ) -- %! Move focus to the previous window , ((modm, xK_m ), addName "Focus the master" $ windows W.focusMaster ) -- %! Move focus to the master window , subtitle "modifying the window order" , ((modm, xK_Return), addName "Swap with the master" $ windows W.swapMaster) -- %! Swap the focused window and the master window , ((modm .|. shiftMask, xK_j ), addName "Swap down" $ windows W.swapDown ) -- %! Swap the focused window with the next window , ((modm .|. shiftMask, xK_k ), addName "Swap up" $ windows W.swapUp ) -- %! Swap the focused window with the previous window , subtitle "resizing the master/slave ratio" , ((modm, xK_h ), sendMessage' Shrink) -- %! Shrink the master area , ((modm, xK_l ), sendMessage' Expand) -- %! Expand the master area , subtitle "floating layer support" , ((modm, xK_t ), addName "Push floating to tiled" $ withFocused $ windows . W.sink) -- %! Push window back into tiling , subtitle "change the number of windows in the master area" , ((modm , xK_comma ), sendMessage' (IncMasterN 1)) -- %! Increment the number of windows in the master area , ((modm , xK_period), sendMessage' (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area , subtitle "quit, or restart" , ((modm .|. shiftMask, xK_q ), addName "Quit" $ io (exitWith ExitSuccess)) -- %! Quit xmonad , ((modm , xK_q ), addName "Restart" $ spawn "xmonad --recompile && xmonad --restart") -- %! Restart xmonad ] -- mod-[1..9] %! Switch to workspace N -- mod-shift-[1..9] %! Move client to workspace N ++ subtitle "switching workspaces": [((m .|. modm, k), addName (n ++ i) $ windows $ f i) | (f, m, n) <- [(W.greedyView, 0, "Switch to workspace "), (W.shift, shiftMask, "Move client to workspace ")] , (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]] -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3 ++ subtitle "switching screens" : [((m .|. modm, key), addName (n ++ show sc) $ screenWorkspace sc >>= flip whenJust (windows . f)) | (f, m, n) <- [(W.view, 0, "Switch to screen number "), (W.shift, shiftMask, "Move client to screen number ")] , (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]] -- | For a prettier presentation: keymask, keysym of 0 are reserved for this -- purpose: they do not happen, afaik, and keysymToString 0 would raise an -- error otherwise separator :: ((KeyMask,KeySym), NamedAction) separator = ((0,0), NamedAction (return () :: X (),[] :: [String])) subtitle :: String -> ((KeyMask, KeySym), NamedAction) subtitle x = ((0,0), NamedAction $ x ++ ":") -- | These are just the @NamedAction@ constructor but with a more specialized -- type, so that you don't have to supply any annotations, for ex coercing -- spawn to @X ()@ from the more general @MonadIO m => m ()@ noName :: X () -> NamedAction noName = NamedAction oneName :: (X (), String) -> NamedAction oneName = NamedAction addName :: String -> X () -> NamedAction addName = flip (curry NamedAction) xmonad-contrib-0.12/XMonad/Util/Image.hs0000644000000000000000000000701412636047674016250 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Image -- Copyright : (c) 2010 Alejandro Serrano -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : trupill@gmail.com -- Stability : unstable -- Portability : unportable -- -- Utilities for manipulating [[Bool]] as images -- ----------------------------------------------------------------------------- module XMonad.Util.Image ( -- * Usage: -- $usage Placement(..), iconPosition, drawIcon, ) where import XMonad import XMonad.Util.Font (stringToPixel,fi) -- | Placement of the icon in the title bar data Placement = OffsetLeft Int Int -- ^ An exact amount of pixels from the upper left corner | OffsetRight Int Int -- ^ An exact amount of pixels from the right left corner | CenterLeft Int -- ^ Centered in the y-axis, an amount of pixels from the left | CenterRight Int -- ^ Centered in the y-axis, an amount of pixels from the right deriving (Show, Read) -- $usage -- This module uses matrices of boolean values as images. When drawing them, -- a True value tells that we want the fore color, and a False value that we -- want the background color to be painted. -- In the module we suppose that those matrices are represented as [[Bool]], -- so the lengths of the inner lists must be the same. -- -- See "Xmonad.Layout.Decoration" for usage examples -- | Gets the ('width', 'height') of an image imageDims :: [[Bool]] -> (Int, Int) imageDims img = (length (head img), length img) -- | Return the 'x' and 'y' positions inside a 'Rectangle' to start drawing -- the image given its 'Placement' iconPosition :: Rectangle -> Placement -> [[Bool]] -> (Position,Position) iconPosition (Rectangle _ _ _ _) (OffsetLeft x y) _ = (fi x, fi y) iconPosition (Rectangle _ _ w _) (OffsetRight x y) icon = let (icon_w, _) = imageDims icon in (fi w - fi x - fi icon_w, fi y) iconPosition (Rectangle _ _ _ h) (CenterLeft x) icon = let (_, icon_h) = imageDims icon in (fi x, fi (h `div` 2) - fi (icon_h `div` 2)) iconPosition (Rectangle _ _ w h) (CenterRight x) icon = let (icon_w, icon_h) = imageDims icon in (fi w - fi x - fi icon_w, fi (h `div` 2) - fi (icon_h `div` 2)) -- | Converts an image represented as [[Bool]] to a series of points -- to be painted (the ones with True values) iconToPoints :: [[Bool]] -> [Point] iconToPoints icon = let labels_inside = map (zip (iterate (1+) 0)) icon filtered_inside = map (\l -> [x | (x, t) <- l, t]) labels_inside labels_outside = zip (iterate (1+) 0) filtered_inside in [Point x y | (y, l) <- labels_outside, x <- l] -- | Displaces a point ('a', 'b') along a vector ('x', 'y') movePoint :: Position -> Position -> Point -> Point movePoint x y (Point a b) = Point (a + x) (b + y) -- | Displaces a list of points along a vector 'x', 'y' movePoints :: Position -> Position -> [Point] -> [Point] movePoints x y points = map (movePoint x y) points -- | Draw an image into a X surface drawIcon :: (Functor m, MonadIO m) => Display -> Drawable -> GC -> String ->String -> Position -> Position -> [[Bool]] -> m () drawIcon dpy drw gc fc bc x y icon = do let (i_w, i_h) = imageDims icon fcolor <- stringToPixel dpy fc bcolor <- stringToPixel dpy bc io $ setForeground dpy gc bcolor io $ fillRectangle dpy drw gc x y (fi i_w) (fi i_h) io $ setForeground dpy gc fcolor io $ drawPoints dpy drw gc (movePoints x y (iconToPoints icon)) coordModeOrigin xmonad-contrib-0.12/XMonad/Util/Types.hs0000644000000000000000000000167612636047674016342 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Types -- Copyright : (c) Daniel Schoepe (2009) -- License : BSD3-style (see LICENSE) -- -- Maintainer : Daniel Schoepe -- Stability : unstable -- Portability : unportable -- -- Miscellaneous commonly used types. -- ----------------------------------------------------------------------------- module XMonad.Util.Types (Direction1D(..) ,Direction2D(..) ) where import Data.Typeable (Typeable) -- | One-dimensional directions: data Direction1D = Next | Prev deriving (Eq,Read,Show,Typeable) -- | Two-dimensional directions: data Direction2D = U -- ^ Up | D -- ^ Down | R -- ^ Right | L -- ^ Left deriving (Eq,Read,Show,Ord,Enum,Bounded,Typeable) xmonad-contrib-0.12/XMonad/Util/DebugWindow.hs0000644000000000000000000001550712636047674017452 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.DebugWindow -- Copyright : (c) Brandon S Allbery KF8NH, 2014 -- License : BSD3-style (see LICENSE) -- -- Maintainer : allbery.b@gmail.com -- Stability : unstable -- Portability : not portable -- -- Module to dump window information for diagnostic/debugging purposes. See -- "XMonad.Hooks.DebugEvents" and "XMonad.Hooks.DebugStack" for practical uses. -- ----------------------------------------------------------------------------- module XMonad.Util.DebugWindow (debugWindow) where import Prelude import XMonad import Codec.Binary.UTF8.String (decodeString) import Control.Exception.Extensible as E import Control.Monad (when) import Data.List (unfoldr ,intercalate ) import Foreign import Foreign.C.String import Numeric (showHex) import System.Exit -- | Output a window by ID in hex, decimal, its ICCCM resource name and class, -- and its title if available. Also indicate override_redirect with an -- exclamation mark, and wrap in brackets if it is unmapped or withdrawn. debugWindow :: Window -> X String debugWindow 0 = return "-no window-" debugWindow w = do let wx = pad 8 '0' $ showHex w "" w' <- withDisplay $ \d -> io (safeGetWindowAttributes d w) case w' of Nothing -> return $ "(deleted window " ++ wx ++ ")" Just (WindowAttributes x y wid ht bw m o) -> do c' <- withDisplay $ \d -> io (getWindowProperty8 d wM_CLASS w) let c = case c' of Nothing -> "" Just c'' -> intercalate "/" $ flip unfoldr (map (toEnum . fromEnum) c'') $ \s -> if null s then Nothing else let (w'',s'') = break (== '\NUL') s s' = if null s'' then s'' else tail s'' in Just (w'',s') t <- catchX' (wrap `fmap` getEWMHTitle "VISIBLE" w) $ catchX' (wrap `fmap` getEWMHTitle "" w) $ catchX' (wrap `fmap` getICCCMTitle w) $ return "" h' <- getMachine w let h = if null h' then "" else '@':h' -- if it has WM_COMMAND use it, else use the appName -- NB. modern stuff often does not set WM_COMMAND since it's only ICCCM required and not some -- horrible gnome/freedesktop session manager thing like Wayland intended. How helpful of them. p' <- withDisplay $ \d -> safeGetCommand d w let p = if null p' then "" else wrap $ intercalate " " p' nWP <- getAtom "_NET_WM_PID" pid' <- withDisplay $ \d -> io $ getWindowProperty32 d nWP w let pid = case pid' of Just [pid''] -> '(':show pid'' ++ ")" _ -> "" let cmd = p ++ pid ++ h let (lb,rb) = case () of () | m == waIsViewable -> ("","") | otherwise -> ("[","]") o' = if o then "!" else "" return $ concat [lb ,o' ,wx ,t ," " ,show wid ,'x':show ht ,if bw == 0 then "" else '+':show bw ,"@" ,show x ,',':show y ,if null c then "" else ' ':c ,if null cmd then "" else ' ':cmd ,rb ] getEWMHTitle :: String -> Window -> X String getEWMHTitle sub w = do a <- getAtom $ "_NET_WM_" ++ (if null sub then "" else '_':sub) ++ "_NAME" (Just t) <- withDisplay $ \d -> io $ getWindowProperty32 d a w return $ map (toEnum . fromEnum) t getICCCMTitle :: Window -> X String getICCCMTitle w = getDecodedStringProp w wM_NAME getDecodedStringProp :: Window -> Atom -> X String getDecodedStringProp w a = do t@(TextProperty t' _ 8 _) <- withDisplay $ \d -> io $ getTextProperty d w a [s] <- catchX' (tryUTF8 t) $ catchX' (tryCompound t) $ io ((:[]) `fmap` peekCString t') return s tryUTF8 :: TextProperty -> X [String] tryUTF8 (TextProperty s enc _ _) = do uTF8_STRING <- getAtom "UTF8_STRING" when (enc == uTF8_STRING) $ error "String is not UTF8_STRING" (map decodeString . splitNul) `fmap` io (peekCString s) tryCompound :: TextProperty -> X [String] tryCompound t@(TextProperty _ enc _ _) = do cOMPOUND_TEXT <- getAtom "COMPOUND_TEXT" when (enc == cOMPOUND_TEXT) $ error "String is not COMPOUND_TEXT" withDisplay $ \d -> io $ wcTextPropertyToTextList d t splitNul :: String -> [String] splitNul "" = [] splitNul s = let (s',ss') = break (== '\NUL') s in s' : splitNul ss' pad :: Int -> Char -> String -> String pad w c s = replicate (w - length s) c ++ s -- modified 'catchX' without the print to 'stderr' catchX' :: X a -> X a -> X a catchX' job errcase = do st <- get c <- ask (a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of Just x -> throw e `const` (x `asTypeOf` ExitSuccess) _ -> runX c st errcase put s' return a wrap :: String -> String wrap s = ' ' : '"' : wrap' s ++ "\"" where wrap' (s':ss) | s' == '"' = '\\' : s' : wrap' ss | s' == '\\' = '\\' : s' : wrap' ss | otherwise = s' : wrap' ss wrap' "" = "" -- Graphics.X11.Extras.getWindowAttributes is bugggggggy safeGetWindowAttributes :: Display -> Window -> IO (Maybe WindowAttributes) safeGetWindowAttributes d w = alloca $ \p -> do s <- xGetWindowAttributes d w p case s of 0 -> return Nothing _ -> Just `fmap` peek p -- and so is getCommand safeGetCommand :: Display -> Window -> X [String] safeGetCommand d w = do wC <- getAtom "WM_COMMAND" p <- io $ getWindowProperty8 d wC w case p of Nothing -> return [] Just cs' -> do let cs = map (toEnum . fromEnum) cs' go (a,(s,"\NUL")) = (s:a,("","")) go (a,(s,'\NUL':ss)) = go (s:a,go' ss) go r = r -- ??? go' = break (== '\NUL') in return $ reverse $ fst $ go ([],go' cs) getMachine :: Window -> X String getMachine w = catchX' (getAtom "WM_CLIENT_MACHINE" >>= getDecodedStringProp w) (return "") xmonad-contrib-0.12/XMonad/Util/PositionStore.hs0000644000000000000000000000616212636047674020052 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Util.PositionStore -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- A utility module to store information about position and size of a window. -- See "XMonad.Layout.PositionStoreFloat" for a layout that makes use of this. -- ----------------------------------------------------------------------------- module XMonad.Util.PositionStore ( getPosStore, modifyPosStore, posStoreInsert, posStoreMove, posStoreQuery, posStoreRemove, PositionStore, ) where import XMonad import qualified XMonad.Util.ExtensibleState as XS import qualified Data.Map as M -- Store window positions relative to the upper left screen edge -- and windows sizes as well as positions as fractions of the screen size. -- This way windows can be easily relocated and scaled when switching screens. data PositionStore = PS (M.Map Window PosStoreRectangle) deriving (Read,Show,Typeable) data PosStoreRectangle = PSRectangle Double Double Double Double deriving (Read,Show,Typeable) instance ExtensionClass PositionStore where initialValue = PS M.empty extensionType = PersistentExtension getPosStore :: X (PositionStore) getPosStore = XS.get modifyPosStore :: (PositionStore -> PositionStore) -> X () modifyPosStore = XS.modify posStoreInsert :: PositionStore -> Window -> Rectangle -> Rectangle -> PositionStore posStoreInsert (PS posStoreMap) w (Rectangle x y wh ht) (Rectangle srX srY srWh srHt) = let offsetX = x - srX offsetY = y - srY in PS $ M.insert w (PSRectangle (fromIntegral offsetX / fromIntegral srWh) (fromIntegral offsetY / fromIntegral srHt) (fromIntegral wh / fromIntegral srWh) (fromIntegral ht / fromIntegral srHt)) posStoreMap posStoreRemove :: PositionStore -> Window -> PositionStore posStoreRemove (PS posStoreMap) w = PS $ M.delete w posStoreMap posStoreQuery :: PositionStore -> Window -> Rectangle -> Maybe Rectangle posStoreQuery (PS posStoreMap) w (Rectangle srX srY srWh srHt) = do (PSRectangle x y wh ht) <- M.lookup w posStoreMap let realWh = fromIntegral srWh * wh realHt = fromIntegral srHt * ht realOffsetX = fromIntegral srWh * x realOffsetY = fromIntegral srHt * y return (Rectangle (srX + round realOffsetX) (srY + round realOffsetY) (round realWh) (round realHt)) posStoreMove :: PositionStore -> Window -> Position -> Position -> Rectangle -> Rectangle -> PositionStore posStoreMove posStore w x y oldSr newSr = case (posStoreQuery posStore w oldSr) of Nothing -> posStore -- not in store, can't move -> do nothing Just (Rectangle _ _ wh ht) -> posStoreInsert posStore w (Rectangle x y wh ht) newSr xmonad-contrib-0.12/XMonad/Util/Paste.hs0000644000000000000000000000625412636047674016307 0ustar0000000000000000{- | Module : XMonad.Util.Paste Copyright : (C) 2008 Jérémy Bobbio, gwern License : BSD3 Maintainer : none Stability : unstable Portability : unportable A module for sending key presses to windows. This modules provides generalized and specialized functions for this task. -} module XMonad.Util.Paste ( -- * Usage -- $usage pasteSelection, pasteString, pasteChar, sendKey, sendKeyWindow, noModMask ) where import XMonad (io, theRoot, withDisplay, X ()) import Graphics.X11 import Graphics.X11.Xlib.Extras (none, setEventType, setKeyEvent) import Control.Monad.Reader (asks) import XMonad.Operations (withFocused) import Data.Char (isUpper) import Data.Maybe (listToMaybe) import XMonad.Util.XSelection (getSelection) import XMonad.Util.EZConfig (parseKey) import Text.ParserCombinators.ReadP (readP_to_S) {- $usage Import this module into your xmonad.hs as usual: > import XMonad.Util.Paste And use the functions. They all return 'X' (), and so are appropriate for use as keybindings. Example: > , ((m, xK_d), pasteString "foo bar") ] Don't expect too much of the functions; they probably don't work on complex texts. -} -- | Paste the current X mouse selection. Note that this uses 'getSelection' from -- "XMonad.Util.XSelection" and so is heir to its flaws. pasteSelection :: X () pasteSelection = getSelection >>= pasteString -- | Send a string to the window which is currently focused. This function correctly -- handles capitalization. Warning: in dealing with capitalized characters, this assumes a QWERTY layout. pasteString :: String -> X () pasteString = mapM_ (\x -> if isUpper x || x `elem` "~!@#$%^&*()_+{}|:\"<>?" then pasteChar shiftMask x else pasteChar noModMask x) {- | Send a character to the current window. This is more low-level. Remember that you must handle the case of capitalization appropriately. That is, from the window's perspective: > pasteChar mod2Mask 'F' ~> "f" You would want to do something like: > pasteChar shiftMask 'F' Note that this function makes use of 'stringToKeysym', and so will probably have trouble with any 'Char' outside ASCII. -} pasteChar :: KeyMask -> Char -> X () pasteChar m c = sendKey m $ maybe (stringToKeysym [c]) fst $ listToMaybe $ readP_to_S parseKey [c] sendKey :: KeyMask -> KeySym -> X () sendKey = (withFocused .) . sendKeyWindow -- | The primitive. Allows you to send any combination of 'KeyMask' and 'KeySym' to any 'Window' you specify. sendKeyWindow :: KeyMask -> KeySym -> Window -> X () sendKeyWindow mods key w = withDisplay $ \d -> do rootw <- asks theRoot keycode <- io $ keysymToKeycode d key io $ allocaXEvent $ \ev -> do setEventType ev keyPress setKeyEvent ev w rootw none mods keycode True sendEvent d w True keyPressMask ev setEventType ev keyRelease sendEvent d w True keyReleaseMask ev xmonad-contrib-0.12/XMonad/Util/Font.hs0000644000000000000000000001410112636047674016127 0ustar0000000000000000{-# LANGUAGE CPP #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Font -- Copyright : (c) 2007 Andrea Rossato and Spencer Janssen -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A module for abstracting a font facility over Core fonts and Xft -- ----------------------------------------------------------------------------- module XMonad.Util.Font ( -- * Usage: -- $usage XMonadFont(..) , initXMF , releaseXMF , initCoreFont , releaseCoreFont , initUtf8Font , releaseUtf8Font , Align (..) , stringPosition , textWidthXMF , textExtentsXMF , printStringXMF , stringToPixel , fi ) where import XMonad import Foreign import Control.Applicative import Control.Exception as E import Data.Maybe #ifdef XFT import Data.List import Graphics.X11.Xft import Graphics.X11.Xrender #endif -- Hide the Core Font/Xft switching here data XMonadFont = Core FontStruct | Utf8 FontSet #ifdef XFT | Xft XftFont #endif -- $usage -- See "XMonad.Layout.Tabbed" or "XMonad.Prompt" for usage examples -- | Get the Pixel value for a named color: if an invalid name is -- given the black pixel will be returned. stringToPixel :: (Functor m, MonadIO m) => Display -> String -> m Pixel stringToPixel d s = fromMaybe fallBack <$> io getIt where getIt = initColor d s fallBack = blackPixel d (defaultScreen d) econst :: a -> IOException -> a econst = const -- | Given a fontname returns the font structure. If the font name is -- not valid the default font will be loaded and returned. initCoreFont :: String -> X FontStruct initCoreFont s = do d <- asks display io $ E.catch (getIt d) (fallBack d) where getIt d = loadQueryFont d s fallBack d = econst $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" releaseCoreFont :: FontStruct -> X () releaseCoreFont fs = do d <- asks display io $ freeFont d fs initUtf8Font :: String -> X FontSet initUtf8Font s = do d <- asks display (_,_,fs) <- io $ E.catch (getIt d) (fallBack d) return fs where getIt d = createFontSet d s fallBack d = econst $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" releaseUtf8Font :: FontSet -> X () releaseUtf8Font fs = do d <- asks display io $ freeFontSet d fs -- | When initXMF gets a font name that starts with 'xft:' it switches to the Xft backend -- Example: 'xft: Sans-10' initXMF :: String -> X XMonadFont initXMF s = #ifdef XFT if xftPrefix `isPrefixOf` s then do dpy <- asks display xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s) return (Xft xftdraw) else #endif fmap Utf8 $ initUtf8Font s #ifdef XFT where xftPrefix = "xft:" #endif releaseXMF :: XMonadFont -> X () #ifdef XFT releaseXMF (Xft xftfont) = do dpy <- asks display io $ xftFontClose dpy xftfont #endif releaseXMF (Utf8 fs) = releaseUtf8Font fs releaseXMF (Core fs) = releaseCoreFont fs textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int textWidthXMF _ (Utf8 fs) s = return $ fi $ wcTextEscapement fs s textWidthXMF _ (Core fs) s = return $ fi $ textWidth fs s #ifdef XFT textWidthXMF dpy (Xft xftdraw) s = liftIO $ do gi <- xftTextExtents dpy xftdraw s return $ xglyphinfo_xOff gi #endif textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (Int32,Int32) textExtentsXMF (Utf8 fs) s = do let (_,rl) = wcTextExtents fs s ascent = fi $ - (rect_y rl) descent = fi $ rect_height rl + (fi $ rect_y rl) return (ascent, descent) textExtentsXMF (Core fs) s = do let (_,a,d,_) = textExtents fs s return (a,d) #ifdef XFT textExtentsXMF (Xft xftfont) _ = io $ do ascent <- fi `fmap` xftfont_ascent xftfont descent <- fi `fmap` xftfont_descent xftfont return (ascent, descent) #endif -- | String position data Align = AlignCenter | AlignRight | AlignLeft | AlignRightOffset Int deriving (Show, Read) -- | Return the string x and y 'Position' in a 'Rectangle', given a -- 'FontStruct' and the 'Align'ment stringPosition :: (Functor m, MonadIO m) => Display -> XMonadFont -> Rectangle -> Align -> String -> m (Position,Position) stringPosition dpy fs (Rectangle _ _ w h) al s = do width <- textWidthXMF dpy fs s (a,d) <- textExtentsXMF fs s let y = fi $ ((h - fi (a + d)) `div` 2) + fi a; x = case al of AlignCenter -> fi (w `div` 2) - fi (width `div` 2) AlignLeft -> 1 AlignRight -> fi (w - (fi width + 1)); AlignRightOffset offset -> fi (w - (fi width + 1)) - fi offset; return (x,y) printStringXMF :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String -> Position -> Position -> String -> m () printStringXMF d p (Core fs) gc fc bc x y s = io $ do setFont d gc $ fontFromFontStruct fs [fc',bc'] <- mapM (stringToPixel d) [fc,bc] setForeground d gc fc' setBackground d gc bc' drawImageString d p gc x y s printStringXMF d p (Utf8 fs) gc fc bc x y s = io $ do [fc',bc'] <- mapM (stringToPixel d) [fc,bc] setForeground d gc fc' setBackground d gc bc' io $ wcDrawImageString d p fs gc x y s #ifdef XFT printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do let screen = defaultScreenOfDisplay dpy colormap = defaultColormapOfScreen screen visual = defaultVisualOfScreen screen bcolor <- stringToPixel dpy bc (a,d) <- textExtentsXMF fs s gi <- io $ xftTextExtents dpy font s io $ setForeground dpy gc bcolor io $ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi)) (y - fi a) (fi $ xglyphinfo_xOff gi) (fi $ a + d) io $ withXftDraw dpy drw visual colormap $ \draw -> withXftColorName dpy visual colormap fc $ \color -> xftDrawString draw color font x y s #endif -- | Short-hand for 'fromIntegral' fi :: (Integral a, Num b) => a -> b fi = fromIntegral xmonad-contrib-0.12/XMonad/Util/WorkspaceCompare.hs0000644000000000000000000001106312636047674020472 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.WorkspaceCompare -- Copyright : (c) Spencer Janssen -- License : BSD3-style (see LICENSE) -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- ----------------------------------------------------------------------------- module XMonad.Util.WorkspaceCompare ( WorkspaceCompare, WorkspaceSort , getWsIndex , getWsCompare , getWsCompareByTag , getXineramaPhysicalWsCompare , getXineramaWsCompare , mkWsSort , getSortByIndex , getSortByTag , getSortByXineramaPhysicalRule , getSortByXineramaRule ) where import XMonad import qualified XMonad.StackSet as S import Data.List import Data.Monoid import Data.Ord import Data.Maybe import Data.Function type WorkspaceCompare = WorkspaceId -> WorkspaceId -> Ordering type WorkspaceSort = [WindowSpace] -> [WindowSpace] -- | Lookup the index of a workspace id in the user's config, return Nothing -- if that workspace does not exist in the config. getWsIndex :: X (WorkspaceId -> Maybe Int) getWsIndex = do spaces <- asks (workspaces . config) return $ flip elemIndex spaces -- | Compare Maybe's differently, so Nothing (i.e. workspaces without indexes) -- come last in the order indexCompare :: Maybe Int -> Maybe Int -> Ordering indexCompare Nothing Nothing = EQ indexCompare Nothing (Just _) = GT indexCompare (Just _) Nothing = LT indexCompare a b = compare a b -- | A comparison function for WorkspaceId, based on the index of the -- tags in the user's config. getWsCompare :: X WorkspaceCompare getWsCompare = do wsIndex <- getWsIndex return $ mconcat [indexCompare `on` wsIndex, compare] -- | A simple comparison function that orders workspaces -- lexicographically by tag. getWsCompareByTag :: X WorkspaceCompare getWsCompareByTag = return compare -- | A comparison function for Xinerama based on visibility, workspace -- and screen id. It produces the same ordering as -- 'XMonad.Hooks.DynamicLog.pprWindowSetXinerama'. getXineramaWsCompare :: X WorkspaceCompare getXineramaWsCompare = getXineramaWsCompare' False -- | A comparison function like 'getXineramaWsCompare', but uses physical locations for screens. getXineramaPhysicalWsCompare :: X WorkspaceCompare getXineramaPhysicalWsCompare = getXineramaWsCompare' True getXineramaWsCompare' :: Bool -> X WorkspaceCompare getXineramaWsCompare' phy = do w <- gets windowset return $ \ a b -> case (isOnScreen a w, isOnScreen b w) of (True, True) -> cmpPosition phy w a b (False, False) -> compare a b (True, False) -> LT (False, True) -> GT where onScreen w = S.current w : S.visible w isOnScreen a w = a `elem` map (S.tag . S.workspace) (onScreen w) tagToSid s x = S.screen $ fromJust $ find ((== x) . S.tag . S.workspace) s cmpPosition False w a b = comparing (tagToSid $ onScreen w) a b cmpPosition True w a b = comparing (rect.(tagToSid $ onScreen w)) a b where rect i = let (Rectangle x y _ _) = screens !! fromIntegral i in (y,x) screens = map (screenRect . S.screenDetail) $ sortBy (comparing S.screen) $ S.current w : S.visible w -- | Create a workspace sorting function from a workspace comparison -- function. mkWsSort :: X WorkspaceCompare -> X WorkspaceSort mkWsSort cmpX = do cmp <- cmpX return $ sortBy (\a b -> cmp (S.tag a) (S.tag b)) -- | Sort several workspaces according to their tags' indices in the -- user's config. getSortByIndex :: X WorkspaceSort getSortByIndex = mkWsSort getWsCompare -- | Sort workspaces lexicographically by tag. getSortByTag :: X WorkspaceSort getSortByTag = mkWsSort getWsCompareByTag -- | Sort serveral workspaces for xinerama displays, in the same order -- produced by 'XMonad.Hooks.DynamicLog.pprWindowSetXinerama': first -- visible workspaces, sorted by screen, then hidden workspaces, -- sorted by tag. getSortByXineramaRule :: X WorkspaceSort getSortByXineramaRule = mkWsSort getXineramaWsCompare -- | Like 'getSortByXineramaRule', but uses physical locations for screens. getSortByXineramaPhysicalRule :: X WorkspaceSort getSortByXineramaPhysicalRule = mkWsSort getXineramaPhysicalWsCompare xmonad-contrib-0.12/XMonad/Util/CustomKeys.hs0000644000000000000000000000662412636047674017342 0ustar0000000000000000-------------------------------------------------------------------- -- | -- Module : XMonad.Util.CustomKeys -- Copyright : (c) 2007 Valery V. Vorotyntsev -- License : BSD3-style (see LICENSE) -- -- Maintainer : Valery V. Vorotynsev -- -- Customized key bindings. -- -- (See also "XMonad.Util.EZConfig" in xmonad-contrib.) -------------------------------------------------------------------- module XMonad.Util.CustomKeys ( -- * Usage -- $usage customKeys , customKeysFrom ) where import XMonad import Control.Monad.Reader import qualified Data.Map as M -- $usage -- -- 1. In @~\/.xmonad\/xmonad.hs@ add: -- -- > import XMonad.Util.CustomKeys -- -- 2. Set key bindings with 'customKeys': -- -- > main = xmonad def { keys = customKeys delkeys inskeys } -- > where -- > delkeys :: XConfig l -> [(KeyMask, KeySym)] -- > delkeys XConfig {modMask = modm} = -- > -- we're preferring Futurama to Xinerama here -- > [ (modm .|. m, k) | (m, k) <- zip [0, shiftMask] [xK_w, xK_e, xK_r] ] -- > -- > inskeys :: XConfig l -> [((KeyMask, KeySym), X ())] -- > inskeys conf@(XConfig {modMask = modm}) = -- > [ ((mod1Mask, xK_F2 ), spawn $ terminal conf) -- > , ((modm .|. controlMask, xK_F11 ), spawn "xscreensaver-command -lock") -- > , ((mod1Mask, xK_Down), spawn "amixer set Master 1-") -- > , ((mod1Mask, xK_Up ), spawn "amixer set Master 1+") -- > ] -- -- 0 (/hidden feature/). You can always replace bindings map -- entirely. No need to import "CustomKeys" this time: -- -- > import XMonad -- > import System.Exit -- > import qualified Data.Map as M -- > -- > main = xmonad def { -- > keys = \_ -> M.fromList [ -- > -- Let me out of here! I want my KDE back! Help! Help! -- > ( (0, xK_Escape), io (exitWith ExitSuccess) ) ] } -- | Customize 'XMonad.Config.def' -- delete needless -- shortcuts and insert those you will use. customKeys :: (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ shortcuts to delete -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ key bindings to insert -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) customKeys = customKeysFrom def -- | General variant of 'customKeys': customize key bindings of -- third-party configuration. customKeysFrom :: XConfig l -- ^ original configuration -> (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ shortcuts to delete -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ key bindings to insert -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) customKeysFrom conf = (runReader .) . customize conf customize :: XConfig l -> (XConfig Layout -> [(KeyMask, KeySym)]) -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -> Reader (XConfig Layout) (M.Map (KeyMask, KeySym) (X ())) customize conf ds is = asks (keys conf) >>= delete ds >>= insert is delete :: (MonadReader r m, Ord a) => (r -> [a]) -> M.Map a b -> m (M.Map a b) delete dels kmap = asks dels >>= return . foldr M.delete kmap insert :: (MonadReader r m, Ord a) => (r -> [(a, b)]) -> M.Map a b -> m (M.Map a b) insert ins kmap = asks ins >>= return . foldr (uncurry M.insert) kmap xmonad-contrib-0.12/XMonad/Util/NamedWindows.hs0000644000000000000000000000403212636047674017622 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.NamedWindows -- Copyright : (c) David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- This module allows you to associate the X titles of windows with -- them. -- ----------------------------------------------------------------------------- module XMonad.Util.NamedWindows ( -- * Usage -- $usage NamedWindow, getName, withNamedWindow, unName ) where import Control.Applicative ( (<$>) ) import Control.Exception.Extensible as E import Data.Maybe ( fromMaybe, listToMaybe ) import qualified XMonad.StackSet as W ( peek ) import XMonad -- $usage -- See "XMonad.Layout.Tabbed" for an example of its use. data NamedWindow = NW !String !Window instance Eq NamedWindow where (NW s _) == (NW s' _) = s == s' instance Ord NamedWindow where compare (NW s _) (NW s' _) = compare s s' instance Show NamedWindow where show (NW n _) = n getName :: Window -> X NamedWindow getName w = withDisplay $ \d -> do -- TODO, this code is ugly and convoluted -- clean it up let getIt = bracket getProp (xFree . tp_value) (fmap (`NW` w) . copy) getProp = (internAtom d "_NET_WM_NAME" False >>= getTextProperty d w) `E.catch` \(SomeException _) -> getTextProperty d w wM_NAME copy prop = fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop io $ getIt `E.catch` \(SomeException _) -> ((`NW` w) . resName) `fmap` getClassHint d w unName :: NamedWindow -> Window unName (NW _ w) = w withNamedWindow :: (NamedWindow -> X ()) -> X () withNamedWindow f = do ws <- gets windowset whenJust (W.peek ws) $ \w -> getName w >>= f xmonad-contrib-0.12/XMonad/Util/Scratchpad.hs0000644000000000000000000001050512636047674017301 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Scratchpad -- Copyright : (c) Braden Shepherdson 2008 -- License : BSD-style (as xmonad) -- -- Maintainer : Braden.Shepherdson@gmail.com -- Stability : unstable -- Portability : unportable -- -- Very handy hotkey-launched floating terminal window. -- ----------------------------------------------------------------------------- module XMonad.Util.Scratchpad ( -- * Usage -- $usage scratchpadSpawnAction ,scratchpadSpawnActionTerminal ,scratchpadSpawnActionCustom ,scratchpadManageHookDefault ,scratchpadManageHook ,scratchpadFilterOutWorkspace ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Util.NamedScratchpad -- $usage -- Bind a key to 'scratchpadSpawnAction' -- Pressing it will spawn the terminal, or bring it to the current -- workspace if it already exists. -- Pressing the key with the terminal on the current workspace will -- send it to a hidden workspace called @NSP@. -- -- If you already have a workspace called @NSP@, it will use that. -- @NSP@ will also appear in xmobar and dzen status bars. You can tweak your -- @dynamicLog@ settings to filter it out if you like. -- -- A tool like detach () turns it -- into a launchpad for X apps. -- -- By default, your xmonad terminal is used. -- The default ManageHook uses a centered, half-screen-wide, -- quarter-screen-tall window. -- The key, position and size are configurable. -- -- The terminal application must support the @-name@ argument. -- Known supported terminals: rxvt, rxvt-unicode, xterm. -- Most others are likely to follow the lead set by xterm. -- -- Bind the following to a key in your xmonad.hs keybindings: -- -- > scratchpadSpawnAction conf -- -- Where @conf@ is the configuration. -- -- And add one of the @scratchpadManageHook*@s to your ManageHook list. -- The default rectangle is half the screen wide and a quarter of the -- screen tall, centered. -- -- | Action to pop up the terminal, for the user to bind to a custom key. scratchpadSpawnAction :: XConfig l -- ^ The configuration, to retrieve the terminal -> X () scratchpadSpawnAction conf = scratchpadSpawnActionCustom $ terminal conf ++ " -name scratchpad" -- | Action to pop up the terminal, with a directly specified terminal. scratchpadSpawnActionTerminal :: String -- ^ Name of the terminal program -> X () scratchpadSpawnActionTerminal term = scratchpadSpawnActionCustom $ term ++ " -name scratchpad" -- | Action to pop up any program with the user specifying how to set -- its resource to \"scratchpad\". For example, with gnome-terminal: -- -- > scratchpadSpawnActionCustom "gnome-terminal --disable-factory --name scratchpad" scratchpadSpawnActionCustom :: String -- ^ Command to spawn a program with resource \"scratchpad\" -> X () scratchpadSpawnActionCustom c = namedScratchpadAction [NS "scratchpad" c scratchpadQuery nonFloating] "scratchpad" -- factored out since this is common to both the ManageHook and the action scratchpadQuery :: Query Bool scratchpadQuery = resource =? "scratchpad" -- | The ManageHook, with the default rectangle: -- Half the screen wide, a quarter of the screen tall, centered. scratchpadManageHookDefault :: ManageHook scratchpadManageHookDefault = namedScratchpadManageHook [NS "" "" scratchpadQuery (customFloating scratchpadDefaultRect)] -- | The ManageHook, with a user-specified StackSet.RationalRect, -- e.g., for a terminal 4/10 of the screen width from the left, half -- the screen height from the top, and 6/10 of the screen width by -- 3/10 the screen height, use: -- -- > scratchpadManageHook (W.RationalRect 0.4 0.5 0.6 0.3) scratchpadManageHook :: W.RationalRect -- ^ User-specified screen rectangle. -> ManageHook scratchpadManageHook rect = namedScratchpadManageHook [NS "" "" scratchpadQuery (customFloating rect)] -- | Transforms a workspace list containing the SP workspace into one that -- doesn't contain it. Intended for use with logHooks. scratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace] scratchpadFilterOutWorkspace = namedScratchpadFilterOutWorkspace scratchpadDefaultRect :: W.RationalRect scratchpadDefaultRect = W.RationalRect 0.25 0.375 0.5 0.25 xmonad-contrib-0.12/XMonad/Util/Dmenu.hs0000644000000000000000000000527112636047674016301 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Dmenu -- Copyright : (c) Spencer Janssen -- License : BSD-style (see LICENSE) -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- A convenient binding to dmenu. -- -- Requires the process-1.0 package -- ----------------------------------------------------------------------------- module XMonad.Util.Dmenu ( -- * Usage -- $usage dmenu, dmenuXinerama, dmenuMap, menu, menuArgs, menuMap, menuMapArgs ) where import XMonad import qualified XMonad.StackSet as W import qualified Data.Map as M import XMonad.Util.Run -- $usage -- You can use this module with the following in your Config.hs file: -- -- > import XMonad.Util.Dmenu -- -- These functions block xmonad's event loop until dmenu exits; this means that -- programs will not be able to open new windows and you will not be able to -- change workspaces or input focus until you have responded to the prompt one -- way or another. -- %import XMonad.Util.Dmenu -- | Starts dmenu on the current screen. Requires this patch to dmenu: -- dmenuXinerama :: [String] -> X String dmenuXinerama opts = do curscreen <- (fromIntegral . W.screen . W.current) `fmap` gets windowset :: X Int runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts) menuArgs "dmenu" ["-xs", show (curscreen+1)] opts -- | Run dmenu to select an option from a list. dmenu :: [String] -> X String dmenu opts = menu "dmenu" opts -- | like 'dmenu' but also takes the command to run. menu :: String -> [String] -> X String menu menuCmd opts = menuArgs menuCmd [] opts -- | Like 'menu' but also takes a list of command line arguments. menuArgs :: String -> [String] -> [String] -> X String menuArgs menuCmd args opts = fmap (filter (/='\n')) $ runProcessWithInput menuCmd args (unlines opts) -- | Like 'dmenuMap' but also takes the command to run. menuMap :: String -> M.Map String a -> X (Maybe a) menuMap menuCmd selectionMap = menuMapArgs menuCmd [] selectionMap -- | Like 'menuMap' but also takes a list of command line arguments. menuMapArgs :: String -> [String] -> M.Map String a -> X (Maybe a) menuMapArgs menuCmd args selectionMap = do selection <- menuFunction (M.keys selectionMap) return $ M.lookup selection selectionMap where menuFunction = menuArgs menuCmd args -- | Run dmenu to select an entry from a map based on the key. dmenuMap :: M.Map String a -> X (Maybe a) dmenuMap selectionMap = menuMap "dmenu" selectionMap xmonad-contrib-0.12/XMonad/Util/Run.hs0000644000000000000000000001416112636047674015773 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Run -- Copyright : (C) 2007 Spencer Janssen, Andrea Rossato, glasser@mit.edu -- License : BSD-style (see LICENSE) -- -- Maintainer : Christian Thiemann -- Stability : unstable -- Portability : unportable -- -- This modules provides several commands to run an external process. -- It is composed of functions formerly defined in "XMonad.Util.Dmenu" (by -- Spencer Janssen), "XMonad.Util.Dzen" (by glasser\@mit.edu) and -- XMonad.Util.RunInXTerm (by Andrea Rossato). -- ----------------------------------------------------------------------------- module XMonad.Util.Run ( -- * Usage -- $usage runProcessWithInput, runProcessWithInputAndWait, safeSpawn, safeSpawnProg, unsafeSpawn, runInTerm, safeRunInTerm, seconds, spawnPipe, hPutStr, hPutStrLn -- re-export for convenience ) where import Codec.Binary.UTF8.String import System.Posix.IO import System.Posix.Process (createSession, executeFile, forkProcess) import Control.Concurrent (threadDelay) import System.IO import System.Process (runInteractiveProcess) import XMonad import Control.Monad -- $usage -- For an example usage of 'runInTerm' see "XMonad.Prompt.Ssh" -- -- For an example usage of 'runProcessWithInput' see -- "XMonad.Prompt.DirectoryPrompt", "XMonad.Util.Dmenu", -- "XMonad.Prompt.ShellPrompt", "XMonad.Actions.WmiiActions", -- "XMonad.Prompt.WorkspaceDir" -- -- For an example usage of 'runProcessWithInputAndWait' see -- "XMonad.Util.Dzen" -- | Returns the output. runProcessWithInput :: MonadIO m => FilePath -> [String] -> String -> m String runProcessWithInput cmd args input = io $ do (pin, pout, perr, _) <- runInteractiveProcess (encodeString cmd) (map encodeString args) Nothing Nothing hPutStr pin input hClose pin output <- hGetContents pout when (output == output) $ return () hClose pout hClose perr -- no need to waitForProcess, we ignore SIGCHLD return output -- | Wait is in μ (microseconds) runProcessWithInputAndWait :: MonadIO m => FilePath -> [String] -> String -> Int -> m () runProcessWithInputAndWait cmd args input timeout = io $ do _ <- xfork $ do (pin, pout, perr, _) <- runInteractiveProcess (encodeString cmd) (map encodeString args) Nothing Nothing hPutStr pin input hFlush pin threadDelay timeout hClose pin hClose pout hClose perr -- no need to waitForProcess, we ignore SIGCHLD return () return () -- | Multiplies by ONE MILLION, for functions that take microseconds. -- -- Use like: -- -- > (5.5 `seconds`) -- -- In GHC 7 and later, you must either enable the PostfixOperators extension -- (by adding -- -- > {-# LANGUAGE PostfixOperators #-} -- -- to the top of your file) or use seconds in prefix form: -- -- > 5.5 seconds seconds :: Rational -> Int seconds = fromEnum . (* 1000000) {- | 'safeSpawn' bypasses 'spawn', because spawn passes strings to \/bin\/sh to be interpreted as shell commands. This is often what one wants, but in many cases the passed string will contain shell metacharacters which one does not want interpreted as such (URLs particularly often have shell metacharacters like \'&\' in them). In this case, it is more useful to specify a file or program to be run and a string to give it as an argument so as to bypass the shell and be certain the program will receive the string as you typed it. Examples: > , ((modm, xK_Print), unsafeSpawn "import -window root $HOME/xwd-$(date +%s)$$.png") > , ((modm, xK_d ), safeSpawn "firefox" []) Note that the unsafeSpawn example must be unsafe and not safe because it makes use of shell interpretation by relying on @$HOME@ and interpolation, whereas the safeSpawn example can be safe because Firefox doesn't need any arguments if it is just being started. -} safeSpawn :: MonadIO m => FilePath -> [String] -> m () safeSpawn prog args = io $ void_ $ forkProcess $ do uninstallSignalHandlers _ <- createSession executeFile (encodeString prog) True (map encodeString args) Nothing where void_ = (>> return ()) -- TODO: replace with Control.Monad.void / void not in ghc6 apparently -- | Simplified 'safeSpawn'; only takes a program (and no arguments): -- -- > , ((modm, xK_d ), safeSpawnProg "firefox") safeSpawnProg :: MonadIO m => FilePath -> m () safeSpawnProg = flip safeSpawn [] -- | An alias for 'spawn'; the name emphasizes that one is calling out to a -- Turing-complete interpreter which may do things one dislikes; for details, see 'safeSpawn'. unsafeSpawn :: MonadIO m => String -> m () unsafeSpawn = spawn -- | Open a terminal emulator. The terminal emulator is specified in the default configuration as xterm by default. It is then -- asked to pass the shell a command with certain options. This is unsafe in the sense of 'unsafeSpawn' unsafeRunInTerm, runInTerm :: String -> String -> X () unsafeRunInTerm options command = asks (terminal . config) >>= \t -> unsafeSpawn $ t ++ " " ++ options ++ " -e " ++ command runInTerm = unsafeRunInTerm -- | Run a given program in the preferred terminal emulator; see 'runInTerm'. This makes use of 'safeSpawn'. safeRunInTerm :: String -> String -> X () safeRunInTerm options command = asks (terminal . config) >>= \t -> safeSpawn t [options, " -e " ++ command] -- | Launch an external application through the system shell and return a @Handle@ to its standard input. spawnPipe :: MonadIO m => String -> m Handle spawnPipe x = io $ do (rd, wr) <- createPipe setFdOption wr CloseOnExec True h <- fdToHandle wr hSetBuffering h LineBuffering _ <- xfork $ do _ <- dupTo rd stdInput executeFile "/bin/sh" False ["-c", encodeString x] Nothing closeFd rd return h xmonad-contrib-0.12/XMonad/Util/Dzen.hs0000644000000000000000000001447112636047674016133 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Dzen -- Copyright : (c) glasser@mit.edu -- License : BSD -- -- Maintainer : glasser@mit.edu -- Stability : stable -- Portability : unportable -- -- Handy wrapper for dzen. Requires dzen >= 0.2.4. -- ----------------------------------------------------------------------------- module XMonad.Util.Dzen ( -- * Flexible interface dzenConfig, DzenConfig, timeout, font, xScreen, vCenter, hCenter, center, onCurr, x, y, addArgs, -- * Legacy interface dzen, dzenScreen, dzenWithArgs, -- * Miscellaneous seconds, chomp, (>=>), ) where import Control.Monad import XMonad import XMonad.StackSet import XMonad.Util.Run (runProcessWithInputAndWait, seconds) type DzenConfig = (Int, [String]) -> X (Int, [String]) -- | @dzenConfig config s@ will display the string @s@ according to the -- configuration @config@. For example, to display the string @\"foobar\"@ with -- all the default settings, you can simply call -- -- > dzenConfig return "foobar" -- -- Or, to set a longer timeout, you could use -- -- > dzenConfig (timeout 10) "foobar" -- -- You can combine configurations with the (>=>) operator. To display -- @\"foobar\"@ for 10 seconds on the first screen, you could use -- -- > dzenConfig (timeout 10 >=> xScreen 0) "foobar" -- -- As a final example, you could adapt the above to display @\"foobar\"@ for -- 10 seconds on the current screen with -- -- > dzenConfig (timeout 10 >=> onCurr xScreen) "foobar" dzenConfig :: DzenConfig -> String -> X () dzenConfig conf s = do (t, args) <- conf (seconds 3, []) runProcessWithInputAndWait "dzen2" args (chomp s) t -- | dzen wants exactly one newline at the end of its input, so this can be -- used for your own invocations of dzen. However, all functions in this -- module will call this for you. chomp :: String -> String chomp = (++"\n") . reverse . dropWhile ('\n' ==) . reverse -- | Set the timeout, in seconds. This defaults to 3 seconds if not -- specified. timeout :: Rational -> DzenConfig timeout = timeoutMicro . seconds -- | Set the timeout, in microseconds. Mostly here for the legacy -- interface. timeoutMicro :: Int -> DzenConfig timeoutMicro n (_, ss) = return (n, ss) -- | Add raw command-line arguments to the configuration. These will be -- passed on verbatim to dzen2. The default includes no arguments. addArgs :: [String] -> DzenConfig addArgs ss (n, ss') = return (n, ss ++ ss') -- | Start dzen2 on a particular screen. Only works with versions of dzen -- that support the "-xs" argument. xScreen :: ScreenId -> DzenConfig xScreen sc = addArgs ["-xs", show (fromIntegral sc + 1 :: Int)] -- | Take a screen-specific configuration and supply it with the screen ID -- of the currently focused screen, according to xmonad. For example, show -- a 100-pixel wide bar centered within the current screen, you could use -- -- > dzenConfig (onCurr (hCenter 100)) "foobar" -- -- Of course, you can still combine these with (>=>); for example, to center -- the string @\"foobar\"@ both horizontally and vertically in a 100x14 box -- using the lovely Terminus font, you could use -- -- > terminus = "-*-terminus-*-*-*-*-12-*-*-*-*-*-*-*" -- > dzenConfig (onCurr (center 100 14) >=> font terminus) "foobar" onCurr :: (ScreenId -> DzenConfig) -> DzenConfig onCurr f conf = gets (screen . current . windowset) >>= flip f conf -- | Put the top of the dzen bar at a particular pixel. x :: Int -> DzenConfig x n = addArgs ["-x", show n] -- | Put the left of the dzen bar at a particular pixel. y :: Int -> DzenConfig y n = addArgs ["-y", show n] -- | Specify the font. Check out xfontsel to get the format of the String -- right; if your dzen supports xft, then you can supply that here, too. font :: String -> DzenConfig font fn = addArgs ["-fn", fn] -- | @vCenter height sc@ sets the configuration to have the dzen bar appear -- on screen @sc@ with height @height@, vertically centered with respect to -- the actual size of that screen. vCenter :: Int -> ScreenId -> DzenConfig vCenter = center' rect_height "-h" "-y" -- | @hCenter width sc@ sets the configuration to have the dzen bar appear -- on screen @sc@ with width @width@, horizontally centered with respect to -- the actual size of that screen. hCenter :: Int -> ScreenId -> DzenConfig hCenter = center' rect_width "-w" "-x" -- | @center width height sc@ sets the configuration to have the dzen bar -- appear on screen @sc@ with width @width@ and height @height@, centered -- both horizontally and vertically with respect to the actual size of that -- screen. center :: Int -> Int -> ScreenId -> DzenConfig center width height sc = hCenter width sc >=> vCenter height sc -- Center things along a single dimension on a particular screen. center' :: (Rectangle -> Dimension) -> String -> String -> Int -> ScreenId -> DzenConfig center' selector extentName positionName extent sc conf = do rect <- gets (detailFromScreenId sc . windowset) case rect of Nothing -> return conf Just r -> addArgs [extentName , show extent, positionName, show ((fromIntegral (selector r) - extent) `div` 2), "-xs" , show (fromIntegral sc + 1 :: Int) ] conf -- Get the rectangle outlining a particular screen. detailFromScreenId :: ScreenId -> WindowSet -> Maybe Rectangle detailFromScreenId sc ws = fmap screenRect maybeSD where c = current ws v = visible ws mapping = map (\s -> (screen s, screenDetail s)) (c:v) maybeSD = lookup sc mapping -- | @dzen str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds. -- Example usage: -- -- > dzen "Hi, mom!" (5 `seconds`) dzen :: String -> Int -> X () dzen = flip (dzenConfig . timeoutMicro) -- | @dzen str args timeout@ pipes @str@ to dzen2 for @timeout@ seconds, passing @args@ to dzen. -- Example usage: -- -- > dzenWithArgs "Hi, dons!" ["-ta", "r"] (5 `seconds`) dzenWithArgs :: String -> [String] -> Int -> X () dzenWithArgs str args t = dzenConfig (timeoutMicro t >=> addArgs args) str -- | @dzenScreen sc str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds, and on screen @sc@. -- Requires dzen to be compiled with Xinerama support. dzenScreen :: ScreenId -> String -> Int -> X () dzenScreen sc str t = dzenConfig (timeoutMicro t >=> xScreen sc) str xmonad-contrib-0.12/XMonad/Util/WindowState.hs0000644000000000000000000000703712636047674017503 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts -- ghc-6.12 only #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.WindowState -- Copyright : (c) Dmitry Bogatov -- License : BSD -- -- Maintainer : Dmitry Bogatov -- Stability : unstable -- Portability : unportable -- -- Functions for saving per-window data. ----------------------------------------------------------------------------- module XMonad.Util.WindowState ( -- * Usage -- $usage get, put, StateQuery(..), runStateQuery, catchQuery ) where import XMonad hiding (get, put, modify) import Control.Monad.Reader(ReaderT(..)) import Control.Monad.State.Class import Data.Typeable (typeOf) import Control.Applicative((<$>), Applicative) -- $usage -- -- This module allow to store state data with some 'Window'. -- It is implemented with XProperties, so resources will be freed when -- 'Window' is destoyed. -- -- This module have advantage over "XMonad.Actions.TagWindows" in that it -- hides from you implementation details and provides simple type-safe -- interface. Main datatype is "StateQuery", which is simple wrapper around -- "Query", which is instance of MonadState, with 'put' and 'get' are -- functions to acess data, stored in "Window". -- -- To save some data in window you probably want to do following: -- > (runStateQuery (put $ Just value) win) :: X () -- To retrive it, you can use -- > (runStateQuery get win) :: X (Maybe YourValueType) -- "Query" can be promoted to "StateQuery" simply by constructor, -- and reverse is 'getQuery'. -- -- For example, I use it to have all X applications @russian@ or @dvorak@ -- layout, but emacs have only @us@, to not screw keybindings. Use your -- imagination! -- | Wrapper around "Query" with phanom type @s@, representing state, saved in -- window. newtype StateQuery s a = StateQuery { getQuery :: Query a } deriving (Monad, MonadIO, Applicative, Functor) packIntoQuery :: (Window -> X a) -> Query a packIntoQuery = Query . ReaderT -- | Apply "StateQuery" to "Window". runStateQuery :: StateQuery s a -> Window -> X a runStateQuery = runQuery . getQuery -- | Lifted to "Query" version of 'catchX' catchQuery :: Query a -> Query (Maybe a) catchQuery q = packIntoQuery $ \win -> userCode $ runQuery q win -- | Instance of MonadState for StateQuery. instance (Show s, Read s, Typeable s) => MonadState (Maybe s) (StateQuery s) where get = StateQuery $ read' <$> get' undefined where get' :: (Maybe s) -> Query String get' x = stringProperty (typePropertyName x) read' :: (Read s) => String -> Maybe s read' "" = Nothing read' s = Just $ read s put = StateQuery . packIntoQuery <$> setWindowProperty' where setWindowProperty' val = setWindowProperty prop strValue where prop = typePropertyName val strValue = maybe "" show val typePropertyName :: (Typeable a) => a -> String typePropertyName x = "_XMONAD_WINSTATE__" ++ show (typeOf x) type PropertyName = String setWindowProperty :: PropertyName -> String -> Window -> X () setWindowProperty prop val win = withDisplay $ \d -> io $ internAtom d prop False >>= setTextProperty d win val xmonad-contrib-0.12/XMonad/Util/RemoteWindows.hs0000644000000000000000000000657712636047674020051 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.RemoteWindows -- Copyright : (c) Anton Vorontsov 2014 -- License : BSD-style (as xmonad) -- -- Maintainer : Anton Vorontsov -- Stability : unstable -- Portability : unportable -- -- This module implements a proper way of finding out whether the window -- is remote or local. -- -- Just checking for a hostname and WM_CLIENT_MACHINE being equal is often -- not enough because the hostname is a changing subject (without any -- established notification mechanisms), and thus WM_CLIENT_MACHINE and -- the hostname can diverge even for a local window. -- -- This module solves the problem. As soon as there is a new window -- created, we check the hostname and WM_CLIENT_MACHINE, and then we cache -- the result into the XMONAD_REMOTE property. -- -- Notice that XMonad itself does not know anything about hostnames, nor -- does it have any dependency on Network.* modules. For this module it is -- not a problem: you can provide a mean to get the hostname through your -- config file (see usage). Or, if you don't like the hassle of handling -- dynamic hostnames (suppose your hostname never changes), it is also -- fine: this module will fallback to using environment variables. -- ----------------------------------------------------------------------------- module XMonad.Util.RemoteWindows ( -- $usage isLocalWindow , manageRemote , manageRemoteG ) where import XMonad import XMonad.Util.WindowProperties import Data.Monoid import Data.Maybe import Control.Monad import System.Posix.Env -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad -- > import XMonad.Util.RemoteWindows -- > import Network.BSD -- > -- > main = xmonad def -- > { manageHook = manageRemote =<< io getHostName } guessHostName :: IO String guessHostName = pickOneMaybe `liftM` (getEnv `mapM` vars) where pickOneMaybe = last . (mzero:) . take 1 . catMaybes vars = ["XAUTHLOCALHOSTNAME","HOST","HOSTNAME"] setRemoteProp :: Window -> String -> X () setRemoteProp w host = do d <- asks display p <- getAtom "XMONAD_REMOTE" t <- getAtom "CARDINAL" v <- hasProperty (Machine host) w io $ changeProperty32 d w p t propModeReplace [fromIntegral . fromEnum $ not v] -- | Given a window, tell if it is a local or a remote process. Normally, -- it checks XMONAD_REMOTE property. If it does not exist (i.e. the -- manageRemote hook was not deployed in user's config), it falls back to -- checking environment variables and assuming that hostname never -- changes. isLocalWindow :: Window -> X Bool isLocalWindow w = getProp32s "XMONAD_REMOTE" w >>= \p -> case p of Just [y] -> return $ y == 0 _ -> io guessHostName >>= \host -> hasProperty (Machine host) w -- | Use this hook to let XMonad properly track remote/local windows. For -- example, @manageHook = manageRemote =<< io getHostName@. manageRemote :: String -> ManageHook manageRemote host = ask >>= \w -> liftX (setRemoteProp w host) >> return mempty -- | Use this hook if you want to manage XMONAD_REMOTE properties, but -- don't want to use an external getHostName in your config. That way you -- are retreating to environment variables. manageRemoteG :: ManageHook manageRemoteG = manageRemote =<< io guessHostName xmonad-contrib-0.12/XMonad/Util/Cursor.hs0000644000000000000000000000232312636047674016501 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Cursor -- Copyright : (c) 2009 Collabora Ltd -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : Andres Salomon -- Stability : unstable -- Portability : unportable -- -- A module for setting the default mouse cursor. -- -- Some ideas shamelessly stolen from Nils Schweinsberg; thanks! ----------------------------------------------------------------------------- module XMonad.Util.Cursor ( -- * Usage: -- $usage module Graphics.X11.Xlib.Cursor, setDefaultCursor ) where import Graphics.X11.Xlib.Cursor import XMonad -- $usage -- -- > setDefaultCursor xC_left_ptr -- -- For example, to override the default gnome cursor: -- -- > import XMonad.Util.Cursor -- > main = xmonad gnomeConfig { startupHook = setDefaultCursor xC_pirate } -- -- Arrr! -- | Set the default (root) cursor setDefaultCursor :: Glyph -> X () setDefaultCursor glyph = do dpy <- asks display rootw <- asks theRoot liftIO $ do curs <- createFontCursor dpy glyph defineCursor dpy rootw curs flush dpy freeCursor dpy curs xmonad-contrib-0.12/XMonad/Util/Loggers.hs0000644000000000000000000002612712636047674016636 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Loggers -- Copyright : (c) Brent Yorgey, Wirt Wolff -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- A collection of simple logger functions and formatting utilities -- which can be used in the 'XMonad.Hooks.DynamicLog.ppExtras' field of -- a pretty-printing status logger format. See "XMonad.Hooks.DynamicLog" -- for more information. ----------------------------------------------------------------------------- module XMonad.Util.Loggers ( -- * Usage -- $usage Logger -- * System Loggers -- $system , aumixVolume , battery , date , loadAvg , maildirNew, maildirUnread , logCmd , logFileCount -- * XMonad Loggers -- $xmonad , logCurrent, logLayout, logTitle -- * Formatting Utilities -- $format , onLogger , wrapL, fixedWidthL , logSp, padL , shortenL , dzenColorL, xmobarColorL , (<$>) ) where import XMonad (liftIO) import XMonad.Core import qualified XMonad.StackSet as W import XMonad.Hooks.DynamicLog import XMonad.Util.Font (Align (..)) import XMonad.Util.NamedWindows (getName) import Control.Applicative ((<$>)) import Control.Exception as E import Data.List (isPrefixOf, isSuffixOf) import Data.Maybe (fromMaybe) import Data.Traversable (traverse) import System.Directory (getDirectoryContents) import System.IO import System.Locale import System.Process (runInteractiveCommand) import System.Time econst :: Monad m => a -> IOException -> m a econst = const . return -- $usage -- Use this module by importing it into your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Util.Loggers -- -- Then, add one or more loggers to the -- 'XMonad.Hooks.DynamicLog.ppExtras' field of your -- 'XMonad.Hooks.DynamicLoc.PP', possibly with extra formatting . -- For example: -- -- > -- display load averages and a pithy quote along with xmonad status. -- > , logHook = dynamicLogWithPP $ def { -- > ppExtras = [ padL loadAvg, logCmd "fortune -n 40 -s" ] -- > } -- > -- gives something like " 3.27 3.52 3.26 Drive defensively. Buy a tank." -- -- See the formatting section below for another example using -- a @where@ block to define some formatted loggers for a top-level -- @myLogHook@. -- -- Loggers are named either for their function, as in 'battery', -- 'aumixVolume', and 'maildirNew', or are prefixed with \"log\" when -- making use of other functions or by analogy with the pp* functions. -- For example, the logger version of 'XMonad.Hooks.DynamicLog.ppTitle' -- is 'logTitle', and 'logFileCount' loggerizes the result of file -- counting code. -- -- Formatting utility names are generally as short as possible and -- carry the suffix \"L\". For example, the logger version of -- 'XMonad.Hooks.DynamicLog.shorten' is 'shortenL'. -- -- Of course, there is nothing really special about these so-called -- \"loggers\": they are just @X (Maybe String)@ actions. So you can -- use them anywhere you would use an @X (Maybe String)@, not just -- with DynamicLog. -- -- Additional loggers welcome! -- | 'Logger' is just a convenient synonym for @X (Maybe String)@. type Logger = X (Maybe String) -- $system -- | Get the current volume with @aumix@. aumixVolume :: Logger aumixVolume = logCmd "aumix -vq" -- | Get the battery status (percent charge and charging\/discharging -- status). This is an ugly hack and may not work for some people. -- At some point it would be nice to make this more general\/have -- fewer dependencies (assumes @\/usr\/bin\/acpi@ and @sed@ are installed.) battery :: Logger battery = logCmd "/usr/bin/acpi | sed -r 's/.*?: (.*%).*/\\1/; s/[dD]ischarging, ([0-9]+%)/\\1-/; s/[cC]harging, ([0-9]+%)/\\1+/; s/[cC]harged, //'" -- | Get the current date and time, and format them via the -- given format string. The format used is the same as that used -- by the C library function strftime; for example, -- @date \"%a %b %d\"@ might display something like @Tue Feb 19@. -- For more information see something like -- . date :: String -> Logger date fmt = io $ do cal <- (getClockTime >>= toCalendarTime) return . Just $ formatCalendarTime defaultTimeLocale fmt cal -- | Get the load average. This assumes that you have a -- utility called @\/usr\/bin\/uptime@ and that you have @sed@ -- installed; these are fairly common on GNU\/Linux systems but it -- would be nice to make this more general. loadAvg :: Logger loadAvg = logCmd "/usr/bin/uptime | sed 's/.*: //; s/,//g'" -- | Create a 'Logger' from an arbitrary shell command. logCmd :: String -> Logger logCmd c = io $ do (_, out, _, _) <- runInteractiveCommand c fmap Just (hGetLine out) `E.catch` econst Nothing -- no need to waitForProcess, we ignore SIGCHLD -- | Get a count of filtered files in a directory. -- See 'maildirUnread' and 'maildirNew' source for usage examples. logFileCount :: FilePath -- ^ directory in which to count files -> (String -> Bool) -- ^ predicate to match if file should be counted -> Logger logFileCount d p = do c <- liftIO ( getDirectoryContents d) let n = length $ Prelude.filter p c case n of 0 -> return Nothing _ -> return $ Just $ show n -- | Get a count of unread mails in a maildir. For maildir format -- details, to write loggers for other classes of mail, see -- and 'logFileCount'. maildirUnread :: FilePath -> Logger maildirUnread mdir = logFileCount (mdir ++ "/cur/") (isSuffixOf ",") -- | Get a count of new mails in a maildir. maildirNew :: FilePath -> Logger maildirNew mdir = logFileCount (mdir ++ "/new/") (not . isPrefixOf ".") -- $xmonad -- -- A very small sample of what you can log since you have access to X. For -- example you can loggerize the number of windows on each workspace, or -- titles on other workspaces, or the id of the previously focused workspace.... -- | Get the title (name) of the focused window. logTitle :: Logger logTitle = withWindowSet $ traverse (fmap show . getName) . W.peek -- | Get the name of the current layout. logLayout :: Logger logLayout = withWindowSet $ return . Just . ld where ld = description . W.layout . W.workspace . W.current -- | Get the name of the current workspace. logCurrent :: Logger logCurrent = withWindowSet $ return . Just . W.currentTag -- $format -- Combine logger formatting functions to make your -- 'XMonad.Hooks.DynamicLog.ppExtras' more colorful and readable. -- (For convenience this module exports 'Control.Applicative.<$>' to -- use instead of \'.\' or \'$\' in hard to read formatting lines. -- For example: -- -- > myLogHook = dynamicLogWithPP def { -- > -- skipped -- > , ppExtras = [lLoad, lTitle, logSp 3, wrapL "[" "]" $ date "%a %d %b"] -- > , ppOrder = \(ws,l,_,xs) -> [l,ws] ++ xs -- > } -- > where -- > -- lTitle = fixedWidthL AlignCenter "." 99 . dzenColorL "cornsilk3" "" . padL . shortenL 80 $ logTitle -- > -- or something like: -- > lTitle = fixedWidthL AlignCenter "." 99 <$> dzenColorL "cornsilk3" "" <$> padL . shortenL 80 $ logTitle -- > -- > lLoad = dzenColorL "#6A5ACD" "" . wrapL loadIcon " " . padL $ loadAvg -- > loadIcon = " ^i(/home/me/.dzen/icons/load.xbm)" -- -- Note: When applying 'shortenL' or 'fixedWidthL' to logger strings -- containing colors or other formatting commands, apply the formatting -- /after/ the length adjustment, or include \"invisible\" characters -- in the length specification, e.g. in the above \'^fg(cornsilk3)\' and -- \'^fg()' yields 19 invisible and 80 visible characters. -- | Use a string formatting function to edit a 'Logger' string. -- For example, to create a tag function to prefix or label loggers, -- as in \'tag: output\', use: -- -- > tagL l = onLogger $ wrap (l ++ ": ") "" -- > -- > tagL "bat" battery -- > tagL "load" loadAvg -- -- If you already have a (String -> String) function you want to -- apply to a logger: -- -- > revL = onLogger trim -- -- See formatting utility source code for more 'onLogger' usage examples. onLogger :: (String -> String) -> Logger -> Logger onLogger = fmap . fmap -- | Wrap a logger's output in delimiters, unless it is @X (Nothing)@ -- or @X (Just \"\")@. Some examples: -- -- > wrapL " | " " | " (date "%a %d %b") -- ' | Tue 19 Feb | ' -- > -- > wrapL "bat: " "" battery -- ' bat: battery_logger_output' wrapL :: String -> String -> Logger -> Logger wrapL l r = onLogger $ wrap l r -- | Make a logger's output constant width by padding with the given string, -- /even if the logger is/ @X (Nothing)@ /or/ @X (Just \"\")@. Useful to -- reduce visual noise as a title logger shrinks and grows, to use a fixed -- width for a logger that sometimes becomes Nothing, or even to create -- fancy spacers or character based art effects. -- -- It fills missing logger output with a repeated character like \".\", -- \":\" or pattern, like \" -.-\". The cycling padding string is reversed on -- the left of the logger output. This is mainly useful with AlignCenter. fixedWidthL :: Align -- ^ AlignCenter, AlignRight, or AlignLeft -> String -- ^ String to cycle to pad missing logger output -> Int -- ^ Fixed length to output (including invisible formatting characters) -> Logger -> Logger fixedWidthL a str n logger = do mbl <- logger let l = fromMaybe "" mbl case a of AlignCenter -> toL (take n $ padhalf l ++ l ++ cs) AlignRight -> toL (reverse (take n $ reverse l ++ cs)) _ -> toL (take n $ l ++ cs) where toL = return . Just cs = cycle str padhalf x = reverse $ take ((n - length x) `div` 2) cs -- | Create a \"spacer\" logger, e.g. @logSp 3 -- loggerizes \' \'@. -- For more complex \"spacers\", use 'fixedWidthL' with @return Nothing@. logSp :: Int -> Logger logSp n = return . Just . take n $ cycle " " -- | Pad a logger's output with a leading and trailing space, unless it -- is @X (Nothing)@ or @X (Just \"\")@. padL :: Logger -> Logger padL = onLogger pad -- | Limit a logger's length, adding \"...\" if truncated. shortenL :: Int -> Logger -> Logger shortenL = onLogger . shorten -- | Color a logger's output with dzen foreground and background colors. -- -- > dzenColorL "green" "#2A4C3F" battery dzenColorL :: String -> String -> Logger -> Logger dzenColorL fg bg = onLogger $ dzenColor fg bg -- | Color a logger's output with xmobar foreground and background colors. -- -- > xmobarColorL "#6A5ACD" "gray6" loadAverage xmobarColorL :: String -> String -> Logger -> Logger xmobarColorL fg bg = onLogger $ xmobarColor fg bg -- todo -- * dynamicLogXinerama logger? Or sorted onscreen Id's with "current" indicator? -- is logCurrent really useful at all? -- -- * ppVisible, etc. Resolve code dup. somehow. Refactor DynamicLog so can -- be used for regular PP stuff /and/ loggers? -- -- * fns for "ppExtras as a whole", combine loggers more nicely. -- -- * parsers to use with fixedWidthL to be smarter about invisible characters? xmonad-contrib-0.12/XMonad/Util/NamedScratchpad.hs0000644000000000000000000001655712636047674020263 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.NamedScratchpad -- Copyright : (c) Konstantin Sobolev -- License : BSD-style (see LICENSE) -- -- Maintainer : Konstantin Sobolev -- Stability : unstable -- Portability : unportable -- -- Named scratchpads that support several arbitrary applications at the same time. -- ----------------------------------------------------------------------------- module XMonad.Util.NamedScratchpad ( -- * Usage -- $usage NamedScratchpad(..), nonFloating, defaultFloating, customFloating, NamedScratchpads, namedScratchpadAction, allNamedScratchpadAction, namedScratchpadManageHook, namedScratchpadFilterOutWorkspace, namedScratchpadFilterOutWorkspacePP ) where import XMonad import XMonad.Hooks.ManageHelpers (doRectFloat) import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace) import XMonad.Hooks.DynamicLog (PP, ppSort) import Control.Monad (filterM) import Data.Maybe (listToMaybe) import qualified XMonad.StackSet as W -- $usage -- Allows to have several floating scratchpads running different applications. -- Bind a key to 'namedScratchpadSpawnAction'. -- Pressing it will spawn configured application, or bring it to the current -- workspace if it already exists. -- Pressing the key with the application on the current workspace will -- send it to a hidden workspace called @NSP@. -- -- If you already have a workspace called @NSP@, it will use that. -- @NSP@ will also appear in xmobar and dzen status bars. You can tweak your -- @dynamicLog@ settings to filter it out if you like. -- -- Create named scratchpads configuration in your xmonad.hs like this: -- -- > import XMonad.StackSet as W -- > import XMonad.ManageHook -- > import XMonad.Util.NamedScratchpad -- > -- > scratchpads = [ -- > -- run htop in xterm, find it by title, use default floating window placement -- > NS "htop" "xterm -e htop" (title =? "htop") defaultFloating , -- > -- > -- run stardict, find it by class name, place it in the floating window -- > -- 1/6 of screen width from the left, 1/6 of screen height -- > -- from the top, 2/3 of screen width by 2/3 of screen height -- > NS "stardict" "stardict" (className =? "Stardict") -- > (customFloating $ W.RationalRect (1/6) (1/6) (2/3) (2/3)) , -- > -- > -- run gvim, find by role, don't float -- > NS "notes" "gvim --role notes ~/notes.txt" (role =? "notes") nonFloating -- > ] where role = stringProperty "WM_WINDOW_ROLE" -- -- Add keybindings: -- -- > , ((modm .|. controlMask .|. shiftMask, xK_t), namedScratchpadAction scratchpads "htop") -- > , ((modm .|. controlMask .|. shiftMask, xK_s), namedScratchpadAction scratchpads "stardict") -- > , ((modm .|. controlMask .|. shiftMask, xK_n), namedScratchpadAction scratchpads "notes") -- -- ... and a manage hook: -- -- > , manageHook = namedScratchpadManageHook scratchpads -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings" -- -- | Single named scratchpad configuration data NamedScratchpad = NS { name :: String -- ^ Scratchpad name , cmd :: String -- ^ Command used to run application , query :: Query Bool -- ^ Query to find already running application , hook :: ManageHook -- ^ Manage hook called for application window, use it to define the placement. See @nonFloating@, @defaultFloating@ and @customFloating@ } -- | Manage hook that makes the window non-floating nonFloating :: ManageHook nonFloating = idHook -- | Manage hook that makes the window floating with the default placement defaultFloating :: ManageHook defaultFloating = doFloat -- | Manage hook that makes the window floating with custom placement customFloating :: W.RationalRect -> ManageHook customFloating = doRectFloat -- | Named scratchpads configuration type NamedScratchpads = [NamedScratchpad] -- | Finds named scratchpad configuration by name findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad findByName c s = listToMaybe $ filter ((s==) . name) c -- | Runs application which should appear in specified scratchpad runApplication :: NamedScratchpad -> X () runApplication = spawn . cmd -- | Action to pop up specified named scratchpad namedScratchpadAction :: NamedScratchpads -- ^ Named scratchpads configuration -> String -- ^ Scratchpad name -> X () namedScratchpadAction = someNamedScratchpadAction (\f ws -> f $ head ws) allNamedScratchpadAction :: NamedScratchpads -> String -> X () allNamedScratchpadAction = someNamedScratchpadAction mapM_ someNamedScratchpadAction :: ((Window -> X ()) -> [Window] -> X ()) -> NamedScratchpads -> String -> X () someNamedScratchpadAction f confs n | Just conf <- findByName confs n = withWindowSet $ \s -> do filterCurrent <- filterM (runQuery (query conf)) ((maybe [] W.integrate . W.stack . W.workspace . W.current) s) filterAll <- filterM (runQuery (query conf)) (W.allWindows s) case filterCurrent of [] -> do case filterAll of [] -> runApplication conf _ -> f (windows . W.shiftWin (W.currentTag s)) filterAll _ -> do if null (filter ((== scratchpadWorkspaceTag) . W.tag) (W.workspaces s)) then addHiddenWorkspace scratchpadWorkspaceTag else return () f (windows . W.shiftWin scratchpadWorkspaceTag) filterAll | otherwise = return () -- tag of the scratchpad workspace scratchpadWorkspaceTag :: String scratchpadWorkspaceTag = "NSP" -- | Manage hook to use with named scratchpads namedScratchpadManageHook :: NamedScratchpads -- ^ Named scratchpads configuration -> ManageHook namedScratchpadManageHook = composeAll . fmap (\c -> query c --> hook c) -- | Transforms a workspace list containing the NSP workspace into one that -- doesn't contain it. Intended for use with logHooks. namedScratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace] namedScratchpadFilterOutWorkspace = filter (\(W.Workspace tag _ _) -> tag /= scratchpadWorkspaceTag) -- | Transforms a pretty-printer into one not displaying the NSP workspace. -- -- A simple use could be: -- -- > logHook = dynamicLogWithPP . namedScratchpadFilterOutWorkspace $ def -- -- Here is another example, when using "XMonad.Layout.IndependentScreens". -- If you have handles @hLeft@ and @hRight@ for bars on the left and right screens, respectively, and @pp@ is a pretty-printer function that takes a handle, you could write -- -- > logHook = let log screen handle = dynamicLogWithPP . namedScratchpadFilterOutWorkspacePP . marshallPP screen . pp $ handle -- > in log 0 hLeft >> log 1 hRight namedScratchpadFilterOutWorkspacePP :: PP -> PP namedScratchpadFilterOutWorkspacePP pp = pp { ppSort = fmap (. namedScratchpadFilterOutWorkspace) (ppSort pp) } -- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20: xmonad-contrib-0.12/XMonad/Util/EZConfig.hs0000644000000000000000000006271312636047674016701 0ustar0000000000000000-------------------------------------------------------------------- -- | -- Module : XMonad.Util.EZConfig -- Copyright : Devin Mullins -- Brent Yorgey (key parsing) -- License : BSD3-style (see LICENSE) -- -- Maintainer : Devin Mullins -- -- Useful helper functions for amending the default configuration, and for -- parsing keybindings specified in a special (emacs-like) format. -- -- (See also "XMonad.Util.CustomKeys" in xmonad-contrib.) -- -------------------------------------------------------------------- module XMonad.Util.EZConfig ( -- * Usage -- $usage -- * Adding or removing keybindings additionalKeys, additionalKeysP, removeKeys, removeKeysP, additionalMouseBindings, removeMouseBindings, -- * Emacs-style keybinding specifications mkKeymap, checkKeymap, mkNamedKeymap, parseKey -- used by XMonad.Util.Paste ) where import XMonad import XMonad.Actions.Submap import XMonad.Util.NamedActions import qualified Data.Map as M import Data.List (foldl', sortBy, groupBy, nub) import Data.Ord (comparing) import Data.Maybe import Control.Arrow (first, (&&&)) import Text.ParserCombinators.ReadP -- $usage -- To use this module, first import it into your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Util.EZConfig -- -- Then, use one of the provided functions to modify your -- configuration. You can use 'additionalKeys', 'removeKeys', -- 'additionalMouseBindings', and 'removeMouseBindings' to easily add -- and remove keybindings or mouse bindings. You can use 'mkKeymap' -- to create a keymap using emacs-style keybinding specifications -- like @\"M-x\"@ instead of @(modMask, xK_x)@, or 'additionalKeysP' -- and 'removeKeysP' to easily add or remove emacs-style keybindings. -- If you use emacs-style keybindings, the 'checkKeymap' function is -- provided, suitable for adding to your 'startupHook', which can warn -- you of any parse errors or duplicate bindings in your keymap. -- -- For more information and usage examples, see the documentation -- provided with each exported function, and check the xmonad config -- archive () -- for some real examples of use. -- | -- Add or override keybindings from the existing set. Example use: -- -- > main = xmonad $ def { terminal = "urxvt" } -- > `additionalKeys` -- > [ ((mod1Mask, xK_m ), spawn "echo 'Hi, mom!' | dzen2 -p 4") -- > , ((mod1Mask, xK_BackSpace), withFocused hide) -- N.B. this is an absurd thing to do -- > ] -- -- This overrides the previous definition of mod-m. -- -- Note that, unlike in xmonad 0.4 and previous, you can't use modMask to refer -- to the modMask you configured earlier. You must specify mod1Mask (or -- whichever), or add your own @myModMask = mod1Mask@ line. additionalKeys :: XConfig a -> [((ButtonMask, KeySym), X ())] -> XConfig a additionalKeys conf keyList = conf { keys = \cnf -> M.union (M.fromList keyList) (keys conf cnf) } -- | Like 'additionalKeys', except using short @String@ key -- descriptors like @\"M-m\"@ instead of @(modMask, xK_m)@, as -- described in the documentation for 'mkKeymap'. For example: -- -- > main = xmonad $ def { terminal = "urxvt" } -- > `additionalKeysP` -- > [ ("M-m", spawn "echo 'Hi, mom!' | dzen2 -p 4") -- > , ("M-", withFocused hide) -- N.B. this is an absurd thing to do -- > ] additionalKeysP :: XConfig l -> [(String, X ())] -> XConfig l additionalKeysP conf keyList = conf { keys = \cnf -> M.union (mkKeymap cnf keyList) (keys conf cnf) } -- | -- Remove standard keybindings you're not using. Example use: -- -- > main = xmonad $ def { terminal = "urxvt" } -- > `removeKeys` [(mod1Mask .|. shiftMask, n) | n <- [xK_1 .. xK_9]] removeKeys :: XConfig a -> [(ButtonMask, KeySym)] -> XConfig a removeKeys conf keyList = conf { keys = \cnf -> keys conf cnf `M.difference` M.fromList (zip keyList $ repeat ()) } -- | Like 'removeKeys', except using short @String@ key descriptors -- like @\"M-m\"@ instead of @(modMask, xK_m)@, as described in the -- documentation for 'mkKeymap'. For example: -- -- > main = xmonad $ def { terminal = "urxvt" } -- > `removeKeysP` ["M-S-" ++ [n] | n <- ['1'..'9']] removeKeysP :: XConfig l -> [String] -> XConfig l removeKeysP conf keyList = conf { keys = \cnf -> keys conf cnf `M.difference` mkKeymap cnf (zip keyList $ repeat (return ())) } -- | Like 'additionalKeys', but for mouse bindings. additionalMouseBindings :: XConfig a -> [((ButtonMask, Button), Window -> X ())] -> XConfig a additionalMouseBindings conf mouseBindingsList = conf { mouseBindings = \cnf -> M.union (M.fromList mouseBindingsList) (mouseBindings conf cnf) } -- | Like 'removeKeys', but for mouse bindings. removeMouseBindings :: XConfig a -> [(ButtonMask, Button)] -> XConfig a removeMouseBindings conf mouseBindingList = conf { mouseBindings = \cnf -> mouseBindings conf cnf `M.difference` M.fromList (zip mouseBindingList $ repeat ()) } -------------------------------------------------------------- -- Keybinding parsing --------------------------------------- -------------------------------------------------------------- -- | Given a config (used to determine the proper modifier key to use) -- and a list of @(String, X ())@ pairs, create a key map by parsing -- the key sequence descriptions contained in the Strings. The key -- sequence descriptions are \"emacs-style\": @M-@, @C-@, @S-@, and -- @M\#-@ denote mod, control, shift, and mod1-mod5 (where @\#@ is -- replaced by the appropriate number) respectively. Note that if -- you want to make a keybinding using \'alt\' even though you use a -- different key (like the \'windows\' key) for \'mod\', you can use -- something like @\"M1-x\"@ for alt+x (check the output of @xmodmap@ -- to see which mod key \'alt\' is bound to). Some special keys can -- also be specified by enclosing their name in angle brackets. -- -- For example, @\"M-C-x\"@ denotes mod+ctrl+x; @\"S-\\"@ -- denotes shift-escape; @\"M1-C-\\"@ denotes alt+ctrl+delete -- (assuming alt is bound to mod1, which is common). -- -- Sequences of keys can also be specified by separating the key -- descriptions with spaces. For example, @\"M-x y \\"@ denotes the -- sequence of keys mod+x, y, down. Submaps (see -- "XMonad.Actions.Submap") will be automatically generated to -- correctly handle these cases. -- -- So, for example, a complete key map might be specified as -- -- > keys = \c -> mkKeymap c $ -- > [ ("M-S-", spawn $ terminal c) -- > , ("M-x w", spawn "xmessage 'woohoo!'") -- type mod+x then w to pop up 'woohoo!' -- > , ("M-x y", spawn "xmessage 'yay!'") -- type mod+x then y to pop up 'yay!' -- > , ("M-S-c", kill) -- > ] -- -- Alternatively, you can use 'additionalKeysP' to automatically -- create a keymap and add it to your config. -- -- Here is a complete list of supported special keys. Note that a few -- keys, such as the arrow keys, have synonyms. If there are other -- special keys you would like to see supported, feel free to submit a -- patch, or ask on the xmonad mailing list; adding special keys is -- quite simple. -- -- > -- > -- > -- > -- > -- > -- > -- > , -- > -- > -- > , -- > , -- > , -- > , -- > -- > -- > -- > -- > -- > -- > - -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > - -- -- Long list of multimedia keys. Please note that not all keys may be -- present in your particular setup although most likely they will do. -- -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -, - -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > -- > - -- > -- > -- > -- > mkKeymap :: XConfig l -> [(String, X ())] -> M.Map (KeyMask, KeySym) (X ()) mkKeymap c = M.fromList . mkSubmaps . readKeymap c mkNamedKeymap :: XConfig l -> [(String, NamedAction)] -> [((KeyMask, KeySym), NamedAction)] mkNamedKeymap c = mkNamedSubmaps . readKeymap c -- | Given a list of pairs of parsed key sequences and actions, -- group them into submaps in the appropriate way. mkNamedSubmaps :: [([(KeyMask, KeySym)], NamedAction)] -> [((KeyMask, KeySym), NamedAction)] mkNamedSubmaps = mkSubmaps' submapName mkSubmaps :: [ ([(KeyMask,KeySym)], X ()) ] -> [((KeyMask, KeySym), X ())] mkSubmaps = mkSubmaps' $ submap . M.fromList mkSubmaps' :: (Ord a) => ([(a, c)] -> c) -> [([a], c)] -> [(a, c)] mkSubmaps' subm binds = map combine gathered where gathered = groupBy fstKey . sortBy (comparing fst) $ binds combine [([k],act)] = (k,act) combine ks = (head . fst . head $ ks, subm . mkSubmaps' subm $ map (first tail) ks) fstKey = (==) `on` (head . fst) on :: (a -> a -> b) -> (c -> a) -> c -> c -> b op `on` f = \x y -> f x `op` f y -- | Given a configuration record and a list of (key sequence -- description, action) pairs, parse the key sequences into lists of -- @(KeyMask,KeySym)@ pairs. Key sequences which fail to parse will -- be ignored. readKeymap :: XConfig l -> [(String, t)] -> [([(KeyMask, KeySym)], t)] readKeymap c = mapMaybe (maybeKeys . first (readKeySequence c)) where maybeKeys (Nothing,_) = Nothing maybeKeys (Just k, act) = Just (k, act) -- | Parse a sequence of keys, returning Nothing if there is -- a parse failure (no parse, or ambiguous parse). readKeySequence :: XConfig l -> String -> Maybe [(KeyMask, KeySym)] readKeySequence c = listToMaybe . parses where parses = map fst . filter (null.snd) . readP_to_S (parseKeySequence c) -- | Parse a sequence of key combinations separated by spaces, e.g. -- @\"M-c x C-S-2\"@ (mod+c, x, ctrl+shift+2). parseKeySequence :: XConfig l -> ReadP [(KeyMask, KeySym)] parseKeySequence c = sepBy1 (parseKeyCombo c) (many1 $ char ' ') -- | Parse a modifier-key combination such as "M-C-s" (mod+ctrl+s). parseKeyCombo :: XConfig l -> ReadP (KeyMask, KeySym) parseKeyCombo c = do mods <- many (parseModifier c) k <- parseKey return (foldl' (.|.) 0 mods, k) -- | Parse a modifier: either M- (user-defined mod-key), -- C- (control), S- (shift), or M#- where # is an integer -- from 1 to 5 (mod1Mask through mod5Mask). parseModifier :: XConfig l -> ReadP KeyMask parseModifier c = (string "M-" >> return (modMask c)) +++ (string "C-" >> return controlMask) +++ (string "S-" >> return shiftMask) +++ do _ <- char 'M' n <- satisfy (`elem` ['1'..'5']) _ <- char '-' return $ indexMod (read [n] - 1) where indexMod = (!!) [mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask] -- | Parse an unmodified basic key, like @\"x\"@, @\"\"@, etc. parseKey :: ReadP KeySym parseKey = parseRegular +++ parseSpecial -- | Parse a regular key name (represented by itself). parseRegular :: ReadP KeySym parseRegular = choice [ char s >> return k | (s,k) <- zip ['!'..'~'] [xK_exclam..xK_asciitilde] ] -- | Parse a special key name (one enclosed in angle brackets). parseSpecial :: ReadP KeySym parseSpecial = do _ <- char '<' key <- choice [ string name >> return k | (name,k) <- keyNames ] _ <- char '>' return key -- | A list of all special key names and their associated KeySyms. keyNames :: [(String, KeySym)] keyNames = functionKeys ++ specialKeys ++ multimediaKeys -- | A list pairing function key descriptor strings (e.g. @\"\"@) with -- the associated KeySyms. functionKeys :: [(String, KeySym)] functionKeys = [ ('F' : show n, k) | (n,k) <- zip ([1..24] :: [Int]) [xK_F1..] ] -- | A list of special key names and their corresponding KeySyms. specialKeys :: [(String, KeySym)] specialKeys = [ ("Backspace" , xK_BackSpace) , ("Tab" , xK_Tab) , ("Return" , xK_Return) , ("Pause" , xK_Pause) , ("Scroll_lock", xK_Scroll_Lock) , ("Sys_Req" , xK_Sys_Req) , ("Print" , xK_Print) , ("Escape" , xK_Escape) , ("Esc" , xK_Escape) , ("Delete" , xK_Delete) , ("Home" , xK_Home) , ("Left" , xK_Left) , ("Up" , xK_Up) , ("Right" , xK_Right) , ("Down" , xK_Down) , ("L" , xK_Left) , ("U" , xK_Up) , ("R" , xK_Right) , ("D" , xK_Down) , ("Page_Up" , xK_Page_Up) , ("Page_Down" , xK_Page_Down) , ("End" , xK_End) , ("Insert" , xK_Insert) , ("Break" , xK_Break) , ("Space" , xK_space) , ("KP_Space" , xK_KP_Space) , ("KP_Tab" , xK_KP_Tab) , ("KP_Enter" , xK_KP_Enter) , ("KP_F1" , xK_KP_F1) , ("KP_F2" , xK_KP_F2) , ("KP_F3" , xK_KP_F3) , ("KP_F4" , xK_KP_F4) , ("KP_Home" , xK_KP_Home) , ("KP_Left" , xK_KP_Left) , ("KP_Up" , xK_KP_Up) , ("KP_Right" , xK_KP_Right) , ("KP_Down" , xK_KP_Down) , ("KP_Prior" , xK_KP_Prior) , ("KP_Page_Up" , xK_KP_Page_Up) , ("KP_Next" , xK_KP_Next) , ("KP_Page_Down", xK_KP_Page_Down) , ("KP_End" , xK_KP_End) , ("KP_Begin" , xK_KP_Begin) , ("KP_Insert" , xK_KP_Insert) , ("KP_Delete" , xK_KP_Delete) , ("KP_Equal" , xK_KP_Equal) , ("KP_Multiply", xK_KP_Multiply) , ("KP_Add" , xK_KP_Add) , ("KP_Separator", xK_KP_Separator) , ("KP_Subtract", xK_KP_Subtract) , ("KP_Decimal" , xK_KP_Decimal) , ("KP_Divide" , xK_KP_Divide) , ("KP_0" , xK_KP_0) , ("KP_1" , xK_KP_1) , ("KP_2" , xK_KP_2) , ("KP_3" , xK_KP_3) , ("KP_4" , xK_KP_4) , ("KP_5" , xK_KP_5) , ("KP_6" , xK_KP_6) , ("KP_7" , xK_KP_7) , ("KP_8" , xK_KP_8) , ("KP_9" , xK_KP_9) ] -- | List of multimedia keys. If X server does not know about some -- | keysym it's omitted from list. (stringToKeysym returns noSymbol in this case) multimediaKeys :: [(String, KeySym)] multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $ [ "XF86ModeLock" , "XF86MonBrightnessUp" , "XF86MonBrightnessDown" , "XF86KbdLightOnOff" , "XF86KbdBrightnessUp" , "XF86KbdBrightnessDown" , "XF86Standby" , "XF86AudioLowerVolume" , "XF86AudioMute" , "XF86AudioRaiseVolume" , "XF86AudioPlay" , "XF86AudioStop" , "XF86AudioPrev" , "XF86AudioNext" , "XF86HomePage" , "XF86Mail" , "XF86Start" , "XF86Search" , "XF86AudioRecord" , "XF86Calculator" , "XF86Memo" , "XF86ToDoList" , "XF86Calendar" , "XF86PowerDown" , "XF86ContrastAdjust" , "XF86RockerUp" , "XF86RockerDown" , "XF86RockerEnter" , "XF86Back" , "XF86Forward" , "XF86Stop" , "XF86Refresh" , "XF86PowerOff" , "XF86WakeUp" , "XF86Eject" , "XF86ScreenSaver" , "XF86WWW" , "XF86Sleep" , "XF86Favorites" , "XF86AudioPause" , "XF86AudioMedia" , "XF86MyComputer" , "XF86VendorHome" , "XF86LightBulb" , "XF86Shop" , "XF86History" , "XF86OpenURL" , "XF86AddFavorite" , "XF86HotLinks" , "XF86BrightnessAdjust" , "XF86Finance" , "XF86Community" , "XF86AudioRewind" , "XF86BackForward" , "XF86Launch0" , "XF86Launch1" , "XF86Launch2" , "XF86Launch3" , "XF86Launch4" , "XF86Launch5" , "XF86Launch6" , "XF86Launch7" , "XF86Launch8" , "XF86Launch9" , "XF86LaunchA" , "XF86LaunchB" , "XF86LaunchC" , "XF86LaunchD" , "XF86LaunchE" , "XF86LaunchF" , "XF86ApplicationLeft" , "XF86ApplicationRight" , "XF86Book" , "XF86CD" , "XF86Calculater" , "XF86Clear" , "XF86Close" , "XF86Copy" , "XF86Cut" , "XF86Display" , "XF86DOS" , "XF86Documents" , "XF86Excel" , "XF86Explorer" , "XF86Game" , "XF86Go" , "XF86iTouch" , "XF86LogOff" , "XF86Market" , "XF86Meeting" , "XF86MenuKB" , "XF86MenuPB" , "XF86MySites" , "XF86New" , "XF86News" , "XF86OfficeHome" , "XF86Open" , "XF86Option" , "XF86Paste" , "XF86Phone" , "XF86Q" , "XF86Reply" , "XF86Reload" , "XF86RotateWindows" , "XF86RotationPB" , "XF86RotationKB" , "XF86Save" , "XF86ScrollUp" , "XF86ScrollDown" , "XF86ScrollClick" , "XF86Send" , "XF86Spell" , "XF86SplitScreen" , "XF86Support" , "XF86TaskPane" , "XF86Terminal" , "XF86Tools" , "XF86Travel" , "XF86UserPB" , "XF86User1KB" , "XF86User2KB" , "XF86Video" , "XF86WheelButton" , "XF86Word" , "XF86Xfer" , "XF86ZoomIn" , "XF86ZoomOut" , "XF86Away" , "XF86Messenger" , "XF86WebCam" , "XF86MailForward" , "XF86Pictures" , "XF86Music" , "XF86TouchpadToggle" , "XF86AudioMicMute" , "XF86_Switch_VT_1" , "XF86_Switch_VT_2" , "XF86_Switch_VT_3" , "XF86_Switch_VT_4" , "XF86_Switch_VT_5" , "XF86_Switch_VT_6" , "XF86_Switch_VT_7" , "XF86_Switch_VT_8" , "XF86_Switch_VT_9" , "XF86_Switch_VT_10" , "XF86_Switch_VT_11" , "XF86_Switch_VT_12" , "XF86_Ungrab" , "XF86_ClearGrab" , "XF86_Next_VMode" , "XF86_Prev_VMode" ] -- | Given a configuration record and a list of (key sequence -- description, action) pairs, check the key sequence descriptions -- for validity, and warn the user (via a popup xmessage window) of -- any unparseable or duplicate key sequences. This function is -- appropriate for adding to your @startupHook@, and you are highly -- encouraged to do so; otherwise, duplicate or unparseable -- keybindings will be silently ignored. -- -- For example, you might do something like this: -- -- > main = xmonad $ myConfig -- > -- > myKeymap = [("S-M-c", kill), ...] -- > myConfig = def { -- > ... -- > keys = \c -> mkKeymap c myKeymap -- > startupHook = return () >> checkKeymap myConfig myKeymap -- > ... -- > } -- -- NOTE: the @return ()@ in the example above is very important! -- Otherwise, you might run into problems with infinite mutual -- recursion: the definition of myConfig depends on the definition of -- startupHook, which depends on the definition of myConfig, ... and -- so on. Actually, it's likely that the above example in particular -- would be OK without the @return ()@, but making @myKeymap@ take -- @myConfig@ as a parameter would definitely lead to -- problems. Believe me. It, uh, happened to my friend. In... a -- dream. Yeah. In any event, the @return () >>@ introduces enough -- laziness to break the deadlock. -- checkKeymap :: XConfig l -> [(String, a)] -> X () checkKeymap conf km = warn (doKeymapCheck conf km) where warn ([],[]) = return () warn (bad,dup) = spawn $ "xmessage 'Warning:\n" ++ msg "bad" bad ++ "\n" ++ msg "duplicate" dup ++ "'" msg _ [] = "" msg m xs = m ++ " keybindings detected: " ++ showBindings xs showBindings = unwords . map (("\""++) . (++"\"")) -- | Given a config and a list of (key sequence description, action) -- pairs, check the key sequence descriptions for validity, -- returning a list of unparseable key sequences, and a list of -- duplicate key sequences. doKeymapCheck :: XConfig l -> [(String,a)] -> ([String], [String]) doKeymapCheck conf km = (bad,dups) where ks = map ((readKeySequence conf &&& id) . fst) km bad = nub . map snd . filter (isNothing . fst) $ ks dups = map (snd . head) . filter ((>1) . length) . groupBy ((==) `on` fst) . sortBy (comparing fst) . map (first fromJust) . filter (isJust . fst) $ ks xmonad-contrib-0.12/XMonad/Util/Replace.hs0000644000000000000000000000764012636047674016606 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.Replace -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : Adam Vogt -- Stability : unstable -- Portability : unportable -- -- Implements a @--replace@ behavior outside of core. -- ----------------------------------------------------------------------------- -- refer to core patches: -- http://article.gmane.org/gmane.comp.lang.haskell.xmonad/8358 module XMonad.Util.Replace ( -- * Usage -- $usage replace -- * Notes -- $shortcomings -- ** Implementing a @--replace@ flag -- $getArgs ) where import XMonad import Data.Function import Control.Monad -- $usage -- You must run the 'replace' action before starting xmonad proper, this -- results in xmonad replacing the currently running WM regardless of the -- arguments it is run with: -- -- > import XMonad -- > import XMonad.Util.Replace -- > main = do -- > replace -- > xmonad $ def { .... } -- -- $shortcomings -- This doesn't seem to work for replacing WMs that have been started -- from within xmonad, such as with @'restart' "openbox" False@, but no other -- WMs that implements --replace manage this either. 'replace' works for -- replacing metacity when the full gnome-session is started at least. -- $getArgs -- You can use 'System.Environment.getArgs' to watch for an explicit -- @--replace@ flag: -- -- > import XMonad -- > import XMonad.Util.Replace (replace) -- > import Control.Monad (when) -- > import System.Environment (getArgs) -- > -- > main = do -- > args <- getArgs -- > when ("--replace" `elem` args) replace -- > xmonad $ def { .... } -- -- -- Note that your @~\/.xmonad/xmonad-$arch-$os@ binary is not run with the same -- flags as the @xmonad@ binary that calls it. You may be able to work around -- this by running your @~\/.xmonad/xmonad-$arch-$os@ binary directly, which is -- otherwise not recommended. -- | @replace@ must be run before xmonad starts to signals to compliant window -- managers that they must exit and let xmonad take over. replace :: IO () replace = do dpy <- openDisplay "" let dflt = defaultScreen dpy rootw <- rootWindow dpy dflt -- check for other WM wmSnAtom <- internAtom dpy ("WM_S" ++ (show dflt)) False currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom when (currentWmSnOwner /= 0) $ do putStrLn $ "Screen " ++ (show dflt) ++ " on display \"" ++ (displayString dpy) ++ "\" already has a window manager." -- prepare to receive destroyNotify for old WM selectInput dpy currentWmSnOwner structureNotifyMask -- create off-screen window netWmSnOwner <- allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes True set_event_mask attributes propertyChangeMask let screen = defaultScreenOfDisplay dpy let visual = defaultVisualOfScreen screen let attrmask = cWOverrideRedirect .|. cWEventMask createWindow dpy rootw (-100) (-100) 1 1 0 copyFromParent copyFromParent visual attrmask attributes -- try to acquire wmSnAtom, this should signal the old WM to terminate putStrLn $ "Replacing existing window manager..." xSetSelectionOwner dpy wmSnAtom netWmSnOwner currentTime -- SKIPPED: check if we acquired the selection -- SKIPPED: send client message indicating that we are now the WM -- wait for old WM to go away putStr $ "Waiting for other window manager to terminate... " fix $ \again -> do evt <- allocaXEvent $ \event -> do windowEvent dpy currentWmSnOwner structureNotifyMask event get_EventType event when (evt /= destroyNotify) again putStrLn $ "done" closeDisplay dpy xmonad-contrib-0.12/XMonad/Util/SpawnOnce.hs0000644000000000000000000000240312636047674017120 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Util.SpawnOnce -- Copyright : (c) Spencer Janssen 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : spencerjanssen@gmail.com -- Stability : unstable -- Portability : not portable -- -- A module for spawning a command once, and only once. Useful to start -- status bars and make session settings inside startupHook. -- ----------------------------------------------------------------------------- module XMonad.Util.SpawnOnce (spawnOnce) where import XMonad import Data.Set as Set import qualified XMonad.Util.ExtensibleState as XS import Control.Monad data SpawnOnce = SpawnOnce { unspawnOnce :: (Set String) } deriving (Read, Show, Typeable) instance ExtensionClass SpawnOnce where initialValue = SpawnOnce Set.empty extensionType = PersistentExtension -- | The first time 'spawnOnce' is executed on a particular command, that -- command is executed. Subsequent invocations for a command do nothing. spawnOnce :: String -> X () spawnOnce xs = do b <- XS.gets (Set.member xs . unspawnOnce) when (not b) $ do spawn xs XS.modify (SpawnOnce . Set.insert xs . unspawnOnce) xmonad-contrib-0.12/XMonad/Layout/0000755000000000000000000000000012636047674015230 5ustar0000000000000000xmonad-contrib-0.12/XMonad/Layout/SimpleFloat.hs0000644000000000000000000000546012636047674020010 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.SimpleFloat -- Copyright : (c) 2007 Andrea Rossato -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A basic floating layout. ----------------------------------------------------------------------------- module XMonad.Layout.SimpleFloat ( -- * Usage: -- $usage simpleFloat , simpleFloat' , SimpleDecoration (..) , SimpleFloat (..) , shrinkText, CustomShrink(CustomShrink) , Shrinker(..) ) where import XMonad import qualified XMonad.StackSet as S import XMonad.Actions.MouseResize import XMonad.Layout.Decoration import XMonad.Layout.SimpleDecoration import XMonad.Layout.WindowArranger -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.SimpleFloat -- -- Then edit your @layoutHook@ by adding the SimpleFloat layout: -- -- > myLayout = simpleFloat ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- | A simple floating layout where every window is placed according -- to the window's initial attributes. -- -- This version is decorated with the 'SimpleDecoration' style. simpleFloat :: Eq a => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a simpleFloat = decoration shrinkText def (Simple False) (mouseResize $ windowArrangeAll $ SF 20) -- | Same as 'simpleFloat', but with the possibility of setting a -- custom shrinker and a custom theme. simpleFloat' :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a simpleFloat' s c = decoration s c (Simple False) (mouseResize $ windowArrangeAll $ SF (decoHeight c)) data SimpleFloat a = SF Dimension deriving (Show, Read) instance LayoutClass SimpleFloat Window where description _ = "Float" doLayout (SF i) sc (S.Stack w l r) = do wrs <- mapM (getSize i sc) (w : reverse l ++ r) return (wrs, Nothing) getSize :: Dimension -> Rectangle -> Window -> X (Window,Rectangle) getSize i (Rectangle rx ry _ _) w = do d <- asks display bw <- asks (borderWidth . config) wa <- io $ getWindowAttributes d w let ny = ry + fi i x = max rx $ fi $ wa_x wa y = max ny $ fi $ wa_y wa wh = (fi $ wa_width wa) + (bw * 2) ht = (fi $ wa_height wa) + (bw * 2) return (w, Rectangle x y wh ht) xmonad-contrib-0.12/XMonad/Layout/Monitor.hs0000644000000000000000000001414612636047674017221 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Monitor -- Copyright : (c) Roman Cheplyaka -- License : BSD-style (see LICENSE) -- -- Maintainer : Roman Cheplyaka -- Stability : unstable -- Portability : unportable -- -- Layout modifier for displaying some window (monitor) above other windows. -- ----------------------------------------------------------------------------- module XMonad.Layout.Monitor ( -- * Usage -- $usage -- * Hints and issues -- $hints Monitor(..), monitor, Property(..), MonitorMessage(..), doHideIgnore, manageMonitor -- * TODO -- $todo ) where import XMonad import XMonad.Layout.LayoutModifier import XMonad.Util.WindowProperties import XMonad.Hooks.ManageHelpers (doHideIgnore) import XMonad.Hooks.FadeInactive (setOpacity) import Control.Monad -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Monitor -- -- Define 'Monitor' record. 'monitor' can be used as a template. At least 'prop' -- and 'rect' should be set here. Also consider setting 'persistent' to True. -- -- Minimal example: -- -- > myMonitor = monitor -- > { prop = ClassName "SomeClass" -- > , rect = Rectangle 0 0 40 20 -- rectangle 40x20 in upper left corner -- > } -- -- More interesting example: -- -- > clock = monitor { -- > -- Cairo-clock creates 2 windows with the same classname, thus also using title -- > prop = ClassName "Cairo-clock" `And` Title "MacSlow's Cairo-Clock" -- > -- rectangle 150x150 in lower right corner, assuming 1280x800 resolution -- > , rect = Rectangle (1280-150) (800-150) 150 150 -- > -- avoid flickering -- > , persistent = True -- > -- make the window transparent -- > , opacity = 0.6 -- > -- hide on start -- > , visible = False -- > -- assign it a name to be able to toggle it independently of others -- > , name = "clock" -- > } -- -- Add ManageHook to de-manage monitor windows and apply opacity settings. -- -- > manageHook = myManageHook <+> manageMonitor clock -- -- Apply layout modifier. -- -- > myLayout = ModifiedLayout clock $ tall ||| Full ||| ... -- -- After that, if there exists a window with specified properties, it will be -- displayed on top of all /tiled/ (not floated) windows on specified -- position. -- -- It's also useful to add some keybinding to toggle monitor visibility: -- -- > , ((mod1Mask, xK_u ), broadcastMessage ToggleMonitor >> refresh) -- -- Screenshot: data Monitor a = Monitor { prop :: Property -- ^ property which uniquely identifies monitor window , rect :: Rectangle -- ^ specifies where to put monitor , visible :: Bool -- ^ is it visible by default? , name :: String -- ^ name of monitor (useful when we have many of them) , persistent :: Bool -- ^ is it shown on all layouts? , opacity :: Rational -- ^ opacity level } deriving (Read, Show) -- | Template for 'Monitor' record. At least 'prop' and 'rect' should be -- redefined. Default settings: 'visible' is 'True', 'persistent' is 'False'. monitor :: Monitor a monitor = Monitor { prop = Const False , rect = Rectangle 0 0 0 0 , visible = True , name = "" , persistent = False , opacity = 1 } -- | Messages without names affect all monitors. Messages with names affect only -- monitors whose names match. data MonitorMessage = ToggleMonitor | ShowMonitor | HideMonitor | ToggleMonitorNamed String | ShowMonitorNamed String | HideMonitorNamed String deriving (Read,Show,Eq,Typeable) instance Message MonitorMessage withMonitor :: Property -> a -> (Window -> X a) -> X a withMonitor p a fn = do monitorWindows <- allWithProperty p case monitorWindows of [] -> return a w:_ -> fn w instance LayoutModifier Monitor Window where redoLayout mon _ _ rects = withMonitor (prop mon) (rects, Nothing) $ \w -> if visible mon then do tileWindow w (rect mon) reveal w return ((w,rect mon):rects, Nothing) else do hide w return (rects, Nothing) handleMess mon mess | Just ToggleMonitor <- fromMessage mess = return $ Just $ mon { visible = not $ visible mon } | Just (ToggleMonitorNamed n) <- fromMessage mess = return $ if name mon == n then Just $ mon { visible = not $ visible mon } else Nothing | Just ShowMonitor <- fromMessage mess = return $ Just $ mon { visible = True } | Just (ShowMonitorNamed n) <- fromMessage mess = return $ if name mon == n then Just $ mon { visible = True } else Nothing | Just HideMonitor <- fromMessage mess = return $ Just $ mon { visible = False } | Just (HideMonitorNamed n) <- fromMessage mess = return $ if name mon == n then Just $ mon { visible = False } else Nothing | Just Hide <- fromMessage mess = do unless (persistent mon) $ withMonitor (prop mon) () hide; return Nothing | otherwise = return Nothing -- | ManageHook which demanages monitor window and applies opacity settings. manageMonitor :: Monitor a -> ManageHook manageMonitor mon = propertyToQuery (prop mon) --> do w <- ask liftX $ setOpacity w $ opacity mon if persistent mon then doIgnore else doHideIgnore -- $hints -- - This module assumes that there is only one window satisfying property exists. -- -- - If your monitor is available on /all/ layouts, set -- 'persistent' to 'True' to avoid unnecessary -- flickering. You can still toggle monitor with a keybinding. -- -- - You can use several monitors with nested modifiers. Give them names --- to be able to toggle them independently. -- -- - You can display monitor only on specific workspaces with -- "XMonad.Layout.PerWorkspace". -- $todo -- - make Monitor remember the window it manages -- -- - specify position relative to the screen xmonad-contrib-0.12/XMonad/Layout/Gaps.hs0000644000000000000000000001357112636047674016465 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Gaps -- Copyright : (c) 2008 Brent Yorgey -- License : BSD3 -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Create manually-sized gaps along edges of the screen which will not -- be used for tiling, along with support for toggling gaps on and -- off. -- -- Note that "XMonad.Hooks.ManageDocks" is the preferred solution for -- leaving space for your dock-type applications (status bars, -- toolbars, docks, etc.), since it automatically sets up appropriate -- gaps, allows them to be toggled, etc. However, this module may -- still be useful in some situations where the automated approach of -- ManageDocks does not work; for example, to work with a dock-type -- application that does not properly set the STRUTS property, or to -- leave part of the screen blank which is truncated by a projector, -- and so on. ----------------------------------------------------------------------------- module XMonad.Layout.Gaps ( -- * Usage -- $usage Direction2D(..), Gaps, GapSpec, gaps, gaps', GapMessage(..) ) where import XMonad.Core import Graphics.X11 (Rectangle(..)) import XMonad.Layout.LayoutModifier import XMonad.Util.Types (Direction2D(..)) import XMonad.Util.XUtils (fi) import Data.List (delete) -- $usage -- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Layout.Gaps -- -- and applying the 'gaps' modifier to your layouts as follows (for -- example): -- -- > layoutHook = gaps [(U,18), (R,23)] $ Tall 1 (3/100) (1/2) ||| Full -- leave gaps at the top and right -- -- You can additionally add some keybindings to toggle or modify the gaps, -- for example: -- -- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps) -- toggle all gaps -- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap -- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap 5 R) -- increment the right-hand gap -- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap 5 R) -- decrement the right-hand gap -- -- If you want complete control over all gaps, you could include -- something like this in your keybindings, assuming in this case you -- are using 'XMonad.Util.EZConfig.mkKeymap' or -- 'XMonad.Util.EZConfig.additionalKeysP' from "XMonad.Util.EZConfig" -- for string keybinding specifications: -- -- > ++ -- > [ ("M-g " ++ f ++ " " ++ k, sendMessage $ m d) -- > | (k, d) <- [("a",L), ("s",D), ("w",U), ("d",R)] -- > , (f, m) <- [("v", ToggleGap), ("h", IncGap 10), ("f", DecGap 10)] -- > ] -- -- Given the above keybinding definition, for example, you could type -- @M-g, v, a@ to toggle the top gap. -- -- To configure gaps differently per-screen, use -- "XMonad.Layout.PerScreen" (coming soon). -- | A manual gap configuration. Each side of the screen on which a -- gap is enabled is paired with a size in pixels. type GapSpec = [(Direction2D,Int)] -- | The gap state. The first component is the configuration (which -- gaps are allowed, and their current size), the second is the gaps -- which are currently active. data Gaps a = Gaps GapSpec [Direction2D] deriving (Show, Read) -- | Messages which can be sent to a gap modifier. data GapMessage = ToggleGaps -- ^ Toggle all gaps. | ToggleGap !Direction2D -- ^ Toggle a single gap. | IncGap !Int !Direction2D -- ^ Increase a gap by a certain number of pixels. | DecGap !Int !Direction2D -- ^ Decrease a gap. deriving (Typeable) instance Message GapMessage instance LayoutModifier Gaps a where modifyLayout g w r = runLayout w (applyGaps g r) pureMess (Gaps conf cur) m | Just ToggleGaps <- fromMessage m = Just $ Gaps conf (toggleGaps conf cur) | Just (ToggleGap d) <- fromMessage m = Just $ Gaps conf (toggleGap conf cur d) | Just (IncGap i d) <- fromMessage m = Just $ Gaps (incGap conf d i) cur | Just (DecGap i d) <- fromMessage m = Just $ Gaps (incGap conf d (-i)) cur | otherwise = Nothing applyGaps :: Gaps a -> Rectangle -> Rectangle applyGaps gs r = foldr applyGap r (activeGaps gs) where applyGap (U,z) (Rectangle x y w h) = Rectangle x (y + fi z) w (h - fi z) applyGap (D,z) (Rectangle x y w h) = Rectangle x y w (h - fi z) applyGap (L,z) (Rectangle x y w h) = Rectangle (x + fi z) y (w - fi z) h applyGap (R,z) (Rectangle x y w h) = Rectangle x y (w - fi z) h activeGaps :: Gaps a -> GapSpec activeGaps (Gaps conf cur) = filter ((`elem` cur) . fst) conf toggleGaps :: GapSpec -> [Direction2D] -> [Direction2D] toggleGaps conf [] = map fst conf toggleGaps _ _ = [] toggleGap :: GapSpec -> [Direction2D] -> Direction2D -> [Direction2D] toggleGap conf cur d | d `elem` cur = delete d cur | d `elem` (map fst conf) = d:cur | otherwise = cur incGap :: GapSpec -> Direction2D -> Int -> GapSpec incGap gs d i = map (\(dir,j) -> if dir == d then (dir,max (j+i) 0) else (dir,j)) gs -- | Add togglable manual gaps to a layout. gaps :: GapSpec -- ^ The gaps to allow, paired with their initial sizes. -> l a -- ^ The layout to modify. -> ModifiedLayout Gaps l a gaps g = ModifiedLayout (Gaps g (map fst g)) -- | Add togglable manual gaps to a layout, explicitly specifying the initial states. gaps' :: [((Direction2D,Int),Bool)] -- ^ The gaps to allow and their initial states. -> l a -- ^ The layout to modify. -> ModifiedLayout Gaps l a gaps' g = ModifiedLayout (Gaps (map fst g) [d | ((d,_),v) <- g, v]) xmonad-contrib-0.12/XMonad/Layout/MosaicAlt.hs0000644000000000000000000001514312636047674017444 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.MosaicAlt -- Copyright : (c) 2007 James Webb -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : xmonad#jwebb,sygneca,com -- Stability : unstable -- Portability : unportable -- -- A layout which gives each window a specified amount of screen space -- relative to the others. Compared to the 'Mosaic' layout, this one -- divides the space in a more balanced way. -- ----------------------------------------------------------------------------- module XMonad.Layout.MosaicAlt ( -- * Usage: -- $usage MosaicAlt(..) , shrinkWindowAlt , expandWindowAlt , tallWindowAlt , wideWindowAlt , resetAlt , Params, Param , HandleWindowAlt ) where import XMonad import qualified XMonad.StackSet as W import qualified Data.Map as M import Data.List ( sortBy ) import Data.Ratio -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.MosaicAlt -- > import qualified Data.Map as M -- -- Then edit your @layoutHook@ by adding the MosaicAlt layout: -- -- > myLayout = MosaicAlt M.empty ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- In the key-bindings, do something like: -- -- > , ((modm .|. shiftMask , xK_a ), withFocused (sendMessage . expandWindowAlt)) -- > , ((modm .|. shiftMask , xK_z ), withFocused (sendMessage . shrinkWindowAlt)) -- > , ((modm .|. shiftMask , xK_s ), withFocused (sendMessage . tallWindowAlt)) -- > , ((modm .|. shiftMask , xK_d ), withFocused (sendMessage . wideWindowAlt)) -- > , ((modm .|. controlMask, xK_space), sendMessage resetAlt) -- > ... -- -- For detailed instruction on editing the key binding see: -- -- "XMonad.Doc.Extending#Editing_key_bindings". data HandleWindowAlt = ShrinkWindowAlt Window | ExpandWindowAlt Window | TallWindowAlt Window | WideWindowAlt Window | ResetAlt deriving ( Typeable, Eq ) instance Message HandleWindowAlt shrinkWindowAlt, expandWindowAlt :: Window -> HandleWindowAlt tallWindowAlt, wideWindowAlt :: Window -> HandleWindowAlt shrinkWindowAlt = ShrinkWindowAlt expandWindowAlt = ExpandWindowAlt tallWindowAlt = TallWindowAlt wideWindowAlt = WideWindowAlt resetAlt :: HandleWindowAlt resetAlt = ResetAlt data Param = Param { area, aspect :: Rational } deriving ( Show, Read ) type Params = M.Map Window Param data MosaicAlt a = MosaicAlt Params deriving ( Show, Read ) instance LayoutClass MosaicAlt Window where description _ = "MosaicAlt" doLayout (MosaicAlt params) rect stack = return (arrange rect stack params', Just $ MosaicAlt params') where params' = ins (W.up stack) $ ins (W.down stack) $ ins [W.focus stack] params ins wins as = foldl M.union as $ map (`M.singleton` (Param 1 1.5)) wins handleMessage (MosaicAlt params) msg = return $ case fromMessage msg of Just (ShrinkWindowAlt w) -> Just $ MosaicAlt $ alter params w (4 % 5) 1 Just (ExpandWindowAlt w) -> Just $ MosaicAlt $ alter params w (6 % 5) 1 Just (TallWindowAlt w) -> Just $ MosaicAlt $ alter params w 1 (3 % 4) Just (WideWindowAlt w) -> Just $ MosaicAlt $ alter params w 1 (5 % 4) Just ResetAlt -> Just $ MosaicAlt M.empty _ -> Nothing -- Change requested params for a window. alter :: Params -> Window -> Rational -> Rational -> Params alter params win arDelta asDelta = case M.lookup win params of Just (Param ar as) -> M.insert win (Param (ar * arDelta) (as * asDelta)) params Nothing -> M.insert win (Param arDelta (1.5 * asDelta)) params -- Layout algorithm entry point. arrange :: Rectangle -> W.Stack Window -> Params -> [(Window, Rectangle)] arrange rect stack params = r where (_, r) = findSplits 3 rect tree params tree = makeTree (sortBy areaCompare wins) params wins = reverse (W.up stack) ++ W.focus stack : W.down stack areaCompare a b = or1 b `compare` or1 a or1 w = maybe 1 area $ M.lookup w params -- Recursively group windows into a binary tree. Aim to balance the tree -- according to the total requested area in each branch. data Tree = Node (Rational, Tree) (Rational, Tree) | Leaf Window | None makeTree :: [Window] -> Params -> Tree makeTree wins params = case wins of [] -> None [x] -> Leaf x _ -> Node (aArea, makeTree aWins params) (bArea, makeTree bWins params) where ((aWins, aArea), (bWins, bArea)) = areaSplit params wins -- Split a list of windows in half by area. areaSplit :: Params -> [Window] -> (([Window], Rational), ([Window], Rational)) areaSplit params wins = gather [] 0 [] 0 wins where gather a aa b ba (r : rs) = if aa <= ba then gather (r : a) (aa + or1 r) b ba rs else gather a aa (r : b) (ba + or1 r) rs gather a aa b ba [] = ((reverse a, aa), (b, ba)) or1 w = maybe 1 area $ M.lookup w params -- Figure out which ways to split the space, by exhaustive search. -- Complexity is quadratic in the number of windows. findSplits :: Int -> Rectangle -> Tree -> Params -> (Double, [(Window, Rectangle)]) findSplits _ _ None _ = (0, []) findSplits _ rect (Leaf w) params = (aspectBadness rect w params, [(w, rect)]) findSplits depth rect (Node (aArea, aTree) (bArea, bTree)) params = if hBadness < vBadness then (hBadness, hList) else (vBadness, vList) where (hBadness, hList) = trySplit splitHorizontallyBy (vBadness, vList) = trySplit splitVerticallyBy trySplit splitBy = (aBadness + bBadness, aList ++ bList) where (aBadness, aList) = findSplits (depth - 1) aRect aTree params (bBadness, bList) = findSplits (depth - 1) bRect bTree params (aRect, bRect) = splitBy ratio rect ratio = aArea / (aArea + bArea) -- Decide how much we like this rectangle. aspectBadness :: Rectangle -> Window -> Params -> Double aspectBadness rect win params = (if a < 1 then tall else wide) * sqrt(w * h) where tall = if w < 700 then ((1 / a) * (700 / w)) else 1 / a wide = if w < 700 then a else (a * w / 700) a = (w / h) / fromRational (maybe 1.5 aspect $ M.lookup win params) w = fromIntegral $ rect_width rect h = fromIntegral $ rect_height rect -- vim: sw=4:et xmonad-contrib-0.12/XMonad/Layout/ToggleLayouts.hs0000644000000000000000000001072412636047674020372 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ToggleLayouts -- Copyright : (c) David Roundy -- License : BSD -- -- Maintainer : none -- Stability : unstable -- Portability : portable -- -- A module to toggle between two layouts. ----------------------------------------------------------------------------- module XMonad.Layout.ToggleLayouts ( -- * Usage -- $usage toggleLayouts, ToggleLayout(..), ToggleLayouts ) where import XMonad import XMonad.StackSet (Workspace (..)) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.ToggleLayouts -- -- Then edit your @layoutHook@ by adding the ToggleLayouts layout: -- -- > myLayout = toggleLayouts Full (Tall 1 (3/100) (1/2)) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- To toggle between layouts add a key binding like -- -- > , ((modm .|. controlMask, xK_space), sendMessage ToggleLayout) -- -- or a key binding like -- -- > , ((modm .|. controlMask, xK_space), sendMessage (Toggle "Full")) -- -- For detailed instruction on editing the key binding see: -- -- "XMonad.Doc.Extending#Editing_key_bindings". data ToggleLayouts lt lf a = ToggleLayouts Bool (lt a) (lf a) deriving (Read,Show) data ToggleLayout = ToggleLayout | Toggle String deriving (Read,Show,Typeable) instance Message ToggleLayout toggleLayouts :: (LayoutClass lt a, LayoutClass lf a) => lt a -> lf a -> ToggleLayouts lt lf a toggleLayouts = ToggleLayouts False instance (LayoutClass lt a, LayoutClass lf a) => LayoutClass (ToggleLayouts lt lf) a where runLayout (Workspace i (ToggleLayouts True lt lf) ms) r = do (ws,mlt') <- runLayout (Workspace i lt ms) r return (ws,fmap (\lt' -> ToggleLayouts True lt' lf) mlt') runLayout (Workspace i (ToggleLayouts False lt lf) ms) r = do (ws,mlf') <- runLayout (Workspace i lf ms) r return (ws,fmap (\lf' -> ToggleLayouts False lt lf') mlf') description (ToggleLayouts True lt _) = description lt description (ToggleLayouts False _ lf) = description lf handleMessage (ToggleLayouts bool lt lf) m | Just ReleaseResources <- fromMessage m = do mlf' <- handleMessage lf m mlt' <- handleMessage lt m return $ case (mlt',mlf') of (Nothing ,Nothing ) -> Nothing (Just lt',Nothing ) -> Just $ ToggleLayouts bool lt' lf (Nothing ,Just lf') -> Just $ ToggleLayouts bool lt lf' (Just lt',Just lf') -> Just $ ToggleLayouts bool lt' lf' handleMessage (ToggleLayouts True lt lf) m | Just ToggleLayout <- fromMessage m = do mlt' <- handleMessage lt (SomeMessage Hide) let lt' = maybe lt id mlt' return $ Just $ ToggleLayouts False lt' lf | Just (Toggle d) <- fromMessage m, d == description lt || d == description lf = do mlt' <- handleMessage lt (SomeMessage Hide) let lt' = maybe lt id mlt' return $ Just $ ToggleLayouts False lt' lf | otherwise = do mlt' <- handleMessage lt m return $ fmap (\lt' -> ToggleLayouts True lt' lf) mlt' handleMessage (ToggleLayouts False lt lf) m | Just ToggleLayout <- fromMessage m = do mlf' <- handleMessage lf (SomeMessage Hide) let lf' = maybe lf id mlf' return $ Just $ ToggleLayouts True lt lf' | Just (Toggle d) <- fromMessage m, d == description lt || d == description lf = do mlf' <- handleMessage lf (SomeMessage Hide) let lf' = maybe lf id mlf' return $ Just $ ToggleLayouts True lt lf' | otherwise = do mlf' <- handleMessage lf m return $ fmap (\lf' -> ToggleLayouts False lt lf') mlf' xmonad-contrib-0.12/XMonad/Layout/Drawer.hs0000644000000000000000000001233112636047674017010 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Drawer -- Copyright : (c) 2009 Max Rabkin -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : max.rabkin@gmail.com -- Stability : unstable -- Portability : unportable -- -- A layout modifier that puts some windows in a "drawer" which retracts and -- expands depending on whether any window in it has focus. -- -- Useful for music players, tool palettes, etc. -- ----------------------------------------------------------------------------- module XMonad.Layout.Drawer ( -- * Usage -- $usage -- * Drawers simpleDrawer , drawer -- * Placing drawers -- The drawer can be placed on any side of the screen with these functions , onLeft, onTop, onRight, onBottom , module XMonad.Util.WindowProperties , Drawer, Reflected ) where import XMonad import XMonad.Layout.LayoutModifier import XMonad.Util.WindowProperties import XMonad.StackSet as S import XMonad.Layout.Reflect -- $usage -- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Drawer -- -- > myLayout = drawer `onTop` (Tall 1 0.03 0.5) ||| Full ||| RandomOtherLayout... -- > where -- > drawer = simpleDrawer 0.01 0.3 (ClassName "Rhythmbox" `Or` ClassName "Xchat") -- > -- > main = xmonad def { layoutHook = myLayout } -- -- This will place the Rhythmbox and Xchat windows in at the top of the screen -- only when using the 'Tall' layout. See "XMonad.Util.WindowProperties" for -- more information on selecting windows. data Drawer l a = Drawer Rational Rational Property (l a) deriving (Read, Show) -- | filter : filterM :: partition : partitionM partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a]) partitionM _ [] = return ([], []) partitionM f (x:xs) = do b <- f x (ys, zs) <- partitionM f xs return $ if b then (x:ys, zs) else (ys, x:zs) instance (LayoutClass l Window, Read (l Window)) => LayoutModifier (Drawer l) Window where modifyLayout (Drawer rs rb p l) ws rect = case stack ws of Nothing -> runLayout ws rect Just stk@(Stack { up=up_, down=down_, S.focus=w }) -> do (upD, upM) <- partitionM (hasProperty p) up_ (downD, downM) <- partitionM (hasProperty p) down_ b <- hasProperty p w focusedWindow <- gets (fmap S.focus . stack . workspace . current . windowset) let rectD = if b && Just w == focusedWindow then rectB else rectS let (stackD, stackM) = if b then ( Just $ stk { up=upD, down=downD } , mkStack upM downM ) else ( mkStack upD downD , Just $ stk { up=upM, down=downM } ) (winsD, _) <- runLayout (ws { layout=l, stack=stackD }) rectD (winsM, u') <- runLayout (ws { stack=stackM }) rectM return (winsD ++ winsM, u') where mkStack [] [] = Nothing mkStack xs (y:ys) = Just (Stack { up=xs, S.focus=y, down=ys }) mkStack (x:xs) ys = Just (Stack { up=xs, S.focus=x, down=ys }) rectB = rect { rect_width=round $ fromIntegral (rect_width rect) * rb } rectS = rectB { rect_x=rect_x rectB - (round $ (rb - rs) * fromIntegral (rect_width rect)) } rectM = rect { rect_x=rect_x rect + round (fromIntegral (rect_width rect) * rs) , rect_width=rect_width rect - round (fromIntegral (rect_width rect) * rs) } type Reflected l = ModifiedLayout Reflect l -- | Construct a drawer with a simple layout of the windows inside simpleDrawer :: Rational -- ^ The portion of the screen taken up by the drawer when closed -> Rational -- ^ The portion of the screen taken up by the drawer when open -> Property -- ^ Which windows to put in the drawer -> Drawer Tall a simpleDrawer rs rb p = Drawer rs rb p vertical where vertical = Tall 0 0 0 -- Export a synonym for the constructor as a Haddock workaround -- | Construct a drawer with an arbitrary layout for windows inside drawer :: Rational -- ^ The portion of the screen taken up by the drawer when closed -> Rational -- ^ The portion of the screen taken up by the drawer when open -> Property -- ^ Which windows to put in the drawer -> (l a) -- ^ The layout of windows in the drawer -> Drawer l a drawer = Drawer onLeft :: Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a onLeft = ModifiedLayout onRight :: Drawer l a -> l' a -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a onRight d = reflectHoriz . onLeft d . reflectHoriz onTop :: Drawer l a -> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a onTop d = Mirror . onLeft d . Mirror onBottom :: Drawer l a -> l' a -> Reflected (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a onBottom d = reflectVert . onTop d . reflectVert xmonad-contrib-0.12/XMonad/Layout/SimpleDecoration.hs0000644000000000000000000000451512636047674021032 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.SimpleDecoration -- Copyright : (c) 2007 Andrea Rossato -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A layout modifier for adding simple decorations to the windows of a -- given layout. The decorations are in the form of ion-like tabs -- for window titles. -- ----------------------------------------------------------------------------- module XMonad.Layout.SimpleDecoration ( -- * Usage: -- $usage simpleDeco , Theme (..) , def , defaultTheme , SimpleDecoration (..) , shrinkText, CustomShrink(CustomShrink) , Shrinker(..) ) where import XMonad import XMonad.Layout.Decoration -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.SimpleDecoration -- -- Then edit your @layoutHook@ by adding the SimpleDecoration decoration to -- your layout: -- -- > myL = simpleDeco shrinkText def (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- You can also edit the default configuration options. -- -- > mySDConfig = def { inactiveBorderColor = "red" -- > , inactiveTextColor = "red"} -- -- and -- -- > myL = dwmStyle shrinkText mySDConfig (layoutHook def) -- | Add simple decorations to windows of a layout. simpleDeco :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration SimpleDecoration s) l a simpleDeco s c = decoration s c $ Simple True data SimpleDecoration a = Simple Bool deriving (Show, Read) instance Eq a => DecorationStyle SimpleDecoration a where describeDeco _ = "Simple" shrink (Simple b) (Rectangle _ _ _ dh) r@(Rectangle x y w h) = if b then Rectangle x (y + fi dh) w (h - dh) else r pureDecoration (Simple b) wh ht _ s _ (w,Rectangle x y wid _) = if isInStack s w then if b then Just $ Rectangle x y nwh ht else Just $ Rectangle x (y - fi ht) nwh ht else Nothing where nwh = min wid wh xmonad-contrib-0.12/XMonad/Layout/FixedColumn.hs0000644000000000000000000000732012636047674020003 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.FixedColumn -- Copyright : (c) 2008 Justin Bogner -- License : BSD3-style (as xmonad) -- -- Maintainer : Justin Bogner -- Stability : unstable -- Portability : unportable -- -- A layout much like Tall, but using a multiple of a window's minimum -- resize amount instead of a percentage of screen to decide where to -- split. This is useful when you usually leave a text editor or -- terminal in the master pane and like it to be 80 columns wide. -- ----------------------------------------------------------------------------- module XMonad.Layout.FixedColumn ( -- * Usage -- $usage FixedColumn(..) ) where import Control.Monad (msum) import Data.Maybe (fromMaybe) import Graphics.X11.Xlib (Window, rect_width) import Graphics.X11.Xlib.Extras ( getWMNormalHints , getWindowAttributes , sh_base_size , sh_resize_inc , wa_border_width) import XMonad.Core (X, LayoutClass(..), fromMessage, io, withDisplay) import XMonad.Layout (Resize(..), IncMasterN(..), tile) import XMonad.StackSet as W -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.FixedColumn -- -- Then edit your @layoutHook@ by adding the FixedColumn layout: -- -- > myLayout = FixedColumn 1 20 80 10 ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- | A tiling mode based on preserving a nice fixed width -- window. Supports 'Shrink', 'Expand' and 'IncMasterN'. data FixedColumn a = FixedColumn !Int -- Number of windows in the master pane !Int -- Number to increment by when resizing !Int -- Default width of master pane !Int -- Column width for normal windows deriving (Read, Show) instance LayoutClass FixedColumn Window where doLayout (FixedColumn nmaster _ ncol fallback) r s = do fws <- mapM (widthCols fallback ncol) ws let frac = maximum (take nmaster fws) // rect_width r rs = tile frac r nmaster (length ws) return $ (zip ws rs, Nothing) where ws = W.integrate s x // y = fromIntegral x / fromIntegral y pureMessage (FixedColumn nmaster delta ncol fallback) m = msum [fmap resize (fromMessage m) ,fmap incmastern (fromMessage m)] where resize Shrink = FixedColumn nmaster delta (max 0 $ ncol - delta) fallback resize Expand = FixedColumn nmaster delta (ncol + delta) fallback incmastern (IncMasterN d) = FixedColumn (max 0 (nmaster+d)) delta ncol fallback description _ = "FixedColumn" -- | Determine the width of @w@ given that we would like it to be @n@ -- columns wide, using @inc@ as a resize increment for windows that -- don't have one widthCols :: Int -> Int -> Window -> X Int widthCols inc n w = withDisplay $ \d -> io $ do sh <- getWMNormalHints d w bw <- fmap (fromIntegral . wa_border_width) $ getWindowAttributes d w let widthHint f = f sh >>= return . fromIntegral . fst oneCol = fromMaybe inc $ widthHint sh_resize_inc base = fromMaybe 0 $ widthHint sh_base_size return $ 2 * bw + base + n * oneCol xmonad-contrib-0.12/XMonad/Layout/WindowArranger.hs0000644000000000000000000002215312636047674020520 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.WindowArranger -- Copyright : (c) Andrea Rossato 2007 -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- This is a pure layout modifier that will let you move and resize -- windows with the keyboard in any layout. ----------------------------------------------------------------------------- module XMonad.Layout.WindowArranger ( -- * Usage -- $usage windowArrange , windowArrangeAll , WindowArrangerMsg (..) , WindowArranger , memberFromList , listFromList , diff ) where import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.LayoutModifier import XMonad.Util.XUtils (fi) import Control.Arrow import Data.List -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.WindowArranger -- > myLayout = layoutHook def -- > main = xmonad def { layoutHook = windowArrange myLayout } -- -- or -- -- > main = xmonad def { layoutHook = windowArrangeAll myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- You may also want to define some key binding to move or resize -- windows. These are good defaults: -- -- > , ((modm .|. controlMask , xK_s ), sendMessage Arrange ) -- > , ((modm .|. controlMask .|. shiftMask, xK_s ), sendMessage DeArrange ) -- > , ((modm .|. controlMask , xK_Left ), sendMessage (MoveLeft 1)) -- > , ((modm .|. controlMask , xK_Right), sendMessage (MoveRight 1)) -- > , ((modm .|. controlMask , xK_Down ), sendMessage (MoveDown 1)) -- > , ((modm .|. controlMask , xK_Up ), sendMessage (MoveUp 1)) -- > , ((modm .|. shiftMask, xK_Left ), sendMessage (IncreaseLeft 1)) -- > , ((modm .|. shiftMask, xK_Right), sendMessage (IncreaseRight 1)) -- > , ((modm .|. shiftMask, xK_Down ), sendMessage (IncreaseDown 1)) -- > , ((modm .|. shiftMask, xK_Up ), sendMessage (IncreaseUp 1)) -- > , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage (DecreaseLeft 1)) -- > , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage (DecreaseRight 1)) -- > , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage (DecreaseDown 1)) -- > , ((modm .|. controlMask .|. shiftMask, xK_Up ), sendMessage (DecreaseUp 1)) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | A layout modifier to float the windows in a workspace windowArrange :: l a -> ModifiedLayout WindowArranger l a windowArrange = ModifiedLayout (WA True False []) -- | A layout modifier to float all the windows in a workspace windowArrangeAll :: l a -> ModifiedLayout WindowArranger l a windowArrangeAll = ModifiedLayout (WA True True []) data WindowArrangerMsg = DeArrange | Arrange | IncreaseLeft Int | IncreaseRight Int | IncreaseUp Int | IncreaseDown Int | DecreaseLeft Int | DecreaseRight Int | DecreaseUp Int | DecreaseDown Int | MoveLeft Int | MoveRight Int | MoveUp Int | MoveDown Int | SetGeometry Rectangle deriving ( Typeable ) instance Message WindowArrangerMsg data ArrangedWindow a = WR (a, Rectangle) | AWR (a, Rectangle) deriving (Read, Show) type ArrangeAll = Bool data WindowArranger a = WA Bool ArrangeAll [ArrangedWindow a] deriving (Read, Show) instance (Show a, Read a, Eq a) => LayoutModifier WindowArranger a where pureModifier (WA True b []) _ (Just _) wrs = arrangeWindows b wrs pureModifier (WA True b awrs) _ (Just (S.Stack w _ _)) wrs = curry process wrs awrs where wins = map fst *** map awrWin update (a,r) = mkNewAWRs b a *** removeAWRs r >>> uncurry (++) process = wins &&& id >>> first diff >>> uncurry update >>> replaceWR wrs >>> putOnTop w >>> map fromAWR &&& Just . WA True b pureModifier _ _ _ wrs = (wrs, Nothing) pureMess (WA True b (wr:wrs)) m -- increase the window's size | Just (IncreaseRight i) <- fm, (win, Rectangle x y w h) <- fa = res win x y (w + fi i) h | Just (IncreaseLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win (x - fi i) y (w + fi i) h | Just (IncreaseUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y - fi i) w (h + fi i) | Just (IncreaseDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x y w (h + fi i) -- decrease the window's size | Just (DecreaseRight i) <- fm, (win, Rectangle x y w h) <- fa = res win (x + fi i) y (chk w i) h | Just (DecreaseLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win x y (chk w i) h | Just (DecreaseUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x y w (chk h i) | Just (DecreaseDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y + fi i) w (chk h i) --move the window around | Just (MoveRight i) <- fm, (win, Rectangle x y w h) <- fa = res win (x + fi i) y w h | Just (MoveLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win (x - fi i) y w h | Just (MoveUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y - fi i) w h | Just (MoveDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y + fi i) w h where res wi x y w h = Just . WA True b $ AWR (wi,Rectangle x y w h):wrs fm = fromMessage m fa = fromAWR wr chk x y = fi $ max 1 (fi x - y) pureMess (WA t b (wr:wrs)) m | Just (SetGeometry r) <- fromMessage m, (w,_) <- fromAWR wr = Just . WA t b $ AWR (w,r):wrs pureMess (WA _ b l) m | Just DeArrange <- fromMessage m = Just $ WA False b l | Just Arrange <- fromMessage m = Just $ WA True b l | otherwise = Nothing arrangeWindows :: ArrangeAll -> [(a,Rectangle)] -> ([(a, Rectangle)], Maybe (WindowArranger a)) arrangeWindows b wrs = (wrs, Just $ WA True b (map t wrs)) where t = if b then AWR else WR fromAWR :: ArrangedWindow a -> (a, Rectangle) fromAWR (WR x) = x fromAWR (AWR x) = x awrWin :: ArrangedWindow a -> a awrWin = fst . fromAWR getAWR :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a] getAWR = memberFromList awrWin (==) getWR :: Eq a => a -> [(a,Rectangle)] -> [(a,Rectangle)] getWR = memberFromList fst (==) mkNewAWRs :: Eq a => ArrangeAll -> [a] -> [(a,Rectangle)] -> [ArrangedWindow a] mkNewAWRs b w wrs = map t . concatMap (flip getWR wrs) $ w where t = if b then AWR else WR removeAWRs :: Eq a => [a] -> [ArrangedWindow a] -> [ArrangedWindow a] removeAWRs = listFromList awrWin notElem putOnTop :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a] putOnTop w awrs = awr ++ nawrs where awr = getAWR w awrs nawrs = filter ((/=w) . awrWin) awrs replaceWR :: Eq a => [(a, Rectangle)] -> [ArrangedWindow a] -> [ArrangedWindow a] replaceWR wrs = foldr r [] where r x xs | WR wr <- x = case fst wr `elemIndex` map fst wrs of Just i -> (WR $ wrs !! i):xs Nothing -> x:xs | otherwise = x:xs -- | Given a function to be applied to each member of a list, and a -- function to check a condition by processing this transformed member -- with the members of a list, you get the list of members that -- satisfy the condition. listFromList :: (b -> c) -> (c -> [a] -> Bool) -> [a] -> [b] -> [b] listFromList f g l = foldr (h l) [] where h x y ys = if g (f y) x then y:ys else ys -- | Given a function to be applied to each member of ta list, and a -- function to check a condition by processing this transformed member -- with something, you get the first member that satisfy the condition, -- or an empty list. memberFromList :: (b -> c) -> (c -> a -> Bool) -> a -> [b] -> [b] memberFromList f g l = foldr (h l) [] where h x y ys = if g (f y) x then [y] else ys -- | Get the list of elements to be deleted and the list of elements to -- be added to the first list in order to get the second list. diff :: Eq a => ([a],[a]) -> ([a],[a]) diff (x,y) = (x \\ y, y \\ x) xmonad-contrib-0.12/XMonad/Layout/ResizeScreen.hs0000644000000000000000000000545012636047674020171 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ResizeScreen -- Copyright : (c) 2007 Andrea Rossato -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A layout transformer to have a layout respect a given screen -- geometry. Mostly used with "Decoration" (the Horizontal and the -- Vertical version will react to SetTheme and change their dimension -- accordingly. ----------------------------------------------------------------------------- module XMonad.Layout.ResizeScreen ( -- * Usage: -- $usage resizeHorizontal, resizeVertical , resizeHorizontalRight, resizeVerticalBottom , withNewRectangle , ResizeScreen (..) , ResizeMode ) where import XMonad import XMonad.Layout.Decoration -- $usage -- You can use this module by importing it into your -- @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Layout.ResizeScreen -- -- and modifying your layoutHook as follows (for example): -- -- > layoutHook = resizeHorizontal 40 Full -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" resizeHorizontal :: Int -> l a -> ModifiedLayout ResizeScreen l a resizeHorizontal i = ModifiedLayout (ResizeScreen L i) resizeVertical :: Int -> l a -> ModifiedLayout ResizeScreen l a resizeVertical i = ModifiedLayout (ResizeScreen T i) resizeHorizontalRight :: Int -> l a -> ModifiedLayout ResizeScreen l a resizeHorizontalRight i = ModifiedLayout (ResizeScreen R i) resizeVerticalBottom :: Int -> l a -> ModifiedLayout ResizeScreen l a resizeVerticalBottom i = ModifiedLayout (ResizeScreen B i) withNewRectangle :: Rectangle -> l a -> ModifiedLayout ResizeScreen l a withNewRectangle r = ModifiedLayout (WithNewScreen r) data ResizeScreen a = ResizeScreen ResizeMode Int | WithNewScreen Rectangle deriving (Read, Show) data ResizeMode = T | B | L | R deriving (Read, Show) instance LayoutModifier ResizeScreen a where modifyLayout m ws rect@(Rectangle x y w h) | ResizeScreen L i <- m = resize $ Rectangle (x + fi i) y (w - fi i) h | ResizeScreen R i <- m = resize $ Rectangle x y (w - fi i) h | ResizeScreen T i <- m = resize $ Rectangle x (y + fi i) w (h - fi i) | ResizeScreen B i <- m = resize $ Rectangle x y w (h - fi i) | WithNewScreen r <- m = resize r | otherwise = resize rect where resize nr = runLayout ws nr pureMess (ResizeScreen d _) m | Just (SetTheme t) <- fromMessage m = Just $ ResizeScreen d (fi $ decoHeight t) pureMess _ _ = Nothing xmonad-contrib-0.12/XMonad/Layout/Combo.hs0000644000000000000000000001674512636047674016640 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Combo -- Copyright : (c) David Roundy -- License : BSD-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- A layout that combines multiple layouts. -- ----------------------------------------------------------------------------- module XMonad.Layout.Combo ( -- * Usage -- $usage combineTwo, CombineTwo ) where import Data.List ( delete, intersect, (\\) ) import Data.Maybe ( isJust ) import XMonad hiding (focus) import XMonad.StackSet ( integrate', Workspace (..), Stack(..) ) import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) ) import qualified XMonad.StackSet as W ( differentiate ) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Combo -- -- and add something like -- -- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) -- -- to your layouts. -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- combineTwo is a new simple layout combinator. It allows the -- combination of two layouts using a third to split the screen -- between the two, but has the advantage of allowing you to -- dynamically adjust the layout, in terms of the number of windows in -- each sublayout. To do this, use "XMonad.Layout.WindowNavigation", -- and add the following key bindings (or something similar): -- -- > , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) -- > , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L) -- > , ((modm .|. controlMask .|. shiftMask, xK_Up ), sendMessage $ Move U) -- > , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D) -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". -- -- These bindings will move a window into the sublayout that is -- up\/down\/left\/right of its current position. Note that there is some -- weirdness in combineTwo, in that the mod-tab focus order is not very closely -- related to the layout order. This is because we're forced to keep track of -- the window positions separately, and this is ugly. If you don't like this, -- lobby for hierarchical stacks in core xmonad or go reimplement the core of -- xmonad yourself. data CombineTwo l l1 l2 a = C2 [a] [a] l (l1 a) (l2 a) deriving (Read, Show) combineTwo :: (Read a, Eq a, LayoutClass super (), LayoutClass l1 a, LayoutClass l2 a) => super () -> l1 a -> l2 a -> CombineTwo (super ()) l1 l2 a combineTwo = C2 [] [] instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutClass (CombineTwo (l ()) l1 l2) a where runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = arrange (integrate' s) where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources) l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources) super' <- maybe super id `fmap` handleMessage super (SomeMessage ReleaseResources) return ([], Just $ C2 [] [] super' l1' l2') arrange [w] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources) l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources) super' <- maybe super id `fmap` handleMessage super (SomeMessage ReleaseResources) return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2') arrange origws = do let w2' = case origws `intersect` w2 of [] -> [head origws] [x] -> [x] x -> case origws \\ x of [] -> init x _ -> x superstack = Stack { focus=(), up=[], down=[()] } s1 = differentiate f' (origws \\ w2') s2 = differentiate f' w2' f' = case s of (Just s') -> focus s':delete (focus s') f Nothing -> f ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super (Just superstack)) rinput (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1 (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2 return (wrs1++wrs2, Just $ C2 f' w2' (maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2')) handleMessage (C2 f ws2 super l1 l2) m | Just (MoveWindowToWindow w1 w2) <- fromMessage m, w1 `notElem` ws2, w2 `elem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m l2' <- maybe l2 id `fmap` handleMessage l2 m return $ Just $ C2 f (w1:ws2) super l1' l2' | Just (MoveWindowToWindow w1 w2) <- fromMessage m, w1 `elem` ws2, w2 `notElem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m l2' <- maybe l2 id `fmap` handleMessage l2 m let ws2' = case delete w1 ws2 of [] -> [w2] x -> x return $ Just $ C2 f ws2' super l1' l2' | otherwise = do ml1' <- broadcastPrivate m [l1] ml2' <- broadcastPrivate m [l2] msuper' <- broadcastPrivate m [super] if isJust msuper' || isJust ml1' || isJust ml2' then return $ Just $ C2 f ws2 (maybe super head msuper') (maybe l1 head ml1') (maybe l2 head ml2') else return Nothing description (C2 _ _ super l1 l2) = "combining "++ description l1 ++" and "++ description l2 ++" with "++ description super differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q) differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z , up = reverse $ takeWhile (/=z) xs , down = tail $ dropWhile (/=z) xs } | otherwise = differentiate zs xs differentiate [] xs = W.differentiate xs broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b]) broadcastPrivate a ol = do nml <- mapM f ol if any isJust nml then return $ Just $ zipWith ((flip maybe) id) ol nml else return Nothing where f l = handleMessage l a `catchX` return Nothing xmonad-contrib-0.12/XMonad/Layout/ShowWName.hs0000644000000000000000000000761712636047674017447 0ustar0000000000000000{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ShowWName -- Copyright : (c) Andrea Rossato 2007 -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- This is a layout modifier that will show the workspace name ----------------------------------------------------------------------------- module XMonad.Layout.ShowWName ( -- * Usage -- $usage showWName , showWName' , def , defaultSWNConfig , SWNConfig(..) , ShowWName ) where import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.LayoutModifier import XMonad.Util.Font import XMonad.Util.Timer import XMonad.Util.XUtils -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.ShowWName -- > myLayout = layoutHook def -- > main = xmonad def { layoutHook = showWName myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- | A layout modifier to show the workspace name when switching showWName :: l a -> ModifiedLayout ShowWName l a showWName = ModifiedLayout (SWN True def Nothing) -- | A layout modifier to show the workspace name when switching. It -- is possible to provide a custom configuration. showWName' :: SWNConfig -> l a -> ModifiedLayout ShowWName l a showWName' c = ModifiedLayout (SWN True c Nothing) type ShowWNState = Maybe (TimerId, Window) data ShowWName a = SWN Bool SWNConfig ShowWNState deriving (Read, Show) data SWNConfig = SWNC { swn_font :: String -- ^ Font name , swn_bgcolor :: String -- ^ Background color , swn_color :: String -- ^ String color , swn_fade :: Rational -- ^ Time in seconds of the name visibility } deriving (Read, Show) instance Default SWNConfig where def = SWNC { swn_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*" , swn_bgcolor = "black" , swn_color = "white" , swn_fade = 1 } {-# DEPRECATED defaultSWNConfig "Use def (from Data.Default, and re-exported from XMonad.Layout.ShowWName) instead." #-} defaultSWNConfig :: SWNConfig defaultSWNConfig = def instance LayoutModifier ShowWName a where redoLayout sn r _ wrs = doShow sn r wrs handleMess (SWN _ c (Just (i,w))) m | Just e <- fromMessage m = handleTimer i e (deleteWindow w >> return Nothing) | Just Hide <- fromMessage m = do deleteWindow w return . Just $ SWN True c Nothing handleMess (SWN _ c s) m | Just Hide <- fromMessage m = return . Just $ SWN True c s | otherwise = return Nothing doShow :: ShowWName a -> Rectangle -> [(a,Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a)) doShow (SWN True c (Just (_,w))) r wrs = deleteWindow w >> flashName c r wrs doShow (SWN True c Nothing ) r wrs = flashName c r wrs doShow (SWN False _ _ ) _ wrs = return (wrs, Nothing) flashName :: SWNConfig -> Rectangle -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a)) flashName c (Rectangle sx sy wh ht) wrs = do d <- asks display n <- withWindowSet (return . S.currentTag) f <- initXMF (swn_font c) width <- fmap (\w -> w + w `div` length n) $ textWidthXMF d f n (as,ds) <- textExtentsXMF f n let hight = as + ds y = fi sy + (fi ht - hight + 2) `div` 2 x = fi sx + (fi wh - width + 2) `div` 2 w <- createNewWindow (Rectangle (fi x) (fi y) (fi width) (fi hight)) Nothing "" True showWindow w paintAndWrite w f (fi width) (fi hight) 0 (swn_bgcolor c) "" (swn_color c) (swn_bgcolor c) [AlignCenter] [n] releaseXMF f i <- startTimer (swn_fade c) return (wrs, Just $ SWN False c $ Just (i,w)) xmonad-contrib-0.12/XMonad/Layout/LayoutBuilderP.hs0000644000000000000000000002250512636047674020474 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LayoutBuilderP -- Copyright : (c) 2009 Anders Engstrom , 2011 Ilya Portnov -- License : BSD3-style (see LICENSE) -- -- Maintainer : Ilya Portnov -- Stability : unstable -- Portability : unportable -- -- A layout combinator that sends windows matching given predicate to one rectangle -- and the rest to another. -- ----------------------------------------------------------------------------- module XMonad.Layout.LayoutBuilderP ( LayoutP (..), layoutP, layoutAll, B.relBox, B.absBox, -- * Overloading ways to select windows -- $selectWin Predicate (..), Proxy(..), ) where import Control.Monad import Data.Maybe (isJust) import XMonad import qualified XMonad.StackSet as W import XMonad.Util.WindowProperties import qualified XMonad.Layout.LayoutBuilder as B -- $selectWin -- -- 'Predicate' exists because layouts are required to be serializable, and -- "XMonad.Util.WindowProperties" is not sufficient (for example it does not -- allow using regular expressions). -- -- compare "XMonad.Util.Invisible" -- | Type class for predicates. This enables us to manage not only Windows, -- but any objects, for which instance Predicate is defined. -- -- Another instance exists in XMonad.Util.WindowPropertiesRE in xmonad-extras class Predicate p w where alwaysTrue :: Proxy w -> p -- ^ A predicate that is always True. checkPredicate :: p -> w -> X Bool -- ^ Check if given object (window or smth else) matches that predicate -- | Contains no actual data, but is needed to help select the correct instance -- of 'Predicate' data Proxy a = Proxy -- | Data type for our layout. data LayoutP p l1 l2 a = LayoutP (Maybe a) (Maybe a) p B.SubBox (Maybe B.SubBox) (l1 a) (Maybe (l2 a)) deriving (Show,Read) -- | Use the specified layout in the described area windows that match given predicate and send the rest of the windows to the next layout in the chain. -- It is possible to supply an alternative area that will then be used instead, if there are no windows to send to the next layout. layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a) => p -> B.SubBox -- ^ The box to place the windows in -> Maybe B.SubBox -- ^ Possibly an alternative box that is used when this layout handles all windows that are left -> l1 a -- ^ The layout to use in the specified area -> LayoutP p l2 l3 a -- ^ Where to send the remaining windows -> LayoutP p l1 (LayoutP p l2 l3) a -- ^ The resulting layout layoutP prop box mbox sub next = LayoutP Nothing Nothing prop box mbox sub (Just next) -- | Use the specified layout in the described area for all remaining windows. layoutAll :: forall l1 p a. (Read a, Eq a, LayoutClass l1 a, Predicate p a) => B.SubBox -- ^ The box to place the windows in -> l1 a -- ^ The layout to use in the specified area -> LayoutP p l1 Full a -- ^ The resulting layout layoutAll box sub = let a = alwaysTrue (Proxy :: Proxy a) in LayoutP Nothing Nothing a box Nothing sub Nothing instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p) => LayoutClass (LayoutP p l1 l2) w where -- | Update window locations. runLayout (W.Workspace _ (LayoutP subf nextf prop box mbox sub next) s) rect = do (subs,nexts,subf',nextf') <- splitStack s prop subf nextf let selBox = if isJust nextf' then box else maybe box id mbox (sublist,sub') <- handle sub subs $ calcArea selBox rect (nextlist,next') <- case next of Nothing -> return ([],Nothing) Just n -> do (res,l) <- handle n nexts rect return (res,Just l) return (sublist++nextlist, Just $ LayoutP subf' nextf' prop box mbox sub' next' ) where handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r l' <- return $ maybe l id ml return (res,l') -- | Propagate messages. handleMessage l m | Just (IncMasterN _) <- fromMessage m = sendFocus l m | Just (Shrink) <- fromMessage m = sendFocus l m | Just (Expand) <- fromMessage m = sendFocus l m | otherwise = sendBoth l m -- | Descriptive name for layout. description (LayoutP _ _ _ _ _ sub (Just next)) = "layoutP "++ description sub ++" "++ description next description (LayoutP _ _ _ _ _ sub Nothing) = "layoutP "++ description sub sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) sendSub (LayoutP subf nextf prop box mbox sub next) m = do sub' <- handleMessage sub m return $ if isJust sub' then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') next else Nothing sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) sendBoth l@(LayoutP _ _ _ _ _ _ Nothing) m = sendSub l m sendBoth (LayoutP subf nextf prop box mbox sub (Just next)) m = do sub' <- handleMessage sub m next' <- handleMessage next m return $ if isJust sub' || isJust next' then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') (Just $ maybe next id next') else Nothing sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) sendNext (LayoutP _ _ _ _ _ _ Nothing) _ = return Nothing sendNext (LayoutP subf nextf prop box mbox sub (Just next)) m = do next' <- handleMessage next m return $ if isJust next' then Just $ LayoutP subf nextf prop box mbox sub next' else Nothing sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a) => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a)) sendFocus l@(LayoutP subf _ _ _ _ _ _) m = do foc <- isFocus subf if foc then sendSub l m else sendNext l m isFocus :: (Show a) => Maybe a -> X Bool isFocus Nothing = return False isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset return $ maybe False (\s -> show w == (show $ W.focus s)) ms -- | Split given list of objects (i.e. windows) using predicate. splitBy :: (Predicate p w) => p -> [w] -> X ([w], [w]) splitBy prop ws = foldM step ([], []) ws where step (good, bad) w = do ok <- checkPredicate prop w return $ if ok then (w:good, bad) else (good, w:bad) splitStack :: (Predicate p w, Eq w) => Maybe (W.Stack w) -> p -> Maybe w -> Maybe w -> X (Maybe (W.Stack w),Maybe (W.Stack w),Maybe w,Maybe w) splitStack Nothing _ _ _ = return (Nothing,Nothing,Nothing,Nothing) splitStack (Just s) prop subf nextf = do let ws = W.integrate s (good, other) <- splitBy prop ws let subf' = foc good subf nextf' = foc other nextf return ( differentiate' subf' good , differentiate' nextf' other , subf' , nextf' ) where foc [] _ = Nothing foc l f = if W.focus s `elem` l then Just $ W.focus s else if maybe False (`elem` l) f then f else Just $ head l calcArea :: B.SubBox -> Rectangle -> Rectangle calcArea (B.SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height' where xpos' = calc False xpos $ rect_width rect ypos' = calc False ypos $ rect_height rect width' = calc True width $ rect_width rect - xpos' height' = calc True height $ rect_height rect - ypos' calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $ case val of B.Rel v -> floor $ v * fromIntegral tot B.Abs v -> if v<0 || (zneg && v==0) then (fromIntegral tot)+v else v differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q) differentiate' _ [] = Nothing differentiate' Nothing w = W.differentiate w differentiate' (Just f) w | f `elem` w = Just $ W.Stack { W.focus = f , W.up = reverse $ takeWhile (/=f) w , W.down = tail $ dropWhile (/=f) w } | otherwise = W.differentiate w instance Predicate Property Window where alwaysTrue _ = Const True checkPredicate = hasProperty xmonad-contrib-0.12/XMonad/Layout/DecorationMadness.hs0000644000000000000000000006524612636047674021203 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DecorationMadness -- Copyright : (c) 2007 Andrea Rossato -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A collection of decorated layouts: some of them may be nice, some -- usable, others just funny. ----------------------------------------------------------------------------- module XMonad.Layout.DecorationMadness ( -- * Usage -- $usage -- * Decorated layouts based on Circle -- $circle circleSimpleDefault , circleDefault , circleSimpleDefaultResizable , circleDefaultResizable , circleSimpleDeco , circleSimpleDecoResizable , circleDeco , circleDecoResizable , circleSimpleDwmStyle , circleDwmStyle , circleSimpleTabbed , circleTabbed -- * Decorated layouts based on Accordion -- $accordion , accordionSimpleDefault , accordionDefault , accordionSimpleDefaultResizable , accordionDefaultResizable , accordionSimpleDeco , accordionSimpleDecoResizable , accordionDeco , accordionDecoResizable , accordionSimpleDwmStyle , accordionDwmStyle , accordionSimpleTabbed , accordionTabbed -- * Tall decorated layouts -- $tall , tallSimpleDefault , tallDefault , tallSimpleDefaultResizable , tallDefaultResizable , tallSimpleDeco , tallDeco , tallSimpleDecoResizable , tallDecoResizable , tallSimpleDwmStyle , tallDwmStyle , tallSimpleTabbed , tallTabbed -- * Mirror Tall decorated layouts -- $mirror , mirrorTallSimpleDefault , mirrorTallDefault , mirrorTallSimpleDefaultResizable , mirrorTallDefaultResizable , mirrorTallSimpleDeco , mirrorTallDeco , mirrorTallSimpleDecoResizable , mirrorTallDecoResizable , mirrorTallSimpleDwmStyle , mirrorTallDwmStyle , mirrorTallSimpleTabbed , mirrorTallTabbed -- * Floating decorated layouts -- $float , floatSimpleSimple , floatSimple , floatSimpleDefault , floatDefault , floatSimpleDwmStyle , floatDwmStyle , floatSimpleTabbed , floatTabbed , def, defaultTheme, shrinkText ) where import XMonad import XMonad.Actions.MouseResize import XMonad.Layout.Decoration import XMonad.Layout.DwmStyle import XMonad.Layout.SimpleDecoration import XMonad.Layout.TabBarDecoration import XMonad.Layout.Accordion import XMonad.Layout.Circle import XMonad.Layout.WindowArranger import XMonad.Layout.SimpleFloat -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.DecorationMadness -- -- Then edit your @layoutHook@ by adding the layout you want: -- -- > main = xmonad def { layoutHook = someMadLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- You can also edit the default theme: -- -- > myTheme = def { inactiveBorderColor = "#FF0000" -- > , activeTextColor = "#00FF00" } -- -- and -- -- > mylayout = tabbed shrinkText myTheme ||| Full ||| etc.. -- -- When a layout is resizable, this means two different things: you -- can grab a window's decoration with the pointer and move it around, -- and you can move and resize windows with the keyboard. For setting -- up the key bindings, please read the documentation of -- "XMonad.Layout.WindowArranger" -- -- The default theme can be dynamically change with the xmonad theme -- selector. See "XMonad.Prompt.Theme". For more themes, look at -- "XMonad.Util.Themes" -- $circle -- Here you will find 'Circle' based decorated layouts. -- | A 'Circle' layout with the xmonad default decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Circle Window circleSimpleDefault = decoration shrinkText def DefaultDecoration Circle -- | Similar to 'circleSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. circleDefault :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) Circle Window circleDefault s t = decoration s t DefaultDecoration Circle -- | A 'Circle' layout with the xmonad simple decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Circle Window circleSimpleDeco = decoration shrinkText def (Simple True) Circle -- | Similar to 'circleSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. circleDeco :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) Circle Window circleDeco s t = decoration s t (Simple True) Circle -- | A 'Circle' layout with the xmonad default decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- -- Here you can find a screen shot: -- -- circleSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window circleSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange Circle) -- | Similar to 'circleSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. circleDefaultResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange Circle) -- | A 'Circle' layout with the xmonad simple decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- -- Here you can find a screen shot: -- -- circleSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window circleSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange Circle) -- | Similar to 'circleSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. circleDecoResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange Circle) -- | A 'Circle' layout with the xmonad DwmStyle decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Circle Window circleSimpleDwmStyle = decoration shrinkText def Dwm Circle -- | Similar to 'circleSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. circleDwmStyle :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DwmStyle s) Circle Window circleDwmStyle s t = decoration s t Dwm Circle -- | A 'Circle' layout with the xmonad tabbed decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- circleSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Circle) Window circleSimpleTabbed = simpleTabBar Circle -- | Similar to 'circleSimpleTabbed' but with the -- possibility of setting a custom shrinker and a custom theme. circleTabbed :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Circle) Window circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Circle) -- $accordion -- Here you will find decorated layouts based on the 'Accordion' -- layout. -- | An 'Accordion' layout with the xmonad default decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- accordionSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Accordion Window accordionSimpleDefault = decoration shrinkText def DefaultDecoration Accordion -- | Similar to 'accordionSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. accordionDefault :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) Accordion Window accordionDefault s t = decoration s t DefaultDecoration Accordion -- | An 'Accordion' layout with the xmonad simple decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- accordionSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Accordion Window accordionSimpleDeco = decoration shrinkText def (Simple True) Accordion -- | Similar to 'accordionSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. accordionDeco :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) Accordion Window accordionDeco s t = decoration s t (Simple True) Accordion -- | An 'Accordion' layout with the xmonad default decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. accordionSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window accordionSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange Accordion) -- | Similar to 'accordionSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. accordionDefaultResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window accordionDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange Accordion) -- | An 'Accordion' layout with the xmonad simple decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. accordionSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window accordionSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange Accordion) -- | Similar to 'accordionSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. accordionDecoResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window accordionDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange Accordion) -- | An 'Accordion' layout with the xmonad DwmStyle decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- accordionSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Accordion Window accordionSimpleDwmStyle = decoration shrinkText def Dwm Accordion -- | Similar to 'accordionSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. accordionDwmStyle :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DwmStyle s) Accordion Window accordionDwmStyle s t = decoration s t Dwm Accordion -- | An 'Accordion' layout with the xmonad tabbed decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- accordionSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Accordion) Window accordionSimpleTabbed = simpleTabBar Accordion -- | Similar to 'accordionSimpleTabbed' but with the -- possibility of setting a custom shrinker and a custom theme. accordionTabbed :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Accordion) Window accordionTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Accordion) -- $tall -- In this section you will find decorated layouts based on the -- 'Tall' layout. tall :: Tall Window tall = Tall 1 (3/100) (1/2) -- | A 'Tall' layout with the xmonad default decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- tallSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Tall Window tallSimpleDefault = decoration shrinkText def DefaultDecoration tall -- | Similar to 'tallSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. tallDefault :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) Tall Window tallDefault s t = decoration s t DefaultDecoration tall -- | A 'Tall' layout with the xmonad simple decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- tallSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Tall Window tallSimpleDeco = decoration shrinkText def (Simple True) tall -- | Similar to 'tallSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. tallDeco :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) Tall Window tallDeco s t = decoration s t (Simple True) tall -- | A 'Tall' layout with the xmonad default decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- -- Here you can find a screen shot: -- -- tallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window tallSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange tall) -- | Similar to 'tallSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. tallDefaultResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window tallDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange tall) -- | A 'Tall' layout with the xmonad simple decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- -- Here you can find a screen shot: -- -- tallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window tallSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange tall) -- | Similar to 'tallSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. tallDecoResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window tallDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange tall) -- | A 'Tall' layout with the xmonad DwmStyle decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- tallSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Tall Window tallSimpleDwmStyle = decoration shrinkText def Dwm tall -- | Similar to 'tallSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. tallDwmStyle :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DwmStyle s) Tall Window tallDwmStyle s t = decoration s t Dwm tall -- | A 'Tall' layout with the xmonad tabbed decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- tallSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Tall) Window tallSimpleTabbed = simpleTabBar tall -- | Similar to 'tallSimpleTabbed' but with the -- possibility of setting a custom shrinker and a custom theme. tallTabbed :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Tall) Window tallTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) tall) -- $mirror -- In this section you will find decorated layouts based on the -- 'Mirror' layout modifier applied to 'Tall'. mirrorTall :: Mirror Tall Window mirrorTall = Mirror tall -- | A 'Mirror Tall' layout with the xmonad default decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- mirrorTallSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (Mirror Tall) Window mirrorTallSimpleDefault = decoration shrinkText def DefaultDecoration mirrorTall -- | Similar to 'mirrorTallSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. mirrorTallDefault :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) (Mirror Tall) Window mirrorTallDefault s t = decoration s t DefaultDecoration mirrorTall -- | A 'Mirror Tall' layout with the xmonad simple decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- mirrorTallSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (Mirror Tall) Window mirrorTallSimpleDeco = decoration shrinkText def (Simple True) mirrorTall -- | Similar to 'mirrorTallSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. mirrorTallDeco :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (Mirror Tall) Window mirrorTallDeco s t = decoration s t (Simple True) mirrorTall -- | A 'Mirror Tall' layout with the xmonad default decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- -- Here you can find a screen shot: -- -- mirrorTallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window mirrorTallSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange mirrorTall) -- | Similar to 'mirrorTallSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. mirrorTallDefaultResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window mirrorTallDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange mirrorTall) -- | A 'Mirror Tall' layout with the xmonad simple decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- -- Here you can find a screen shot: -- -- mirrorTallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window mirrorTallSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange mirrorTall) -- | Similar to 'mirrorTallSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. mirrorTallDecoResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window mirrorTallDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange mirrorTall) -- | A 'Mirror Tall' layout with the xmonad DwmStyle decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- mirrorTallSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) (Mirror Tall) Window mirrorTallSimpleDwmStyle = decoration shrinkText def Dwm mirrorTall -- | Similar to 'mirrorTallSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. mirrorTallDwmStyle :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DwmStyle s) (Mirror Tall) Window mirrorTallDwmStyle s t = decoration s t Dwm mirrorTall -- | A 'Mirror Tall' layout with the xmonad tabbed decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- mirrorTallSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen (Mirror Tall)) Window mirrorTallSimpleTabbed = simpleTabBar mirrorTall -- | Similar to 'mirrorTallSimpleTabbed' but with the -- possibility of setting a custom shrinker and a custom theme. mirrorTallTabbed :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen (Mirror Tall)) Window mirrorTallTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) mirrorTall) -- $float -- Here you will find decorated layout based on the SimpleFloating -- layout -- | A simple floating layout where every window is placed according -- to the window's initial attributes. -- -- Here you can find a screen shot: -- -- floatSimpleSimple :: (Show a, Eq a) => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatSimpleSimple = simpleFloat floatSimple :: (Show a, Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatSimple = simpleFloat' -- | This version is decorated with the 'DefaultDecoration' style. -- -- Here you can find a screen shot: -- -- floatSimpleDefault :: (Show a, Eq a) => ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatSimpleDefault = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrangeAll $ SF 20) -- | Same as 'floatSimpleDefault', but with the possibility of setting a -- custom shrinker and a custom theme. floatDefault :: (Show a, Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatDefault s t = decoration s t DefaultDecoration (mouseResize $ windowArrangeAll $ SF (decoHeight t)) -- | This version is decorated with the 'DwmStyle'. Note that this is -- a keyboard only floating layout. -- -- Here you can find a screen shot: -- -- floatSimpleDwmStyle :: (Show a, Eq a) => ModifiedLayout (Decoration DwmStyle DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatSimpleDwmStyle = decoration shrinkText def Dwm (mouseResize $ windowArrangeAll $ SF 20) -- | Same as 'floatSimpleDwmStyle', but with the possibility of setting a -- custom shrinker and a custom theme. floatDwmStyle :: (Show a, Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration DwmStyle s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatDwmStyle s t = decoration s t Dwm (mouseResize $ windowArrangeAll $ SF (decoHeight t)) -- | This version is decorated with the 'TabbedDecoration' style. -- | Mouse dragging is somehow weird. -- -- Here you can find a screen shot: -- -- floatSimpleTabbed :: (Show a, Eq a) => ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatSimpleTabbed = tabBar shrinkText def Top (mouseResize $ windowArrangeAll $ SF 20) -- | Same as 'floatSimpleTabbed', but with the possibility of setting a -- custom shrinker and a custom theme. floatTabbed :: (Show a, Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a floatTabbed s t = tabBar s t Top (mouseResize $ windowArrangeAll $ SF (decoHeight t)) xmonad-contrib-0.12/XMonad/Layout/LayoutCombinators.hs0000644000000000000000000003063212636047674021246 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LayoutCombinators -- Copyright : (c) David Roundy -- License : BSD -- -- Maintainer : none -- Stability : unstable -- Portability : portable -- -- The "XMonad.Layout.LayoutCombinators" module provides combinators -- for easily combining multiple layouts into one composite layout, as -- well as a way to jump directly to any particular layout (say, with -- a keybinding) without having to cycle through other layouts to get -- to it. ----------------------------------------------------------------------------- module XMonad.Layout.LayoutCombinators ( -- * Usage -- $usage -- * Layout combinators -- $combine -- ** Combinators using DragPane vertical -- $dpv (*||*), (**||*),(***||*),(****||*),(***||**),(****||***) , (***||****),(*||****),(**||***),(*||***),(*||**) -- ** Combinators using DragPane horizontal -- $dph , (*//*), (**//*),(***//*),(****//*),(***//**),(****//***) , (***//****),(*//****),(**//***),(*//***),(*//**) -- ** Combinators using Tall (vertical) -- $tv , (*|*), (**|*),(***|*),(****|*),(***|**),(****|***) , (***|****),(*|****),(**|***),(*|***),(*|**) -- ** Combinators using Mirror Tall (horizontal) -- $mth , (*/*), (**/*),(***/*),(****/*),(***/**),(****/***) , (***/****),(*/****),(**/***),(*/***),(*/**) -- * New layout choice combinator and 'JumpToLayout' -- $jtl , (|||) , JumpToLayout(..) -- * Types , NewSelect ) where import Data.Maybe ( isJust, isNothing ) import XMonad hiding ((|||)) import XMonad.StackSet (Workspace (..)) import XMonad.Layout.Combo import XMonad.Layout.DragPane -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.LayoutCombinators hiding ( (|||) ) -- -- Then edit your @layoutHook@ to use the new layout combinators. For -- example: -- -- > myLayout = (Tall 1 (3/100) (1/2) *//* Full) ||| (Tall 1 (3/100) (1/2) ***||** Full) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the @layoutHook@ see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- To use the 'JumpToLayout' message, hide the normal @|||@ operator instead: -- -- > import XMonad hiding ( (|||) ) -- > import XMonad.Layout.LayoutCombinators -- -- If you import XMonad.Layout, you will need to hide it from there as well. -- Then bind some keys to a 'JumpToLayout' message: -- -- > , ((modm .|. controlMask, xK_f), sendMessage $ JumpToLayout "Full") -- jump directly to the Full layout -- -- See below for more detailed documentation. -- $combine -- Each of the following combinators combines two layouts into a -- single composite layout by splitting the screen into two regions, -- one governed by each layout. Asterisks in the combinator names -- denote the relative amount of screen space given to the respective -- layouts. For example, the '***||*' combinator gives three times as -- much space to the left-hand layout as to the right-hand layout. infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, **||***, *||***, *||**, *//*, **//*, ***//*, ****//*, ***//**, ****//***, ***//****, *//****, **//***, *//***, *//**, *|* , **|* , ***|* , ****|* , ***|** , ****|*** , ***|**** , *|**** , **|*** , *|*** , *|** , */* , **/* , ***/* , ****/* , ***/** , ****/*** , ***/**** , */**** , **/*** , */*** , */** -- $dpv -- These combinators combine two layouts using "XMonad.DragPane" in -- vertical mode. (*||*),(**||*),(***||*),(****||*), (***||**),(****||***), (***||****),(*||****),(**||***),(*||***),(*||**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a (*||*) = combineTwo (dragPane Vertical 0.1 (1/2)) (**||*) = combineTwo (dragPane Vertical 0.1 (2/3)) (***||*) = combineTwo (dragPane Vertical 0.1 (3/4)) (****||*) = combineTwo (dragPane Vertical 0.1 (4/5)) (***||**) = combineTwo (dragPane Vertical 0.1 (3/5)) (****||***) = combineTwo (dragPane Vertical 0.1 (4/7)) (***||****) = combineTwo (dragPane Vertical 0.1 (3/7)) (*||****) = combineTwo (dragPane Vertical 0.1 (1/5)) (**||***) = combineTwo (dragPane Vertical 0.1 (2/5)) (*||***) = combineTwo (dragPane Vertical 0.1 (1/4)) (*||**) = combineTwo (dragPane Vertical 0.1 (1/3)) -- $dph -- These combinators combine two layouts using "XMonad.DragPane" in -- horizontal mode. (*//*),(**//*),(***//*),(****//*), (***//**),(****//***), (***//****),(*//****),(**//***),(*//***),(*//**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a (*//*) = combineTwo (dragPane Horizontal 0.1 (1/2)) (**//*) = combineTwo (dragPane Horizontal 0.1 (2/3)) (***//*) = combineTwo (dragPane Horizontal 0.1 (3/4)) (****//*) = combineTwo (dragPane Horizontal 0.1 (4/5)) (***//**) = combineTwo (dragPane Horizontal 0.1 (3/5)) (****//***) = combineTwo (dragPane Horizontal 0.1 (4/7)) (***//****) = combineTwo (dragPane Horizontal 0.1 (3/7)) (*//****) = combineTwo (dragPane Horizontal 0.1 (1/5)) (**//***) = combineTwo (dragPane Horizontal 0.1 (2/5)) (*//***) = combineTwo (dragPane Horizontal 0.1 (1/4)) (*//**) = combineTwo (dragPane Horizontal 0.1 (1/3)) -- $tv -- These combinators combine two layouts vertically using @Tall@. (*|*),(**|*),(***|*),(****|*), (***|**),(****|***), (***|****),(*|****),(**|***),(*|***),(*|**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> CombineTwo (Tall ()) l1 l2 a (*|*) = combineTwo (Tall 1 0.1 (1/2)) (**|*) = combineTwo (Tall 1 0.1 (2/3)) (***|*) = combineTwo (Tall 1 0.1 (3/4)) (****|*) = combineTwo (Tall 1 0.1 (4/5)) (***|**) = combineTwo (Tall 1 0.1 (3/5)) (****|***) = combineTwo (Tall 1 0.1 (4/7)) (***|****) = combineTwo (Tall 1 0.1 (3/7)) (*|****) = combineTwo (Tall 1 0.1 (1/5)) (**|***) = combineTwo (Tall 1 0.1 (2/5)) (*|***) = combineTwo (Tall 1 0.1 (1/4)) (*|**) = combineTwo (Tall 1 0.1 (1/3)) -- $mth -- These combinators combine two layouts horizontally using @Mirror -- Tall@. (*/*),(**/*),(***/*),(****/*), (***/**),(****/***), (***/****),(*/****),(**/***),(*/***),(*/**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> CombineTwo (Mirror Tall ()) l1 l2 a (*/*) = combineTwo (Mirror $ Tall 1 0.1 (1/2)) (**/*) = combineTwo (Mirror $ Tall 1 0.1 (2/3)) (***/*) = combineTwo (Mirror $ Tall 1 0.1 (3/4)) (****/*) = combineTwo (Mirror $ Tall 1 0.1 (4/5)) (***/**) = combineTwo (Mirror $ Tall 1 0.1 (3/5)) (****/***) = combineTwo (Mirror $ Tall 1 0.1 (4/7)) (***/****) = combineTwo (Mirror $ Tall 1 0.1 (3/7)) (*/****) = combineTwo (Mirror $ Tall 1 0.1 (1/5)) (**/***) = combineTwo (Mirror $ Tall 1 0.1 (2/5)) (*/***) = combineTwo (Mirror $ Tall 1 0.1 (1/4)) (*/**) = combineTwo (Mirror $ Tall 1 0.1 (1/3)) infixr 5 ||| -- $jtl -- The standard xmonad core exports a layout combinator @|||@ which -- represents layout choice. This is a reimplementation which also -- provides the capability to support 'JumpToLayout' messages. To use -- it, be sure to hide the import of @|||@ from the xmonad core; if either of -- these two lines appear in your configuration: -- -- > import XMonad -- > import XMonad.Layout -- -- replace them with these instead, respectively: -- -- > import XMonad hiding ( (|||) ) -- > import XMonad.Layout hiding ( (|||) ) -- -- The argument given to a 'JumpToLayout' message should be the -- @description@ of the layout to be selected. If you use -- "XMonad.Hooks.DynamicLog", this is the name of the layout displayed -- in your status bar. Alternatively, you can use GHCi to determine -- the proper name to use. For example: -- -- > $ ghci -- > GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help -- > Loading package base ... linking ... done. -- > :set prompt "> " -- don't show loaded module names -- > > :m +XMonad.Core -- load the xmonad core -- > > :m +XMonad.Layout.Grid -- load whatever module you want to use -- > > description Grid -- find out what it's called -- > "Grid" -- -- As yet another (possibly easier) alternative, you can use the -- "XMonad.Layout.Named" modifier to give custom names to your -- layouts, and use those. -- -- For the ability to select a layout from a prompt, see -- "Xmonad.Prompt.Layout". -- | A reimplementation of the combinator of the same name from the -- xmonad core, providing layout choice, and the ability to support -- 'JumpToLayout' messages. (|||) :: (LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> NewSelect l1 l2 a (|||) = NewSelect True data NewSelect l1 l2 a = NewSelect Bool (l1 a) (l2 a) deriving ( Read, Show ) -- | data JumpToLayout = JumpToLayout String -- ^ A message to jump to a particular layout -- , specified by its description string.. | NextLayoutNoWrap | Wrap deriving ( Read, Show, Typeable ) instance Message JumpToLayout instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a where runLayout (Workspace i (NewSelect True l1 l2) ms) r = do (wrs, ml1') <- runLayout (Workspace i l1 ms) r return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1') runLayout (Workspace i (NewSelect False l1 l2) ms) r = do (wrs, ml2') <- runLayout (Workspace i l2 ms) r return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2') description (NewSelect True l1 _) = description l1 description (NewSelect False _ l2) = description l2 handleMessage l@(NewSelect False _ _) m | Just Wrap <- fromMessage m = fmap Just $ swap l >>= passOn m handleMessage l@(NewSelect amfirst _ _) m | Just NextLayoutNoWrap <- fromMessage m = if amfirst then when' isNothing (passOnM m l) $ fmap Just $ swap l >>= passOn (SomeMessage Wrap) else passOnM m l handleMessage l m | Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $ fmap Just $ swap l >>= passOn (SomeMessage Wrap) handleMessage l@(NewSelect True _ l2) m | Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just `fmap` swap l handleMessage l@(NewSelect False l1 _) m | Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just `fmap` swap l handleMessage l m | Just (JumpToLayout _) <- fromMessage m = when' isNothing (passOnM m l) $ do ml' <- passOnM m $ sw l case ml' of Nothing -> return Nothing Just l' -> Just `fmap` swap (sw l') handleMessage (NewSelect b l1 l2) m | Just ReleaseResources <- fromMessage m = do ml1' <- handleMessage l1 m ml2' <- handleMessage l2 m return $ if isJust ml1' || isJust ml2' then Just $ NewSelect b (maybe l1 id ml1') (maybe l2 id ml2') else Nothing handleMessage l m = passOnM m l swap :: (LayoutClass l1 a, LayoutClass l2 a) => NewSelect l1 l2 a -> X (NewSelect l1 l2 a) swap l = sw `fmap` passOn (SomeMessage Hide) l sw :: NewSelect l1 l2 a -> NewSelect l1 l2 a sw (NewSelect b lt lf) = NewSelect (not b) lt lf passOn :: (LayoutClass l1 a, LayoutClass l2 a) => SomeMessage -> NewSelect l1 l2 a -> X (NewSelect l1 l2 a) passOn m l = maybe l id `fmap` passOnM m l passOnM :: (LayoutClass l1 a, LayoutClass l2 a) => SomeMessage -> NewSelect l1 l2 a -> X (Maybe (NewSelect l1 l2 a)) passOnM m (NewSelect True lt lf) = do mlt' <- handleMessage lt m return $ (\lt' -> NewSelect True lt' lf) `fmap` mlt' passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m return $ (\lf' -> NewSelect False lt lf') `fmap` mlf' when' :: Monad m => (a -> Bool) -> m a -> m a -> m a when' f a b = do a1 <- a; if f a1 then b else return a1 xmonad-contrib-0.12/XMonad/Layout/LimitWindows.hs0000644000000000000000000001341112636047674020215 0ustar0000000000000000{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LimitWindows -- Copyright : (c) 2009 Adam Vogt -- (c) 2009 Max Rabkin -- wrote limitSelect -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : vogt.adam@gmail.com -- Stability : unstable -- Portability : unportable -- -- A layout modifier that limits the number of windows that can be shown. -- See "XMonad.Layout.Minimize" for manually setting hidden windows. -- ----------------------------------------------------------------------------- module XMonad.Layout.LimitWindows ( -- * Usage -- $usage -- * Layout Modifiers limitWindows,limitSlice,limitSelect, -- * Change the number of windows increaseLimit,decreaseLimit,setLimit, #ifdef TESTING -- * For tests select,update,Selection(..),updateAndSelect, #endif -- * Types LimitWindows, Selection, ) where import XMonad.Layout.LayoutModifier import XMonad import qualified XMonad.StackSet as W import Control.Monad((<=<),guard) import Control.Applicative((<$>)) import Data.Maybe(fromJust) -- $usage -- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.LimitWindows -- -- > myLayout = limitWindows 6 $ Tall 1 0.03 0.5 ||| Full ||| RandomOtherLayout... -- > main = xmonad def { layoutHook = myLayout } -- -- You may also be interested in dynamically changing the number dynamically, -- by binding keys to the 'increaseLimit', 'decreaseLimit', or 'setLimit' -- actions. -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- -- See also 'XMonad.Layout.BoringWindows.boringAuto' for keybindings that skip -- the hidden windows. increaseLimit :: X () increaseLimit = sendMessage $ LimitChange succ decreaseLimit :: X () decreaseLimit = sendMessage . LimitChange $ max 1 . pred setLimit :: Int -> X () setLimit tgt = sendMessage . LimitChange $ const tgt -- | Only display the first @n@ windows. limitWindows :: Int -> l a -> ModifiedLayout LimitWindows l a limitWindows n = ModifiedLayout (LimitWindows FirstN n) -- | Only display @n@ windows around the focused window. This makes sense with -- layouts that arrange windows linearily, like 'XMonad.Layout.Layout.Accordion'. limitSlice :: Int -> l a -> ModifiedLayout LimitWindows l a limitSlice n = ModifiedLayout (LimitWindows Slice n) -- | Only display the first @m@ windows and @r@ others. -- The @IncMasterN@ message will change @m@, as well as passing it onto the -- underlying layout. limitSelect :: Int -> Int -> l a -> ModifiedLayout Selection l a limitSelect m r = ModifiedLayout Sel{ nMaster=m, start=m, nRest=r } data LimitWindows a = LimitWindows SliceStyle Int deriving (Read,Show) data SliceStyle = FirstN | Slice deriving (Read,Show) data LimitChange = LimitChange { unLC :: (Int -> Int) } deriving (Typeable) instance Message LimitChange instance LayoutModifier LimitWindows a where pureMess (LimitWindows s n) = fmap (LimitWindows s) . pos <=< (`app` n) . unLC <=< fromMessage where pos x = guard (x>=1) >> return x app f x = guard (f x /= x) >> return (f x) modifyLayout (LimitWindows style n) ws r = runLayout ws { W.stack = f n <$> W.stack ws } r where f = case style of FirstN -> firstN Slice -> slice firstN :: Int -> W.Stack a -> W.Stack a firstN n st = upfocus $ fromJust $ W.differentiate $ take (max 1 n) $ W.integrate st where upfocus = foldr (.) id $ replicate (length (W.up st)) W.focusDown' -- | A non-wrapping, fixed-size slice of a stack around the focused element slice :: Int -> W.Stack t -> W.Stack t slice n (W.Stack f u d) = W.Stack f (take (nu + unusedD) u) (take (nd + unusedU) d) where unusedD = max 0 $ nd - length d unusedU = max 0 $ nu - length u nd = div (n - 1) 2 nu = uncurry (+) $ divMod (n - 1) 2 data Selection a = Sel { nMaster :: Int, start :: Int, nRest :: Int } deriving (Read, Show, Eq) instance LayoutModifier Selection a where modifyLayout s w r = runLayout (w { W.stack = updateAndSelect s <$> W.stack w }) r pureModifier sel _ stk wins = (wins, update sel <$> stk) pureMess sel m | Just f <- unLC <$> fromMessage m = Just $ sel { nRest = max 0 (f (nMaster sel + nRest sel) - nMaster sel) } | Just (IncMasterN n) <- fromMessage m = Just $ sel { nMaster = max 0 (nMaster sel + n) } | otherwise = Nothing select :: Selection l -> W.Stack a -> W.Stack a select s stk | lups < nMaster s = stk { W.down=take (nMaster s - lups - 1) downs ++ (take (nRest s) . drop (start s - lups - 1) $ downs) } | otherwise = stk { W.up=reverse (take (nMaster s) ups ++ drop (start s) ups), W.down=take ((nRest s) - (lups - start s) - 1) downs } where downs = W.down stk ups = reverse $ W.up stk lups = length ups updateStart :: Selection l -> W.Stack a -> Int updateStart s stk | lups < nMaster s -- the focussed window is in the master pane = start s `min` (lups + ldown - (nRest s) + 1) `max` nMaster s | otherwise = start s `min` lups `max` (lups - (nRest s) + 1) `min` (lups + ldown - (nRest s) + 1) `max` nMaster s where lups = length $ W.up stk ldown = length $ W.down stk update :: Selection l -> W.Stack a -> Selection a update sel stk = sel { start=updateStart sel stk } updateAndSelect :: Selection l -> W.Stack a -> W.Stack a updateAndSelect sel stk = select (update sel stk) stk xmonad-contrib-0.12/XMonad/Layout/ResizableTile.hs0000644000000000000000000001257512636047674020334 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ResizableTile -- Copyright : (c) MATSUYAMA Tomohiro -- License : BSD-style (see LICENSE) -- -- Maintainer : MATSUYAMA Tomohiro -- Stability : unstable -- Portability : unportable -- -- More useful tiled layout that allows you to change a width\/height of window. -- ----------------------------------------------------------------------------- module XMonad.Layout.ResizableTile ( -- * Usage -- $usage ResizableTall(..), MirrorResize(..) ) where import XMonad hiding (tile, splitVertically, splitHorizontallyBy) import qualified XMonad.StackSet as W import Control.Monad import qualified Data.Map as M import Data.List ((\\)) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.ResizableTile -- -- Then edit your @layoutHook@ by adding the ResizableTile layout: -- -- > myLayout = ResizableTall 1 (3/100) (1/2) [] ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- You may also want to add the following key bindings: -- -- > , ((modm, xK_a), sendMessage MirrorShrink) -- > , ((modm, xK_z), sendMessage MirrorExpand) -- -- For detailed instruction on editing the key binding see: -- -- "XMonad.Doc.Extending#Editing_key_bindings". data MirrorResize = MirrorShrink | MirrorExpand deriving Typeable instance Message MirrorResize data ResizableTall a = ResizableTall { _nmaster :: Int -- ^ number of master windows , _delta :: Rational -- ^ change when resizing by 'Shrink', 'Expand', -- 'MirrorShrink', 'MirrorExpand' , _frac :: Rational -- ^ width of master , _slaves :: [Rational] -- ^ fraction to multiply the window -- height that would be given when divided equally. -- -- slave windows are assigned their modified -- heights in order, from top to bottom -- -- unspecified values are replaced by 1 } deriving (Show, Read) instance LayoutClass ResizableTall a where doLayout (ResizableTall nmaster _ frac mfrac) r = return . (\x->(x,Nothing)) . ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate handleMessage (ResizableTall nmaster delta frac mfrac) m = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset fs <- (M.keys . W.floating) `fmap` gets windowset return $ ms >>= unfloat fs >>= handleMesg where handleMesg s = msum [fmap resize (fromMessage m) ,fmap (\x -> mresize x s) (fromMessage m) ,fmap incmastern (fromMessage m)] unfloat fs s = if W.focus s `elem` fs then Nothing else Just (s { W.up = (W.up s) \\ fs , W.down = (W.down s) \\ fs }) resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac resize Expand = ResizableTall nmaster delta (min 1 $ frac+delta) mfrac mresize MirrorShrink s = mresize' s delta mresize MirrorExpand s = mresize' s (0-delta) mresize' s d = let n = length $ W.up s total = n + (length $ W.down s) + 1 pos = if n == (nmaster-1) || n == (total-1) then n-1 else n mfrac' = modifymfrac (mfrac ++ repeat 1) d pos in ResizableTall nmaster delta frac $ take total mfrac' modifymfrac [] _ _ = [] modifymfrac (f:fx) d n | n == 0 = f+d : fx | otherwise = f : modifymfrac fx d (n-1) incmastern (IncMasterN d) = ResizableTall (max 0 (nmaster+d)) delta frac mfrac description _ = "ResizableTall" tile :: Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle] tile f mf r nmaster n = if n <= nmaster || nmaster == 0 then splitVertically mf n r else splitVertically mf nmaster r1 ++ splitVertically (drop nmaster mf) (n-nmaster) r2 -- two columns where (r1,r2) = splitHorizontallyBy f r splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle] splitVertically [] _ r = [r] splitVertically _ n r | n < 2 = [r] splitVertically (f:fx) n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh : splitVertically fx (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh)) where smallh = min sh (floor $ fromIntegral (sh `div` fromIntegral n) * f) --hmm, this is a fold or map. splitHorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle) splitHorizontallyBy f (Rectangle sx sy sw sh) = ( Rectangle sx sy leftw sh , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh) where leftw = floor $ fromIntegral sw * f xmonad-contrib-0.12/XMonad/Layout/NoFrillsDecoration.hs0000644000000000000000000000324712636047674021332 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.NoFrillsDecoration -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- Most basic version of decoration for windows without any additional -- modifications. In contrast to "XMonad.Layout.SimpleDecoration" this will -- result in title bars that span the entire window instead of being only the -- length of the window title. -- ----------------------------------------------------------------------------- module XMonad.Layout.NoFrillsDecoration ( -- * Usage: -- $usage noFrillsDeco , module XMonad.Layout.SimpleDecoration , NoFrillsDecoration ) where import XMonad.Layout.Decoration import XMonad.Layout.SimpleDecoration -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.NoFrillsDecoration -- -- Then edit your @layoutHook@ by adding the NoFrillsDecoration to -- your layout: -- -- > myL = noFrillsDeco shrinkText def (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- | Add very simple decorations to windows of a layout. noFrillsDeco :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration NoFrillsDecoration s) l a noFrillsDeco s c = decoration s c $ NFD True data NoFrillsDecoration a = NFD Bool deriving (Show, Read) instance Eq a => DecorationStyle NoFrillsDecoration a where describeDeco _ = "NoFrillsDeco" xmonad-contrib-0.12/XMonad/Layout/ComboP.hs0000644000000000000000000002154212636047674016747 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ComboP -- Copyright : (c) Konstantin Sobolev -- License : BSD-style (see LICENSE) -- -- Maintainer : Konstantin Sobolev -- Stability : unstable -- Portability : unportable -- -- A layout that combines multiple layouts and allows to specify where to put -- new windows. -- ----------------------------------------------------------------------------- module XMonad.Layout.ComboP ( -- * Usage -- $usage combineTwoP, CombineTwoP, SwapWindow(..), Property(..) ) where import Data.List ( delete, intersect, (\\) ) import Data.Maybe ( isJust ) import Control.Monad import XMonad hiding (focus) import XMonad.StackSet ( Workspace (..), Stack(..) ) import XMonad.Layout.WindowNavigation import XMonad.Util.WindowProperties import qualified XMonad.StackSet as W -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.ComboP -- -- and add something like -- -- > combineTwoP (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) (ClassName "Firefox") -- -- to your layouts. This way all windows with class = \"Firefox\" will always go -- to the left pane, all others - to the right. -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- 'combineTwoP' is a simple layout combinator based on 'combineTwo' from Combo, with -- addition of a 'Property' which tells where to put new windows. Windows mathing -- the property will go into the first part, all others will go into the second -- part. It supports @Move@ messages as 'combineTwo' does, but it also introduces -- 'SwapWindow' message which sends focused window to the other part. It is -- required because @Move@ commands don't work when one of the parts is empty. -- To use it, import \"XMonad.Layout.WindowNavigation\", and add the following key -- bindings (or something similar): -- -- > , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) -- > , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L) -- > , ((modm .|. controlMask .|. shiftMask, xK_Up ), sendMessage $ Move U) -- > , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D) -- > , ((modm .|. controlMask .|. shiftMask, xK_s ), sendMessage $ SwapWindow) -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". data SwapWindow = SwapWindow -- ^ Swap window between panes | SwapWindowN Int -- ^ Swap window between panes in the N-th nested ComboP. @SwapWindowN 0@ equals to SwapWindow deriving (Read, Show, Typeable) instance Message SwapWindow data CombineTwoP l l1 l2 a = C2P [a] [a] [a] l (l1 a) (l2 a) Property deriving (Read, Show) combineTwoP :: (LayoutClass super(), LayoutClass l1 Window, LayoutClass l2 Window) => super () -> l1 Window -> l2 Window -> Property -> CombineTwoP (super ()) l1 l2 Window combineTwoP = C2P [] [] [] instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) => LayoutClass (CombineTwoP (l ()) l1 l2) Window where doLayout (C2P f w1 w2 super l1 l2 prop) rinput s = let origws = W.integrate s -- passed in windows w1c = origws `intersect` w1 -- current windows in the first pane w2c = origws `intersect` w2 -- current windows in the second pane new = origws \\ (w1c ++ w2c) -- new windows superstack = Just Stack { focus=(), up=[], down=[()] } f' = focus s:delete (focus s) f -- list of focused windows, contains 2 elements at most in do matching <- (hasProperty prop) `filterM` new -- new windows matching predecate let w1' = w1c ++ matching -- updated first pane windows w2' = w2c ++ (new \\ matching) -- updated second pane windows s1 = differentiate f' w1' -- first pane stack s2 = differentiate f' w2' -- second pane stack ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super superstack) rinput (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1 (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2 return (wrs1++wrs2, Just $ C2P f' w1' w2' (maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2') prop) handleMessage us@(C2P f ws1 ws2 super l1 l2 prop) m | Just SwapWindow <- fromMessage m = swap us | Just (SwapWindowN 0) <- fromMessage m = swap us | Just (SwapWindowN n) <- fromMessage m = forwardToFocused us $ SomeMessage $ SwapWindowN $ n-1 | Just (MoveWindowToWindow w1 w2) <- fromMessage m, w1 `elem` ws1, w2 `elem` ws2 = return $ Just $ C2P f (delete w1 ws1) (w1:ws2) super l1 l2 prop | Just (MoveWindowToWindow w1 w2) <- fromMessage m, w1 `elem` ws2, w2 `elem` ws1 = return $ Just $ C2P f (w1:ws1) (delete w1 ws2) super l1 l2 prop | otherwise = do ml1' <- handleMessage l1 m ml2' <- handleMessage l2 m msuper' <- handleMessage super m if isJust msuper' || isJust ml1' || isJust ml2' then return $ Just $ C2P f ws1 ws2 (maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2') prop else return Nothing description (C2P _ _ _ super l1 l2 prop) = "combining " ++ description l1 ++ " and "++ description l2 ++ " with " ++ description super ++ " using "++ (show prop) -- send focused window to the other pane. Does nothing if we don't -- own the focused window swap :: (LayoutClass s a, LayoutClass l1 Window, LayoutClass l2 Window) => CombineTwoP (s a) l1 l2 Window -> X (Maybe (CombineTwoP (s a) l1 l2 Window)) swap (C2P f ws1 ws2 super l1 l2 prop) = do mst <- gets (W.stack . W.workspace . W.current . windowset) let (ws1', ws2') = case mst of Nothing -> (ws1, ws2) Just st -> if foc `elem` ws1 then (foc `delete` ws1, foc:ws2) else if foc `elem` ws2 then (foc:ws1, foc `delete` ws2) else (ws1, ws2) where foc = W.focus st if (ws1,ws2) == (ws1',ws2') then return Nothing else return $ Just $ C2P f ws1' ws2' super l1 l2 prop -- forwards the message to the sublayout which contains the focused window forwardToFocused :: (LayoutClass l1 Window, LayoutClass l2 Window, LayoutClass s a) => CombineTwoP (s a) l1 l2 Window -> SomeMessage -> X (Maybe (CombineTwoP (s a) l1 l2 Window)) forwardToFocused (C2P f ws1 ws2 super l1 l2 prop) m = do ml1 <- forwardIfFocused l1 ws1 m ml2 <- forwardIfFocused l2 ws2 m ms <- if isJust ml1 || isJust ml2 then return Nothing else handleMessage super m if isJust ml1 || isJust ml2 || isJust ms then return $ Just $ C2P f ws1 ws2 (maybe super id ms) (maybe l1 id ml1) (maybe l2 id ml2) prop else return Nothing -- forwards message m to layout l if focused window is among w forwardIfFocused :: (LayoutClass l Window) => l Window -> [Window] -> SomeMessage -> X (Maybe (l Window)) forwardIfFocused l w m = do mst <- gets (W.stack . W.workspace . W.current . windowset) maybe (return Nothing) send mst where send st = if (W.focus st) `elem` w then handleMessage l m else return Nothing -- code from CombineTwo -- given two sets of zs and xs takes the first z from zs that also belongs to xs -- and turns xs into a stack with z being current element. Acts as -- StackSet.differentiate if zs and xs don't intersect differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q) differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z , up = reverse $ takeWhile (/=z) xs , down = tail $ dropWhile (/=z) xs } | otherwise = differentiate zs xs differentiate [] xs = W.differentiate xs -- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20: xmonad-contrib-0.12/XMonad/Layout/Mosaic.hs0000644000000000000000000001717412636047674017011 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Mosaic -- Copyright : (c) 2009 Adam Vogt, 2007 James Webb -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : vogt.adamgmail.com -- Stability : unstable -- Portability : unportable -- -- Based on MosaicAlt, but aspect ratio messages always change the aspect -- ratios, and rearranging the window stack changes the window sizes. -- ----------------------------------------------------------------------------- module XMonad.Layout.Mosaic ( -- * Usage -- $usage Aspect(..) ,mosaic ,changeMaster ,changeFocused ,Mosaic ) where import Prelude hiding (sum) import XMonad(Typeable, LayoutClass(doLayout, handleMessage, pureMessage, description), Message, X, fromMessage, withWindowSet, Resize(..), splitHorizontallyBy, splitVerticallyBy, sendMessage, Rectangle) import qualified XMonad.StackSet as W import Control.Arrow(second, first) import Control.Monad(mplus) import Data.Foldable(Foldable,foldMap, sum) import Data.Function(on) import Data.List(sortBy) import Data.Monoid(Monoid,mempty, mappend) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Mosaic -- -- Then edit your @layoutHook@ by adding the Mosaic layout: -- -- > myLayout = mosaic 2 [3,2] ||| Full ||| etc.. -- > main = xmonad $ def { layoutHook = myLayout } -- -- Unfortunately, infinite lists break serialization, so don't use them. And if -- the list is too short, it is extended with @++ repeat 1@, which covers the -- main use case. -- -- To change the choice in aspect ratio and the relative sizes of windows, add -- to your keybindings: -- -- > , ((modm, xK_a), sendMessage Taller) -- > , ((modm, xK_z), sendMessage Wider) -- -- > , ((modm, xK_r), sendMessage Reset) -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" data Aspect = Taller | Wider | Reset | SlopeMod ([Rational] -> [Rational]) deriving (Typeable) instance Message Aspect -- | The relative magnitudes (the sign is ignored) of the rational numbers in -- the second argument determine the relative areas that the windows receive. -- The first number represents the size of the master window, the second is for -- the next window in the stack, and so on. -- -- The list is extended with @++ repeat 1@, so @mosaic 1.5 []@ is like a -- resizable grid. -- -- The first parameter is the multiplicative factor to use when responding to -- the 'Expand' message. mosaic :: Rational -> [Rational] -> Mosaic a mosaic = Mosaic Nothing data Mosaic a = -- | True to override the aspect, current index, maximum index Mosaic (Maybe(Bool,Rational,Int)) Rational [Rational] deriving (Read,Show) instance LayoutClass Mosaic a where description = const "Mosaic" pureMessage (Mosaic Nothing _ _) _ = Nothing pureMessage (Mosaic (Just(_,ix,mix)) delta ss) ms = fromMessage ms >>= ixMod where ixMod Taller | round ix >= mix = Nothing | otherwise = Just $ Mosaic (Just(False,succ ix,mix)) delta ss ixMod Wider | round ix <= (0::Integer) = Nothing | otherwise = Just $ Mosaic (Just(False,pred ix,mix)) delta ss ixMod Reset = Just $ Mosaic Nothing delta ss ixMod (SlopeMod f) = Just $ Mosaic (Just(False,ix,mix)) delta (f ss) handleMessage l@(Mosaic _ delta _) ms | Just Expand <- fromMessage ms = changeFocused (*delta) >> return Nothing | Just Shrink <- fromMessage ms = changeFocused (/delta) >> return Nothing | otherwise = return $ pureMessage l ms doLayout (Mosaic state delta ss) r st = let ssExt = zipWith const (ss ++ repeat 1) $ W.integrate st rects = splits r ssExt nls = length rects fi = fromIntegral nextIx (ov,ix,mix) | mix <= 0 || ov = fromIntegral $ nls `div` 2 | otherwise = max 0 $ (*fi (pred nls)) $ min 1 $ ix / fi mix rect = rects !! maybe (nls `div` 2) round (nextIx `fmap` state) state' = fmap (\x@(ov,_,_) -> (ov,nextIx x,pred nls)) state `mplus` Just (True,fromIntegral nls / 2,pred nls) ss' = maybe ss (const ss `either` const ssExt) $ zipRemain ss ssExt in return (zip (W.integrate st) rect, Just $ Mosaic state' delta ss') zipRemain :: [a] -> [b] -> Maybe (Either [a] [b]) zipRemain (_:xs) (_:ys) = zipRemain xs ys zipRemain [] [] = Nothing zipRemain [] y = Just (Right y) zipRemain x [] = Just (Left x) -- | These sample functions are meant to be applied to the list of window sizes -- through the 'SlopeMod' message. changeMaster :: (Rational -> Rational) -> X () changeMaster = sendMessage . SlopeMod . onHead -- | Apply a function to the Rational that represents the currently focused -- window. -- -- 'Expand' and 'Shrink' messages are responded to with @changeFocused -- (*delta)@ or @changeFocused (delta/)@ where @delta@ is the first argument to -- 'mosaic'. -- -- This is exported because other functions (ex. @const 1@, @(+1)@) may be -- useful to apply to the current area. changeFocused :: (Rational -> Rational) -> X () changeFocused f = withWindowSet $ sendMessage . SlopeMod . maybe id (mulIx . length . W.up) . W.stack . W.workspace . W.current where mulIx i = uncurry (++) . second (onHead f) . splitAt i onHead :: (a -> a) -> [a] -> [a] onHead f = uncurry (++) . first (fmap f) . splitAt 1 splits :: Rectangle -> [Rational] -> [[Rectangle]] splits rect = map (reverse . map snd . sortBy (compare `on` fst)) . splitsL rect . makeTree snd . zip [1..] . normalize . reverse . map abs splitsL :: Rectangle -> Tree (Int,Rational) -> [[(Int,Rectangle)]] splitsL _rect Empty = [] splitsL rect (Leaf (x,_)) = [[(x,rect)]] splitsL rect (Branch l r) = do let mkSplit f = f ((sumSnd l /) $ sumSnd l + sumSnd r) rect sumSnd = sum . fmap snd (rl,rr) <- map mkSplit [splitVerticallyBy,splitHorizontallyBy] splitsL rl l `interleave` splitsL rr r -- like zipWith (++), but when one list is shorter, its elements are duplicated -- so that they match interleave :: [[a]] -> [[a]] -> [[a]] interleave xs ys | lx > ly = zc xs (extend lx ys) | otherwise = zc (extend ly xs) ys where lx = length xs ly = length ys zc = zipWith (++) extend :: Int -> [a] -> [a] extend n pat = do (p,e) <- zip pat $ replicate m True ++ repeat False [p | e] ++ replicate d p where (d,m) = n `divMod` length pat normalize :: Fractional a => [a] -> [a] normalize x = let s = sum x in map (/s) x data Tree a = Branch (Tree a) (Tree a) | Leaf a | Empty instance Foldable Tree where foldMap _f Empty = mempty foldMap f (Leaf x) = f x foldMap f (Branch l r) = foldMap f l `mappend` foldMap f r instance Functor Tree where fmap f (Leaf x) = Leaf $ f x fmap f (Branch l r) = Branch (fmap f l) (fmap f r) fmap _ Empty = Empty instance Monoid (Tree a) where mempty = Empty mappend Empty x = x mappend x Empty = x mappend x y = Branch x y makeTree :: (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a makeTree _ [] = Empty makeTree _ [x] = Leaf x makeTree f xs = Branch (makeTree f a) (makeTree f b) where ((a,b),_) = foldr go (([],[]),(0,0)) xs go n ((ls,rs),(l,r)) | l > r = ((ls,n:rs),(l,f n+r)) | otherwise = ((n:ls,rs),(f n+l,r)) xmonad-contrib-0.12/XMonad/Layout/LayoutHints.hs0000644000000000000000000002572112636047674020056 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} {-# LANGUAGE ParallelListComp, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LayoutHints -- Copyright : (c) David Roundy -- License : BSD -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- Make layouts respect size hints. ----------------------------------------------------------------------------- module XMonad.Layout.LayoutHints ( -- * usage -- $usage layoutHints , layoutHintsWithPlacement , layoutHintsToCenter , LayoutHints , LayoutHintsToCenter , hintsEventHook ) where import XMonad(LayoutClass(runLayout), mkAdjust, Window, Dimension, Position, Rectangle(Rectangle), D, X, refresh, Event(..), propertyNotify, wM_NORMAL_HINTS, (<&&>), io, applySizeHints, whenX, isClient, withDisplay, getWindowAttributes, getWMNormalHints, WindowAttributes(..)) import qualified XMonad.StackSet as W import XMonad.Layout.Decoration(isInStack) import XMonad.Layout.LayoutModifier(ModifiedLayout(..), LayoutModifier(modifyLayout, redoLayout, modifierDescription)) import XMonad.Util.Types(Direction2D(..)) import Control.Applicative((<$>)) import Control.Arrow(Arrow((***), first, second)) import Control.Monad(join) import Data.Function(on) import Data.List(sortBy) import Data.Monoid(All(..)) import Data.Set (Set) import qualified Data.Set as Set -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.LayoutHints -- -- Then edit your @layoutHook@ by adding the 'layoutHints' layout modifier -- to some layout: -- -- > myLayout = layoutHints (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- Or, to center the adapted window in its available area: -- -- > myLayout = layoutHintsWithPlacement (0.5, 0.5) (Tall 1 (3/100) (1/2)) -- > ||| Full ||| etc.. -- -- Or, to make a reasonable attempt to eliminate gaps between windows: -- -- > myLayout = layoutHintsToCenter (Tall 1 (3/100) (1/2)) -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- To make XMonad reflect changes in window hints immediately, add -- 'hintsEventHook' to your 'handleEventHook'. -- -- > myHandleEventHook = hintsEventHook <+> ... -- > -- > main = xmonad def { handleEventHook = myHandleEventHook -- > , ... } layoutHints :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHints l a layoutHints = ModifiedLayout (LayoutHints (0, 0)) -- | @layoutHintsWithPlacement (rx, ry) layout@ will adapt the sizes of a layout's -- windows according to their size hints, and position them inside their -- originally assigned area according to the @rx@ and @ry@ parameters. -- (0, 0) places the window at the top left, (1, 0) at the top right, (0.5, 0.5) -- at the center, etc. layoutHintsWithPlacement :: (LayoutClass l a) => (Double, Double) -> l a -> ModifiedLayout LayoutHints l a layoutHintsWithPlacement rs = ModifiedLayout (LayoutHints rs) -- | @layoutHintsToCenter layout@ applies hints, sliding the window to the -- center of the screen and expanding its neighbors to fill the gaps. Windows -- are never expanded in a way that increases overlap. -- -- @layoutHintsToCenter@ only makes one pass at resizing the neighbors of -- hinted windows, so with some layouts (ex. the arrangement with two 'Mirror' -- 'Tall' stacked vertically), @layoutHintsToCenter@ may leave some gaps. -- Simple layouts like 'Tall' are unaffected. layoutHintsToCenter :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHintsToCenter l a layoutHintsToCenter = ModifiedLayout LayoutHintsToCenter data LayoutHints a = LayoutHints (Double, Double) deriving (Read, Show) instance LayoutModifier LayoutHints Window where modifierDescription _ = "Hinted" redoLayout _ _ Nothing xs = return (xs, Nothing) redoLayout (LayoutHints al) _ (Just s) xs = do xs' <- mapM (\x@(_, r) -> second (placeRectangle al r) <$> applyHint x) xs return (xs', Nothing) where applyHint (w,r@(Rectangle a b c d)) = do adj <- mkAdjust w let (c',d') = adj (c,d) return (w, if isInStack s w then Rectangle a b c' d' else r) -- | @placeRectangle (rx, ry) r0 r@ will return a new rectangle with the same dimensions -- as @r@, but positioned inside of @r0@ as specified by the (rx, ry) parameters (see -- 'layoutHintsWithPlacement'). placeRectangle :: RealFrac r => (r, r) -> Rectangle -> Rectangle -> Rectangle placeRectangle (rx, ry) (Rectangle x0 y0 w h) (Rectangle _ _ dx dy) = Rectangle (align x0 dx w rx) (align y0 dy h ry) dx dy where align :: RealFrac r => Position -> Dimension -> Dimension -> r -> Position align z0 dz d r = z0 + truncate (fromIntegral (d - dz) * r) fitting :: [Rectangle] -> Int fitting rects = sum $ do r <- rects return $ length $ filter (touching r) rects applyOrder :: Rectangle -> [((Window, Rectangle),t)] -> [[((Window, Rectangle),t)]] applyOrder root wrs = do -- perhaps it would just be better to take all permutations, or apply the -- resizing multiple times f <- [maximum, minimum, sum, sum . map sq] return $ sortBy (compare `on` (f . distance)) wrs where distFC = uncurry ((+) `on` sq) . pairWise (-) (center root) distance = map distFC . corners . snd . fst pairWise f (a,b) (c,d) = (f a c, f b d) sq = join (*) data LayoutHintsToCenter a = LayoutHintsToCenter deriving (Read, Show) instance LayoutModifier LayoutHintsToCenter Window where modifyLayout _ ws@(W.Workspace _ _ Nothing) r = runLayout ws r modifyLayout _ ws@(W.Workspace _ _ (Just st)) r = do (arrs,ol) <- runLayout ws r flip (,) ol . head . reverse . sortBy (compare `on` (fitting . map snd)) . map (applyHints st r) . applyOrder r <$> mapM (\x -> fmap ((,) x) $ mkAdjust (fst x)) arrs -- apply hints to first, grow adjacent windows applyHints :: W.Stack Window -> Rectangle -> [((Window, Rectangle),(D -> D))] -> [(Window, Rectangle)] applyHints _ _ [] = [] applyHints s root (((w,lrect@(Rectangle a b c d)),adj):xs) = let (c',d') = adj (c,d) redr = placeRectangle (centerPlacement root lrect :: (Double,Double)) lrect $ if isInStack s w then Rectangle a b c' d' else lrect ds = (fromIntegral c - fromIntegral c',fromIntegral d - fromIntegral d') growOther' r = growOther ds lrect (freeDirs root lrect) r mapSnd f = map (first $ second f) next = applyHints s root $ mapSnd growOther' xs in (w,redr):next growOther :: (Position, Position) -> Rectangle -> Set Direction2D -> Rectangle -> Rectangle growOther ds lrect fds r | dirs <- flipDir <$> Set.toList (Set.intersection adj fds) , not $ any (uncurry opposite) $ cross dirs = foldr (flip grow ds) r dirs | otherwise = r where adj = adjacent lrect r cross xs = [ (a,b) | a <- xs, b <- xs ] flipDir :: Direction2D -> Direction2D flipDir d = case d of { L -> R; U -> D; R -> L; D -> U } opposite :: Direction2D -> Direction2D -> Bool opposite x y = flipDir x == y -- | Leave the opposite edges where they were grow :: Direction2D -> (Position,Position) -> Rectangle -> Rectangle grow L (px,_ ) (Rectangle x y w h) = Rectangle (x-px) y (w+fromIntegral px) h grow U (_ ,py) (Rectangle x y w h) = Rectangle x (y-py) w (h+fromIntegral py) grow R (px,_ ) (Rectangle x y w h) = Rectangle x y (w+fromIntegral px) h grow D (_ ,py) (Rectangle x y w h) = Rectangle x y w (h+fromIntegral py) comparingEdges :: ([Position] -> [Position] -> Bool) -> Rectangle -> Rectangle -> Set Direction2D comparingEdges surrounds r1 r2 = Set.fromList $ map fst $ filter snd [ (\k -> (dir,k)) $ any and [[dir `elem` [R,L], allEq [a,c,w,y], [b,d] `surrounds` [x,z]] ,[dir `elem` [U,D], allEq [b,d,x,z], [a,c] `surrounds` [w,y]]] | ((a,b),(c,d)) <- edge $ corners r1 | ((w,x),(y,z)) <- edge $ delay 2 $ corners r2 | dir <- [U,R,D,L]] where edge (x:xs) = zip (x:xs) (xs ++ [x]) edge [] = [] delay n xs = drop n xs ++ take n xs allEq = all (uncurry (==)) . edge -- | in what direction is the second window from the first that can expand if the -- first is shrunk, assuming that the root window is fully covered: -- one direction for a common edge -- two directions for a common corner adjacent :: Rectangle -> Rectangle -> Set Direction2D adjacent = comparingEdges (all . onClosedInterval) -- | True whenever two edges touch. not (Set.null $ adjacent x y) ==> touching x y touching :: Rectangle -> Rectangle -> Bool touching a b = not . Set.null $ comparingEdges c a b where c x y = any (onClosedInterval x) y || any (onClosedInterval y) x onClosedInterval :: Ord a => [a] -> a -> Bool onClosedInterval bds x = minimum bds <= x && maximum bds >= x -- | starting top left going clockwise corners :: Rectangle -> [(Position, Position)] corners (Rectangle x y w h) = [(x,y) ,(x+fromIntegral w, y) ,(x+fromIntegral w, y+fromIntegral h) ,(x, y+fromIntegral h)] center :: Rectangle -> (Position, Position) center (Rectangle x y w h) = (avg x w, avg y h) where avg a b = a + fromIntegral b `div` 2 centerPlacement :: RealFrac r => Rectangle -> Rectangle -> (r, r) centerPlacement = centerPlacement' clamp where clamp n = case signum n of 0 -> 0.5 1 -> 1 _ -> 0 freeDirs :: Rectangle -> Rectangle -> Set Direction2D freeDirs root = Set.fromList . uncurry (++) . (lr *** ud) . centerPlacement' signum root where lr 1 = [L] lr (-1) = [R] lr _ = [L,R] ud 1 = [U] ud (-1) = [D] ud _ = [U,D] centerPlacement' :: (Position -> r) -> Rectangle -> Rectangle -> (r, r) centerPlacement' cf root assigned = (cf $ cx - cwx, cf $ cy - cwy) where (cx,cy) = center root (cwx,cwy) = center assigned -- | Event hook that refreshes the layout whenever a window changes its hints. hintsEventHook :: Event -> X All hintsEventHook (PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w }) | t == propertyNotify && a == wM_NORMAL_HINTS = do whenX (isClient w <&&> hintsMismatch w) $ refresh return (All True) hintsEventHook _ = return (All True) -- | True if the window's current size does not satisfy its size hints. hintsMismatch :: Window -> X Bool hintsMismatch w = withDisplay $ \d -> io $ do wa <- getWindowAttributes d w sh <- getWMNormalHints d w let dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa) return $ dim /= applySizeHints 0 sh dim xmonad-contrib-0.12/XMonad/Layout/Tabbed.hs0000644000000000000000000002333112636047674016747 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Tabbed -- Copyright : (c) 2007 David Roundy, Andrea Rossato -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A tabbed layout for the Xmonad Window Manager -- ----------------------------------------------------------------------------- module XMonad.Layout.Tabbed ( -- * Usage: -- $usage simpleTabbed, tabbed, addTabs , simpleTabbedAlways, tabbedAlways, addTabsAlways , simpleTabbedBottom, tabbedBottom, addTabsBottom , simpleTabbedLeft, tabbedLeft, addTabsLeft , simpleTabbedRight, tabbedRight, addTabsRight , simpleTabbedBottomAlways, tabbedBottomAlways, addTabsBottomAlways , simpleTabbedLeftAlways, tabbedLeftAlways, addTabsLeftAlways , simpleTabbedRightAlways, tabbedRightAlways, addTabsRightAlways , Theme (..) , def , defaultTheme , TabbedDecoration (..) , shrinkText, CustomShrink(CustomShrink) , Shrinker(..) , TabbarShown, Direction2D(..) ) where import Data.List import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.Decoration import XMonad.Layout.Simplest ( Simplest(Simplest) ) import XMonad.Util.Types (Direction2D(..)) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Tabbed -- -- Then edit your @layoutHook@ by adding the Tabbed layout: -- -- > myLayout = simpleTabbed ||| Full ||| etc.. -- -- or, if you want a specific theme for you tabbed layout: -- -- > myLayout = tabbed shrinkText def ||| Full ||| etc.. -- -- and then: -- -- > main = xmonad def { layoutHook = myLayout } -- -- This layout has hardcoded behaviour for mouse clicks on tab decorations: -- Left click on the tab switches focus to that window. -- Middle click on the tab closes the window. -- -- The default Tabbar behaviour is to hide it when only one window is open -- on the workspace. To have it always shown, use one of the layouts or -- modifiers ending in @Always@. -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- You can also edit the default configuration options. -- -- > myTabConfig = def { inactiveBorderColor = "#FF0000" -- > , activeTextColor = "#00FF00"} -- -- and -- -- > mylayout = tabbed shrinkText myTabConfig ||| Full ||| etc.. -- Layouts -- | A tabbed layout with the default xmonad Theme. -- -- This is a minimal working configuration: -- -- > import XMonad -- > import XMonad.Layout.Tabbed -- > main = xmonad def { layoutHook = simpleTabbed } simpleTabbed :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window simpleTabbed = tabbed shrinkText def simpleTabbedAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window simpleTabbedAlways = tabbedAlways shrinkText def -- | A bottom-tabbed layout with the default xmonad Theme. simpleTabbedBottom :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window simpleTabbedBottom = tabbedBottom shrinkText def -- | A bottom-tabbed layout with the default xmonad Theme. simpleTabbedBottomAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window simpleTabbedBottomAlways = tabbedBottomAlways shrinkText def -- | A side-tabbed layout with the default xmonad Theme. simpleTabbedLeft, simpleTabbedRight :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window simpleTabbedLeft = tabbedLeft shrinkText def simpleTabbedRight = tabbedRight shrinkText def -- | A side-tabbed layout with the default xmonad Theme. simpleTabbedLeftAlways, simpleTabbedRightAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window simpleTabbedLeftAlways = tabbedLeftAlways shrinkText def simpleTabbedRightAlways = tabbedRightAlways shrinkText def -- | A layout decorated with tabs and the possibility to set a custom -- shrinker and theme. tabbed :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a tabbed s c = addTabs s c Simplest tabbedAlways :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a tabbedAlways s c = addTabsAlways s c Simplest -- | A layout decorated with tabs at the bottom and the possibility to set a custom -- shrinker and theme. tabbedBottom :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a tabbedBottom s c = addTabsBottom s c Simplest tabbedBottomAlways :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a tabbedBottomAlways s c = addTabsBottomAlways s c Simplest -- | A layout decorated with tabs and the possibility to set a custom -- shrinker and theme. tabbedLeft, tabbedRight :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a tabbedLeft s c = addTabsLeft s c Simplest tabbedRight s c = addTabsRight s c Simplest -- | A layout decorated with tabs and the possibility to set a custom -- shrinker and theme. tabbedLeftAlways, tabbedRightAlways :: (Eq a, Shrinker s) => s -> Theme -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a tabbedLeftAlways s c = addTabsLeftAlways s c Simplest tabbedRightAlways s c = addTabsRightAlways s c Simplest -- Layout Modifiers -- | A layout modifier that uses the provided shrinker and theme to add tabs to any layout. addTabs :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a addTabs = createTabs WhenPlural U addTabsAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a addTabsAlways = createTabs Always U -- | A layout modifier that uses the provided shrinker and theme to add tabs to the bottom of any layout. addTabsBottom :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a addTabsBottom = createTabs WhenPlural D addTabsBottomAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a addTabsBottomAlways = createTabs Always D -- | A layout modifier that uses the provided shrinker and theme to add tabs to the side of any layout. addTabsRight, addTabsLeft :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a addTabsRight = createTabs WhenPlural R addTabsLeft = createTabs WhenPlural L addTabsRightAlways, addTabsLeftAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a addTabsRightAlways = createTabs Always R addTabsLeftAlways = createTabs Always L -- Tab creation abstractions. Internal use only. -- Create tabbar when required at the given location with the given -- shrinker and theme to the supplied layout. createTabs ::(Eq a, LayoutClass l a, Shrinker s) => TabbarShown -> Direction2D -> s -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a createTabs sh loc tx th l = decoration tx th (Tabbed loc sh) l data TabbarShown = Always | WhenPlural deriving (Read, Show, Eq) data TabbedDecoration a = Tabbed Direction2D TabbarShown deriving (Read, Show) instance Eq a => DecorationStyle TabbedDecoration a where describeDeco (Tabbed U _ ) = "Tabbed" describeDeco (Tabbed D _ ) = "Tabbed Bottom" describeDeco (Tabbed L _ ) = "Tabbed Left" describeDeco (Tabbed R _ ) = "Tabbed Right" decorationEventHook _ ds ButtonEvent { ev_window = ew , ev_event_type = et , ev_button = eb } | et == buttonPress , Just ((w,_),_) <- findWindowByDecoration ew ds = if eb == button2 then killWindow w else focus w decorationEventHook _ _ _ = return () pureDecoration (Tabbed lc sh) wt ht _ s wrs (w,r@(Rectangle x y wh hh)) = if ((sh == Always && numWindows > 0) || numWindows > 1) then Just $ case lc of U -> upperTab D -> lowerTab L -> leftTab R -> rightTab else Nothing where ws = filter (`elem` map fst (filter ((==r) . snd) wrs)) (S.integrate s) loc k h i = k + fi ((h * fi i) `div` max 1 (fi $ length ws)) esize k h = fi $ maybe k (\i -> loc k h (i+1) - loc k h i) $ w `elemIndex` ws wid = esize x wh hid = esize y hh n k h = maybe k (loc k h) $ w `elemIndex` ws nx = n x wh ny = n y hh upperTab = Rectangle nx y wid (fi ht) lowerTab = Rectangle nx (y + fi (hh - ht)) wid (fi ht) leftTab = Rectangle x ny (fi wt) hid rightTab = Rectangle (x + fi (wh - wt)) ny (fi wt) hid numWindows = length ws shrink (Tabbed loc _ ) (Rectangle _ _ dw dh) (Rectangle x y w h) = case loc of U -> Rectangle x (y + fi dh) w (h - dh) D -> Rectangle x y w (h - dh) L -> Rectangle (x + fi dw) y (w - dw) h R -> Rectangle x y (w - dw) h xmonad-contrib-0.12/XMonad/Layout/Hidden.hs0000644000000000000000000001266212636047674016766 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Hidden -- Copyright : (c) Peter Jones 2015 -- License : BSD3-style (see LICENSE) -- -- Maintainer : pjones@devalot.com -- Stability : unstable -- Portability : not portable -- -- Similar to "XMonad.Layout.Minimize" but completely removes windows -- from the window set so "XMonad.Layout.BoringWindows" isn't -- necessary. Perfect companion to -- "XMonad.Layout.BinarySpacePartition" since it can be used to move -- windows to another part of the BSP tree. -- ----------------------------------------------------------------------------- module XMonad.Layout.Hidden ( -- * Usage -- $usage HiddenMsg (..) , hiddenWindows , hideWindow , popOldestHiddenWindow , popNewestHiddenWindow ) where -------------------------------------------------------------------------------- import XMonad import XMonad.Layout.LayoutModifier import qualified XMonad.StackSet as W -------------------------------------------------------------------------------- -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Hidden -- -- Then edit your @layoutHook@ by adding the @HiddenWindows@ layout modifier: -- -- > myLayout = hiddenWindows (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- In the key bindings, do something like: -- -- > , ((modMask, xK_backslash), withFocused hideWindow) -- > , ((modMask .|. shiftMask, xK_backslash), popOldestHiddenWindow) -- > ... -- -- For detailed instruction on editing the key bindings see: -- -- "XMonad.Doc.Extending#Editing_key_bindings". -------------------------------------------------------------------------------- data HiddenWindows a = HiddenWindows [Window] deriving (Show, Read) -------------------------------------------------------------------------------- -- | Messages for the @HiddenWindows@ layout modifier. data HiddenMsg = HideWindow Window -- ^ Hide a window. | PopNewestHiddenWindow -- ^ Restore window (FILO). | PopOldestHiddenWindow -- ^ Restore window (FIFO). deriving (Typeable, Eq) instance Message HiddenMsg -------------------------------------------------------------------------------- instance LayoutModifier HiddenWindows Window where handleMess h@(HiddenWindows hidden) mess | Just (HideWindow win) <- fromMessage mess = hideWindowMsg h win | Just (PopNewestHiddenWindow) <- fromMessage mess = popNewestMsg h | Just (PopOldestHiddenWindow) <- fromMessage mess = popOldestMsg h | Just ReleaseResources <- fromMessage mess = doUnhook | otherwise = return Nothing where doUnhook = do mapM_ restoreWindow hidden return Nothing modifierDescription _ = "Hidden" -------------------------------------------------------------------------------- -- | Apply the @HiddenWindows@ layout modifier. hiddenWindows :: LayoutClass l Window => l Window -> ModifiedLayout HiddenWindows l Window hiddenWindows = ModifiedLayout $ HiddenWindows [] -------------------------------------------------------------------------------- -- | Remove the given window from the current layout. It is placed in -- list of hidden windows so it can be restored later. hideWindow :: Window -> X () hideWindow = sendMessage . HideWindow -------------------------------------------------------------------------------- -- | Restore a previously hidden window. Using this function will -- treat the list of hidden windows as a FIFO queue. That is, the -- first window hidden will be restored. popOldestHiddenWindow :: X () popOldestHiddenWindow = sendMessage PopOldestHiddenWindow -------------------------------------------------------------------------------- -- | Restore a previously hidden window. Using this function will -- treat the list of hidden windows as a FILO queue. That is, the -- most recently hidden window will be restored. popNewestHiddenWindow :: X () popNewestHiddenWindow = sendMessage PopNewestHiddenWindow -------------------------------------------------------------------------------- hideWindowMsg :: HiddenWindows a -> Window -> X (Maybe (HiddenWindows a)) hideWindowMsg (HiddenWindows hidden) win = do windows (W.delete' win) return . Just . HiddenWindows $ hidden ++ [win] -------------------------------------------------------------------------------- popNewestMsg :: HiddenWindows a -> X (Maybe (HiddenWindows a)) popNewestMsg (HiddenWindows []) = return Nothing popNewestMsg (HiddenWindows hidden) = do let (win, rest) = (last hidden, init hidden) restoreWindow win return . Just . HiddenWindows $ rest -------------------------------------------------------------------------------- popOldestMsg :: HiddenWindows a -> X (Maybe (HiddenWindows a)) popOldestMsg (HiddenWindows []) = return Nothing popOldestMsg (HiddenWindows (win:rest)) = do restoreWindow win return . Just . HiddenWindows $ rest -------------------------------------------------------------------------------- restoreWindow :: Window -> X () restoreWindow = windows . W.insertUp xmonad-contrib-0.12/XMonad/Layout/Groups.hs0000644000000000000000000005170412636047674017052 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-} {-# LANGUAGE StandaloneDeriving, FlexibleContexts, DeriveDataTypeable , UndecidableInstances, FlexibleInstances, MultiParamTypeClasses , PatternGuards, Rank2Types, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Groups -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Two-level layout with windows split in individual layout groups, -- themselves managed by a user-provided layout. -- ----------------------------------------------------------------------------- module XMonad.Layout.Groups ( -- * Usage -- $usage -- * Creation group -- * Messages , GroupsMessage(..) , ModifySpec -- ** Useful 'ModifySpec's , swapUp , swapDown , swapMaster , focusUp , focusDown , focusMaster , swapGroupUp , swapGroupDown , swapGroupMaster , focusGroupUp , focusGroupDown , focusGroupMaster , moveToGroupUp , moveToGroupDown , moveToNewGroupUp , moveToNewGroupDown , splitGroup -- * Types , Groups , Group(..) , onZipper , onLayout , WithID , sameID ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Util.Stack import Data.Maybe (isJust, isNothing, fromMaybe, catMaybes, fromJust) import Data.List ((\\)) import Control.Arrow ((>>>)) import Control.Applicative ((<$>)) import Control.Monad (forM) -- $usage -- This module provides a layout combinator that allows you -- to manage your windows in independent groups. You can provide -- both the layout with which to arrange the windows inside each -- group, and the layout with which the groups themselves will -- be arranged on the screen. -- -- The "XMonad.Layout.Groups.Examples" and "XMonad.Layout.Groups.Wmii" -- modules contain examples of layouts that can be defined with this -- combinator. They're also the recommended starting point -- if you are a beginner and looking for something you can use easily. -- -- One thing to note is that 'Groups'-based layout have their own -- notion of the order of windows, which is completely separate -- from XMonad's. For this reason, operations like 'XMonad.StackSet.SwapUp' -- will have no visible effect, and those like 'XMonad.StackSet.focusUp' -- will focus the windows in an unpredictable order. For a better way of -- rearranging windows and moving focus in such a layout, see the -- example 'ModifySpec's (to be passed to the 'Modify' message) provided -- by this module. -- -- If you use both 'Groups'-based and other layouts, The "XMonad.Layout.Groups.Helpers" -- module provides actions that can work correctly with both, defined using -- functions from "XMonad.Actions.MessageFeedback". -- | Create a 'Groups' layout. -- -- Note that the second parameter (the layout for arranging the -- groups) is not used on 'Windows', but on 'Group's. For this -- reason, you can only use layouts that don't specifically -- need to manage 'Window's. This is obvious, when you think -- about it. group :: l Window -> l2 (Group l Window) -> Groups l l2 Window group l l2 = Groups l l2 startingGroups (U 1 0) where startingGroups = fromJust $ singletonZ $ G (ID (U 0 0) l) emptyZ -- * Stuff with unique keys data Uniq = U Integer Integer deriving (Eq, Show, Read) -- | From a seed, generate an infinite list of keys and a new -- seed. All keys generated with this method will be different -- provided you don't use 'gen' again with a key from the list. -- (if you need to do that, see 'split' instead) gen :: Uniq -> (Uniq, [Uniq]) gen (U i1 i2) = (U (i1+1) i2, zipWith U (repeat i1) [i2..]) -- | Split an infinite list into two. I ended up not -- needing this, but let's keep it just in case. -- split :: [a] -> ([a], [a]) -- split as = snd $ foldr step (True, ([], [])) as -- where step a (True, (as1, as2)) = (False, (a:as1, as2)) -- step a (False, (as1, as2)) = (True, (as1, a:as2)) -- | Add a unique identity to a layout so we can -- follow it around. data WithID l a = ID { getID :: Uniq , unID :: (l a)} deriving (Show, Read) -- | Compare the ids of two 'WithID' values sameID :: WithID l a -> WithID l a -> Bool sameID (ID id1 _) (ID id2 _) = id1 == id2 instance Eq (WithID l a) where ID id1 _ == ID id2 _ = id1 == id2 instance LayoutClass l a => LayoutClass (WithID l) a where runLayout ws@W.Workspace { W.layout = ID id l } r = do (placements, ml') <- flip runLayout r ws { W.layout = l} return (placements, ID id <$> ml') handleMessage (ID id l) sm = do ml' <- handleMessage l sm return $ ID id <$> ml' description (ID _ l) = description l -- * The 'Groups' layout -- ** Datatypes -- | A group of windows and its layout algorithm. data Group l a = G { gLayout :: WithID l a , gZipper :: Zipper a } deriving (Show, Read, Eq) onLayout :: (WithID l a -> WithID l a) -> Group l a -> Group l a onLayout f g = g { gLayout = f $ gLayout g } onZipper :: (Zipper a -> Zipper a) -> Group l a -> Group l a onZipper f g = g { gZipper = f $ gZipper g } -- | The type of our layouts. data Groups l l2 a = Groups { -- | The starting layout for new groups baseLayout :: l a -- | The layout for placing each group on the screen , partitioner :: l2 (Group l a) -- | The window groups , groups :: W.Stack (Group l a) -- | A seed for generating unique ids , seed :: Uniq } deriving instance (Show a, Show (l a), Show (l2 (Group l a))) => Show (Groups l l2 a) deriving instance (Read a, Read (l a), Read (l2 (Group l a))) => Read (Groups l l2 a) -- | Messages accepted by 'Groups'-based layouts. -- All other messages are forwarded to the layout of the currently -- focused subgroup (as if they had been wrapped in 'ToFocused'). data GroupsMessage = ToEnclosing SomeMessage -- ^ Send a message to the enclosing layout -- (the one that places the groups themselves) | ToGroup Int SomeMessage -- ^ Send a message to the layout for nth group -- (starting at 0) | ToFocused SomeMessage -- ^ Send a message to the layout for the focused -- group | ToAll SomeMessage -- ^ Send a message to all the sub-layouts | Refocus -- ^ Refocus the window which should be focused according -- to the layout. | Modify ModifySpec -- ^ Modify the ordering\/grouping\/focusing -- of windows according to a 'ModifySpec' deriving Typeable instance Show GroupsMessage where show (ToEnclosing _) = "ToEnclosing {...}" show (ToGroup i _) = "ToGroup "++show i++" {...}" show (ToFocused _) = "ToFocused {...}" show (ToAll _) = "ToAll {...}" show Refocus = "Refocus" show (Modify _) = "Modify {...}" instance Message GroupsMessage modifyGroups :: (Zipper (Group l a) -> Zipper (Group l a)) -> Groups l l2 a -> Groups l l2 a modifyGroups f g = let (seed', id:_) = gen (seed g) defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ in g { groups = fromMaybe defaultGroups . f . Just $ groups g , seed = seed' } -- ** Readaptation -- | Adapt our groups to a new stack. -- This algorithm handles window additions and deletions correctly, -- ignores changes in window ordering, and tries to react to any -- other stack changes as gracefully as possible. readapt :: Eq a => Zipper a -> Groups l l2 a -> Groups l l2 a readapt z g = let mf = getFocusZ z (seed', id:_) = gen $ seed g g' = g { seed = seed' } in flip modifyGroups g' $ mapZ_ (onZipper $ removeDeleted z) >>> filterKeepLast (isJust . gZipper) >>> findNewWindows (W.integrate' z) >>> addWindows (ID id $ baseLayout g) >>> focusGroup mf >>> onFocusedZ (onZipper $ focusWindow mf) where filterKeepLast _ Nothing = Nothing filterKeepLast f z@(Just s) = maybe (singletonZ $ W.focus s) Just $ filterZ_ f z -- | Remove the windows from a group which are no longer present in -- the stack. removeDeleted :: Eq a => Zipper a -> Zipper a -> Zipper a removeDeleted z = filterZ_ (flip elemZ z) -- | Identify the windows not already in a group. findNewWindows :: Eq a => [a] -> Zipper (Group l a) -> (Zipper (Group l a), [a]) findNewWindows as gs = (gs, foldrZ_ removePresent as gs) where removePresent g as' = filter (not . flip elemZ (gZipper g)) as' -- | Add windows to the focused group. If you need to create one, -- use the given layout and an id from the given list. addWindows :: WithID l a -> (Zipper (Group l a), [a]) -> Zipper (Group l a) addWindows l (Nothing, as) = singletonZ $ G l (W.differentiate as) addWindows _ (z, as) = onFocusedZ (onZipper add) z where add z = foldl (flip insertUpZ) z as -- | Focus the group containing the given window focusGroup :: Eq a => Maybe a -> Zipper (Group l a) -> Zipper (Group l a) focusGroup Nothing = id focusGroup (Just a) = fromTags . map (tagBy $ elemZ a . gZipper) . W.integrate' -- | Focus the given window focusWindow :: Eq a => Maybe a -> Zipper a -> Zipper a focusWindow Nothing = id focusWindow (Just a) = fromTags . map (tagBy (==a)) . W.integrate' -- * Interface -- ** Layout instance instance (LayoutClass l Window, LayoutClass l2 (Group l Window)) => LayoutClass (Groups l l2) Window where description (Groups _ p gs _) = s1++" by "++s2 where s1 = description $ gLayout $ W.focus gs s2 = description p runLayout ws@(W.Workspace _ _l z) r = let l = readapt z _l in do (areas, mpart') <- runLayout ws { W.layout = partitioner l , W.stack = Just $ groups l } r results <- forM areas $ \(g, r') -> runLayout ws { W.layout = gLayout g , W.stack = gZipper g } r' let hidden = map gLayout (W.integrate $ groups l) \\ map (gLayout . fst) areas hidden' <- mapM (flip handleMessage $ SomeMessage Hide) hidden let placements = concatMap fst results newL = justMakeNew l mpart' (map snd results ++ hidden') return $ (placements, newL) handleMessage l@(Groups _ p _ _) sm | Just (ToEnclosing sm') <- fromMessage sm = do mp' <- handleMessage p sm' return $ maybeMakeNew l mp' [] handleMessage l@(Groups _ p gs _) sm | Just (ToAll sm') <- fromMessage sm = do mp' <- handleMessage p sm' mg's <- mapZM_ (handle sm') $ Just gs return $ maybeMakeNew l mp' $ W.integrate' mg's where handle sm (G l _) = handleMessage l sm handleMessage l sm | Just a <- fromMessage sm = let _rightType = a == Hide -- Is there a better-looking way -- of doing this? in handleMessage l $ SomeMessage $ ToAll sm handleMessage l@(Groups _ _ z _) sm = case fromMessage sm of Just (ToFocused sm') -> do mg's <- W.integrate' <$> handleOnFocused sm' z return $ maybeMakeNew l Nothing mg's Just (ToGroup i sm') -> do mg's <- handleOnIndex i sm' z return $ maybeMakeNew l Nothing mg's Just (Modify spec) -> case applySpec spec l of Just l' -> refocus l' >> return (Just l') Nothing -> return $ Just l Just Refocus -> refocus l >> return (Just l) Just _ -> return Nothing Nothing -> handleMessage l $ SomeMessage (ToFocused sm) where handleOnFocused sm z = mapZM step $ Just z where step True (G l _) = handleMessage l sm step False _ = return Nothing handleOnIndex i sm z = mapM step $ zip [0..] $ W.integrate z where step (j, (G l _)) | i == j = handleMessage l sm step _ = return Nothing justMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)] -> Maybe (Groups l l2 a) justMakeNew g mpart' ml's = Just g { partitioner = fromMaybe (partitioner g) mpart' , groups = combine (groups g) ml's } where combine z ml's = let table = map (\(ID id a) -> (id, a)) $ catMaybes ml's in flip mapS_ z $ \(G (ID id l) ws) -> case lookup id table of Nothing -> G (ID id l) ws Just l' -> G (ID id l') ws mapS_ f = fromJust . mapZ_ f . Just maybeMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)] -> Maybe (Groups l l2 a) maybeMakeNew _ Nothing ml's | all isNothing ml's = Nothing maybeMakeNew g mpart' ml's = justMakeNew g mpart' ml's refocus :: Groups l l2 Window -> X () refocus g = case getFocusZ $ gZipper $ W.focus $ groups g of Just w -> focus w Nothing -> return () -- ** ModifySpec type -- | Type of functions describing modifications to a 'Groups' layout. They -- are transformations on 'Zipper's of groups. -- -- Things you shouldn't do: -- -- * Forge new windows (they will be ignored) -- -- * Duplicate windows (whatever happens is your problem) -- -- * Remove windows (they will be added again) -- -- * Duplicate layouts (only one will be kept, the rest will -- get the base layout) -- -- Note that 'ModifySpec' is a rank-2 type (indicating that 'ModifySpec's must -- be polymorphic in the layout type), so if you define functions taking -- 'ModifySpec's as arguments, or returning them, you'll need to write a type -- signature and add @{-# LANGUAGE Rank2Types #-}@ at the beginning type ModifySpec = forall l. WithID l Window -> Zipper (Group l Window) -> Zipper (Group l Window) -- | Apply a ModifySpec. applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window) applySpec f g = let (seed', id:ids) = gen $ seed g g' = flip modifyGroups g $ f (ID id $ baseLayout g) >>> toTags >>> foldr reID ((ids, []), []) >>> snd >>> fromTags in case groups g == groups g' of True -> Nothing False -> Just g' { seed = seed' } where reID eg ((id:ids, seen), egs) = let myID = getID $ gLayout $ fromE eg in case elem myID seen of False -> ((id:ids, myID:seen), eg:egs) True -> ((ids, seen), mapE_ (setID id) eg:egs) where setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z reID _ (([], _), _) = undefined -- The list of ids is infinite -- ** Misc. ModifySpecs -- | helper onFocused :: (Zipper Window -> Zipper Window) -> ModifySpec onFocused f _ gs = onFocusedZ (onZipper f) gs -- | Swap the focused window with the previous one. swapUp :: ModifySpec swapUp = onFocused swapUpZ -- | Swap the focused window with the next one. swapDown :: ModifySpec swapDown = onFocused swapDownZ -- | Swap the focused window with the (group's) master -- window. swapMaster :: ModifySpec swapMaster = onFocused swapMasterZ -- | Swap the focused group with the previous one. swapGroupUp :: ModifySpec swapGroupUp _ = swapUpZ -- | Swap the focused group with the next one. swapGroupDown :: ModifySpec swapGroupDown _ = swapDownZ -- | Swap the focused group with the master group. swapGroupMaster :: ModifySpec swapGroupMaster _ = swapMasterZ -- | Move focus to the previous window in the group. focusUp :: ModifySpec focusUp = onFocused focusUpZ -- | Move focus to the next window in the group. focusDown :: ModifySpec focusDown = onFocused focusDownZ -- | Move focus to the group's master window. focusMaster :: ModifySpec focusMaster = onFocused focusMasterZ -- | Move focus to the previous group. focusGroupUp :: ModifySpec focusGroupUp _ = focusUpZ -- | Move focus to the next group. focusGroupDown :: ModifySpec focusGroupDown _ = focusDownZ -- | Move focus to the master group. focusGroupMaster :: ModifySpec focusGroupMaster _ = focusMasterZ -- | helper _removeFocused :: W.Stack a -> (a, Zipper a) _removeFocused (W.Stack f (u:up) down) = (f, Just $ W.Stack u up down) _removeFocused (W.Stack f [] (d:down)) = (f, Just $ W.Stack d [] down) _removeFocused (W.Stack f [] []) = (f, Nothing) -- helper _moveToNewGroup :: WithID l Window -> W.Stack (Group l Window) -> (Group l Window -> Zipper (Group l Window) -> Zipper (Group l Window)) -> Zipper (Group l Window) _moveToNewGroup l0 s insertX | G l (Just f) <- W.focus s = let (w, f') = _removeFocused f s' = s { W.focus = G l f' } in insertX (G l0 $ singletonZ w) $ Just s' _moveToNewGroup _ s _ = Just s -- | Move the focused window to a new group before the current one. moveToNewGroupUp :: ModifySpec moveToNewGroupUp _ Nothing = Nothing moveToNewGroupUp l0 (Just s) = _moveToNewGroup l0 s insertUpZ -- | Move the focused window to a new group after the current one. moveToNewGroupDown :: ModifySpec moveToNewGroupDown _ Nothing = Nothing moveToNewGroupDown l0 (Just s) = _moveToNewGroup l0 s insertDownZ -- | Move the focused window to the previous group. -- If 'True', when in the first group, wrap around to the last one. -- If 'False', create a new group before it. moveToGroupUp :: Bool -> ModifySpec moveToGroupUp _ _ Nothing = Nothing moveToGroupUp False l0 (Just s) = if null (W.up s) then moveToNewGroupUp l0 (Just s) else moveToGroupUp True l0 (Just s) moveToGroupUp True _ (Just s@(W.Stack _ [] [])) = Just s moveToGroupUp True _ (Just s@(W.Stack (G l (Just f)) _ _)) = let (w, f') = _removeFocused f in onFocusedZ (onZipper $ insertUpZ w) $ focusUpZ $ Just s { W.focus = G l f' } moveToGroupUp True _ gs = gs -- | Move the focused window to the next group. -- If 'True', when in the last group, wrap around to the first one. -- If 'False', create a new group after it. moveToGroupDown :: Bool -> ModifySpec moveToGroupDown _ _ Nothing = Nothing moveToGroupDown False l0 (Just s) = if null (W.down s) then moveToNewGroupDown l0 (Just s) else moveToGroupDown True l0 (Just s) moveToGroupDown True _ (Just s@(W.Stack _ [] [])) = Just s moveToGroupDown True _ (Just s@(W.Stack (G l (Just f)) _ _)) = let (w, f') = _removeFocused f in onFocusedZ (onZipper $ insertUpZ w) $ focusDownZ $ Just s { W.focus = G l f' } moveToGroupDown True _ gs = gs -- | Split the focused group into two at the position of the focused window (below it, -- unless it's the last window - in that case, above it). splitGroup :: ModifySpec splitGroup _ Nothing = Nothing splitGroup l0 z@(Just s) | G l (Just ws) <- W.focus s = case ws of W.Stack _ [] [] -> z W.Stack f (u:up) [] -> let g1 = G l $ Just $ W.Stack f [] [] g2 = G l0 $ Just $ W.Stack u up [] in insertDownZ g1 $ onFocusedZ (const g2) z W.Stack f up (d:down) -> let g1 = G l $ Just $ W.Stack f up [] g2 = G l0 $ Just $ W.Stack d [] down in insertUpZ g1 $ onFocusedZ (const g2) z splitGroup _ _ = Nothing xmonad-contrib-0.12/XMonad/Layout/Magnifier.hs0000644000000000000000000001532012636047674017466 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Magnifier -- Copyright : (c) Peter De Wachter and Andrea Rossato 2007 -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- Screenshot : -- -- This is a layout modifier that will make a layout increase the size -- of the window that has focus. -- ----------------------------------------------------------------------------- module XMonad.Layout.Magnifier ( -- * Usage -- $usage magnifier, magnifier', magnifierOff, magnifiercz, magnifiercz', maximizeVertical, MagnifyMsg (..), Magnifier, ) where import XMonad import XMonad.StackSet import XMonad.Layout.LayoutModifier import XMonad.Util.XUtils -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Magnifier -- -- Then edit your @layoutHook@ by adding the 'magnifier' layout modifier -- to some layout: -- -- > myLayout = magnifier (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- By default magnifier increases the focused window's size by 1.5. -- You can also use: -- -- > magnifiercz 1.2 -- -- to use a custom level of magnification. You can even make the focused -- window smaller for a pop in effect. -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- Magnifier supports some commands. To use them add something like -- this to your key bindings: -- -- > , ((modm .|. controlMask , xK_plus ), sendMessage MagnifyMore) -- > , ((modm .|. controlMask , xK_minus), sendMessage MagnifyLess) -- > , ((modm .|. controlMask , xK_o ), sendMessage ToggleOff ) -- > , ((modm .|. controlMask .|. shiftMask, xK_o ), sendMessage ToggleOn ) -- > , ((modm .|. controlMask , xK_m ), sendMessage Toggle ) -- -- Note that a few other extension modules, such as -- "XMonad.Layout.MultiToggle" and "XMonad.Layout.ToggleLayouts", also -- define a message named 'Toggle'. To avoid conflicts when using -- these modules together, you can import Magnifier qualified, like -- this: -- -- > import qualified XMonad.Layout.Magnifier as Mag -- -- and then prefix @Mag@ to the front of everything from this module, -- like @Mag.Toggle@, @Mag.magnifier@, and so on. -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Increase the size of the window that has focus magnifier :: l a -> ModifiedLayout Magnifier l a magnifier = ModifiedLayout (Mag (1.5,1.5) On All) -- | Change the size of the window that has focus by a custom zoom magnifiercz :: Rational -> l a -> ModifiedLayout Magnifier l a magnifiercz cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On All) -- | Increase the size of the window that has focus, unless if it is the -- master window. magnifier' :: l a -> ModifiedLayout Magnifier l a magnifier' = ModifiedLayout (Mag (1.5,1.5) On NoMaster) -- | Magnifier that defaults to Off magnifierOff :: l a -> ModifiedLayout Magnifier l a magnifierOff = ModifiedLayout (Mag (1.5,1.5) Off All) -- | Increase the size of the window that has focus by a custom zoom, -- unless if it is the master window. magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a magnifiercz' cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On NoMaster) -- | A magnifier that greatly magnifies just the vertical direction maximizeVertical :: l a -> ModifiedLayout Magnifier l a maximizeVertical = ModifiedLayout (Mag (1,1000) Off All) data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle deriving ( Typeable ) instance Message MagnifyMsg data Magnifier a = Mag (Double,Double) Toggle MagnifyMaster deriving (Read, Show) data Toggle = On | Off deriving (Read, Show) data MagnifyMaster = All | NoMaster deriving (Read, Show) instance LayoutModifier Magnifier Window where redoLayout (Mag z On All ) r (Just s) wrs = applyMagnifier z r s wrs redoLayout (Mag z On NoMaster) r (Just s) wrs = unlessMaster (applyMagnifier z) r s wrs redoLayout _ _ _ wrs = return (wrs, Nothing) handleMess (Mag z On t) m | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z `addto` 0.1 ) On t) | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z `addto` (-0.1)) On t) | Just ToggleOff <- fromMessage m = return . Just $ (Mag (z ) Off t) | Just Toggle <- fromMessage m = return . Just $ (Mag (z ) Off t) where addto (x,y) i = (x+i,y+i) handleMess (Mag z Off t) m | Just ToggleOn <- fromMessage m = return . Just $ (Mag z On t) | Just Toggle <- fromMessage m = return . Just $ (Mag z On t) handleMess _ _ = return Nothing modifierDescription (Mag _ On All ) = "Magnifier" modifierDescription (Mag _ On NoMaster) = "Magnifier NoMaster" modifierDescription (Mag _ Off _ ) = "Magnifier (off)" type NewLayout a = Rectangle -> Stack a -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe (Magnifier a)) unlessMaster :: NewLayout a -> NewLayout a unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing) else mainmod r s wrs applyMagnifier :: (Double,Double) -> Rectangle -> t -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe a) applyMagnifier z r _ wrs = do focused <- withWindowSet (return . peek) let mag (w,wr) ws | focused == Just w = ws ++ [(w, fit r $ magnify z wr)] | otherwise = (w,wr) : ws return (reverse $ foldr mag [] wrs, Nothing) magnify :: (Double, Double) -> Rectangle -> Rectangle magnify (zoomx,zoomy) (Rectangle x y w h) = Rectangle x' y' w' h' where x' = x - fromIntegral (w' - w) `div` 2 y' = y - fromIntegral (h' - h) `div` 2 w' = round $ fromIntegral w * zoomx h' = round $ fromIntegral h * zoomy fit :: Rectangle -> Rectangle -> Rectangle fit (Rectangle sx sy sw sh) (Rectangle x y w h) = Rectangle x' y' w' h' where x' = max sx (x - (max 0 (x + fi w - sx - fi sw))) y' = max sy (y - (max 0 (y + fi h - sy - fi sh))) w' = min sw w h' = min sh h xmonad-contrib-0.12/XMonad/Layout/PerWorkspace.hs0000644000000000000000000001334612636047674020200 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.PerWorkspace -- Copyright : (c) Brent Yorgey -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Configure layouts on a per-workspace basis: use layouts and apply -- layout modifiers selectively, depending on the workspace. ----------------------------------------------------------------------------- module XMonad.Layout.PerWorkspace ( -- * Usage -- $usage PerWorkspace, onWorkspace, onWorkspaces, modWorkspace, modWorkspaces ) where import XMonad import qualified XMonad.StackSet as W import Data.Maybe (fromMaybe) -- $usage -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: -- -- > import XMonad.Layout.PerWorkspace -- -- and modifying your layoutHook as follows (for example): -- -- > layoutHook = modWorkspace "baz" m1 $ -- apply layout modifier m1 to all layouts on workspace "baz" -- > onWorkspace "foo" l1 $ -- layout l1 will be used on workspace "foo". -- > onWorkspaces ["bar","6"] l2 $ -- layout l2 will be used on workspaces "bar" and "6". -- > l3 -- layout l3 will be used on all other workspaces. -- -- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated -- layouts, e.g. @(Full ||| smartBorders $ tabbed shrinkText -- defaultTConf ||| ...)@, and @m1@ can be any layout modifier, i.e. a -- function of type @(l a -> ModifiedLayout lm l a)@. (In fact, @m1@ can be any -- function @(LayoutClass l a, LayoutClass l' a) => l a -> l' a@.) -- -- In another scenario, suppose you wanted to have layouts A, B, and C -- available on all workspaces, except that on workspace foo you want -- layout D instead of C. You could do that as follows: -- -- > layoutHook = A ||| B ||| onWorkspace "foo" D C -- | Specify one layout to use on a particular workspace, and another -- to use on all others. The second layout can be another call to -- 'onWorkspace', and so on. onWorkspace :: (LayoutClass l1 a, LayoutClass l2 a) => WorkspaceId -- ^ the tag of the workspace to match -> (l1 a) -- ^ layout to use on the matched workspace -> (l2 a) -- ^ layout to use everywhere else -> PerWorkspace l1 l2 a onWorkspace wsId = onWorkspaces [wsId] -- | Specify one layout to use on a particular set of workspaces, and -- another to use on all other workspaces. onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a) => [WorkspaceId] -- ^ tags of workspaces to match -> (l1 a) -- ^ layout to use on matched workspaces -> (l2 a) -- ^ layout to use everywhere else -> PerWorkspace l1 l2 a onWorkspaces wsIds = modWorkspaces wsIds . const -- | Specify a layout modifier to apply to a particular workspace; layouts -- on all other workspaces will remain unmodified. modWorkspace :: (LayoutClass l1 a, LayoutClass l2 a) => WorkspaceId -- ^ tag of the workspace to match -> (l2 a -> l1 a) -- ^ the modifier to apply on the matching workspace -> l2 a -- ^ the base layout -> PerWorkspace l1 l2 a modWorkspace wsId = modWorkspaces [wsId] -- | Specify a layout modifier to apply to a particular set of -- workspaces; layouts on all other workspaces will remain -- unmodified. modWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a) => [WorkspaceId] -- ^ tags of the workspaces to match -> (l2 a -> l1 a) -- ^ the modifier to apply on the matching workspaces -> l2 a -- ^ the base layout -> PerWorkspace l1 l2 a modWorkspaces wsIds f l = PerWorkspace wsIds False (f l) l -- | Structure for representing a workspace-specific layout along with -- a layout for all other workspaces. We store the tags of workspaces -- to be matched, and the two layouts. We save the layout choice in -- the Bool, to be used to implement description. data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId] Bool (l1 a) (l2 a) deriving (Read, Show) instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerWorkspace l1 l2) a where runLayout (W.Workspace i p@(PerWorkspace wsIds _ lt lf) ms) r | i `elem` wsIds = do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r return (wrs, Just $ mkNewPerWorkspaceT p mlt') | otherwise = do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r return (wrs, Just $ mkNewPerWorkspaceF p mlt') handleMessage (PerWorkspace wsIds bool lt lf) m | bool = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ PerWorkspace wsIds bool nt lf) | otherwise = handleMessage lf m >>= maybe (return Nothing) (\nf -> return . Just $ PerWorkspace wsIds bool lt nf) description (PerWorkspace _ True l1 _) = description l1 description (PerWorkspace _ _ _ l2) = description l2 -- | Construct new PerWorkspace values with possibly modified layouts. mkNewPerWorkspaceT :: PerWorkspace l1 l2 a -> Maybe (l1 a) -> PerWorkspace l1 l2 a mkNewPerWorkspaceT (PerWorkspace wsIds _ lt lf) mlt' = (\lt' -> PerWorkspace wsIds True lt' lf) $ fromMaybe lt mlt' mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) -> PerWorkspace l1 l2 a mkNewPerWorkspaceF (PerWorkspace wsIds _ lt lf) mlf' = (\lf' -> PerWorkspace wsIds False lt lf') $ fromMaybe lf mlf' xmonad-contrib-0.12/XMonad/Layout/Reflect.hs0000644000000000000000000000756212636047674017162 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Reflect -- Copyright : (c) Brent Yorgey -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Reflect a layout horizontally or vertically. ----------------------------------------------------------------------------- module XMonad.Layout.Reflect ( -- * Usage -- $usage reflectHoriz, reflectVert, REFLECTX(..), REFLECTY(..), Reflect ) where import XMonad.Core import Graphics.X11 (Rectangle(..), Window) import Control.Arrow (second) import XMonad.Layout.LayoutModifier import XMonad.Layout.MultiToggle import XMonad.Util.XUtils (fi) -- $usage -- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Layout.Reflect -- -- and modifying your layoutHook as follows (for example): -- -- > layoutHook = reflectHoriz $ Tall 1 (3/100) (1/2) -- put master pane on the right -- -- 'reflectHoriz' and 'reflectVert' can be applied to any sort of -- layout (including Mirrored layouts) and will simply flip the -- physical layout of the windows vertically or horizontally. -- -- "XMonad.Layout.MultiToggle" transformers are also provided for -- toggling layouts between reflected\/non-reflected with a keybinding. -- To use this feature, you will also need to import the MultiToggle -- module: -- -- > import XMonad.Layout.MultiToggle -- -- Next, add one or more toggles to your layout. For example, to allow -- separate toggling of both vertical and horizontal reflection: -- -- > layoutHook = mkToggle (single REFLECTX) $ -- > mkToggle (single REFLECTY) $ -- > (tiled ||| Mirror tiled ||| ...) -- whatever layouts you use -- -- Finally, add some keybindings to do the toggling, for example: -- -- > , ((modm .|. controlMask, xK_x), sendMessage $ Toggle REFLECTX) -- > , ((modm .|. controlMask, xK_y), sendMessage $ Toggle REFLECTY) -- -- | Apply a horizontal reflection (left \<--\> right) to a -- layout. reflectHoriz :: l a -> ModifiedLayout Reflect l a reflectHoriz = ModifiedLayout (Reflect Horiz) -- | Apply a vertical reflection (top \<--\> bottom) to a -- layout. reflectVert :: l a -> ModifiedLayout Reflect l a reflectVert = ModifiedLayout (Reflect Vert) data ReflectDir = Horiz | Vert deriving (Read, Show) -- | Given an axis of reflection and the enclosing rectangle which -- contains all the laid out windows, transform a rectangle -- representing a window into its flipped counterpart. reflectRect :: ReflectDir -> Rectangle -> Rectangle -> Rectangle reflectRect Horiz (Rectangle sx _ sw _) (Rectangle rx ry rw rh) = Rectangle (2*sx + fi sw - rx - fi rw) ry rw rh reflectRect Vert (Rectangle _ sy _ sh) (Rectangle rx ry rw rh) = Rectangle rx (2*sy + fi sh - ry - fi rh) rw rh data Reflect a = Reflect ReflectDir deriving (Show, Read) instance LayoutModifier Reflect a where -- reflect all the generated Rectangles. pureModifier (Reflect d) r _ wrs = (map (second $ reflectRect d r) wrs, Just $ Reflect d) modifierDescription (Reflect d) = "Reflect" ++ xy where xy = case d of { Horiz -> "X" ; Vert -> "Y" } -------- instances for MultiToggle ------------------ data REFLECTX = REFLECTX deriving (Read, Show, Eq, Typeable) data REFLECTY = REFLECTY deriving (Read, Show, Eq, Typeable) instance Transformer REFLECTX Window where transform REFLECTX x k = k (reflectHoriz x) (\(ModifiedLayout _ x') -> x') instance Transformer REFLECTY Window where transform REFLECTY x k = k (reflectVert x) (\(ModifiedLayout _ x') -> x') xmonad-contrib-0.12/XMonad/Layout/Maximize.hs0000644000000000000000000000735012636047674017354 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Maximize -- Copyright : (c) 2007 James Webb -- License : BSD3-style (see LICENSE) -- -- Maintainer : xmonad#jwebb,sygneca,com -- Stability : unstable -- Portability : unportable -- -- Temporarily yanks the focused window out of the layout to mostly fill -- the screen. -- ----------------------------------------------------------------------------- module XMonad.Layout.Maximize ( -- * Usage -- $usage maximize, maximizeWithPadding, maximizeRestore, Maximize, MaximizeRestore, ) where import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.LayoutModifier import Data.List ( partition ) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Maximize -- -- Then edit your @layoutHook@ by adding the Maximize layout modifier: -- -- > myLayout = maximize (Tall 1 (3/100) (1/2)) ||| Full ||| etc..) -- > main = xmonad def { layoutHook = myLayout } -- -- Or, if you want to control the amount of padding placed around the -- maximized window: -- -- > myLayout = maximizeWithPadding 10 (Tall 1 (3/100) (1/2)) ||| Full ||| etc..) -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- In the key-bindings, do something like: -- -- > , ((modm, xK_backslash), withFocused (sendMessage . maximizeRestore)) -- > ... -- -- For detailed instruction on editing the key binding see: -- -- "XMonad.Doc.Extending#Editing_key_bindings". data Maximize a = Maximize Dimension (Maybe Window) deriving ( Read, Show ) maximize :: LayoutClass l Window => l Window -> ModifiedLayout Maximize l Window maximize = ModifiedLayout $ Maximize 25 Nothing -- | Like 'maximize', but allows you to specify the amount of padding -- placed around the maximized window. maximizeWithPadding :: LayoutClass l Window => Dimension -> l Window -> ModifiedLayout Maximize l Window maximizeWithPadding padding = ModifiedLayout $ Maximize padding Nothing data MaximizeRestore = MaximizeRestore Window deriving ( Typeable, Eq ) instance Message MaximizeRestore maximizeRestore :: Window -> MaximizeRestore maximizeRestore = MaximizeRestore instance LayoutModifier Maximize Window where modifierDescription (Maximize _ _) = "Maximize" pureModifier (Maximize padding (Just target)) rect (Just (S.Stack focused _ _)) wrs = if focused == target then (maxed ++ rest, Nothing) else (rest ++ maxed, lay) where (toMax, rest) = partition (\(w, _) -> w == target) wrs maxed = map (\(w, _) -> (w, maxRect)) toMax maxRect = Rectangle (rect_x rect + fromIntegral padding) (rect_y rect + fromIntegral padding) (rect_width rect - padding * 2) (rect_height rect - padding * 2) lay | null maxed = Just (Maximize padding Nothing) | otherwise = Nothing pureModifier _ _ _ wrs = (wrs, Nothing) pureMess (Maximize padding mw) m = case fromMessage m of Just (MaximizeRestore w) -> case mw of Just w' -> if (w == w') then Just $ Maximize padding Nothing -- restore window else Just $ Maximize padding $ Just w -- maximize different window Nothing -> Just $ Maximize padding $ Just w -- maximize window _ -> Nothing -- vim: sw=4:et xmonad-contrib-0.12/XMonad/Layout/Accordion.hs0000644000000000000000000000362312636047674017471 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Accordion -- Copyright : (c) glasser@mit.edu -- License : BSD -- -- Maintainer : glasser@mit.edu -- Stability : stable -- Portability : unportable -- -- LayoutClass that puts non-focused windows in ribbons at the top and bottom -- of the screen. ----------------------------------------------------------------------------- module XMonad.Layout.Accordion ( -- * Usage -- $usage Accordion(Accordion)) where import XMonad import qualified XMonad.StackSet as W import Data.Ratio -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Accordion -- -- Then edit your @layoutHook@ by adding the Accordion layout: -- -- > myLayout = Accordion ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" data Accordion a = Accordion deriving ( Read, Show ) instance LayoutClass Accordion Window where pureLayout _ sc ws = zip ups tops ++ [(W.focus ws, mainPane)] ++ zip dns bottoms where ups = reverse $ W.up ws dns = W.down ws (top, allButTop) = splitVerticallyBy (1%8 :: Ratio Int) sc (center, bottom) = splitVerticallyBy (6%7 :: Ratio Int) allButTop (allButBottom, _) = splitVerticallyBy (7%8 :: Ratio Int) sc mainPane | ups /= [] && dns /= [] = center | ups /= [] = allButTop | dns /= [] = allButBottom | otherwise = sc tops = if ups /= [] then splitVertically (length ups) top else [] bottoms = if dns /= [] then splitVertically (length dns) bottom else [] xmonad-contrib-0.12/XMonad/Layout/DragPane.hs0000644000000000000000000001304012636047674017243 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DragPane -- Copyright : (c) Spencer Janssen -- David Roundy , -- Andrea Rossato -- License : BSD3-style (see LICENSE) -- -- Maintainer : Andrea Rossato -- Stability : unstable -- Portability : unportable -- -- Layouts that splits the screen either horizontally or vertically and -- shows two windows. The first window is always the master window, and -- the other is either the currently focused window or the second window in -- layout order. ----------------------------------------------------------------------------- module XMonad.Layout.DragPane ( -- * Usage -- $usage dragPane , DragPane, DragType (..) ) where import XMonad import Data.Unique import qualified XMonad.StackSet as W import XMonad.Util.Invisible import XMonad.Util.XUtils -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.DragPane -- -- Then edit your @layoutHook@ by adding the DragPane layout: -- -- > myLayout = dragPane Horizontal 0.1 0.5 ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" halfHandleWidth :: Integral a => a halfHandleWidth = 1 handleColor :: String handleColor = "#000000" dragPane :: DragType -> Double -> Double -> DragPane a dragPane t x y = DragPane (I Nothing) t x y data DragPane a = DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double deriving ( Show, Read ) data DragType = Horizontal | Vertical deriving ( Show, Read ) instance LayoutClass DragPane a where doLayout d@(DragPane _ Vertical _ _) = doLay id d doLayout d@(DragPane _ Horizontal _ _) = doLay mirrorRect d handleMessage = handleMess data SetFrac = SetFrac Int Double deriving ( Show, Read, Eq, Typeable ) instance Message SetFrac handleMess :: DragPane a -> SomeMessage -> X (Maybe (DragPane a)) handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x | Just e <- fromMessage x :: Maybe Event = do handleEvent d e return Nothing | Just Hide <- fromMessage x = do hideWindow win return $ Just (DragPane mb ty delta split) | Just ReleaseResources <- fromMessage x = do deleteWindow win return $ Just (DragPane (I Nothing) ty delta split) -- layout specific messages | Just Shrink <- fromMessage x = return $ Just (DragPane mb ty delta (split - delta)) | Just Expand <- fromMessage x = return $ Just (DragPane mb ty delta (split + delta)) | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = do return $ Just (DragPane mb ty delta frac) handleMess _ _ = return Nothing handleEvent :: DragPane a -> Event -> X () handleEvent (DragPane (I (Just (win,r,ident))) ty _ _) (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t }) | t == buttonPress && thisw == win || thisbw == win = do mouseDrag (\ex ey -> do let frac = case ty of Vertical -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r) Horizontal -> (fromIntegral ey - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r) sendMessage (SetFrac ident frac)) (return ()) handleEvent _ _ = return () doLay :: (Rectangle -> Rectangle) -> DragPane a -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a)) doLay mirror (DragPane mw ty delta split) r s = do let r' = mirror r (left', right') = splitHorizontallyBy split r' left = case left' of Rectangle x y w h -> mirror $ Rectangle x y (w-halfHandleWidth) h right = case right' of Rectangle x y w h -> mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h handr = case left' of Rectangle x y w h -> mirror $ Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h wrs = case reverse (W.up s) of (master:_) -> [(master,left),(W.focus s,right)] [] -> case W.down s of (next:_) -> [(W.focus s,left),(next,right)] [] -> [(W.focus s, r)] if length wrs > 1 then case mw of I (Just (w,_,ident)) -> do w' <- deleteWindow w >> newDragWin handr return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split) I Nothing -> do w <- newDragWin handr i <- io $ newUnique return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split) else return (wrs, Nothing) newDragWin :: Rectangle -> X Window newDragWin r = do let mask = Just $ exposureMask .|. buttonPressMask w <- createNewWindow r mask handleColor False showWindow w d <- asks display liftIO $ lowerWindow d w return w xmonad-contrib-0.12/XMonad/Layout/ThreeColumns.hs0000644000000000000000000001065012636047674020176 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ThreeColumns -- Copyright : (c) Kai Grossjohann -- License : BSD3-style (see LICENSE) -- -- Maintainer : ? -- Stability : unstable -- Portability : unportable -- -- A layout similar to tall but with three columns. With 2560x1600 pixels this -- layout can be used for a huge main window and up to six reasonable sized -- slave windows. ----------------------------------------------------------------------------- module XMonad.Layout.ThreeColumns ( -- * Usage -- $usage -- * Screenshots -- $screenshot ThreeCol(..) ) where import XMonad import qualified XMonad.StackSet as W import Data.Ratio import Control.Monad -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.ThreeColumns -- -- Then edit your @layoutHook@ by adding the ThreeCol layout: -- -- > myLayout = ThreeCol 1 (3/100) (1/2) ||| ThreeColMid 1 (3/100) (1/2) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- The first argument specifies how many windows initially appear in the main -- window. The second argument argument specifies the amount to resize while -- resizing and the third argument specifies the initial size of the columns. -- A positive size designates the fraction of the screen that the main window -- should occupy, but if the size is negative the absolute value designates the -- fraction a slave column should occupy. If both slave columns are visible, -- they always occupy the same amount of space. -- -- The ThreeColMid variant places the main window between the slave columns. -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- $screenshot -- <> -- | Arguments are nmaster, delta, fraction data ThreeCol a = ThreeColMid { threeColNMaster :: !Int, threeColDelta :: !Rational, threeColFrac :: !Rational} | ThreeCol { threeColNMaster :: !Int, threeColDelta :: !Rational, threeColFrac :: !Rational} deriving (Show,Read) instance LayoutClass ThreeCol a where pureLayout (ThreeCol n _ f) r = doL False n f r pureLayout (ThreeColMid n _ f) r = doL True n f r handleMessage l m = return $ msum [fmap resize (fromMessage m) ,fmap incmastern (fromMessage m)] where resize Shrink = l { threeColFrac = max (-0.5) $ f-d } resize Expand = l { threeColFrac = min 1 $ f+d } incmastern (IncMasterN x) = l { threeColNMaster = max 0 (n+x) } n = threeColNMaster l d = threeColDelta l f = threeColFrac l description _ = "ThreeCol" doL :: Bool-> Int-> Rational-> Rectangle-> W.Stack a-> [(a, Rectangle)] doL m n f r = ap zip (tile3 m f r n . length) . W.integrate -- | tile3. Compute window positions using 3 panes tile3 :: Bool -> Rational -> Rectangle -> Int -> Int -> [Rectangle] tile3 middle f r nmaster n | n <= nmaster || nmaster == 0 = splitVertically n r | n <= nmaster+1 = splitVertically nmaster s1 ++ splitVertically (n-nmaster) s2 | otherwise = splitVertically nmaster r1 ++ splitVertically nslave1 r2 ++ splitVertically nslave2 r3 where (r1, r2, r3) = split3HorizontallyBy middle (if f<0 then 1+2*f else f) r (s1, s2) = splitHorizontallyBy (if f<0 then 1+f else f) r nslave = (n - nmaster) nslave1 = ceiling (nslave % 2) nslave2 = (n - nmaster - nslave1) split3HorizontallyBy :: Bool -> Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle) split3HorizontallyBy middle f (Rectangle sx sy sw sh) = if middle then ( Rectangle (sx + fromIntegral r3w) sy r1w sh , Rectangle (sx + fromIntegral r3w + fromIntegral r1w) sy r2w sh , Rectangle sx sy r3w sh ) else ( Rectangle sx sy r1w sh , Rectangle (sx + fromIntegral r1w) sy r2w sh , Rectangle (sx + fromIntegral r1w + fromIntegral r2w) sy r3w sh ) where r1w = ceiling $ fromIntegral sw * f r2w = ceiling ( (sw - r1w) % 2 ) r3w = sw - r1w - r2w xmonad-contrib-0.12/XMonad/Layout/BoringWindows.hs0000644000000000000000000001443712636047674020370 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-} {-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.BoringWindows -- Copyright : (c) 2008 David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : Adam Vogt -- Stability : unstable -- Portability : unportable -- -- BoringWindows is an extension to allow windows to be marked boring -- ----------------------------------------------------------------------------- module XMonad.Layout.BoringWindows ( -- * Usage -- $usage boringWindows, boringAuto, markBoring, clearBoring, focusUp, focusDown, focusMaster, UpdateBoring(UpdateBoring), BoringMessage(Replace,Merge), BoringWindows() -- * Tips -- ** variant of 'Full' -- $simplest ) where import XMonad.Layout.LayoutModifier(ModifiedLayout(..), LayoutModifier(handleMessOrMaybeModifyIt, redoLayout)) import XMonad(Typeable, LayoutClass, Message, X, fromMessage, sendMessage, windows, withFocused, Window) import Control.Applicative((<$>)) import Data.List((\\), union) import Data.Maybe(fromMaybe, listToMaybe, maybeToList) import qualified Data.Map as M import qualified XMonad.StackSet as W -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.BoringWindows -- -- Then edit your @layoutHook@ by adding the layout modifier: -- -- > myLayout = boringWindows (Full ||| etc..) -- > main = xmonad def { layoutHook = myLayout } -- -- Then to your keybindings, add: -- -- > , ((modm, xK_j), focusUp) -- > , ((modm, xK_k), focusDown) -- > , ((modm, xK_m), focusMaster) -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" data BoringMessage = FocusUp | FocusDown | FocusMaster | IsBoring Window | ClearBoring | Replace String [Window] | Merge String [Window] deriving ( Read, Show, Typeable ) instance Message BoringMessage -- | UpdateBoring is sent before attempting to view another boring window, so -- that layouts have a chance to mark boring windows. data UpdateBoring = UpdateBoring deriving (Typeable) instance Message UpdateBoring markBoring, clearBoring, focusUp, focusDown, focusMaster :: X () markBoring = withFocused (sendMessage . IsBoring) clearBoring = sendMessage ClearBoring focusUp = sendMessage UpdateBoring >> sendMessage FocusUp focusDown = sendMessage UpdateBoring >> sendMessage FocusDown focusMaster = sendMessage UpdateBoring >> sendMessage FocusMaster data BoringWindows a = BoringWindows { namedBoring :: M.Map String [a] -- ^ store borings with a specific source , chosenBoring :: [a] -- ^ user-chosen borings , hiddenBoring :: Maybe [a] -- ^ maybe mark hidden windows } deriving (Show,Read,Typeable) boringWindows :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a boringWindows = ModifiedLayout (BoringWindows M.empty [] Nothing) -- | Mark windows that are not given rectangles as boring boringAuto :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a boringAuto = ModifiedLayout (BoringWindows M.empty [] (Just [])) instance LayoutModifier BoringWindows Window where redoLayout (b@BoringWindows { hiddenBoring = bs }) _r mst arrs = do let bs' = W.integrate' mst \\ map fst arrs return (arrs, Just $ b { hiddenBoring = const bs' <$> bs } ) handleMessOrMaybeModifyIt bst@(BoringWindows nbs cbs lbs) m | Just (Replace k ws) <- fromMessage m , maybe True (ws/=) (M.lookup k nbs) = let nnb = if null ws then M.delete k nbs else M.insert k ws nbs in rjl bst { namedBoring = nnb } | Just (Merge k ws) <- fromMessage m , maybe True (not . null . (ws \\)) (M.lookup k nbs) = rjl bst { namedBoring = M.insertWith union k ws nbs } | Just (IsBoring w) <- fromMessage m , w `notElem` cbs = rjl bst { chosenBoring = w:cbs } | Just ClearBoring <- fromMessage m, not (null cbs) = rjl bst { namedBoring = M.empty, chosenBoring = []} | Just FocusUp <- fromMessage m = do windows $ W.modify' $ skipBoring W.focusUp' return Nothing | Just FocusDown <- fromMessage m = do windows $ W.modify' $ skipBoring W.focusDown' return Nothing | Just FocusMaster <- fromMessage m = do windows $ W.modify' $ skipBoring W.focusDown' -- wiggle focus to make sure . skipBoring W.focusUp' -- no boring window gets the focus . focusMaster' return Nothing where skipBoring f st = fromMaybe st $ listToMaybe $ filter ((`notElem` W.focus st:bs) . W.focus) $ take (length $ W.integrate st) $ iterate f st bs = concat $ cbs:maybeToList lbs ++ M.elems nbs rjl = return . Just . Left handleMessOrMaybeModifyIt _ _ = return Nothing -- | Variant of 'focusMaster' that works on a -- 'Stack' rather than an entire 'StackSet'. focusMaster' :: W.Stack a -> W.Stack a focusMaster' c@(W.Stack _ [] _) = c focusMaster' (W.Stack t ls rs) = W.Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls {- $simplest An alternative to 'Full' is "XMonad.Layout.Simplest". Less windows are ignored by 'focusUp' and 'focusDown'. This may be helpful when you want windows to be uninteresting by some other layout modifier (ex. "XMonad.Layout.Minimize") -} xmonad-contrib-0.12/XMonad/Layout/Spacing.hs0000644000000000000000000001146012636047674017152 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-} {-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Spacing -- Copyright : (c) Brent Yorgey -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : portable -- -- Add a configurable amount of space around windows. ----------------------------------------------------------------------------- module XMonad.Layout.Spacing ( -- * Usage -- $usage spacing, Spacing, spacingWithEdge, SpacingWithEdge, smartSpacing, SmartSpacing, smartSpacingWithEdge, SmartSpacingWithEdge, ModifySpacing(..), setSpacing, incSpacing ) where import Graphics.X11 (Rectangle(..)) import Control.Arrow (second) import XMonad.Operations (sendMessage) import XMonad.Core (X,runLayout,Message,fromMessage,Typeable) import XMonad.StackSet (up, down, Workspace(..)) import XMonad.Util.Font (fi) import XMonad.Layout.LayoutModifier -- $usage -- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Layout.Spacing -- -- and modifying your layoutHook as follows (for example): -- -- > layoutHook = spacing 2 $ Tall 1 (3/100) (1/2) -- > -- put a 2px space around every window -- -- | Surround all windows by a certain number of pixels of blank space. spacing :: Int -> l a -> ModifiedLayout Spacing l a spacing p = ModifiedLayout (Spacing p) data Spacing a = Spacing Int deriving (Show, Read) -- | Message to dynamically modify (e.g. increase/decrease/set) the size of the window spacing data ModifySpacing = ModifySpacing (Int -> Int) deriving (Typeable) instance Message ModifySpacing -- | Set spacing to given amount setSpacing :: Int -> X () setSpacing n = sendMessage $ ModifySpacing $ const n -- | Increase spacing by given amount incSpacing :: Int -> X () incSpacing n = sendMessage $ ModifySpacing $ (+n) instance LayoutModifier Spacing a where pureModifier (Spacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing) pureMess (Spacing px) m | Just (ModifySpacing f) <- fromMessage m = Just $ Spacing $ max 0 $ f px | otherwise = Nothing modifierDescription (Spacing p) = "Spacing " ++ show p -- | Surround all windows by a certain number of pixels of blank space, and -- additionally adds the same amount of spacing around the edge of the screen. spacingWithEdge :: Int -> l a -> ModifiedLayout SpacingWithEdge l a spacingWithEdge p = ModifiedLayout (SpacingWithEdge p) data SpacingWithEdge a = SpacingWithEdge Int deriving (Show, Read) instance LayoutModifier SpacingWithEdge a where pureModifier (SpacingWithEdge p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing) pureMess (SpacingWithEdge px) m | Just (ModifySpacing f) <- fromMessage m = Just $ SpacingWithEdge $ max 0 $ f px | otherwise = Nothing modifyLayout (SpacingWithEdge p) w r = runLayout w (shrinkRect p r) modifierDescription (SpacingWithEdge p) = "SpacingWithEdge " ++ show p shrinkRect :: Int -> Rectangle -> Rectangle shrinkRect p (Rectangle x y w h) = Rectangle (x+fi p) (y+fi p) (w-2*fi p) (h-2*fi p) -- | Surrounds all windows with blank space, except when the window is the only -- visible window on the current workspace. smartSpacing :: Int -> l a -> ModifiedLayout SmartSpacing l a smartSpacing p = ModifiedLayout (SmartSpacing p) data SmartSpacing a = SmartSpacing Int deriving (Show, Read) instance LayoutModifier SmartSpacing a where pureModifier _ _ _ [x] = ([x], Nothing) pureModifier (SmartSpacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing) modifierDescription (SmartSpacing p) = "SmartSpacing " ++ show p -- | Surrounds all windows with blank space, and adds the same amount of spacing -- around the edge of the screen, except when the window is the only visible -- window on the current workspace. smartSpacingWithEdge :: Int -> l a -> ModifiedLayout SmartSpacingWithEdge l a smartSpacingWithEdge p = ModifiedLayout (SmartSpacingWithEdge p) data SmartSpacingWithEdge a = SmartSpacingWithEdge Int deriving (Show, Read) instance LayoutModifier SmartSpacingWithEdge a where pureModifier _ _ _ [x] = ([x], Nothing) pureModifier (SmartSpacingWithEdge p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing) modifyLayout (SmartSpacingWithEdge p) w r | maybe False (\s -> null (up s) && null (down s)) (stack w) = runLayout w r | otherwise = runLayout w (shrinkRect p r) modifierDescription (SmartSpacingWithEdge p) = "SmartSpacingWithEdge " ++ show p xmonad-contrib-0.12/XMonad/Layout/BinarySpacePartition.hs0000644000000000000000000010370712636047674021666 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} {-# LANGUAGE DoAndIfThenElse #-} {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.BinarySpacePartition -- Copyright : (c) 2013 Ben Weitzman -- 2015 Anton Pirogov -- License : BSD3-style (see LICENSE) -- -- Maintainer : Ben Weitzman -- Stability : unstable -- Portability : unportable -- -- Layout where new windows will split the focused window in half, based off of BSPWM -- ----------------------------------------------------------------------------- module XMonad.Layout.BinarySpacePartition ( -- * Usage -- $usage emptyBSP , Rotate(..) , Swap(..) , ResizeDirectional(..) , TreeRotate(..) , TreeBalance(..) , FocusParent(..) , SelectMoveNode(..) , Direction2D(..) ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Util.Stack hiding (Zipper) import XMonad.Util.Types -- for mouse resizing import XMonad.Layout.WindowArranger (WindowArrangerMsg(SetGeometry)) -- for "focus parent" node border import XMonad.Util.XUtils import qualified Data.Map as M import qualified Data.Set as S import Data.List ((\\), elemIndex, foldl') import Data.Maybe (fromMaybe, isNothing, isJust, mapMaybe, catMaybes) import Control.Applicative import Control.Monad import Data.Ratio ((%)) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.BinarySpacePartition -- -- Then add the layout, using the default BSP (BinarySpacePartition) -- -- > myLayout = emptyBSP ||| etc .. -- -- It may be a good idea to use "XMonad.Actions.Navigation2D" to move between the windows. -- -- This layout responds to SetGeometry and is compatible with e.g. "XMonad.Actions.MouseResize" -- or "XMonad.Layout.BorderResize". You should probably try both to decide which is better for you, -- if you want to be able to resize the splits with the mouse. -- -- If you don't want to use the mouse, add the following key bindings to resize the splits with the keyboard: -- -- > , ((modm .|. altMask, xK_l ), sendMessage $ ExpandTowards R) -- > , ((modm .|. altMask, xK_h ), sendMessage $ ExpandTowards L) -- > , ((modm .|. altMask, xK_j ), sendMessage $ ExpandTowards D) -- > , ((modm .|. altMask, xK_k ), sendMessage $ ExpandTowards U) -- > , ((modm .|. altMask .|. ctrlMask , xK_l ), sendMessage $ ShrinkFrom R) -- > , ((modm .|. altMask .|. ctrlMask , xK_h ), sendMessage $ ShrinkFrom L) -- > , ((modm .|. altMask .|. ctrlMask , xK_j ), sendMessage $ ShrinkFrom D) -- > , ((modm .|. altMask .|. ctrlMask , xK_k ), sendMessage $ ShrinkFrom U) -- > , ((modm, xK_r ), sendMessage Rotate) -- > , ((modm, xK_s ), sendMessage Swap) -- > , ((modm, xK_n ), sendMessage FocusParent) -- > , ((modm .|. ctrlMask, xK_n ), sendMessage SelectNode) -- > , ((modm .|. shiftMask, xK_n ), sendMessage MoveNode) -- -- Here's an alternative key mapping, this time using additionalKeysP, -- arrow keys, and slightly different behavior when resizing windows -- -- > , ("M-M1-", sendMessage $ ExpandTowards L) -- > , ("M-M1-", sendMessage $ ShrinkFrom L) -- > , ("M-M1-", sendMessage $ ExpandTowards U) -- > , ("M-M1-", sendMessage $ ShrinkFrom U) -- > , ("M-M1-C-", sendMessage $ ShrinkFrom R) -- > , ("M-M1-C-", sendMessage $ ExpandTowards R) -- > , ("M-M1-C-", sendMessage $ ShrinkFrom D) -- > , ("M-M1-C-", sendMessage $ ExpandTowards D) -- > , ("M-s", sendMessage $ BSP.Swap) -- > , ("M-M1-s", sendMessage $ Rotate) ] -- -- If you have many windows open and the layout begins to look too hard to manage, you can 'Balance' -- the layout, so that the current splittings are discarded and windows are tiled freshly in a way that -- the split depth is minimized. You can combine this with 'Equalize', which does not change your tree, -- but tunes the split ratios in a way that each window gets the same amount of space: -- -- > , ((myModMask, xK_a), sendMessage Balance) -- > , ((myModMask .|. shiftMask, xK_a), sendMessage Equalize) -- -- |Message for rotating the binary tree around the parent node of the window to the left or right data TreeRotate = RotateL | RotateR deriving Typeable instance Message TreeRotate -- |Message to balance the tree in some way (Balance retiles the windows, Equalize changes ratios) data TreeBalance = Balance | Equalize deriving Typeable instance Message TreeBalance -- |Message for resizing one of the cells in the BSP data ResizeDirectional = ExpandTowards Direction2D | ShrinkFrom Direction2D | MoveSplit Direction2D deriving Typeable instance Message ResizeDirectional -- |Message for rotating a split (horizontal/vertical) in the BSP data Rotate = Rotate deriving Typeable instance Message Rotate -- |Message for swapping the left child of a split with the right child of split data Swap = Swap deriving Typeable instance Message Swap -- |Message to cyclically select the parent node instead of the leaf data FocusParent = FocusParent deriving Typeable instance Message FocusParent -- |Message to move nodes inside the tree data SelectMoveNode = SelectNode | MoveNode deriving Typeable instance Message SelectMoveNode data Axis = Horizontal | Vertical deriving (Show, Read, Eq) oppositeDirection :: Direction2D -> Direction2D oppositeDirection U = D oppositeDirection D = U oppositeDirection L = R oppositeDirection R = L oppositeAxis :: Axis -> Axis oppositeAxis Vertical = Horizontal oppositeAxis Horizontal = Vertical toAxis :: Direction2D -> Axis toAxis U = Horizontal toAxis D = Horizontal toAxis L = Vertical toAxis R = Vertical split :: Axis -> Rational -> Rectangle -> (Rectangle, Rectangle) split Horizontal r (Rectangle sx sy sw sh) = (r1, r2) where r1 = Rectangle sx sy sw sh' r2 = Rectangle sx (sy + fromIntegral sh') sw (sh - sh') sh' = floor $ fromIntegral sh * r split Vertical r (Rectangle sx sy sw sh) = (r1, r2) where r1 = Rectangle sx sy sw' sh r2 = Rectangle (sx + fromIntegral sw') sy (sw - sw') sh sw' = floor $ fromIntegral sw * r data Split = Split { axis :: Axis , ratio :: Rational } deriving (Show, Read, Eq) oppositeSplit :: Split -> Split oppositeSplit (Split d r) = Split (oppositeAxis d) r increaseRatio :: Split -> Rational -> Split increaseRatio (Split d r) delta = Split d (min 0.9 (max 0.1 (r + delta))) resizeDiff :: Rational resizeDiff = 0.05 data Tree a = Leaf Int | Node { value :: a , left :: Tree a , right :: Tree a } deriving (Show, Read, Eq) numLeaves :: Tree a -> Int numLeaves (Leaf _) = 1 numLeaves (Node _ l r) = numLeaves l + numLeaves r -- right or left rotation of a (sub)tree, no effect if rotation not possible rotTree :: Direction2D -> Tree a -> Tree a rotTree _ (Leaf n) = Leaf n rotTree R n@(Node _ (Leaf _) _) = n rotTree L n@(Node _ _ (Leaf _)) = n rotTree R (Node sp (Node sp2 l2 r2) r) = Node sp2 l2 (Node sp r2 r) rotTree L (Node sp l (Node sp2 l2 r2)) = Node sp2 (Node sp l l2) r2 rotTree _ t = t data Crumb a = LeftCrumb a (Tree a) | RightCrumb a (Tree a) deriving (Show, Read, Eq) swapCrumb :: Crumb a -> Crumb a swapCrumb (LeftCrumb s t) = RightCrumb s t swapCrumb (RightCrumb s t) = LeftCrumb s t parentVal :: Crumb a -> a parentVal (LeftCrumb s _) = s parentVal (RightCrumb s _) = s modifyParentVal :: (a -> a) -> Crumb a -> Crumb a modifyParentVal f (LeftCrumb s t) = LeftCrumb (f s) t modifyParentVal f (RightCrumb s t) = RightCrumb (f s) t type Zipper a = (Tree a, [Crumb a]) toZipper :: Tree a -> Zipper a toZipper t = (t, []) goLeft :: Zipper a -> Maybe (Zipper a) goLeft (Leaf _, _) = Nothing goLeft (Node x l r, bs) = Just (l, LeftCrumb x r:bs) goRight :: Zipper a -> Maybe (Zipper a) goRight (Leaf _, _) = Nothing goRight (Node x l r, bs) = Just (r, RightCrumb x l:bs) goUp :: Zipper a -> Maybe (Zipper a) goUp (_, []) = Nothing goUp (t, LeftCrumb x r:cs) = Just (Node x t r, cs) goUp (t, RightCrumb x l:cs) = Just (Node x l t, cs) goSibling :: Zipper a -> Maybe (Zipper a) goSibling (_, []) = Nothing goSibling z@(_, LeftCrumb _ _:_) = Just z >>= goUp >>= goRight goSibling z@(_, RightCrumb _ _:_) = Just z >>= goUp >>= goLeft top :: Zipper a -> Zipper a top z = case goUp z of Nothing -> z Just z' -> top z' toTree :: Zipper a -> Tree a toTree = fst . top goToNthLeaf :: Int -> Zipper a -> Maybe (Zipper a) goToNthLeaf _ z@(Leaf _, _) = Just z goToNthLeaf n z@(t, _) = if numLeaves (left t) > n then do z' <- goLeft z goToNthLeaf n z' else do z' <- goRight z goToNthLeaf (n - (numLeaves . left $ t)) z' toggleSplits :: Tree Split -> Tree Split toggleSplits (Leaf l) = Leaf l toggleSplits (Node s l r) = Node (oppositeSplit s) (toggleSplits l) (toggleSplits r) splitCurrent :: Zipper Split -> Maybe (Zipper Split) splitCurrent (Leaf _, []) = Just (Node (Split Vertical 0.5) (Leaf 0) (Leaf 0), []) splitCurrent (Leaf _, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf 0) (Leaf 0), crumb:cs) splitCurrent (n, []) = Just (Node (Split Vertical 0.5) (Leaf 0) (toggleSplits n), []) splitCurrent (n, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf 0) (toggleSplits n), crumb:cs) removeCurrent :: Zipper a -> Maybe (Zipper a) removeCurrent (Leaf _, LeftCrumb _ r:cs) = Just (r, cs) removeCurrent (Leaf _, RightCrumb _ l:cs) = Just (l, cs) removeCurrent (Leaf _, []) = Nothing removeCurrent (Node _ (Leaf _) r@(Node _ _ _), cs) = Just (r, cs) removeCurrent (Node _ l@(Node _ _ _) (Leaf _), cs) = Just (l, cs) removeCurrent (Node _ (Leaf _) (Leaf _), cs) = Just (Leaf 0, cs) removeCurrent z@(Node _ _ _, _) = goLeft z >>= removeCurrent rotateCurrent :: Zipper Split -> Maybe (Zipper Split) rotateCurrent l@(_, []) = Just l rotateCurrent (n, c:cs) = Just (n, modifyParentVal oppositeSplit c:cs) swapCurrent :: Zipper a -> Maybe (Zipper a) swapCurrent l@(_, []) = Just l swapCurrent (n, c:cs) = Just (n, swapCrumb c:cs) isAllTheWay :: Direction2D -> Zipper Split -> Bool isAllTheWay _ (_, []) = True isAllTheWay R (_, LeftCrumb s _:_) | axis s == Vertical = False isAllTheWay L (_, RightCrumb s _:_) | axis s == Vertical = False isAllTheWay D (_, LeftCrumb s _:_) | axis s == Horizontal = False isAllTheWay U (_, RightCrumb s _:_) | axis s == Horizontal = False isAllTheWay dir z = fromMaybe False $ goUp z >>= Just . isAllTheWay dir expandTreeTowards :: Direction2D -> Zipper Split -> Maybe (Zipper Split) expandTreeTowards _ z@(_, []) = Just z expandTreeTowards dir z | isAllTheWay dir z = shrinkTreeFrom (oppositeDirection dir) z expandTreeTowards R (t, LeftCrumb s r:cs) | axis s == Vertical = Just (t, LeftCrumb (increaseRatio s resizeDiff) r:cs) expandTreeTowards L (t, RightCrumb s l:cs) | axis s == Vertical = Just (t, RightCrumb (increaseRatio s (-resizeDiff)) l:cs) expandTreeTowards D (t, LeftCrumb s r:cs) | axis s == Horizontal = Just (t, LeftCrumb (increaseRatio s resizeDiff) r:cs) expandTreeTowards U (t, RightCrumb s l:cs) | axis s == Horizontal = Just (t, RightCrumb (increaseRatio s (-resizeDiff)) l:cs) expandTreeTowards dir z = goUp z >>= expandTreeTowards dir shrinkTreeFrom :: Direction2D -> Zipper Split -> Maybe (Zipper Split) shrinkTreeFrom _ z@(_, []) = Just z shrinkTreeFrom R z@(_, LeftCrumb s _:_) | axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards L shrinkTreeFrom L z@(_, RightCrumb s _:_) | axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards R shrinkTreeFrom D z@(_, LeftCrumb s _:_) | axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards U shrinkTreeFrom U z@(_, RightCrumb s _:_) | axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards D shrinkTreeFrom dir z = goUp z >>= shrinkTreeFrom dir -- Direction2D refers to which direction the divider should move. autoSizeTree :: Direction2D -> Zipper Split -> Maybe (Zipper Split) autoSizeTree _ z@(_, []) = Just z autoSizeTree d z = Just z >>= getSplit (toAxis d) >>= resizeTree d -- resizing once found the correct split. YOU MUST FIND THE RIGHT SPLIT FIRST. resizeTree :: Direction2D -> Zipper Split -> Maybe (Zipper Split) resizeTree _ z@(_, []) = Just z resizeTree R z@(_, LeftCrumb _ _:_) = Just z >>= expandTreeTowards R resizeTree L z@(_, LeftCrumb _ _:_) = Just z >>= shrinkTreeFrom R resizeTree U z@(_, LeftCrumb _ _:_) = Just z >>= shrinkTreeFrom D resizeTree D z@(_, LeftCrumb _ _:_) = Just z >>= expandTreeTowards D resizeTree R z@(_, RightCrumb _ _:_) = Just z >>= shrinkTreeFrom L resizeTree L z@(_, RightCrumb _ _:_) = Just z >>= expandTreeTowards L resizeTree U z@(_, RightCrumb _ _:_) = Just z >>= expandTreeTowards U resizeTree D z@(_, RightCrumb _ _:_) = Just z >>= shrinkTreeFrom U getSplit :: Axis -> Zipper Split -> Maybe (Zipper Split) getSplit _ (_, []) = Nothing getSplit d z = do let fs = findSplit d z if isNothing fs then findClosest d z else fs findClosest :: Axis -> Zipper Split -> Maybe (Zipper Split) findClosest _ z@(_, []) = Just z findClosest d z@(_, LeftCrumb s _:_) | axis s == d = Just z findClosest d z@(_, RightCrumb s _:_) | axis s == d = Just z findClosest d z = goUp z >>= findClosest d findSplit :: Axis -> Zipper Split -> Maybe (Zipper Split) findSplit _ (_, []) = Nothing findSplit d z@(_, LeftCrumb s _:_) | axis s == d = Just z findSplit d z = goUp z >>= findSplit d resizeSplit :: Direction2D -> (Rational,Rational) -> Zipper Split -> Maybe (Zipper Split) resizeSplit _ _ z@(_, []) = Just z resizeSplit dir (xsc,ysc) z = case goToBorder dir z of Nothing -> Just z Just (t, crumb) -> Just $ case dir of R -> (t{value=sp{ratio=scaleRatio (ratio sp) xsc}}, crumb) D -> (t{value=sp{ratio=scaleRatio (ratio sp) ysc}}, crumb) L -> (t{value=sp{ratio=1-scaleRatio (1-ratio sp) xsc}}, crumb) U -> (t{value=sp{ratio=1-scaleRatio (1-ratio sp) ysc}}, crumb) where sp = value t scaleRatio r fac = min 0.9 $ max 0.1 $ r*fac -- starting from a leaf, go to node representing a border of the according window goToBorder :: Direction2D -> Zipper Split -> Maybe (Zipper Split) goToBorder L z@(_, RightCrumb (Split Vertical _) _:_) = goUp z goToBorder L z = goUp z >>= goToBorder L goToBorder R z@(_, LeftCrumb (Split Vertical _) _:_) = goUp z goToBorder R z = goUp z >>= goToBorder R goToBorder U z@(_, RightCrumb (Split Horizontal _) _:_) = goUp z goToBorder U z = goUp z >>= goToBorder U goToBorder D z@(_, LeftCrumb (Split Horizontal _) _:_) = goUp z goToBorder D z = goUp z >>= goToBorder D -- takes a list of indices and numerates the leaves of a given tree numerate :: [Int] -> Tree a -> Tree a numerate ns t = snd $ num ns t where num (n:nns) (Leaf _) = (nns, Leaf n) num [] (Leaf _) = ([], Leaf 0) num n (Node s l r) = (n'', Node s nl nr) where (n', nl) = num n l (n'', nr) = num n' r -- return values of leaves from left to right as list flatten :: Tree a -> [Int] flatten (Leaf n) = [n] flatten (Node _ l r) = flatten l++flatten r -- adjust ratios to make window areas equal equalize :: Zipper Split -> Maybe (Zipper Split) equalize (t, cs) = Just (eql t, cs) where eql (Leaf n) = Leaf n eql n@(Node s l r) = Node s{ratio=fromIntegral (numLeaves l) % fromIntegral (numLeaves n)} (eql l) (eql r) -- generate a symmetrical balanced tree for n leaves from given tree, preserving leaf labels balancedTree :: Zipper Split -> Maybe (Zipper Split) balancedTree (t, cs) = Just (numerate (flatten t) $ balanced (numLeaves t), cs) where balanced 1 = Leaf 0 balanced 2 = Node (Split Horizontal 0.5) (Leaf 0) (Leaf 0) balanced m = Node (Split Horizontal 0.5) (balanced (m`div`2)) (balanced (m-m`div`2)) -- attempt to rotate splits optimally in order choose more quad-like rects optimizeOrientation :: Rectangle -> Zipper Split -> Maybe (Zipper Split) optimizeOrientation rct (t, cs) = Just (opt t rct, cs) where opt (Leaf v) _ = Leaf v opt (Node sp l r) rect = Node sp' (opt l lrect) (opt r rrect) where (Rectangle _ _ w1 h1,Rectangle _ _ w2 h2) = split (axis sp) (ratio sp) rect (Rectangle _ _ w3 h3,Rectangle _ _ w4 h4) = split (axis $ oppositeSplit sp) (ratio sp) rect f w h = if w > h then w'/h' else h'/w' where (w',h') = (fromIntegral w :: Double, fromIntegral h :: Double) wratio = min (f w1 h1) (f w2 h2) wratio' = min (f w3 h3) (f w4 h4) sp' = if wratio Zipper a -> Maybe (Zipper a) goToNode (NodeRef _ dirs _) z = foldM gofun z dirs where gofun z' L = goLeft z' gofun z' R = goRight z' gofun _ _ = Nothing toNodeRef :: Int -> Maybe (Zipper Split) -> NodeRef toNodeRef _ Nothing = noRef toNodeRef l (Just (_, cs)) = NodeRef l (reverse $ map crumbToDir cs) [] where crumbToDir (LeftCrumb _ _) = L crumbToDir (RightCrumb _ _) = R -- returns the leaf a noderef is leading to, if any nodeRefToLeaf :: NodeRef -> Maybe (Zipper a) -> Maybe Int nodeRefToLeaf n (Just z) = case goToNode n z of Just (Leaf l, _) -> Just l Just (Node _ _ _, _) -> Nothing Nothing -> Nothing nodeRefToLeaf _ Nothing = Nothing leafToNodeRef :: Int -> BinarySpacePartition a -> NodeRef leafToNodeRef l b = toNodeRef l (makeZipper b >>= goToNthLeaf l) data BinarySpacePartition a = BinarySpacePartition { getOldRects :: [(Window,Rectangle)] , getFocusedNode :: NodeRef , getSelectedNode :: NodeRef , getTree :: Maybe (Tree Split) } deriving (Show, Read,Eq) -- | an empty BinarySpacePartition to use as a default for adding windows to. emptyBSP :: BinarySpacePartition a emptyBSP = BinarySpacePartition [] noRef noRef Nothing makeBSP :: Tree Split -> BinarySpacePartition a makeBSP = BinarySpacePartition [] noRef noRef . Just makeZipper :: BinarySpacePartition a -> Maybe (Zipper Split) makeZipper (BinarySpacePartition _ _ _ Nothing) = Nothing makeZipper (BinarySpacePartition _ _ _ (Just t)) = Just . toZipper $ t size :: BinarySpacePartition a -> Int size = maybe 0 numLeaves . getTree zipperToBinarySpacePartition :: Maybe (Zipper Split) -> BinarySpacePartition b zipperToBinarySpacePartition Nothing = emptyBSP zipperToBinarySpacePartition (Just z) = BinarySpacePartition [] noRef noRef . Just . toTree . top $ z rectangles :: BinarySpacePartition a -> Rectangle -> [Rectangle] rectangles (BinarySpacePartition _ _ _ Nothing) _ = [] rectangles (BinarySpacePartition _ _ _ (Just (Leaf _))) rootRect = [rootRect] rectangles (BinarySpacePartition _ _ _ (Just node)) rootRect = rectangles (makeBSP . left $ node) leftBox ++ rectangles (makeBSP . right $ node) rightBox where (leftBox, rightBox) = split (axis info) (ratio info) rootRect info = value node getNodeRect :: BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle getNodeRect b r n = fromMaybe (Rectangle 0 0 1 1) (makeZipper b >>= goToNode n >>= getRect []) where getRect ls (_, []) = Just $ foldl (\r' (s,f) -> f $ split' s r') r ls getRect ls z@(_, LeftCrumb s _:_) = goUp z >>= getRect ((s,fst):ls) getRect ls z@(_, RightCrumb s _:_) = goUp z >>= getRect ((s,snd):ls) split' s = split (axis s) (ratio s) doToNth :: (Zipper Split -> Maybe (Zipper Split)) -> BinarySpacePartition a -> BinarySpacePartition a doToNth f b = b{getTree=getTree $ zipperToBinarySpacePartition $ makeZipper b >>= goToNode (getFocusedNode b) >>= f} splitNth :: BinarySpacePartition a -> BinarySpacePartition a splitNth (BinarySpacePartition _ _ _ Nothing) = makeBSP (Leaf 0) splitNth b = doToNth splitCurrent b removeNth :: BinarySpacePartition a -> BinarySpacePartition a removeNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP removeNth (BinarySpacePartition _ _ _ (Just (Leaf _))) = emptyBSP removeNth b = doToNth removeCurrent b rotateNth :: BinarySpacePartition a -> BinarySpacePartition a rotateNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP rotateNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b rotateNth b = doToNth rotateCurrent b swapNth :: BinarySpacePartition a -> BinarySpacePartition a swapNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP swapNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b swapNth b = doToNth swapCurrent b growNthTowards :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a growNthTowards _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP growNthTowards _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b growNthTowards dir b = doToNth (expandTreeTowards dir) b shrinkNthFrom :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a shrinkNthFrom _ (BinarySpacePartition _ _ _ Nothing)= emptyBSP shrinkNthFrom _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b shrinkNthFrom dir b = doToNth (shrinkTreeFrom dir) b autoSizeNth :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a autoSizeNth _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP autoSizeNth _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b autoSizeNth dir b = doToNth (autoSizeTree dir) b resizeSplitNth :: Direction2D -> (Rational,Rational) -> BinarySpacePartition a -> BinarySpacePartition a resizeSplitNth _ _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP resizeSplitNth _ _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b resizeSplitNth dir sc b = doToNth (resizeSplit dir sc) b -- rotate tree left or right around parent of nth leaf rotateTreeNth :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a rotateTreeNth _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP rotateTreeNth U b = b rotateTreeNth D b = b rotateTreeNth dir b@(BinarySpacePartition _ _ _ (Just _)) = doToNth (\t -> case goUp t of Nothing -> Just t Just (t', c) -> Just (rotTree dir t', c)) b equalizeNth :: BinarySpacePartition a -> BinarySpacePartition a equalizeNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP equalizeNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b equalizeNth b = doToNth equalize b rebalanceNth :: BinarySpacePartition a -> Rectangle -> BinarySpacePartition a rebalanceNth (BinarySpacePartition _ _ _ Nothing) _ = emptyBSP rebalanceNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) _ = b rebalanceNth b r = doToNth (balancedTree >=> optimizeOrientation r) b flattenLeaves :: BinarySpacePartition a -> [Int] flattenLeaves (BinarySpacePartition _ _ _ Nothing) = [] flattenLeaves (BinarySpacePartition _ _ _ (Just t)) = flatten t -- we do this before an action to look afterwards which leaves moved where numerateLeaves :: BinarySpacePartition a -> BinarySpacePartition a numerateLeaves b@(BinarySpacePartition _ _ _ Nothing) = b numerateLeaves b@(BinarySpacePartition _ _ _ (Just t)) = b{getTree=Just $ numerate ns t} where ns = [0..(numLeaves t-1)] -- if there is a selected and focused node and the focused is not a part of selected, -- move selected node to be a child of focused node moveNode :: BinarySpacePartition a -> BinarySpacePartition a moveNode b@(BinarySpacePartition _ (NodeRef (-1) _ _) _ _) = b moveNode b@(BinarySpacePartition _ _ (NodeRef (-1) _ _) _) = b moveNode b@(BinarySpacePartition _ _ _ Nothing) = b moveNode b@(BinarySpacePartition _ f s (Just ot)) = case makeZipper b >>= goToNode s of Just (n, LeftCrumb _ t:cs) -> b{getTree=Just $ insert n $ top (t, cs)} Just (n, RightCrumb _ t:cs) -> b{getTree=Just $ insert n $ top (t, cs)} _ -> b where insert t z = case goToNode f z of Nothing -> ot --return original tree (abort) Just (n, c:cs) -> toTree (Node (Split (oppositeAxis . axis . parentVal $ c) 0.5) t n, c:cs) Just (n, []) -> toTree (Node (Split Vertical 0.5) t n, []) ------------------------------------------ -- returns index of focused window or 0 for empty stack index :: W.Stack a -> Int index s = case toIndex (Just s) of (_, Nothing) -> 0 (_, Just int) -> int --move windows to new positions according to tree transformations, keeping focus on originally focused window --CAREFUL here! introduce a bug here and have fun debugging as your windows start to disappear or explode adjustStack :: Maybe (W.Stack Window) --original stack -> Maybe (W.Stack Window) --stack without floating windows -> [Window] --just floating windows of this WS -> Maybe (BinarySpacePartition Window) -- Tree with numbered leaves telling what to move where -> Maybe (W.Stack Window) --resulting stack adjustStack orig Nothing _ _ = orig --no new stack -> no changes adjustStack orig _ _ Nothing = orig --empty tree -> no changes adjustStack orig s fw (Just b) = if length ls tree incomplete, no changes else fromIndex ws' fid' where ws' = mapMaybe (`M.lookup` wsmap) ls ++ fw fid' = fromMaybe 0 $ elemIndex focused ws' wsmap = M.fromList $ zip [0..] ws -- map: old index in list -> window ls = flattenLeaves b -- get new index ordering from tree (ws,fid) = toIndex s focused = ws !! fromMaybe 0 fid --replace the window stack of the managed workspace with our modified stack replaceStack :: Maybe (W.Stack Window) -> X () replaceStack s = do st <- get let wset = windowset st cur = W.current wset wsp = W.workspace cur put st{windowset=wset{W.current=cur{W.workspace=wsp{W.stack=s}}}} replaceFloating :: M.Map Window W.RationalRect -> X () replaceFloating wsm = do st <- get let wset = windowset st put st{windowset=wset{W.floating=wsm}} -- some helpers to filter windows -- getFloating :: X [Window] getFloating = (M.keys . W.floating) <$> gets windowset -- all floating windows getStackSet :: X (Maybe (W.Stack Window)) getStackSet = (W.stack . W.workspace . W.current) <$> gets windowset -- windows on this WS (with floating) getScreenRect :: X Rectangle getScreenRect = (screenRect . W.screenDetail . W.current) <$> gets windowset withoutFloating :: [Window] -> Maybe (W.Stack Window) -> Maybe (W.Stack Window) withoutFloating fs = maybe Nothing (unfloat fs) -- ignore messages if current focus is on floating window, otherwise return stack without floating unfloat :: [Window] -> W.Stack Window -> Maybe (W.Stack Window) unfloat fs s = if W.focus s `elem` fs then Nothing else Just $ s{W.up = W.up s \\ fs, W.down = W.down s \\ fs} instance LayoutClass BinarySpacePartition Window where doLayout b r s = do let b' = layout b b'' <- updateNodeRef b' (size b/=size b') r let rs = rectangles b'' r wrs = zip ws rs return (wrs, Just b''{getOldRects=wrs}) where ws = W.integrate s l = length ws layout bsp | l == sz = bsp | l > sz = layout $ splitNth bsp | otherwise = layout $ removeNth bsp where sz = size bsp handleMessage b_orig m | Just msg@(SetGeometry _) <- fromMessage m = handleResize b msg | Just FocusParent <- fromMessage m = do let n = getFocusedNode b let n' = toNodeRef (refLeaf n) (makeZipper b >>= goToNode n >>= goUp) return $ Just b{getFocusedNode=n'{refWins=refWins n}} | Just SelectNode <- fromMessage m = do let n = getFocusedNode b let s = getSelectedNode b removeBorder $ refWins s let s' = if refLeaf n == refLeaf s && refPath n == refPath s then noRef else n{refWins=[]} return $ Just b{getSelectedNode=s'} | otherwise = do ws <- getStackSet fs <- getFloating r <- getScreenRect -- removeBorder $ refWins $ getSelectedNode b let lws = withoutFloating fs ws -- tiled windows on WS lfs = maybe [] W.integrate ws \\ maybe [] W.integrate lws -- untiled windows on WS b' = handleMesg r -- transform tree (concerns only tiled windows) ws' = adjustStack ws lws lfs b' -- apply transformation to window stack, reintegrate floating wins replaceStack ws' return b' where handleMesg r = msum [ fmap resize (fromMessage m) , fmap rotate (fromMessage m) , fmap swap (fromMessage m) , fmap rotateTr (fromMessage m) , fmap (balanceTr r) (fromMessage m) , fmap move (fromMessage m) ] resize (ExpandTowards dir) = growNthTowards dir b resize (ShrinkFrom dir) = shrinkNthFrom dir b resize (MoveSplit dir) = autoSizeNth dir b rotate Rotate = resetFoc $ rotateNth b swap Swap = resetFoc $ swapNth b rotateTr RotateL = resetFoc $ rotateTreeNth L b rotateTr RotateR = resetFoc $ rotateTreeNth R b balanceTr _ Equalize = resetFoc $ equalizeNth b balanceTr r Balance = resetFoc $ rebalanceNth b r move MoveNode = resetFoc $ moveNode b move SelectNode = b --should not happen here, is done above, as we need X monad b = numerateLeaves b_orig resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf=(-1)} ,getSelectedNode=(getSelectedNode bsp){refLeaf=(-1)}} description _ = "BSP" -- React to SetGeometry message to work with BorderResize/MouseResize handleResize :: BinarySpacePartition Window -> WindowArrangerMsg -> X (Maybe (BinarySpacePartition Window)) handleResize b (SetGeometry newrect@(Rectangle _ _ w h)) = do ws <- getStackSet fs <- getFloating case W.focus <$> ws of Nothing -> return Nothing Just win -> do (_,_,_,_,_,mx,my,_) <- withDisplay (\d -> io $ queryPointer d win) let oldrect@(Rectangle _ _ ow oh) = fromMaybe (Rectangle 0 0 0 0) $ lookup win $ getOldRects b let (xsc,ysc) = (fi w % fi ow, fi h % fi oh) (xsc',ysc') = (rough xsc, rough ysc) dirs = changedDirs oldrect newrect (fi mx,fi my) n = elemIndex win $ maybe [] W.integrate $ withoutFloating fs ws -- unless (isNothing dir) $ debug $ -- show (fi x-fi ox,fi y-fi oy) ++ show (fi w-fi ow,fi h-fi oh) -- ++ show dir ++ " " ++ show win ++ " " ++ show (mx,my) return $ case n of Just _ -> Just $ foldl' (\b' d -> resizeSplitNth d (xsc',ysc') b') b dirs Nothing -> Nothing --focused window is floating -> ignore where rough v = min 1.5 $ max 0.75 v -- extreme scale factors are forbidden handleResize _ _ = return Nothing -- find out which borders have been pulled. We need the old and new rects and the mouse coordinates changedDirs :: Rectangle -> Rectangle -> (Int,Int) -> [Direction2D] changedDirs (Rectangle _ _ ow oh) (Rectangle _ _ w h) (mx,my) = catMaybes [lr, ud] where lr = if ow==w then Nothing else Just (if (fi mx :: Double) > (fi ow :: Double)/2 then R else L) ud = if oh==h then Nothing else Just (if (fi my :: Double) > (fi oh :: Double)/2 then D else U) -- node focus border helpers ---------------------------- updateNodeRef :: BinarySpacePartition Window -> Bool -> Rectangle -> X (BinarySpacePartition Window) updateNodeRef b force r = do let n = getFocusedNode b let s = getSelectedNode b removeBorder (refWins n++refWins s) l <- getCurrFocused b' <- if refLeaf n /= l || refLeaf n == (-1) || force then return b{getFocusedNode=leafToNodeRef l b} else return b b'' <- if force then return b'{getSelectedNode=noRef} else return b' renderBorders r b'' where getCurrFocused = maybe 0 index <$> (withoutFloating <$> getFloating <*> getStackSet) -- create border around focused node if necessary renderBorders :: Rectangle -> BinarySpacePartition a -> X (BinarySpacePartition a) renderBorders r b = do let l = nodeRefToLeaf (getFocusedNode b) $ makeZipper b wssel <- if refLeaf (getSelectedNode b)/=(-1) then createBorder (getNodeRect b r (getSelectedNode b)) $ Just "#00ff00" else return [] let b' = b{getSelectedNode=(getSelectedNode b){refWins=wssel}} if refLeaf (getFocusedNode b')==(-1) || isJust l || size b'<2 then return b' else do ws' <- createBorder (getNodeRect b' r (getFocusedNode b')) Nothing return b'{getFocusedNode=(getFocusedNode b'){refWins=ws'}} -- create a window for each border line, show, add into stack and set floating createBorder :: Rectangle -> Maybe String -> X [Window] createBorder (Rectangle wx wy ww wh) c = do bw <- asks (borderWidth.config) bc <- case c of Nothing -> asks (focusedBorderColor.config) Just s -> return s let rects = [ Rectangle wx wy ww (fi bw) , Rectangle wx wy (fi bw) wh , Rectangle wx (wy+fi wh-fi bw) ww (fi bw) , Rectangle (wx+fi ww-fi bw) wy (fi bw) wh ] ws <- mapM (\r -> createNewWindow r Nothing bc False) rects showWindows ws maybe Nothing (\s -> Just s{W.down=W.down s ++ ws}) <$> getStackSet >>= replaceStack M.union (M.fromList $ zip ws $ map toRR rects) . W.floating . windowset <$> get >>= replaceFloating modify (\s -> s{mapped=mapped s `S.union` S.fromList ws}) -- show <$> mapM isClient ws >>= debug return ws where toRR (Rectangle x y w h) = W.RationalRect (fi x) (fi y) (fi w) (fi h) -- remove border line windows from stack + floating, kill removeBorder :: [Window] -> X () removeBorder ws = do modify (\s -> s{mapped = mapped s `S.difference` S.fromList ws}) flip (foldl (flip M.delete)) ws . W.floating . windowset <$> get >>= replaceFloating maybe Nothing (\s -> Just s{W.down=W.down s \\ ws}) <$> getStackSet >>= replaceStack deleteWindows ws xmonad-contrib-0.12/XMonad/Layout/OneBig.hs0000644000000000000000000001146712636047674016740 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.OneBig -- Copyright : (c) 2009 Ilya Portnov -- License : BSD3-style (see LICENSE) -- -- Maintainer : Ilya Portnov -- Stability : unstable -- Portability : unportable -- -- Provides layout named OneBig. It places one (master) window at top left corner of screen, and other (slave) windows at top -- ----------------------------------------------------------------------------- module XMonad.Layout.OneBig ( -- * Usage -- $usage OneBig (..) ) where import XMonad import qualified XMonad.StackSet as W -- $usage -- This module defines layout named OneBig. It places one (master) -- window at top left, and other (slave) windows at right and at -- bottom of master. It tries to give equal space for each slave -- window. -- -- You can use this module by adding following in your @xmonad.hs@: -- -- > import XMonad.Layout.OneBig -- -- Then add layouts to your layoutHook: -- -- > myLayoutHook = OneBig (3/4) (3/4) ||| ... -- -- In this example, master window will occupy 3/4 of screen width and -- 3/4 of screen height. -- | Data type for layout data OneBig a = OneBig Float Float deriving (Read,Show) instance LayoutClass OneBig a where pureLayout = oneBigLayout pureMessage = oneBigMessage -- | Processes Shrink/Expand messages oneBigMessage :: OneBig a -> SomeMessage -> Maybe (OneBig a) oneBigMessage (OneBig cx cy) m = fmap resize (fromMessage m) where resize Shrink = OneBig (cx-delta) (cy-delta) resize Expand = OneBig (cx+delta) (cy+delta) delta = 3/100 -- | Main layout function oneBigLayout :: OneBig a -> Rectangle -> W.Stack a -> [(a, Rectangle)] oneBigLayout (OneBig cx cy) rect stack = [(master,masterRect)] ++ (divideBottom bottomRect bottomWs) ++ (divideRight rightRect rightWs) where ws = W.integrate stack n = length ws ht (Rectangle _ _ _ hh) = hh wd (Rectangle _ _ ww _) = ww h' = round (fromIntegral (ht rect)*cy) w = wd rect m = calcBottomWs n w h' master = head ws other = tail ws bottomWs = take m other rightWs = drop m other masterRect = cmaster n m cx cy rect bottomRect = cbottom cy rect rightRect = cright cx cy rect -- | Calculate how many windows must be placed at bottom calcBottomWs :: Int -> Dimension -> Dimension -> Int calcBottomWs n w h' = case n of 1 -> 0 2 -> 1 3 -> 2 4 -> 2 _ -> (fromIntegral w)*(n-1) `div` fromIntegral (h'+(fromIntegral w)) -- | Calculate rectangle for master window cmaster:: Int -> Int -> Float -> Float -> Rectangle -> Rectangle cmaster n m cx cy (Rectangle x y sw sh) = Rectangle x y w h where w = if (n > m+1) then round (fromIntegral sw*cx) else sw h = if (n > 1) then round (fromIntegral sh*cy) else sh -- | Calculate rectangle for bottom windows cbottom:: Float -> Rectangle -> Rectangle cbottom cy (Rectangle sx sy sw sh) = Rectangle sx y sw h where h = round (fromIntegral sh*(1-cy)) y = round (fromIntegral sh*cy+(fromIntegral sy)) -- | Calculate rectangle for right windows cright:: Float -> Float -> Rectangle -> Rectangle cright cx cy (Rectangle sx sy sw sh) = Rectangle x sy w h where w = round (fromIntegral sw*(1-cx)) x = round (fromIntegral sw*cx+(fromIntegral sx)) h = round (fromIntegral sh*cy) -- | Divide bottom rectangle between windows divideBottom :: Rectangle -> [a] -> [(a, Rectangle)] divideBottom (Rectangle x y w h) ws = zip ws rects where n = length ws oneW = fromIntegral w `div` n oneRect = Rectangle x y (fromIntegral oneW) h rects = take n $ iterate (shiftR (fromIntegral oneW)) oneRect -- | Divide right rectangle between windows divideRight :: Rectangle -> [a] -> [(a, Rectangle)] divideRight (Rectangle x y w h) ws = if (n==0) then [] else zip ws rects where n = length ws oneH = fromIntegral h `div` n oneRect = Rectangle x y w (fromIntegral oneH) rects = take n $ iterate (shiftB (fromIntegral oneH)) oneRect -- | Shift rectangle right shiftR :: Position -> Rectangle -> Rectangle shiftR s (Rectangle x y w h) = Rectangle (x+s) y w h -- | Shift rectangle bottom shiftB :: Position -> Rectangle -> Rectangle shiftB s (Rectangle x y w h) = Rectangle x (y+s) w h xmonad-contrib-0.12/XMonad/Layout/MouseResizableTile.hs0000644000000000000000000003745212636047674021346 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.MouseResizableTile -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- A layout in the spirit of "XMonad.Layout.ResizableTile", but with the option -- to use the mouse to adjust the layout. -- ----------------------------------------------------------------------------- module XMonad.Layout.MouseResizableTile ( -- * Usage -- $usage mouseResizableTile, mouseResizableTileMirrored, MRTMessage (ShrinkSlave, ExpandSlave), -- * Parameters -- $mrtParameters nmaster, masterFrac, slaveFrac, fracIncrement, isMirrored, draggerType, DraggerType (..), MouseResizableTile, ) where import XMonad hiding (tile, splitVertically, splitHorizontallyBy) import qualified XMonad.StackSet as W import XMonad.Util.XUtils import Control.Applicative((<$>)) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.MouseResizableTile -- -- Then edit your @layoutHook@ by adding the MouseResizableTile layout. -- Either in its normal form or the mirrored version. (The mirror layout modifier -- will not work correctly here because of the use of the mouse.) -- -- > myLayout = mouseResizableTile ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- You may also want to add the following key bindings: -- -- > , ((modm, xK_u), sendMessage ShrinkSlave) -- %! Shrink a slave area -- > , ((modm, xK_i), sendMessage ExpandSlave) -- %! Expand a slave area -- -- For detailed instruction on editing the key binding see: -- -- "XMonad.Doc.Extending#Editing_key_bindings". -- $mrtParameters -- The following functions are also labels for updating the @data@ (whose -- representation is otherwise hidden) produced by 'mouseResizableTile'. -- -- Usage: -- -- > myLayout = mouseResizableTile{ masterFrac = 0.7, -- > fracIncrement = 0.05, -- > draggerType = BordersDragger } -- > ||| etc.. data MRTMessage = SetMasterFraction Rational | SetLeftSlaveFraction Int Rational | SetRightSlaveFraction Int Rational | ShrinkSlave | ExpandSlave deriving Typeable instance Message MRTMessage data DraggerInfo = MasterDragger Position Rational | LeftSlaveDragger Position Rational Int | RightSlaveDragger Position Rational Int deriving (Show, Read) type DraggerWithRect = (Rectangle, Glyph, DraggerInfo) type DraggerWithWin = (Window, DraggerInfo) -- | Specifies the size of the clickable area between windows. data DraggerType = FixedDragger { gapWidth :: Dimension -- ^ width of a gap between windows , draggerWidth :: Dimension -- ^ width of the dragger itself -- (will overlap windows if greater than gap) } | BordersDragger -- ^ no gaps, draggers overlap window borders deriving (Show, Read) type DraggerGeometry = (Position, Dimension, Position, Dimension) data MouseResizableTile a = MRT { nmaster :: Int, -- ^ Get/set the number of windows in -- master pane (default: 1). masterFrac :: Rational, -- ^ Get/set the proportion of screen -- occupied by master pane (default: 1/2). slaveFrac :: Rational, -- ^ Get/set the proportion of remaining -- space in a column occupied by a slave -- window (default: 1/2). fracIncrement :: Rational, -- ^ Get/set the increment used when -- modifying masterFrac/slaveFrac by the -- Shrink, Expand, etc. messages (default: -- 3/100). leftFracs :: [Rational], rightFracs :: [Rational], draggers :: [DraggerWithWin], draggerType :: DraggerType, -- ^ Get/set dragger and gap dimensions -- (default: FixedDragger 6 6). focusPos :: Int, numWindows :: Int, isMirrored :: Bool -- ^ Get/set whether the layout is -- mirrored (default: False). } deriving (Show, Read) mouseResizableTile :: MouseResizableTile a mouseResizableTile = MRT 1 0.5 0.5 0.03 [] [] [] (FixedDragger 6 6) 0 0 False -- | May be removed in favor of @mouseResizableTile { isMirrored = True }@ mouseResizableTileMirrored :: MouseResizableTile a mouseResizableTileMirrored = mouseResizableTile { isMirrored = True } instance LayoutClass MouseResizableTile Window where doLayout st sr (W.Stack w l r) = do drg <- draggerGeometry $ draggerType st let wins = reverse l ++ w : r num = length wins sr' = mirrorAdjust sr (mirrorRect sr) (rects, preparedDraggers) = tile (nmaster st) (masterFrac st) (leftFracs st ++ repeat (slaveFrac st)) (rightFracs st ++ repeat (slaveFrac st)) sr' num drg rects' = map (mirrorAdjust id mirrorRect . sanitizeRectangle sr') rects mapM_ deleteDragger $ draggers st (draggerWrs, newDraggers) <- unzip <$> mapM (createDragger sr . adjustForMirror (isMirrored st)) preparedDraggers return (draggerWrs ++ zip wins rects', Just $ st { draggers = newDraggers, focusPos = length l, numWindows = length wins }) where mirrorAdjust a b = if (isMirrored st) then b else a handleMessage st m | Just (IncMasterN d) <- fromMessage m = return $ Just $ st { nmaster = max 0 (nmaster st + d) } | Just Shrink <- fromMessage m = return $ Just $ st { masterFrac = max 0 (masterFrac st - fracIncrement st) } | Just Expand <- fromMessage m = return $ Just $ st { masterFrac = min 1 (masterFrac st + fracIncrement st) } | Just ShrinkSlave <- fromMessage m = return $ Just $ modifySlave st (- fracIncrement st) | Just ExpandSlave <- fromMessage m = return $ Just $ modifySlave st (fracIncrement st) | Just (SetMasterFraction f) <- fromMessage m = return $ Just $ st { masterFrac = max 0 (min 1 f) } | Just (SetLeftSlaveFraction pos f) <- fromMessage m = return $ Just $ st { leftFracs = replaceAtPos (slaveFrac st) (leftFracs st) pos (max 0 (min 1 f)) } | Just (SetRightSlaveFraction pos f) <- fromMessage m = return $ Just $ st { rightFracs = replaceAtPos (slaveFrac st) (rightFracs st) pos (max 0 (min 1 f)) } | Just e <- fromMessage m :: Maybe Event = handleResize (draggers st) (isMirrored st) e >> return Nothing | Just Hide <- fromMessage m = releaseResources >> return (Just $ st { draggers = [] }) | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ st { draggers = [] }) where releaseResources = mapM_ deleteDragger $ draggers st handleMessage _ _ = return Nothing description st = mirror "MouseResizableTile" where mirror = if isMirrored st then ("Mirror " ++) else id draggerGeometry :: DraggerType -> X DraggerGeometry draggerGeometry (FixedDragger g d) = return (fromIntegral $ g `div` 2, g, fromIntegral $ d `div` 2, d) draggerGeometry BordersDragger = do w <- asks (borderWidth . config) return (0, 0, fromIntegral w, 2*w) adjustForMirror :: Bool -> DraggerWithRect -> DraggerWithRect adjustForMirror False dragger = dragger adjustForMirror True (draggerRect, draggerCursor, draggerInfo) = (mirrorRect draggerRect, draggerCursor', draggerInfo) where draggerCursor' = if (draggerCursor == xC_sb_h_double_arrow) then xC_sb_v_double_arrow else xC_sb_h_double_arrow modifySlave :: MouseResizableTile a -> Rational -> MouseResizableTile a modifySlave st delta = let pos = focusPos st num = numWindows st nmaster' = nmaster st leftFracs' = leftFracs st rightFracs' = rightFracs st slFrac = slaveFrac st draggersLeft = nmaster' - 1 draggersRight = (num - nmaster') - 1 in if pos < nmaster' then if draggersLeft > 0 then let draggerPos = min (draggersLeft - 1) pos oldFraction = (leftFracs' ++ repeat slFrac) !! draggerPos in st { leftFracs = replaceAtPos slFrac leftFracs' draggerPos (max 0 (min 1 (oldFraction + delta))) } else st else if draggersRight > 0 then let draggerPos = min (draggersRight - 1) (pos - nmaster') oldFraction = (rightFracs' ++ repeat slFrac) !! draggerPos in st { rightFracs = replaceAtPos slFrac rightFracs' draggerPos (max 0 (min 1 (oldFraction + delta))) } else st replaceAtPos :: (Num t, Eq t) => Rational -> [Rational] -> t -> Rational -> [Rational] replaceAtPos _ [] 0 x' = [x'] replaceAtPos d [] pos x' = d : replaceAtPos d [] (pos - 1) x' replaceAtPos _ (_:xs) 0 x' = x' : xs replaceAtPos d (x:xs) pos x' = x : replaceAtPos d xs (pos -1 ) x' sanitizeRectangle :: Rectangle -> Rectangle -> Rectangle sanitizeRectangle (Rectangle sx sy swh sht) (Rectangle x y wh ht) = (Rectangle (within 0 (sx + fromIntegral swh) x) (within 0 (sy + fromIntegral sht) y) (within 1 swh wh) (within 1 sht ht)) within :: (Ord a) => a -> a -> a -> a within low high a = max low $ min high a tile :: Int -> Rational -> [Rational] -> [Rational] -> Rectangle -> Int -> DraggerGeometry -> ([Rectangle], [DraggerWithRect]) tile nmaster' masterFrac' leftFracs' rightFracs' sr num drg | num <= nmaster' = splitVertically (take (num - 1) leftFracs') sr True 0 drg | nmaster' == 0 = splitVertically (take (num - 1) rightFracs') sr False 0 drg | otherwise = (leftRects ++ rightRects, masterDragger : leftDraggers ++ rightDraggers) where ((sr1, sr2), masterDragger) = splitHorizontallyBy masterFrac' sr drg (leftRects, leftDraggers) = splitVertically (take (nmaster' - 1) leftFracs') sr1 True 0 drg (rightRects, rightDraggers) = splitVertically (take (num - nmaster' - 1) rightFracs') sr2 False 0 drg splitVertically :: RealFrac r => [r] -> Rectangle -> Bool -> Int -> DraggerGeometry -> ([Rectangle], [DraggerWithRect]) splitVertically [] r _ _ _ = ([r], []) splitVertically (f:fx) (Rectangle sx sy sw sh) isLeft num drg@(drOff, drSz, drOff2, drSz2) = let nextRect = Rectangle sx sy sw $ smallh - div drSz 2 (otherRects, otherDragger) = splitVertically fx (Rectangle sx (sy + fromIntegral smallh + drOff) sw (sh - smallh - div drSz 2)) isLeft (num + 1) drg draggerRect = Rectangle sx (sy + fromIntegral smallh - drOff2) sw drSz2 draggerInfo = if isLeft then LeftSlaveDragger sy (fromIntegral sh) num else RightSlaveDragger sy (fromIntegral sh) num nextDragger = (draggerRect, xC_sb_v_double_arrow, draggerInfo) in (nextRect : otherRects, nextDragger : otherDragger) where smallh = floor $ fromIntegral sh * f splitHorizontallyBy :: RealFrac r => r -> Rectangle -> DraggerGeometry -> ((Rectangle, Rectangle), DraggerWithRect) splitHorizontallyBy f (Rectangle sx sy sw sh) (drOff, drSz, drOff2, drSz2) = ((leftHalf, rightHalf), (draggerRect, xC_sb_h_double_arrow, draggerInfo)) where leftw = floor $ fromIntegral sw * f leftHalf = Rectangle sx sy (leftw - drSz `div` 2) sh rightHalf = Rectangle (sx + fromIntegral leftw + drOff) sy (sw - fromIntegral leftw - drSz `div` 2) sh draggerRect = Rectangle (sx + fromIntegral leftw - drOff2) sy drSz2 sh draggerInfo = MasterDragger sx (fromIntegral sw) createDragger :: Rectangle -> DraggerWithRect -> X ((Window, Rectangle), DraggerWithWin) createDragger sr (draggerRect, draggerCursor, draggerInfo) = do let draggerRect' = sanitizeRectangle sr draggerRect draggerWin <- createInputWindow draggerCursor draggerRect' return ((draggerWin, draggerRect'), (draggerWin, draggerInfo)) deleteDragger :: DraggerWithWin -> X () deleteDragger (draggerWin, _) = deleteWindow draggerWin handleResize :: [DraggerWithWin] -> Bool -> Event -> X () handleResize draggers' isM ButtonEvent { ev_window = ew, ev_event_type = et } | et == buttonPress, Just x <- lookup ew draggers' = case x of MasterDragger lb r -> mouseDrag' id lb r SetMasterFraction LeftSlaveDragger lb r num -> mouseDrag' flip lb r (SetLeftSlaveFraction num) RightSlaveDragger lb r num -> mouseDrag' flip lb r (SetRightSlaveFraction num) where chooseAxis isM' axis1 axis2 = if isM' then axis2 else axis1 mouseDrag' flp lowerBound range msg = flip mouseDrag (return ()) $ \x y -> do let axis = flp (chooseAxis isM) x y fraction = fromIntegral (axis - lowerBound) / range sendMessage (msg fraction) handleResize _ _ _ = return () createInputWindow :: Glyph -> Rectangle -> X Window createInputWindow cursorGlyph r = withDisplay $ \d -> do win <- mkInputWindow d r io $ selectInput d win (exposureMask .|. buttonPressMask) cursor <- io $ createFontCursor d cursorGlyph io $ defineCursor d win cursor io $ freeCursor d cursor showWindow win return win mkInputWindow :: Display -> Rectangle -> X Window mkInputWindow d (Rectangle x y w h) = do rw <- asks theRoot let screen = defaultScreenOfDisplay d visual = defaultVisualOfScreen screen attrmask = cWOverrideRedirect io $ allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes True createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes xmonad-contrib-0.12/XMonad/Layout/ZoomRow.hs0000644000000000000000000002360712636047674017210 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-} {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses , PatternGuards, DeriveDataTypeable, ExistentialQuantification , FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ZoomRow -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Row layout with individually resizable elements. -- ----------------------------------------------------------------------------- module XMonad.Layout.ZoomRow ( -- * Usage -- $usage ZoomRow -- * Creation , zoomRow -- * Messages , ZoomMessage(..) , zoomIn , zoomOut , zoomReset -- * Use with non-'Eq' elements -- $noneq , zoomRowWith , EQF(..) , ClassEQ(..) ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Util.Stack import XMonad.Layout.Decoration (fi) import Data.Maybe (fromMaybe) import Control.Arrow (second) -- $usage -- This module provides a layout which places all windows in a single -- row; the size occupied by each individual window can be increased -- and decreased, and a window can be set to use the whole available -- space whenever it has focus. -- -- You can use this module by including the following in your @~\/.xmonad/xmonad.hs@: -- -- > import XMonad.Layout.ZoomRow -- -- and using 'zoomRow' somewhere in your 'layoutHook', for example: -- -- > myLayout = zoomRow ||| Mirror zoomRow -- -- To be able to resize windows, you can create keybindings to send -- the relevant 'ZoomMessage's: -- -- > -- Increase the size occupied by the focused window -- > , ((modMask .|. shifMask, xK_minus), sendMessage zoomIn) -- > -- Decrease the size occupied by the focused window -- > , ((modMayk , xK_minus), sendMessage zoomOut) -- > -- Reset the size occupied by the focused window -- > , ((modMask , xK_equal), sendMessage zoomReset) -- > -- (Un)Maximize the focused window -- > , ((modMask , xK_f ), sendMessage ToggleZoomFull) -- -- For more information on editing your layout hook and key bindings, -- see "XMonad.Doc.Extending". -- * Creation functions -- | 'ZoomRow' layout for laying out elements which are instances of -- 'Eq'. Perfect for 'Window's. zoomRow :: (Eq a, Show a, Read a) => ZoomRow ClassEQ a zoomRow = ZC ClassEQ emptyZ -- $noneq -- Haskell's 'Eq' class is usually concerned with structural equality, whereas -- what this layout really wants is for its elements to have a unique identity, -- even across changes. There are cases (such as, importantly, 'Window's) where -- the 'Eq' instance for a type actually does that, but if you want to lay -- out something more exotic than windows and your 'Eq' means something else, -- you can use the following. -- | ZoomRow layout with a custom equality predicate. It should -- of course satisfy the laws for 'Eq', and you should also make -- sure that the layout never has to handle two \"equal\" elements -- at the same time (it won't do any huge damage, but might behave -- a bit strangely). zoomRowWith :: (EQF f a, Show (f a), Read (f a), Show a, Read a) => f a -> ZoomRow f a zoomRowWith f = ZC f emptyZ -- * The datatypes -- | A layout that arranges its windows in a horizontal row, -- and allows to change the relative size of each element -- independently. data ZoomRow f a = ZC { zoomEq :: f a -- ^ Function to compare elements for -- equality, a real Eq instance might -- not be what you want in some cases , zoomRatios :: (Zipper (Elt a)) -- ^ Element specs. The zipper is so we -- know what the focus is when we handle -- a message } deriving (Show, Read, Eq) -- | Class for equivalence relations. Must be transitive, reflexive. class EQF f a where eq :: f a -> a -> a -> Bool -- | To use the usual '==': data ClassEQ a = ClassEQ deriving (Show, Read, Eq) instance Eq a => EQF ClassEQ a where eq _ a b = a == b -- | Size specification for an element. data Elt a = E { elt :: a -- ^ The element , ratio :: Rational -- ^ Its size ratio , full :: Bool -- ^ Whether it should occupy all the -- available space when it has focus. } deriving (Show, Read, Eq) -- * Helpers getRatio :: Elt a -> (a, Rational) getRatio (E a r _) = (a,r) lookupBy :: (a -> a -> Bool) -> a -> [Elt a] -> Maybe (Elt a) lookupBy _ _ [] = Nothing lookupBy f a (E a' r b : _) | f a a' = Just $ E a r b lookupBy f a (_:es) = lookupBy f a es setFocus :: Zipper a -> a -> Zipper a setFocus Nothing a = Just $ W.Stack a [] [] setFocus (Just s) a = Just s { W.focus = a } -- * Messages -- | The type of messages accepted by a 'ZoomRow' layout data ZoomMessage = Zoom Rational -- ^ Multiply the focused window's size factor -- by the given number. | ZoomTo Rational -- ^ Set the focused window's size factor to the -- given number. | ZoomFull Bool -- ^ Set whether the focused window should occupy -- all available space when it has focus | ZoomFullToggle -- ^ Toggle whether the focused window should -- occupy all available space when it has focus deriving (Typeable, Show) instance Message ZoomMessage -- | Increase the size of the focused window. -- Defined as @Zoom 1.5@ zoomIn :: ZoomMessage zoomIn = Zoom 1.5 -- | Decrease the size of the focused window. -- Defined as @Zoom (2/3)@ zoomOut :: ZoomMessage zoomOut = Zoom $ 2/3 -- | Reset the size of the focused window. -- Defined as @ZoomTo 1@ zoomReset :: ZoomMessage zoomReset = ZoomTo 1 -- * LayoutClass instance instance (EQF f a, Show a, Read a, Show (f a), Read (f a)) => LayoutClass (ZoomRow f) a where description (ZC _ Nothing) = "ZoomRow" description (ZC _ (Just s)) = "ZoomRow" ++ if full $ W.focus s then " (Max)" else "" emptyLayout (ZC _ Nothing) _ = return ([], Nothing) emptyLayout (ZC f _) _ = return ([], Just $ ZC f Nothing) doLayout (ZC f zelts) r@(Rectangle _ _ w _) s = let elts = W.integrate' zelts zelts' = mapZ_ (\a -> fromMaybe (E a 1 False) $ lookupBy (eq f) a elts) $ Just s elts' = W.integrate' zelts' maybeL' = if zelts `noChange` zelts' then Nothing else Just $ ZC f zelts' total = sum $ map ratio elts' widths = map (second ((* fi w) . (/total)) . getRatio) elts' in case getFocusZ zelts' of Just (E a _ True) -> return ([(a, r)], maybeL') _ -> return (makeRects r widths, maybeL') where makeRects :: Rectangle -> [(a, Rational)] -> [(a, Rectangle)] makeRects r pairs = let as = map fst pairs widths = map snd pairs discreteWidths = snd $ foldr discretize (0, []) widths rectangles = snd $ foldr makeRect (r, []) discreteWidths in zip as rectangles -- | Make a new rectangle by substracting the given width from the available -- space (from the right, since this is a foldr) makeRect :: Dimension -> (Rectangle, [Rectangle]) -> (Rectangle, [Rectangle]) makeRect w (Rectangle x y w0 h, rs) = ( Rectangle x y (w0-w) h , Rectangle (x+fi w0-fi w) y w h : rs ) -- | Round a list of fractions in a way that maintains the total. -- If you know a better way to do this I'm very interested. discretize :: Rational -> (Rational, [Dimension]) -> (Rational, [Dimension]) discretize r (carry, ds) = let (d, carry') = properFraction $ carry+r in (carry', d:ds) noChange z1 z2 = toTags z1 `helper` toTags z2 where helper [] [] = True helper (Right a:as) (Right b:bs) = a `sameAs` b && as `helper` bs helper (Left a:as) (Left b:bs) = a `sameAs` b && as `helper` bs helper _ _ = False E a1 r1 b1 `sameAs` E a2 r2 b2 = (eq f a1 a2) && (r1 == r2) && (b1 == b2) pureMessage (ZC f zelts) sm | Just (ZoomFull False) <- fromMessage sm , Just (E a r True) <- getFocusZ zelts = Just $ ZC f $ setFocus zelts $ E a r False pureMessage (ZC f zelts) sm | Just (ZoomFull True) <- fromMessage sm , Just (E a r False) <- getFocusZ zelts = Just $ ZC f $ setFocus zelts $ E a r True pureMessage (ZC f zelts) sm | Just (E a r b) <- getFocusZ zelts = case fromMessage sm of Just (Zoom r') -> Just $ ZC f $ setFocus zelts $ E a (r*r') b Just (ZoomTo r') -> Just $ ZC f $ setFocus zelts $ E a r' b Just ZoomFullToggle -> pureMessage (ZC f zelts) $ SomeMessage $ ZoomFull $ not b _ -> Nothing pureMessage _ _ = Nothingxmonad-contrib-0.12/XMonad/Layout/Dishes.hs0000644000000000000000000000360212636047674017004 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Dishes -- Copyright : (c) Jeremy Apthorp -- License : BSD-style (see LICENSE) -- -- Maintainer : Jeremy Apthorp -- Stability : unstable -- Portability : portable -- -- Dishes is a layout that stacks extra windows underneath the master -- windows. -- ----------------------------------------------------------------------------- module XMonad.Layout.Dishes ( -- * Usage -- $usage Dishes (..) ) where import XMonad import XMonad.StackSet (integrate) import Control.Monad (ap) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Dishes -- -- Then edit your @layoutHook@ by adding the Dishes layout: -- -- > myLayout = Dishes 2 (1/6) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" data Dishes a = Dishes Int Rational deriving (Show, Read) instance LayoutClass Dishes a where doLayout (Dishes nmaster h) r = return . (\x->(x,Nothing)) . ap zip (dishes h r nmaster . length) . integrate pureMessage (Dishes nmaster h) m = fmap incmastern (fromMessage m) where incmastern (IncMasterN d) = Dishes (max 0 (nmaster+d)) h dishes :: Rational -> Rectangle -> Int -> Int -> [Rectangle] dishes h s nmaster n = if n <= nmaster then splitHorizontally n s else ws where (m,rest) = splitVerticallyBy (1 - (fromIntegral $ n - nmaster) * h) s ws = splitHorizontally nmaster m ++ splitVertically (n - nmaster) rest xmonad-contrib-0.12/XMonad/Layout/HintedGrid.hs0000644000000000000000000001055112636047674017607 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.HintedGrid -- Copyright : (c) Lukas Mai -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- A not so simple layout that attempts to put all windows in a square grid -- while obeying their size hints. -- ----------------------------------------------------------------------------- module XMonad.Layout.HintedGrid ( -- * Usage -- $usage Grid(..), arrange, defaultRatio ) where import Prelude hiding ((.)) import XMonad import XMonad.StackSet import Control.Monad.State import Data.List import Data.Ord infixr 9 . (.) :: (Functor f) => (a -> b) -> f a -> f b (.) = fmap -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.HintedGrid -- -- Then edit your @layoutHook@ by adding the 'Grid' layout: -- -- > myLayout = Grid False ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- You can also specify an aspect ratio for Grid to strive for with the -- GridRatio constructor: -- -- > myLayout = GridRatio (4/3) False ||| etc. -- -- For more detailed instructions on editing the layoutHook see -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- | Automatic mirroring of hinted layouts doesn't work very well, so this -- 'Grid' comes with built-in mirroring. @Grid False@ is the normal layout, -- @Grid True@ is the mirrored variant (rotated by 90 degrees). data Grid a = Grid Bool | GridRatio Double Bool deriving (Read, Show) defaultRatio :: Double defaultRatio = 16/9 instance LayoutClass Grid Window where doLayout (Grid m) r w = doLayout (GridRatio defaultRatio m) r w doLayout (GridRatio d m) r w = flip (,) Nothing . arrange d m r (integrate w) replicateS :: Int -> (a -> (b, a)) -> a -> ([b], a) replicateS n f = runState . replicateM n $ do (a,s) <- gets f; put s; return a doColumn :: Dimension -> Dimension -> Dimension -> [(D -> D)] -> [D] doColumn width height k adjs = let (ind, fs) = unzip . sortBy (comparing $ snd . ($ (width, height)) . snd) . zip [0 :: Int ..] $ adjs (_, ds) = doC height k fs in map snd . sortBy (comparing fst) . zip ind $ ds where doC h _ [] = (h, []) doC h n (f : fs) = (adj :) . doC (h - h') (n - 1) fs where adj@(_, h') = f (width, h `div` n) doRect :: Dimension -> Dimension -> Dimension -> [[D -> D]] -> [Rectangle] doRect height = doR where doR _ _ [] = [] doR width n (c : cs) = let v = fromIntegral $ length c c' = doColumn (width `div` n) height v c (ws, hs) = unzip c' maxw = maximum ws height' = sum hs hbonus = height - height' hsingle = hbonus `div` v hoffset = hsingle `div` 2 width' = width - maxw ys = map ((height -) . subtract hoffset) . scanl1 (+) . map (hsingle +) $ hs xs = map ((width' +) . (`div` 2) . (maxw -)) $ ws in zipWith3 (\x y (w, h) -> Rectangle (fromIntegral x) (fromIntegral y) w h) xs ys c' ++ doR width' (n - 1) cs -- | The internal function for computing the grid layout. arrange :: Double -> Bool -> Rectangle -> [Window] -> X [(Window, Rectangle)] arrange aspectRatio mirror (Rectangle rx ry rw rh) wins = do proto <- mapM mkAdjust wins let adjs = map (\f -> twist . f . twist) proto rs = arrange' aspectRatio (twist (rw, rh)) adjs rs' = map (\(Rectangle x y w h) -> uncurry (uncurry Rectangle (twist (x, y))) (twist (w, h))) rs return . zip wins . map (\r -> r{ rect_x = rect_x r + rx, rect_y = rect_y r + ry }) $ rs' where twist | mirror = \(a, b) -> (b, a) | otherwise = id arrange' :: Double -> D -> [D -> D] -> [Rectangle] arrange' aspectRatio (rw, rh) adjs = reverse $ doRect rh rw (fromIntegral ncolumns) (ecols ++ cols) where nwindows = length adjs ncolumns = max 1 . round . sqrt $ fromIntegral nwindows * fromIntegral rw / (fromIntegral rh * aspectRatio) nrows = nwindows `div` ncolumns nextras = nwindows - ncolumns * nrows (ecols, adjs') = replicateS nextras (splitAt (nrows + 1)) $ reverse adjs (cols, _) = replicateS (ncolumns - nextras) (splitAt nrows) adjs' xmonad-contrib-0.12/XMonad/Layout/GridVariants.hs0000644000000000000000000002521412636047674020165 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} ---------------------------------------------------------------------- -- | -- Module : XMonad.Layout.GridVariants -- Copyright : (c) Norbert Zeh -- License : BSD-style (see LICENSE) -- -- Maintainer : nzeh@cs.dal.ca -- Stability : unstable -- Portability : unportable -- -- Two layouts: one is a variant of the Grid layout that allows the -- desired aspect ratio of windows to be specified. The other is like -- Tall but places a grid with fixed number of rows and columns in the -- master area and uses an aspect-ratio-specified layout for the -- slaves. ---------------------------------------------------------------------- module XMonad.Layout.GridVariants ( -- * Usage -- $usage ChangeMasterGridGeom(..) , ChangeGridGeom(..) , Grid(..) , TallGrid(..) , SplitGrid(..) , Orientation(..) ) where import Control.Monad import XMonad import qualified XMonad.StackSet as W -- $usage -- This module can be used as follows: -- -- > import XMonad.Layout.GridVariants -- -- Then add something like this to your layouts: -- -- > Grid (16/10) -- -- for a 16:10 aspect ratio grid, or -- -- > SplitGrid L 2 3 (2/3) (16/10) (5/100) -- -- for a layout with a 2x3 master grid that uses 2/3 of the screen, -- and a 16:10 aspect ratio slave grid to its right. The last -- parameter is again the percentage by which the split between master -- and slave area changes in response to Expand/Shrink messages. -- -- To be able to change the geometry of the master grid, add something -- like this to your keybindings: -- -- > ((modm .|. shiftMask, xK_equal), sendMessage $ IncMasterCols 1), -- > ((modm .|. shiftMask, xK_minus), sendMessage $ IncMasterCols (-1)), -- > ((modm .|. controlMask, xK_equal), sendMessage $ IncMasterRows 1), -- > ((modm .|. controlMask, xK_minus), sendMessage $ IncMasterRows (-1)) -- | Grid layout. The parameter is the desired x:y aspect ratio of windows data Grid a = Grid !Rational deriving (Read, Show) instance LayoutClass Grid a where pureLayout (Grid aspect) rect st = zip wins rects where wins = W.integrate st nwins = length wins rects = arrangeAspectGrid rect nwins aspect pureMessage layout msg = fmap (changeGridAspect layout) (fromMessage msg) description _ = "Grid" changeGridAspect :: Grid a -> ChangeGridGeom -> Grid a changeGridAspect (Grid _) (SetGridAspect aspect) = Grid aspect changeGridAspect (Grid aspect) (ChangeGridAspect delta) = Grid (max 0.00001 (aspect + delta)) -- |Geometry change messages understood by Grid and SplitGrid data ChangeGridGeom = SetGridAspect !Rational | ChangeGridAspect !Rational deriving Typeable instance Message ChangeGridGeom -- |SplitGrid layout. Parameters are -- -- - side where the master is -- - number of master rows -- - number of master columns -- - portion of screen used for master grid -- - x:y aspect ratio of slave windows -- - increment for resize messages data SplitGrid a = SplitGrid Orientation !Int !Int !Rational !Rational !Rational deriving (Read, Show) -- |Type to specify the side of the screen that holds -- the master area of a SplitGrid. data Orientation = T | B | L | R deriving (Eq, Read, Show) instance LayoutClass SplitGrid a where pureLayout (SplitGrid o mrows mcols mfrac saspect _) rect st = zip wins rects where wins = W.integrate st nwins = length wins rects = arrangeSplitGrid rect o nwins mrows mcols mfrac saspect pureMessage layout msg = msum [ fmap (resizeMaster layout) (fromMessage msg) , fmap (changeMasterGrid layout) (fromMessage msg) , fmap (changeSlaveGridAspect layout) (fromMessage msg) ] description _ = "SplitGrid" -- |The geometry change message understood by the master grid data ChangeMasterGridGeom = IncMasterRows !Int -- ^Change the number of master rows | IncMasterCols !Int -- ^Change the number of master columns | SetMasterRows !Int -- ^Set the number of master rows to absolute value | SetMasterCols !Int -- ^Set the number of master columns to absolute value | SetMasterFraction !Rational -- ^Set the fraction of the screen used by the master grid deriving Typeable instance Message ChangeMasterGridGeom arrangeSplitGrid :: Rectangle -> Orientation -> Int -> Int -> Int -> Rational -> Rational -> [Rectangle] arrangeSplitGrid rect@(Rectangle rx ry rw rh) o nwins mrows mcols mfrac saspect | nwins <= mwins = arrangeMasterGrid rect nwins mcols | mwins == 0 = arrangeAspectGrid rect nwins saspect | otherwise = (arrangeMasterGrid mrect mwins mcols) ++ (arrangeAspectGrid srect swins saspect) where mwins = mrows * mcols swins = nwins - mwins mrect = Rectangle mx my mw mh srect = Rectangle sx sy sw sh (mh, sh, mw, sw) = if o `elem` [T, B] then (ceiling (fromIntegral rh * mfrac), rh - mh, rw, rw) else (rh, rh, ceiling (fromIntegral rw * mfrac), rw - mw) mx = fromIntegral rx + if o == R then fromIntegral sw else 0 my = fromIntegral ry + if o == B then fromIntegral sh else 0 sx = fromIntegral rx + if o == L then fromIntegral mw else 0 sy = fromIntegral ry + if o == T then fromIntegral mh else 0 arrangeMasterGrid :: Rectangle -> Int -> Int -> [Rectangle] arrangeMasterGrid rect nwins mcols = arrangeGrid rect nwins (min nwins mcols) arrangeAspectGrid :: Rectangle -> Int -> Rational -> [Rectangle] arrangeAspectGrid rect@(Rectangle _ _ rw rh) nwins aspect = arrangeGrid rect nwins (min nwins ncols) where scr_a = fromIntegral rw / fromIntegral rh fcols = sqrt ( fromRational $ scr_a * fromIntegral nwins / aspect ) :: Double cols1 = floor fcols :: Int cols2 = ceiling fcols :: Int rows1 = ceiling ( fromIntegral nwins / fromIntegral cols1 :: Rational ) :: Int rows2 = floor ( fromIntegral nwins / fromIntegral cols2 :: Rational ) :: Int a1 = scr_a * fromIntegral rows1 / fromIntegral cols1 a2 = scr_a * fromIntegral rows2 / fromIntegral cols2 ncols | cols1 == 0 = cols2 | rows2 == 0 = cols1 | a1 / aspect < aspect / a2 = cols1 | otherwise = cols2 arrangeGrid :: Rectangle -> Int -> Int -> [Rectangle] arrangeGrid (Rectangle rx ry rw rh) nwins ncols = [Rectangle (fromIntegral x + rx) (fromIntegral y + ry) (fromIntegral w) (fromIntegral h) | (x, y, w, h) <- rects] where nrows_in_cols = listDifference $ splitEvenly nwins ncols x_slabs = splitIntoSlabs (fromIntegral rw) ncols y_slabs = [splitIntoSlabs (fromIntegral rh) nrows | nrows <- nrows_in_cols] rects_in_cols = [[(x, y, w, h) | (y, h) <- lst] | ((x, w), lst) <- zip x_slabs y_slabs] rects = foldr (++) [] rects_in_cols splitIntoSlabs :: Int -> Int -> [(Int, Int)] splitIntoSlabs width nslabs = zip (0:xs) widths where xs = splitEvenly width nslabs widths = listDifference xs listDifference :: [Int] -> [Int] listDifference lst = [cur-pre | (cur,pre) <- zip lst (0:lst)] splitEvenly :: Int -> Int -> [Int] splitEvenly n parts = [ sz-off | (sz,off) <- zip sizes offsets] where size = ceiling ( (fromIntegral n / fromIntegral parts) :: Double ) extra = size*parts - n sizes = [i*size | i <- [1..parts]] offsets = (take (fromIntegral extra) [1..]) ++ [extra,extra..] resizeMaster :: SplitGrid a -> Resize -> SplitGrid a resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Shrink = SplitGrid o mrows mcols (max 0 (mfrac - delta)) saspect delta resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Expand = SplitGrid o mrows mcols (min 1 (mfrac + delta)) saspect delta changeMasterGrid :: SplitGrid a -> ChangeMasterGridGeom -> SplitGrid a changeMasterGrid (SplitGrid o mrows mcols mfrac saspect delta) (IncMasterRows d) = SplitGrid o (max 0 (mrows + d)) mcols mfrac saspect delta changeMasterGrid (SplitGrid o mrows mcols mfrac saspect delta) (IncMasterCols d) = SplitGrid o mrows (max 0 (mcols + d)) mfrac saspect delta changeMasterGrid (SplitGrid o _ mcols mfrac saspect delta) (SetMasterRows mrows) = SplitGrid o (max 0 mrows) mcols mfrac saspect delta changeMasterGrid (SplitGrid o mrows _ mfrac saspect delta) (SetMasterCols mcols) = SplitGrid o mrows (max 0 mcols) mfrac saspect delta changeMasterGrid (SplitGrid o mrows mcols _ saspect delta) (SetMasterFraction mfrac) = SplitGrid o mrows mcols mfrac saspect delta changeSlaveGridAspect :: SplitGrid a -> ChangeGridGeom -> SplitGrid a changeSlaveGridAspect (SplitGrid o mrows mcols mfrac _ delta) (SetGridAspect saspect) = SplitGrid o mrows mcols mfrac saspect delta changeSlaveGridAspect (SplitGrid o mrows mcols mfrac saspect delta) (ChangeGridAspect sdelta) = SplitGrid o mrows mcols mfrac (max 0.00001 (saspect + sdelta)) delta -- | TallGrid layout. Parameters are -- -- - number of master rows -- - number of master columns -- - portion of screen used for master grid -- - x:y aspect ratio of slave windows -- - increment for resize messages -- -- This exists mostly because it was introduced in an earlier version. -- It's a fairly thin wrapper around "SplitGrid L". data TallGrid a = TallGrid !Int !Int !Rational !Rational !Rational deriving (Read, Show) instance LayoutClass TallGrid a where pureLayout (TallGrid mrows mcols mfrac saspect _) rect st = zip wins rects where wins = W.integrate st nwins = length wins rects = arrangeSplitGrid rect L nwins mrows mcols mfrac saspect pureMessage layout msg = msum [ fmap ((tallGridAdapter resizeMaster) layout) (fromMessage msg) , fmap ((tallGridAdapter changeMasterGrid) layout) (fromMessage msg) ] description _ = "TallGrid" tallGridAdapter :: (SplitGrid a -> b -> SplitGrid a) -> TallGrid a -> b -> TallGrid a tallGridAdapter f (TallGrid mrows mcols mfrac saspect delta) msg = TallGrid mrows' mcols' mfrac' saspect' delta' where SplitGrid _ mrows' mcols' mfrac' saspect' delta' = f (SplitGrid L mrows mcols mfrac saspect delta) msg xmonad-contrib-0.12/XMonad/Layout/Master.hs0000644000000000000000000001174212636047674017024 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Master -- Copyright : (c) Ismael Carnales, Lukas Mai -- License : BSD-style (see LICENSE) -- -- Maintainer : Ismael Carnales -- Stability : unstable -- Portability : unportable -- -- Layout modfier that adds a master window to another layout. ----------------------------------------------------------------------------- module XMonad.Layout.Master ( -- * Usage -- $usage mastered, fixMastered, multimastered, AddMaster, ) where import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.LayoutModifier import Control.Monad -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Master -- -- Then edit your @layoutHook@ and add the Master modifier to the layout that -- you prefer. -- -- > mastered (1/100) (1/2) $ Grid -- -- Or if you prefer to have a master with fixed width: -- -- > fixMastered (1/100) (1/2) $ Grid -- -- Or if you want multiple (here two) master windows from the beginning: -- -- > multimastered 2 (1/100) (1/2) $ Grid -- -- This will use the left half of your screen for a master window and let -- Grid manage the right half. -- -- For more detailed instructions on editing the layoutHook see -- "XMonad.Doc.Extending#Editing_the_layout_hook". -- -- Like 'XMonad.Layout.Tall', 'withMaster' supports the -- 'XMonad.Layout.Shrink' and XMonad.Layout.Expand' messages. -- | Data type for LayoutModifier which converts given layout to a mastered -- layout data AddMaster a = AddMaster Int Rational Rational deriving (Show, Read) multimastered :: (LayoutClass l a) => Int -- ^ @k@, number of master windows -> Rational -- ^ @delta@, the ratio of the screen to resize by -> Rational -- ^ @frac@, what portion of the screen to use for the master window -> l a -- ^ the layout to be modified -> ModifiedLayout AddMaster l a multimastered k delta frac = ModifiedLayout $ AddMaster k delta frac mastered :: (LayoutClass l a) => Rational -- ^ @delta@, the ratio of the screen to resize by -> Rational -- ^ @frac@, what portion of the screen to use for the master window -> l a -- ^ the layout to be modified -> ModifiedLayout AddMaster l a mastered delta frac = multimastered 1 delta frac instance LayoutModifier AddMaster Window where modifyLayout (AddMaster k delta frac) = applyMaster False k delta frac modifierDescription _ = "Mastered" pureMess (AddMaster k delta frac) m | Just Shrink <- fromMessage m = Just $ AddMaster k delta (frac-delta) | Just Expand <- fromMessage m = Just $ AddMaster k delta (frac+delta) | Just (IncMasterN d) <- fromMessage m = Just $ AddMaster (max 1 (k+d)) delta frac pureMess _ _ = Nothing data FixMaster a = FixMaster (AddMaster a) deriving (Show, Read) instance LayoutModifier FixMaster Window where modifyLayout (FixMaster (AddMaster k d f)) = applyMaster True k d f modifierDescription (FixMaster a) = "Fix" ++ modifierDescription a pureMess (FixMaster a) m = liftM FixMaster (pureMess a m) fixMastered :: (LayoutClass l a) => Rational -- ^ @delta@, the ratio of the screen to resize by -> Rational -- ^ @frac@, what portion of the screen to use for the master window -> l a -- ^ the layout to be modified -> ModifiedLayout FixMaster l a fixMastered delta frac = ModifiedLayout . FixMaster $ AddMaster 1 delta frac -- | Internal function for adding a master window and let the modified -- layout handle the rest of the windows applyMaster :: (LayoutClass l Window) => Bool -> Int -> Rational -> Rational -> S.Workspace WorkspaceId (l Window) Window -> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window)) applyMaster f k _ frac wksp rect = do let st= S.stack wksp let ws = S.integrate' $ st let n = length ws + fromEnum f if n > 1 then do if(n<=k) then return ((divideCol rect ws), Nothing) else do let m = take k ws let (mr, sr) = splitHorizontallyBy frac rect let nst = st>>= S.filter (\w -> not (w `elem` m)) wrs <- runLayout (wksp {S.stack = nst}) sr return ((divideCol mr m) ++ (fst wrs), snd wrs) else runLayout wksp rect -- | Shift rectangle down shiftD :: Position -> Rectangle -> Rectangle shiftD s (Rectangle x y w h) = Rectangle x (y+s) w h -- | Divide rectangle between windows divideCol :: Rectangle -> [a] -> [(a, Rectangle)] divideCol (Rectangle x y w h) ws = zip ws rects where n = length ws oneH = fromIntegral h `div` n oneRect = Rectangle x y w (fromIntegral oneH) rects = take n $ iterate (shiftD (fromIntegral oneH)) oneRect xmonad-contrib-0.12/XMonad/Layout/Dwindle.hs0000644000000000000000000002070312636047674017154 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Dwindle -- Copyright : (c) Norbert Zeh -- License : BSD3 -- -- Maintainer : Norbert Zeh -- Stability : experimental -- Portability : portable -- -- Three layouts: The first, 'Spiral', is a reimplementation of -- 'XMonad.Layout.Spiral.spiral' with, at least to me, more intuitive semantics. -- The second, 'Dwindle', is inspired by a similar layout in awesome and -- produces the same sequence of decreasing window sizes as Spiral but pushes -- the smallest windows into a screen corner rather than the centre. The third, -- 'Squeeze' arranges all windows in one row or in one column, with -- geometrically decreasing sizes. -- ----------------------------------------------------------------------------- module XMonad.Layout.Dwindle ( -- * Usage -- $usage Dwindle(..) , Direction2D(..) , Chirality(..) ) where import Data.List ( unfoldr ) import XMonad import XMonad.StackSet ( integrate, Stack ) import XMonad.Util.Types ( Direction2D(..) ) -- $usage -- This module can be used as follows: -- -- > import XMonad.Layout.Dwindle -- -- Then add something like this to your layouts: -- -- > Dwindle R CW 1.5 1.1 -- -- or -- -- > Spiral L CW 1.5 1.1 -- -- or -- -- ^ Squeeze D 1.5 1.1 -- -- The first produces a layout that places the second window to the right of -- the first, the third below the second, the fourth to the right of the third, -- and so on. The first window is 1.5 times as wide as the second one, the -- second is 1.5 times as tall as the third one, and so on. Thus, the further -- down the window stack a window is, the smaller it is and the more it is -- pushed into the bottom-right corner. -- -- The second produces a layout with the same window sizes but places the second -- window to the left of the first one, the third above the second one, the -- fourth to the right of the third one, and so on. -- -- The third produces a layout that stacks windows vertically top-down with each -- window being 1.5 times as tall as the next. -- -- In all three cases, the fourth (third, in the case of 'Squeeze') parameter, -- 1.1, is the factor by which the third parameter increases or decreases in -- response to Expand or Shrink messages. -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- | Layouts with geometrically decreasing window sizes. 'Spiral' and 'Dwindle' -- split the screen into a rectangle for the first window and a rectangle for -- the remaining windows, which is split recursively to lay out these windows. -- Both layouts alternate between horizontal and vertical splits. -- -- In each recursive step, the split 'Direction2D' determines the placement of the -- remaining windows relative to the current window: to the left, to the right, -- above or below. The split direction of the first split is determined by the -- first layout parameter. The split direction of the second step is rotated 90 -- degrees relative to the first split direction according to the second layout -- parameter of type 'Chirality'. So, if the first split is 'R' and the second -- layout parameter is 'CW', then the second split is 'D'. -- -- For the 'Spiral' layout, the same 'Chirality' is used for computing the split -- direction of each step from the split direction of the previous step. For -- example, parameters 'R' and 'CW' produces the direction sequence 'R', 'D', -- 'L', 'U', 'R', 'D', 'L', 'U', ... -- -- For the 'Dwindle' layout, the 'Chirality' alternates between 'CW' and 'CCW' in -- each step. For example, parameters 'U' and 'CCW' produce the direction -- sequence 'U', 'L', 'U', 'L', ... because 'L' is the 'CCW' rotation of 'U' and -- 'U' is the 'CW' rotation of 'L'. -- -- In each split, the current rectangle is split so that the ratio between the -- size of the rectangle allocated to the current window and the size of the -- rectangle allocated to the remaining windows is the third layout parameter. -- This ratio can be altered using 'Expand' and 'Shrink' messages. The former -- multiplies the ratio by the fourth layout parameter. The latter divides the -- ratio by this parameter. -- -- 'Squeeze' does not alternate between horizontal and vertical splits and -- simply splits in the direction given as its first argument. -- -- Parameters for both 'Dwindle' and 'Spiral': -- -- * First split direction -- -- * First split chirality -- -- * Size ratio between rectangle allocated to current window and rectangle -- allocated to remaining windows -- -- * Factor by which the size ratio is changed in response to 'Expand' or 'Shrink' -- messages -- -- The parameters for 'Squeeze' are the same, except that there is no 'Chirality' -- parameter. data Dwindle a = Dwindle !Direction2D !Chirality !Rational !Rational | Spiral !Direction2D !Chirality !Rational !Rational | Squeeze !Direction2D !Rational !Rational deriving (Read, Show) -- | Rotation between consecutive split directions data Chirality = CW | CCW deriving (Read, Show) instance LayoutClass Dwindle a where pureLayout (Dwindle dir rot ratio _) = dwindle alternate dir rot ratio pureLayout (Spiral dir rot ratio _) = dwindle rotate dir rot ratio pureLayout (Squeeze dir ratio _) = squeeze dir ratio pureMessage (Dwindle dir rot ratio delta) = fmap (\ratio' -> Dwindle dir rot ratio' delta) . changeRatio ratio delta pureMessage (Spiral dir rot ratio delta) = fmap (\ratio' -> Spiral dir rot ratio' delta) . changeRatio ratio delta pureMessage (Squeeze dir ratio delta) = fmap (\ratio' -> Squeeze dir ratio' delta) . changeRatio ratio delta changeRatio :: Rational -> Rational -> SomeMessage -> Maybe Rational changeRatio ratio delta = fmap f . fromMessage where f Expand = ratio * delta f Shrink = ratio / delta dwindle :: AxesGenerator -> Direction2D -> Chirality -> Rational -> Rectangle -> Stack a -> [(a, Rectangle)] dwindle trans dir rot ratio rect st = unfoldr genRects (integrate st, rect, dirAxes dir, rot) where genRects ([], _, _, _) = Nothing genRects ([w], r, a, rt) = Just ((w, r), ([], r, a, rt)) genRects ((w:ws), r, a, rt) = Just ((w, r'), (ws, r'', a', rt')) where (r', r'') = splitRect r ratio a (a', rt') = trans a rt squeeze :: Direction2D -> Rational -> Rectangle -> Stack a -> [(a, Rectangle)] squeeze dir ratio rect st = zip wins rects where wins = integrate st nwins = length wins sizes = take nwins $ unfoldr (\r -> Just (r * ratio, r * ratio)) 1 totals' = 0 : zipWith (+) sizes totals' totals = tail totals' splits = zip (tail sizes) totals ratios = reverse $ map (\(l, r) -> l / r) splits rects = genRects rect ratios genRects r [] = [r] genRects r (x:xs) = r' : genRects r'' xs where (r', r'') = splitRect r x (dirAxes dir) splitRect :: Rectangle -> Rational -> Axes -> (Rectangle, Rectangle) splitRect (Rectangle x y w h) ratio (ax, ay) = (Rectangle x' y' w' h', Rectangle x'' y'' w'' h'') where portion = ratio / (ratio + 1) w1 = (round $ fi w * portion) :: Int w2 = fi w - w1 h1 = (round $ fi h * portion) :: Int h2 = fi h - h1 x' = x + fi (negate ax * (1 - ax) * w2 `div` 2) y' = y + fi (negate ay * (1 - ay) * h2 `div` 2) w' = fi $ w1 + (1 - abs ax) * w2 h' = fi $ h1 + (1 - abs ay) * h2 x'' = x + fi (ax * (1 + ax) * w1 `div` 2) y'' = y + fi (ay * (1 + ay) * h1 `div` 2) w'' = fi $ w2 + (1 - abs ax) * w1 h'' = fi $ h2 + (1 - abs ay) * h1 fi :: (Num b, Integral a) => a -> b fi = fromIntegral type Axes = (Int, Int) type AxesGenerator = Axes -> Chirality -> (Axes, Chirality) dirAxes :: Direction2D -> Axes dirAxes L = (-1, 0) dirAxes R = ( 1, 0) dirAxes U = ( 0, -1) dirAxes D = ( 0, 1) alternate :: AxesGenerator alternate = chDir alt rotate :: AxesGenerator rotate = chDir id chDir :: (Chirality -> Chirality) -> AxesGenerator chDir f (x, y) r = (a' r, r') where a' CW = (-y, x) a' CCW = ( y, -x) r' = f r alt :: Chirality -> Chirality alt CW = CCW alt CCW = CW xmonad-contrib-0.12/XMonad/Layout/StackTile.hs0000644000000000000000000000445512636047674017457 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.StackTile -- Copyright : (c) Rickard Gustafsson -- License : BSD-style (see LICENSE) -- -- Maintainer : Rickard Gustafsson -- Stability : unstable -- Portability : unportable -- -- A stacking layout, like dishes but with the ability to resize master pane. -- Mostly useful on small screens. -- ----------------------------------------------------------------------------- module XMonad.Layout.StackTile ( -- * Usage -- $usage StackTile(..) ) where import XMonad hiding (tile) import qualified XMonad.StackSet as W import Control.Monad -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.StackTile -- -- Then edit your @layoutHook@ by adding the StackTile layout: -- -- > myLayout = StackTile 1 (3/100) (1/2) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- data StackTile a = StackTile !Int !Rational !Rational deriving (Show, Read) instance LayoutClass StackTile a where pureLayout (StackTile nmaster _ frac) r s = zip ws rs where ws = W.integrate s rs = tile frac r nmaster (length ws) pureMessage (StackTile nmaster delta frac) m = msum [fmap resize (fromMessage m) ,fmap incmastern (fromMessage m)] where resize Shrink = StackTile nmaster delta (max 0 $ frac-delta) resize Expand = StackTile nmaster delta (min 1 $ frac+delta) incmastern (IncMasterN d) = StackTile (max 0 (nmaster+d)) delta frac description _ = "StackTile" tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle] tile f r nmaster n = if n <= nmaster || nmaster == 0 then splitHorizontally n r else splitHorizontally nmaster r1 ++ splitVertically (n-nmaster) r2 -- two columns where (r1,r2) = splitVerticallyBy f r xmonad-contrib-0.12/XMonad/Layout/MagicFocus.hs0000644000000000000000000001006212636047674017603 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.MagicFocus -- Copyright : (c) Peter De Wachter -- License : BSD -- -- Maintainer : Peter De Wachter -- Stability : unstable -- Portability : unportable -- -- Automagically put the focused window in the master area. ----------------------------------------------------------------------------- module XMonad.Layout.MagicFocus (-- * Usage -- $usage magicFocus, promoteWarp, promoteWarp', followOnlyIf, disableFollowOnWS, MagicFocus, ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier import XMonad.Actions.UpdatePointer (updatePointer) import Data.Monoid(All(..)) import qualified Data.Map as M -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.MagicFocus -- -- Then edit your @layoutHook@ by adding the magicFocus layout -- modifier: -- -- > myLayout = magicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout, -- > handleEventHook = promoteWarp } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- | Create a new layout which automagically puts the focused window -- in the master area. magicFocus :: l a -> ModifiedLayout MagicFocus l a magicFocus = ModifiedLayout MagicFocus data MagicFocus a = MagicFocus deriving (Show, Read) instance LayoutModifier MagicFocus Window where modifyLayout MagicFocus (W.Workspace i l s) r = withWindowSet $ \wset -> runLayout (W.Workspace i l (s >>= \st -> Just $ swap st (W.peek wset))) r swap :: (Eq a) => W.Stack a -> Maybe a -> W.Stack a swap (W.Stack f u d) focused | Just f == focused = W.Stack f [] (reverse u ++ d) | otherwise = W.Stack f u d -- | An eventHook that overrides the normal focusFollowsMouse. When the mouse -- it moved to another window, that window is replaced as the master, and the -- mouse is warped to inside the new master. -- -- It prevents infinite loops when focusFollowsMouse is true (the default), and -- MagicFocus is in use when changing focus with the mouse. -- -- This eventHook does nothing when there are floating windows on the current -- workspace. promoteWarp :: Event -> X All promoteWarp = promoteWarp' (0.5, 0.5) (0.85, 0.85) -- | promoteWarp' allows you to specify an arbitrary pair of arguments to -- pass to 'updatePointer' when the mouse enters another window. promoteWarp' :: (Rational, Rational) -> (Rational, Rational) -> Event -> X All promoteWarp' refPos ratio e@(CrossingEvent {ev_window = w, ev_event_type = t}) | t == enterNotify && ev_mode e == notifyNormal = do ws <- gets windowset let foc = W.peek ws st = W.integrate' . W.stack . W.workspace $ W.current ws wsFloats = M.filterWithKey (\k _ -> k `elem` st) $ W.floating ws if Just w /= foc && M.null wsFloats then do windows (W.swapMaster . W.focusWindow w) updatePointer refPos ratio return $ All False else return $ All True promoteWarp' _ _ _ = return $ All True -- | Another event hook to override the focusFollowsMouse and make the pointer -- only follow if a given condition is satisfied. This could be used to disable -- focusFollowsMouse only for given workspaces or layouts. -- Beware that your focusFollowsMouse setting is ignored if you use this event hook. followOnlyIf :: X Bool -> Event -> X All followOnlyIf cond e@(CrossingEvent {ev_window = w, ev_event_type = t}) | t == enterNotify && ev_mode e == notifyNormal = whenX cond (focus w) >> return (All False) followOnlyIf _ _ = return $ All True -- | Disables focusFollow on the given workspaces: disableFollowOnWS :: [WorkspaceId] -> X Bool disableFollowOnWS wses = (`notElem` wses) `fmap` gets (W.currentTag . windowset) xmonad-contrib-0.12/XMonad/Layout/Minimize.hs0000644000000000000000000001341612636047674017352 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleContexts, PatternGuards #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Minimize -- Copyright : (c) Jan Vornberger 2009, Alejandro Serrano 2010 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- Makes it possible to minimize windows, temporarily removing them -- from the layout until they are restored. -- ----------------------------------------------------------------------------- module XMonad.Layout.Minimize ( -- * Usage -- $usage minimize, minimizeWindow, MinimizeMsg(RestoreMinimizedWin,RestoreNextMinimizedWin), Minimize, ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier import XMonad.Layout.BoringWindows as BW import XMonad.Util.WindowProperties (getProp32) import Data.List import qualified Data.Map as M import Data.Maybe import Foreign.C.Types (CLong) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Minimize -- -- Then edit your @layoutHook@ by adding the Minimize layout modifier: -- -- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- In the key-bindings, do something like: -- -- > , ((modm, xK_m ), withFocused minimizeWindow) -- > , ((modm .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin) -- -- The first action will minimize the focused window, while the second one will restore -- the next minimized window. -- -- For detailed instruction on editing the key binding see: -- -- "XMonad.Doc.Extending#Editing_key_bindings". -- -- The module is designed to work together with "XMonad.Layout.BoringWindows" so -- that minimized windows will be skipped over when switching the focused window with -- the keyboard. Include 'BW.boringWindows' in your layout hook and see the -- documentation of "XMonad.Layout.BoringWindows" on how to modify your keybindings. -- -- Also see "XMonad.Hooks.Minimize" if you want to be able to minimize -- and restore windows from your taskbar. data Minimize a = Minimize [Window] (M.Map Window W.RationalRect) deriving ( Read, Show ) minimize :: LayoutClass l Window => l Window -> ModifiedLayout Minimize l Window minimize = ModifiedLayout $ Minimize [] M.empty data MinimizeMsg = MinimizeWin Window | RestoreMinimizedWin Window | RestoreNextMinimizedWin deriving (Typeable, Eq) instance Message MinimizeMsg minimizeWindow :: Window -> X () minimizeWindow w = sendMessage (MinimizeWin w) >> BW.focusDown setMinimizedState :: Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X () setMinimizedState win st f = do setWMState win st withDisplay $ \dpy -> do wm_state <- getAtom "_NET_WM_STATE" mini <- getAtom "_NET_WM_STATE_HIDDEN" wstate <- fromMaybe [] `fmap` getProp32 wm_state win let ptype = 4 -- The atom property type for changeProperty fi_mini = fromIntegral mini io $ changeProperty32 dpy win wm_state ptype propModeReplace (f fi_mini wstate) setMinimized :: Window -> X () setMinimized win = setMinimizedState win iconicState (:) setNotMinimized :: Window -> X () setNotMinimized win = setMinimizedState win normalState delete instance LayoutModifier Minimize Window where modifierDescription _ = "Minimize" modifyLayout (Minimize minimized _) wksp rect = do let stack = W.stack wksp filtStack = stack >>=W.filter (\w -> not (w `elem` minimized)) runLayout (wksp {W.stack = filtStack}) rect handleMess (Minimize minimized unfloated) m | Just (MinimizeWin w) <- fromMessage m, not (w `elem` minimized) = do setMinimized w ws <- gets windowset case M.lookup w (W.floating ws) of Nothing -> return $ Just $ Minimize (w:minimized) unfloated Just r -> do modify (\s -> s { windowset = W.sink w ws}) return $ Just $ Minimize (w:minimized) (M.insert w r unfloated) | Just (RestoreMinimizedWin w) <- fromMessage m = do setNotMinimized w case M.lookup w unfloated of Nothing -> return $ Just $ Minimize (minimized \\ [w]) unfloated Just r -> do ws <- gets windowset modify (\s -> s { windowset = W.float w r ws}) return $ Just $ Minimize (minimized \\ [w]) (M.delete w unfloated) | Just RestoreNextMinimizedWin <- fromMessage m = do ws <- gets windowset if not (null minimized) then case M.lookup (head minimized) unfloated of Nothing -> do let w = head minimized setNotMinimized w modify (\s -> s { windowset = W.focusWindow w ws}) return $ Just $ Minimize (tail minimized) unfloated Just r -> do let w = head minimized setNotMinimized w modify (\s -> s { windowset = (W.focusWindow w . W.float w r) ws}) return $ Just $ Minimize (tail minimized) (M.delete w unfloated) else return Nothing | Just BW.UpdateBoring <- fromMessage m = do ws <- gets (W.workspace . W.current . windowset) flip sendMessageWithNoRefresh ws $ BW.Replace "Minimize" minimized return Nothing | otherwise = return Nothing xmonad-contrib-0.12/XMonad/Layout/LayoutBuilder.hs0000644000000000000000000003670712636047674020365 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LayoutBuilder -- Copyright : (c) 2009 Anders Engstrom -- License : BSD3-style (see LICENSE) -- -- Maintainer : Anders Engstrom -- Stability : unstable -- Portability : unportable -- -- A layout combinator that sends a specified number of windows to one rectangle -- and the rest to another. Each of these rectangles are given a layout that -- is used within them. This can be chained to provide an arbitrary number of -- rectangles. The layout combinator allows overlapping rectangles, but such -- layouts does not work well together with hinting -- ("XMonad.Layout.LayoutHints", "XMonad.Layout.HintedGrid" etc.) -- ----------------------------------------------------------------------------- module XMonad.Layout.LayoutBuilder ( -- * Usage -- $usage layoutN, layoutR, layoutAll, IncLayoutN (..), SubMeasure (..), SubBox (..), absBox, relBox, LayoutN, ) where import XMonad import qualified XMonad.StackSet as W import Data.Maybe (isJust,isNothing,listToMaybe) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.LayoutBuilder -- -- Then edit your @layoutHook@ by adding something like: -- -- > myLayout = ( (layoutN 1 (relBox 0 0 0.5 1) (Just $ relBox 0 0 1 1) $ simpleTabbed) -- > $ (layoutAll (relBox 0.5 0 1 1) $ simpleTabbed) -- > ) ||| -- > ( (layoutN 1 (relBox (1/3) 0 (1/2) 1) (Just $ relBox 0 0 1 1) $ Tall 0 0.01 0.5) -- > $ (layoutR 0.1 0.5 (relBox (2/3) 0 1 1) Nothing $ Tall 0 0.01 0.5) -- > $ (layoutAll (relBox 0 0 (1/3) 1) $ Tall 0 0.01 0.5) -- > ) ||| -- > ( (layoutN 1 (absBox (-512-200) 0 512 0) (Just $ relBox 0 0 1 1) $ simpleTabbed) -- > $ (layoutN 1 (absBox (-200) 0 0 0) Nothing $ simpleTabbed) -- > $ (layoutAll (absBox 0 0 (-512-200) 0) $ simpleTabbed) -- > ) ||| -- > ( (layoutN 1 (absBox 10 0 0 (-10)) Nothing $ Tall 0 0.01 0.5) -- > $ (layoutN 1 (absBox 0 0 200 0) Nothing $ Tall 0 0.01 0.5) -- > $ (layoutAll (absBox 10 10 0 0) $ Tall 2 0.01 0.5) -- > ) ||| Full ||| etc... -- > main = xmonad def { layoutHook = myLayout } -- -- This will produce a layout similar to DragPane, but with the possibility to have multiple windows in the left half -- and tabs that show the available windows. It will also produce a layout similar to ThreeColMid and a special layout -- created for use with a 80 columns wide Emacs window, its sidebar and a tabbed area for all other windows. -- -- The final layout is for applications that use a toolbar in a separate window, shown on a low resolution screen. It has -- a master area that cover almost the whole screen. It leaves 10 px to the left and 10 px at the bottom. To the left -- the toolbar is located and can be accessed by focusing this area. It is actually 200 px wide, but usually below the -- other windows. Similarly all other windows are tiled, but behind the master window and can be accessed by moving the -- mouse to the bottom of the screen. Everything can also be accessed by the standard focus changing key bindings. -- -- This module can be used to create many different custom layouts, but there are limitations. The primary limitation -- can be observed in the second and third example when there are only two columns with windows in them. The leftmost -- area is left blank. These blank areas can be avoided by placing the rectangles appropriately. -- -- These examples require "XMonad.Layout.Tabbed". -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- You may wish to add the following keybindings: -- -- > , ((modm .|. shiftMask, xK_h ), sendMessage $ IncLayoutN (-1)) -- > , ((modm .|. shiftMask, xK_l ), sendMessage $ IncLayoutN 1) -- -- For detailed instruction on editing the key binding see: -- -- "XMonad.Doc.Extending#Editing_key_bindings". type WindowNum = Either Int (Rational,Rational) -- | Use one layout in the specified area for a number of windows and possibly let another layout handle the rest. data LayoutN l1 l2 a = LayoutN (Maybe a) (Maybe a) WindowNum SubBox (Maybe SubBox) (l1 a) (Maybe (l2 a)) deriving (Show,Read) -- | Use the specified layout in the described area for N windows and send the rest of the windows to the next layout in the chain. -- It is possible to supply an alternative area that will then be used instead, if there are no windows to send to the next layout. layoutN :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a) => Int -- ^ The number of windows to handle -> SubBox -- ^ The box to place the windows in -> Maybe SubBox -- ^ Possibly an alternative box that is used when this layout handles all windows that are left -> l1 a -- ^ The layout to use in the specified area -> LayoutN l2 l3 a -- ^ Where to send the remaining windows -> LayoutN l1 (LayoutN l2 l3) a -- ^ The resulting layout layoutN num box mbox sub next = LayoutN Nothing Nothing (Left num) box mbox sub (Just next) -- | As layoutN, but the number of windows is given relative to the total number of windows remaining to be handled. The first -- argument is how much to change the ratio when using IncLayoutN, and the second is the initial ratio. layoutR :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a) => Rational -- ^ How much to change the ratio with each IncLayoutN -> Rational -- ^ The ratio of the remaining windows to handle -> SubBox -- ^ The box to place the windows in -> Maybe SubBox -- ^ Possibly an alternative box that is used when this layout handles all windows that are left -> l1 a -- ^ The layout to use in the specified area -> LayoutN l2 l3 a -- ^ Where to send the remaining windows -> LayoutN l1 (LayoutN l2 l3) a -- ^ The resulting layout layoutR numdiff num box mbox sub next = LayoutN Nothing Nothing (Right (numdiff,num)) box mbox sub (Just next) -- | Use the specified layout in the described area for all remaining windows. layoutAll :: (Read a, Eq a, LayoutClass l1 a) => SubBox -- ^ The box to place the windows in -> l1 a -- ^ The layout to use in the specified area -> LayoutN l1 Full a -- ^ The resulting layout layoutAll box sub = LayoutN Nothing Nothing (Right (0,1)) box Nothing sub Nothing -- | Change the number of windows handled by the focused layout. data IncLayoutN = IncLayoutN Int deriving Typeable instance Message IncLayoutN -- | The absolute or relative measures used to describe the area a layout should be placed in. For negative absolute values -- the total remaining space will be added. For sizes, the remaining space will also be added for zeroes. Relative values -- are applied on the remaining space after the top-left corner of the box have been removed. data SubMeasure = Abs Int | Rel Rational deriving (Show,Read) -- | A box to place a layout in. The stored values are xpos, ypos, width and height. data SubBox = SubBox SubMeasure SubMeasure SubMeasure SubMeasure deriving (Show,Read) -- | Create a box with only absolute measurements. If the values are negative, the total remaining space will be added. For -- sizes it will also be added for zeroes. absBox :: Int -- ^ Absolute X-Position -> Int -- ^ Absolute Y-Position -> Int -- ^ Absolute width -> Int -- ^ Absolute height -> SubBox -- ^ The resulting 'SubBox' describing the area absBox x y w h = SubBox (Abs x) (Abs y) (Abs w) (Abs h) -- | Create a box with only relative measurements. relBox :: Rational -- ^ Relative X-Position with respect to the surrounding area -> Rational -- ^ Relative Y-Position with respect to the surrounding area -> Rational -- ^ Relative width with respect to the remaining width -> Rational -- ^ Relative height with respect to the remaining height -> SubBox -- ^ The resulting 'SubBox' describing the area relBox x y w h = SubBox (Rel x) (Rel y) (Rel w) (Rel h) instance (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutClass (LayoutN l1 l2) a where -- | Update window locations. runLayout (W.Workspace _ (LayoutN subf nextf num box mbox sub next) s) rect = do let (subs,nexts,subf',nextf') = splitStack s num subf nextf selBox = if isJust nextf' then box else maybe box id mbox (sublist,sub',schange) <- handle sub subs $ calcArea selBox rect (nextlist,next',nchange) <- case next of Nothing -> return ([], Nothing, False) Just n -> do (res, l, ch) <- handle n nexts rect return (res, Just l, ch) let newlist = if (length $ maybe [] W.up s) < (length $ W.integrate' subs) then sublist++nextlist else nextlist++sublist newstate = if subf' /= subf || nextf' /= nextf || schange || nchange then Just $ LayoutN subf' nextf' num box mbox sub' next' else Nothing return (newlist, newstate) where handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r l' <- return $ maybe l id ml return (res, l', isNothing ml) -- | Propagate messages. handleMessage l m | Just (IncLayoutN _) <- fromMessage m = windowNum l m | Just (IncMasterN _) <- fromMessage m = sendFocus l m | Just (Shrink) <- fromMessage m = sendFocus l m | Just (Expand) <- fromMessage m = sendFocus l m | otherwise = sendBoth l m -- | Descriptive name for layout. description (LayoutN _ _ _ _ _ sub Nothing) = "layoutAll "++ description sub description (LayoutN _ _ (Left _) _ _ sub (Just next)) = "layoutN "++ description sub ++" "++ description next description (LayoutN _ _ (Right _) _ _ sub (Just next)) = "layoutR "++ description sub ++" "++ description next windowNum :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a)) windowNum l@(LayoutN subf nextf num box mbox subl nextl) m | (Just (IncLayoutN n)) <- fromMessage m = do foc <- isFocus subf if foc then do let newnum = case num of (Left oldnum) -> Left $ max 1 $ oldnum + n (Right (diff,oldnum)) -> Right (diff, min 1 $ max 0 $ oldnum + (fromIntegral n)*diff) return $ Just $ LayoutN subf nextf newnum box mbox subl nextl else sendNext l m windowNum l m = sendNext l m sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a)) sendSub (LayoutN subf nextf num box mbox sub next) m = do sub' <- handleMessage sub m return $ if isJust sub' then Just $ LayoutN subf nextf num box mbox (maybe sub id sub') next else Nothing sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a)) sendBoth l@(LayoutN _ _ _ _ _ _ Nothing) m = sendSub l m sendBoth (LayoutN subf nextf num box mbox sub (Just next)) m = do sub' <- handleMessage sub m next' <- handleMessage next m return $ if isJust sub' || isJust next' then Just $ LayoutN subf nextf num box mbox (maybe sub id sub') (Just $ maybe next id next') else Nothing sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a)) sendNext (LayoutN _ _ _ _ _ _ Nothing) _ = return Nothing sendNext (LayoutN subf nextf num box mbox sub (Just next)) m = do next' <- handleMessage next m return $ if isJust next' then Just $ LayoutN subf nextf num box mbox sub next' else Nothing sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a)) sendFocus l@(LayoutN subf _ _ _ _ _ _) m = do foc <- isFocus subf if foc then sendSub l m else sendNext l m isFocus :: (Show a) => Maybe a -> X Bool isFocus Nothing = return False isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset return $ maybe False (\s -> show w == (show $ W.focus s)) ms calcNum :: Int -> WindowNum -> Int calcNum tot num = max 1 $ case num of Left i -> i Right (_,r) -> ceiling $ r * fromIntegral tot splitStack :: Eq a => Maybe (W.Stack a) -> WindowNum -> Maybe a -> Maybe a -> (Maybe (W.Stack a),Maybe (W.Stack a),Maybe a,Maybe a) splitStack Nothing _ _ _ = (Nothing,Nothing,Nothing,Nothing) splitStack (Just s) num subf nextf = ( differentiate' subf' subl , differentiate' nextf' nextl , subf' , nextf' ) where ws = W.integrate s n = calcNum (length ws) num subl = take n ws nextl = drop n ws subf' = foc subl subf nextf' = foc nextl nextf foc [] _ = Nothing foc l f | W.focus s `elem` l = Just $ W.focus s | maybe False (`elem` l) f = f | otherwise = listToMaybe l calcArea :: SubBox -> Rectangle -> Rectangle calcArea (SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height' where xpos' = calc False xpos $ rect_width rect ypos' = calc False ypos $ rect_height rect width' = calc True width $ rect_width rect - xpos' height' = calc True height $ rect_height rect - ypos' calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $ case val of Rel v -> floor $ v * fromIntegral tot Abs v -> if v<0 || (zneg && v==0) then (fromIntegral tot)+v else v differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q) differentiate' _ [] = Nothing differentiate' Nothing w = W.differentiate w differentiate' (Just f) w | f `elem` w = Just $ W.Stack { W.focus = f , W.up = reverse $ takeWhile (/=f) w , W.down = tail $ dropWhile (/=f) w } | otherwise = W.differentiate w xmonad-contrib-0.12/XMonad/Layout/Roledex.hs0000644000000000000000000000501412636047674017166 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Roledex -- Copyright : (c) tim.thelion@gmail.com -- License : BSD -- -- Maintainer : tim.thelion@gmail.com -- Stability : unstable -- Portability : unportable -- -- This is a completely pointless layout which acts like Microsoft's Flip 3D ----------------------------------------------------------------------------- module XMonad.Layout.Roledex ( -- * Usage -- $usage -- * Screenshots -- $screenshot Roledex(Roledex)) where import XMonad import qualified XMonad.StackSet as W import Data.Ratio -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Roledex -- -- Then edit your @layoutHook@ by adding the Roledex layout: -- -- > myLayout = Roledex ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- $screenshot -- <> data Roledex a = Roledex deriving ( Show, Read ) instance LayoutClass Roledex Window where doLayout _ = roledexLayout roledexLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Roledex a)) roledexLayout sc ws = return ([(W.focus ws, mainPane)] ++ (zip ups tops) ++ (reverse (zip dns bottoms)) ,Nothing) where ups = W.up ws dns = W.down ws c = length ups + length dns rect = fst $ splitHorizontallyBy (2%3 :: Ratio Int) $ fst (splitVerticallyBy (2%3 :: Ratio Int) sc) gw = div' (w - rw) (fromIntegral c) where (Rectangle _ _ w _) = sc (Rectangle _ _ rw _) = rect gh = div' (h - rh) (fromIntegral c) where (Rectangle _ _ _ h) = sc (Rectangle _ _ _ rh) = rect mainPane = mrect (gw * fromIntegral c) (gh * fromIntegral c) rect mrect mx my (Rectangle x y w h) = Rectangle (x + (fromIntegral mx)) (y + (fromIntegral my)) w h tops = map f $ cd c (length dns) bottoms = map f $ [0..(length dns)] f n = mrect (gw * (fromIntegral n)) (gh * (fromIntegral n)) rect cd n m = if n > m then (n - 1) : (cd (n-1) m) else [] div' :: Integral a => a -> a -> a div' _ 0 = 0 div' n o = div n o xmonad-contrib-0.12/XMonad/Layout/MessageControl.hs0000644000000000000000000001046612636047674020520 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.MessageControl -- Copyright : (c) 2008 Quentin Moser -- License : BSD3 -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Provides message \"escaping\" and filtering facilities which -- help control complex nested layouts. ----------------------------------------------------------------------------- module XMonad.Layout.MessageControl ( -- * Usage -- $usage Ignore() , ignore , UnEscape() , unEscape , EscapedMessage(Escape) , escape ) where import XMonad.Core (Message, SomeMessage(..) , fromMessage, LayoutClass(..)) import XMonad.StackSet (Workspace(..)) import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..)) import Data.Typeable (Typeable) import Control.Applicative ((<$>)) import Control.Arrow (second) -- $usage -- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Layout.MessageEscape -- -- Then, if you use a modified layout where the modifier would intercept -- a message, but you'd want to be able to send it to the inner layout -- only, add the 'unEscape' modifier to the inner layout like so: -- -- > import XMonad.Layout.Master (mastered) -- > import XMonad.Layout.Tabbed (simpleTabbed) -- > import XMonad.Layout.LayoutCombinators ((|||)) -- > -- > myLayout = Tall ||| unEscape (mastered 0.01 0.5 $ Full ||| simpleTabbed) -- -- you can now send a message to the inner layout with -- @sendMessage $ escape message@, e.g. -- -- > -- Change the inner layout -- > ((modm .|. controlMask, xK_space), sendMessage $ escape NextLayout) -- -- If you want unescaped messages to be handled /only/ by the enclosing -- layout, use the 'ignore' modifier: -- -- > myLayout = Tall ||| (ignore NextLayout $ ignore (JumpToLayout "") $ -- > unEscape $ mastered 0.01 0.5 -- > $ Full ||| simpleTabbed) -- -- /IMPORTANT NOTE:/ The standard '(|||)' operator from "XMonad.Layout" -- does not behave correctly with 'ignore'. Make sure you use the one -- from "XMonad.Layout.LayoutCombinators". -- | the Ignore layout modifier. Prevents its inner layout from receiving -- messages of a certain type. data Ignore m l w = I (l w) deriving (Show, Read) instance (Message m, LayoutClass l w) => LayoutClass (Ignore m l) w where runLayout ws r = second (I <$>) <$> runLayout (unILayout ws) r where unILayout :: Workspace i (Ignore m l w) w -> Workspace i (l w) w unILayout w@(Workspace { layout = (I l) }) = w { layout = l } handleMessage l@(I l') sm = case fromMessageAs sm l of Just _ -> return Nothing Nothing -> (I <$>) <$> handleMessage l' sm where fromMessageAs :: Message m' => SomeMessage -> Ignore m' l w -> Maybe m' fromMessageAs a _ = fromMessage a description (I l) = "Ignore "++description l -- | the UnEscape layout modifier. Listens to 'EscapedMessage's and sends -- their nested message to the inner layout. data UnEscape w = UE deriving (Show, Read) instance LayoutModifier UnEscape a where handleMessOrMaybeModifyIt _ mess = return $ case fromMessage mess of Just (Escape mess') -> Just $ Right mess' Nothing -> Nothing -- | Data type for an escaped message. Send with 'escape'. newtype EscapedMessage = Escape SomeMessage deriving Typeable instance Message EscapedMessage -- | Creates an 'EscapedMessage'. escape :: Message m => m -> EscapedMessage escape = Escape . SomeMessage -- | Applies the UnEscape layout modifier to a layout. unEscape :: LayoutClass l w => l w -> ModifiedLayout UnEscape l w unEscape l = ModifiedLayout UE l -- | Applies the Ignore layout modifier to a layout, blocking -- all messages of the same type as the one passed as its first argument. ignore :: (Message m, LayoutClass l w) => m -> l w -> (Ignore m l w) ignore _ l = I lxmonad-contrib-0.12/XMonad/Layout/IM.hs0000644000000000000000000001112012636047674016064 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.IM -- Copyright : (c) Roman Cheplyaka, Ivan N. Veselov -- License : BSD-style (see LICENSE) -- -- Maintainer : Roman Cheplyaka -- Stability : unstable -- Portability : unportable -- -- Layout modfier suitable for workspace with multi-windowed instant messenger -- (like Psi or Tkabber). -- ----------------------------------------------------------------------------- module XMonad.Layout.IM ( -- * Usage -- $usage -- * Hints -- $hints -- * TODO -- $todo Property(..), IM(..), withIM, gridIM, AddRoster, ) where import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.Grid import XMonad.Layout.LayoutModifier import XMonad.Util.WindowProperties -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.IM -- > import Data.Ratio ((%)) -- -- Then edit your @layoutHook@ by adding IM modifier to layout which you prefer -- for managing your chat windows (Grid in this example, another useful choice -- to consider is Tabbed layout). -- -- > myLayout = withIM (1%7) (ClassName "Tkabber") Grid ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- Here @1%7@ is the part of the screen which your roster will occupy, -- @ClassName \"Tkabber\"@ tells xmonad which window is actually your roster. -- -- Screenshot: -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- $hints -- -- To launch IM layout automatically on your IM workspace use "XMonad.Layout.PerWorkspace". -- -- By default the roster window will appear on the left side. -- To place roster window on the right side, use @reflectHoriz@ from -- "XMonad.Layout.Reflect" module. -- $todo -- This item are questionable. Please let me know if you find them useful. -- -- * shrink\/expand -- -- | Data type for LayoutModifier which converts given layout to IM-layout -- (with dedicated space for the roster and original layout for chat windows) data AddRoster a = AddRoster Rational Property deriving (Read, Show) instance LayoutModifier AddRoster Window where modifyLayout (AddRoster ratio prop) = applyIM ratio prop modifierDescription _ = "IM" -- | Modifier which converts given layout to IM-layout (with dedicated -- space for roster and original layout for chat windows) withIM :: LayoutClass l a => Rational -> Property -> l a -> ModifiedLayout AddRoster l a withIM ratio prop = ModifiedLayout $ AddRoster ratio prop -- | IM layout modifier applied to the Grid layout gridIM :: Rational -> Property -> ModifiedLayout AddRoster Grid a gridIM ratio prop = withIM ratio prop Grid -- | Internal function for adding space for the roster specified by -- the property and running original layout for all chat windows applyIM :: (LayoutClass l Window) => Rational -> Property -> S.Workspace WorkspaceId (l Window) Window -> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window)) applyIM ratio prop wksp rect = do let stack = S.stack wksp let ws = S.integrate' $ stack let (masterRect, slaveRect) = splitHorizontallyBy ratio rect master <- findM (hasProperty prop) ws case master of Just w -> do let filteredStack = stack >>= S.filter (w /=) wrs <- runLayout (wksp {S.stack = filteredStack}) slaveRect return ((w, masterRect) : fst wrs, snd wrs) Nothing -> runLayout wksp rect -- | Like find, but works with monadic computation instead of pure function. findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a) findM _ [] = return Nothing findM f (x:xs) = do { b <- f x; if b then return (Just x) else findM f xs } -- | This is for compatibility with old configs only and will be removed in future versions! data IM a = IM Rational Property deriving (Read, Show) instance LayoutClass IM Window where description _ = "IM" doLayout (IM r prop) rect stack = do let ws = S.integrate stack let (masterRect, slaveRect) = splitHorizontallyBy r rect master <- findM (hasProperty prop) ws let positions = case master of Just w -> (w, masterRect) : arrange defaultRatio slaveRect (filter (w /=) ws) Nothing -> arrange defaultRatio rect ws return (positions, Nothing) xmonad-contrib-0.12/XMonad/Layout/Stoppable.hs0000644000000000000000000001153312636047674017520 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} {-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Stoppable -- Copyright : (c) Anton Vorontsov 2014 -- License : BSD-style (as xmonad) -- -- Maintainer : Anton Vorontsov -- Stability : unstable -- Portability : unportable -- -- This module implements a special kind of layout modifier, which when -- applied to a layout, causes xmonad to stop all non-visible processes. -- In a way, this is a sledge-hammer for applications that drain power. -- For example, given a web browser on a stoppable workspace, once the -- workspace is hidden the web browser will be stopped. -- -- Note that the stopped application won't be able to communicate with X11 -- clipboard. For this, the module actually stops applications after a -- certain delay, giving a chance for a user to complete copy-paste -- sequence. By default, the delay equals to 15 seconds, it is -- configurable via 'Stoppable' constructor. -- -- The stoppable modifier prepends a mark (by default equals to -- \"Stoppable\") to the layout description (alternatively, you can choose -- your own mark and use it with 'Stoppable' constructor). The stoppable -- layout (identified by a mark) spans to multiple workspaces, letting you -- to create groups of stoppable workspaces that only stop processes when -- none of the workspaces are visible, and conversely, unfreezing all -- processes even if one of the stoppable workspaces are visible. -- -- To stop the process we use signals, which works for most cases. For -- processes that tinker with signal handling (debuggers), another -- (Linux-centric) approach may be used. See -- -- ----------------------------------------------------------------------------- module XMonad.Layout.Stoppable ( -- $usage Stoppable(..) , stoppable ) where import XMonad import XMonad.Actions.WithAll import XMonad.Util.WindowProperties import XMonad.Util.RemoteWindows import XMonad.Util.Timer import XMonad.StackSet hiding (filter) import XMonad.Layout.LayoutModifier import System.Posix.Signals import Data.Maybe import Control.Monad -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad -- > import XMonad.Layout.Stoppable -- > -- > main = xmonad def -- > { layoutHook = layoutHook def ||| stoppable (layoutHook def) } -- -- Note that the module has to distinguish between local and remote -- proccesses, which means that it needs to know the hostname, so it looks -- for environment variables (e.g. HOST). -- -- Environment variables will work for most cases, but won't work if the -- hostname changes. To cover dynamic hostnames case, in addition to -- layoutHook you have to provide manageHook from -- "XMonad.Util.RemoteWindows" module. -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" signalWindow :: Signal -> Window -> X () signalWindow s w = do pid <- getProp32s "_NET_WM_PID" w io $ (signalProcess s . fromIntegral) `mapM_` fromMaybe [] pid signalLocalWindow :: Signal -> Window -> X () signalLocalWindow s w = isLocalWindow w >>= flip when (signalWindow s w) withAllOn :: (a -> X ()) -> Workspace i l a -> X () withAllOn f wspc = f `mapM_` integrate' (stack wspc) withAllFiltered :: (Workspace i l a -> Bool) -> [Workspace i l a] -> (a -> X ()) -> X () withAllFiltered p wspcs f = withAllOn f `mapM_` filter p wspcs sigStoppableWorkspacesHook :: String -> X () sigStoppableWorkspacesHook k = do ws <- gets windowset withAllFiltered isStoppable (hidden ws) (signalLocalWindow sigSTOP) where isStoppable ws = k `elem` words (description $ layout ws) -- | Data type for ModifiedLayout. The constructor lets you to specify a -- custom mark/description modifier and a delay. You can also use -- 'stoppable' helper function. data Stoppable a = Stoppable { mark :: String , delay :: Rational , timer :: Maybe TimerId } deriving (Show,Read) instance LayoutModifier Stoppable Window where modifierDescription = mark hook _ = withAll $ signalLocalWindow sigCONT handleMess (Stoppable m _ (Just tid)) msg | Just ev <- fromMessage msg = handleTimer tid ev run where run = sigStoppableWorkspacesHook m >> return Nothing handleMess (Stoppable m d _) msg | Just Hide <- fromMessage msg = (Just . Stoppable m d . Just) `liftM` startTimer d | otherwise = return Nothing -- | Convert a layout to a stoppable layout using the default mark -- (\"Stoppable\") and a delay of 15 seconds. stoppable :: l a -> ModifiedLayout Stoppable l a stoppable = ModifiedLayout (Stoppable "Stoppable" 15 Nothing) xmonad-contrib-0.12/XMonad/Layout/LayoutModifier.hs0000644000000000000000000003116312636047674020524 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LayoutModifier -- Copyright : (c) David Roundy -- License : BSD -- -- Maintainer : none -- Stability : unstable -- Portability : portable -- -- A module for writing easy layout modifiers, which do not define a -- layout in and of themselves, but modify the behavior of or add new -- functionality to other layouts. If you ever find yourself writing -- a layout which takes another layout as a parameter, chances are you -- should be writing a LayoutModifier instead! -- -- In case it is not clear, this module is not intended to help you -- configure xmonad, it is to help you write other extension modules. -- So get hacking! ----------------------------------------------------------------------------- module XMonad.Layout.LayoutModifier ( -- * Usage -- $usage -- * The 'LayoutModifier' class LayoutModifier(..), ModifiedLayout(..) ) where import Control.Monad import XMonad import XMonad.StackSet ( Stack, Workspace (..) ) -- $usage -- -- The 'LayoutModifier' class is provided to help extension developers -- write easy layout modifiers. End users won't find much of interest -- here. =) -- -- To write a layout modifier using the 'LayoutModifier' class, define -- a data type to represent the layout modification (storing any -- necessary state), define an instance of 'LayoutModifier', and -- export an appropriate function for applying the modifier. For example: -- -- > data MyModifier a = MyModifier MyState -- > deriving (Show, Read) -- > -- > instance LayoutModifier MyModifier a where -- > -- override whatever methods from LayoutModifier you like -- > -- > modify :: l a -> ModifiedLayout MyModifier l a -- > modify = ModifiedLayout (MyModifier initialState) -- -- When defining an instance of 'LayoutModifier', you are free to -- override as many or as few of the methods as you see fit. See the -- documentation below for specific information about the effect of -- overriding each method. Every method has a default implementation; -- an instance of 'LayoutModifier' which did not provide a non-default -- implementation of any of the methods would simply act as the -- identity on any layouts to which it is applied. -- -- For more specific usage examples, see -- -- * "XMonad.Layout.WorkspaceDir" -- -- * "XMonad.Layout.Magnifier" -- -- * "XMonad.Layout.NoBorders" -- -- * "XMonad.Layout.Reflect" -- -- * "XMonad.Layout.Named" -- -- * "XMonad.Layout.WindowNavigation" -- -- and several others. You probably want to start by looking at some -- of the above examples; the documentation below is detailed but -- possibly confusing, and in many cases the creation of a -- 'LayoutModifier' is actually quite simple. -- -- /Important note/: because of the way the 'LayoutModifier' class is -- intended to be used, by overriding any of its methods and keeping -- default implementations for all the others, 'LayoutModifier' -- methods should never be called explicitly. It is likely that such -- explicit calls will not have the intended effect. Rather, the -- 'LayoutModifier' methods should only be called indirectly through -- the 'LayoutClass' instance for 'ModifiedLayout', since it is this -- instance that defines the semantics of overriding the various -- 'LayoutModifier' methods. class (Show (m a), Read (m a)) => LayoutModifier m a where -- | 'modifyLayout' allows you to intercept a call to 'runLayout' -- /before/ it is called on the underlying layout, in order to -- perform some effect in the X monad, and\/or modify some of -- the parameters before passing them on to the 'runLayout' -- method of the underlying layout. -- -- The default implementation of 'modifyLayout' simply calls -- 'runLayout' on the underlying layout. modifyLayout :: (LayoutClass l a) => m a -- ^ the layout modifier -> Workspace WorkspaceId (l a) a -- ^ current workspace -> Rectangle -- ^ screen rectangle -> X ([(a, Rectangle)], Maybe (l a)) modifyLayout _ w r = runLayout w r -- | Similar to 'modifyLayout', but this function also allows you -- update the state of your layout modifier(the second value in the -- outer tuple). -- -- If both 'modifyLayoutWithUpdate' and 'redoLayout' return a -- modified state of the layout modifier, 'redoLayout' takes -- precedence. If this function returns a modified state, this -- state will internally be used in the subsequent call to -- 'redoLayout' as well. modifyLayoutWithUpdate :: (LayoutClass l a) => m a -> Workspace WorkspaceId (l a) a -> Rectangle -> X (([(a,Rectangle)], Maybe (l a)), Maybe (m a)) modifyLayoutWithUpdate m w r = flip (,) Nothing `fmap` modifyLayout m w r -- | 'handleMess' allows you to spy on messages to the underlying -- layout, in order to have an effect in the X monad, or alter -- the layout modifier state in some way (by returning @Just -- nm@, where @nm@ is a new modifier). In all cases, the -- underlying layout will also receive the message as usual, -- after the message has been processed by 'handleMess'. -- -- If you wish to possibly modify a message before it reaches -- the underlying layout, you should use -- 'handleMessOrMaybeModifyIt' instead. If you do not need to -- modify messages or have access to the X monad, you should use -- 'pureMess' instead. -- -- The default implementation of 'handleMess' calls 'unhook' -- when receiving a 'Hide' or 'ReleaseResources' method (after -- which it returns @Nothing@), and otherwise passes the message -- on to 'pureMess'. handleMess :: m a -> SomeMessage -> X (Maybe (m a)) handleMess m mess | Just Hide <- fromMessage mess = doUnhook | Just ReleaseResources <- fromMessage mess = doUnhook | otherwise = return $ pureMess m mess where doUnhook = do unhook m; return Nothing -- | 'handleMessOrMaybeModifyIt' allows you to intercept messages -- sent to the underlying layout, in order to have an effect in -- the X monad, alter the layout modifier state, or produce a -- modified message to be passed on to the underlying layout. -- -- The default implementation of 'handleMessOrMaybeModifyIt' -- simply passes on the message to 'handleMess'. handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage)) handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess return (Left `fmap` mm') -- | 'pureMess' allows you to spy on messages sent to the -- underlying layout, in order to possibly change the layout -- modifier state. -- -- The default implementation of 'pureMess' ignores messages -- sent to it, and returns @Nothing@ (causing the layout -- modifier to remain unchanged). pureMess :: m a -> SomeMessage -> Maybe (m a) pureMess _ _ = Nothing -- | 'redoLayout' allows you to intercept a call to 'runLayout' on -- workspaces with at least one window, /after/ it is called on -- the underlying layout, in order to perform some effect in the -- X monad, possibly return a new layout modifier, and\/or -- modify the results of 'runLayout' before returning them. -- -- If you don't need access to the X monad, use 'pureModifier' -- instead. Also, if the behavior you need can be cleanly -- separated into an effect in the X monad, followed by a pure -- transformation of the results of 'runLayout', you should -- consider implementing 'hook' and 'pureModifier' instead of -- 'redoLayout'. -- -- On empty workspaces, the Stack is Nothing. -- -- The default implementation of 'redoLayout' calls 'hook' and -- then 'pureModifier'. redoLayout :: m a -- ^ the layout modifier -> Rectangle -- ^ screen rectangle -> Maybe (Stack a) -- ^ current window stack -> [(a, Rectangle)] -- ^ (window,rectangle) pairs returned -- by the underlying layout -> X ([(a, Rectangle)], Maybe (m a)) redoLayout m r ms wrs = do hook m; return $ pureModifier m r ms wrs -- | 'pureModifier' allows you to intercept a call to 'runLayout' -- /after/ it is called on the underlying layout, in order to -- modify the list of window\/rectangle pairings it has returned, -- and\/or return a new layout modifier. -- -- The default implementation of 'pureModifier' returns the -- window rectangles unmodified. pureModifier :: m a -- ^ the layout modifier -> Rectangle -- ^ screen rectangle -> Maybe (Stack a) -- ^ current window stack -> [(a, Rectangle)] -- ^ (window, rectangle) pairs returned -- by the underlying layout -> ([(a, Rectangle)], Maybe (m a)) pureModifier _ _ _ wrs = (wrs, Nothing) -- | 'hook' is called by the default implementation of -- 'redoLayout', and as such represents an X action which is to -- be run each time 'runLayout' is called on the underlying -- layout, /after/ 'runLayout' has completed. Of course, if you -- override 'redoLayout', then 'hook' will not be called unless -- you explicitly call it. -- -- The default implementation of 'hook' is @return ()@ (i.e., it -- has no effect). hook :: m a -> X () hook _ = return () -- | 'unhook' is called by the default implementation of -- 'handleMess' upon receiving a 'Hide' or a 'ReleaseResources' -- message. -- -- The default implementation, of course, does nothing. unhook :: m a -> X () unhook _ = return () -- | 'modifierDescription' is used to give a String description to -- this layout modifier. It is the empty string by default; you -- should only override this if it is important that the -- presence of the layout modifier be displayed in text -- representations of the layout (for example, in the status bar -- of a "XMonad.Hooks.DynamicLog" user). modifierDescription :: m a -> String modifierDescription = const "" -- | 'modifyDescription' gives a String description for the entire -- layout (modifier + underlying layout). By default, it is -- derived from the concatenation of the 'modifierDescription' -- with the 'description' of the underlying layout, with a -- \"smart space\" in between (the space is not included if the -- 'modifierDescription' is empty). modifyDescription :: (LayoutClass l a) => m a -> l a -> String modifyDescription m l = modifierDescription m <> description l where "" <> x = x x <> y = x ++ " " ++ y -- | The 'LayoutClass' instance for a 'ModifiedLayout' defines the -- semantics of a 'LayoutModifier' applied to an underlying layout. instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where runLayout (Workspace i (ModifiedLayout m l) ms) r = do ((ws, ml'),mm') <- modifyLayoutWithUpdate m (Workspace i l ms) r (ws', mm'') <- redoLayout (maybe m id mm') r ms ws let ml'' = case mm'' `mplus` mm' of Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml' Nothing -> ModifiedLayout m `fmap` ml' return (ws', ml'') handleMessage (ModifiedLayout m l) mess = do mm' <- handleMessOrMaybeModifyIt m mess ml' <- case mm' of Just (Right mess') -> handleMessage l mess' _ -> handleMessage l mess return $ case mm' of Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml' _ -> (ModifiedLayout m) `fmap` ml' description (ModifiedLayout m l) = modifyDescription m l -- | A 'ModifiedLayout' is simply a container for a layout modifier -- combined with an underlying layout. It is, of course, itself a -- layout (i.e. an instance of 'LayoutClass'). data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show ) -- N.B. I think there is a Haddock bug here; the Haddock output for -- the above does not parenthesize (m a) and (l a), which is obviously -- incorrect. xmonad-contrib-0.12/XMonad/Layout/Square.hs0000644000000000000000000000406412636047674017030 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Square -- Copyright : (c) David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- A layout that splits the screen into a square area and the rest of the -- screen. -- This is probably only ever useful in combination with -- "XMonad.Layout.Combo". -- It sticks one window in a square region, and makes the rest -- of the windows live with what's left (in a full-screen sense). -- ----------------------------------------------------------------------------- module XMonad.Layout.Square ( -- * Usage -- $usage Square(..) ) where import XMonad import XMonad.StackSet ( integrate ) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Layout.Square -- -- An example layout using square together with "XMonad.Layout.Combo" -- to make the very last area square: -- -- > , combo (combo (mirror $ twoPane 0.03 0.85),1)] (twoPane 0.03 0.5) ) -- > [(twoPane 0.03 0.2,1),(combo [(twoPane 0.03 0.8,1),(square,1)] -- > [(tabbed,3),(tabbed,30),(tabbed,1),(tabbed,1)] -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". data Square a = Square deriving ( Read, Show ) instance LayoutClass Square a where pureLayout Square r s = arrange (integrate s) where arrange ws@(_:_) = map (\w->(w,rest)) (init ws) ++ [(last ws,sq)] arrange [] = [] -- actually, this is an impossible case (rest, sq) = splitSquare r splitSquare :: Rectangle -> (Rectangle, Rectangle) splitSquare (Rectangle x y w h) | w > h = (Rectangle x y (w - h) h, Rectangle (x+fromIntegral (w-h)) y h h) | otherwise = (Rectangle x y w (h-w), Rectangle x (y+fromIntegral (h-w)) w w) xmonad-contrib-0.12/XMonad/Layout/Simplest.hs0000644000000000000000000000235212636047674017366 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Simplest -- Copyright : (c) 2007 Andrea Rossato -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A very simple layout. The simplest, afaik. ----------------------------------------------------------------------------- module XMonad.Layout.Simplest ( -- * Usage: -- $usage Simplest (..) ) where import XMonad import qualified XMonad.StackSet as S -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Simplest -- -- Then edit your @layoutHook@ by adding the Simplest layout: -- -- > myLayout = Simplest ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" data Simplest a = Simplest deriving (Show, Read) instance LayoutClass Simplest a where pureLayout Simplest rec (S.Stack w l r) = zip (w : reverse l ++ r) (repeat rec) xmonad-contrib-0.12/XMonad/Layout/IfMax.hs0000644000000000000000000000524712636047674016600 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.IfMax -- Copyright : (c) 2013 Ilya Portnov -- License : BSD3-style (see LICENSE) -- -- Maintainer : Ilya Portnov -- Stability : unstable -- Portability : unportable -- -- Provides IfMax layout, which will run one layout if there are maximum N -- windows on workspace, and another layout, when number of windows is greater -- than N. -- ----------------------------------------------------------------------------- {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} module XMonad.Layout.IfMax ( -- * Usage -- $usage IfMax (..) , ifMax ) where import Data.Maybe import XMonad import qualified XMonad.StackSet as W -- $usage -- IfMax layout will run one layout if number of windows on workspace is as -- maximum N, and else will run another layout. -- -- You can use this module by adding folowing in your @xmonad.hs@: -- -- > import XMonad.Layout.IfMax -- -- Then add layouts to your layoutHook: -- -- > myLayoutHook = IfMax 2 Full (Tall ...) ||| ... -- -- In this example, if there are 1 or 2 windows, Full layout will be used; -- otherwise, Tall layout will be used. -- data IfMax l1 l2 w = IfMax Int (l1 w) (l2 w) deriving (Read, Show) instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (IfMax l1 l2) a where runLayout (W.Workspace _ (IfMax n l1 l2) s) rect = arrange (W.integrate' s) where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources) l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources) return ([], Just $ IfMax n l1' l2') arrange ws | length ws <= n = do (wrs, ml1') <- runLayout (W.Workspace "" l1 s) rect let l1' = fromMaybe l1 ml1' return (wrs, Just $ IfMax n l1' l2) | otherwise = do (wrs, ml2') <- runLayout (W.Workspace "" l2 s) rect let l2' = fromMaybe l2 ml2' return (wrs, Just $ IfMax n l1 l2') description (IfMax n l1 l2) = "If number of windows is <= " ++ show n ++ ", then " ++ description l1 ++ ", else " ++ description l2 -- | Layout itself ifMax :: (LayoutClass l1 w, LayoutClass l2 w) => Int -- ^ Maximum number of windows for the first layout -> l1 w -- ^ First layout -> l2 w -- ^ Second layout -> IfMax l1 l2 w ifMax n l1 l2 = IfMax n l1 l2 xmonad-contrib-0.12/XMonad/Layout/TabBarDecoration.hs0000644000000000000000000000566112636047674020737 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.TabBarDecoration -- Copyright : (c) 2007 Andrea Rossato -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A layout modifier to add a bar of tabs to your layouts. ----------------------------------------------------------------------------- module XMonad.Layout.TabBarDecoration ( -- * Usage -- $usage simpleTabBar, tabBar , def, defaultTheme, shrinkText , TabBarDecoration (..), XPPosition (..) , module XMonad.Layout.ResizeScreen ) where import Data.List import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.Decoration import XMonad.Layout.ResizeScreen import XMonad.Prompt ( XPPosition (..) ) -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.TabBarDecoration -- -- Then edit your @layoutHook@ by adding the layout you want: -- -- > main = xmonad def { layoutHook = simpleTabBar $ layoutHook def} -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- 'tabBar' will give you the possibility of setting a custom shrinker -- and a custom theme. -- -- The deafult theme can be dynamically change with the xmonad theme -- selector. See "XMonad.Prompt.Theme". For more themse, look at -- "XMonad.Util.Themes" -- | Add, on the top of the screen, a simple bar of tabs to a given -- | layout, with the default theme and the default shrinker. simpleTabBar :: Eq a => l a -> ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen l) a simpleTabBar = decoration shrinkText def (TabBar Top) . resizeVertical 20 -- | Same of 'simpleTabBar', but with the possibility of setting a -- custom shrinker, a custom theme and the position: 'Top' or -- 'Bottom'. tabBar :: (Eq a, Shrinker s) => s -> Theme -> XPPosition -> l a -> ModifiedLayout (Decoration TabBarDecoration s) l a tabBar s t p = decoration s t (TabBar p) data TabBarDecoration a = TabBar XPPosition deriving (Read, Show) instance Eq a => DecorationStyle TabBarDecoration a where describeDeco _ = "TabBar" shrink _ _ r = r decorationCatchClicksHook _ mainw _ _ = focus mainw >> return True pureDecoration (TabBar p) _ dht (Rectangle x y wh ht) s _ (w,_) = if isInStack s w then Just $ Rectangle nx ny wid (fi dht) else Nothing where wrs = S.integrate s loc i = (wh * fi i) `div` max 1 (fi $ length wrs) wid = maybe (fi x) (\i -> loc (i+1) - loc i) $ w `elemIndex` wrs ny = case p of Top -> y Bottom -> y + fi ht - fi dht nx = (x +) $ maybe 0 (fi . loc) $ w `elemIndex` wrs xmonad-contrib-0.12/XMonad/Layout/CenteredMaster.hs0000644000000000000000000001002412636047674020466 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.CenteredMaster -- Copyright : (c) 2009 Ilya Portnov -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : Ilya Portnov -- Stability : unstable -- Portability : unportable -- -- Two layout modifiers. centerMaster places master window at center, -- on top of all other windows, which are managed by base layout. -- topRightMaster is similar, but places master window in top right corner -- instead of center. -- ----------------------------------------------------------------------------- module XMonad.Layout.CenteredMaster ( -- * Usage -- $usage centerMaster, topRightMaster, CenteredMaster, TopRightMaster, ) where import XMonad import XMonad.Layout.LayoutModifier import qualified XMonad.StackSet as W -- $usage -- This module defines two new layout modifiers: centerMaster and topRightMaster. -- centerMaster places master window at center of screen, on top of others. -- All other windows in background are managed by base layout. -- topRightMaster is like centerMaster, but places master window in top right corner instead of center. -- -- Yo can use this module by adding folowing in your @xmonad.hs@: -- -- > import XMonad.Layout.CenteredMaster -- -- Then add layouts to your layoutHook: -- -- > myLayoutHook = centerMaster Grid ||| ... -- | Function that decides where master window should be placed type Positioner = Rectangle -> Rectangle -- | Data type for LayoutModifier data CenteredMaster a = CenteredMaster deriving (Read,Show) instance LayoutModifier CenteredMaster Window where modifyLayout CenteredMaster = applyPosition (center (5/7) (5/7)) data TopRightMaster a = TopRightMaster deriving (Read,Show) instance LayoutModifier TopRightMaster Window where modifyLayout TopRightMaster = applyPosition (topRight (3/7) (1/2)) -- | Modifier that puts master window in center, other windows in background -- are managed by given layout centerMaster :: LayoutClass l a => l a -> ModifiedLayout CenteredMaster l a centerMaster = ModifiedLayout CenteredMaster -- | Modifier that puts master window in top right corner, other windows in background -- are managed by given layout topRightMaster :: LayoutClass l a => l a -> ModifiedLayout TopRightMaster l a topRightMaster = ModifiedLayout TopRightMaster -- | Internal function, doing main job applyPosition :: (LayoutClass l a, Eq a) => Positioner -> W.Workspace WorkspaceId (l a) a -> Rectangle -> X ([(a, Rectangle)], Maybe (l a)) applyPosition pos wksp rect = do let stack = W.stack wksp let ws = W.integrate' $ stack if null ws then runLayout wksp rect else do let first = head ws let other = tail ws let filtStack = stack >>= W.filter (first /=) wrs <- runLayout (wksp {W.stack = filtStack}) rect return ((first, place pos other rect) : fst wrs, snd wrs) -- | Place master window (it's Rectangle is given), using the given Positioner. -- If second argument is empty (that is, there is only one window on workspace), -- place that window fullscreen. place :: Positioner -> [a] -> Rectangle -> Rectangle place _ [] rect = rect place pos _ rect = pos rect -- | Function that calculates Rectangle at top right corner of given Rectangle topRight :: Float -> Float -> Rectangle -> Rectangle topRight rx ry (Rectangle sx sy sw sh) = Rectangle x sy w h where w = round (fromIntegral sw * rx) h = round (fromIntegral sh * ry) x = sx + fromIntegral (sw-w) -- | Function that calculates Rectangle at center of given Rectangle. center :: Float -> Float -> Rectangle -> Rectangle center rx ry (Rectangle sx sy sw sh) = Rectangle x y w h where w = round (fromIntegral sw * rx) h = round (fromIntegral sh * ry) x = sx + fromIntegral (sw-w) `div` 2 y = sy + fromIntegral (sh-h) `div` 2 xmonad-contrib-0.12/XMonad/Layout/Grid.hs0000644000000000000000000000476512636047674016465 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Grid -- Copyright : (c) Lukas Mai -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- A simple layout that attempts to put all windows in a square grid. -- ----------------------------------------------------------------------------- module XMonad.Layout.Grid ( -- * Usage -- $usage Grid(..), arrange, defaultRatio ) where import XMonad import XMonad.StackSet -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Grid -- -- Then edit your @layoutHook@ by adding the Grid layout: -- -- > myLayout = Grid ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- You can also specify an aspect ratio for Grid to strive for with the -- GridRatio constructor. For example, if you want Grid to try to make a grid -- four windows wide and three windows tall, you could use -- -- > myLayout = GridRatio (4/3) ||| etc. -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" data Grid a = Grid | GridRatio Double deriving (Read, Show) defaultRatio :: Double defaultRatio = 16/9 instance LayoutClass Grid a where pureLayout Grid r = pureLayout (GridRatio defaultRatio) r pureLayout (GridRatio d) r = arrange d r . integrate arrange :: Double -> Rectangle -> [a] -> [(a, Rectangle)] arrange aspectRatio (Rectangle rx ry rw rh) st = zip st rectangles where nwins = length st ncols = max 1 . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh * aspectRatio) mincs = max 1 $ nwins `div` ncols extrs = nwins - ncols * mincs chop :: Int -> Dimension -> [(Position, Dimension)] chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m' where k :: Dimension k = m `div` fromIntegral n m' = fromIntegral m k' :: Position k' = fromIntegral k xcoords = chop ncols rw ycoords = chop mincs rh ycoords' = chop (succ mincs) rh (xbase, xext) = splitAt (ncols - extrs) xcoords rectangles = combine ycoords xbase ++ combine ycoords' xext where combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys] xmonad-contrib-0.12/XMonad/Layout/IndependentScreens.hs0000644000000000000000000002051512636047674021347 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.IndependentScreens -- Copyright : (c) 2009 Daniel Wagner -- License : BSD3 -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Utility functions for simulating independent sets of workspaces on -- each screen (like dwm's workspace model), using internal tags to -- distinguish workspaces associated with each screen. ----------------------------------------------------------------------------- module XMonad.Layout.IndependentScreens ( -- * Usage -- $usage VirtualWorkspace, PhysicalWorkspace, workspaces', withScreens, onCurrentScreen, marshallPP, whenCurrentOn, countScreens, -- * Converting between virtual and physical workspaces -- $converting marshall, unmarshall, unmarshallS, unmarshallW, marshallWindowSpace, unmarshallWindowSpace, marshallSort ) where -- for the screen stuff import Control.Applicative((<*), liftA2) import Control.Arrow hiding ((|||)) import Control.Monad import Data.List (nub, genericLength) import Graphics.X11.Xinerama import XMonad import XMonad.StackSet hiding (filter, workspaces) import XMonad.Hooks.DynamicLog -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.IndependentScreens -- -- You can define your workspaces by calling @withScreens@: -- -- > myConfig = def { workspaces = withScreens 2 ["web", "email", "irc"] } -- -- This will create \"physical\" workspaces with distinct internal names for -- each (screen, virtual workspace) pair. -- -- Then edit any keybindings that use the list of workspaces or refer -- to specific workspace names. In the default configuration, only -- the keybindings for changing workspace do this: -- -- > keyBindings conf = let m = modMask conf in fromList $ -- > {- lots of other keybindings -} -- > [((m .|. modm, k), windows $ f i) -- > | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9] -- > , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] -- -- This should change to -- -- > keyBindings conf = let m = modMask conf in fromList $ -- > {- lots of other keybindings -} -- > [((m .|. modm, k), windows $ onCurrentScreen f i) -- > | (i, k) <- zip (workspaces' conf) [xK_1 .. xK_9] -- > , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] -- -- In particular, the analogue of @XMonad.workspaces@ is -- @workspaces'@, and you can use @onCurrentScreen@ to convert functions -- of virtual workspaces to functions of physical workspaces, which work -- by marshalling the virtual workspace name and the currently focused -- screen into a physical workspace name. -- -- A complete example abusing many of the functions below is available in the -- "XMonad.Config.Dmwit" module. type VirtualWorkspace = WorkspaceId type PhysicalWorkspace = WorkspaceId -- $converting -- You shouldn't need to use the functions below very much. They are used -- internally. However, in some cases, they may be useful, and so are exported -- just in case. In general, the \"marshall\" functions convert the convenient -- form (like \"web\") you would like to use in your configuration file to the -- inconvenient form (like \"2_web\") that xmonad uses internally. Similarly, -- the \"unmarshall\" functions convert in the other direction. marshall :: ScreenId -> VirtualWorkspace -> PhysicalWorkspace marshall (S sc) vws = show sc ++ '_':vws unmarshall :: PhysicalWorkspace -> (ScreenId, VirtualWorkspace) unmarshallS :: PhysicalWorkspace -> ScreenId unmarshallW :: PhysicalWorkspace -> VirtualWorkspace unmarshall = ((S . read) *** drop 1) . break (=='_') unmarshallS = fst . unmarshall unmarshallW = snd . unmarshall workspaces' :: XConfig l -> [VirtualWorkspace] workspaces' = nub . map (snd . unmarshall) . workspaces withScreens :: ScreenId -- ^ The number of screens to make workspaces for -> [VirtualWorkspace] -- ^ The desired virtual workspace names -> [PhysicalWorkspace] -- ^ A list of all internal physical workspace names withScreens n vws = [marshall sc pws | pws <- vws, sc <- [0..n-1]] onCurrentScreen :: (VirtualWorkspace -> WindowSet -> a) -> (PhysicalWorkspace -> WindowSet -> a) onCurrentScreen f vws = screen . current >>= f . flip marshall vws -- | In case you don't know statically how many screens there will be, you can call this in main before starting xmonad. For example, part of my config reads -- -- > main = do -- > nScreens <- countScreens -- > xmonad $ def { -- > ... -- > workspaces = withScreens nScreens (workspaces def), -- > ... -- > } -- countScreens :: (MonadIO m, Integral i) => m i countScreens = liftM genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getScreenInfo closeDisplay -- | This turns a naive pretty-printer into one that is aware of the -- independent screens. That is, you can write your pretty printer to behave -- the way you want on virtual workspaces; this function will convert that -- pretty-printer into one that first filters out physical workspaces on other -- screens, then converts all the physical workspaces on this screen to their -- virtual names. -- -- For example, if you have handles @hLeft@ and @hRight@ for bars on the left and right screens, respectively, and @pp@ is a pretty-printer function that takes a handle, you could write -- -- > logHook = let log screen handle = dynamicLogWithPP . marshallPP screen . pp $ handle -- > in log 0 hLeft >> log 1 hRight marshallPP :: ScreenId -> PP -> PP marshallPP s pp = pp { ppCurrent = ppCurrent pp . snd . unmarshall, ppVisible = ppVisible pp . snd . unmarshall, ppHidden = ppHidden pp . snd . unmarshall, ppHiddenNoWindows = ppHiddenNoWindows pp . snd . unmarshall, ppUrgent = ppUrgent pp . snd . unmarshall, ppSort = fmap (marshallSort s) (ppSort pp) } -- | Take a pretty-printer and turn it into one that only runs when the current -- workspace is one associated with the given screen. The way this works is a -- bit hacky, so beware: the 'ppOutput' field of the input will not be invoked -- if either of the following conditions is met: -- -- 1. The 'ppSort' of the input returns an empty list (when not given one). -- -- 2. The 'ppOrder' of the input returns the exact string @\"\\0\"@. -- -- For example, you can use this to create a pipe which tracks the title of the -- window currently focused on a given screen (even if the screen is not -- current) by doing something like this: -- -- > ppFocus s = whenCurrentOn s def -- > { ppOrder = \(_:_:title:_) -> [title] -- > , ppOutput = appendFile ("focus" ++ show s) . (++ "\n") -- > } -- -- Sequence a few of these pretty-printers to get a log hook that keeps each -- screen's title up-to-date. whenCurrentOn :: ScreenId -> PP -> PP whenCurrentOn s pp = pp { ppSort = do sort <- ppSort pp return $ \xs -> case xs of x:_ | unmarshallS (tag x) == s -> sort xs _ -> [] , ppOrder = \i@(wss:_) -> case wss of "" -> ["\0"] -- we got passed no workspaces; this is the signal from ppSort that this is a boring case _ -> ppOrder pp i , ppOutput = \out -> case out of "\0" -> return () -- we got passed the signal from ppOrder that this is a boring case _ -> ppOutput pp out } -- | If @vSort@ is a function that sorts 'WindowSpace's with virtual names, then @marshallSort s vSort@ is a function which sorts 'WindowSpace's with physical names in an analogous way -- but keeps only the spaces on screen @s@. marshallSort :: ScreenId -> ([WindowSpace] -> [WindowSpace]) -> ([WindowSpace] -> [WindowSpace]) marshallSort s vSort = pScreens . vSort . vScreens where onScreen ws = unmarshallS (tag ws) == s vScreens = map unmarshallWindowSpace . filter onScreen pScreens = map (marshallWindowSpace s) -- | Convert the tag of the 'WindowSpace' from a 'VirtualWorkspace' to a 'PhysicalWorkspace'. marshallWindowSpace :: ScreenId -> WindowSpace -> WindowSpace -- | Convert the tag of the 'WindowSpace' from a 'PhysicalWorkspace' to a 'VirtualWorkspace'. unmarshallWindowSpace :: WindowSpace -> WindowSpace marshallWindowSpace s ws = ws { tag = marshall s (tag ws) } unmarshallWindowSpace ws = ws { tag = unmarshallW (tag ws) } xmonad-contrib-0.12/XMonad/Layout/WorkspaceDir.hs0000644000000000000000000000646012636047674020167 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.WorkspaceDir -- Copyright : (c) 2007 David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- WorkspaceDir is an extension to set the current directory in a workspace. -- -- Actually, it sets the current directory in a layout, since there's no way I -- know of to attach a behavior to a workspace. This means that any terminals -- (or other programs) pulled up in that workspace (with that layout) will -- execute in that working directory. Sort of handy, I think. -- -- Note this extension requires the 'directory' package to be installed. -- ----------------------------------------------------------------------------- module XMonad.Layout.WorkspaceDir ( -- * Usage -- $usage workspaceDir, changeDir, WorkspaceDir, ) where import System.Directory ( setCurrentDirectory, getCurrentDirectory ) import Control.Monad ( when ) import XMonad hiding ( focus ) import XMonad.Prompt ( XPConfig ) import XMonad.Prompt.Directory ( directoryPrompt ) import XMonad.Layout.LayoutModifier import XMonad.StackSet ( tag, currentTag ) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.WorkspaceDir -- -- Then edit your @layoutHook@ by adding the Workspace layout modifier -- to some layout: -- -- > myLayout = workspaceDir "~" (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- WorkspaceDir provides also a prompt. To use it you need to import -- "XMonad.Prompt" and add something like this to your key bindings: -- -- > , ((modm .|. shiftMask, xK_x ), changeDir def) -- -- For detailed instruction on editing the key binding see: -- -- "XMonad.Doc.Extending#Editing_key_bindings". data Chdir = Chdir String deriving ( Typeable ) instance Message Chdir data WorkspaceDir a = WorkspaceDir String deriving ( Read, Show ) instance LayoutModifier WorkspaceDir Window where modifyLayout (WorkspaceDir d) w r = do tc <- gets (currentTag.windowset) when (tc == tag w) $ scd d runLayout w r handleMess (WorkspaceDir _) m | Just (Chdir wd) <- fromMessage m = do wd' <- cleanDir wd return $ Just $ WorkspaceDir wd' | otherwise = return Nothing workspaceDir :: LayoutClass l a => String -> l a -> ModifiedLayout WorkspaceDir l a workspaceDir s = ModifiedLayout (WorkspaceDir s) cleanDir :: String -> X String cleanDir x = scd x >> io getCurrentDirectory scd :: String -> X () scd x = catchIO $ setCurrentDirectory x changeDir :: XPConfig -> X () changeDir c = directoryPrompt c "Set working directory: " (sendMessage . Chdir) xmonad-contrib-0.12/XMonad/Layout/Decoration.hs0000644000000000000000000005350012636047674017656 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Decoration -- Copyright : (c) 2007 Andrea Rossato, 2009 Jan Vornberger -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A layout modifier and a class for easily creating decorated -- layouts. ----------------------------------------------------------------------------- module XMonad.Layout.Decoration ( -- * Usage: -- $usage decoration , Theme (..), defaultTheme, def , Decoration , DecorationMsg (..) , DecorationStyle (..) , DefaultDecoration (..) , Shrinker (..), DefaultShrinker , shrinkText, CustomShrink ( CustomShrink ), shrinkWhile , isInStack, isVisible, isInvisible, isWithin, fi , findWindowByDecoration , module XMonad.Layout.LayoutModifier , DecorationState, OrigWin ) where import Control.Monad (when) import Data.Maybe import Data.List import Foreign.C.Types(CInt) import XMonad import qualified XMonad.StackSet as W import XMonad.Hooks.UrgencyHook import XMonad.Layout.LayoutModifier import XMonad.Layout.WindowArranger (WindowArrangerMsg (..), diff, listFromList) import XMonad.Util.NamedWindows (getName) import XMonad.Util.Invisible import XMonad.Util.XUtils import XMonad.Util.Font import XMonad.Util.Image -- $usage -- This module is intended for layout developers, who want to decorate -- their layouts. End users will not find here very much for them. -- -- For examples of 'DecorationStyle' instances you can have a look at -- "XMonad.Layout.SimpleDecoration", "XMonad.Layout.Tabbed", -- "XMonad.Layout.DwmStyle", or "XMonad.Layout.TabBarDecoration". -- | A layout modifier that, with a 'Shrinker', a 'Theme', a -- 'DecorationStyle', and a layout, will decorate this layout -- according to the decoration style provided. -- -- For some usage examples see "XMonad.Layout.DecorationMadness". decoration :: (DecorationStyle ds a, Shrinker s) => s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a decoration s t ds = ModifiedLayout (Decoration (I Nothing) s t ds) -- | A 'Theme' is a record of colors, font etc., to customize a -- 'DecorationStyle'. -- -- For a collection of 'Theme's see "XMonad.Util.Themes" data Theme = Theme { activeColor :: String -- ^ Color of the active window , inactiveColor :: String -- ^ Color of the inactive window , urgentColor :: String -- ^ Color of the urgent window , activeBorderColor :: String -- ^ Color of the border of the active window , inactiveBorderColor :: String -- ^ Color of the border of the inactive window , urgentBorderColor :: String -- ^ Color of the border of the urgent window , activeTextColor :: String -- ^ Color of the text of the active window , inactiveTextColor :: String -- ^ Color of the text of the inactive window , urgentTextColor :: String -- ^ Color of the text of the urgent window , fontName :: String -- ^ Font name , decoWidth :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle') , decoHeight :: Dimension -- ^ Height of the decorations , windowTitleAddons :: [(String, Align)] -- ^ Extra text to appear in a window's title bar. -- Refer to for a use "XMonad.Layout.ImageButtonDecoration" , windowTitleIcons :: [([[Bool]], Placement)] -- ^ Extra icons to appear in a window's title bar. -- Inner @[Bool]@ is a row in a icon bitmap. } deriving (Show, Read) instance Default Theme where def = Theme { activeColor = "#999999" , inactiveColor = "#666666" , urgentColor = "#FFFF00" , activeBorderColor = "#FFFFFF" , inactiveBorderColor = "#BBBBBB" , urgentBorderColor = "##00FF00" , activeTextColor = "#FFFFFF" , inactiveTextColor = "#BFBFBF" , urgentTextColor = "#FF0000" , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" , decoWidth = 200 , decoHeight = 20 , windowTitleAddons = [] , windowTitleIcons = [] } {-# DEPRECATED defaultTheme "Use def (from Data.Default, and re-exported by XMonad.Layout.Decoration) instead." #-} -- | The default xmonad 'Theme'. defaultTheme :: Theme defaultTheme = def -- | A 'Decoration' layout modifier will handle 'SetTheme', a message -- to dynamically change the decoration 'Theme'. data DecorationMsg = SetTheme Theme deriving ( Typeable ) instance Message DecorationMsg -- | The 'Decoration' state component, where the list of decorated -- window's is zipped with a list of decoration. A list of decoration -- is a list of tuples, a 'Maybe' 'Window' and a 'Maybe Rectangle'. -- The 'Window' will be displayed only if the rectangle is of type -- 'Just'. data DecorationState = DS { decos :: [(OrigWin,DecoWin)] , font :: XMonadFont } type DecoWin = (Maybe Window, Maybe Rectangle) type OrigWin = (Window,Rectangle) -- | The 'Decoration' 'LayoutModifier'. This data type is an instance -- of the 'LayoutModifier' class. This data type will be passed, -- together with a layout, to the 'ModifiedLayout' type constructor -- to modify the layout by adding decorations according to a -- 'DecorationStyle'. data Decoration ds s a = Decoration (Invisible Maybe DecorationState) s Theme (ds a) deriving (Show, Read) -- | The 'DecorationStyle' class, defines methods used in the -- implementation of the 'Decoration' 'LayoutModifier' instance. A -- type instance of this class is passed to the 'Decoration' type in -- order to decorate a layout, by using these methods. class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where -- | The description that the 'Decoration' modifier will display. describeDeco :: ds a -> String describeDeco ds = show ds -- | Shrink the window's rectangle when applying a decoration. shrink :: ds a -> Rectangle -> Rectangle -> Rectangle shrink _ (Rectangle _ _ _ dh) (Rectangle x y w h) = Rectangle x (y + fi dh) w (h - dh) -- | The decoration event hook decorationEventHook :: ds a -> DecorationState -> Event -> X () decorationEventHook ds s e = handleMouseFocusDrag ds s e -- | A hook that can be used to catch the cases when the user -- clicks on the decoration. If you return True here, the click event -- will be considered as dealt with and no further processing will take place. decorationCatchClicksHook :: ds a -> Window -> Int -- ^ distance from the left where the click happened on the decoration -> Int -- ^ distance from the right where the click happened on the decoration -> X Bool decorationCatchClicksHook _ _ _ _ = return False -- | This hook is called while a window is dragged using the decoration. -- The hook can be overwritten if a different way of handling the dragging -- is required. decorationWhileDraggingHook :: ds a -> CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleDraggingInProgress ex ey (mainw, r) x y -- | This hoook is called after a window has been dragged using the decoration. decorationAfterDraggingHook :: ds a -> (Window, Rectangle) -> Window -> X () decorationAfterDraggingHook _ds (mainw, _r) _decoWin = focus mainw -- | The pure version of the main method, 'decorate'. pureDecoration :: ds a -> Dimension -> Dimension -> Rectangle -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> Maybe Rectangle pureDecoration _ _ ht _ s _ (w,Rectangle x y wh ht') = if isInStack s w && (ht < ht') then Just $ Rectangle x y wh ht else Nothing -- | Given the theme's decoration width and height, the screen -- rectangle, the windows stack, the list of windows and -- rectangles returned by the underlying layout and window to be -- decorated, tupled with its rectangle, produce a 'Just' -- 'Rectangle' or 'Nothing' if the window is not to be decorated. decorate :: ds a -> Dimension -> Dimension -> Rectangle -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> X (Maybe Rectangle) decorate ds w h r s wrs wr = return $ pureDecoration ds w h r s wrs wr -- | The default 'DecorationStyle', with just the default methods' -- implementations. data DefaultDecoration a = DefaultDecoration deriving ( Read, Show ) instance Eq a => DecorationStyle DefaultDecoration a -- | The long 'LayoutModifier' instance for the 'Decoration' type. -- -- In 'redoLayout' we check the state: if there is no state we -- initialize it. -- -- The state is 'diff'ed against the list of windows produced by the -- underlying layout: removed windows get deleted and new ones -- decorated by 'createDecos', which will call 'decorate' to decide if -- a window must be given a 'Rectangle', in which case a decoration -- window will be created. -- -- After that we resync the updated state with the windows' list and -- then we process the resynced stated (as we do with a new state). -- -- First we map the decoration windows, we update each decoration to -- reflect any decorated window's change, and we insert, in the list -- of windows and rectangles returned by the underlying layout, the -- decoration for each window. This way xmonad will restack the -- decorations and their windows accordingly. At the end we remove -- invisible\/stacked windows. -- -- Message handling is quite simple: when needed we release the state -- component of the 'Decoration' 'LayoutModifier'. Otherwise we call -- 'handleEvent', which will call the appropriate 'DecorationStyle' -- methods to perform its tasks. instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration ds s) Window where redoLayout (Decoration (I (Just s)) sh t ds) _ Nothing _ = do releaseResources s return ([], Just $ Decoration (I Nothing) sh t ds) redoLayout _ _ Nothing _ = return ([], Nothing) redoLayout (Decoration st sh t ds) sc (Just stack) wrs | I Nothing <- st = initState t ds sc stack wrs >>= processState | I (Just s) <- st = do let dwrs = decos s (d,a) = curry diff (get_ws dwrs) ws toDel = todel d dwrs toAdd = toadd a wrs deleteDecos (map snd toDel) let ndwrs = zip toAdd $ repeat (Nothing,Nothing) ndecos <- resync (ndwrs ++ del_dwrs d dwrs) wrs processState (s {decos = ndecos }) | otherwise = return (wrs, Nothing) where ws = map fst wrs get_w = fst . fst get_ws = map get_w del_dwrs = listFromList get_w notElem find_dw i = fst . snd . flip (!!) i todel d = filter (flip elem d . get_w) toadd a = filter (flip elem a . fst ) check_dwr dwr = case dwr of (Nothing, Just dr) -> do dw <- createDecoWindow t dr return (Just dw, Just dr) _ -> return dwr resync _ [] = return [] resync d ((w,r):xs) = case w `elemIndex` get_ws d of Just i -> do dr <- decorate ds (decoWidth t) (decoHeight t) sc stack wrs (w,r) dwr <- check_dwr (find_dw i d, dr) dwrs <- resync d xs return $ ((w,r),dwr) : dwrs Nothing -> resync d xs -- We drop any windows that are *precisely* stacked underneath -- another window: these must be intended to be tabbed! remove_stacked rs ((w,r):xs) | r `elem` rs = remove_stacked rs xs | otherwise = (w,r) : remove_stacked (r:rs) xs remove_stacked _ [] = [] insert_dwr ((w,r),(Just dw,Just dr)) xs = (dw,dr):(w, shrink ds dr r):xs insert_dwr (x ,( _ , _ )) xs = x:xs dwrs_to_wrs = remove_stacked [] . foldr insert_dwr [] processState s = do let ndwrs = decos s showDecos (map snd ndwrs) updateDecos sh t (font s) ndwrs return (dwrs_to_wrs ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh t ds)) handleMess (Decoration (I (Just s@(DS {decos = dwrs}))) sh t ds) m | Just e <- fromMessage m = do decorationEventHook ds s e handleEvent sh t s e return Nothing | Just Hide <- fromMessage m = do hideDecos (map snd dwrs) return Nothing | Just (SetTheme nt) <- fromMessage m = do releaseResources s return $ Just $ Decoration (I Nothing) sh nt ds | Just ReleaseResources <- fromMessage m = do releaseResources s return $ Just $ Decoration (I Nothing) sh t ds handleMess _ _ = return Nothing modifierDescription (Decoration _ _ _ ds) = describeDeco ds -- | By default 'Decoration' handles 'PropertyEvent' and 'ExposeEvent' -- only. handleEvent :: Shrinker s => s -> Theme -> DecorationState -> Event -> X () handleEvent sh t (DS dwrs fs) e | PropertyEvent {ev_window = w} <- e , Just i <- w `elemIndex` (map (fst . fst) dwrs) = updateDeco sh t fs (dwrs !! i) | ExposeEvent {ev_window = w} <- e , Just i <- w `elemIndex` (catMaybes $ map (fst . snd) dwrs) = updateDeco sh t fs (dwrs !! i) handleEvent _ _ _ _ = return () -- | Mouse focus and mouse drag are handled by the same function, this -- way we can start dragging unfocused windows too. handleMouseFocusDrag :: (DecorationStyle ds a) => ds a -> DecorationState -> Event -> X () handleMouseFocusDrag ds (DS dwrs _) ButtonEvent { ev_window = ew , ev_event_type = et , ev_x_root = ex , ev_y_root = ey } | et == buttonPress , Just ((mainw,r), (_, decoRectM)) <- lookFor ew dwrs = do let Just (Rectangle dx _ dwh _) = decoRectM distFromLeft = ex - fi dx distFromRight = fi dwh - (ex - fi dx) dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight) when (not dealtWith) $ do mouseDrag (\x y -> focus mainw >> decorationWhileDraggingHook ds ex ey (mainw, r) x y) (decorationAfterDraggingHook ds (mainw, r) ew) handleMouseFocusDrag _ _ _ = return () handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () handleDraggingInProgress ex ey (_, r) x y = do let rect = Rectangle (x - (fi ex - rect_x r)) (y - (fi ey - rect_y r)) (rect_width r) (rect_height r) sendMessage $ SetGeometry rect -- | Given a window and the state, if a matching decoration is in the -- state return it with its ('Maybe') 'Rectangle'. lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,(Window,Maybe Rectangle)) lookFor w ((wr,(Just dw,dr)):dwrs) | w == dw = Just (wr,(dw,dr)) | otherwise = lookFor w dwrs lookFor w ((_, (Nothing, _)):dwrs) = lookFor w dwrs lookFor _ [] = Nothing findWindowByDecoration :: Window -> DecorationState -> Maybe (OrigWin,(Window,Maybe Rectangle)) findWindowByDecoration w ds = lookFor w (decos ds) -- | Initialize the 'DecorationState' by initializing the font -- structure and by creating the needed decorations. initState :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle -> W.Stack Window -> [(Window,Rectangle)] -> X DecorationState initState t ds sc s wrs = do fs <- initXMF (fontName t) dwrs <- createDecos t ds sc s wrs wrs return $ DS dwrs fs -- | Delete windows stored in the state and release the font structure. releaseResources :: DecorationState -> X () releaseResources s = do deleteDecos (map snd $ decos s) releaseXMF (font s) -- | Create the decoration windows of a list of windows and their -- rectangles, by calling the 'decorate' method of the -- 'DecorationStyle' received. createDecos :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle -> W.Stack Window -> [(Window,Rectangle)] -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)] createDecos t ds sc s wrs ((w,r):xs) = do deco <- decorate ds (decoWidth t) (decoHeight t) sc s wrs (w,r) case deco of Just dr -> do dw <- createDecoWindow t dr dwrs <- createDecos t ds sc s wrs xs return $ ((w,r), (Just dw, Just dr)) : dwrs Nothing -> do dwrs <- createDecos t ds sc s wrs xs return $ ((w,r), (Nothing, Nothing)) : dwrs createDecos _ _ _ _ _ [] = return [] createDecoWindow :: Theme -> Rectangle -> X Window createDecoWindow t r = let mask = Just (exposureMask .|. buttonPressMask) in createNewWindow r mask (inactiveColor t) True showDecos :: [DecoWin] -> X () showDecos = showWindows . catMaybes . map fst . filter (isJust . snd) hideDecos :: [DecoWin] -> X () hideDecos = hideWindows . catMaybes . map fst deleteDecos :: [DecoWin] -> X () deleteDecos = deleteWindows . catMaybes . map fst updateDecos :: Shrinker s => s -> Theme -> XMonadFont -> [(OrigWin,DecoWin)] -> X () updateDecos s t f = mapM_ $ updateDeco s t f -- | Update a decoration window given a shrinker, a theme, the font -- structure and the needed 'Rectangle's updateDeco :: Shrinker s => s -> Theme -> XMonadFont -> (OrigWin,DecoWin) -> X () updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do nw <- getName w ur <- readUrgents dpy <- asks display let focusColor win ic ac uc = (maybe ic (\focusw -> case () of _ | focusw == win -> ac | win `elem` ur -> uc | otherwise -> ic) . W.peek) `fmap` gets windowset (bc,borderc,tc) <- focusColor w (inactiveColor t, inactiveBorderColor t, inactiveTextColor t) (activeColor t, activeBorderColor t, activeTextColor t) (urgentColor t, urgentBorderColor t, urgentTextColor t) let s = shrinkIt sh name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw) let als = AlignCenter : map snd (windowTitleAddons t) strs = name : map fst (windowTitleAddons t) i_als = map snd (windowTitleIcons t) icons = map fst (windowTitleIcons t) paintTextAndIcons dw fs wh ht 1 bc borderc tc bc als strs i_als icons updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w updateDeco _ _ _ _ = return () -- | True if the window is in the 'Stack'. The 'Window' comes second -- to facilitate list processing, even though @w \`isInStack\` s@ won't -- work...;) isInStack :: Eq a => W.Stack a -> a -> Bool isInStack s = flip elem (W.integrate s) -- | Given a 'Rectangle' and a list of 'Rectangle's is True if the -- 'Rectangle' is not completely contained by any 'Rectangle' of the -- list. isVisible :: Rectangle -> [Rectangle] -> Bool isVisible r = and . foldr f [] where f x xs = if r `isWithin` x then False : xs else True : xs -- | The contrary of 'isVisible'. isInvisible :: Rectangle -> [Rectangle] -> Bool isInvisible r = not . isVisible r -- | True is the first 'Rectangle' is totally within the second -- 'Rectangle'. isWithin :: Rectangle -> Rectangle -> Bool isWithin (Rectangle x y w h) (Rectangle rx ry rw rh) | x >= rx, x <= rx + fi rw , y >= ry, y <= ry + fi rh , x + fi w <= rx + fi rw , y + fi h <= ry + fi rh = True | otherwise = False shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String shrinkWhile sh p x = sw $ sh x where sw [n] = return n sw [] = return "" sw (n:ns) = do cond <- p n if cond then sw ns else return n data CustomShrink = CustomShrink instance Show CustomShrink where show _ = "" instance Read CustomShrink where readsPrec _ s = [(CustomShrink,s)] class (Read s, Show s) => Shrinker s where shrinkIt :: s -> String -> [String] data DefaultShrinker = DefaultShrinker instance Show DefaultShrinker where show _ = "" instance Read DefaultShrinker where readsPrec _ s = [(DefaultShrinker,s)] instance Shrinker DefaultShrinker where shrinkIt _ "" = [""] shrinkIt s cs = cs : shrinkIt s (init cs) shrinkText :: DefaultShrinker shrinkText = DefaultShrinker xmonad-contrib-0.12/XMonad/Layout/Column.hs0000644000000000000000000000512012636047674017017 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Column -- Copyright : (c) 2009 Ilya Portnov -- License : BSD3-style (see LICENSE) -- -- Maintainer : Ilya Portnov -- Stability : unstable -- Portability : unportable -- -- Provides Column layout that places all windows in one column. Windows -- heights are calculated from equation: H1/H2 = H2/H3 = ... = q, where q is -- given. With Shrink/Expand messages you can change the q value. -- ----------------------------------------------------------------------------- module XMonad.Layout.Column ( -- * Usage -- $usage Column (..) ) where import XMonad import qualified XMonad.StackSet as W -- $usage -- This module defines layot named Column. It places all windows in one -- column. Windows heights are calculated from equation: H1/H2 = H2/H3 = ... = -- q, where `q' is given (thus, windows heights are members of geometric -- progression). With Shrink/Expand messages one can change the `q' value. -- -- You can use this module by adding folowing in your @xmonad.hs@: -- -- > import XMonad.Layout.Column -- -- Then add layouts to your layoutHook: -- -- > myLayoutHook = Column 1.6 ||| ... -- -- In this example, each next window will have height 1.6 times less then -- previous window. data Column a = Column Float deriving (Read,Show) instance LayoutClass Column a where pureLayout = columnLayout pureMessage = columnMessage columnMessage :: Column a -> SomeMessage -> Maybe (Column a) columnMessage (Column q) m = fmap resize (fromMessage m) where resize Shrink = Column (q-0.1) resize Expand = Column (q+0.1) columnLayout :: Column a -> Rectangle -> W.Stack a -> [(a,Rectangle)] columnLayout (Column q) rect stack = zip ws rects where ws = W.integrate stack n = length ws heights = map (xn n rect q) [1..n] ys = [fromIntegral $ sum $ take k heights | k <- [0..n-1]] rects = map (mkRect rect) $ zip heights ys mkRect :: Rectangle -> (Dimension,Position) -> Rectangle mkRect (Rectangle xs ys ws _) (h,y) = Rectangle xs (ys+fromIntegral y) ws h xn :: Int -> Rectangle -> Float -> Int -> Dimension xn n (Rectangle _ _ _ h) q k = if q==1 then h `div` (fromIntegral n) else round ((fromIntegral h)*q^(n-k)*(1-q)/(1-q^n)) xmonad-contrib-0.12/XMonad/Layout/SubLayouts.hs0000644000000000000000000005130312636047674017700 0ustar0000000000000000{-# LANGUAGE PatternGuards, ParallelListComp, DeriveDataTypeable, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.SubLayouts -- Copyright : (c) 2009 Adam Vogt -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : vogt.adam@gmail.com -- Stability : unstable -- Portability : unportable -- -- A layout combinator that allows layouts to be nested. -- ----------------------------------------------------------------------------- module XMonad.Layout.SubLayouts ( -- * Usage -- $usage subLayout, subTabbed, pushGroup, pullGroup, pushWindow, pullWindow, onGroup, toSubl, mergeDir, GroupMsg(..), Broadcast(..), defaultSublMap, Sublayout, -- * Screenshots -- $screenshots -- * Todo -- $todo ) where import XMonad.Layout.Circle () -- so haddock can find the link import XMonad.Layout.Decoration(Decoration, DefaultShrinker) import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, modifyLayout, redoLayout), ModifiedLayout(..)) import XMonad.Layout.Simplest(Simplest(..)) import XMonad.Layout.Tabbed(shrinkText, TabbedDecoration, addTabs) import XMonad.Layout.WindowNavigation(Navigate(Apply)) import XMonad.Util.Invisible(Invisible(..)) import XMonad.Util.Types(Direction2D(..)) import XMonad hiding (def) import Control.Applicative((<$>),(<*)) import Control.Arrow(Arrow(second, (&&&))) import Control.Monad(MonadPlus(mplus), foldM, guard, when, join) import Data.Function(on) import Data.List(nubBy, (\\), find) import Data.Maybe(isNothing, fromMaybe, listToMaybe, mapMaybe) import Data.Traversable(sequenceA) import qualified XMonad as X import qualified XMonad.Layout.BoringWindows as B import qualified XMonad.StackSet as W import qualified Data.Map as M import Data.Map(Map) -- $screenshots -- -- <> -- -- Larger version: -- $todo -- /Issue 288/ -- -- "XMonad.Layout.ResizableTile" assumes that its environment -- contains only the windows it is running: sublayouts are currently run with -- the stack containing only the windows passed to it in its environment, but -- any changes that the layout makes are not merged back. -- -- Should the behavior be made optional? -- -- /Features/ -- -- * suggested managehooks for merging specific windows, or the apropriate -- layout based hack to find out the number of groups currently showed, but -- the size of current window groups is not available (outside of this -- growing module) -- -- /SimpleTabbed as a SubLayout/ -- -- 'subTabbed' works well, but it would be more uniform to avoid the use of -- addTabs, with the sublayout being Simplest (but -- 'XMonad.Layout.Tabbed.simpleTabbed' is this...). The only thing to be -- gained by fixing this issue is the ability to mix and match decoration -- styles. Better compatibility with some other layouts of which I am not -- aware could be another benefit. -- -- 'simpleTabbed' (and other decorated layouts) fail horribly when used as -- subLayouts: -- -- * decorations stick around: layout is run after being told to Hide -- -- * mouse events do not change focus: the group-ungroup does not respect -- the focus changes it wants? -- -- * sending ReleaseResources before running it makes xmonad very slow, and -- still leaves borders sticking around -- -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.SubLayouts -- > import XMonad.Layout.WindowNavigation -- -- Using "XMonad.Layout.BoringWindows" is optional and it allows you to add a -- keybinding to skip over the non-visible windows. -- -- > import XMonad.Layout.BoringWindows -- -- Then edit your @layoutHook@ by adding the 'subTabbed' layout modifier: -- -- > myLayout = windowNavigation $ subTabbed $ boringWindows $ -- > Tall 1 (3/100) (1/2) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- "XMonad.Layout.WindowNavigation" is used to specify which windows to merge, -- and it is not integrated into the modifier because it can be configured, and -- works best as the outer modifier. -- -- Then to your keybindings add: -- -- > , ((modm .|. controlMask, xK_h), sendMessage $ pullGroup L) -- > , ((modm .|. controlMask, xK_l), sendMessage $ pullGroup R) -- > , ((modm .|. controlMask, xK_k), sendMessage $ pullGroup U) -- > , ((modm .|. controlMask, xK_j), sendMessage $ pullGroup D) -- > -- > , ((modm .|. controlMask, xK_m), withFocused (sendMessage . MergeAll)) -- > , ((modm .|. controlMask, xK_u), withFocused (sendMessage . UnMerge)) -- > -- > , ((modm .|. controlMask, xK_period), onGroup W.focusUp') -- > , ((modm .|. controlMask, xK_comma), onGroup W.focusDown') -- -- These additional keybindings require the optional -- "XMonad.Layout.BoringWindows" layoutModifier. The focus will skip over the -- windows that are not focused in each sublayout. -- -- > , ((modm, xK_j), focusDown) -- > , ((modm, xK_k), focusUp) -- -- A 'submap' can be used to make modifying the sublayouts using 'onGroup' and -- 'toSubl' simpler: -- -- > ,((modm, xK_s), submap $ defaultSublMap conf) -- -- /NOTE:/ is there some reason that @asks config >>= submap . defaultSublMap@ -- could not be used in the keybinding instead? It avoids having to explicitly -- pass the conf. -- -- For more detailed instructions, see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- "XMonad.Doc.Extending#Adding_key_bindings" -- | The main layout modifier arguments: -- -- @subLayout advanceInnerLayouts innerLayout outerLayout@ -- -- [@advanceInnerLayouts@] When a new group at index @n@ in the outer layout -- is created (even with one element), the @innerLayout@ is used as the -- layout within that group after being advanced with @advanceInnerLayouts !! -- n@ 'NextLayout' messages. If there is no corresponding element in the -- @advanceInnerLayouts@ list, then @innerLayout@ is not given any 'NextLayout' -- messages. -- -- [@innerLayout@] The single layout given to be run as a sublayout. -- -- [@outerLayout@] The layout that determines the rectangles given to each -- group. -- -- Ex. The second group is 'Tall', the third is 'Circle', all others are tabbed -- with: -- -- > myLayout = addTabs shrinkText def -- > $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| Circle) -- > $ Tall 1 0.2 0.5 ||| Full subLayout :: [Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a subLayout nextLayout sl x = ModifiedLayout (Sublayout (I []) (nextLayout,sl) []) x -- | @subTabbed@ is a use of 'subLayout' with 'addTabs' to show decorations. subTabbed :: (Eq a, LayoutModifier (Sublayout Simplest) a, LayoutClass l a) => l a -> ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) (ModifiedLayout (Sublayout Simplest) l) a subTabbed x = addTabs shrinkText X.def $ subLayout [] Simplest x -- | @defaultSublMap@ is an attempt to create a set of keybindings like the -- defaults ones but to be used as a 'submap' for sending messages to the -- sublayout. defaultSublMap :: XConfig l -> Map (KeyMask, KeySym) (X ()) defaultSublMap (XConfig { modMask = modm }) = M.fromList [((modm, xK_space), toSubl NextLayout), ((modm, xK_j), onGroup W.focusDown'), ((modm, xK_k), onGroup W.focusUp'), ((modm, xK_h), toSubl Shrink), ((modm, xK_l), toSubl Expand), ((modm, xK_Tab), onGroup W.focusDown'), ((modm .|. shiftMask, xK_Tab), onGroup W.focusUp'), ((modm, xK_m), onGroup focusMaster'), ((modm, xK_comma), toSubl $ IncMasterN 1), ((modm, xK_period), toSubl $ IncMasterN (-1)), ((modm, xK_Return), onGroup swapMaster') ] where -- should these go into XMonad.StackSet? focusMaster' st = let (f:fs) = W.integrate st in W.Stack f [] fs swapMaster' (W.Stack f u d) = W.Stack f [] $ reverse u ++ d data Sublayout l a = Sublayout { delayMess :: Invisible [] (SomeMessage,a) -- ^ messages are handled when running the layout, -- not in the handleMessage, I'm not sure that this -- is necessary , def :: ([Int], l a) -- ^ how many NextLayout messages to send to newly -- populated layouts. If there is no corresponding -- index, then don't send any. , subls :: [(l a,W.Stack a)] -- ^ The sublayouts and the stacks they manage } deriving (Read,Show) -- | Groups assumes this invariant: -- M.keys gs == map W.focus (M.elems gs) (ignoring order) -- All windows in the workspace are in the Map -- -- The keys are visible windows, the rest are hidden. -- -- This representation probably simplifies the internals of the modifier. type Groups a = Map a (W.Stack a) -- | GroupMsg take window parameters to determine which group the action should -- be applied to data GroupMsg a = UnMerge a -- ^ free the focused window from its tab stack | UnMergeAll a -- ^ separate the focused group into singleton groups | Merge a a -- ^ merge the first group into the second group | MergeAll a -- ^ make one large group, keeping the parameter focused | Migrate a a -- ^ used to the window named in the first argument to the -- second argument's group, this may be replaced by a -- combination of 'UnMerge' and 'Merge' | WithGroup (W.Stack a -> X (W.Stack a)) a | SubMessage SomeMessage a -- ^ the sublayout with the given window will get the message deriving (Typeable) -- | merge the window that would be focused by the function when applied to the -- W.Stack of all windows, with the current group removed. The given window -- should be focused by a sublayout. Example usage: @withFocused (sendMessage . -- mergeDir W.focusDown')@ mergeDir :: (W.Stack Window -> W.Stack Window) -> Window -> GroupMsg Window mergeDir f w = WithGroup g w where g cs = do let onlyOthers = W.filter (`notElem` W.integrate cs) flip whenJust (sendMessage . Merge (W.focus cs) . W.focus . f) =<< fmap (onlyOthers =<<) currentStack return cs data Broadcast = Broadcast SomeMessage -- ^ send a message to all sublayouts deriving (Typeable) instance Message Broadcast instance Typeable a => Message (GroupMsg a) -- | @pullGroup@, @pushGroup@ allow you to merge windows or groups inheriting -- the position of the current window (pull) or the other window (push). -- -- @pushWindow@ and @pullWindow@ move individual windows between groups. They -- are less effective at preserving window positions. pullGroup,pushGroup,pullWindow,pushWindow :: Direction2D -> Navigate pullGroup = mergeNav (\o c -> sendMessage $ Merge o c) pushGroup = mergeNav (\o c -> sendMessage $ Merge c o) pullWindow = mergeNav (\o c -> sendMessage $ Migrate o c) pushWindow = mergeNav (\o c -> sendMessage $ Migrate c o) mergeNav :: (Window -> Window -> X ()) -> Direction2D -> Navigate mergeNav f = Apply (\o -> withFocused (f o)) -- | Apply a function on the stack belonging to the currently focused group. It -- works for rearranging windows and for changing focus. onGroup :: (W.Stack Window -> W.Stack Window) -> X () onGroup f = withFocused (sendMessage . WithGroup (return . f)) -- | Send a message to the currently focused sublayout. toSubl :: (Message a) => a -> X () toSubl m = withFocused (sendMessage . SubMessage (SomeMessage m)) instance (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModifier (Sublayout l) Window where modifyLayout (Sublayout { subls = osls }) (W.Workspace i la st) r = do let gs' = updateGroup st $ toGroups osls st' = W.filter (`elem` M.keys gs') =<< st updateWs gs' oldStack <- gets $ W.stack . W.workspace . W.current . windowset setStack st' runLayout (W.Workspace i la st') r <* setStack oldStack -- FIXME: merge back reordering, deletions? redoLayout (Sublayout { delayMess = I ms, def = defl, subls = osls }) _r st arrs = do let gs' = updateGroup st $ toGroups osls sls <- fromGroups defl st gs' osls let newL :: LayoutClass l Window => Rectangle -> WorkspaceId -> (l Window) -> Bool -> (Maybe (W.Stack Window)) -> X ([(Window, Rectangle)], l Window) newL rect n ol isNew sst = do orgStack <- currentStack let handle l (y,_) | not isNew = fromMaybe l <$> handleMessage l y | otherwise = return l kms = filter ((`elem` M.keys gs') . snd) ms setStack sst nl <- foldM handle ol $ filter ((`elem` W.integrate' sst) . snd) kms result <- runLayout (W.Workspace n nl sst) rect setStack orgStack -- FIXME: merge back reordering, deletions? return $ fromMaybe nl `second` result (urls,ssts) = unzip [ (newL gr i l isNew sst, sst) | (isNew,(l,_st)) <- sls | i <- map show [ 0 :: Int .. ] | (k,gr) <- arrs, let sst = M.lookup k gs' ] arrs' <- sequence urls sls' <- return . Sublayout (I []) defl . map snd <$> fromGroups defl st gs' [ (l,s) | (_,l) <- arrs' | (Just s) <- ssts ] return (concatMap fst arrs', sls') handleMess (Sublayout (I ms) defl sls) m | Just (SubMessage sm w) <- fromMessage m = return $ Just $ Sublayout (I ((sm,w):ms)) defl sls | Just (Broadcast sm) <- fromMessage m = do ms' <- fmap (zip (repeat sm) . W.integrate') currentStack return $ if null ms' then Nothing else Just $ Sublayout (I $ ms' ++ ms) defl sls | Just B.UpdateBoring <- fromMessage m = do let bs = concatMap unfocused $ M.elems gs ws <- gets (W.workspace . W.current . windowset) flip sendMessageWithNoRefresh ws $ B.Replace "Sublayouts" bs return Nothing | Just (WithGroup f w) <- fromMessage m , Just g <- M.lookup w gs = do g' <- f g let gs' = M.insert (W.focus g') g' $ M.delete (W.focus g) gs when (gs' /= gs) $ updateWs gs' when (w /= W.focus g') $ windows (W.focusWindow $ W.focus g') return Nothing | Just (MergeAll w) <- fromMessage m = let gs' = fmap (M.singleton w) $ (focusWindow' w =<<) $ W.differentiate $ concatMap W.integrate $ M.elems gs in maybe (return Nothing) fgs gs' | Just (UnMergeAll w) <- fromMessage m = let ws = concatMap W.integrate $ M.elems gs _ = w :: Window mkSingleton f = M.singleton f (W.Stack f [] []) in fgs $ M.unions $ map mkSingleton ws | Just (Merge x y) <- fromMessage m , Just (W.Stack _ xb xn) <- findGroup x , Just yst <- findGroup y = let zs = W.Stack x xb (xn ++ W.integrate yst) in fgs $ M.insert x zs $ M.delete (W.focus yst) gs | Just (UnMerge x) <- fromMessage m = fgs . M.fromList . map (W.focus &&& id) . M.elems $ M.mapMaybe (W.filter (x/=)) gs -- XXX sometimes this migrates an incorrect window, why? | Just (Migrate x y) <- fromMessage m , Just xst <- findGroup x , Just (W.Stack yf yu yd) <- findGroup y = let zs = W.Stack x (yf:yu) yd nxsAdd = maybe id (\e -> M.insert (W.focus e) e) $ W.filter (x/=) xst in fgs $ nxsAdd $ M.insert x zs $ M.delete yf gs | otherwise = fmap join $ sequenceA $ catchLayoutMess <$> fromMessage m where gs = toGroups sls fgs gs' = do st <- currentStack Just . Sublayout (I ms) defl . map snd <$> fromGroups defl st gs' sls findGroup z = mplus (M.lookup z gs) $ listToMaybe $ M.elems $ M.filter ((z `elem`) . W.integrate) gs -- catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window)) -- This l must be the same as from the instance head, -- -XScopedTypeVariables should bring it into scope, but we are -- trying to avoid warnings with ghc-6.8.2 and avoid CPP catchLayoutMess x = do let m' = x `asTypeOf` (undefined :: LayoutMessages) ms' <- zip (repeat $ SomeMessage m') . W.integrate' <$> currentStack return $ do guard $ not $ null ms' Just $ Sublayout (I $ ms' ++ ms) defl sls currentStack :: X (Maybe (W.Stack Window)) currentStack = gets (W.stack . W.workspace . W.current . windowset) -- | update Group to follow changes in the workspace updateGroup :: Ord a => Maybe (W.Stack a) -> Groups a -> Groups a updateGroup mst gs = let flatten = concatMap W.integrate . M.elems news = W.integrate' mst \\ flatten gs deads = flatten gs \\ W.integrate' mst uniNew = M.union (M.fromList $ map (\n -> (n,single n)) news) single x = W.Stack x [] [] -- pass through a list to update/remove keys remDead = M.fromList . map (\w -> (W.focus w,w)) . mapMaybe (W.filter (`notElem` deads)) . M.elems -- update the current tab group's order and focus followFocus hs = fromMaybe hs $ do f' <- W.focus `fmap` mst xs <- find (elem f' . W.integrate) $ M.elems hs xs' <- W.filter (`elem` W.integrate xs) =<< mst return $ M.insert f' xs' $ M.delete (W.focus xs) hs in remDead $ uniNew $ followFocus gs -- | rearrange the windowset to put the groups of tabs next to eachother, so -- that the stack of tabs stays put. updateWs :: Groups Window -> X () updateWs = windowsMaybe . updateWs' updateWs' :: Groups Window -> WindowSet -> Maybe WindowSet updateWs' gs ws = do f <- W.peek ws let w = W.index ws nes = concatMap W.integrate $ mapMaybe (flip M.lookup gs) w ws' = W.focusWindow f $ foldr W.insertUp (foldr W.delete' ws nes) nes guard $ W.index ws' /= W.index ws return ws' -- | focusWindow'. focus an element of a stack, is Nothing if that element is -- absent. See also 'W.focusWindow' focusWindow' :: (Eq a) => a -> W.Stack a -> Maybe (W.Stack a) focusWindow' w st = do guard $ not $ null $ filter (w==) $ W.integrate st if W.focus st == w then Just st else focusWindow' w $ W.focusDown' st -- update only when Just windowsMaybe :: (WindowSet -> Maybe WindowSet) -> X () windowsMaybe f = do xst <- get ws <- gets windowset let up fws = put xst { windowset = fws } maybe (return ()) up $ f ws unfocused :: W.Stack a -> [a] unfocused x = W.up x ++ W.down x toGroups :: (Ord a) => [(a1, W.Stack a)] -> Map a (W.Stack a) toGroups ws = M.fromList . map (W.focus &&& id) . nubBy (on (==) W.focus) $ map snd ws -- | restore the default layout for each group. It needs the X monad to switch -- the default layout to a specific one (handleMessage NextLayout) fromGroups :: (LayoutClass layout a, Ord k) => ([Int], layout a) -> Maybe (W.Stack k) -> Groups k -> [(layout a, b)] -> X [(Bool,(layout a, W.Stack k))] fromGroups (skips,defl) st gs sls = do defls <- mapM (iterateM nextL defl !!) skips return $ fromGroups' defl defls st gs (map fst sls) where nextL l = fromMaybe l <$> handleMessage l (SomeMessage NextLayout) iterateM f = iterate (>>= f) . return fromGroups' :: (Ord k) => a -> [a] -> Maybe (W.Stack k) -> Groups k -> [a] -> [(Bool,(a, W.Stack k))] fromGroups' defl defls st gs sls = [ (isNew,fromMaybe2 (dl, single w) (l, M.lookup w gs)) | l <- map Just sls ++ repeat Nothing, let isNew = isNothing l | dl <- defls ++ repeat defl | w <- W.integrate' $ W.filter (`notElem` unfocs) =<< st ] where unfocs = unfocused =<< M.elems gs single w = W.Stack w [] [] fromMaybe2 (a,b) (x,y) = (fromMaybe a x, fromMaybe b y) -- this would be much cleaner with some kind of data-accessor setStack :: Maybe (W.Stack Window) -> X () setStack x = modify (\s -> s { windowset = (windowset s) { W.current = (W.current $ windowset s) { W.workspace = (W.workspace $ W.current $ windowset s) { W.stack = x }}}}) xmonad-contrib-0.12/XMonad/Layout/NoBorders.hs0000644000000000000000000002061612636047674017466 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} {-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.NoBorders -- Copyright : (c) David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- Make a given layout display without borders. This is useful for -- full-screen or tabbed layouts, where you don't really want to waste a -- couple of pixels of real estate just to inform yourself that the visible -- window has focus. -- ----------------------------------------------------------------------------- module XMonad.Layout.NoBorders ( -- * Usage -- $usage noBorders, smartBorders, withBorder, lessBorders, SetsAmbiguous(..), Ambiguity(..), With(..), SmartBorder, WithBorder, ConfigurableBorder, ) where import XMonad import XMonad.Layout.LayoutModifier import qualified XMonad.StackSet as W import Data.List import qualified Data.Map as M import Data.Function (on) -- $usage -- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file: -- -- > import XMonad.Layout.NoBorders -- -- and modify the layouts to call noBorders on the layouts you want to lack -- borders: -- -- > layoutHook = ... ||| noBorders Full ||| ... -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- todo, use an InvisibleList. data WithBorder a = WithBorder Dimension [a] deriving ( Read, Show ) instance LayoutModifier WithBorder Window where unhook (WithBorder _ s) = asks (borderWidth . config) >>= setBorders s redoLayout (WithBorder n s) _ _ wrs = do asks (borderWidth . config) >>= setBorders (s \\ ws) setBorders ws n return (wrs, Just $ WithBorder n ws) where ws = map fst wrs -- | Removes all window borders from the specified layout. noBorders :: LayoutClass l Window => l Window -> ModifiedLayout WithBorder l Window noBorders = withBorder 0 -- | Forces a layout to use the specified border width. 'noBorders' is -- equivalent to @'withBorder' 0@. withBorder :: LayoutClass l a => Dimension -> l a -> ModifiedLayout WithBorder l a withBorder b = ModifiedLayout $ WithBorder b [] setBorders :: [Window] -> Dimension -> X () setBorders ws bw = withDisplay $ \d -> mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws singleton :: [a] -> Bool singleton = null . drop 1 type SmartBorder = ConfigurableBorder Ambiguity -- | Removes the borders from a window under one of the following conditions: -- -- * There is only one screen and only one window. In this case it's obvious -- that it has the focus, so no border is needed. -- -- * A floating window covers the entire screen (e.g. mplayer). -- smartBorders :: LayoutClass l a => l a -> ModifiedLayout SmartBorder l a smartBorders = lessBorders Never -- | Apply a datatype that has a SetsAmbiguous instance to provide a list of -- windows that should not have borders. -- -- This gives flexibility over when borders should be drawn, in particular with -- xinerama setups: 'Ambiguity' has a number of useful 'SetsAmbiguous' -- instances lessBorders :: (SetsAmbiguous p, Read p, Show p, LayoutClass l a) => p -> l a -> ModifiedLayout (ConfigurableBorder p) l a lessBorders amb = ModifiedLayout (ConfigurableBorder amb []) data ConfigurableBorder p w = ConfigurableBorder p [w] deriving (Read, Show) instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where unhook (ConfigurableBorder _p s) = asks (borderWidth . config) >>= setBorders s redoLayout (ConfigurableBorder p s) _ mst wrs = do ws <- withWindowSet (\wset -> return (hiddens p wset mst wrs)) asks (borderWidth . config) >>= setBorders (s \\ ws) setBorders ws 0 return (wrs, Just $ ConfigurableBorder p ws) -- | SetsAmbiguous allows custom actions to generate lists of windows that -- should not have borders drawn through 'ConfigurableBorder' -- -- To add your own (though perhaps those options would better belong as an -- aditional constructor to 'Ambiguity'), you can add the function as such: -- -- > data MyAmbiguity = MyAmbiguity deriving (Read, Show) -- -- > instance SetsAmbiguous MyAmbiguity where -- > hiddens _ wset mst wrs = otherHiddens Screen \\ otherHiddens OnlyFloat -- > where otherHiddens p = hiddens p wset mst wrs -- -- The above example is redundant, because you can have the same result with: -- -- > layoutHook = lessBorders (Combine Difference Screen OnlyFloat) (Tall 1 0.5 0.03 ||| ... ) -- -- To get the same result as 'smartBorders': -- -- > layoutHook = lessBorders Never (Tall 1 0.5 0.03 ||| ...) -- -- This indirect method is required to keep the 'Read' and 'Show' for -- ConfigurableBorder so that xmonad can serialize state. class SetsAmbiguous p where hiddens :: p -> WindowSet -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window] instance SetsAmbiguous Ambiguity where hiddens amb wset mst wrs | Combine Union a b <- amb = on union next a b | Combine Difference a b <- amb = on (\\) next a b | Combine Intersection a b <- amb = on intersect next a b | otherwise = tiled ms ++ floating where next p = hiddens p wset mst wrs nonzerorect (Rectangle _ _ 0 0) = False nonzerorect _ = True screens = [ scr | scr <- W.screens wset, case amb of Never -> True _ -> not $ null $ integrate scr, nonzerorect . screenRect $ W.screenDetail scr] floating = [ w | (w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset, px <= 0, py <= 0, wx + px >= 1, wy + py >= 1] ms = filter (`elem` W.integrate' mst) $ map fst wrs tiled [w] | Screen <- amb = [w] | OnlyFloat <- amb = [] | OtherIndicated <- amb , let nonF = map integrate $ W.current wset : W.visible wset , length (concat nonF) > length wrs , singleton $ filter (1==) $ map length nonF = [w] | singleton screens = [w] tiled _ = [] integrate y = W.integrate' . W.stack $ W.workspace y -- | In order of increasing ambiguity (less borders more frequently), where -- subsequent constructors add additional cases where borders are not drawn -- than their predecessors. These behaviors make most sense with with multiple -- screens: for single screens, 'Never' or 'smartBorders' makes more sense. data Ambiguity = Combine With Ambiguity Ambiguity -- ^ This constructor is used to combine the -- borderless windows provided by the -- SetsAmbiguous instances from two other -- 'Ambiguity' data types. | OnlyFloat -- ^ Only remove borders on floating windows that -- cover the whole screen | Never -- ^ Never remove borders when ambiguous: -- this is the same as smartBorders | EmptyScreen -- ^ Focus in an empty screens does not count as -- ambiguous. | OtherIndicated -- ^ No borders on full when all other screens -- have borders. | Screen -- ^ Borders are never drawn on singleton screens. -- With this one you really need another way such -- as a statusbar to detect focus. deriving (Read, Show) -- | Used to indicate to the 'SetsAmbiguous' instance for 'Ambiguity' how two -- lists should be combined. data With = Union -- ^ uses 'Data.List.union' | Difference -- ^ uses 'Data.List.\\' | Intersection -- ^ uses 'Data.List.intersect' deriving (Read, Show) xmonad-contrib-0.12/XMonad/Layout/Named.hs0000644000000000000000000000307512636047674016615 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Named -- Copyright : (c) David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- A module for assigning a name to a given layout. Deprecated, use -- "XMonad.Layout.Renamed" instead. -- ----------------------------------------------------------------------------- module XMonad.Layout.Named ( -- * Usage -- $usage named, nameTail ) where import XMonad.Layout.LayoutModifier import XMonad.Layout.Renamed -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Named -- -- Then edit your @layoutHook@ by adding the Named layout modifier -- to some layout: -- -- > myLayout = named "real big" Full ||| (nameTail $ named "real big" $ Full) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- Note that this module has been deprecated and may be removed in a future -- release, please use "XMonad.Layout.Renamed" instead. -- | (Deprecated) Rename a layout. named :: String -> l a -> ModifiedLayout Rename l a named s = renamed [Replace s] -- | (Deprecated) Remove the first word of the name. nameTail :: l a -> ModifiedLayout Rename l a nameTail = renamed [CutWordsLeft 1] xmonad-contrib-0.12/XMonad/Layout/Cross.hs0000644000000000000000000001113612636047674016657 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} -- | -- Module : XMonad.Layout.Cross -- Copyright : (c) Luis Cabellos -- License : BSD3-style (see LICENSE) -- -- Maintainer : Luis Cabellos -- Stability : stable -- Portability : portable -- -- A Cross Layout with the main window in the center. -- module XMonad.Layout.Cross( -- * Usage -- $usage simpleCross , Cross(..) ) where import XMonad( Dimension, Rectangle(..), LayoutClass(..), Resize(..), fromMessage ) import XMonad.StackSet( focus, up, down ) import Control.Monad( msum ) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Cross -- -- Then edit your @layoutHook@ by adding one of the Cross layouts: -- -- > myLayout = simpleCross ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- apply a factor to a Rectangle Dimension (<%>) :: Dimension -> Rational -> Dimension d <%> f = floor $ f * (fromIntegral d) -- | The Cross Layout draws the focused window in the center of the screen -- and part of the other windows on the sides. The 'Shrink' and 'Expand' -- messages increment the size of the main window. -- -- The focus keybindings change the center window, while other windows -- cycle through the side positions. With the Cross layout only four -- windows are shown around the focused window, two ups and two downs, -- no matter how many are in the current stack. I.e. focus down cycles the -- window below focused into the center; focus up cycles the window above. data Cross a = Cross { crossProp :: !Rational, -- ^ Proportion of screen occupied by the main window. crossInc :: !Rational -- ^ Percent of main window to increment by when resizing. } deriving( Show, Read ) -- | A simple Cross Layout. It places the focused window in the center. -- The proportion of the screen used by the main window is 4\/5. simpleCross :: Cross a simpleCross = Cross (4/5) (1/100) instance LayoutClass Cross a where pureLayout (Cross f _) r s = [(focus s, mainRect r f)] ++ (zip winCycle (upRects r f)) ++ (zip (reverse winCycle) (downRects r f)) where winCycle = (up s) ++ (reverse (down s)) pureMessage (Cross f d) m = msum [fmap resize (fromMessage m)] where resize Shrink = Cross (max (1/100) $ f - d) d resize Expand = Cross (min 1 $ f + d) d description _ = "Cross" -- get the Rectangle for the focused window mainRect :: Rectangle -> Rational -> Rectangle mainRect (Rectangle rx ry rw rh) f = Rectangle (rx + (fromIntegral (rw <%> invf))) (ry + (fromIntegral (rh <%> invf))) (rw <%> f) (rh <%> f) where invf = (1/2) * (1-f) -- get the rectangles for the up windows upRects :: Rectangle -> Rational -> [Rectangle] upRects r f = [topRectangle r nf, rightRectangle r nf] where nf = f * (8/10) -- get the rectangles for the down windows downRects :: Rectangle -> Rational -> [Rectangle] downRects r f = [bottomRectangle r nf, leftRectangle r nf] where nf = f * (8/10) topRectangle :: Rectangle -> Rational -> Rectangle topRectangle (Rectangle rx ry rw rh) f = Rectangle (rx + (fromIntegral (rw <%> ((1-f)*(1/2))))) ry (rw <%> f) (rh <%> ((1-f)*(1/2))) rightRectangle :: Rectangle -> Rational -> Rectangle rightRectangle (Rectangle rx ry rw rh) f = Rectangle (rx + (fromIntegral (rw - (rw <%> (1/2))))) (ry + (fromIntegral (rh <%> ((1-f)*(1/2))))) (rw <%> (1/2)) (rh <%> f) bottomRectangle :: Rectangle -> Rational -> Rectangle bottomRectangle (Rectangle rx ry rw rh) f = Rectangle (rx + (fromIntegral (rw <%> ((1-f)*(1/2))))) (ry + (fromIntegral (rh - (rh <%> ((1-f)*(1/2)))))) (rw <%> f) (rh <%> ((1-f)*(1/2))) leftRectangle :: Rectangle -> Rational -> Rectangle leftRectangle (Rectangle rx ry rw rh) f = Rectangle rx (ry + (fromIntegral (rh <%> ((1-f)*(1/2))))) (rw <%> (1/2)) (rh <%> f) xmonad-contrib-0.12/XMonad/Layout/MultiToggle.hs0000644000000000000000000001627412636047674020032 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, Rank2Types, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.MultiToggle -- Copyright : (c) Lukas Mai -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Dynamically apply and unapply transformers to your window layout. This can -- be used to rotate your window layout by 90 degrees, or to make the -- currently focused window occupy the whole screen (\"zoom in\") then undo -- the transformation (\"zoom out\"). module XMonad.Layout.MultiToggle ( -- * Usage -- $usage Transformer(..), Toggle(..), (??), EOT(..), single, mkToggle, mkToggle1, HList, HCons, MultiToggle, ) where import XMonad import XMonad.StackSet (Workspace(..)) import Control.Arrow import Data.Typeable import Data.Maybe -- $usage -- The basic idea is to have a base layout and a set of layout transformers, -- of which at most one is active at any time. Enabling another transformer -- first disables any currently active transformer; i.e. it works like a -- group of radio buttons. -- -- To use this module, you need some data types which represent -- transformers; for some commonly used transformers (including -- MIRROR, NOBORDERS, and FULL used in the examples below) you can -- simply import "XMonad.Layout.MultiToggle.Instances". -- -- Somewhere else in your file you probably have a definition of @layout@; -- the default looks like this: -- -- > layout = tiled ||| Mirror tiled ||| Full -- -- After changing this to -- -- > layout = mkToggle (single MIRROR) (tiled ||| Full) -- -- you can now dynamically apply the 'XMonad.Layout.Mirror' transformation: -- -- > ... -- > , ((modm, xK_x ), sendMessage $ Toggle MIRROR) -- > ... -- -- (That should be part of your key bindings.) When you press @mod-x@, the -- active layout is mirrored. Another @mod-x@ and it's back to normal. -- -- It's also possible to stack @MultiToggle@s. For example: -- -- @ -- layout = id -- . 'XMonad.Layout.NoBorders.smartBorders' -- . mkToggle (NOBORDERS ?? FULL ?? EOT) -- . mkToggle (single MIRROR) -- $ tiled ||| 'XMonad.Layout.Grid.Grid' ||| 'XMonad.Layout.Circle.Circle' -- @ -- -- By binding a key to @(sendMessage $ Toggle FULL)@ you can temporarily -- maximize windows, in addition to being able to rotate layouts and remove -- window borders. -- -- You can also define your own transformers by creating a data type -- which is an instance of the 'Transformer' class. For example, here -- is the definition of @MIRROR@: -- -- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable) -- > instance Transformer MIRROR Window where -- > transform _ x k = k (Mirror x) (\(Mirror x') -> x') -- -- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable \#-}@ at the -- beginning of your file. -- | A class to identify custom transformers (and look up transforming -- functions by type). class (Eq t, Typeable t) => Transformer t a | t -> a where transform :: (LayoutClass l a) => t -> l a -> (forall l'. (LayoutClass l' a) => l' a -> (l' a -> l a) -> b) -> b data EL l a = forall l'. (LayoutClass l' a) => EL (l' a) (l' a -> l a) unEL :: (LayoutClass l a) => EL l a -> (forall l'. (LayoutClass l' a) => l' a -> b) -> b unEL (EL x _) k = k x deEL :: (LayoutClass l a) => EL l a -> l a deEL (EL x det) = det x transform' :: (Transformer t a, LayoutClass l a) => t -> EL l a -> EL l a transform' t (EL l det) = transform t l (\l' det' -> EL l' (det . det')) -- | Toggle the specified layout transformer. data Toggle a = forall t. (Transformer t a) => Toggle t deriving (Typeable) instance (Typeable a) => Message (Toggle a) data MultiToggleS ts l a = MultiToggleS (l a) (Maybe Int) ts deriving (Read, Show) data MultiToggle ts l a = MultiToggle{ currLayout :: EL l a, currIndex :: Maybe Int, transformers :: ts } expand :: (LayoutClass l a, HList ts a) => MultiToggleS ts l a -> MultiToggle ts l a expand (MultiToggleS b i ts) = resolve ts (fromMaybe (-1) i) id (\x mt -> let g = transform' x in mt{ currLayout = g $ currLayout mt } ) (MultiToggle (EL b id) i ts) collapse :: (LayoutClass l a) => MultiToggle ts l a -> MultiToggleS ts l a collapse mt = MultiToggleS (deEL (currLayout mt)) (currIndex mt) (transformers mt) instance (LayoutClass l a, Read (l a), HList ts a, Read ts) => Read (MultiToggle ts l a) where readsPrec p s = map (first expand) $ readsPrec p s instance (Show ts, Show (l a), LayoutClass l a) => Show (MultiToggle ts l a) where showsPrec p = showsPrec p . collapse -- | Construct a @MultiToggle@ layout from a transformer table and a base -- layout. mkToggle :: (LayoutClass l a) => ts -> l a -> MultiToggle ts l a mkToggle ts l = MultiToggle (EL l id) Nothing ts -- | Construct a @MultiToggle@ layout from a single transformer and a base -- layout. mkToggle1 :: (LayoutClass l a) => t -> l a -> MultiToggle (HCons t EOT) l a mkToggle1 t = mkToggle (single t) -- | Marks the end of a transformer list. data EOT = EOT deriving (Read, Show) data HCons a b = HCons a b deriving (Read, Show) infixr 0 ?? -- | Prepend an element to a heterogeneous list. Used to build transformer -- tables for 'mkToggle'. (??) :: a -> b -> HCons a b (??) = HCons -- | Construct a singleton transformer table. single :: a -> HCons a EOT single = (?? EOT) class HList c a where find :: (Transformer t a) => c -> t -> Maybe Int resolve :: c -> Int -> b -> (forall t. (Transformer t a) => t -> b) -> b instance HList EOT w where find EOT _ = Nothing resolve EOT _ d _ = d instance (Transformer a w, HList b w) => HList (HCons a b) w where find (HCons x xs) t | t `geq` x = Just 0 | otherwise = fmap succ (find xs t) resolve (HCons x xs) n d k = case n `compare` 0 of LT -> d EQ -> k x GT -> resolve xs (pred n) d k geq :: (Typeable a, Eq a, Typeable b) => a -> b -> Bool geq a b = Just a == cast b instance (Typeable a, Show ts, HList ts a, LayoutClass l a) => LayoutClass (MultiToggle ts l) a where description mt = currLayout mt `unEL` \l -> description l runLayout (Workspace i mt s) r = case currLayout mt of EL l det -> fmap (fmap . fmap $ (\x -> mt { currLayout = EL x det })) $ runLayout (Workspace i l s) r handleMessage mt m | Just (Toggle t) <- fromMessage m , i@(Just _) <- find (transformers mt) t = case currLayout mt of EL l det -> do l' <- fromMaybe l `fmap` handleMessage l (SomeMessage ReleaseResources) return . Just $ mt { currLayout = (if cur then id else transform' t) (EL (det l') id), currIndex = if cur then Nothing else i } where cur = (i == currIndex mt) | otherwise = case currLayout mt of EL l det -> fmap (fmap (\x -> mt { currLayout = EL x det })) $ handleMessage l m xmonad-contrib-0.12/XMonad/Layout/ImageButtonDecoration.hs0000644000000000000000000001471112636047674022016 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ImageButtonDecoration -- Copyright : (c) Jan Vornberger 2009 -- Alejandro Serrano 2010 -- License : BSD3-style (see LICENSE) -- -- Maintainer : trupill@gmail.com -- Stability : unstable -- Portability : not portable -- -- A decoration that includes small image buttons on both ends which invoke -- various actions when clicked on: Show a window menu (see -- "XMonad.Actions.WindowMenu"), minimize, maximize or close the window. -- -- Note: For maximizing and minimizing to actually work, you will need -- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your -- setup. See the documentation of those modules for more information. -- ----------------------------------------------------------------------------- -- This module is mostly derived from "XMonad.Layout.DecorationAddons" -- and "XMonad.Layout.ButtonDecoration" module XMonad.Layout.ImageButtonDecoration ( -- * Usage: -- $usage imageButtonDeco , defaultThemeWithImageButtons , imageTitleBarButtonHandler , ImageButtonDecoration ) where import XMonad import XMonad.Layout.Decoration import XMonad.Layout.DecorationAddons import XMonad.Util.Image import XMonad.Actions.WindowMenu import XMonad.Layout.Minimize import XMonad.Layout.Maximize -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.ImageButtonDecoration -- -- Then edit your @layoutHook@ by adding the ImageButtonDecoration to -- your layout: -- -- > myL = imageButtonDeco shrinkText defaultThemeWithImageButtons (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- The buttons' dimension and placements buttonSize :: Int buttonSize = 10 menuButtonOffset :: Int menuButtonOffset = 4 minimizeButtonOffset :: Int minimizeButtonOffset = 32 maximizeButtonOffset :: Int maximizeButtonOffset = 18 closeButtonOffset :: Int closeButtonOffset = 4 -- The images in a 0-1 scale to make -- it easier to visualize convertToBool' :: [Int] -> [Bool] convertToBool' = map (\x -> x == 1) convertToBool :: [[Int]] -> [[Bool]] convertToBool = map convertToBool' menuButton' :: [[Int]] menuButton' = [[1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1]] menuButton :: [[Bool]] menuButton = convertToBool menuButton' miniButton' :: [[Int]] miniButton' = [[0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [0,0,0,0,0,0,0,0,0,0], [1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1]] miniButton :: [[Bool]] miniButton = convertToBool miniButton' maxiButton' :: [[Int]] maxiButton' = [[1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,0,0,0,0,0,0,1,1], [1,1,1,1,1,1,1,1,1,1], [1,1,1,1,1,1,1,1,1,1]] maxiButton :: [[Bool]] maxiButton = convertToBool maxiButton' closeButton' :: [[Int]] closeButton' = [[1,1,0,0,0,0,0,0,1,1], [1,1,1,0,0,0,0,1,1,1], [0,1,1,1,0,0,1,1,1,0], [0,0,1,1,1,1,1,1,0,0], [0,0,0,1,1,1,1,0,0,0], [0,0,0,1,1,1,1,0,0,0], [0,0,1,1,1,1,1,1,0,0], [0,1,1,1,0,0,1,1,1,0], [1,1,1,0,0,0,0,1,1,1], [1,1,0,0,0,0,0,0,1,1]] closeButton :: [[Bool]] closeButton = convertToBool closeButton' -- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration. -- It will intercept clicks on the buttons of the decoration and invoke the associated action. -- To actually see the buttons, you will need to use a theme that includes them. -- See 'defaultThemeWithImageButtons' below. imageTitleBarButtonHandler :: Window -> Int -> Int -> X Bool imageTitleBarButtonHandler mainw distFromLeft distFromRight = do let action = if (fi distFromLeft >= menuButtonOffset && fi distFromLeft <= menuButtonOffset + buttonSize) then focus mainw >> windowMenu >> return True else if (fi distFromRight >= closeButtonOffset && fi distFromRight <= closeButtonOffset + buttonSize) then focus mainw >> kill >> return True else if (fi distFromRight >= maximizeButtonOffset && fi distFromRight <= maximizeButtonOffset + buttonSize) then focus mainw >> sendMessage (maximizeRestore mainw) >> return True else if (fi distFromRight >= minimizeButtonOffset && fi distFromRight <= minimizeButtonOffset + buttonSize) then focus mainw >> minimizeWindow mainw >> return True else return False action defaultThemeWithImageButtons :: Theme defaultThemeWithImageButtons = def { windowTitleIcons = [ (menuButton, CenterLeft 3), (closeButton, CenterRight 3), (maxiButton, CenterRight 18), (miniButton, CenterRight 33) ] } imageButtonDeco :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration ImageButtonDecoration s) l a imageButtonDeco s c = decoration s c $ NFD True data ImageButtonDecoration a = NFD Bool deriving (Show, Read) instance Eq a => DecorationStyle ImageButtonDecoration a where describeDeco _ = "ImageButtonDeco" decorationCatchClicksHook _ mainw dFL dFR = imageTitleBarButtonHandler mainw dFL dFR decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return () xmonad-contrib-0.12/XMonad/Layout/SimplestFloat.hs0000644000000000000000000000405512636047674020356 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.SimplestFloat -- Copyright : (c) 2008 Jussi Mäki -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : joamaki@gmail.com -- Stability : unstable -- Portability : unportable -- -- A basic floating layout like SimpleFloat but without the decoration. ----------------------------------------------------------------------------- module XMonad.Layout.SimplestFloat ( -- * Usage: -- $usage simplestFloat , SimplestFloat ) where import XMonad import qualified XMonad.StackSet as S import XMonad.Layout.WindowArranger import XMonad.Layout.LayoutModifier import XMonad.Util.XUtils (fi) -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.SimplestFloat -- -- Then edit your @layoutHook@ by adding the SimplestFloat layout: -- -- > myLayout = simplestFloat ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- | A simple floating layout where every window is placed according -- to the window's initial attributes. simplestFloat :: Eq a => (ModifiedLayout WindowArranger SimplestFloat) a simplestFloat = windowArrangeAll SF data SimplestFloat a = SF deriving (Show, Read) instance LayoutClass SimplestFloat Window where doLayout SF sc (S.Stack w l r) = fmap (flip (,) Nothing) $ mapM (getSize sc) (w : reverse l ++ r) description _ = "SimplestFloat" getSize :: Rectangle -> Window -> X (Window,Rectangle) getSize (Rectangle rx ry _ _) w = do d <- asks display bw <- asks (borderWidth . config) wa <- io $ getWindowAttributes d w let x = max rx $ fi $ wa_x wa y = max ry $ fi $ wa_y wa wh = (fi $ wa_width wa) + (bw * 2) ht = (fi $ wa_height wa) + (bw * 2) return (w, Rectangle x y wh ht) xmonad-contrib-0.12/XMonad/Layout/BorderResize.hs0000644000000000000000000002334312636047674020170 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.BorderResize -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- This layout modifier will allow to resize windows by dragging their -- borders with the mouse. However, it only works in layouts or modified -- layouts that react to the 'SetGeometry' message. -- "XMonad.Layout.WindowArranger" can be used to create such a setup, -- but it is probably must useful in a floating layout such as -- "XMonad.Layout.PositionStoreFloat" with which it has been mainly tested. -- See the documentation of PositionStoreFloat for a typical usage example. -- ----------------------------------------------------------------------------- module XMonad.Layout.BorderResize ( -- * Usage -- $usage borderResize , BorderResize (..) , RectWithBorders, BorderInfo, ) where import XMonad import XMonad.Layout.Decoration import XMonad.Layout.WindowArranger import XMonad.Util.XUtils import Control.Monad(when) import qualified Data.Map as M -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.BorderResize -- > myLayout = borderResize (... layout setup that reacts to SetGeometry ...) -- > main = xmonad def { layoutHook = myLayout } -- type BorderBlueprint = (Rectangle, Glyph, BorderType) data BorderType = RightSideBorder | LeftSideBorder | TopSideBorder | BottomSideBorder deriving (Show, Read, Eq) data BorderInfo = BI { bWin :: Window, bRect :: Rectangle, bType :: BorderType } deriving (Show, Read) type RectWithBorders = (Rectangle, [BorderInfo]) data BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read) brBorderSize :: Dimension brBorderSize = 2 borderResize :: l a -> ModifiedLayout BorderResize l a borderResize = ModifiedLayout (BR M.empty) instance LayoutModifier BorderResize Window where redoLayout _ _ Nothing wrs = return (wrs, Nothing) redoLayout (BR wrsLastTime) _ _ wrs = do let correctOrder = map fst wrs wrsCurrent = M.fromList wrs wrsGone = M.difference wrsLastTime wrsCurrent wrsAppeared = M.difference wrsCurrent wrsLastTime wrsStillThere = M.intersectionWith testIfUnchanged wrsLastTime wrsCurrent handleGone wrsGone wrsCreated <- handleAppeared wrsAppeared let wrsChanged = handleStillThere wrsStillThere wrsThisTime = M.union wrsChanged wrsCreated return (compileWrs wrsThisTime correctOrder, Just $ BR wrsThisTime) -- What we return is the original wrs with the new border -- windows inserted at the correct positions - this way, the core -- will restack the borders correctly. -- We also return information about our borders, so that we -- can handle events that they receive and destroy them when -- they are no longer needed. where testIfUnchanged entry@(rLastTime, _) rCurrent = if rLastTime == rCurrent then (Nothing, entry) else (Just rCurrent, entry) handleMess (BR wrsLastTime) m | Just e <- fromMessage m :: Maybe Event = handleResize (createBorderLookupTable wrsLastTime) e >> return Nothing | Just _ <- fromMessage m :: Maybe LayoutMessages = handleGone wrsLastTime >> return (Just $ BR M.empty) handleMess _ _ = return Nothing compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)] compileWrs wrsThisTime correctOrder = let wrs = reorder (M.toList wrsThisTime) correctOrder in concat $ map compileWr wrs compileWr :: (Window, RectWithBorders) -> [(Window, Rectangle)] compileWr (w, (r, borderInfos)) = let borderWrs = for borderInfos $ \bi -> (bWin bi, bRect bi) in borderWrs ++ [(w, r)] handleGone :: M.Map Window RectWithBorders -> X () handleGone wrsGone = mapM_ deleteWindow borderWins where borderWins = map bWin . concat . map snd . M.elems $ wrsGone handleAppeared :: M.Map Window Rectangle -> X (M.Map Window RectWithBorders) handleAppeared wrsAppeared = do let wrs = M.toList wrsAppeared wrsCreated <- mapM handleSingleAppeared wrs return $ M.fromList wrsCreated handleSingleAppeared :: (Window, Rectangle) -> X (Window, RectWithBorders) handleSingleAppeared (w, r) = do let borderBlueprints = prepareBorders r borderInfos <- mapM createBorder borderBlueprints return (w, (r, borderInfos)) handleStillThere :: M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders handleStillThere wrsStillThere = M.map handleSingleStillThere wrsStillThere handleSingleStillThere :: (Maybe Rectangle, RectWithBorders) -> RectWithBorders handleSingleStillThere (Nothing, entry) = entry handleSingleStillThere (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos) where changedBorderBlueprints = prepareBorders rCurrent updatedBorderInfos = map updateBorderInfo . zip borderInfos $ changedBorderBlueprints -- assuming that the four borders are always in the same order updateBorderInfo :: (BorderInfo, BorderBlueprint) -> BorderInfo updateBorderInfo (borderInfo, (r, _, _)) = borderInfo { bRect = r } createBorderLookupTable :: M.Map Window RectWithBorders -> [(Window, (BorderType, Window, Rectangle))] createBorderLookupTable wrsLastTime = concat $ map processSingleEntry $ M.toList wrsLastTime where processSingleEntry :: (Window, RectWithBorders) -> [(Window, (BorderType, Window, Rectangle))] processSingleEntry (w, (r, borderInfos)) = for borderInfos $ \bi -> (bWin bi, (bType bi, w, r)) prepareBorders :: Rectangle -> [BorderBlueprint] prepareBorders (Rectangle x y wh ht) = [((Rectangle (x + fi wh - fi brBorderSize) y brBorderSize ht), xC_right_side , RightSideBorder), ((Rectangle x y brBorderSize ht) , xC_left_side , LeftSideBorder), ((Rectangle x y wh brBorderSize) , xC_top_side , TopSideBorder), ((Rectangle x (y + fi ht - fi brBorderSize) wh brBorderSize), xC_bottom_side, BottomSideBorder) ] handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X () handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et } | et == buttonPress, Just edge <- lookup ew borders = case edge of (RightSideBorder, hostWin, (Rectangle hx hy _ hht)) -> mouseDrag (\x _ -> do let nwh = max 1 $ fi (x - hx) rect = Rectangle hx hy nwh hht focus hostWin when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) (LeftSideBorder, hostWin, (Rectangle hx hy hwh hht)) -> mouseDrag (\x _ -> do let nx = max 0 $ min (hx + fi hwh) $ x nwh = max 1 $ hwh + fi (hx - x) rect = Rectangle nx hy nwh hht focus hostWin when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin) (TopSideBorder, hostWin, (Rectangle hx hy hwh hht)) -> mouseDrag (\_ y -> do let ny = max 0 $ min (hy + fi hht) $ y nht = max 1 $ hht + fi (hy - y) rect = Rectangle hx ny hwh nht focus hostWin when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin) (BottomSideBorder, hostWin, (Rectangle hx hy hwh _)) -> mouseDrag (\_ y -> do let nht = max 1 $ fi (y - hy) rect = Rectangle hx hy hwh nht focus hostWin when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) handleResize _ _ = return () createBorder :: BorderBlueprint -> X (BorderInfo) createBorder (borderRect, borderCursor, borderType) = do borderWin <- createInputWindow borderCursor borderRect return BI { bWin = borderWin, bRect = borderRect, bType = borderType } createInputWindow :: Glyph -> Rectangle -> X Window createInputWindow cursorGlyph r = withDisplay $ \d -> do win <- mkInputWindow d r io $ selectInput d win (exposureMask .|. buttonPressMask) cursor <- io $ createFontCursor d cursorGlyph io $ defineCursor d win cursor io $ freeCursor d cursor showWindow win return win mkInputWindow :: Display -> Rectangle -> X Window mkInputWindow d (Rectangle x y w h) = do rw <- asks theRoot let screen = defaultScreenOfDisplay d visual = defaultVisualOfScreen screen attrmask = cWOverrideRedirect io $ allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes True createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes for :: [a] -> (a -> b) -> [b] for = flip map reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)] reorder wrs order = let ordered = concat $ map (pickElem wrs) order rest = filter (\(w, _) -> not (w `elem` order)) wrs in ordered ++ rest where pickElem list e = case (lookup e list) of Just result -> [(e, result)] Nothing -> [] xmonad-contrib-0.12/XMonad/Layout/WindowSwitcherDecoration.hs0000644000000000000000000001445412636047674022564 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.WindowSwitcherDecoration -- Copyright : (c) Jan Vornberger 2009 -- Alejandro Serrano 2010 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- A decoration that allows to switch the position of windows by dragging -- them onto each other. -- ----------------------------------------------------------------------------- module XMonad.Layout.WindowSwitcherDecoration ( -- * Usage: -- $usage windowSwitcherDecoration, windowSwitcherDecorationWithButtons, windowSwitcherDecorationWithImageButtons, WindowSwitcherDecoration, ImageWindowSwitcherDecoration, ) where import XMonad import XMonad.Layout.Decoration import XMonad.Layout.DecorationAddons import XMonad.Layout.ImageButtonDecoration import XMonad.Layout.DraggingVisualizer import qualified XMonad.StackSet as S import Control.Monad import Foreign.C.Types(CInt) -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.WindowSwitcherDecoration -- > import XMonad.Layout.DraggingVisualizer -- -- Then edit your @layoutHook@ by adding the WindowSwitcherDecoration to -- your layout: -- -- > myL = windowSwitcherDecoration shrinkText def (draggingVisualizer $ layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- There is also a version of the decoration that contains buttons like -- "XMonad.Layout.ButtonDecoration". To use that version, you will need to -- import "XMonad.Layout.DecorationAddons" as well and modify your @layoutHook@ -- in the following way: -- -- > import XMonad.Layout.DecorationAddons -- > -- > myL = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer $ layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- Additionaly, there is a version of the decoration that contains image buttons like -- "XMonad.Layout.ImageButtonDecoration". To use that version, you will need to -- import "XMonad.Layout.ImageButtonDecoration" as well and modify your @layoutHook@ -- in the following way: -- -- > import XMonad.Layout.ImageButtonDecoration -- > -- > myL = windowSwitcherDecorationWithImageButtons shrinkText defaultThemeWithImageButtons (draggingVisualizer $ layoutHook def) -- > main = xmonad def { layoutHook = myL } -- windowSwitcherDecoration :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a windowSwitcherDecoration s c = decoration s c $ WSD False windowSwitcherDecorationWithButtons :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a windowSwitcherDecorationWithButtons s c = decoration s c $ WSD True data WindowSwitcherDecoration a = WSD Bool deriving (Show, Read) instance Eq a => DecorationStyle WindowSwitcherDecoration a where describeDeco _ = "WindowSwitcherDeco" decorationCatchClicksHook (WSD withButtons) mainw dFL dFR = if withButtons then titleBarButtonHandler mainw dFL dFR else return False decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw hasCrossed <- handleScreenCrossing mainw decoWin unless hasCrossed $ do sendMessage $ DraggingStopped performWindowSwitching mainw -- Note: the image button code is duplicated from the above -- because the title bar handle is different windowSwitcherDecorationWithImageButtons :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a windowSwitcherDecorationWithImageButtons s c = decoration s c $ IWSD True data ImageWindowSwitcherDecoration a = IWSD Bool deriving (Show, Read) instance Eq a => DecorationStyle ImageWindowSwitcherDecoration a where describeDeco _ = "ImageWindowSwitcherDeco" decorationCatchClicksHook (IWSD withButtons) mainw dFL dFR = if withButtons then imageTitleBarButtonHandler mainw dFL dFR else return False decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw hasCrossed <- handleScreenCrossing mainw decoWin unless hasCrossed $ do sendMessage $ DraggingStopped performWindowSwitching mainw handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () handleTiledDraggingInProgress ex ey (mainw, r) x y = do let rect = Rectangle (x - (fi ex - rect_x r)) (y - (fi ey - rect_y r)) (rect_width r) (rect_height r) sendMessage $ DraggingWindow mainw rect performWindowSwitching :: Window -> X () performWindowSwitching win = withDisplay $ \d -> do root <- asks theRoot (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root ws <- gets windowset let allWindows = S.index ws -- do a little double check to be sure if (win `elem` allWindows) && (selWin `elem` allWindows) then do let allWindowsSwitched = map (switchEntries win selWin) allWindows let (ls, t:rs) = break (win ==) allWindowsSwitched let newStack = S.Stack t (reverse ls) rs windows $ S.modify' $ \_ -> newStack else return () where switchEntries a b x | x == a = b | x == b = a | otherwise = x xmonad-contrib-0.12/XMonad/Layout/AutoMaster.hs0000644000000000000000000001141012636047674017645 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.AutoMaster -- Copyright : (c) 2009 Ilya Portnov -- License : BSD3-style (see LICENSE) -- -- Maintainer : Ilya Portnov -- Stability : unstable -- Portability : unportable -- -- Provides layout modifier AutoMaster. It separates screen in two parts - -- master and slave. Size of slave area automatically changes depending on -- number of slave windows. -- ----------------------------------------------------------------------------- module XMonad.Layout.AutoMaster ( -- * Usage -- $usage autoMaster, AutoMaster ) where import Control.Monad import XMonad import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier -- $usage -- This module defines layout modifier named autoMaster. It separates -- screen in two parts - master and slave. Master windows are arranged -- in one row, in slave area underlying layout is run. Size of slave area -- automatically increases when number of slave windows is increasing. -- -- You can use this module by adding folowing in your @xmonad.hs@: -- -- > import XMonad.Layout.AutoMaster -- -- Then add layouts to your layoutHook: -- -- > myLayoutHook = autoMaster 1 (1/100) Grid ||| ... -- -- In this example, master area by default contains 1 window (you can -- change this number in runtime with usual IncMasterN message), changing -- slave area size with 1/100 on each Shrink/Expand message. -- | Data type for layout modifier data AutoMaster a = AutoMaster Int Float Float deriving (Read,Show) instance (Eq w) => LayoutModifier AutoMaster w where modifyLayout (AutoMaster k bias _) = autoLayout k bias pureMess = autoMess -- | Handle Shrink/Expand and IncMasterN messages autoMess :: AutoMaster a -> SomeMessage -> Maybe (AutoMaster a) autoMess (AutoMaster k bias delta) m = msum [fmap resize (fromMessage m), fmap incmastern (fromMessage m)] where incmastern (IncMasterN d) = AutoMaster (max 1 (k+d)) bias delta resize Expand = AutoMaster k (min ( 0.4) $ bias+delta) delta resize Shrink = AutoMaster k (max (-0.4) $ bias-delta) delta -- | Main layout function autoLayout :: (Eq w, LayoutClass l w) => Int -> Float -> W.Workspace WorkspaceId (l w) w -> Rectangle -> X ([(w, Rectangle)], Maybe (l w)) autoLayout k bias wksp rect = do let stack = W.stack wksp let ws = W.integrate' stack let n = length ws if null ws then runLayout wksp rect else do if (n<=k) then return ((divideRow rect ws),Nothing) else do let master = take k ws let filtStack = stack >>= W.filter (\w -> not (w `elem` master)) wrs <- runLayout (wksp {W.stack = filtStack}) (slaveRect rect n bias) return ((divideRow (masterRect rect n bias) master) ++ (fst wrs), snd wrs) -- | Calculates height of master area, depending on number of windows. masterHeight :: Int -> Float -> Float masterHeight n bias = (calcHeight n) + bias where calcHeight :: Int -> Float calcHeight 1 = 1.0 calcHeight m = if (m<9) then (43/45) - (fromIntegral m)*(7/90) else (1/3) -- | Rectangle for master area masterRect :: Rectangle -> Int -> Float -> Rectangle masterRect (Rectangle sx sy sw sh) n bias = Rectangle sx sy sw h where h = round $ (fromIntegral sh)*(masterHeight n bias) -- | Rectangle for slave area slaveRect :: Rectangle -> Int -> Float -> Rectangle slaveRect (Rectangle sx sy sw sh) n bias = Rectangle sx (sy+mh) sw h where mh = round $ (fromIntegral sh)*(masterHeight n bias) h = round $ (fromIntegral sh)*(1-masterHeight n bias) -- | Divide rectangle between windows divideRow :: Rectangle -> [a] -> [(a, Rectangle)] divideRow (Rectangle x y w h) ws = zip ws rects where n = length ws oneW = fromIntegral w `div` n oneRect = Rectangle x y (fromIntegral oneW) h rects = take n $ iterate (shiftR (fromIntegral oneW)) oneRect -- | Shift rectangle right shiftR :: Position -> Rectangle -> Rectangle shiftR s (Rectangle x y w h) = Rectangle (x+s) y w h -- | User interface function autoMaster :: LayoutClass l a => Int -> -- Number of master windows Float -> -- Step for which to increment/decrement master area size with Shrink/Expand l a -> ModifiedLayout AutoMaster l a autoMaster nmaster delta = ModifiedLayout (AutoMaster nmaster 0 delta) xmonad-contrib-0.12/XMonad/Layout/PerScreen.hs0000644000000000000000000000557012636047674017461 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.PerScreen -- Copyright : (c) Edward Z. Yang -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Configure layouts based on the width of your screen; use your -- favorite multi-column layout for wide screens and a full-screen -- layout for small ones. ----------------------------------------------------------------------------- module XMonad.Layout.PerScreen ( -- * Usage -- $usage PerScreen, ifWider ) where import XMonad import qualified XMonad.StackSet as W import Data.Maybe (fromMaybe) -- $usage -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: -- -- > import XMonad.Layout.PerScreen -- -- and modifying your layoutHook as follows (for example): -- -- > layoutHook = ifWider 1280 (Tall 1 (3/100) (1/2) ||| Full) Full -- -- Replace any of the layouts with any arbitrarily complicated layout. -- ifWider can also be used inside other layout combinators. ifWider :: (LayoutClass l1 a, LayoutClass l2 a) => Dimension -- ^ target screen width -> (l1 a) -- ^ layout to use when the screen is wide enough -> (l2 a) -- ^ layout to use otherwise -> PerScreen l1 l2 a ifWider w = PerScreen w False data PerScreen l1 l2 a = PerScreen Dimension Bool (l1 a) (l2 a) deriving (Read, Show) -- | Construct new PerScreen values with possibly modified layouts. mkNewPerScreenT :: PerScreen l1 l2 a -> Maybe (l1 a) -> PerScreen l1 l2 a mkNewPerScreenT (PerScreen w _ lt lf) mlt' = (\lt' -> PerScreen w True lt' lf) $ fromMaybe lt mlt' mkNewPerScreenF :: PerScreen l1 l2 a -> Maybe (l2 a) -> PerScreen l1 l2 a mkNewPerScreenF (PerScreen w _ lt lf) mlf' = (\lf' -> PerScreen w False lt lf') $ fromMaybe lf mlf' instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerScreen l1 l2) a where runLayout (W.Workspace i p@(PerScreen w _ lt lf) ms) r | rect_width r > w = do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r return (wrs, Just $ mkNewPerScreenT p mlt') | otherwise = do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r return (wrs, Just $ mkNewPerScreenF p mlt') handleMessage (PerScreen w bool lt lf) m | bool = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ PerScreen w bool nt lf) | otherwise = handleMessage lf m >>= maybe (return Nothing) (\nf -> return . Just $ PerScreen w bool lt nf) description (PerScreen _ True l1 _) = description l1 description (PerScreen _ _ _ l2) = description l2 xmonad-contrib-0.12/XMonad/Layout/LayoutScreens.hs0000644000000000000000000001066112636047674020370 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LayoutScreens -- Copyright : (c) David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- Divide a single screen into multiple screens. ----------------------------------------------------------------------------- module XMonad.Layout.LayoutScreens ( -- * Usage -- $usage layoutScreens, layoutSplitScreen, fixedLayout, FixedLayout, ) where import XMonad import qualified XMonad.StackSet as W -- $usage -- This module allows you to pretend that you have more than one screen by -- dividing a single screen into multiple screens that xmonad will treat as -- separate screens. This should definitely be useful for testing the -- behavior of xmonad under Xinerama, and it's possible that it'd also be -- handy for use as an actual user interface, if you've got a very large -- screen and long for greater flexibility (e.g. being able to see your -- email window at all times, a crude mimic of sticky windows). -- -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Layout.LayoutScreens -- > import XMonad.Layout.TwoPane -- -- Then add some keybindings; for example: -- -- > , ((modm .|. shiftMask, xK_space), layoutScreens 2 (TwoPane 0.5 0.5)) -- > , ((modm .|. controlMask .|. shiftMask, xK_space), rescreen) -- -- Another example use would be to handle a scenario where xrandr didn't -- work properly (e.g. a VNC X server in my case) and you want to be able -- to resize your screen (e.g. to match the size of a remote VNC client): -- -- > import XMonad.Layout.LayoutScreens -- -- > , ((modm .|. shiftMask, xK_space), -- > layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768])) -- > , ((modm .|. controlMask .|. shiftMask, xK_space), rescreen) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Modify all screens. layoutScreens :: LayoutClass l Int => Int -> l Int -> X () layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens." layoutScreens nscr l = do rtrect <- asks theRoot >>= getWindowRectangle (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rtrect windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) -> let (x:xs, ys) = splitAt nscr $ map W.workspace (v:vs) ++ hs s:ss = map snd wss in ws { W.current = W.Screen x 0 (SD s) , W.visible = zipWith3 W.Screen xs [1 ..] $ map SD ss , W.hidden = ys } -- | Modify current screen. layoutSplitScreen :: LayoutClass l Int => Int -> l Int -> X () layoutSplitScreen nscr _ | nscr < 1 = trace $ "Can't layoutSplitScreen with only " ++ show nscr ++ " screens." layoutSplitScreen nscr l = do rect <- gets $ screenRect . W.screenDetail . W.current . windowset (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rect windows $ \ws@(W.StackSet { W.current = c, W.visible = vs, W.hidden = hs }) -> let (x:xs, ys) = splitAt nscr $ W.workspace c : hs s:ss = map snd wss in ws { W.current = W.Screen x (W.screen c) (SD s) , W.visible = (zipWith3 W.Screen xs [(W.screen c+1) ..] $ map SD ss) ++ map (\v -> if W.screen v>W.screen c then v{W.screen = W.screen v + fromIntegral (nscr-1)} else v) vs , W.hidden = ys } getWindowRectangle :: Window -> X Rectangle getWindowRectangle w = withDisplay $ \d -> do a <- io $ getWindowAttributes d w return $ Rectangle (fromIntegral $ wa_x a) (fromIntegral $ wa_y a) (fromIntegral $ wa_width a) (fromIntegral $ wa_height a) data FixedLayout a = FixedLayout [Rectangle] deriving (Read,Show) instance LayoutClass FixedLayout a where doLayout (FixedLayout rs) _ s = return (zip (W.integrate s) rs, Nothing) fixedLayout :: [Rectangle] -> FixedLayout a fixedLayout = FixedLayout xmonad-contrib-0.12/XMonad/Layout/ButtonDecoration.hs0000644000000000000000000000375312636047674021057 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.ButtonDecoration -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- A decoration that includes small buttons on both ends which invoke -- various actions when clicked on: Show a window menu (see -- "XMonad.Actions.WindowMenu"), minimize, maximize or close the window. -- -- Note: For maximizing and minimizing to actually work, you will need -- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your -- setup. See the documentation of those modules for more information. -- ----------------------------------------------------------------------------- module XMonad.Layout.ButtonDecoration ( -- * Usage: -- $usage buttonDeco, ButtonDecoration, ) where import XMonad import XMonad.Layout.Decoration import XMonad.Layout.DecorationAddons -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.DecorationAddons -- > import XMonad.Layout.ButtonDecoration -- -- Then edit your @layoutHook@ by adding the ButtonDecoration to -- your layout: -- -- > myL = buttonDeco shrinkText defaultThemeWithButtons (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- buttonDeco :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration ButtonDecoration s) l a buttonDeco s c = decoration s c $ NFD True data ButtonDecoration a = NFD Bool deriving (Show, Read) instance Eq a => DecorationStyle ButtonDecoration a where describeDeco _ = "ButtonDeco" decorationCatchClicksHook _ mainw dFL dFR = titleBarButtonHandler mainw dFL dFR decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return () xmonad-contrib-0.12/XMonad/Layout/TwoPane.hs0000644000000000000000000000435012636047674017143 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.TwoPane -- Copyright : (c) Spencer Janssen -- License : BSD3-style (see LICENSE) -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- A layout that splits the screen horizontally and shows two windows. The -- left window is always the master window, and the right is either the -- currently focused window or the second window in layout order. -- ----------------------------------------------------------------------------- module XMonad.Layout.TwoPane ( -- * Usage -- $usage TwoPane (..) ) where import XMonad hiding (focus) import XMonad.StackSet ( focus, up, down) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.TwoPane -- -- Then edit your @layoutHook@ by adding the TwoPane layout: -- -- > myLayout = TwoPane (3/100) (1/2) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" data TwoPane a = TwoPane Rational Rational deriving ( Show, Read ) instance LayoutClass TwoPane a where doLayout (TwoPane _ split) r s = return (arrange r s,Nothing) where arrange rect st = case reverse (up st) of (master:_) -> [(master,left),(focus st,right)] [] -> case down st of (next:_) -> [(focus st,left),(next,right)] [] -> [(focus st, rect)] where (left, right) = splitHorizontallyBy split rect handleMessage (TwoPane delta split) x = return $ case fromMessage x of Just Shrink -> Just (TwoPane delta (split - delta)) Just Expand -> Just (TwoPane delta (split + delta)) _ -> Nothing description _ = "TwoPane" xmonad-contrib-0.12/XMonad/Layout/PositionStoreFloat.hs0000644000000000000000000000737412636047674021406 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.PositionStoreFloat -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- A floating layout which has been designed with a dual-head setup -- in mind. It makes use of "XMonad.Util.PositionStore" as well as -- "XMonad.Hooks.PositionStoreHooks" . Since there is currently no way -- to move or resize windows with the keyboard alone in this layout, -- it is adviced to use it in combination with a decoration such as -- "XMonad.Layout.NoFrillsDecoration" (to move windows) and the -- layout modifier "XMonad.Layout.BorderResize" (to resize windows). -- ----------------------------------------------------------------------------- module XMonad.Layout.PositionStoreFloat ( -- * Usage -- $usage positionStoreFloat, PositionStoreFloat ) where import XMonad import XMonad.Util.PositionStore import qualified XMonad.StackSet as S import XMonad.Layout.WindowArranger import Control.Monad(when) import Data.Maybe(isJust) import Data.List(nub) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.PositionStoreFloat -- > import XMonad.Layout.NoFrillsDecoration -- > import XMonad.Layout.BorderResize -- -- Then edit your @layoutHook@ by adding the PositionStoreFloat layout. -- Below is a suggestion which uses the mentioned NoFrillsDecoration and -- BorderResize: -- -- > myLayouts = floatingDeco $ borderResize $ positionStoreFloat ||| etc.. -- > where floatingDeco l = noFrillsDeco shrinkText def l -- > main = xmonad def { layoutHook = myLayouts } -- -- See the documentation of "XMonad.Hooks.PositionStoreHooks" on how -- to add the support hooks. positionStoreFloat :: PositionStoreFloat a positionStoreFloat = PSF (Nothing, []) data PositionStoreFloat a = PSF (Maybe Rectangle, [a]) deriving (Show, Read) instance LayoutClass PositionStoreFloat Window where description _ = "PSF" doLayout (PSF (maybeChange, paintOrder)) sr (S.Stack w l r) = do posStore <- getPosStore let wrs = map (\w' -> (w', pSQ posStore w' sr)) (reverse l ++ r) let focused = case maybeChange of Nothing -> (w, pSQ posStore w sr) Just changedRect -> (w, changedRect) let wrs' = focused : wrs let paintOrder' = nub (w : paintOrder) when (isJust maybeChange) $ do updatePositionStore focused sr return (reorder wrs' paintOrder', Just $ PSF (Nothing, paintOrder')) where pSQ posStore w' sr' = case (posStoreQuery posStore w' sr') of Just rect -> rect Nothing -> (Rectangle 50 50 200 200) -- should usually not happen pureMessage (PSF (_, paintOrder)) m | Just (SetGeometry rect) <- fromMessage m = Just $ PSF (Just rect, paintOrder) | otherwise = Nothing updatePositionStore :: (Window, Rectangle) -> Rectangle -> X () updatePositionStore (w, rect) sr = modifyPosStore (\ps -> posStoreInsert ps w rect sr) reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)] reorder wrs order = let ordered = concat $ map (pickElem wrs) order rest = filter (\(w, _) -> not (w `elem` order)) wrs in ordered ++ rest where pickElem list e = case (lookup e list) of Just result -> [(e, result)] Nothing -> [] xmonad-contrib-0.12/XMonad/Layout/MultiColumns.hs0000644000000000000000000001414412636047674020223 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.MultiColumns -- Copyright : (c) Anders Engstrom -- License : BSD3-style (see LICENSE) -- -- Maintainer : Anders Engstrom -- Stability : unstable -- Portability : unportable -- -- This layout tiles windows in a growing number of columns. The number of -- windows in each column can be controlled by messages. ----------------------------------------------------------------------------- module XMonad.Layout.MultiColumns ( -- * Usage -- $usage multiCol, MultiCol, ) where import XMonad import qualified XMonad.StackSet as W import Control.Monad -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.MultiColumns -- -- Then edit your @layoutHook@ by adding the multiCol layout: -- -- > myLayouts = multiCol [1] 4 0.01 0.5 ||| etc.. -- > main = xmonad def { layoutHook = myLayouts } -- -- Or alternatively: -- -- > myLayouts = Mirror (multiCol [1] 2 0.01 (-0.25)) ||| etc.. -- > main = xmonad def { layoutHook = myLayouts } -- -- The maximum number of windows in a column can be controlled using the -- IncMasterN messages and the column containing the focused window will be -- modified. If the value is 0, all remaining windows will be placed in that -- column when all columns before that has been filled. -- -- The size can be set to between 1 and -0.5. If the value is positive, the -- master column will be of that size. The rest of the screen is split among -- the other columns. But if the size is negative, it instead indicates the -- size of all non-master columns and the master column will cover the rest of -- the screen. If the master column would become smaller than the other -- columns, the screen is instead split equally among all columns. Therefore, -- if equal size among all columns are desired, set the size to -0.5. -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- | Layout constructor. multiCol :: [Int] -- ^ Windows in each column, starting with master. Set to 0 to catch the rest. -> Int -- ^ Default value for all following columns. -> Rational -- ^ How much to change size each time. -> Rational -- ^ Initial size of master area, or column area if the size is negative. -> MultiCol a multiCol n defn ds s = MultiCol (map (max 0) n) (max 0 defn) ds s 0 data MultiCol a = MultiCol { multiColNWin :: ![Int] , multiColDefWin :: !Int , multiColDeltaSize :: !Rational , multiColSize :: !Rational , multiColActive :: !Int } deriving (Show,Read,Eq) instance LayoutClass MultiCol a where doLayout l r s = return (zip w rlist, resl) where rlist = doL (multiColNWin l') (multiColSize l') r wlen w = W.integrate s wlen = length w -- Make sure the list of columns is big enough and update active column nw = multiColNWin l ++ repeat (multiColDefWin l) l' = l { multiColNWin = take (max (length $ multiColNWin l) $ getCol (wlen-1) nw + 1) nw , multiColActive = getCol (length $ W.up s) nw } -- Only return new layout if it has been modified resl = if l'==l then Nothing else Just l' handleMessage l m = return $ msum [fmap resize (fromMessage m) ,fmap incmastern (fromMessage m)] where resize Shrink = l { multiColSize = max (-0.5) $ s-ds } resize Expand = l { multiColSize = min 1 $ s+ds } incmastern (IncMasterN x) = l { multiColNWin = take a n ++ [newval] ++ tail r } where newval = max 0 $ head r + x r = drop a n n = multiColNWin l ds = multiColDeltaSize l s = multiColSize l a = multiColActive l description _ = "MultiCol" -- | Get which column a window is in, starting at 0. getCol :: Int -> [Int] -> Int getCol w (n:ns) = if n<1 || w < n then 0 else 1 + getCol (w-n) ns -- Should never occur... getCol _ _ = -1 doL :: [Int] -> Rational -> Rectangle -> Int -> [Rectangle] doL nwin s r n = rlist where -- Number of columns to tile ncol = getCol (n-1) nwin + 1 -- Compute the actual size size = floor $ abs s * fromIntegral (rect_width r) -- Extract all but last column to tile c = take (ncol-1) nwin -- Compute number of windows in last column and add it to the others col = c ++ [n-sum c] -- Compute width of columns width = if s>0 then if ncol==1 -- Only one window then [fromIntegral $ rect_width r] -- Give the master it's space and split the rest equally for the other columns else size:replicate (ncol-1) ((fromIntegral (rect_width r) - size) `div` (ncol-1)) else if fromIntegral ncol * abs s >= 1 -- Split equally then replicate ncol $ fromIntegral (rect_width r) `div` ncol -- Let the master cover what is left... else (fromIntegral (rect_width r) - (ncol-1)*size):replicate (ncol-1) size -- Compute the horizontal position of columns xpos = accumEx (fromIntegral $ rect_x r) width -- Exclusive accumulation accumEx a (x:xs) = a:accumEx (a+x) xs accumEx _ _ = [] -- Create a rectangle for each column cr = zipWith (\x w -> r { rect_x=fromIntegral x, rect_width=fromIntegral w }) xpos width -- Split the columns into the windows rlist = concat $ zipWith (\num rect -> splitVertically num rect) col cr xmonad-contrib-0.12/XMonad/Layout/AvoidFloats.hs0000644000000000000000000002773712636047674020017 0ustar0000000000000000{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, ParallelListComp, DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.AvoidFloats -- Copyright : (c) 2014 Anders Engstrom -- License : BSD3-style (see LICENSE) -- -- Maintainer : (c) Anders Engstrom -- Stability : unstable -- Portability : unportable -- -- Find a maximum empty rectangle around floating windows and use that area -- to display non-floating windows. -- ----------------------------------------------------------------------------- module XMonad.Layout.AvoidFloats ( -- * Usage -- $usage avoidFloats, avoidFloats', AvoidFloatMsg(..), AvoidFloatItemMsg(..), ) where import XMonad import XMonad.Layout.LayoutModifier import qualified XMonad.StackSet as W import Data.List import Data.Ord import Data.Maybe import qualified Data.Map as M import qualified Data.Set as S -- $usage -- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file: -- -- > import XMonad.Layout.AvoidFloats -- -- and modify the layouts to call avoidFloats on the layouts where you want the -- non-floating windows to not be behind floating windows. -- -- > layoutHook = ... ||| avoidFloats Full ||| ... -- -- For more detailed instructions on editing the layoutHook see: -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- Then add appropriate key bindings, for example: -- -- > ,((modm .|. shiftMask, xK_b), sendMessage AvoidFloatToggle) -- > ,((modm .|. controlMask, xK_b), withFocused $ sendMessage . AvoidFloatToggleItem) -- > ,((modm .|. shiftMask .|. controlMask, xK_b), sendMessage (AvoidFloatSet False) >> sendMessage AvoidFloatClearItems) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- -- Note that this module is incompatible with an old way of configuring -- "XMonad.Actions.FloatSnap". If you are having problems, please update your -- configuration. -- | Avoid floating windows unless the resulting area for windows would be too small. -- In that case, use the whole screen as if this layout modifier wasn't there. -- No windows are avoided by default, they need to be added using signals. avoidFloats :: l a -- ^ Layout to modify. -> ModifiedLayout AvoidFloats l a avoidFloats = avoidFloats' 100 100 False -- | Avoid floating windows unless the resulting area for windows would be too small. -- In that case, use the whole screen as if this layout modifier wasn't there. avoidFloats' :: Int -- ^ Minimum width of the area used for non-floating windows. -> Int -- ^ Minimum height of the area used for non-floating windows. -> Bool -- ^ If floating windows should be avoided by default. -> l a -- ^ Layout to modify. -> ModifiedLayout AvoidFloats l a avoidFloats' w h act = ModifiedLayout (AvoidFloats Nothing S.empty w h act) data AvoidFloats a = AvoidFloats { cache :: Maybe ((M.Map a W.RationalRect, Rectangle), Rectangle) , chosen :: S.Set a , minw :: Int , minh :: Int , avoidAll :: Bool } deriving (Read, Show) -- | Change the state of the whole avoid float layout modifier. data AvoidFloatMsg = AvoidFloatToggle -- ^ Toggle between avoiding all or only selected. | AvoidFloatSet Bool -- ^ Set if all all floating windows should be avoided. | AvoidFloatClearItems -- ^ Clear the set of windows to specifically avoid. deriving (Typeable) -- | Change the state of the avoid float layout modifier conserning a specific window. data AvoidFloatItemMsg a = AvoidFloatAddItem a -- ^ Add a window to always avoid. | AvoidFloatRemoveItem a -- ^ Stop always avoiding selected window. | AvoidFloatToggleItem a -- ^ Toggle between always avoiding selected window. deriving (Typeable) instance Message AvoidFloatMsg instance Typeable a => Message (AvoidFloatItemMsg a) instance LayoutModifier AvoidFloats Window where modifyLayoutWithUpdate lm w r = withDisplay $ \d -> do floating <- gets $ W.floating . windowset case cache lm of Just (key, mer) | key == (floating,r) -> flip (,) Nothing `fmap` runLayout w mer _ -> do rs <- io $ map toRect `fmap` mapM (getWindowAttributes d) (filter shouldAvoid $ M.keys floating) let mer = maximumBy (comparing area) $ filter bigEnough $ maxEmptyRectangles r rs flip (,) (Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) `fmap` runLayout w mer where toRect :: WindowAttributes -> Rectangle toRect wa = let b = fi $ wa_border_width wa in Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa + 2*b) (fi $ wa_height wa + 2*b) bigEnough :: Rectangle -> Bool bigEnough rect = rect_width rect >= fi (minw lm) && rect_height rect >= fi (minh lm) shouldAvoid a = avoidAll lm || a `S.member` chosen lm pureMess lm m | Just (AvoidFloatToggle) <- fromMessage m = Just $ lm { avoidAll = not (avoidAll lm), cache = Nothing } | Just (AvoidFloatSet s) <- fromMessage m, s /= avoidAll lm = Just $ lm { avoidAll = s, cache = Nothing } | Just (AvoidFloatClearItems) <- fromMessage m = Just $ lm { chosen = S.empty, cache = Nothing } | Just (AvoidFloatAddItem a) <- fromMessage m, a `S.notMember` chosen lm = Just $ lm { chosen = S.insert a (chosen lm), cache = Nothing } | Just (AvoidFloatRemoveItem a) <- fromMessage m, a `S.member` chosen lm = Just $ lm { chosen = S.delete a (chosen lm), cache = Nothing } | Just (AvoidFloatToggleItem a) <- fromMessage m = let op = if a `S.member` chosen lm then S.delete else S.insert in Just $ lm { chosen = op a (chosen lm), cache = Nothing } | otherwise = Nothing pruneWindows :: AvoidFloats Window -> AvoidFloats Window pruneWindows lm = case cache lm of Nothing -> lm Just ((floating,_),_) -> lm { chosen = S.filter (flip M.member floating) (chosen lm) } -- | Find all maximum empty rectangles (MERs) that are axis aligned. This is -- done in O(n^2) time using a modified version of the algoprithm MERAlg 1 -- described in \"On the maximum empty rectangle problem\" by A. Naamad, D.T. -- Lee and W.-L HSU. Published in Discrete Applied Mathematics 8 (1984.) maxEmptyRectangles :: Rectangle -> [Rectangle] -> [Rectangle] maxEmptyRectangles br rectangles = filter (\a -> area a > 0) $ upAndDownEdge ++ noneOrUpEdge ++ downEdge where upAndDownEdge = findGaps br rectangles noneOrUpEdge = concat $ map (everyLower br bottoms) bottoms downEdge = concat $ map maybeToList $ map (bottomEdge br bottoms) bottoms bottoms = sortBy (comparing bottom) $ splitContainers rectangles everyLower :: Rectangle -> [Rectangle] -> Rectangle -> [Rectangle] everyLower br bottoms r = let (rs, boundLeft, boundRight, boundRects) = foldr (everyUpper r) ([], left br, right br, reverse bottoms) bottoms (boundLeft', boundRight', _) = shrinkBounds boundLeft boundRight boundRects r (top br) in mkRect boundLeft' boundRight' (top br) (top r) ?: rs everyUpper :: Rectangle -- ^ The current rectangle where the top edge is used. -> Rectangle -- ^ The current rectangle where the bottom edge is used. -> ([Rectangle],Int,Int,[Rectangle]) -- ^ List of MERs found so far, left bound, right bound and list of rectangles used for bounds. -> ([Rectangle],Int,Int,[Rectangle]) everyUpper lower upper (rs, boundLeft, boundRight, boundRects) = (r?:rs, boundLeft', boundRight', boundRects') where r = mkRect boundLeft' boundRight' (bottom upper) (top lower) (boundLeft', boundRight', boundRects') = shrinkBounds boundLeft boundRight boundRects lower (bottom upper) shrinkBounds :: Int -> Int -> [Rectangle] -> Rectangle -> Int -> (Int, Int, [Rectangle]) shrinkBounds boundLeft boundRight boundRects lower upperLimit = (boundLeft', boundRight', boundRects') where (shrinkers, boundRects') = span (\a -> bottom a > upperLimit) boundRects (boundLeft', boundRight') = foldr (shrinkBounds' lower) (boundLeft, boundRight) $ filter (\a -> top a < top lower) shrinkers shrinkBounds' :: Rectangle -> Rectangle -> (Int, Int) -> (Int, Int) shrinkBounds' mr r (boundLeft, boundRight) | right r < right mr = (max boundLeft $ right r, boundRight) | left r > left mr = (boundLeft, min boundRight $ left r) | otherwise = (right r, left r) -- r is horizontally covering all of mr; make sure the area of this rectangle will always be 0. bottomEdge :: Rectangle -> [Rectangle] -> Rectangle -> Maybe Rectangle bottomEdge br bottoms r = let rs = filter (\a -> bottom r < bottom a && top a < bottom br) bottoms boundLeft = maximum $ left br : (filter (< right r) $ map right rs) boundRight = minimum $ right br : (filter (> left r) $ map left rs) in if any (\a -> left a <= left r && right r <= right a) rs then Nothing else mkRect boundLeft boundRight (bottom r) (bottom br) -- | Split rectangles that horizontally fully contains another rectangle -- without sharing either the left or right side. splitContainers :: [Rectangle] -> [Rectangle] splitContainers rects = splitContainers' [] $ sortBy (comparing rect_width) rects where splitContainers' :: [Rectangle] -> [Rectangle] -> [Rectangle] splitContainers' res [] = res splitContainers' res (r:rs) = splitContainers' (r:res) $ concat $ map (doSplit r) rs doSplit :: Rectangle -> Rectangle -> [Rectangle] doSplit guide r | left guide <= left r || right r <= right guide = [r] | otherwise = let w0 = fi (rect_x guide - rect_x r) + (rect_width guide `div` 2) w1 = rect_width r - w0 in [ Rectangle (rect_x r) (rect_y r) w0 (rect_height r) , Rectangle (rect_x r + fi w0) (rect_y r) w1 (rect_height r) ] -- | Find all horizontal gaps that are left empty from top to bottom of screen. findGaps :: Rectangle -- ^ Bounding rectangle. -> [Rectangle] -- ^ List of all rectangles that can cover areas in the bounding rectangle. -> [Rectangle] findGaps br rs = let (gaps,end) = foldr findGaps' ([], left br) $ sortBy (flip $ comparing left) $ filter inBounds rs lastgap = mkRect end (right br) (top br) (bottom br) in lastgap?:gaps where findGaps' :: Rectangle -> ([Rectangle], Int) -> ([Rectangle], Int) findGaps' r (gaps, end) = let gap = mkRect end (left r) (top br) (bottom br) in (gap?:gaps, max end (right r)) inBounds :: Rectangle -> Bool inBounds r = left r < right br && left br < right r fi :: (Integral a, Num b) => a -> b fi x = fromIntegral x (?:) :: Maybe a -> [a] -> [a] Just x ?: xs = x:xs _ ?: xs = xs left, right, top, bottom, area :: Rectangle -> Int left r = fi (rect_x r) right r = fi (rect_x r) + fi (rect_width r) top r = fi (rect_y r) bottom r = fi (rect_y r) + fi (rect_height r) area r = fi (rect_width r * rect_height r) mkRect :: Int -> Int -> Int -> Int -> Maybe Rectangle mkRect l r t b = let rect = Rectangle (fi l) (fi t) (fi $ max 0 $ r-l) (fi $ max 0 $ b-t) in if area rect > 0 then Just rect else Nothing xmonad-contrib-0.12/XMonad/Layout/DraggingVisualizer.hs0000644000000000000000000000405512636047674021370 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DraggingVisualizer -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- A helper module to visualize the process of dragging a window by -- making it follow the mouse cursor. See "XMonad.Layout.WindowSwitcherDecoration" -- for a module that makes use of this. -- ----------------------------------------------------------------------------- module XMonad.Layout.DraggingVisualizer ( draggingVisualizer, DraggingVisualizerMsg (..), DraggingVisualizer, ) where import XMonad import XMonad.Layout.LayoutModifier data DraggingVisualizer a = DraggingVisualizer (Maybe (Window, Rectangle)) deriving ( Read, Show ) draggingVisualizer :: LayoutClass l Window => l Window -> ModifiedLayout DraggingVisualizer l Window draggingVisualizer = ModifiedLayout $ DraggingVisualizer Nothing data DraggingVisualizerMsg = DraggingWindow Window Rectangle | DraggingStopped deriving ( Typeable, Eq ) instance Message DraggingVisualizerMsg instance LayoutModifier DraggingVisualizer Window where modifierDescription (DraggingVisualizer _) = "DraggingVisualizer" pureModifier (DraggingVisualizer (Just dragged@(draggedWin, _))) _ _ wrs = if draggedWin `elem` (map fst wrs) then (dragged : rest, Nothing) else (wrs, Just $ DraggingVisualizer Nothing) where rest = filter (\(w, _) -> w /= draggedWin) wrs pureModifier _ _ _ wrs = (wrs, Nothing) pureMess (DraggingVisualizer _) m = case fromMessage m of Just (DraggingWindow w rect) -> Just $ DraggingVisualizer $ Just (w, rect) Just (DraggingStopped) -> Just $ DraggingVisualizer Nothing _ -> Nothing xmonad-contrib-0.12/XMonad/Layout/DwmStyle.hs0000644000000000000000000000444712636047674017345 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DwmStyle -- Copyright : (c) 2007 Andrea Rossato -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A layout modifier for decorating windows in a dwm like style. ----------------------------------------------------------------------------- module XMonad.Layout.DwmStyle ( -- * Usage: -- $usage dwmStyle , Theme (..) , def , defaultTheme , DwmStyle (..) , shrinkText, CustomShrink(CustomShrink) , Shrinker(..) ) where import XMonad import XMonad.StackSet ( Stack (..) ) import XMonad.Layout.Decoration -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.DwmStyle -- -- Then edit your @layoutHook@ by adding the DwmStyle decoration to -- your layout: -- -- > myL = dwmStyle shrinkText def (layoutHook def) -- > main = xmonad def { layoutHook = myL } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- You can also edit the default configuration options. -- -- > myDWConfig = def { inactiveBorderColor = "red" -- > , inactiveTextColor = "red"} -- -- and -- -- > myL = dwmStyle shrinkText myDWConfig (layoutHook def) -- -- A complete xmonad.hs file for this would therefore be: -- -- > import XMonad -- > import XMonad.Layout.DwmStyle -- > -- > main = xmonad def { -- > layoutHook = dwmStyle shrinkText def (layoutHook def) -- > } -- -- | Add simple old dwm-style decorations to windows of a layout. dwmStyle :: (Eq a, Shrinker s) => s -> Theme -> l a -> ModifiedLayout (Decoration DwmStyle s) l a dwmStyle s c = decoration s c Dwm data DwmStyle a = Dwm deriving (Show, Read) instance Eq a => DecorationStyle DwmStyle a where describeDeco _ = "DwmStyle" shrink _ _ r = r pureDecoration _ wh ht _ s@(Stack fw _ _) _ (w,Rectangle x y wid _) = if w == fw || not (isInStack s w) then Nothing else Just $ Rectangle (fi nx) y nwh (fi ht) where nwh = min wid $ fi wh nx = fi x + wid - nwh xmonad-contrib-0.12/XMonad/Layout/OnHost.hs0000644000000000000000000001561312636047674017004 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.OnHost -- Copyright : (c) Brandon S Allbery, Brent Yorgey -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Configure layouts on a per-host basis: use layouts and apply -- layout modifiers selectively, depending on the host. Heavily based on -- "XMonad.Layout.PerWorkspace" by Brent Yorgey. ----------------------------------------------------------------------------- module XMonad.Layout.OnHost (-- * Usage -- $usage OnHost ,onHost ,onHosts ,modHost ,modHosts ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier import Data.Maybe (fromMaybe) import System.Posix.Env (getEnv) -- $usage -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: -- -- > import XMonad.Layout.OnHost -- -- and modifying your 'layoutHook' as follows (for example): -- -- > layoutHook = modHost "baz" m1 $ -- apply layout modifier m1 to all layouts on host "baz" -- > onHost "foo" l1 $ -- layout l1 will be used on host "foo". -- > onHosts ["bar","quux"] l2 $ -- layout l2 will be used on hosts "bar" and "quux". -- > l3 -- layout l3 will be used on all other hosts. -- -- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated -- layouts, e.g. @(Full ||| smartBorders $ tabbed shrinkText -- defaultTConf ||| ...)@, and @m1@ can be any layout modifier, i.e. a -- function of type @(l a -> ModifiedLayout lm l a)@. -- -- In another scenario, suppose you wanted to have layouts A, B, and C -- available on all hosts, except that on host foo you want -- layout D instead of C. You could do that as follows: -- -- > layoutHook = A ||| B ||| onHost "foo" D C -- -- Note that we rely on '$HOST' being set in the environment, as is true on most -- modern systems; if it's not, you may want to use a wrapper around xmonad or -- perhaps use 'System.Posix.Env.setEnv' (or 'putEnv') to set it in 'main'. -- This is to avoid dragging in the network package as an xmonad dependency. -- If '$HOST' is not defined, it will behave as if the host name never matches. -- -- Also note that '$HOST' is usually a fully qualified domain name, not a short name. -- If you use a short name, this code will try to truncate $HOST to match; this may -- prove too magical, though, and may change in the future. -- | Specify one layout to use on a particular host, and another -- to use on all others. The second layout can be another call to -- 'onHost', and so on. onHost :: (LayoutClass l1 a, LayoutClass l2 a) => String -- ^ the name of the host to match -> (l1 a) -- ^ layout to use on the matched host -> (l2 a) -- ^ layout to use everywhere else -> OnHost l1 l2 a onHost host = onHosts [host] -- | Specify one layout to use on a particular set of hosts, and -- another to use on all other hosts. onHosts :: (LayoutClass l1 a, LayoutClass l2 a) => [String] -- ^ names of hosts to match -> (l1 a) -- ^ layout to use on matched hosts -> (l2 a) -- ^ layout to use everywhere else -> OnHost l1 l2 a onHosts hosts l1 l2 = OnHost hosts False l1 l2 -- | Specify a layout modifier to apply on a particular host; layouts -- on all other hosts will remain unmodified. modHost :: (LayoutClass l a) => String -- ^ name of the host to match -> (l a -> ModifiedLayout lm l a) -- ^ the modifier to apply on the matching host -> l a -- ^ the base layout -> OnHost (ModifiedLayout lm l) l a modHost host = modHosts [host] -- | Specify a layout modifier to apply on a particular set of -- hosts; layouts on all other hosts will remain -- unmodified. modHosts :: (LayoutClass l a) => [String] -- ^ names of the hosts to match -> (l a -> ModifiedLayout lm l a) -- ^ the modifier to apply on the matching hosts -> l a -- ^ the base layout -> OnHost (ModifiedLayout lm l) l a modHosts hosts f l = OnHost hosts False (f l) l -- | Structure for representing a host-specific layout along with -- a layout for all other hosts. We store the names of hosts -- to be matched, and the two layouts. We save the layout choice in -- the Bool, to be used to implement description. data OnHost l1 l2 a = OnHost [String] Bool (l1 a) (l2 a) deriving (Read, Show) instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (OnHost l1 l2) a where runLayout (W.Workspace i p@(OnHost hosts _ lt lf) ms) r = do h <- io $ getEnv "HOST" if maybe False (`elemFQDN` hosts) h then do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r return (wrs, Just $ mkNewOnHostT p mlt') else do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r return (wrs, Just $ mkNewOnHostF p mlt') handleMessage (OnHost hosts bool lt lf) m | bool = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ OnHost hosts bool nt lf) | otherwise = handleMessage lf m >>= maybe (return Nothing) (\nf -> return . Just $ OnHost hosts bool lt nf) description (OnHost _ True l1 _) = description l1 description (OnHost _ _ _ l2) = description l2 -- | Construct new OnHost values with possibly modified layouts. mkNewOnHostT :: OnHost l1 l2 a -> Maybe (l1 a) -> OnHost l1 l2 a mkNewOnHostT (OnHost hosts _ lt lf) mlt' = (\lt' -> OnHost hosts True lt' lf) $ fromMaybe lt mlt' mkNewOnHostF :: OnHost l1 l2 a -> Maybe (l2 a) -> OnHost l1 l2 a mkNewOnHostF (OnHost hosts _ lt lf) mlf' = (\lf' -> OnHost hosts False lt lf') $ fromMaybe lf mlf' -- | 'Data.List.elem' except that if one side has a dot and the other doesn't, we truncate -- the one that does at the dot. elemFQDN :: String -> [String] -> Bool elemFQDN _ [] = False elemFQDN h0 (h:hs) | h0 `eqFQDN` h = True | otherwise = elemFQDN h0 hs -- | String equality, possibly truncating one side at a dot. eqFQDN :: String -> String -> Bool eqFQDN a b | '.' `elem` a && '.' `elem` b = a == b | '.' `elem` a = takeWhile (/= '.') a == b | '.' `elem` b = a == takeWhile (/= '.') b | otherwise = a == b xmonad-contrib-0.12/XMonad/Layout/TrackFloating.hs0000644000000000000000000001301312636047674020312 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} {- | Module : XMonad.Layout.TrackFloating Copyright : (c) 2010 & 2013 Adam Vogt 2011 Willem Vanlint License : BSD-style (see xmonad/LICENSE) Maintainer : vogt.adam@gmail.com Stability : unstable Portability : unportable Layout modifier that tracks focus in the tiled layer while the floating layer is in use. This is particularly helpful for tiled layouts where the focus determines what is visible. The relevant bugs are Issue 4 and 306: , -} module XMonad.Layout.TrackFloating (-- * Usage -- $usage -- ** For other layout modifiers -- $layoutModifier trackFloating, useTransientFor, -- ** Exported types TrackFloating, UseTransientFor, ) where import Control.Monad import Data.Function import Data.List import Data.Maybe import qualified Data.Map as M import qualified Data.Set as S import XMonad import XMonad.Layout.LayoutModifier import qualified XMonad.StackSet as W import qualified Data.Traversable as T data TrackFloating a = TrackFloating { _wasFloating :: Bool, _tiledFocus :: Maybe Window } deriving (Read,Show,Eq) instance LayoutModifier TrackFloating Window where modifyLayoutWithUpdate os@(TrackFloating _wasF mw) ws@(W.Workspace{ W.stack = ms }) r = do winset <- gets windowset let xCur = fmap W.focus xStack xStack = W.stack $ W.workspace $ W.current winset isF = fmap (\x -> x `M.member` W.floating winset || (let (\\\) = (S.\\) `on` (S.fromList . W.integrate') in x `S.member` (xStack \\\ ms))) xCur newStack -- focus is floating, so use the remembered focus point | Just isF' <- isF, isF', Just w <- mw, Just s <- ms, Just ns <- find ((==) w . W.focus) $ zipWith const (iterate W.focusDown' s) (W.integrate s) = Just ns | otherwise = ms newState = case isF of Just True -> mw Just False | Just f <- xCur -> Just f _ -> Nothing ran <- runLayout ws{ W.stack = newStack } r return (ran, let n = TrackFloating (fromMaybe False isF) newState in guard (n /= os) >> Just n) {- | When focus is on the tiled layer, the underlying layout is run with focus on the window named by the WM_TRANSIENT_FOR property on the floating window. -} useTransientFor :: l a -> ModifiedLayout UseTransientFor l a useTransientFor x = ModifiedLayout UseTransientFor x data UseTransientFor a = UseTransientFor deriving (Read,Show,Eq) instance LayoutModifier UseTransientFor Window where modifyLayout _ ws@(W.Workspace{ W.stack = ms }) r = do m <- gets (W.peek . windowset) d <- asks display parent <- fmap join $ T.traverse (io . getTransientForHint d) m s0 <- get whenJust parent $ \p -> put s0{ windowset = W.focusWindow p (windowset s0) } result <- runLayout ws{ W.stack = fromMaybe ms (liftM2 focusWin ms parent) } r m' <- gets (W.peek . windowset) when (m' == parent) $ -- layout changed the windowset, so don't clobber it whenJust m $ \p -> put s0{ windowset = W.focusWindow p (windowset s0) } return result focusWin :: Eq a => W.Stack a -> a -> Maybe (W.Stack a) focusWin st@(W.Stack f u d) w | w `elem` u || w `elem` d = Just . head . filter ((==w) . W.focus) $ iterate (if w `elem` u then W.focusUp' else W.focusDown') st | w == f = Just st | otherwise = Nothing {- $usage Apply to your layout in a config like: > main = xmonad (def{ > layoutHook = trackFloating (useTransientFor > (noBorders Full ||| Tall 1 0.3 0.5)), > ... > }) 'useTransientFor' and 'trackFloating' can be enabled independently. For example when the floating window sets @WM_TRANSIENT_FOR@, such as libreoffice's file->preferences window, @optionA@ will have the last-focused window magnified while @optionB@ will result magnify the window that opened the preferences window regardless of which tiled window was focused before. > import XMonad.Layout.Magnifier > import XMonad.Layout.TrackFloating > > underlyingLayout = magnifier (Tall 1 0.3 0.5) > > optionA = trackFloating underlyingLayout > optionB = trackFloating (useTransientFor underlyingLayout) -} {- | Runs another layout with a remembered focus, provided: * the subset of windows doesn't include the focus in XState * it was previously run with a subset that included the XState focus * the remembered focus hasn't since been killed -} trackFloating :: l a -> ModifiedLayout TrackFloating l a trackFloating layout = ModifiedLayout (TrackFloating False Nothing) layout {- $layoutModifier It also corrects focus issues for full-like layouts inside other layout modifiers: > import XMonad.Layout.IM > import XMonad.Layout.Tabbed > import XMonad.Layout.TrackFloating > import XMonad.Layout.Reflect > gimpLayout = withIM 0.11 (Role "gimp-toolbox") $ reflectHoriz > $ withIM 0.15 (Role "gimp-dock") (trackFloating simpleTabbed) Interactions with some layout modifiers (ex. decorations, minimizing) are unknown but likely unpleasant. -} xmonad-contrib-0.12/XMonad/Layout/Renamed.hs0000644000000000000000000000536512636047674017150 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Groups -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Layout modifier that can modify the description of its underlying -- layout on a (hopefully) flexible way. -- ----------------------------------------------------------------------------- module XMonad.Layout.Renamed ( -- * Usage -- $usage renamed , Rename(..) ) where import XMonad import XMonad.Layout.LayoutModifier -- $usage -- You can use this module by adding -- -- > import XMonad.Layout.Renamed -- -- to your @~\/.xmonad\/xmonad.hs@. -- -- You can then use 'renamed' to modify the description of your -- layouts. For example: -- -- > myLayout = renamed [PrependWords "Awesome"] $ tiled ||| Mirror tiled ||| Full -- | Apply a list of 'Rename' values to a layout, from left to right. renamed :: [Rename a] -> l a -> ModifiedLayout Rename l a renamed = ModifiedLayout . Chain -- | The available renaming operations data Rename a = CutLeft Int -- ^ Remove a number of characters from the left | CutRight Int -- ^ Remove a number of characters from the right | Append String -- ^ Add a string on the right | Prepend String -- ^ Add a string on the left | CutWordsLeft Int -- ^ Remove a number of words from the left | CutWordsRight Int -- ^ Remove a number of words from the right | AppendWords String -- ^ Add a string to the right, prepending a space to it -- if necessary | PrependWords String -- ^ Add a string to the left, appending a space to it if -- necessary | Replace String -- ^ Repace with another wtring | Chain [Rename a] -- ^ Apply a list of modifications in left-to-right order deriving (Show, Read, Eq) apply :: Rename a -> String -> String apply (CutLeft i) s = drop i s apply (CutRight i) s = take (length s - i) s apply (CutWordsLeft i) s = unwords $ drop i $ words s apply (CutWordsRight i) s = let ws = words s in unwords $ take (length ws - i) ws apply (Replace s) _ = s apply (Append s') s = s ++ s' apply (Prepend s') s = s' ++ s apply (AppendWords s') s = unwords $ words s ++ [s'] apply (PrependWords s') s = unwords $ s' : words s apply (Chain rs) s = ($s) $ foldr (flip (.)) id $ map apply rs instance LayoutModifier Rename a where modifyDescription r l = apply r (description l)xmonad-contrib-0.12/XMonad/Layout/Fullscreen.hs0000644000000000000000000002216512636047674017674 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Fullscreen -- Copyright : (c) 2010 Audun Skaugen -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : audunskaugen@gmail.com -- Stability : unstable -- Portability : unportable -- -- Hooks for sending messages about fullscreen windows to layouts, and -- a few example layout modifier that implement fullscreen windows. ----------------------------------------------------------------------------- module XMonad.Layout.Fullscreen ( -- * Usage: -- $usage fullscreenSupport ,fullscreenFull ,fullscreenFocus ,fullscreenFullRect ,fullscreenFocusRect ,fullscreenFloat ,fullscreenFloatRect ,fullscreenEventHook ,fullscreenManageHook ,fullscreenManageHookWith ,FullscreenMessage(..) -- * Types for reference ,FullscreenFloat, FullscreenFocus, FullscreenFull ) where import XMonad import XMonad.Layout.LayoutModifier import XMonad.Util.WindowProperties import XMonad.Hooks.ManageHelpers (isFullscreen) import qualified XMonad.StackSet as W import Data.List import Data.Maybe import Data.Monoid import qualified Data.Map as M import Control.Monad import Control.Arrow (second) -- $usage -- Provides a ManageHook and an EventHook that sends layout messages -- with information about fullscreening windows. This allows layouts -- to make their own decisions about what they should to with a -- window that requests fullscreen. -- -- The module also includes a few layout modifiers as an illustration -- of how such layouts should behave. -- -- To use this module, add 'fullscreenEventHook' and 'fullscreenManageHook' -- to your config, i.e. -- -- > xmonad def { handleEventHook = fullscreenEventHook, -- > manageHook = fullscreenManageHook, -- > layoutHook = myLayouts } -- -- Now you can use layouts that respect fullscreen, for example the -- provided 'fullscreenFull': -- -- > myLayouts = fullscreenFull someLayout -- -- | Modifies your config to apply basic fullscreen support -- fullscreen -- windows when they request it. Example usage: -- -- > main = xmonad -- > $ fullscreenSupport -- > $ defaultConfig { ... } fullscreenSupport :: LayoutClass l Window => XConfig l -> XConfig (ModifiedLayout FullscreenFull l) fullscreenSupport c = c { layoutHook = fullscreenFull $ layoutHook c, handleEventHook = handleEventHook c <+> fullscreenEventHook, manageHook = manageHook c <+> fullscreenManageHook } -- | Messages that control the fullscreen state of the window. -- AddFullscreen and RemoveFullscreen are sent to all layouts -- when a window wants or no longer wants to be fullscreen. -- FullscreenChanged is sent to the current layout after one -- of the above have been sent. data FullscreenMessage = AddFullscreen Window | RemoveFullscreen Window | FullscreenChanged deriving (Typeable) instance Message FullscreenMessage data FullscreenFull a = FullscreenFull W.RationalRect [a] deriving (Read, Show) data FullscreenFocus a = FullscreenFocus W.RationalRect [a] deriving (Read, Show) data FullscreenFloat a = FullscreenFloat W.RationalRect (M.Map a (W.RationalRect, Bool)) deriving (Read, Show) instance LayoutModifier FullscreenFull Window where pureMess ff@(FullscreenFull frect fulls) m = case fromMessage m of Just (AddFullscreen win) -> Just $ FullscreenFull frect $ nub $ win:fulls Just (RemoveFullscreen win) -> Just $ FullscreenFull frect $ delete win $ fulls Just FullscreenChanged -> Just ff _ -> Nothing pureModifier (FullscreenFull frect fulls) rect _ list = (map (flip (,) rect') visfulls ++ rest, Nothing) where visfulls = intersect fulls $ map fst list rest = filter (flip notElem visfulls . fst) list rect' = scaleRationalRect rect frect instance LayoutModifier FullscreenFocus Window where pureMess ff@(FullscreenFocus frect fulls) m = case fromMessage m of Just (AddFullscreen win) -> Just $ FullscreenFocus frect $ nub $ win:fulls Just (RemoveFullscreen win) -> Just $ FullscreenFocus frect $ delete win $ fulls Just FullscreenChanged -> Just ff _ -> Nothing pureModifier (FullscreenFocus frect fulls) rect (Just (W.Stack {W.focus = f})) list | f `elem` fulls = ((f, rect') : rest, Nothing) | otherwise = (list, Nothing) where rest = filter ((/= f) . fst) list rect' = scaleRationalRect rect frect pureModifier _ _ Nothing list = (list, Nothing) instance LayoutModifier FullscreenFloat Window where handleMess (FullscreenFloat frect fulls) m = case fromMessage m of Just (AddFullscreen win) -> do mrect <- (M.lookup win . W.floating) `fmap` gets windowset return $ case mrect of Just rect -> Just $ FullscreenFloat frect $ M.insert win (rect,True) fulls Nothing -> Nothing Just (RemoveFullscreen win) -> return $ Just $ FullscreenFloat frect $ M.adjust (second $ const False) win fulls -- Modify the floating member of the stack set directly; this is the hackish part. Just FullscreenChanged -> do st <- get let ws = windowset st flt = W.floating ws flt' = M.intersectionWith doFull fulls flt put st {windowset = ws {W.floating = M.union flt' flt}} return $ Just $ FullscreenFloat frect $ M.filter snd fulls where doFull (_, True) _ = frect doFull (rect, False) _ = rect Nothing -> return Nothing -- | Layout modifier that makes fullscreened window fill the -- entire screen. fullscreenFull :: LayoutClass l a => l a -> ModifiedLayout FullscreenFull l a fullscreenFull = fullscreenFullRect $ W.RationalRect 0 0 1 1 -- | As above, but the fullscreened window will fill the -- specified rectangle instead of the entire screen. fullscreenFullRect :: LayoutClass l a => W.RationalRect -> l a -> ModifiedLayout FullscreenFull l a fullscreenFullRect r = ModifiedLayout $ FullscreenFull r [] -- | Layout modifier that makes the fullscreened window fill -- the entire screen only if it is currently focused. fullscreenFocus :: LayoutClass l a => l a -> ModifiedLayout FullscreenFocus l a fullscreenFocus = fullscreenFocusRect $ W.RationalRect 0 0 1 1 -- | As above, but the fullscreened window will fill the -- specified rectangle instead of the entire screen. fullscreenFocusRect :: LayoutClass l a => W.RationalRect -> l a -> ModifiedLayout FullscreenFocus l a fullscreenFocusRect r = ModifiedLayout $ FullscreenFocus r [] -- | Hackish layout modifier that makes floating fullscreened -- windows fill the entire screen. fullscreenFloat :: LayoutClass l a => l a -> ModifiedLayout FullscreenFloat l a fullscreenFloat = fullscreenFloatRect $ W.RationalRect 0 0 1 1 -- | As above, but the fullscreened window will fill the -- specified rectangle instead of the entire screen. fullscreenFloatRect :: LayoutClass l a => W.RationalRect -> l a -> ModifiedLayout FullscreenFloat l a fullscreenFloatRect r = ModifiedLayout $ FullscreenFloat r M.empty -- | The event hook required for the layout modifiers to work fullscreenEventHook :: Event -> X All fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do wmstate <- getAtom "_NET_WM_STATE" fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN" wstate <- fromMaybe [] `fmap` getProp32 wmstate win let fi :: (Integral i, Num n) => i -> n fi = fromIntegral isFull = fi fullsc `elem` wstate remove = 0 add = 1 toggle = 2 ptype = 4 chWState f = io $ changeProperty32 dpy win wmstate ptype propModeReplace (f wstate) when (typ == wmstate && fi fullsc `elem` dats) $ do when (action == add || (action == toggle && not isFull)) $ do chWState (fi fullsc:) broadcastMessage $ AddFullscreen win sendMessage FullscreenChanged when (action == remove || (action == toggle && isFull)) $ do chWState $ delete (fi fullsc) broadcastMessage $ RemoveFullscreen win sendMessage FullscreenChanged return $ All True fullscreenEventHook (DestroyWindowEvent {ev_window = w}) = do -- When a window is destroyed, the layouts should remove that window -- from their states. broadcastMessage $ RemoveFullscreen w cw <- (W.workspace . W.current) `fmap` gets windowset sendMessageWithNoRefresh FullscreenChanged cw return $ All True fullscreenEventHook _ = return $ All True -- | Manage hook that sets the fullscreen property for -- windows that are initially fullscreen fullscreenManageHook :: ManageHook fullscreenManageHook = fullscreenManageHook' isFullscreen -- | A version of fullscreenManageHook that lets you specify -- your own query to decide whether a window should be fullscreen. fullscreenManageHookWith :: Query Bool -> ManageHook fullscreenManageHookWith h = fullscreenManageHook' $ isFullscreen <||> h fullscreenManageHook' :: Query Bool -> ManageHook fullscreenManageHook' isFull = isFull --> do w <- ask liftX $ do broadcastMessage $ AddFullscreen w cw <- (W.workspace . W.current) `fmap` gets windowset sendMessageWithNoRefresh FullscreenChanged cw idHook xmonad-contrib-0.12/XMonad/Layout/Spiral.hs0000644000000000000000000001146312636047674017023 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Spiral -- Copyright : (c) Joe Thornber -- License : BSD3-style (see LICENSE) -- -- Maintainer : Joe Thornber -- Stability : stable -- Portability : portable -- -- A spiral tiling layout. -- ----------------------------------------------------------------------------- module XMonad.Layout.Spiral ( -- * Usage -- $usage spiral , spiralWithDir , Rotation (..) , Direction (..) , SpiralWithDir ) where import Data.Ratio import XMonad hiding ( Rotation ) import XMonad.StackSet ( integrate ) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Spiral -- -- Then edit your @layoutHook@ by adding the Spiral layout: -- -- > myLayout = spiral (6/7) ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" fibs :: [Integer] fibs = 1 : 1 : zipWith (+) fibs (tail fibs) mkRatios :: [Integer] -> [Rational] mkRatios (x1:x2:xs) = (x1 % x2) : mkRatios (x2:xs) mkRatios _ = [] data Rotation = CW | CCW deriving (Read, Show) data Direction = East | South | West | North deriving (Eq, Enum, Read, Show) blend :: Rational -> [Rational] -> [Rational] blend scale ratios = zipWith (+) ratios scaleFactors where len = length ratios step = (scale - (1 % 1)) / (fromIntegral len) scaleFactors = map (* step) . reverse . take len $ [0..] -- | A spiral layout. The parameter controls the size ratio between -- successive windows in the spiral. Sensible values range from 0 -- up to the aspect ratio of your monitor (often 4\/3). -- -- By default, the spiral is counterclockwise, starting to the east. -- See also 'spiralWithDir'. spiral :: Rational -> SpiralWithDir a spiral = spiralWithDir East CW -- | Create a spiral layout, specifying the starting cardinal direction, -- the spiral direction (clockwise or counterclockwise), and the -- size ratio. spiralWithDir :: Direction -> Rotation -> Rational -> SpiralWithDir a spiralWithDir = SpiralWithDir data SpiralWithDir a = SpiralWithDir Direction Rotation Rational deriving ( Read, Show ) instance LayoutClass SpiralWithDir a where pureLayout (SpiralWithDir dir rot scale) sc stack = zip ws rects where ws = integrate stack ratios = blend scale . reverse . take (length ws - 1) . mkRatios $ tail fibs rects = divideRects (zip ratios dirs) sc dirs = dropWhile (/= dir) $ case rot of CW -> cycle [East .. North] CCW -> cycle [North, West, South, East] handleMessage (SpiralWithDir dir rot scale) = return . fmap resize . fromMessage where resize Expand = spiralWithDir dir rot $ (21 % 20) * scale resize Shrink = spiralWithDir dir rot $ (20 % 21) * scale description _ = "Spiral" -- This will produce one more rectangle than there are splits details divideRects :: [(Rational, Direction)] -> Rectangle -> [Rectangle] divideRects [] r = [r] divideRects ((r,d):xs) rect = case divideRect r d rect of (r1, r2) -> r1 : (divideRects xs r2) -- It's much simpler if we work with all Integers and convert to -- Rectangle at the end. data Rect = Rect Integer Integer Integer Integer fromRect :: Rect -> Rectangle fromRect (Rect x y w h) = Rectangle (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) toRect :: Rectangle -> Rect toRect (Rectangle x y w h) = Rect (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) divideRect :: Rational -> Direction -> Rectangle -> (Rectangle, Rectangle) divideRect r d rect = let (r1, r2) = divideRect' r d $ toRect rect in (fromRect r1, fromRect r2) divideRect' :: Rational -> Direction -> Rect -> (Rect, Rect) divideRect' ratio dir (Rect x y w h) = case dir of East -> let (w1, w2) = chop ratio w in (Rect x y w1 h, Rect (x + w1) y w2 h) South -> let (h1, h2) = chop ratio h in (Rect x y w h1, Rect x (y + h1) w h2) West -> let (w1, w2) = chop (1 - ratio) w in (Rect (x + w1) y w2 h, Rect x y w1 h) North -> let (h1, h2) = chop (1 - ratio) h in (Rect x (y + h1) w h2, Rect x y w h1) chop :: Rational -> Integer -> (Integer, Integer) chop rat n = let f = ((fromIntegral n) * (numerator rat)) `div` (denominator rat) in (f, n - f) xmonad-contrib-0.12/XMonad/Layout/DecorationAddons.hs0000644000000000000000000001351612636047674021012 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.DecorationAddons -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- Various stuff that can be added to the decoration. Most of it -- is intended to be used by other modules. See -- "XMonad.Layout.ButtonDecoration" for a module that makes use of this. -- ----------------------------------------------------------------------------- module XMonad.Layout.DecorationAddons ( titleBarButtonHandler ,defaultThemeWithButtons ,handleScreenCrossing ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Layout.Decoration import XMonad.Actions.WindowMenu import XMonad.Layout.Minimize import XMonad.Layout.Maximize import XMonad.Hooks.ManageDocks import XMonad.Util.Font import XMonad.Util.PositionStore import Control.Applicative((<$>)) import Data.Maybe import qualified Data.Set as S minimizeButtonOffset :: Int minimizeButtonOffset = 48 maximizeButtonOffset :: Int maximizeButtonOffset = 25 closeButtonOffset :: Int closeButtonOffset = 10 buttonSize :: Int buttonSize = 10 -- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration. -- It will intercept clicks on the buttons of the decoration and invoke the associated action. -- To actually see the buttons, you will need to use a theme that includes them. -- See 'defaultThemeWithButtons' below. titleBarButtonHandler :: Window -> Int -> Int -> X Bool titleBarButtonHandler mainw distFromLeft distFromRight = do let action = if (fi distFromLeft <= 3 * buttonSize) then focus mainw >> windowMenu >> return True else if (fi distFromRight >= closeButtonOffset && fi distFromRight <= closeButtonOffset + buttonSize) then focus mainw >> kill >> return True else if (fi distFromRight >= maximizeButtonOffset && fi distFromRight <= maximizeButtonOffset + (2 * buttonSize)) then focus mainw >> sendMessage (maximizeRestore mainw) >> return True else if (fi distFromRight >= minimizeButtonOffset && fi distFromRight <= minimizeButtonOffset + buttonSize) then focus mainw >> minimizeWindow mainw >> return True else return False action -- | Intended to be used together with 'titleBarButtonHandler'. See above. defaultThemeWithButtons :: Theme defaultThemeWithButtons = def { windowTitleAddons = [ (" (M)", AlignLeft) , ("_" , AlignRightOffset minimizeButtonOffset) , ("[]" , AlignRightOffset maximizeButtonOffset) , ("X" , AlignRightOffset closeButtonOffset) ] } -- | A function intended to be plugged into the 'decorationAfterDraggingHook' of a decoration. -- It will check if the window has been dragged onto another screen and shift it there. -- The PositionStore is also updated accordingly, as this is designed to be used together -- with "XMonad.Layout.PositionStoreFloat". handleScreenCrossing :: Window -> Window -> X Bool handleScreenCrossing w decoWin = withDisplay $ \d -> do root <- asks theRoot (_, _, _, px, py, _, _, _) <- io $ queryPointer d root ws <- gets windowset sc <- fromMaybe (W.current ws) <$> pointScreen (fi px) (fi py) maybeWksp <- screenWorkspace $ W.screen sc let targetWksp = maybeWksp >>= \wksp -> W.findTag w ws >>= \currentWksp -> if (currentWksp /= wksp) then Just wksp else Nothing case targetWksp of Just wksp -> do -- find out window under cursor on target workspace -- apparently we have to switch to the workspace first -- to make this work, which unforunately introduces some flicker windows $ \ws' -> W.view wksp ws' (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root -- adjust PositionStore let oldScreenRect = screenRect . W.screenDetail $ W.current ws newScreenRect = screenRect . W.screenDetail $ sc {-- somewhat ugly hack to get proper ScreenRect, creates unwanted inter-dependencies TODO: get ScreenRects in a proper way --} oldScreenRect' <- fmap ($ oldScreenRect) (calcGap $ S.fromList [minBound .. maxBound]) newScreenRect' <- fmap ($ newScreenRect) (calcGap $ S.fromList [minBound .. maxBound]) wa <- io $ getWindowAttributes d decoWin modifyPosStore (\ps -> posStoreMove ps w (fi $ wa_x wa) (fi $ wa_y wa) oldScreenRect' newScreenRect') -- set focus correctly so the window will be inserted -- at the correct position on the target workspace -- and then shift the window windows $ \ws' -> W.shiftWin wksp w . W.focusWindow selWin $ ws' -- return True to signal that screen crossing has taken place return True Nothing -> return False xmonad-contrib-0.12/XMonad/Layout/WindowNavigation.hs0000644000000000000000000002603012636047674021054 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.WindowNavigation -- Copyright : (c) 2007 David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : Devin Mullins -- Stability : unstable -- Portability : unportable -- -- WindowNavigation is an extension to allow easy navigation of a workspace. -- ----------------------------------------------------------------------------- module XMonad.Layout.WindowNavigation ( -- * Usage -- $usage windowNavigation, configurableNavigation, Navigate(..), Direction2D(..), MoveWindowToWindow(..), navigateColor, navigateBrightness, noNavigateBorders, defaultWNConfig, def, WNConfig, WindowNavigation, ) where import Data.List ( nub, sortBy, (\\) ) import XMonad hiding (Point) import qualified XMonad.StackSet as W import XMonad.Layout.LayoutModifier import XMonad.Util.Invisible import XMonad.Util.Types (Direction2D(..)) import XMonad.Util.XUtils -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.WindowNavigation -- -- Then edit your @layoutHook@ by adding the WindowNavigation layout modifier -- to some layout: -- -- > myLayout = windowNavigation (Tall 1 (3/100) (1/2)) ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" -- -- In keybindings: -- -- > , ((modm, xK_Right), sendMessage $ Go R) -- > , ((modm, xK_Left ), sendMessage $ Go L) -- > , ((modm, xK_Up ), sendMessage $ Go U) -- > , ((modm, xK_Down ), sendMessage $ Go D) -- > , ((modm .|. controlMask, xK_Right), sendMessage $ Swap R) -- > , ((modm .|. controlMask, xK_Left ), sendMessage $ Swap L) -- > , ((modm .|. controlMask, xK_Up ), sendMessage $ Swap U) -- > , ((modm .|. controlMask, xK_Down ), sendMessage $ Swap D) -- -- For detailed instruction on editing the key binding see: -- -- "XMonad.Doc.Extending#Editing_key_bindings". data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( Read, Show, Typeable ) instance Typeable a => Message (MoveWindowToWindow a) data Navigate = Go Direction2D | Swap Direction2D | Move Direction2D | Apply (Window -> X()) Direction2D -- ^ Apply action with destination window deriving ( Typeable ) instance Message Navigate data WNConfig = WNC { brightness :: Maybe Double -- Indicates a fraction of the focus color. , upColor :: String , downColor :: String , leftColor :: String , rightColor :: String } deriving (Show, Read) noNavigateBorders :: WNConfig noNavigateBorders = def {brightness = Just 0} navigateColor :: String -> WNConfig navigateColor c = WNC Nothing c c c c navigateBrightness :: Double -> WNConfig navigateBrightness f = def { brightness = Just $ max 0 $ min 1 f } instance Default WNConfig where def = WNC (Just 0.4) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF" {-# DEPRECATED defaultWNConfig "Use def (from Data.Default, and re-exported by XMonad.Layout.WindowNavigation) instead." #-} defaultWNConfig :: WNConfig defaultWNConfig = def data NavigationState a = NS Point [(a,Rectangle)] data WindowNavigation a = WindowNavigation WNConfig (Invisible Maybe (NavigationState a)) deriving ( Read, Show ) windowNavigation :: LayoutClass l a => l a -> ModifiedLayout WindowNavigation l a windowNavigation = ModifiedLayout (WindowNavigation def (I Nothing)) configurableNavigation :: LayoutClass l a => WNConfig -> l a -> ModifiedLayout WindowNavigation l a configurableNavigation conf = ModifiedLayout (WindowNavigation conf (I Nothing)) instance LayoutModifier WindowNavigation Window where redoLayout (WindowNavigation conf (I st)) rscr (Just s) origwrs = do XConf { normalBorder = nbc, focusedBorder = fbc, display = dpy } <- ask [uc,dc,lc,rc] <- case brightness conf of Just frac -> do myc <- averagePixels fbc nbc frac return [myc,myc,myc,myc] Nothing -> mapM (stringToPixel dpy) [upColor conf, downColor conf, leftColor conf, rightColor conf] let dirc U = uc dirc D = dc dirc L = lc dirc R = rc let w = W.focus s r = case filter ((==w).fst) origwrs of ((_,x):_) -> x [] -> rscr pt = case st of Just (NS ptold _) | ptold `inrect` r -> ptold _ -> center r existing_wins = W.integrate s wrs = filter ((`elem` existing_wins) . fst) $ filter ((/=r) . snd) $ filter ((/=w) . fst) origwrs wnavigable = nub $ concatMap (\d -> take 1 $ navigable d pt wrs) [U,D,R,L] wnavigablec = nub $ concatMap (\d -> map (\(win,_) -> (win,dirc d)) $ take 1 $ navigable d pt wrs) [U,D,R,L] wothers = case st of Just (NS _ wo) -> map fst wo _ -> [] mapM_ (sc nbc) (wothers \\ map fst wnavigable) mapM_ (\(win,c) -> sc c win) wnavigablec return (origwrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable) redoLayout _ _ _ origwrs = return (origwrs, Nothing) handleMessOrMaybeModifyIt (WindowNavigation conf (I (Just (NS pt wrs)))) m | Just (Go d) <- fromMessage m = case navigable d pt wrs of [] -> return Nothing ((w,r):_) -> do modify focusWindowHere return $ Just $ Left $ WindowNavigation conf $ I $ Just $ NS (centerd d pt r) wrs where focusWindowHere :: XState -> XState focusWindowHere s | Just w == W.peek (windowset s) = s | has w $ W.stack $ W.workspace $ W.current $ windowset s = s { windowset = until ((Just w ==) . W.peek) W.focusUp $ windowset s } | otherwise = s has _ Nothing = False has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr) | Just (Swap d) <- fromMessage m = case navigable d pt wrs of [] -> return Nothing ((w,_):_) -> do let swap st = unint (W.focus st) $ map (swapw (W.focus st)) $ W.integrate st swapw y x | x == w = y | x == y = w | otherwise = x unint f xs = case span (/= f) xs of (u,_:dn) -> W.Stack { W.focus = f , W.up = reverse u , W.down = dn } _ -> W.Stack { W.focus = f , W.down = xs , W.up = [] } windows $ W.modify' swap return Nothing | Just (Move d) <- fromMessage m = case navigable d pt wrs of [] -> return Nothing ((w,_):_) -> do mst <- gets (W.stack . W.workspace . W.current . windowset) return $ do st <- mst Just $ Right $ SomeMessage $ MoveWindowToWindow (W.focus st) w | Just (Apply f d) <- fromMessage m = case navigable d pt wrs of [] -> return Nothing ((w,_):_) -> f w >> return Nothing | Just Hide <- fromMessage m = do XConf { normalBorder = nbc } <- ask mapM_ (sc nbc . fst) wrs return $ Just $ Left $ WindowNavigation conf $ I $ Just $ NS pt [] | Just ReleaseResources <- fromMessage m = handleMessOrMaybeModifyIt (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide) handleMessOrMaybeModifyIt _ _ = return Nothing navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] navigable d pt = sortby d . filter (inr d pt . snd) sc :: Pixel -> Window -> X () sc c win = withDisplay $ \dpy -> io $ setWindowBorder dpy win c center :: Rectangle -> Point center (Rectangle x y w h) = P (fromIntegral x + fromIntegral w/2) (fromIntegral y + fromIntegral h/2) centerd :: Direction2D -> Point -> Rectangle -> Point centerd d (P xx yy) (Rectangle x y w h) | d == U || d == D = P xx (fromIntegral y + fromIntegral h/2) | otherwise = P (fromIntegral x + fromIntegral w/2) yy inr :: Direction2D -> Point -> Rectangle -> Bool inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && y < fromIntegral yr + fromIntegral h inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && y > fromIntegral yr inr R (P a x) (Rectangle b l _ w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && a < fromIntegral b inr L (P a x) (Rectangle b l c w) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w && a > fromIntegral b + fromIntegral c inrect :: Point -> Rectangle -> Bool inrect (P x y) (Rectangle a b w h) = x > fromIntegral a && x < fromIntegral a + fromIntegral w && y > fromIntegral b && y < fromIntegral b + fromIntegral h sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)] sortby U = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y' y) sortby D = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y y') sortby R = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x x') sortby L = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x' x) data Point = P Double Double xmonad-contrib-0.12/XMonad/Layout/Circle.hs0000644000000000000000000000522112636047674016765 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Circle -- Copyright : (c) Peter De Wachter -- License : BSD-style (see LICENSE) -- -- Maintainer : Peter De Wachter -- Stability : unstable -- Portability : unportable -- -- Circle is an elliptical, overlapping layout, by Peter De Wachter -- ----------------------------------------------------------------------------- module XMonad.Layout.Circle ( -- * Usage -- $usage Circle (..) ) where -- actually it's an ellipse import Data.List import XMonad import XMonad.StackSet (integrate, peek) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.Circle -- -- Then edit your @layoutHook@ by adding the Circle layout: -- -- > myLayout = Circle ||| Full ||| etc.. -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" data Circle a = Circle deriving ( Read, Show ) instance LayoutClass Circle Window where doLayout Circle r s = do layout <- raiseFocus $ circleLayout r $ integrate s return (layout, Nothing) circleLayout :: Rectangle -> [a] -> [(a, Rectangle)] circleLayout _ [] = [] circleLayout r (w:ws) = master : rest where master = (w, center r) rest = zip ws $ map (satellite r) [0, pi * 2 / fromIntegral (length ws) ..] raiseFocus :: [(Window, Rectangle)] -> X [(Window, Rectangle)] raiseFocus xs = do focused <- withWindowSet (return . peek) return $ case find ((== focused) . Just . fst) xs of Just x -> x : delete x xs Nothing -> xs center :: Rectangle -> Rectangle center (Rectangle sx sy sw sh) = Rectangle x y w h where s = sqrt 2 :: Double w = round (fromIntegral sw / s) h = round (fromIntegral sh / s) x = sx + fromIntegral (sw - w) `div` 2 y = sy + fromIntegral (sh - h) `div` 2 satellite :: Rectangle -> Double -> Rectangle satellite (Rectangle sx sy sw sh) a = Rectangle (sx + round (rx + rx * cos a)) (sy + round (ry + ry * sin a)) w h where rx = fromIntegral (sw - w) / 2 ry = fromIntegral (sh - h) / 2 w = sw * 10 `div` 25 h = sh * 10 `div` 25 xmonad-contrib-0.12/XMonad/Layout/HintedTile.hs0000644000000000000000000001176412636047674017626 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.HintedTile -- Copyright : (c) Peter De Wachter -- License : BSD3-style (see LICENSE) -- -- Maintainer : Peter De Wachter -- Andrea Rossato -- Stability : unstable -- Portability : unportable -- -- A gapless tiled layout that attempts to obey window size hints, -- rather than simply ignoring them. -- ----------------------------------------------------------------------------- module XMonad.Layout.HintedTile ( -- * Usage -- $usage HintedTile(..), Orientation(..), Alignment(..) ) where import XMonad hiding (Tall(..)) import qualified XMonad.StackSet as W import Control.Monad -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Layout.HintedTile -- -- Then edit your @layoutHook@ by adding the HintedTile layout: -- -- > myLayout = hintedTile Tall ||| hintedTile Wide ||| Full ||| etc.. -- > where -- > hintedTile = HintedTile nmaster delta ratio TopLeft -- > nmaster = 1 -- > ratio = 1/2 -- > delta = 3/100 -- > main = xmonad def { layoutHook = myLayout } -- -- Because both Xmonad and Xmonad.Layout.HintedTile define Tall, -- you need to disambiguate Tall. If you are replacing the -- built-in Tall with HintedTile, change @import Xmonad@ to -- @import Xmonad hiding (Tall)@. -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" data HintedTile a = HintedTile { nmaster :: !Int -- ^ number of windows in the master pane , delta :: !Rational -- ^ how much to change when resizing , frac :: !Rational -- ^ ratio between master/nonmaster panes , alignment :: !Alignment -- ^ Where to place windows that are smaller -- than their preordained rectangles. , orientation :: !Orientation -- ^ Tall or Wide (mirrored) layout? } deriving ( Show, Read ) data Orientation = Wide -- ^ Lay out windows similarly to Mirror tiled. | Tall -- ^ Lay out windows similarly to tiled. deriving ( Show, Read, Eq, Ord ) data Alignment = TopLeft | Center | BottomRight deriving ( Show, Read, Eq, Ord ) instance LayoutClass HintedTile Window where doLayout (HintedTile { orientation = o, nmaster = nm, frac = f, alignment = al }) r w' = do bhs <- mapM mkAdjust w let (masters, slaves) = splitAt nm bhs return (zip w (tiler masters slaves), Nothing) where w = W.integrate w' tiler masters slaves | null masters || null slaves = divide al o (masters ++ slaves) r | otherwise = split o f r (divide al o masters) (divide al o slaves) pureMessage c m = fmap resize (fromMessage m) `mplus` fmap incmastern (fromMessage m) where resize Shrink = c { frac = max 0 $ frac c - delta c } resize Expand = c { frac = min 1 $ frac c + delta c } incmastern (IncMasterN d) = c { nmaster = max 0 $ nmaster c + d } description l = show (orientation l) align :: Alignment -> Position -> Dimension -> Dimension -> Position align TopLeft p _ _ = p align Center p a b = p + fromIntegral (a - b) `div` 2 align BottomRight p a b = p + fromIntegral (a - b) -- Divide the screen vertically (horizontally) into n subrectangles divide :: Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle] divide _ _ [] _ = [] divide al _ [bh] (Rectangle sx sy sw sh) = [Rectangle (align al sx sw w) (align al sy sh h) w h] where (w, h) = bh (sw, sh) divide al Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle (align al sx sw w) sy w h) : (divide al Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h))) where (w, h) = bh (sw, sh `div` fromIntegral (1 + (length bhs))) divide al Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx (align al sy sh h) w h) : (divide al Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh)) where (w, h) = bh (sw `div` fromIntegral (1 + (length bhs)), sh) -- Split the screen into two rectangles, using a rational to specify the ratio split :: Orientation -> Rational -> Rectangle -> (Rectangle -> [Rectangle]) -> (Rectangle -> [Rectangle]) -> [Rectangle] split Tall f (Rectangle sx sy sw sh) left right = leftRects ++ rightRects where leftw = floor $ fromIntegral sw * f leftRects = left $ Rectangle sx sy leftw sh rightx = (maximum . map rect_width) leftRects rightRects = right $ Rectangle (sx + fromIntegral rightx) sy (sw - rightx) sh split Wide f (Rectangle sx sy sw sh) top bottom = topRects ++ bottomRects where toph = floor $ fromIntegral sh * f topRects = top $ Rectangle sx sy sw toph bottomy = (maximum . map rect_height) topRects bottomRects = bottom $ Rectangle sx (sy + fromIntegral bottomy) sw (sh - bottomy) xmonad-contrib-0.12/XMonad/Layout/Groups/0000755000000000000000000000000012636047674016507 5ustar0000000000000000xmonad-contrib-0.12/XMonad/Layout/Groups/Wmii.hs0000644000000000000000000001073612636047674017757 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE MultiParamTypeClasses, Rank2Types #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Groups.Wmii -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : stable -- Portability : unportable -- -- A wmii-like layout algorithm. -- ----------------------------------------------------------------------------- module XMonad.Layout.Groups.Wmii ( -- * Usage -- $usage wmii , zoomGroupIn , zoomGroupOut , zoomGroupReset , toggleGroupFull , groupToNextLayout , groupToFullLayout , groupToTabbedLayout , groupToVerticalLayout -- * Useful re-exports , shrinkText , def , defaultTheme , module XMonad.Layout.Groups.Helpers ) where import XMonad hiding ((|||)) import qualified XMonad.Layout.Groups as G import XMonad.Layout.Groups.Examples import XMonad.Layout.Groups.Helpers import XMonad.Layout.Tabbed import XMonad.Layout.Named import XMonad.Layout.Renamed import XMonad.Layout.LayoutCombinators import XMonad.Layout.MessageControl import XMonad.Layout.Simplest -- $usage -- This module provides a layout inspired by the one used by the wmii -- () window manager. -- Windows are arranged into groups in a horizontal row, and each group can lay out -- its windows -- -- * by maximizing the focused one -- -- * by tabbing them (wmii uses a stacked layout, but I'm too lazy to write it) -- -- * by arranging them in a column. -- -- As the groups are arranged in a 'ZoomRow', the relative width of each group can be -- increased or decreased at will. Groups can also be set to use the whole screen -- whenever they have focus. -- -- You can use the contents of this module by adding -- -- > import XMonad.Layout.Groups.Wmii -- -- to the top of your @.\/.xmonad\/xmonad.hs@, and adding 'wmii' -- (with a 'Shrinker' and decoration 'Theme' as -- parameters) to your layout hook, for example: -- -- > myLayout = wmii shrinkText def -- -- To be able to zoom in and out of groups, change their inner layout, etc., -- create key bindings for the relevant actions: -- -- > ((modMask, xK_f), toggleGroupFull) -- -- and so on. -- -- For more information on how to extend your layout hook and key bindings, see -- "XMonad.Doc.Extending". -- -- Finally, you will probably want to be able to move focus and windows -- between groups in a consistent fashion. For this, you should take a look -- at the "XMonad.Layout.Groups.Helpers" module, whose contents are re-exported -- by this module. -- | A layout inspired by wmii wmii s t = G.group innerLayout zoomRowG where column = named "Column" $ Tall 0 (3/100) (1/2) tabs = named "Tabs" $ Simplest innerLayout = renamed [CutWordsLeft 3] $ addTabs s t $ ignore NextLayout $ ignore (JumpToLayout "") $ unEscape $ column ||| tabs ||| Full -- | Increase the width of the focused group zoomGroupIn :: X () zoomGroupIn = zoomColumnIn -- | Decrease the size of the focused group zoomGroupOut :: X () zoomGroupOut = zoomColumnOut -- | Reset the size of the focused group to the default zoomGroupReset :: X () zoomGroupReset = zoomColumnReset -- | Toggle whether the currently focused group should be maximized -- whenever it has focus. toggleGroupFull :: X () toggleGroupFull = toggleGroupFull -- | Rotate the layouts in the focused group. groupToNextLayout :: X () groupToNextLayout = sendMessage $ escape NextLayout -- | Switch the focused group to the \"maximized\" layout. groupToFullLayout :: X () groupToFullLayout = sendMessage $ escape $ JumpToLayout "Full" -- | Switch the focused group to the \"tabbed\" layout. groupToTabbedLayout :: X () groupToTabbedLayout = sendMessage $ escape $ JumpToLayout "Tabs" -- | Switch the focused group to the \"column\" layout. groupToVerticalLayout :: X () groupToVerticalLayout = sendMessage $ escape $ JumpToLayout "Column" xmonad-contrib-0.12/XMonad/Layout/Groups/Examples.hs0000644000000000000000000002144412636047674020626 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE MultiParamTypeClasses, Rank2Types, TypeFamilies #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Groups.Examples -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Example layouts for "XMonad.Layout.Groups". -- ----------------------------------------------------------------------------- module XMonad.Layout.Groups.Examples ( -- * Usage -- $usage -- * Example: Row of columns -- $example1 rowOfColumns , zoomColumnIn , zoomColumnOut , zoomColumnReset , toggleColumnFull , zoomWindowIn , zoomWindowOut , zoomWindowReset , toggleWindowFull -- * Example: Tiled tab groups -- $example2 , tallTabs , mirrorTallTabs , fullTabs , TiledTabsConfig(..) , def , defaultTiledTabsConfig , increaseNMasterGroups , decreaseNMasterGroups , shrinkMasterGroups , expandMasterGroups , nextOuterLayout -- * Useful re-exports and utils , module XMonad.Layout.Groups.Helpers , shrinkText , defaultTheme , GroupEQ(..) , zoomRowG ) where import XMonad hiding ((|||)) import qualified XMonad.Layout.Groups as G import XMonad.Layout.Groups.Helpers import XMonad.Layout.ZoomRow import XMonad.Layout.Tabbed import XMonad.Layout.Named import XMonad.Layout.Renamed import XMonad.Layout.LayoutCombinators import XMonad.Layout.Decoration import XMonad.Layout.Simplest -- $usage -- This module contains example 'G.Groups'-based layouts. -- You can either import this module directly, or look at its source -- for ideas of how "XMonad.Layout.Groups" may be used. -- -- You can use the contents of this module by adding -- -- > import XMonad.Layout.Groups.Examples -- -- to the top of your @.\/.xmonad\/xmonad.hs@. -- -- For more information on using any of the layouts, jump directly -- to its \"Example\" section. -- -- Whichever layout you choose to use, you will probably want to be -- able to move focus and windows between groups in a consistent -- manner. For this, you should take a look at the functions from -- the "XMonad.Layout.Groups.Helpers" module, which are all -- re-exported by this module. -- -- For more information on how to extend your layour hook and key bindings, see -- "XMonad.Doc.Extending". -- * Helper: ZoomRow of Group elements -- | Compare two 'Group's by comparing the ids of their layouts. data GroupEQ a = GroupEQ deriving (Show, Read) instance Eq a => EQF GroupEQ (G.Group l a) where eq _ (G.G l1 _) (G.G l2 _) = G.sameID l1 l2 zoomRowG :: (Eq a, Show a, Read a, Show (l a), Read (l a)) => ZoomRow GroupEQ (G.Group l a) zoomRowG = zoomRowWith GroupEQ -- * Example 1: Row of columns -- $example1 -- A layout that arranges windows in a row of columns. It uses 'ZoomRow's for -- both, allowing you to: -- -- * Freely change the proportion of the screen width allocated to each column -- -- * Freely change the proportion of a column's heigth allocated to each of its windows -- -- * Set a column to occupy the whole screen space whenever it has focus -- -- * Set a window to occupy its whole column whenever it has focus -- -- to use this layout, add 'rowOfColumns' to your layout hook, for example: -- -- > myLayout = rowOfColumns -- -- To be able to change the sizes of columns and windows, you can create key bindings -- for the relevant actions: -- -- > ((modMask, xK_minus), zoomWindowOut) -- -- and so on. rowOfColumns = G.group column zoomRowG where column = renamed [CutWordsLeft 2, PrependWords "ZoomColumn"] $ Mirror zoomRow -- | Increase the width of the focused column zoomColumnIn :: X () zoomColumnIn = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomIn -- | Decrease the width of the focused column zoomColumnOut :: X () zoomColumnOut = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomOut -- | Reset the width of the focused column zoomColumnReset :: X () zoomColumnReset = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomReset -- | Toggle whether the currently focused column should -- take up all available space whenever it has focus toggleColumnFull :: X () toggleColumnFull = sendMessage $ G.ToEnclosing $ SomeMessage $ ZoomFullToggle -- | Increase the heigth of the focused window zoomWindowIn :: X () zoomWindowIn = sendMessage zoomIn -- | Decrease the height of the focused window zoomWindowOut :: X () zoomWindowOut = sendMessage zoomOut -- | Reset the height of the focused window zoomWindowReset :: X () zoomWindowReset = sendMessage zoomReset -- | Toggle whether the currently focused window should -- take up the whole column whenever it has focus toggleWindowFull :: X () toggleWindowFull = sendMessage ZoomFullToggle -- * Example 2: Tabbed groups in a Tall/Full layout. -- $example2 -- A layout which arranges windows into tabbed groups, and the groups -- themselves according to XMonad's default algorithm -- (@'Tall' ||| 'Mirror' 'Tall' ||| 'Full'@). As their names -- indicate, 'tallTabs' starts as 'Tall', 'mirrorTallTabs' starts -- as 'Mirror' 'Tall' and 'fullTabs' starts as 'Full', but in any -- case you can freely switch between the three afterwards. -- -- You can use any of these three layouts by including it in your layout hook. -- You will need to provide it with a 'TiledTabsConfig' containing the size -- parameters for 'Tall' and 'Mirror' 'Tall', and the shrinker and decoration theme -- for the tabs. If you're happy with defaults, you can use 'def': -- -- > myLayout = tallTabs def -- -- To be able to increase\/decrease the number of master groups and shrink\/expand -- the master area, you can create key bindings for the relevant actions: -- -- > ((modMask, xK_h), shrinkMasterGroups) -- -- and so on. -- | Configuration data for the "tiled tab groups" layout data TiledTabsConfig s = TTC { vNMaster :: Int , vRatio :: Rational , vIncrement :: Rational , hNMaster :: Int , hRatio :: Rational , hIncrement :: Rational , tabsShrinker :: s , tabsTheme :: Theme } instance s ~ DefaultShrinker => Default (TiledTabsConfig s) where def = TTC 1 0.5 (3/100) 1 0.5 (3/100) shrinkText def {-# DEPRECATED defaultTiledTabsConfig "Use def (from Data.Default, and re-exported by XMonad.Layout.Groups) instead." #-} defaultTiledTabsConfig :: TiledTabsConfig DefaultShrinker defaultTiledTabsConfig = def fullTabs c = _tab c $ G.group _tabs $ Full ||| _vert c ||| _horiz c tallTabs c = _tab c $ G.group _tabs $ _vert c ||| _horiz c ||| Full mirrorTallTabs c = _tab c $ G.group _tabs $ _horiz c ||| Full ||| _vert c _tabs = named "Tabs" Simplest _tab c l = renamed [CutWordsLeft 1] $ addTabs (tabsShrinker c) (tabsTheme c) l _vert c = named "Vertical" $ Tall (vNMaster c) (vIncrement c) (vRatio c) _horiz c = named "Horizontal" $ Mirror $ Tall (hNMaster c) (hIncrement c) (hRatio c) -- | Increase the number of master groups by one increaseNMasterGroups :: X () increaseNMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ IncMasterN 1 -- | Decrease the number of master groups by one decreaseNMasterGroups :: X () decreaseNMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ IncMasterN (-1) -- | Shrink the master area shrinkMasterGroups :: X () shrinkMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ Shrink -- | Expand the master area expandMasterGroups :: X () expandMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ Expand -- | Rotate the available outer layout algorithms nextOuterLayout :: X () nextOuterLayout = sendMessage $ G.ToEnclosing $ SomeMessage $ NextLayout xmonad-contrib-0.12/XMonad/Layout/Groups/Helpers.hs0000644000000000000000000001766712636047674020466 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE MultiParamTypeClasses, Rank2Types, ImpredicativeTypes #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Groups.Helpers -- Copyright : Quentin Moser -- License : BSD-style (see LICENSE) -- -- Maintainer : orphaned -- Stability : stable -- Portability : unportable -- -- Utility functions for "XMonad.Layout.Groups". -- ----------------------------------------------------------------------------- module XMonad.Layout.Groups.Helpers ( -- * Usage -- $usage -- ** Layout-generic actions swapUp , swapDown , swapMaster , focusUp , focusDown , focusMaster , toggleFocusFloat -- ** 'G.Groups'-secific actions , swapGroupUp , swapGroupDown , swapGroupMaster , focusGroupUp , focusGroupDown , focusGroupMaster , moveToGroupUp , moveToGroupDown , moveToNewGroupUp , moveToNewGroupDown , splitGroup ) where import XMonad hiding ((|||)) import qualified XMonad.StackSet as W import qualified XMonad.Layout.Groups as G import XMonad.Actions.MessageFeedback import Control.Monad (unless) import qualified Data.Map as M -- $usage -- -- This module provides helpers functions for use with "XMonad.Layout.Groups"-based -- layouts. You can use its contents by adding -- -- > import XMonad.Layout.Groups.Helpers -- -- to the top of your @.\/.xmonad\/xmonad.hs@. -- -- "XMonad.Layout.Groups"-based layouts do not have the same notion -- of window ordering as the rest of XMonad. For this reason, the usual -- ways of reordering windows and moving focus do not work with them. -- "XMonad.Layout.Groups" provides 'Message's that can be used to obtain -- the right effect. -- -- But what if you want to use both 'G.Groups' and other layouts? -- This module provides actions that try to send 'G.GroupsMessage's, and -- fall back to the classic way if the current layout doesn't hande them. -- They are in the section called \"Layout-generic actions\". -- -- The sections \"Groups-specific actions\" contains actions that don't make -- sense for non-'G.Groups'-based layouts. These are simply wrappers around -- the equivalent 'G.GroupsMessage's, but are included so you don't have to -- write @sendMessage $ Modify $ ...@ everytime. -- -- This module exports many operations with the same names as -- 'G.ModifySpec's from "XMonad.Layout.Groups", so if you want -- to import both, we suggest to import "XMonad.Layout.Groups" -- qualified: -- -- > import qualified XMonad.Layout.Groups as G -- -- For more information on how to extend your layour hook and key bindings, see -- "XMonad.Doc.Extending". -- ** Layout-generic actions -- #Layout-generic actions# alt :: G.ModifySpec -> (WindowSet -> WindowSet) -> X () alt f g = alt2 (G.Modify f) $ windows g alt2 :: G.GroupsMessage -> X () -> X () alt2 m x = do b <- send m unless b x -- | Swap the focused window with the previous one swapUp :: X () swapUp = alt G.swapUp W.swapUp -- | Swap the focused window with the next one swapDown :: X () swapDown = alt G.swapDown W.swapDown -- | Swap the focused window with the master window swapMaster :: X () swapMaster = alt G.swapMaster W.swapMaster -- | If the focused window is floating, focus the next floating -- window. otherwise, focus the next non-floating one. focusUp :: X () focusUp = ifFloat focusFloatUp focusNonFloatUp -- | If the focused window is floating, focus the next floating -- window. otherwise, focus the next non-floating one. focusDown :: X () focusDown = ifFloat focusFloatDown focusNonFloatDown -- | Move focus to the master window focusMaster :: X () focusMaster = alt G.focusMaster W.shiftMaster -- | Move focus between the floating and non-floating layers toggleFocusFloat :: X () toggleFocusFloat = ifFloat focusNonFloat focusFloatUp -- *** Floating layer helpers getFloats :: X [Window] getFloats = gets $ M.keys . W.floating . windowset getWindows :: X [Window] getWindows = gets $ W.integrate' . W.stack . W.workspace . W.current . windowset ifFloat :: X () -> X () -> X () ifFloat x1 x2 = withFocused $ \w -> do floats <- getFloats if elem w floats then x1 else x2 focusNonFloat :: X () focusNonFloat = alt2 G.Refocus helper where helper = withFocused $ \w -> do ws <- getWindows floats <- getFloats let (before, after) = span (/=w) ws case filter (flip notElem floats) $ after ++ before of [] -> return () w':_ -> focus w' focusHelper :: (Bool -> Bool) -- ^ if you want to focus a floating window, 'id'. -- if you want a non-floating one, 'not'. -> ([Window] -> [Window]) -- ^ if you want the next window, 'id'. -- if you want the previous one, 'reverse'. -> X () focusHelper f g = withFocused $ \w -> do ws <- getWindows let (before, _:after) = span (/=w) ws let toFocus = g $ after ++ before floats <- getFloats case filter (f . flip elem floats) toFocus of [] -> return () w':_ -> focus w' focusNonFloatUp :: X () focusNonFloatUp = alt2 (G.Modify G.focusUp) $ focusHelper not reverse focusNonFloatDown :: X () focusNonFloatDown = alt2 (G.Modify G.focusDown) $ focusHelper not id focusFloatUp :: X () focusFloatUp = focusHelper id reverse focusFloatDown :: X () focusFloatDown = focusHelper id id -- ** Groups-specific actions wrap :: G.ModifySpec -> X () wrap = sendMessage . G.Modify -- | Swap the focused group with the previous one swapGroupUp :: X () swapGroupUp = wrap G.swapGroupUp -- | Swap the focused group with the next one swapGroupDown :: X () swapGroupDown = wrap G.swapGroupDown -- | Swap the focused group with the master group swapGroupMaster :: X () swapGroupMaster = wrap G.swapGroupMaster -- | Move the focus to the previous group focusGroupUp :: X () focusGroupUp = wrap G.focusGroupUp -- | Move the focus to the next group focusGroupDown :: X () focusGroupDown = wrap G.focusGroupDown -- | Move the focus to the master group focusGroupMaster :: X () focusGroupMaster = wrap G.focusGroupMaster -- | Move the focused window to the previous group. The 'Bool' argument -- determines what will be done if the focused window is in the very first -- group: Wrap back to the end ('True'), or create a new group before -- it ('False'). moveToGroupUp :: Bool -> X () moveToGroupUp b = wrap (G.moveToGroupUp b) -- | Move the focused window to the next group. The 'Bool' argument -- determines what will be done if the focused window is in the very last -- group: Wrap back to the beginning ('True'), or create a new group after -- it ('False'). moveToGroupDown :: Bool -> X () moveToGroupDown b = wrap (G.moveToGroupDown b) -- | Move the focused window to a new group before the current one moveToNewGroupUp :: X () moveToNewGroupUp = wrap G.moveToNewGroupUp -- | Move the focused window to a new group after the current one moveToNewGroupDown :: X () moveToNewGroupDown = wrap G.moveToNewGroupDown -- | Split the focused group in two at the position of the focused -- window. splitGroup :: X () splitGroup = wrap G.splitGroup xmonad-contrib-0.12/XMonad/Layout/MultiToggle/0000755000000000000000000000000012636047674017464 5ustar0000000000000000xmonad-contrib-0.12/XMonad/Layout/MultiToggle/Instances.hs0000644000000000000000000000272312636047674021753 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.MultiToggle.Instances -- Copyright : (c) 2008 Brent Yorgey -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Some convenient common instances of the -- 'XMonad.Layout.MultiToggle.Transformer' class, for use with -- "XMonad.Layout.MultiToggle". module XMonad.Layout.MultiToggle.Instances ( StdTransformers(..) ) where import XMonad.Layout.MultiToggle import XMonad import XMonad.Layout.NoBorders import XMonad.Layout.LayoutModifier data StdTransformers = FULL -- ^ switch to Full layout | NBFULL -- ^ switch to Full with no borders | MIRROR -- ^ Mirror the current layout. | NOBORDERS -- ^ Remove borders. | SMARTBORDERS -- ^ Apply smart borders. deriving (Read, Show, Eq, Typeable) instance Transformer StdTransformers Window where transform FULL x k = k Full (const x) transform NBFULL x k = k (noBorders Full) (const x) transform MIRROR x k = k (Mirror x) (\(Mirror x') -> x') transform NOBORDERS x k = k (noBorders x) (\(ModifiedLayout _ x') -> x') transform SMARTBORDERS x k = k (smartBorders x) (\(ModifiedLayout _ x') -> x') xmonad-contrib-0.12/XMonad/Doc/0000755000000000000000000000000012636047674014460 5ustar0000000000000000xmonad-contrib-0.12/XMonad/Doc/Configuring.hs0000644000000000000000000001241312636047674017267 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Doc.Configuring -- Copyright : (C) 2007 Don Stewart and Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : portable -- -- This is a brief tutorial that will teach you how to create a -- basic xmonad configuration. -- -- For more detailed instructions on extending xmonad with the -- xmonad-contrib library, see "XMonad.Doc.Extending". -- ----------------------------------------------------------------------------- module XMonad.Doc.Configuring ( -- * Configuring xmonad -- $configure -- * A simple example -- $example -- * Checking whether your xmonad.hs is correct -- $check -- * Loading your configuration -- $load ) where -------------------------------------------------------------------------------- -- -- Configuring Xmonad -- -------------------------------------------------------------------------------- {- $configure #Configuring_xmonad# xmonad can be configured by creating and editing the Haskell file: > ~/.xmonad/xmonad.hs If this file does not exist, xmonad will simply use default settings; if it does exist, xmonad will use whatever settings you specify. Note that this file can contain arbitrary Haskell code, which means that you have quite a lot of flexibility in configuring xmonad. HISTORICAL NOTE regarding upgrading from versions (< 0.5) of xmonad or using old documentation: xmonad-0.5 delivered a major change in the way xmonad is configured. Prior to version 0.5, configuring xmonad required editing a source file called Config.hs, manually recompiling xmonad, and then restarting. From version 0.5 onwards, however, you should NOT edit this file or manually compile with ghc --make. All you have to do is edit xmonad.hs and restart with @mod-q@; xmonad does the recompiling itself. The format of the configuration file also changed with version 0.5; enabling simpler and much shorter xmonad.hs files that only require listing those settings which are different from the defaults. While the complicated template.hs (man/xmonad.hs) files listing all default settings are still provided for reference, once you wish to make substantial changes to your configuration, the template.hs style configuration is not recommended. It is fine to use top-level definitions to organize your xmonad.hs, but wherever possible it is better to leave out settings that simply duplicate defaults. -} {- $example #A_simple_example# Here is a basic example, which starts with the default xmonad configuration and overrides the border width, default terminal, and some colours: > -- > -- An example, simple ~/.xmonad/xmonad.hs file. > -- It overrides a few basic settings, reusing all the other defaults. > -- > > import XMonad > > main = xmonad $ def > { borderWidth = 2 > , terminal = "urxvt" > , normalBorderColor = "#cccccc" > , focusedBorderColor = "#cd8b00" } This will run \'xmonad\', the window manager, with your settings passed as arguments. Overriding default settings like this (using \"record update syntax\"), will yield the shortest config file, as you only have to describe values that differ from the defaults. As an alternative, you can copy the template @xmonad.hs@ file (found either in the @man@ directory, if you have the xmonad source, or on the xmonad wiki config archive at ) into your @~\/.xmonad\/@ directory. This template file contains all the default settings spelled out, and you should be able to simply change the ones you would like to change. To see what fields can be customized beyond the ones in the example above, the definition of the 'XMonad.Core.XConfig' data structure can be found in "XMonad.Core". -} {- $check #Checking_whether_your_xmonad.hs_is_correct# After changing your configuration, it is a good idea to check that it is syntactically and type correct. You can do this easily by using an xmonad flag: > $ xmonad --recompile > $ If there is no output, your xmonad.hs has no errors. If there are errors, they will be printed to the console. Patch them up and try again. Note, however, that if you skip this step and try restarting xmonad with errors in your xmonad.hs, it's not the end of the world; xmonad will simply display a window showing the errors and continue with the previous configuration settings. (This assumes that you have the \'xmessage\' utility installed; you probably do.) -} {- $load #Loading_your_configuration# To get xmonad to use your new settings, type @mod-q@. (Remember, the mod key is \'alt\' by default, but you can configure it to be something else, such as your Windows key if you have one.) xmonad will attempt to compile this file, and run it. If everything goes well, xmonad will seamlessly restart itself with the new settings, keeping all your windows, layouts, etc. intact. (If you change anything related to your layouts, you may need to hit @mod-shift-space@ after restarting to see the changes take effect.) If something goes wrong, the previous (default) settings will be used. Note this requires that GHC and xmonad are in the @$PATH@ in the environment from which xmonad is started. -} xmonad-contrib-0.12/XMonad/Doc/Developing.hs0000644000000000000000000002677012636047674017124 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Doc.Developing -- Copyright : (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : portable -- -- This module gives a brief overview of the xmonad internals. It is -- intended for advanced users who are curious about the xmonad source -- code and want an brief overview. This document may also be helpful -- for the beginner\/intermediate Haskell programmer who is motivated -- to write an xmonad extension as a way to deepen her understanding -- of this powerful functional language; however, there is not space -- here to go into much detail. For a more comprehensive document -- covering some of the same material in more depth, see the guided -- tour of the xmonad source on the xmonad wiki: -- . -- -- If you write an extension module and think it may be useful for -- others, consider releasing it. Coding guidelines and licensing -- policies are covered at the end of this document, and must be -- followed if you want your code to be included in the official -- repositories. For a basic tutorial on the nuts and bolts of -- developing a new extension for xmonad, see the tutorial on the -- wiki: -- . -- ----------------------------------------------------------------------------- module XMonad.Doc.Developing ( -- * Writing new extensions -- $writing -- * Libraries for writing window managers -- $xmonad-libs -- * xmonad internals -- $internals -- ** The @main@ entry point -- $main -- ** The X monad and the internal state -- $internalState -- ** Event handling and messages -- $events -- ** The 'LayoutClass' -- $layoutClass -- * Coding style -- $style -- * Licensing policy -- $license ) where -------------------------------------------------------------------------------- -- -- Writing Extensions -- -------------------------------------------------------------------------------- {- $writing -} {- $xmonad-libs Starting with version 0.5, xmonad and xmonad-contrib are packaged and distributed as libraries, instead of components which must be compiled by the user into a binary (as they were prior to version 0.5). This way of distributing xmonad has many advantages, since it allows packaging by GNU\/Linux distributions while still allowing the user to customize the window manager to fit her needs. Basically, xmonad and the xmonad-contrib libraries let users write their own window manager in just a few lines of code. While @~\/.xmonad\/xmonad.hs@ at first seems to be simply a configuration file, it is actually a complete Haskell program which uses the xmonad and xmonad-contrib libraries to create a custom window manager. This makes it possible not only to edit the default xmonad configuration, as we have seen in the "XMonad.Doc.Extending" document, but to use the Haskell programming language to extend the window manager you are writing in any way you see fit. -} {- $internals -} {- $main #The_main_entry_point# xmonad installs a binary, @xmonad@, which must be executed by the Xsession starting script. This binary, whose code can be read in @Main.hs@ of the xmonad source tree, will use 'XMonad.Core.recompile' to run @ghc@ in order to build a binary from @~\/.xmonad\/xmonad.hs@. If this compilation process fails, for any reason, a default @main@ entry point will be used, which calls the 'XMonad.Main.xmonad' function with a default configuration. Thus, the real @main@ entry point, the one that even the users' custom window manager application in @~\/.xmonad\/xmonad.hs@ must call, is the 'XMonad.Main.xmonad' function. This function takes a configuration as its only argument, whose type ('XMonad.Core.XConfig') is defined in "XMonad.Core". 'XMonad.Main.xmonad' takes care of opening the connection with the X server, initializing the state (or deserializing it when restarted) and the configuration, and calling the event handler ('XMonad.Main.handle') that goes into an infinite loop (using 'Prelude.forever') waiting for events and acting accordingly. -} {- $internalState The event loop which calls 'XMonad.Main.handle' to react to events is run within the 'XMonad.Core.X' monad, which is a 'Control.Monad.State.StateT' transformer over 'IO', encapsulated within a 'Control.Monad.Reader.ReaderT' transformer. The 'Control.Monad.State.StateT' transformer encapsulates the (read\/writable) state of the window manager (of type 'XMonad.Core.XState'), whereas the 'Control.Monad.Reader.ReaderT' transformer encapsulates the (read-only) configuration (of type 'XMonad.Core.XConf'). Thanks to GHC's newtype deriving feature, the instance of the 'Control.Monad.State.MonadState' class parametrized over 'XMonad.Core.XState' and the instance of the 'Control.Monad.Reader.MonadReader' class parametrized over 'XMonad.Core.XConf' are automatically derived for the 'XMonad.Core.X' monad. This way we can use 'Control.Monad.State.get', 'Control.Monad.State.gets' and 'Control.Monad.State.modify' for the 'XMonad.Core.XState', and 'Control.Monad.Reader.ask' and 'Control.Monad.Reader.asks' for reading the 'XMonad.Core.XConf'. 'XMonad.Core.XState' is where all the sensitive information about window management is stored. The most important field of the 'XMonad.Core.XState' is the 'XMonad.Core.windowset', whose type ('XMonad.Core.WindowSet') is a synonym for a 'XMonad.StackSet.StackSet' parametrized over a 'XMonad.Core.WorkspaceID' (a 'String'), a layout type wrapped inside the 'XMonad.Layout.Layout' existential data type, the 'Graphics.X11.Types.Window' type, the 'XMonad.Core.ScreenID' and the 'XMonad.Core.ScreenDetail's. What a 'XMonad.StackSet.StackSet' is and how it can be manipulated with pure functions is described in the Haddock documentation of the "XMonad.StackSet" module. The 'XMonad.StackSet.StackSet' ('XMonad.Core.WindowSet') has four fields: * 'XMonad.StackSet.current', for the current, focused workspace. This is a 'XMonad.StackSet.Screen', which is composed of a 'XMonad.StackSet.Workspace' together with the screen information (for Xinerama support). * 'XMonad.StackSet.visible', a list of 'XMonad.StackSet.Screen's for the other visible (with Xinerama) workspaces. For non-Xinerama setups, this list is always empty. * 'XMonad.StackSet.hidden', the list of non-visible 'XMonad.StackSet.Workspace's. * 'XMonad.StackSet.floating', a map from floating 'Graphics.X11.Types.Window's to 'XMonad.StackSet.RationalRect's specifying their geometry. The 'XMonad.StackSet.Workspace' type is made of a 'XMonad.StackSet.tag', a 'XMonad.StackSet.layout' and a (possibly empty) 'XMonad.StackSet.stack' of windows. "XMonad.StackSet" (which should usually be imported qualified, to avoid name clashes with Prelude functions such as 'Prelude.delete' and 'Prelude.filter') provides many pure functions to manipulate the 'XMonad.StackSet.StackSet'. These functions are most commonly used as an argument to 'XMonad.Operations.windows', which takes a pure function to manipulate the 'XMonad.Core.WindowSet' and does all the needed operations to refresh the screen and save the modified 'XMonad.Core.XState'. During each 'XMonad.Operations.windows' call, the 'XMonad.StackSet.layout' field of the 'XMonad.StackSet.current' and 'XMonad.StackSet.visible' 'XMonad.StackSet.Workspace's are used to physically arrange the 'XMonad.StackSet.stack' of windows on each workspace. The possibility of manipulating the 'XMonad.StackSet.StackSet' ('XMonad.Core.WindowSet') with pure functions makes it possible to test all the properties of those functions with QuickCheck, providing greater reliability of the core code. Every change to the "XMonad.StackSet" module must be accompanied by appropriate QuickCheck properties before being applied. -} {- $events Event handling is the core activity of xmonad. Events generated by the X server are most important, but there may also be events generated by layouts or the user. "XMonad.Core" defines a class that generalizes the concept of events, 'XMonad.Core.Message', constrained to types with a 'Data.Typeable.Typeable' instance definition (which can be automatically derived by GHC). 'XMonad.Core.Message's are wrapped within an existential type 'XMonad.Core.SomeMessage'. The 'Data.Typeable.Typeable' constraint allows for the definition of a 'XMonad.Core.fromMessage' function that can unwrap the message with 'Data.Typeable.cast'. X Events are instances of this class, along with any messages used by xmonad itself or by extension modules. Using the 'Data.Typeable.Typeable' class for any kind of 'XMonad.Core.Message's and events allows us to define polymorphic functions for processing messages or unhandled events. This is precisely what happens with X events: xmonad passes them to 'XMonad.Main.handle'. If the main event handling function doesn't have anything to do with the event, the event is sent to all visible layouts by 'XMonad.Operations.broadcastMessage'. This messaging system allows the user to create new message types, simply declare an instance of the 'Data.Typeable.Typeable' and use 'XMonad.Operations.sendMessage' to send commands to layouts. And, finally, layouts may handle X events and other messages within the same function... miracles of polymorphism. -} {- $layoutClass #The_LayoutClass# to do -} {- $style These are the coding guidelines for contributing to xmonad and the xmonad contributed extensions. * Comment every top level function (particularly exported funtions), and provide a type signature. * Use Haddock syntax in the comments (see below). * Follow the coding style of the other modules. * Code should be compilable with "ghc-options: -Wall -Werror" set in the xmonad-contrib.cabal file. There should be no warnings. * Code should be free of any warnings or errors from the Hlint tool; use your best judgement on some warnings like eta-reduction or bracket removal, though. * Partial functions should be avoided: the window manager should not crash, so never call 'error' or 'undefined'. * Tabs are /illegal/. Use 4 spaces for indenting. * Any pure function added to the core must have QuickCheck properties precisely defining its behaviour. Tests for everything else are encouraged. For examples of Haddock documentation syntax, have a look at other extensions. Important points are: * Every exported function (or even better, every function) should have a Haddock comment explaining what it does, and providing examples. * Literal chunks of code can be written in comments using \"birdtrack\" notation (a greater-than symbol at the beginning of each line). Be sure to leave a blank line before and after each birdtrack-quoted section. * Link to functions by surrounding the names in single quotes, modules in double quotes. * Literal quote marks and slashes should be escaped with a backslash. To generate and view the Haddock documentation for your extension, run > runhaskell Setup haddock and then point your browser to @\/path\/to\/XMonadContrib\/dist\/doc\/html\/xmonad-contrib\/index.html@. For more information, see the Haddock documentation: . For more information on the nuts and bolts of how to develop your own extension, see the tutorial on the wiki: . -} {- $license New modules should identify the author, and be submitted under the same license as xmonad (BSD3 license or freer). -} xmonad-contrib-0.12/XMonad/Doc/Extending.hs0000644000000000000000000014155512636047674016754 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Doc.Extending -- Copyright : (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : portable -- -- This module documents the xmonad-contrib library and -- how to use it to extend the capabilities of xmonad. -- -- Reading this document should not require a deep knowledge of -- Haskell; the examples are intended to be useful and understandable -- for those users who do not know Haskell and don't want to have to -- learn it just to configure xmonad. You should be able to get by -- just fine by ignoring anything you don't understand and using the -- provided examples as templates. However, relevant Haskell features -- are discussed when appropriate, so this document will hopefully be -- useful for more advanced Haskell users as well. -- -- Those wishing to be totally hardcore and develop their own xmonad -- extensions (it's easier than it sounds, we promise!) should read -- the documentation in "XMonad.Doc.Developing". -- -- More configuration examples may be found on the Haskell wiki: -- -- -- ----------------------------------------------------------------------------- module XMonad.Doc.Extending ( -- * The xmonad-contrib library -- $library -- ** Actions -- $actions -- ** Configurations -- $configs -- ** Hooks -- $hooks -- ** Layouts -- $layouts -- ** Prompts -- $prompts -- ** Utilities -- $utils -- * Extending xmonad -- $extending -- ** Editing key bindings -- $keys -- *** Adding key bindings -- $keyAdding -- *** Removing key bindings -- $keyDel -- *** Adding and removing key bindings -- $keyAddDel -- ** Editing mouse bindings -- $mouse -- ** Editing the layout hook -- $layoutHook -- ** Editing the manage hook -- $manageHook -- ** The log hook and external status bars -- $logHook ) where -------------------------------------------------------------------------------- -- -- The XmonadContrib Library -- -------------------------------------------------------------------------------- {- $library The xmonad-contrib (xmc) library is a set of extension modules contributed by xmonad hackers and users, which provide additional xmonad features. Examples include various layout modes (tabbed, spiral, three-column...), prompts, program launchers, the ability to manipulate windows and workspaces in various ways, alternate navigation modes, and much more. There are also \"meta-modules\" which make it easier to write new modules and extensions. This is a concise yet complete overview of the xmonad-contrib modules. For more information about any particular module, just click on its name to view its Haddock documentation; each module should come with extensive documentation. If you find a module that could be better documented, or has incorrect documentation, please report it as a bug ()! -} {- $actions In the @XMonad.Actions@ namespace you can find modules exporting various functions that are usually intended to be bound to key combinations or mouse actions, in order to provide functionality beyond the standard keybindings provided by xmonad. See "XMonad.Doc.Extending#Editing_key_bindings" for instructions on how to edit your key bindings. * "XMonad.Actions.Commands": Allows you to run internal xmonad commands (X () actions) using a dmenu menu in addition to key bindings. Requires dmenu and the Dmenu XMonad.Actions module. * "XMonad.Actions.ConstrainedResize": Lets you constrain the aspect ratio of a floating window (by, say, holding shift while you resize). Useful for making a nice circular XClock window. * "XMonad.Actions.CopyWindow": Provides bindings to duplicate a window on multiple workspaces, providing dwm-like tagging functionality. * "XMonad.Actions.CycleRecentWS": Provides bindings to cycle through most recently used workspaces with repeated presses of a single key (as long as modifier key is held down). This is similar to how many window managers handle window switching. * "XMonad.Actions.CycleSelectedLayouts": This module allows to cycle through the given subset of layouts. * "XMonad.Actions.CycleWS": Provides bindings to cycle forward or backward through the list of workspaces, to move windows between workspaces, and to cycle between screens. Replaces the former XMonad.Actions.RotView. * "XMonad.Actions.CycleWindows": Provides bindings to cycle windows up or down on the current workspace stack while maintaining focus in place. * "XMonad.Actions.DeManage": This module provides a method to cease management of a window without unmapping it. "XMonad.Hooks.ManageDocks" is a more automated solution if your panel supports it. * "XMonad.Actions.DwmPromote": Dwm-like swap function for xmonad. Swaps focused window with the master window. If focus is in the master, swap it with the next window in the stack. Focus stays in the master. * "XMonad.Actions.DynamicWorkspaces": Provides bindings to add and delete workspaces. Note that you may only delete a workspace that is already empty. * "XMonad.Actions.FindEmptyWorkspace": Find an empty workspace. * "XMonad.Actions.FlexibleManipulate": Move and resize floating windows without warping the mouse. * "XMonad.Actions.FlexibleResize": Resize floating windows from any corner. * "XMonad.Actions.FloatKeys": Move and resize floating windows. * "XMonad.Actions.FloatSnap": Move and resize floating windows using other windows and the edge of the screen as guidelines. * "XMonad.Actions.FocusNth": Focus the nth window of the current workspace. * "XMonad.Actions.GridSelect": GridSelect displays items(e.g. the opened windows) in a 2D grid and lets the user select from it with the cursor/hjkl keys or the mouse. * "XMonad.Actions.MessageFeedback": Alternative to 'XMonad.Operations.sendMessage' that provides knowledge of whether the message was handled, and utility functions based on this facility. * "XMonad.Actions.MouseGestures": Support for simple mouse gestures. * "XMonad.Actions.MouseResize": A layout modifier to resize windows with the mouse by grabbing the window's lower right corner. * "XMonad.Actions.NoBorders": This module provides helper functions for dealing with window borders. * "XMonad.Actions.OnScreen": Control workspaces on different screens (in xinerama mode). * "XMonad.Actions.PerWorkspaceKeys": Define key-bindings on per-workspace basis. * "XMonad.Actions.PhysicalScreens": Manipulate screens ordered by physical location instead of ID * "XMonad.Actions.Plane": This module has functions to navigate through workspaces in a bidimensional manner. * "XMonad.Actions.Promote": Alternate promote function for xmonad. * "XMonad.Actions.RandomBackground": An action to start terminals with a random background color * "XMonad.Actions.RotSlaves": Rotate all windows except the master window and keep the focus in place. * "XMonad.Actions.Search": A module for easily running Internet searches on web sites through xmonad. Modeled after the handy Surfraw CLI search tools at . * "XMonad.Actions.SimpleDate": An example external contrib module for XMonad. Provides a simple binding to dzen2 to print the date as a popup menu. * "XMonad.Actions.SinkAll": (Deprecated) Provides a simple binding that pushes all floating windows on the current workspace back into tiling. Instead, use the more general "XMonad.Actions.WithAll" * "XMonad.Actions.SpawnOn": Provides a way to modify a window spawned by a command(e.g shift it to the workspace it was launched on) by using the _NET_WM_PID property that most windows set on creation. * "XMonad.Actions.Submap": A module that allows the user to create a sub-mapping of key bindings. * "XMonad.Actions.SwapWorkspaces": Lets you swap workspace tags, so you can keep related ones next to each other, without having to move individual windows. * "XMonad.Actions.TagWindows": Functions for tagging windows and selecting them by tags. * "XMonad.Actions.TopicSpace": Turns your workspaces into a more topic oriented system. * "XMonad.Actions.UpdateFocus": Updates the focus on mouse move in unfocused windows. * "XMonad.Actions.UpdatePointer": Causes the pointer to follow whichever window focus changes to. * "XMonad.Actions.Warp": Warp the pointer to a given window or screen. * "XMonad.Actions.WindowBringer": dmenu operations to bring windows to you, and bring you to windows. That is to say, it pops up a dmenu with window names, in case you forgot where you left your XChat. * "XMonad.Actions.WindowGo": Defines a few convenient operations for raising (traveling to) windows based on XMonad's Query monad, such as 'runOrRaise'. * "XMonad.Actions.WindowMenu": Uses "XMonad.Actions.GridSelect" to display a number of actions related to window management in the center of the focused window. * "XMonad.Actions.WindowNavigation": Experimental rewrite of "XMonad.Layout.WindowNavigation". * "XMonad.Actions.WithAll": Provides functions for performing a given action on all windows of the current workspace. * "XMonad.Actions.WorkspaceCursors": Like "XMonad.Actions.Plane" for an arbitrary number of dimensions. -} {- $configs In the @XMonad.Config@ namespace you can find modules exporting the configurations used by some of the xmonad and xmonad-contrib developers. You can look at them for examples while creating your own configuration; you can also simply import them and use them as your own configuration, possibly with some modifications. * "XMonad.Config.Arossato" This module specifies my xmonad defaults. * "XMonad.Config.Azerty" Fixes some keybindings for users of French keyboard layouts. * "XMonad.Config.Desktop" This module provides core desktop environment settings used in the Gnome, Kde, and Xfce config configs. It is also useful for people using other environments such as lxde, or using tray or panel applications without full desktop environments. * "XMonad.Config.Gnome" * "XMonad.Config.Kde" * "XMonad.Config.Sjanssen" * "XMonad.Config.Xfce" -} {- $hooks In the @XMonad.Hooks@ namespace you can find modules exporting hooks. Hooks are actions that xmonad performs when certain events occur. The two most important hooks are: * 'XMonad.Core.manageHook': this hook is called when a new window xmonad must take care of is created. This is a very powerful hook, since it lets us examine the new window's properties and act accordingly. For instance, we can configure xmonad to put windows belonging to a given application in the float layer, not to manage dock applications, or open them in a given workspace. See "XMonad.Doc.Extending#Editing_the_manage_hook" for more information on customizing 'XMonad.Core.manageHook'. * 'XMonad.Core.logHook': this hook is called when the stack of windows managed by xmonad has been changed, by calling the 'XMonad.Operations.windows' function. For instance "XMonad.Hooks.DynamicLog" will produce a string (whose format can be configured) to be printed to the standard output. This can be used to display some information about the xmonad state in a status bar. See "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" for more information. * 'XMonad.Core.handleEventHook': this hook is called on all events handled by xmonad, thus it is extremely powerful. See "Graphics.X11.Xlib.Extras" and xmonad source and development documentation for more details. Here is a list of the modules found in @XMonad.Hooks@: * "XMonad.Hooks.DynamicHooks": One-shot and permanent ManageHooks that can be updated at runtime. * "XMonad.Hooks.DynamicLog": for use with 'XMonad.Core.logHook'; send information about xmonad's state to standard output, suitable for putting in a status bar of some sort. See "XMonad.Doc.Extending#The_log_hook_and_external_status_bars". * "XMonad.Hooks.EwmhDesktops": Makes xmonad use the EWMH hints to tell panel applications about its workspaces and the windows therein. It also allows the user to interact with xmonad by clicking on panels and window lists. * "XMonad.Hooks.FadeInactive": Makes XMonad set the _NET_WM_WINDOW_OPACITY atom for inactive windows, which causes those windows to become slightly translucent if something like xcompmgr is running * "XMonad.Hooks.FloatNext": Hook and keybindings for automatically sending the next spawned window(s) to the floating layer. * "XMonad.Hooks.InsertPosition": Configure where new windows should be added and which window should be focused. * "XMonad.Hooks.ManageDocks": This module provides tools to automatically manage 'dock' type programs, such as gnome-panel, kicker, dzen, and xmobar. * "XMonad.Hooks.ManageHelpers": provide helper functions to be used in @manageHook@. * "XMonad.Hooks.Minimize": Handles window manager hints to minimize and restore windows. Use this with XMonad.Layout.Minimize. * "XMonad.Hooks.Place": Automatic placement of floating windows. * "XMonad.Hooks.RestoreMinimized": (Deprecated: Use XMonad.Hooks.Minimize) Lets you restore minimized windows (see "XMonad.Layout.Minimize") by selecting them on a taskbar (listens for _NET_ACTIVE_WINDOW and WM_CHANGE_STATE). * "XMonad.Hooks.Script": Provides a simple interface for running a ~\/.xmonad\/hooks script with the name of a hook. * "XMonad.Hooks.ServerMode": Allows sending commands to a running xmonad process. * "XMonad.Hooks.SetCursor": Set a default mouse cursor on startup. * "XMonad.Hooks.SetWMName": Sets the WM name to a given string, so that it could be detected using _NET_SUPPORTING_WM_CHECK protocol. May be useful for making Java GUI programs work. * "XMonad.Hooks.UrgencyHook": UrgencyHook lets you configure an action to occur when a window demands your attention. (In traditional WMs, this takes the form of \"flashing\" on your \"taskbar.\" Blech.) * "XMonad.Hooks.WorkspaceByPos": Useful in a dual-head setup: Looks at the requested geometry of new windows and moves them to the workspace of the non-focused screen if necessary. * "XMonad.Hooks.XPropManage": A ManageHook matching on XProperties. -} {- $layouts In the @XMonad.Layout@ namespace you can find modules exporting contributed tiling algorithms, such as a tabbed layout, a circle, a spiral, three columns, and so on. You will also find modules which provide facilities for combining different layouts, such as "XMonad.Layout.Combo", "XMonad.Layout.ComboP", "XMonad.Layout.LayoutBuilder", "XMonad.Layout.SubLayouts", or "XMonad.Layout.LayoutCombinators". Layouts can be also modified with layout modifiers. A general interface for writing layout modifiers is implemented in "XMonad.Layout.LayoutModifier". For more information on using those modules for customizing your 'XMonad.Core.layoutHook' see "XMonad.Doc.Extending#Editing_the_layout_hook". * "XMonad.Layout.Accordion": LayoutClass that puts non-focused windows in ribbons at the top and bottom of the screen. * "XMonad.Layout.AutoMaster": Provides layout modifier AutoMaster. It separates screen in two parts - master and slave. Size of slave area automatically changes depending on number of slave windows. * "XMonad.Layout.BorderResize": This layout modifier will allow to resize windows by dragging their borders with the mouse. However, it only works in layouts or modified layouts that react to the SetGeometry message. "XMonad.Layout.WindowArranger" can be used to create such a setup. BorderResize is probably most useful in floating layouts. * "XMonad.Layout.BoringWindows": BoringWindows is an extension to allow windows to be marked boring * "XMonad.Layout.CenteredMaster": Two layout modifiers. centerMaster places master window at center, on top of all other windows, which are managed by base layout. topRightMaster is similar, but places master window in top right corner instead of center. * "XMonad.Layout.Circle": Circle is an elliptical, overlapping layout. * "XMonad.Layout.Column": Provides Column layout that places all windows in one column. Windows heights are calculated from equation: H1/H2 = H2/H3 = ... = q, where q is given. With Shrink/Expand messages you can change the q value. * "XMonad.Layout.Combo": A layout that combines multiple layouts. * "XMonad.Layout.ComboP": A layout that combines multiple layouts and allows to specify where to put new windows. * "XMonad.Layout.Cross": A Cross Layout with the main window in the center. * "XMonad.Layout.Decoration": A layout modifier and a class for easily creating decorated layouts. * "XMonad.Layout.DecorationMadness": A collection of decorated layouts: some of them may be nice, some usable, others just funny. * "XMonad.Layout.Dishes": Dishes is a layout that stacks extra windows underneath the master windows. * "XMonad.Layout.DragPane": Layouts that splits the screen either horizontally or vertically and shows two windows. The first window is always the master window, and the other is either the currently focused window or the second window in layout order. See also "XMonad.Layout.MouseResizableTall" * "XMonad.Layout.DwmStyle": A layout modifier for decorating windows in a dwm like style. * "XMonad.Layout.FixedColumn": A layout much like Tall, but using a multiple of a window's minimum resize amount instead of a percentage of screen to decide where to split. This is useful when you usually leave a text editor or terminal in the master pane and like it to be 80 columns wide. * "XMonad.Layout.Gaps": Create manually-sized gaps along edges of the screen which will not be used for tiling, along with support for toggling gaps on and off. You probably want "XMonad.Hooks.ManageDocks". * "XMonad.Layout.Grid": A simple layout that attempts to put all windows in a square grid. * "XMonad.Layout.GridVariants": Two layouts: one is a variant of the Grid layout that allows the desired aspect ratio of windows to be specified. The other is like Tall but places a grid with fixed number of rows and columns in the master area and uses an aspect-ratio-specified layout for the slaves. * "XMonad.Layout.HintedGrid": A not so simple layout that attempts to put all windows in a square grid while obeying their size hints. * "XMonad.Layout.HintedTile": A gapless tiled layout that attempts to obey window size hints, rather than simply ignoring them. * "XMonad.Layout.IM": Layout modfier suitable for workspace with multi-windowed instant messenger (like Psi or Tkabber). * "XMonad.Layout.IndependentScreens": Utility functions for simulating independent sets of workspaces on each screen (like dwm's workspace model), using internal tags to distinguish workspaces associated with each screen. * "XMonad.Layout.LayoutBuilder": A layout combinator that sends a specified number of windows to one rectangle and the rest to another. * "XMonad.Layout.LayoutCombinators": The "XMonad.Layout.LayoutCombinators" module provides combinators for easily combining multiple layouts into one composite layout, as well as a way to jump directly to any particular layout (say, with a keybinding) without having to cycle through other layouts to get to it. * "XMonad.Layout.LayoutHints": Make layouts respect size hints. * "XMonad.Layout.LayoutModifier": A module for writing easy layout modifiers, which do not define a layout in and of themselves, but modify the behavior of or add new functionality to other layouts. If you ever find yourself writing a layout which takes another layout as a parameter, chances are you should be writing a LayoutModifier instead! In case it is not clear, this module is not intended to help you configure xmonad, it is to help you write other extension modules. So get hacking! * "XMonad.Layout.LayoutScreens": Divide a single screen into multiple screens. * "XMonad.Layout.LimitWindows": A layout modifier that limits the number of windows that can be shown. * "XMonad.Layout.MagicFocus": Automagically put the focused window in the master area. * "XMonad.Layout.Magnifier": Screenshot : This is a layout modifier that will make a layout increase the size of the window that has focus. * "XMonad.Layout.Master": Layout modfier that adds a master window to another layout. * "XMonad.Layout.Maximize": Temporarily yanks the focused window out of the layout to mostly fill the screen. * "XMonad.Layout.MessageControl": Provides message escaping and filtering facilities which help control complex nested layouts. * "XMonad.Layout.Minimize": Makes it possible to minimize windows, temporarily removing them from the layout until they are restored. * "XMonad.Layout.Monitor": Layout modfier for displaying some window (monitor) above other windows * "XMonad.Layout.Mosaic": Based on MosaicAlt, but aspect ratio messages always change the aspect ratios, and rearranging the window stack changes the window sizes. * "XMonad.Layout.MosaicAlt": A layout which gives each window a specified amount of screen space relative to the others. Compared to the 'Mosaic' layout, this one divides the space in a more balanced way. * "XMonad.Layout.MouseResizableTile": A layout in the spirit of "XMonad.Layout.ResizableTile", but with the option to use the mouse to adjust the layout. * "XMonad.Layout.MultiToggle": Dynamically apply and unapply transformers to your window layout. This can be used to rotate your window layout by 90 degrees, or to make the currently focused window occupy the whole screen (\"zoom in\") then undo the transformation (\"zoom out\"). * "XMonad.Layout.Named": A module for assigning a name to a given layout. * "XMonad.Layout.NoBorders": Make a given layout display without borders. This is useful for full-screen or tabbed layouts, where you don't really want to waste a couple of pixels of real estate just to inform yourself that the visible window has focus. * "XMonad.Layout.NoFrillsDecoration": Most basic version of decoration for windows without any additional modifications. In contrast to "XMonad.Layout.SimpleDecoration" this will result in title bars that span the entire window instead of being only the length of the window title. * "XMonad.Layout.OneBig": Places one (master) window at top left corner of screen, and other (slave) windows at the top. * "XMonad.Layout.PerWorkspace": Configure layouts on a per-workspace basis: use layouts and apply layout modifiers selectively, depending on the workspace. * "XMonad.Layout.Reflect": Reflect a layout horizontally or vertically. * "XMonad.Layout.ResizableTile": More useful tiled layout that allows you to change a width\/height of window. See also "XMonad.Layout.MouseResizableTile". * "XMonad.Layout.ResizeScreen": A layout transformer to have a layout respect a given screen geometry. Mostly used with "Decoration" (the Horizontal and the Vertical version will react to SetTheme and change their dimension accordingly. * "XMonad.Layout.Roledex": This is a completely pointless layout which acts like Microsoft's Flip 3D * "XMonad.Layout.ShowWName": This is a layout modifier that will show the workspace name * "XMonad.Layout.SimpleDecoration": A layout modifier for adding simple decorations to the windows of a given layout. The decorations are in the form of ion-like tabs for window titles. * "XMonad.Layout.SimpleFloat": A basic floating layout. * "XMonad.Layout.Simplest": A very simple layout. The simplest, afaik. Used as a base for decorated layouts. * "XMonad.Layout.SimplestFloat": A basic floating layout like SimpleFloat but without the decoration. * "XMonad.Layout.Spacing": Add a configurable amount of space around windows. * "XMonad.Layout.Spiral": A spiral tiling layout. * "XMonad.Layout.Square": A layout that splits the screen into a square area and the rest of the screen. This is probably only ever useful in combination with "XMonad.Layout.Combo". It sticks one window in a square region, and makes the rest of the windows live with what's left (in a full-screen sense). * "XMonad.Layout.StackTile": A stacking layout, like dishes but with the ability to resize master pane. Mostly useful on small screens. * "XMonad.Layout.SubLayouts": A layout combinator that allows layouts to be nested. * "XMonad.Layout.TabBarDecoration": A layout modifier to add a bar of tabs to your layouts. * "XMonad.Layout.Tabbed": A tabbed layout for the Xmonad Window Manager * "XMonad.Layout.ThreeColumns": A layout similar to tall but with three columns. With 2560x1600 pixels this layout can be used for a huge main window and up to six reasonable sized slave windows. * "XMonad.Layout.ToggleLayouts": A module to toggle between two layouts. * "XMonad.Layout.TwoPane": A layout that splits the screen horizontally and shows two windows. The left window is always the master window, and the right is either the currently focused window or the second window in layout order. * "XMonad.Layout.WindowArranger": This is a pure layout modifier that will let you move and resize windows with the keyboard in any layout. * "XMonad.Layout.WindowNavigation": WindowNavigation is an extension to allow easy navigation of a workspace. See also "XMonad.Actions.WindowNavigation". * "XMonad.Layout.WorkspaceDir": WorkspaceDir is an extension to set the current directory in a workspace. Actually, it sets the current directory in a layout, since there's no way I know of to attach a behavior to a workspace. This means that any terminals (or other programs) pulled up in that workspace (with that layout) will execute in that working directory. Sort of handy, I think. Note this extension requires the 'directory' package to be installed. -} {- $prompts In the @XMonad.Prompt@ name space you can find modules providing graphical prompts for getting user input and using it to perform various actions. The "XMonad.Prompt" provides a library for easily writing new prompt modules. These are the available prompts: * "XMonad.Prompt.AppLauncher": A module for launch applicationes that receive parameters in the command line. The launcher call a prompt to get the parameters. * "XMonad.Prompt.AppendFile": A prompt for appending a single line of text to a file. Useful for keeping a file of notes, things to remember for later, and so on--- using a keybinding, you can write things down just about as quickly as you think of them, so it doesn't have to interrupt whatever else you're doing. Who knows, it might be useful for other purposes as well! * "XMonad.Prompt.DirExec": A directory file executables prompt for XMonad. This might be useful if you don't want to have scripts in your PATH environment variable (same executable names, different behavior) - otherwise you might want to use "XMonad.Prompt.Shell" instead - but you want to have easy access to these executables through the xmonad's prompt. * "XMonad.Prompt.Directory": A directory prompt for XMonad * "XMonad.Prompt.Email": A prompt for sending quick, one-line emails, via the standard GNU \'mail\' utility (which must be in your $PATH). This module is intended mostly as an example of using "XMonad.Prompt.Input" to build an action requiring user input. * "XMonad.Prompt.Input": A generic framework for prompting the user for input and passing it along to some other action. * "XMonad.Prompt.Layout": A layout-selection prompt for XMonad * "XMonad.Prompt.Man": A manual page prompt for XMonad window manager. TODO * narrow completions by section number, if the one is specified (like @\/etc\/bash_completion@ does) * "XMonad.Prompt.RunOrRaise": A prompt for XMonad which will run a program, open a file, or raise an already running program, depending on context. * "XMonad.Prompt.Shell": A shell prompt for XMonad * "XMonad.Prompt.Ssh": A ssh prompt for XMonad * "XMonad.Prompt.Theme": A prompt for changing the theme of the current workspace * "XMonad.Prompt.Window": xprompt operations to bring windows to you, and bring you to windows. * "XMonad.Prompt.Workspace": A workspace prompt for XMonad * "XMonad.Prompt.XMonad": A prompt for running XMonad commands Usually a prompt is called by some key binding. See "XMonad.Doc.Extending#Editing_key_bindings", which includes examples of adding some prompts. -} {- $utils In the @XMonad.Util@ namespace you can find modules exporting various utility functions that are used by the other modules of the xmonad-contrib library. There are also utilities for helping in configuring xmonad or using external utilities. A non complete list with a brief description: * "XMonad.Util.Cursor": configure the default cursor/pointer glyph. * "XMonad.Util.CustomKeys": configure key bindings (see "XMonad.Doc.Extending#Editing_key_bindings"). * "XMonad.Util.Dmenu": A convenient binding to dmenu. Requires the process-1.0 package * "XMonad.Util.Dzen": Handy wrapper for dzen. Requires dzen >= 0.2.4. * "XMonad.Util.EZConfig": configure key bindings easily, including a parser for writing key bindings in "M-C-x" style. * "XMonad.Util.Font": A module for abstracting a font facility over Core fonts and Xft * "XMonad.Util.Invisible": A data type to store the layout state * "XMonad.Util.Loggers": A collection of simple logger functions and formatting utilities which can be used in the 'XMonad.Hooks.DynamicLog.ppExtras' field of a pretty-printing status logger format. See "XMonad.Hooks.DynamicLog" for more information. * "XMonad.Util.NamedActions": A wrapper for keybinding configuration that can list the available keybindings. * "XMonad.Util.NamedScratchpad": Like "XMonad.Util.Scratchpad" toggle windows to and from the current workspace. Supports several arbitrary applications at the same time. * "XMonad.Util.NamedWindows": This module allows you to associate the X titles of windows with them. * "XMonad.Util.Paste": A module for sending key presses to windows. This modules provides generalized and specialized functions for this task. * "XMonad.Util.Replace": Implements a @--replace@ flag outside of core. * "XMonad.Util.Run": This modules provides several commands to run an external process. It is composed of functions formerly defined in "XMonad.Util.Dmenu" (by Spencer Janssen), "XMonad.Util.Dzen" (by glasser\@mit.edu) and XMonad.Util.RunInXTerm (by Andrea Rossato). * "XMonad.Util.Scratchpad": Very handy hotkey-launched toggleable floating terminal window. * "XMonad.Util.StringProp": Internal utility functions for storing Strings with the root window. Used for global state like IORefs with string keys, but more latency, persistent between xmonad restarts. * "XMonad.Util.Themes": A (hopefully) growing collection of themes for decorated layouts. * "XMonad.Util.Timer": A module for setting up timers * "XMonad.Util.Types": Miscellaneous commonly used types. * "XMonad.Util.WindowProperties": EDSL for specifying window properties; various utilities related to window properties. * "XMonad.Util.XSelection": A module for accessing and manipulating X Window's mouse selection (the buffer used in copy and pasting). 'getSelection' and 'putSelection' are adaptations of Hxsel.hs and Hxput.hs from the XMonad-utils * "XMonad.Util.XUtils": A module for painting on the screen -} -------------------------------------------------------------------------------- -- -- Extending Xmonad -- -------------------------------------------------------------------------------- {- $extending #Extending_xmonad# Since the @xmonad.hs@ file is just another Haskell module, you may import and use any Haskell code or libraries you wish, such as extensions from the xmonad-contrib library, or other code you write yourself. -} {- $keys #Editing_key_bindings# Editing key bindings means changing the 'XMonad.Core.XConfig.keys' field of the 'XMonad.Core.XConfig' record used by xmonad. For example, you could write: > import XMonad > > main = xmonad $ def { keys = myKeys } and provide an appropriate definition of @myKeys@, such as: > myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList > [ ((modm, xK_F12), xmonadPrompt def) > , ((modm, xK_F3 ), shellPrompt def) > ] This particular definition also requires importing "XMonad.Prompt", "XMonad.Prompt.Shell", "XMonad.Prompt.XMonad", and "Data.Map": > import qualified Data.Map as M > import XMonad.Prompt > import XMonad.Prompt.Shell > import XMonad.Prompt.XMonad For a list of the names of particular keys (such as xK_F12, and so on), see Usually, rather than completely redefining the key bindings, as we did above, we want to simply add some new bindings and\/or remove existing ones. -} {- $keyAdding #Adding_key_bindings# Adding key bindings can be done in different ways. See the end of this section for the easiest ways. The type signature of 'XMonad.Core.XConfig.keys' is: > keys :: XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()) In order to add new key bindings, you need to first create an appropriate 'Data.Map.Map' from a list of key bindings using 'Data.Map.fromList'. This 'Data.Map.Map' of new key bindings then needs to be joined to a 'Data.Map.Map' of existing bindings using 'Data.Map.union'. Since we are going to need some of the functions of the "Data.Map" module, before starting we must first import this modules: > import qualified Data.Map as M For instance, if you have defined some additional key bindings like these: > myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList > [ ((modm, xK_F12), xmonadPrompt def) > , ((modm, xK_F3 ), shellPrompt def) > ] then you can create a new key bindings map by joining the default one with yours: > newKeys x = myKeys x `M.union` keys def x Finally, you can use @newKeys@ in the 'XMonad.Core.XConfig.keys' field of the configuration: > main = xmonad $ def { keys = newKeys } Alternatively, the '<+>' operator can be used which in this usage does exactly the same as the explicit usage of 'M.union' and propagation of the config argument, thanks to appropriate instances in "Data.Monoid". > main = xmonad $ def { keys = myKeys <+> keys def } All together, your @~\/.xmonad\/xmonad.hs@ would now look like this: > module Main (main) where > > import XMonad > > import qualified Data.Map as M > import Graphics.X11.Xlib > import XMonad.Prompt > import XMonad.Prompt.Shell > import XMonad.Prompt.XMonad > > main :: IO () > main = xmonad $ def { keys = myKeys <+> keys def } > > myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList > [ ((modm, xK_F12), xmonadPrompt def) > , ((modm, xK_F3 ), shellPrompt def) > ] There are much simpler ways to accomplish this, however, if you are willing to use an extension module to help you configure your keys. For instance, "XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" both provide useful functions for editing your key bindings; "XMonad.Util.EZConfig" even lets you use emacs-style keybinding descriptions like \"M-C-\". -} {- $keyDel #Removing_key_bindings# Removing key bindings requires modifying the 'Data.Map.Map' which stores the key bindings. This can be done with 'Data.Map.difference' or with 'Data.Map.delete'. For example, suppose you want to get rid of @mod-q@ and @mod-shift-q@ (you just want to leave xmonad running forever). To do this you need to define @newKeys@ as a 'Data.Map.difference' between the default map and the map of the key bindings you want to remove. Like so: > newKeys x = keys def x `M.difference` keysToRemove x > > keysToRemove :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) > keysToRemove x = M.fromList > [ ((modm , xK_q ), return ()) > , ((modm .|. shiftMask, xK_q ), return ()) > ] As you can see, it doesn't matter what actions we associate with the keys listed in @keysToRemove@, so we just use @return ()@ (the \"null\" action). It is also possible to simply define a list of keys we want to unbind and then use 'Data.Map.delete' to remove them. In that case we would write something like: > newKeys x = foldr M.delete (keys def x) (keysToRemove x) > > keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)] > keysToRemove x = > [ (modm , xK_q ) > , (modm .|. shiftMask, xK_q ) > ] Another even simpler possibility is the use of some of the utilities provided by the xmonad-contrib library. Look, for instance, at 'XMonad.Util.EZConfig.removeKeys'. -} {- $keyAddDel #Adding_and_removing_key_bindings# Adding and removing key bindings requires simply combining the steps for removing and adding. Here is an example from "XMonad.Config.Arossato": > defKeys = keys def > delKeys x = foldr M.delete (defKeys x) (toRemove x) > newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x) > -- remove some of the default key bindings > toRemove XConfig{modMask = modm} = > [ (modm , xK_j ) > , (modm , xK_k ) > , (modm , xK_p ) > , (modm .|. shiftMask, xK_p ) > , (modm .|. shiftMask, xK_q ) > , (modm , xK_q ) > ] ++ > -- I want modm .|. shiftMask 1-9 to be free! > [(shiftMask .|. modm, k) | k <- [xK_1 .. xK_9]] > -- These are my personal key bindings > toAdd XConfig{modMask = modm} = > [ ((modm , xK_F12 ), xmonadPrompt def ) > , ((modm , xK_F3 ), shellPrompt def ) > ] ++ > -- Use modm .|. shiftMask .|. controlMask 1-9 instead > [( (m .|. modm, k), windows $ f i) > | (i, k) <- zip (workspaces x) [xK_1 .. xK_9] > , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)] > ] You can achieve the same result using the "XMonad.Util.CustomKeys" module; take a look at the 'XMonad.Util.CustomKeys.customKeys' function in particular. NOTE: modm is defined as the modMask you defined (or left as the default) in your config. -} {- $mouse #Editing_mouse_bindings# Most of the previous discussion of key bindings applies to mouse bindings as well. For example, you could configure button4 to close the window you click on like so: > import qualified Data.Map as M > > myMouse x = [ (0, button4), (\w -> focus w >> kill) ] > > newMouse x = M.union (mouseBindings def x) (M.fromList (myMouse x)) > > main = xmonad $ def { ..., mouseBindings = newMouse, ... } Overriding or deleting mouse bindings works similarly. You can also configure mouse bindings much more easily using the 'XMonad.Util.EZConfig.additionalMouseBindings' and 'XMonad.Util.EZConfig.removeMouseBindings' functions from the "XMonad.Util.EZConfig" module. -} {- $layoutHook #Editing_the_layout_hook# When you start an application that opens a new window, when you change the focused window, or move it to another workspace, or change that workspace's layout, xmonad will use the 'XMonad.Core.layoutHook' for reordering the visible windows on the visible workspace(s). Since different layouts may be attached to different workspaces, and you can change them, xmonad needs to know which one to use. In this sense the layoutHook may be thought as the list of layouts that xmonad will use for laying out windows on the screen(s). The problem is that the layout subsystem is implemented with an advanced feature of the Haskell programming language: type classes. This allows us to very easily write new layouts, combine or modify existing layouts, create layouts with internal state, etc. See "XMonad.Doc.Extending#The_LayoutClass" for more information. This means that we cannot simply have a list of layouts as we used to have before the 0.5 release: a list requires every member to belong to the same type! Instead the combination of layouts to be used by xmonad is created with a specific layout combinator: 'XMonad.Layout.|||'. Suppose we want a list with the 'XMonad.Layout.Full', 'XMonad.Layout.Tabbed.tabbed' and 'XMonad.Layout.Accordion.Accordion' layouts. First we import, in our @~\/.xmonad\/xmonad.hs@, all the needed modules: > import XMonad > > import XMonad.Layout.Tabbed > import XMonad.Layout.Accordion Then we create the combination of layouts we need: > mylayoutHook = Full ||| tabbed shrinkText def ||| Accordion Now, all we need to do is change the 'XMonad.Core.layoutHook' field of the 'XMonad.Core.XConfig' record, like so: > main = xmonad $ def { layoutHook = mylayoutHook } Thanks to the new combinator, we can apply a layout modifier to a whole combination of layouts, instead of applying it to each one. For example, suppose we want to use the 'XMonad.Layout.NoBorders.noBorders' layout modifier, from the "XMonad.Layout.NoBorders" module (which must be imported): > mylayoutHook = noBorders (Full ||| tabbed shrinkText def ||| Accordion) If we want only the tabbed layout without borders, then we may write: > mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion Our @~\/.xmonad\/xmonad.hs@ will now look like this: > import XMonad > > import XMonad.Layout.Tabbed > import XMonad.Layout.Accordion > import XMonad.Layout.NoBorders > > mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion > > main = xmonad $ def { layoutHook = mylayoutHook } That's it! -} {- $manageHook #Editing_the_manage_hook# The 'XMonad.Core.manageHook' is a very powerful tool for customizing the behavior of xmonad with regard to new windows. Whenever a new window is created, xmonad calls the 'XMonad.Core.manageHook', which can thus be used to perform certain actions on the new window, such as placing it in a specific workspace, ignoring it, or placing it in the float layer. The default 'XMonad.Core.manageHook' causes xmonad to float MPlayer and Gimp, and to ignore gnome-panel, desktop_window, kicker, and kdesktop. The "XMonad.ManageHook" module provides some simple combinators that can be used to alter the 'XMonad.Core.manageHook' by replacing or adding to the default actions. Let's start by analyzing the default 'XMonad.Config.manageHook', defined in "XMonad.Config": > manageHook :: ManageHook > manageHook = composeAll > [ className =? "MPlayer" --> doFloat > , className =? "Gimp" --> doFloat > , resource =? "desktop_window" --> doIgnore > , resource =? "kdesktop" --> doIgnore ] 'XMonad.ManageHook.composeAll' can be used to compose a list of different 'XMonad.Config.ManageHook's. In this example we have a list of 'XMonad.Config.ManageHook's formed by the following commands: the Mplayer's and the Gimp's windows, whose 'XMonad.ManageHook.className' are, respectively \"Mplayer\" and \"Gimp\", are to be placed in the float layer with the 'XMonad.ManageHook.doFloat' function; the windows whose resource names are respectively \"desktop_window\" and \kdesktop\" are to be ignored with the 'XMonad.ManageHook.doIgnore' function. This is another example of 'XMonad.Config.manageHook', taken from "XMonad.Config.Arossato": > myManageHook = composeAll [ resource =? "realplay.bin" --> doFloat > , resource =? "win" --> doF (W.shift "doc") -- xpdf > , resource =? "firefox-bin" --> doF (W.shift "web") > ] > newManageHook = myManageHook <+> manageHook def Again we use 'XMonad.ManageHook.composeAll' to compose a list of different 'XMonad.Config.ManageHook's. The first one will put RealPlayer on the float layer, the second one will put the xpdf windows in the workspace named \"doc\", with 'XMonad.ManageHook.doF' and 'XMonad.StackSet.shift' functions, and the third one will put all firefox windows on the workspace called "web". Then we use the 'XMonad.ManageHook.<+>' combinator to compose @myManageHook@ with the default 'XMonad.Config.manageHook' to form @newManageHook@. Each 'XMonad.Config.ManageHook' has the form: > property =? match --> action Where @property@ can be: * 'XMonad.ManageHook.title': the window's title * 'XMonad.ManageHook.resource': the resource name * 'XMonad.ManageHook.className': the resource class name. * 'XMonad.ManageHook.stringProperty' @somestring@: the contents of the property @somestring@. (You can retrieve the needed information using the X utility named @xprop@; for example, to find the resource class name, you can type > xprop | grep WM_CLASS at a prompt, then click on the window whose resource class you want to know.) @match@ is the string that will match the property value (for instance the one you retrieved with @xprop@). An @action@ can be: * 'XMonad.ManageHook.doFloat': to place the window in the float layer; * 'XMonad.ManageHook.doIgnore': to ignore the window; * 'XMonad.ManageHook.doF': to execute a function with the window as argument. For example, suppose we want to add a 'XMonad.Config.manageHook' to float RealPlayer, which usually has a 'XMonad.ManageHook.resource' name of \"realplay.bin\". First we need to import "XMonad.ManageHook": > import XMonad.ManageHook Then we create our own 'XMonad.Config.manageHook': > myManageHook = resource =? "realplay.bin" --> doFloat We can now use the 'XMonad.ManageHook.<+>' combinator to add our 'XMonad.Config.manageHook' to the default one: > newManageHook = myManageHook <+> manageHook def (Of course, if we wanted to completely replace the default 'XMonad.Config.manageHook', this step would not be necessary.) Now, all we need to do is change the 'XMonad.Core.manageHook' field of the 'XMonad.Core.XConfig' record, like so: > main = xmonad def { ..., manageHook = newManageHook, ... } And we are done. Obviously, we may wish to add more then one 'XMonad.Config.manageHook'. In this case we can use a list of hooks, compose them all with 'XMonad.ManageHook.composeAll', and add the composed to the default one. For instance, if we want RealPlayer to float and thunderbird always opened in the workspace named "mail", we can do so like this: > myManageHook = composeAll [ resource =? "realplay.bin" --> doFloat > , resource =? "thunderbird-bin" --> doF (W.shift "mail") > ] Remember to import the module that defines the 'XMonad.StackSet.shift' function, "XMonad.StackSet", like this: > import qualified XMonad.StackSet as W And then we can add @myManageHook@ to the default one to create @newManageHook@ as we did in the previous example. One more thing to note about this system is that if a window matches multiple rules in a 'XMonad.Config.manageHook', /all/ of the corresponding actions will be run (in the order in which they are defined). This is a change from versions before 0.5, when only the first rule that matched was run. Finally, for additional rules and actions you can use in your manageHook, check out the contrib module "XMonad.Hooks.ManageHelpers". -} {- $logHook #The_log_hook_and_external_status_bars# When the stack of the windows managed by xmonad changes for any reason, xmonad will call 'XMonad.Core.logHook', which can be used to output some information about the internal state of xmonad, such as the layout that is presently in use, the workspace we are in, the focused window's title, and so on. Extracting information about the internal xmonad state can be somewhat difficult if you are not familiar with the source code. Therefore, it's usually easiest to use a module that has been designed specifically for logging some of the most interesting information about the internal state of xmonad: "XMonad.Hooks.DynamicLog". This module can be used with an external status bar to print the produced logs in a convenient way; the most commonly used status bars are dzen and xmobar. By default the 'XMonad.Core.logHook' doesn't produce anything. To enable it you need first to import "XMonad.Hooks.DynamicLog": > import XMonad.Hooks.DynamicLog Then you just need to update the 'XMonad.Core.logHook' field of the 'XMonad.Core.XConfig' record with one of the provided functions. For example: > main = xmonad def { logHook = dynamicLog } More interesting configurations are also possible; see the "XMonad.Hooks.DynamicLog" module for more possibilities. You may now enjoy your extended xmonad experience. Have fun! -} xmonad-contrib-0.12/XMonad/Actions/0000755000000000000000000000000012636047674015353 5ustar0000000000000000xmonad-contrib-0.12/XMonad/Actions/CycleRecentWS.hs0000644000000000000000000001037612636047674020370 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleRecentWS -- Copyright : (c) Michal Janeczek -- License : BSD3-style (see LICENSE) -- -- Maintainer : Michal Janeczek -- Stability : unstable -- Portability : unportable -- -- Provides bindings to cycle through most recently used workspaces -- with repeated presses of a single key (as long as modifier key is -- held down). This is similar to how many window managers handle -- window switching. -- ----------------------------------------------------------------------------- module XMonad.Actions.CycleRecentWS ( -- * Usage -- $usage cycleRecentWS, cycleWindowSets ) where import XMonad hiding (workspaces) import XMonad.StackSet -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Actions.CycleRecentWS -- > -- > , ((modm, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Cycle through most recent workspaces with repeated presses of a key, while -- a modifier key is held down. The recency of workspaces previewed while browsing -- to the target workspace is not affected. That way a stack of most recently used -- workspaces is maintained, similarly to how many window managers handle window -- switching. For best effects use the same modkey+key combination as the one used -- to invoke this action. cycleRecentWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action. -- 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 () cycleRecentWS = cycleWindowSets options where options w = map (view `flip` w) (recentTags w) recentTags w = map tag $ tail (workspaces w) ++ [head (workspaces w)] cycref :: [a] -> Int -> a cycref l i = l !! (i `mod` length l) -- | Cycle through a finite list of WindowSets with repeated presses of a key, while -- a modifier key is held down. For best effects use the same modkey+key combination -- as the one used to invoke this action. 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. -- As soon as one of them is released, the final WindowSet is chosen and the action exits. -> KeySym -- ^ Key used to preview next WindowSet 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. -> X () cycleWindowSets genOptions mods keyNext keyPrev = do options <- gets $ genOptions . windowset XConf {theRoot = root, display = d} <- ask let event = allocaXEvent $ \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p s <- keycodeToKeysym d c 0 return (t, s) let setOption n = do windows $ const $ options `cycref` n (t, s) <- io event case () of () | t == keyPress && s == keyNext -> setOption (n+1) | t == keyPress && s == keyPrev -> setOption (n-1) | t == keyRelease && s `elem` mods -> return () | otherwise -> setOption n io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime setOption 0 io $ ungrabKeyboard d currentTime xmonad-contrib-0.12/XMonad/Actions/Plane.hs0000644000000000000000000001721512636047674016754 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Plane -- Copyright : (c) Marco Túlio Gontijo e Silva , -- Leonardo Serra -- License : BSD3-style (see LICENSE) -- -- Maintainer : Marco Túlio Gontijo e Silva -- Stability : unstable -- Portability : unportable -- -- This module has functions to navigate through workspaces in a bidimensional -- manner. It allows the organization of workspaces in lines, and provides -- functions to move and shift windows in all four directions (left, up, right -- and down) possible in a surface. -- -- This functionality was inspired by GNOME (finite) and KDE (infinite) -- keybindings for workspace navigation, and by "XMonad.Actions.CycleWS" for -- the idea of applying this approach to XMonad. ----------------------------------------------------------------------------- module XMonad.Actions.Plane ( -- * Usage -- $usage -- * Data types Direction (..) , Limits (..) , Lines (..) -- * Key bindings , planeKeys -- * Navigating through workspaces , planeShift , planeMove ) where import Control.Monad import Data.List import Data.Map hiding (split) import Data.Maybe import XMonad import XMonad.StackSet hiding (workspaces) import XMonad.Util.Run -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Actions.Plane -- > import Data.Map (union) -- > -- > main = xmonad def {keys = myKeys} -- > -- > myKeys conf = union (keys def conf) $ myNewKeys conf -- > -- > myNewKeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Direction to go in the plane. data Direction = ToLeft | ToUp | ToRight | ToDown deriving Enum -- | Defines the behaviour when you're trying to move out of the limits. data Limits = Finite -- ^ Ignore the function call, and keep in the same workspace. | Circular -- ^ Get on the other side, like in the Snake game. | Linear -- ^ The plan comes as a row, so it goes to the next or prev if -- the workspaces were numbered. deriving Eq -- | The number of lines in which the workspaces will be arranged. It's -- possible to use a number of lines that is not a divisor of the number of -- workspaces, but the results are better when using a divisor. If it's not a -- divisor, the last line will have the remaining workspaces. data Lines = GConf -- ^ Use @gconftool-2@ to find out the number of lines. | Lines Int -- ^ Specify the number of lines explicitly. -- | This is the way most people would like to use this module. It attaches the -- 'KeyMask' passed as a parameter with 'xK_Left', 'xK_Up', 'xK_Right' and -- 'xK_Down', associating it with 'planeMove' to the corresponding 'Direction'. -- It also associates these bindings with 'shiftMask' to 'planeShift'. planeKeys :: KeyMask -> Lines -> Limits -> Map (KeyMask, KeySym) (X ()) planeKeys modm ln limits = fromList $ [ ((keyMask, keySym), function ln limits direction) | (keySym, direction) <- zip [xK_Left .. xK_Down] $ enumFrom ToLeft , (keyMask, function) <- [(modm, planeMove), (shiftMask .|. modm, planeShift)] ] -- | Shift a window to the next workspace in 'Direction'. Note that this will -- also move to the next workspace. It's a good idea to use the same 'Lines' -- and 'Limits' for all the bindings. planeShift :: Lines -> Limits -> Direction -> X () planeShift = plane shift' shift' :: (Eq s, Eq i, Ord a) => i -> StackSet i l a s sd -> StackSet i l a s sd shift' area = greedyView area . shift area -- | Move to the next workspace in 'Direction'. planeMove :: Lines -> Limits -> Direction -> X () planeMove = plane greedyView plane :: (WorkspaceId -> WindowSet -> WindowSet) -> Lines -> Limits -> Direction -> X () plane function numberLines_ limits direction = do st <- get xconf <- ask numberLines <- liftIO $ case numberLines_ of Lines numberLines__ -> return numberLines__ GConf -> do numberLines__ <- runProcessWithInput gconftool parameters "" case reads numberLines__ of [(numberRead, _)] -> return numberRead _ -> do trace $ "XMonad.Actions.Plane: Could not parse the output of " ++ gconftool ++ unwords parameters ++ ": " ++ numberLines__ ++ "; assuming 1." return 1 let notBorder :: Bool notBorder = (replicate 2 (circular_ < currentWS) ++ replicate 2 (circular_ > currentWS)) !! fromEnum direction circular_ :: Int circular_ = circular currentWS circular :: Int -> Int circular = [ onLine pred , onColumn pred , onLine succ , onColumn succ ] !! fromEnum direction linear :: Int -> Int linear = [ onLine pred . onColumn pred , onColumn pred . onLine pred , onLine succ . onColumn succ , onColumn succ . onLine succ ] !! fromEnum direction onLine :: (Int -> Int) -> Int -> Int onLine f currentWS_ | line < areasLine = mod_ columns | otherwise = mod_ areasColumn where line, column :: Int (line, column) = split currentWS_ mod_ :: Int -> Int mod_ columns_ = compose line $ mod (f column) columns_ onColumn :: (Int -> Int) -> Int -> Int onColumn f currentWS_ | column < areasColumn || areasColumn == 0 = mod_ numberLines | otherwise = mod_ $ pred numberLines where line, column :: Int (line, column) = split currentWS_ mod_ :: Int -> Int mod_ lines_ = compose (mod (f line) lines_) column compose :: Int -> Int -> Int compose line column = line * columns + column split :: Int -> (Int, Int) split currentWS_ = (operation div, operation mod) where operation :: (Int -> Int -> Int) -> Int operation f = f currentWS_ columns areasLine :: Int areasLine = div areas columns areasColumn :: Int areasColumn = mod areas columns columns :: Int columns = if mod areas numberLines == 0 then preColumns else preColumns + 1 currentWS :: Int currentWS = fromJust mCurrentWS preColumns :: Int preColumns = div areas numberLines mCurrentWS :: Maybe Int mCurrentWS = elemIndex (currentTag $ windowset st) areaNames areas :: Int areas = length areaNames run :: (Int -> Int) -> X () run f = windows $ function $ areaNames !! f currentWS areaNames :: [String] areaNames = workspaces $ config xconf when (isJust mCurrentWS) $ case limits of Finite -> when notBorder $ run circular Circular -> run circular Linear -> if notBorder then run circular else run linear gconftool :: String gconftool = "gconftool-2" parameters :: [String] parameters = ["--get", "/apps/panel/applets/workspace_switcher_screen0/prefs/num_rows"] xmonad-contrib-0.12/XMonad/Actions/FloatKeys.hs0000644000000000000000000001221012636047674017604 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.FloatKeys -- Copyright : (c) Karsten Schoelzel -- License : BSD -- -- Maintainer : Karsten Schoelzel -- Stability : stable -- Portability : unportable -- -- Move and resize floating windows. ----------------------------------------------------------------------------- module XMonad.Actions.FloatKeys ( -- * Usage -- $usage keysMoveWindow, keysMoveWindowTo, keysResizeWindow, keysAbsResizeWindow, P, G, ) where import XMonad -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.FloatKeys -- -- Then add appropriate key bindings, for example: -- -- > , ((modm, xK_d ), withFocused (keysResizeWindow (-10,-10) (1,1))) -- > , ((modm, xK_s ), withFocused (keysResizeWindow (10,10) (1,1))) -- > , ((modm .|. shiftMask, xK_d ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752))) -- > , ((modm .|. shiftMask, xK_s ), withFocused (keysAbsResizeWindow (10,10) (1024,752))) -- > , ((modm, xK_a ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2))) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the -- right and @dy@ pixels down. keysMoveWindow :: D -> Window -> X () keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do io $ raiseWindow d w wa <- io $ getWindowAttributes d w io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + dx)) (fromIntegral (fromIntegral (wa_y wa) + dy)) float w -- | @keysMoveWindowTo (x, y) (gx, gy)@ moves the window relative -- point @(gx, gy)@ to the point @(x,y)@, where @(gx,gy)@ gives a -- position relative to the window border, i.e. @gx = 0@ is the left -- border, @gx = 1@ is the right border, @gy = 0@ is the top border, and -- @gy = 1@ the bottom border. -- -- For example, on a 1024x768 screen: -- -- > keysMoveWindowTo (512,384) (1%2, 1%2) -- center the window on screen -- > keysMoveWindowTo (1024,0) (1, 0) -- put window in the top right corner keysMoveWindowTo :: P -> G -> Window -> X () keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do io $ raiseWindow d w wa <- io $ getWindowAttributes d w io $ moveWindow d w (x - round (gx * fromIntegral (wa_width wa))) (y - round (gy * fromIntegral (wa_height wa))) float w type G = (Rational, Rational) type P = (Position, Position) -- | @keysResizeWindow (dx, dy) (gx, gy)@ changes the width by @dx@ -- and the height by @dy@, leaving the window-relative point @(gx, -- gy)@ fixed. -- -- For example: -- -- > keysResizeWindow (10, 0) (0, 0) -- make the window 10 pixels larger to the right -- > 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) (0, 1) -- shrink the window in direction of the bottom-left corner keysResizeWindow :: D -> G -> Window -> X () keysResizeWindow = keysMoveResize keysResizeWindow' -- | @keysAbsResizeWindow (dx, dy) (ax, ay)@ changes the width by @dx@ -- and the height by @dy@, leaving the screen absolute point @(ax, -- ay)@ fixed. -- -- 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 :: D -> D -> Window -> X () keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow' keysAbsResizeWindow' :: SizeHints -> P -> D -> D -> D -> (P,D) keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh)) where (nw, nh) = applySizeHintsContents sh (w + dx, h + dy) nx :: Rational nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w ny :: Rational ny = fromIntegral (ay * h + nh * (fromIntegral y - ay)) / fromIntegral h keysResizeWindow' :: SizeHints -> P -> D -> D -> G -> (P,D) keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh)) where (nw, nh) = applySizeHintsContents sh (w + dx, h + dy) nx = round $ fromIntegral x + gx * fromIntegral w - gx * fromIntegral nw ny = round $ fromIntegral y + gy * fromIntegral h - gy * fromIntegral nh keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X () keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do io $ raiseWindow d w wa <- io $ getWindowAttributes d w sh <- io $ getWMNormalHints d w let wa_dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa) wa_pos = (fromIntegral $ wa_x wa, fromIntegral $ wa_y wa) (wn_pos, wn_dim) = f sh wa_pos wa_dim move resize io $ resizeWindow d w `uncurry` wn_dim io $ moveWindow d w `uncurry` wn_pos float w xmonad-contrib-0.12/XMonad/Actions/Commands.hs0000644000000000000000000001170412636047674017453 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Commands -- Copyright : (c) David Glasser 2007 -- License : BSD3 -- -- Maintainer : glasser@mit.edu -- Stability : stable -- Portability : portable -- -- Allows you to run internal xmonad commands (X () actions) using -- a dmenu menu in addition to key bindings. Requires dmenu and -- the Dmenu XMonad.Actions module. -- ----------------------------------------------------------------------------- module XMonad.Actions.Commands ( -- * Usage -- $usage commandMap, runCommand, runCommand', workspaceCommands, screenCommands, defaultCommands ) where import XMonad import XMonad.StackSet hiding (workspaces) import XMonad.Util.Dmenu (dmenu) import qualified Data.Map as M import System.Exit import Data.Maybe -- $usage -- -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.Commands -- -- Then add a keybinding to the runCommand action: -- -- > , ((modm .|. controlMask, xK_y), commands >>= runCommand) -- -- and define the list of commands you want to use: -- -- > commands :: X [(String, X ())] -- > commands = defaultCommands -- -- Whatever key you bound to will now cause a popup menu of internal -- xmonad commands to appear. You can change the commands by changing -- the contents of the list returned by 'commands'. (If you like it -- enough, you may even want to get rid of many of your other key -- bindings!) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a -- list of pairs. commandMap :: [(String, X ())] -> M.Map String (X ()) commandMap c = M.fromList c -- | Generate a list of commands to switch to\/send windows to workspaces. workspaceCommands :: X [(String, X ())] workspaceCommands = asks (workspaces . config) >>= \spaces -> return [((m ++ show i), windows $ f i) | i <- spaces , (f, m) <- [(view, "view"), (shift, "shift")] ] -- | Generate a list of commands dealing with multiple screens. screenCommands :: [(String, X ())] screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f)) | sc <- [0, 1]::[Int] -- TODO: adapt to screen changes , (f, m) <- [(view, "screen"), (shift, "screen-to-")] ] -- | A nice pre-defined list of commands. defaultCommands :: X [(String, X ())] defaultCommands = do wscmds <- workspaceCommands return $ wscmds ++ screenCommands ++ otherCommands where otherCommands = [ ("shrink" , sendMessage Shrink ) , ("expand" , sendMessage Expand ) , ("next-layout" , sendMessage NextLayout ) , ("default-layout" , asks (layoutHook . config) >>= setLayout ) , ("restart-wm" , restart "xmonad" True ) , ("restart-wm-no-resume", restart "xmonad" False ) , ("xterm" , spawn =<< asks (terminal . config) ) , ("run" , spawn "exe=`dmenu_path | dmenu -b` && exec $exe" ) , ("kill" , kill ) , ("refresh" , refresh ) , ("focus-up" , windows focusUp ) , ("focus-down" , windows focusDown ) , ("swap-up" , windows swapUp ) , ("swap-down" , windows swapDown ) , ("swap-master" , windows swapMaster ) , ("sink" , withFocused $ windows . sink ) , ("quit-wm" , io $ exitWith ExitSuccess ) ] -- | Given a list of command\/action pairs, prompt the user to choose a -- command and return the corresponding action. runCommand :: [(String, X ())] -> X () runCommand cl = do let m = commandMap cl choice <- dmenu (M.keys m) fromMaybe (return ()) (M.lookup choice m) -- | Given the name of a command from 'defaultCommands', return the -- corresponding action (or the null action if the command is not -- found). runCommand' :: String -> X () runCommand' c = do m <- fmap commandMap defaultCommands fromMaybe (return ()) (M.lookup c m) xmonad-contrib-0.12/XMonad/Actions/ShowText.hs0000644000000000000000000000756112636047674017505 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.ShowText -- Copyright : (c) Mario Pastorelli (2012) -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : pastorelli.mario@gmail.com -- Stability : unstable -- Portability : unportable -- -- ShowText displays text for sometime on the screen similar to "XMonad.Util.Dzen" -- which offers more features (currently) ----------------------------------------------------------------------------- module XMonad.Actions.ShowText ( -- * Usage -- $usage def , defaultSTConfig , handleTimerEvent , flashText , ShowTextConfig(..) ) where import Control.Monad (when) import Data.Map (Map,empty,insert,lookup) import Data.Monoid (mempty, All) import Prelude hiding (lookup) import XMonad import XMonad.StackSet (current,screen) import XMonad.Util.Font (Align(AlignCenter) , initXMF , releaseXMF , textExtentsXMF , textWidthXMF) import XMonad.Util.Timer (startTimer) import XMonad.Util.XUtils (createNewWindow , deleteWindow , fi , showWindow , paintAndWrite) import qualified XMonad.Util.ExtensibleState as ES -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.ShowText -- -- Then add the event hook handler: -- -- > xmonad { handleEventHook = myHandleEventHooks <+> handleTimerEvent } -- -- You can then use flashText in your keybindings: -- -- > ((modMask, xK_Right), flashText def 1 "->" >> nextWS) -- -- | ShowText contains the map with timers as keys and created windows as values newtype ShowText = ShowText (Map Atom Window) deriving (Read,Show,Typeable) instance ExtensionClass ShowText where initialValue = ShowText empty -- | Utility to modify a ShowText modShowText :: (Map Atom Window -> Map Atom Window) -> ShowText -> ShowText modShowText f (ShowText m) = ShowText $ f m data ShowTextConfig = STC { st_font :: String -- ^ Font name , st_bg :: String -- ^ Background color , st_fg :: String -- ^ Foreground color } instance Default ShowTextConfig where def = STC { st_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*" , st_bg = "black" , 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 handleTimerEvent :: Event -> X All handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do (ShowText m) <- ES.get :: X ShowText a <- io $ internAtom dis "XMONAD_TIMER" False when (mtyp == a && length d >= 1) (whenJust (lookup (fromIntegral $ d !! 0) m) deleteWindow) mempty handleTimerEvent _ = mempty -- | Shows a window in the center of the screen with the given text flashText :: ShowTextConfig -> Rational -- ^ number of seconds -> String -- ^ text to display -> X () flashText c i s = do f <- initXMF (st_font c) d <- asks display sc <- gets $ fi . screen . current . windowset width <- textWidthXMF d f s (as,ds) <- textExtentsXMF f s let hight = as + ds ht = displayHeight d sc wh = displayWidth d sc y = (fi ht - hight + 2) `div` 2 x = (fi wh - width + 2) `div` 2 w <- createNewWindow (Rectangle (fi x) (fi y) (fi width) (fi hight)) Nothing "" True showWindow w paintAndWrite w f (fi width) (fi hight) 0 (st_bg c) "" (st_fg c) (st_bg c) [AlignCenter] [s] releaseXMF f io $ sync d False t <- startTimer i ES.modify $ modShowText (insert (fromIntegral t) w) xmonad-contrib-0.12/XMonad/Actions/DynamicWorkspaceGroups.hs0000644000000000000000000001131312636047674022351 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.DynamicWorkspaceGroups -- Copyright : (c) Brent Yorgey 2009 -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : experimental -- Portability : unportable -- -- Dynamically manage \"workspace groups\", sets of workspaces being -- used together for some common task or purpose, to allow switching -- between workspace groups in a single action. Note that this only -- makes sense for multi-head setups. -- ----------------------------------------------------------------------------- module XMonad.Actions.DynamicWorkspaceGroups ( -- * Usage -- $usage WSGroupId , addRawWSGroup , addWSGroup , addCurrentWSGroup , forgetWSGroup , viewWSGroup , promptWSGroupView , promptWSGroupAdd , promptWSGroupForget , WSGPrompt ) where import Data.List (find) import Control.Arrow ((&&&)) import qualified Data.Map as M import XMonad import qualified XMonad.StackSet as W import XMonad.Prompt import qualified XMonad.Util.ExtensibleState as XS -- $usage -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: -- -- > import XMonad.Actions.DynamicWorkspaceGroups -- -- Then add keybindings like the following (this example uses -- "XMonad.Util.EZConfig"-style keybindings, but this is not necessary): -- -- > , ("M-y n", promptWSGroupAdd myXPConfig "Name this group: ") -- > , ("M-y g", promptWSGroupView myXPConfig "Go to group: ") -- > , ("M-y d", promptWSGroupForget myXPConfig "Forget group: ") -- type WSGroup = [(ScreenId,WorkspaceId)] type WSGroupId = String data WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup } deriving (Typeable, Read, Show) withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage withWSG f = WSG . f . unWSG instance ExtensionClass WSGroupStorage where initialValue = WSG $ M.empty extensionType = PersistentExtension -- | Add a new workspace group of the given name, mapping to an -- explicitly specified association between screen IDs and workspace -- names. This function could be useful for, say, creating some -- standard workspace groups in your startup hook. addRawWSGroup :: WSGroupId -> [(ScreenId, WorkspaceId)] -> X () addRawWSGroup name = XS.modify . withWSG . M.insert name -- | Add a new workspace group with the given name. addWSGroup :: WSGroupId -> [WorkspaceId] -> X () addWSGroup name wids = withWindowSet $ \w -> do let wss = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w wmap = mapM (strength . (flip lookup wss &&& id)) wids case wmap of Just ps -> addRawWSGroup name ps Nothing -> return () where strength (ma, b) = ma >>= \a -> return (a,b) -- | Give a name to the current workspace group. addCurrentWSGroup :: WSGroupId -> X () addCurrentWSGroup name = withWindowSet $ \w -> addWSGroup name $ map (W.tag . W.workspace) (reverse $ W.current w : W.visible w) -- | Delete the named workspace group from the list of workspace -- groups. Note that this has no effect on the workspaces involved; -- it simply forgets the given name. forgetWSGroup :: WSGroupId -> X () forgetWSGroup = XS.modify . withWSG . M.delete -- | View the workspace group with the given name. viewWSGroup :: WSGroupId -> X () viewWSGroup name = do WSG m <- XS.get case M.lookup name m of Just grp -> mapM_ (uncurry viewWS) grp Nothing -> return () -- | View the given workspace on the given screen. viewWS :: ScreenId -> WorkspaceId -> X () viewWS sid wid = do mw <- findScreenWS sid case mw of Just w -> do windows $ W.view w windows $ W.greedyView wid Nothing -> return () -- | Find the workspace which is currently on the given screen. findScreenWS :: ScreenId -> X (Maybe WorkspaceId) findScreenWS sid = withWindowSet $ return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens data WSGPrompt = WSGPrompt String instance XPrompt WSGPrompt where showXPrompt (WSGPrompt s) = s -- | Prompt for a workspace group to view. promptWSGroupView :: XPConfig -> String -> X () promptWSGroupView xp s = do gs <- fmap (M.keys . unWSG) XS.get mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) viewWSGroup -- | Prompt for a name for the current workspace group. promptWSGroupAdd :: XPConfig -> String -> X () promptWSGroupAdd xp s = mkXPrompt (WSGPrompt s) xp (const $ return []) addCurrentWSGroup -- | Prompt for a workspace group to forget. promptWSGroupForget :: XPConfig -> String -> X () promptWSGroupForget xp s = do gs <- fmap (M.keys . unWSG) XS.get mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) forgetWSGroup xmonad-contrib-0.12/XMonad/Actions/CycleWS.hs0000644000000000000000000003453612636047674017233 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleWS -- Copyright : (c) Joachim Breitner , -- Nelson Elhage (`toggleWS' function) -- License : BSD3-style (see LICENSE) -- -- Maintainer : Joachim Breitner -- Stability : unstable -- Portability : unportable -- -- Provides bindings to cycle forward or backward through the list of -- workspaces, to move windows between workspaces, and to cycle -- between screens. More general combinators provide ways to cycle -- through workspaces in various orders, to only cycle through some -- subset of workspaces, and to cycle by more than one workspace at a -- time. -- -- Note that this module now subsumes the functionality of the former -- @XMonad.Actions.RotView@. Former users of @rotView@ can simply replace -- @rotView True@ with @moveTo Next NonEmptyWS@, and so on. -- -- If you want to exactly replicate the action of @rotView@ (cycling -- through workspace in order lexicographically by tag, instead of in -- the order specified in the config), it can be implemented as: -- -- > rotView b = do t <- findWorkspace getSortByTag (bToDir b) NonEmptyWS 1 -- > windows . greedyView $ t -- > where bToDir True = Next -- > bToDir False = Prev -- ----------------------------------------------------------------------------- module XMonad.Actions.CycleWS ( -- * Usage -- $usage -- * Moving between workspaces -- $moving nextWS , prevWS , shiftToNext , shiftToPrev -- * Toggling the previous workspace -- $toggling , toggleWS , toggleWS' , toggleOrView -- * Moving between screens (xinerama) , nextScreen , prevScreen , shiftNextScreen , shiftPrevScreen , swapNextScreen , swapPrevScreen -- * Moving between workspaces, take two! -- $taketwo , Direction1D(..) , WSType(..) , shiftTo , moveTo , doTo -- * The mother-combinator , findWorkspace , toggleOrDoSkip , skipTags , screenBy ) where import Data.List ( find, findIndex ) import Data.Maybe ( isNothing, isJust ) import XMonad hiding (workspaces) import qualified XMonad.Hooks.WorkspaceHistory as WH import XMonad.StackSet hiding (filter) import XMonad.Util.Types import XMonad.Util.WorkspaceCompare -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Actions.CycleWS -- > -- > -- a basic CycleWS setup -- > -- > , ((modm, xK_Down), nextWS) -- > , ((modm, xK_Up), prevWS) -- > , ((modm .|. shiftMask, xK_Down), shiftToNext) -- > , ((modm .|. shiftMask, xK_Up), shiftToPrev) -- > , ((modm, xK_Right), nextScreen) -- > , ((modm, xK_Left), prevScreen) -- > , ((modm .|. shiftMask, xK_Right), shiftNextScreen) -- > , ((modm .|. shiftMask, xK_Left), shiftPrevScreen) -- > , ((modm, xK_z), toggleWS) -- -- If you want to follow the moved window, you can use both actions: -- -- > , ((modm .|. shiftMask, xK_Down), shiftToNext >> nextWS) -- > , ((modm .|. shiftMask, xK_Up), shiftToPrev >> prevWS) -- -- You can also get fancier with 'moveTo', 'shiftTo', and 'findWorkspace'. -- For example: -- -- > , ((modm , xK_f), moveTo Next EmptyWS) -- find a free workspace -- > , ((modm .|. controlMask, xK_Right), -- a crazy keybinding! -- > do t <- findWorkspace getSortByXineramaRule Next NonEmptyWS 2 -- > windows . view $ t ) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- -- When using the toggle functions, in order to ensure that the workspace -- to which you switch is the previously viewed workspace, use the -- 'logHook' in "XMonad.Hooks.WorkspaceHistory". {- $moving The following commands for moving the view and windows between workspaces are somewhat inflexible, but are very simple and probably Do The Right Thing for most users. All of the commands in this section cycle through workspaces in the order in which they are given in your config. -} -- | Switch to the next workspace. nextWS :: X () nextWS = switchWorkspace 1 -- | Switch to the previous workspace. prevWS :: X () prevWS = switchWorkspace (-1) -- | Move the focused window to the next workspace. shiftToNext :: X () shiftToNext = shiftBy 1 -- | Move the focused window to the previous workspace. shiftToPrev :: X () shiftToPrev = shiftBy (-1) -- $toggling -- | Toggle to the workspace displayed previously. toggleWS :: X () toggleWS = toggleWS' [] -- | Toggle to the previous workspace while excluding some workspaces. -- -- > -- Ignore the scratchpad workspace while toggling: -- > ("M-b", toggleWS' ["NSP"]) toggleWS' :: [WorkspaceId] -> X () toggleWS' skips = lastViewedHiddenExcept skips >>= flip whenJust (windows . view) -- | 'XMonad.StackSet.greedyView' a workspace, or if already there, view -- the previously displayed workspace ala weechat. Change @greedyView@ to -- @toggleOrView@ in your workspace bindings as in the 'XMonad.StackSet.view' -- faq at . -- For more flexibility see 'toggleOrDoSkip'. toggleOrView :: WorkspaceId -> X () toggleOrView = toggleOrDoSkip [] greedyView -- | Allows ignoring listed workspace tags (such as scratchpad's \"NSP\"), and -- running other actions such as view, shift, etc. For example: -- -- > import qualified XMonad.StackSet as W -- > import XMonad.Actions.CycleWS -- > -- > -- toggleOrView for people who prefer view to greedyView -- > toggleOrView' = toggleOrDoSkip [] W.view -- > -- > -- toggleOrView ignoring scratchpad and named scratchpad workspace -- > toggleOrViewNoSP = toggleOrDoSkip ["NSP"] W.greedyView toggleOrDoSkip :: [WorkspaceId] -> (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> X () toggleOrDoSkip skips f toWS = do cur <- gets (currentTag . windowset) if toWS == cur then lastViewedHiddenExcept skips >>= flip whenJust (windows . f) else windows (f toWS) -- | List difference ('\\') for workspaces and tags. Removes workspaces -- matching listed tags from the given workspace list. skipTags :: (Eq i) => [Workspace i l a] -> [i] -> [Workspace i l a] skipTags wss ids = filter ((`notElem` ids) . tag) wss -- | Ignoring the skips, find the best candidate for the last viewed hidden -- workspace. lastViewedHiddenExcept :: [WorkspaceId] -> X (Maybe WorkspaceId) lastViewedHiddenExcept skips = do hs <- gets $ map tag . flip skipTags skips . hidden . windowset vs <- WH.workspaceHistory return $ choose hs (find (`elem` hs) vs) where choose [] _ = Nothing choose (h:_) Nothing = Just h choose _ vh@(Just _) = vh switchWorkspace :: Int -> X () switchWorkspace d = wsBy d >>= windows . greedyView shiftBy :: Int -> X () shiftBy d = wsBy d >>= windows . shift wsBy :: Int -> X (WorkspaceId) wsBy = findWorkspace getSortByIndex Next AnyWS {- $taketwo A few more general commands are also provided, which allow cycling through subsets of workspaces. For example, > moveTo Next EmptyWS will move to the first available workspace with no windows, and > shiftTo Prev (WSIs $ return (('p' `elem`) . tag)) will move the focused window backwards to the first workspace containing the letter 'p' in its name. =) -} -- | What type of workspaces should be included in the cycle? data WSType = EmptyWS -- ^ cycle through empty workspaces | NonEmptyWS -- ^ cycle through non-empty workspaces | HiddenWS -- ^ cycle through non-visible workspaces | HiddenNonEmptyWS -- ^ cycle through non-empty non-visible workspaces | AnyWS -- ^ cycle through all workspaces | WSTagGroup Char -- ^ 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 | WSIs (X (WindowSpace -> Bool)) -- ^ cycle through workspaces satisfying -- an arbitrary predicate -- | Convert a WSType value to a predicate on workspaces. wsTypeToPred :: WSType -> X (WindowSpace -> Bool) wsTypeToPred EmptyWS = return (isNothing . stack) wsTypeToPred NonEmptyWS = return (isJust . stack) wsTypeToPred HiddenWS = do hs <- gets (map tag . hidden . windowset) return (\w -> tag w `elem` hs) wsTypeToPred HiddenNonEmptyWS = do ne <- wsTypeToPred NonEmptyWS hi <- wsTypeToPred HiddenWS return (\w -> hi w && ne w) wsTypeToPred AnyWS = return (const True) wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) `fmap` gets windowset return $ (cur ==).groupName where groupName = takeWhile (/=sep).tag wsTypeToPred (WSIs p) = p -- | View the next workspace in the given direction that satisfies -- the given condition. moveTo :: Direction1D -> WSType -> X () moveTo dir t = doTo dir t getSortByIndex (windows . greedyView) -- | Move the currently focused window to the next workspace in the -- given direction that satisfies the given condition. shiftTo :: Direction1D -> WSType -> X () shiftTo dir t = doTo dir t getSortByIndex (windows . shift) -- | Using the given sort, find the next workspace in the given -- direction of the given type, and perform the given action on it. doTo :: Direction1D -> WSType -> X WorkspaceSort -> (WorkspaceId -> X ()) -> X () doTo dir t srt act = findWorkspace srt dir t 1 >>= act -- | Given a function @s@ to sort workspaces, a direction @dir@, a -- predicate @p@ on workspaces, and an integer @n@, find the tag of -- the workspace which is @n@ away from the current workspace in -- direction @dir@ (wrapping around if necessary), among those -- workspaces, sorted by @s@, which satisfy @p@. -- -- For some useful workspace sorting functions, see -- "XMonad.Util.WorkspaceCompare". -- -- For ideas of what to do with a workspace tag once obtained, note -- that 'moveTo' and 'shiftTo' are implemented by applying @(>>= -- (windows . greedyView))@ and @(>>= (windows . shift))@, respectively, -- to the output of 'findWorkspace'. findWorkspace :: X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceId findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n) where maybeNegate Next d = d maybeNegate Prev d = (-d) findWorkspaceGen :: X WorkspaceSort -> X (WindowSpace -> Bool) -> Int -> X WorkspaceId findWorkspaceGen _ _ 0 = gets (currentTag . windowset) findWorkspaceGen sortX wsPredX d = do wsPred <- wsPredX sort <- sortX ws <- gets windowset let cur = workspace (current ws) sorted = sort (workspaces ws) pivoted = let (a,b) = span ((/= (tag cur)) . tag) sorted in b ++ a ws' = filter wsPred pivoted mCurIx = findWsIndex cur ws' d' = if d > 0 then d - 1 else d next = if null ws' then cur else case mCurIx of Nothing -> ws' !! (d' `mod` length ws') Just ix -> ws' !! ((ix + d) `mod` length ws') return $ tag next findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int findWsIndex ws wss = findIndex ((== tag ws) . tag) wss -- | View next screen nextScreen :: X () nextScreen = switchScreen 1 -- | View prev screen prevScreen :: X () prevScreen = switchScreen (-1) switchScreen :: Int -> X () switchScreen d = do s <- screenBy d mws <- screenWorkspace s case mws of Nothing -> return () Just ws -> windows (view ws) {- | Get the 'ScreenId' /d/ places over. Example usage is a variation of the the default screen keybindings: > -- mod-{w,e}, Switch to previous/next Xinerama screen > -- mod-shift-{w,e}, Move client to previous/next Xinerama screen > -- > [((m .|. modm, key), sc >>= screenWorkspace >>= flip whenJust (windows . f)) > | (key, sc) <- zip [xK_w, xK_e] [(screenBy (-1)),(screenBy 1)] > , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] -} screenBy :: Int -> X (ScreenId) screenBy d = do ws <- gets windowset --let ss = sortBy screen (screens ws) let now = screen (current ws) return $ (now + fromIntegral d) `mod` fromIntegral (length (screens ws)) -- | Swap current screen with next screen swapNextScreen :: X () swapNextScreen = swapScreen 1 -- | Swap current screen with previous screen swapPrevScreen :: X () swapPrevScreen = swapScreen (-1) swapScreen :: Int -> X () swapScreen d = do s <- screenBy d mws <- screenWorkspace s case mws of Nothing -> return () Just ws -> windows (greedyView ws) -- | Move focused window to workspace on next screen shiftNextScreen :: X () shiftNextScreen = shiftScreenBy 1 -- | Move focused window to workspace on prev screen shiftPrevScreen :: X () shiftPrevScreen = shiftScreenBy (-1) shiftScreenBy :: Int -> X () shiftScreenBy d = do s <- screenBy d mws <- screenWorkspace s case mws of Nothing -> return () Just ws -> windows (shift ws) xmonad-contrib-0.12/XMonad/Actions/Search.hs0000644000000000000000000004215312636047674017121 0ustar0000000000000000{- | Module : XMonad.Actions.Search Copyright : (C) 2007 Gwern Branwen License : None; public domain Maintainer : Stability : unstable Portability : unportable; depends on XSelection, XPrompt A module for easily running Internet searches on web sites through xmonad. Modeled after the handy Surfraw CLI search tools at . Additional sites welcomed. -} module XMonad.Actions.Search ( -- * Usage -- $usage search, SearchEngine(..), searchEngine, searchEngineF, promptSearch, promptSearchBrowser, selectSearch, selectSearchBrowser, isPrefixOf, escape, use, intelligent, (!>), prefixAware, namedEngine, amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, stackage, thesaurus, wayback, wikipedia, wiktionary, youtube, vocabulary, duckduckgo, multi, -- * Use case: searching with a submap -- $tip -- * Types Browser, Site, Query, Name, Search ) where import Codec.Binary.UTF8.String (encode) import Data.Char (isAlphaNum, isAscii) import Data.List (isPrefixOf) import Text.Printf import XMonad (X (), liftIO) import XMonad.Prompt (XPConfig (), XPrompt (showXPrompt, nextCompletion, commandToComplete), getNextCompletion, historyCompletionP, mkXPrompt) import XMonad.Prompt.Shell (getBrowser) import XMonad.Util.Run (safeSpawn) import XMonad.Util.XSelection (getSelection) {- $usage This module is intended to allow easy access to databases on the Internet through xmonad's interface. The idea is that one wants to run a search but the query string and the browser to use must come from somewhere. There are two places the query string can come from - the user can type it into a prompt which pops up, or the query could be available already in the X Windows copy\/paste buffer (perhaps you just highlighted the string of interest). Thus, there are two main functions: 'promptSearch', and 'selectSearch' (implemented using the more primitive 'search'). To each of these is passed an engine function; this is a function that knows how to search a particular site. For example, the 'google' function knows how to search Google, and so on. You pass 'promptSearch' and 'selectSearch' the engine you want, the browser you want, and anything special they might need; this whole line is then bound to a key of you choosing in your xmonad.hs. For specific examples, see each function. This module is easily extended to new sites by using 'searchEngine'. The currently available search engines are: * 'amazon' -- Amazon keyword search. * 'alpha' -- Wolfram|Alpha query. * 'codesearch' -- Google Labs Code Search search. * 'deb' -- Debian package search. * 'debbts' -- Debian Bug Tracking System. * 'debpts' -- Debian Package Tracking System. * 'dictionary' -- dictionary.reference.com search. * 'google' -- basic Google search. * 'hackage' -- Hackage, the Haskell package database. * 'hoogle' -- Hoogle, the Haskell libraries API search engine. * 'stackage' -- Stackage, An alternative Haskell libraries API search engine. * 'images' -- Google images. * 'imdb' -- the Internet Movie Database. * 'isohunt' -- isoHunt search. * 'lucky' -- Google "I'm feeling lucky" search. * 'maps' -- Google maps. * 'mathworld' -- Wolfram MathWorld search. * 'openstreetmap' -- OpenStreetMap free wiki world map. * 'scholar' -- Google scholar academic search. * 'thesaurus' -- thesaurus.reference.com search. * 'wayback' -- the Wayback Machine. * 'wikipedia' -- basic Wikipedia search. * 'youtube' -- Youtube video search. * 'vocabulary' -- Dictionary search * 'duckduckgo' -- DuckDuckGo search engine. * 'multi' -- Search based on the prefix. \"amazon:Potter\" will use amazon, etc. With no prefix searches google. Feel free to add more! -} {- $tip In combination with "XMonad.Actions.Submap" you can create a powerful and easy way to search without adding a whole bunch of bindings. First import the necessary modules: > import qualified XMonad.Prompt as P > import qualified XMonad.Actions.Submap as SM > import qualified XMonad.Actions.Search as S Then add the following to your key bindings: > ... > -- Search commands > , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.def) > , ((modm .|. shiftMask, xK_s), SM.submap $ searchEngineMap $ S.selectSearch) > > ... > > searchEngineMap method = M.fromList $ > [ ((0, xK_g), method S.google) > , ((0, xK_h), method S.hoogle) > , ((0, xK_w), method S.wikipedia) > ] Or in combination with XMonad.Util.EZConfig: > ... > ] -- end of regular keybindings > -- Search commands > ++ [("M-s " ++ k, S.promptSearch P.def f) | (k,f) <- searchList ] > ++ [("M-S-s " ++ k, S.selectSearch f) | (k,f) <- searchList ] > > ... > > searchList :: [(String, S.SearchEngine)] > searchList = [ ("g", S.google) > , ("h", S.hoohle) > , ("w", S.wikipedia) > ] Make sure to set firefox to open new pages in a new window instead of in a new tab: @Firefox -> Edit -> Preferences -> Tabs -> New pages should be opened in...@ Now /mod-s/ + /g/\//h/\//w/ prompts you for a search string, then opens a new firefox window that performs the search on Google, Hoogle or Wikipedia respectively. If you select something in whatever application and hit /mod-shift-s/ + /g/\//h/\//w/ it will search the selected string with the specified engine. Happy searching! -} -- | A customized prompt indicating we are searching, and the name of the site. data Search = Search Name instance XPrompt Search where showXPrompt (Search name)= "Search [" ++ name ++ "]: " nextCompletion _ = getNextCompletion commandToComplete _ c = c -- | Escape the search string so search engines understand it. Only -- digits and ASCII letters are not encoded. All non ASCII characters -- which are encoded as UTF8 escape :: String -> String escape = concatMap escapeURIChar escapeURIChar :: Char -> String escapeURIChar c | isAscii c && isAlphaNum c = [c] | otherwise = concatMap (printf "%%%02X") $ encode [c] type Browser = FilePath type Query = String type Site = String -> String type Name = String data SearchEngine = SearchEngine Name Site -- | Given an already defined search engine, extracts its transformation -- function, making it easy to create compound search engines. -- For an instance you can use @use google@ to get a function which -- makes the same transformation as the google search engine would. use :: SearchEngine -> Site use (SearchEngine _ engine) = engine -- | Given a browser, a search engine's transformation function, and a search term, perform the -- requested search in the browser. search :: Browser -> Site -> Query -> X () search browser site query = safeSpawn browser [site query] {- | Given a base URL, create the 'SearchEngine' that escapes the query and appends it to the base. You can easily define a new engine locally using exported functions without needing to modify "XMonad.Actions.Search": > myNewEngine = searchEngine "site" "http://site.com/search=" 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 from site to site, often considerably, so there\'s no general way to cover this. 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. -} searchEngine :: Name -> String -> SearchEngine searchEngine name site = searchEngineF name (\s -> site ++ (escape s)) {- | 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 inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function. > searchFunc :: String -> String > searchFunc s | "wiki:" `isPrefixOf` s = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s) > | "http://" `isPrefixOf` s = s > | otherwise = (use google) s > myNewEngine = searchEngineF "mymulti" searchFunc @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 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 complex searches. The user input will be automatically escaped in search engines created with 'searchEngine', 'searchEngineF', however, completely depends on the transformation function passed to it. -} searchEngineF :: Name -> Site -> SearchEngine searchEngineF = SearchEngine -- The engines. amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, stackage, thesaurus, vocabulary, wayback, wikipedia, wiktionary, youtube, duckduckgo :: SearchEngine amazon = searchEngine "amazon" "http://www.amazon.com/exec/obidos/external-search?index=all&keyword=" alpha = searchEngine "alpha" "http://www.wolframalpha.com/input/?i=" codesearch = searchEngine "codesearch" "http://www.google.com/codesearch?q=" deb = searchEngine "deb" "http://packages.debian.org/" debbts = searchEngine "debbts" "http://bugs.debian.org/" debpts = searchEngine "debpts" "http://packages.qa.debian.org/" dictionary = searchEngine "dict" "http://dictionary.reference.com/browse/" google = searchEngine "google" "http://www.google.com/search?num=100&q=" hackage = searchEngine "hackage" "http://hackage.haskell.org/package/" hoogle = searchEngine "hoogle" "http://www.haskell.org/hoogle/?q=" images = searchEngine "images" "http://images.google.fr/images?q=" imdb = searchEngine "imdb" "http://www.imdb.com/find?s=all&q=" isohunt = searchEngine "isohunt" "http://isohunt.com/torrents/?ihq=" lucky = searchEngine "lucky" "http://www.google.com/search?btnI&q=" maps = searchEngine "maps" "http://maps.google.com/maps?q=" mathworld = searchEngine "mathworld" "http://mathworld.wolfram.com/search/?query=" openstreetmap = searchEngine "openstreetmap" "http://gazetteer.openstreetmap.org/namefinder/?find=" scholar = searchEngine "scholar" "http://scholar.google.com/scholar?q=" stackage = searchEngine "stackage" "www.stackage.org/lts/hoogle?q=" thesaurus = searchEngine "thesaurus" "http://thesaurus.reference.com/search?q=" wikipedia = searchEngine "wiki" "http://en.wikipedia.org/wiki/Special:Search?go=Go&search=" wiktionary = searchEngine "wikt" "http://en.wiktionary.org/wiki/Special:Search?go=Go&search=" youtube = searchEngine "youtube" "http://www.youtube.com/results?search_type=search_videos&search_query=" wayback = searchEngineF "wayback" ("http://web.archive.org/web/*/"++) vocabulary = searchEngine "vocabulary" "http://www.vocabulary.com/search?q=" duckduckgo = searchEngine "duckduckgo" "https://duckduckgo.com/?t=lm&q=" multi :: SearchEngine 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 like the argument, but goes directly to a URL if one is given rather than searching. > myIntelligentGoogleEngine = intelligent google Now if you search for http:\/\/xmonad.org it will directly open in your browser-} intelligent :: SearchEngine -> SearchEngine 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" ~> "foo//bar" removeColonPrefix :: String -> String removeColonPrefix s = if ':' `elem` s then drop 1 $ dropWhile (':' /=) s else s {- | Connects a few search engines into one. If the search engines\' names are \"s1\", \"s2\" and \"s3\", then the resulting engine will use s1 if the query is @s1:word@, s2 if you type @s2:word@ and s3 in all other cases. Example: > multiEngine = intelligent (wikipedia !> mathworld !> (prefixAware google)) Now if you type \"wiki:Haskell\" it will search for \"Haskell\" in Wikipedia, \"mathworld:integral\" will search mathworld, and everything else will fall back to google. The use of intelligent will make sure that URLs are opened directly. -} (!>) :: SearchEngine -> SearchEngine -> SearchEngine (SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if (name1++":") `isPrefixOf` s then site1 (removeColonPrefix s) else site2 s) {- | 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 up searching for google:xmonad if google is your fallback engine and you explicitly add the prefix. -} prefixAware :: SearchEngine -> SearchEngine prefixAware (SearchEngine name site) = SearchEngine name (\s -> if (name++":") `isPrefixOf` s then site $ removeColonPrefix s else site s) {- | Changes search engine's name -} namedEngine :: Name -> SearchEngine -> SearchEngine namedEngine name (SearchEngine _ site) = searchEngineF name site {- | Like 'search', but for use with the output from a Prompt; it grabs the Prompt's result, passes it to a given searchEngine and opens it in a given browser. -} promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X () promptSearchBrowser config browser (SearchEngine name site) = mkXPrompt (Search name) config (historyCompletionP ("Search [" `isPrefixOf`)) $ search browser site {- | Like 'search', but in this case, the string is not specified but grabbed from the user's response to a prompt. Example: > , ((modm, xK_g), promptSearch greenXPConfig google) This specializes "promptSearchBrowser" by supplying the browser argument as supplied by 'getBrowser' from "XMonad.Prompt.Shell". -} promptSearch :: XPConfig -> SearchEngine -> X () promptSearch config engine = liftIO getBrowser >>= \ browser -> promptSearchBrowser config browser engine -- | Like 'search', but for use with the X selection; it grabs the selection, -- passes it to a given searchEngine and opens it in a given browser. selectSearchBrowser :: Browser -> SearchEngine -> X () selectSearchBrowser browser (SearchEngine _ site) = search browser site =<< getSelection {- | Like 'search', but for use with the X selection; it grabs the selection, passes it to a given searchEngine and opens it in the default browser . Example: > , ((modm .|. shiftMask, xK_g), selectSearch google) This specializes "selectSearchBrowser" by supplying the browser argument as supplied by 'getBrowser' from "XMonad.Prompt.Shell". -} selectSearch :: SearchEngine -> X () selectSearch engine = liftIO getBrowser >>= \browser -> selectSearchBrowser browser engine xmonad-contrib-0.12/XMonad/Actions/GridSelect.hs0000644000000000000000000007753512636047674017755 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.GridSelect -- Copyright : Clemens Fruhwirth -- License : BSD-style (see LICENSE) -- -- Maintainer : Clemens Fruhwirth -- Stability : unstable -- Portability : unportable -- -- GridSelect displays items(e.g. the opened windows) in a 2D grid and lets -- the user select from it with the cursor/hjkl keys or the mouse. -- ----------------------------------------------------------------------------- module XMonad.Actions.GridSelect ( -- * Usage -- $usage -- ** Customizing -- *** Using a common GSConfig -- $commonGSConfig -- *** Custom keybindings -- $keybindings -- * Configuration GSConfig(..), def, defaultGSConfig, TwoDPosition, buildDefaultGSConfig, -- * Variations on 'gridselect' gridselect, gridselectWindow, withSelectedWindow, bringSelected, goToSelected, gridselectWorkspace, gridselectWorkspace', spawnSelected, runSelectedAction, -- * Colorizers HasColorizer(defaultColorizer), fromClassName, stringColorizer, colorRangeFromClassName, -- * Navigation Mode assembly TwoD, makeXEventhandler, shadowWithKeymap, -- * Built-in Navigation Mode defaultNavigation, substringSearch, navNSearch, -- * Navigation Components setPos, move, moveNext, movePrev, select, cancel, transformSearchString, -- * Rearrangers -- $rearrangers Rearranger, noRearranger, searchStringRearrangerGenerator, -- * Screenshots -- $screenshots -- * Types TwoDState, ) where import Data.Maybe import Data.Bits import Data.Char import Data.Ord (comparing) import Control.Applicative import Control.Monad.State import Control.Arrow import Data.List as L import qualified Data.Map as M import XMonad hiding (liftX) import XMonad.Util.Font import XMonad.Prompt (mkUnmanagedWindow) import XMonad.StackSet as W import XMonad.Layout.Decoration import XMonad.Util.NamedWindows import XMonad.Actions.WindowBringer (bringWindow) import Text.Printf import System.Random (mkStdGen, genRange, next) import Data.Word (Word8) -- $usage -- -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.GridSelect -- -- Then add a keybinding, e.g. -- -- > , ((modm, xK_g), goToSelected defaultGSConfig) -- -- 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 -- can use the following: -- -- > , ((modm, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"]) -- $commonGSConfig -- -- It is possible to bind a @gsconfig@ at top-level in your configuration. Like so: -- -- > -- the top of your config -- > {-# LANGUAGE NoMonomorphismRestriction #-} -- > import XMonad -- > ... -- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellwidth = 100 } -- -- An example where 'buildDefaultGSConfig' is used instead of 'defaultGSConfig' -- in order to specify a custom colorizer is @gsconfig2@ (found in -- "XMonad.Actions.GridSelect#Colorizers"): -- -- > gsconfig2 colorizer = (buildDefaultGSConfig colorizer) { gs_cellheight = 30, gs_cellwidth = 100 } -- -- > -- | A green monochrome colorizer based on window class -- > greenColorizer = colorRangeFromClassName -- > black -- lowest inactive bg -- > (0x70,0xFF,0x70) -- highest inactive bg -- > black -- active bg -- > white -- inactive fg -- > white -- active fg -- > where black = minBound -- > white = maxBound -- -- Then you can bind to: -- -- > ,((modm, xK_g), goToSelected $ gsconfig2 myWinColorizer) -- > ,((modm, xK_p), spawnSelected $ spawnSelected defaultColorizer) -- $keybindings -- -- You can build you own navigation mode and submodes by combining the -- exported action ingredients and assembling them using 'makeXEventhandler' and 'shadowWithKeymap'. -- -- > myNavigation :: TwoD a (Maybe a) -- > myNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler -- > where navKeyMap = M.fromList [ -- > ((0,xK_Escape), cancel) -- > ,((0,xK_Return), select) -- > ,((0,xK_slash) , substringSearch myNavigation) -- > ,((0,xK_Left) , move (-1,0) >> myNavigation) -- > ,((0,xK_h) , move (-1,0) >> myNavigation) -- > ,((0,xK_Right) , move (1,0) >> myNavigation) -- > ,((0,xK_l) , move (1,0) >> myNavigation) -- > ,((0,xK_Down) , move (0,1) >> myNavigation) -- > ,((0,xK_j) , move (0,1) >> myNavigation) -- > ,((0,xK_Up) , move (0,-1) >> myNavigation) -- > ,((0,xK_y) , move (-1,-1) >> myNavigation) -- > ,((0,xK_i) , move (1,-1) >> myNavigation) -- > ,((0,xK_n) , move (-1,1) >> myNavigation) -- > ,((0,xK_m) , move (1,-1) >> myNavigation) -- > ,((0,xK_space) , setPos (0,0) >> myNavigation) -- > ] -- > -- The navigation handler ignores unknown key symbols -- > navDefaultHandler = const myNavigation -- -- You can then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@: -- -- > gsconfig3 = def -- > { gs_cellheight = 30 -- > , gs_cellwidth = 100 -- > , gs_navigate = myNavigation -- > } -- $screenshots -- -- Selecting a workspace: -- -- <> -- -- Selecting a window by title: -- -- <> -- | The 'Default' instance gives a basic configuration for 'gridselect', with -- the colorizer chosen based on the type. -- -- If you want to replace the 'gs_colorizer' field, use 'buildDefaultGSConfig' -- instead of 'def' to avoid ambiguous type variables. data GSConfig a = GSConfig { gs_cellheight :: Integer, gs_cellwidth :: Integer, gs_cellpadding :: Integer, gs_colorizer :: a -> Bool -> X (String, String), gs_font :: String, gs_navigate :: TwoD a (Maybe a), gs_rearranger :: Rearranger a, gs_originFractX :: Double, gs_originFractY :: Double } -- | That is 'fromClassName' if you are selecting a 'Window', or -- 'defaultColorizer' if you are selecting a 'String'. The catch-all instance -- @HasColorizer a@ uses the 'focusedBorderColor' and 'normalBorderColor' -- colors. class HasColorizer a where defaultColorizer :: a -> Bool -> X (String, String) instance HasColorizer Window where defaultColorizer = fromClassName instance HasColorizer String where defaultColorizer = stringColorizer instance HasColorizer a where defaultColorizer _ isFg = let getColor = if isFg then focusedBorderColor else normalBorderColor in asks $ flip (,) "black" . getColor . config instance HasColorizer a => Default (GSConfig a) where 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 TwoDElementMap a = [(TwoDPosition,(String,a))] data TwoDState a = TwoDState { td_curpos :: TwoDPosition , td_availSlots :: [TwoDPosition] , td_elements :: [(String,a)] , td_gsconfig :: GSConfig a , td_font :: XMonadFont , td_paneX :: Integer , td_paneY :: Integer , td_drawingWin :: Window , td_searchString :: String , td_elementmap :: TwoDElementMap a } generateElementmap :: TwoDState a -> X (TwoDElementMap a) generateElementmap s = do rearrangedElements <- rearranger searchString sortedElements return $ zip positions rearrangedElements where TwoDState {td_availSlots = positions, td_gsconfig = gsconfig, td_searchString = searchString} = s GSConfig {gs_rearranger = rearranger} = gsconfig -- Filter out any elements that don't contain the searchString (case insensitive) filteredElements = L.filter ((searchString `isInfixOfI`) . fst) (td_elements s) -- Sorts the elementmap sortedElements = orderElementmap searchString filteredElements -- Case Insensitive version of isInfixOf needle `isInfixOfI` haystack = (upper needle) `isInfixOf` (upper haystack) upper = map toUpper -- | We enforce an ordering such that we will always get the same result. If the -- elements position changes from call to call of gridselect, then the shown -- positions will also change when you search for the same string. This is -- especially the case when using gridselect for showing and switching between -- workspaces, as workspaces are usually shown in order of last visited. The -- chosen ordering is "how deep in the haystack the needle is" (number of -- characters from the beginning of the string and the needle). orderElementmap :: String -> [(String,a)] -> [(String,a)] orderElementmap searchString elements = if not $ null searchString then sortedElements else elements where upper = map toUpper -- Calculates a (score, element) tuple where the score is the depth of the (case insensitive) needle. calcScore element = ( length $ takeWhile (not . isPrefixOf (upper searchString)) (tails . upper . fst $ element) , element) -- Use the score and then the string as the parameters for comparing, making -- it consistent even when two strings that score the same, as it will then be -- sorted by the strings, making it consistent. compareScore = comparing (\(score, (str,_)) -> (score, str)) sortedElements = map snd . sortBy compareScore $ map calcScore elements newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b } deriving (Monad,Functor,MonadState (TwoDState a)) instance Applicative (TwoD a) where (<*>) = ap pure = return liftX :: X a1 -> TwoD a a1 liftX = TwoD . lift evalTwoD :: TwoD a1 a -> TwoDState a1 -> X a evalTwoD m s = flip evalStateT s $ unTwoD m diamondLayer :: (Enum a, Num a, Eq a) => a -> [(a, a)] diamondLayer 0 = [(0,0)] diamondLayer n = -- tr = top right -- r = ur ++ 90 degree clock-wise rotation of ur let tr = [ (x,n-x) | x <- [0..n-1] ] r = tr ++ (map (\(x,y) -> (y,-x)) tr) in r ++ (map (negate *** negate) r) diamond :: (Enum a, Num a, Eq a) => [(a, a)] diamond = concatMap diamondLayer [0..] diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)] diamondRestrict x y originX originY = L.filter (\(x',y') -> abs x' <= x && abs y' <= y) . map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) . take 1000 $ diamond findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b) findInElementMap pos = find ((== pos) . fst) drawWinBox :: Window -> XMonadFont -> (String, String) -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X () drawWinBox win font (fg,bg) ch cw text x y cp = withDisplay $ \dpy -> do gc <- liftIO $ createGC dpy win bordergc <- liftIO $ createGC dpy win liftIO $ do Just fgcolor <- initColor dpy fg Just bgcolor <- initColor dpy bg Just bordercolor <- initColor dpy borderColor setForeground dpy gc fgcolor setBackground dpy gc bgcolor setForeground dpy bordergc bordercolor fillRectangle dpy win gc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch) drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch) stext <- shrinkWhile (shrinkIt shrinkText) (\n -> do size <- liftIO $ textWidthXMF dpy font n return $ size > (fromInteger (cw-(2*cp)))) text printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+(div ch 2))) stext liftIO $ freeGC dpy gc liftIO $ freeGC dpy bordergc updateAllElements :: TwoD a () updateAllElements = do s <- get updateElements (td_elementmap s) grayoutElements :: Int -> TwoD a () grayoutElements skip = do s <- get updateElementsWithColorizer grayOnly $ drop skip (td_elementmap s) where grayOnly _ _ = return ("#808080", "#808080") updateElements :: TwoDElementMap a -> TwoD a () updateElements elementmap = do s <- get updateElementsWithColorizer (gs_colorizer (td_gsconfig s)) elementmap updateElementsWithColorizer :: (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a () updateElementsWithColorizer colorizer elementmap = do TwoDState { td_curpos = curpos, td_drawingWin = win, td_gsconfig = gsconfig, td_font = font, td_paneX = paneX, td_paneY = paneY} <- get let cellwidth = gs_cellwidth gsconfig cellheight = gs_cellheight gsconfig paneX' = div (paneX-cellwidth) 2 paneY' = div (paneY-cellheight) 2 updateElement (pos@(x,y),(text, element)) = liftX $ do colors <- colorizer element (pos == curpos) drawWinBox win font colors cellheight cellwidth text (paneX'+x*cellwidth) (paneY'+y*cellheight) (gs_cellpadding gsconfig) mapM_ updateElement elementmap stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a) stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop | t == buttonRelease = do s @ TwoDState { td_paneX = px, td_paneY = py, td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _) } <- get let gridX = (fi x - (px - cw) `div` 2) `div` cw gridY = (fi y - (py - ch) `div` 2) `div` ch case lookup (gridX,gridY) (td_elementmap s) of Just (_,el) -> return (Just el) Nothing -> contEventloop | otherwise = contEventloop stdHandle (ExposeEvent { }) contEventloop = updateAllElements >> contEventloop stdHandle _ contEventloop = contEventloop -- | Embeds a key handler into the X event handler that dispatches key -- events to the key handler, while non-key event go to the standard -- handler. makeXEventhandler :: ((KeySym, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a) makeXEventhandler keyhandler = fix $ \me -> join $ liftX $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e ev <- getEvent e if ev_event_type ev == keyPress then do (ks,s) <- lookupString $ asKeyEvent e return $ do mask <- liftX $ cleanMask (ev_state ev) keyhandler (fromMaybe xK_VoidSymbol ks, s, mask) else return $ stdHandle ev me -- | When the map contains (KeySym,KeyMask) tuple for the given event, -- the associated action in the map associated shadows the default key -- handler shadowWithKeymap :: M.Map (KeyMask, KeySym) a -> ((KeySym, String, KeyMask) -> a) -> (KeySym, String, KeyMask) -> a shadowWithKeymap keymap dflt keyEvent@(ks,_,m') = fromMaybe (dflt keyEvent) (M.lookup (m',ks) keymap) -- Helper functions to use for key handler functions -- | Closes gridselect returning the element under the cursor select :: TwoD a (Maybe a) select = do s <- get return $ fmap (snd . snd) $ findInElementMap (td_curpos s) (td_elementmap s) -- | Closes gridselect returning no element. cancel :: TwoD a (Maybe a) cancel = return Nothing -- | Sets the absolute position of the cursor. setPos :: (Integer, Integer) -> TwoD a () setPos newPos = do s <- get let elmap = td_elementmap s newSelectedEl = findInElementMap newPos (td_elementmap s) oldPos = td_curpos s when (isJust newSelectedEl && newPos /= oldPos) $ do put s { td_curpos = newPos } updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl]) -- | Moves the cursor by the offsets specified move :: (Integer, Integer) -> TwoD a () move (dx,dy) = do s <- get let (x,y) = td_curpos s newPos = (x+dx,y+dy) setPos newPos moveNext :: TwoD a () moveNext = do position <- gets td_curpos elems <- gets td_elementmap let n = length elems m = case findIndex (\p -> fst p == position) elems of Nothing -> Nothing Just k | k == n-1 -> Just 0 | otherwise -> Just (k+1) whenJust m $ \i -> setPos (fst $ elems !! i) movePrev :: TwoD a () movePrev = do position <- gets td_curpos elems <- gets td_elementmap let n = length elems m = case findIndex (\p -> fst p == position) elems of Nothing -> Nothing Just 0 -> Just (n-1) Just k -> Just (k-1) whenJust m $ \i -> setPos (fst $ elems !! i) -- | Apply a transformation function the current search string transformSearchString :: (String -> String) -> TwoD a () transformSearchString f = do s <- get let oldSearchString = td_searchString s newSearchString = f oldSearchString when (newSearchString /= oldSearchString) $ do -- FIXME curpos might end up outside new bounds let s' = s { td_searchString = newSearchString } m <- liftX $ generateElementmap s' let s'' = s' { td_elementmap = m } oldLen = length $ td_elementmap s newLen = length $ td_elementmap s'' -- All the elements in the previous element map should be -- grayed out, except for those which will be covered by -- elements in the new element map. when (newLen < oldLen) $ grayoutElements newLen put s'' updateAllElements -- | By default gridselect used the defaultNavigation action, which -- binds left,right,up,down and vi-style h,l,j,k navigation. Return -- quits gridselect, returning the selected element, while Escape -- cancels the selection. Slash enters the substring search mode. In -- substring search mode, every string-associated keystroke is -- added to a search string, which narrows down the object -- selection. Substring search mode comes back to regular navigation -- via Return, while Escape cancels the search. If you want that -- navigation style, add 'defaultNavigation' as 'gs_navigate' to your -- 'GSConfig' object. This is done by 'buildDefaultGSConfig' automatically. defaultNavigation :: TwoD a (Maybe a) defaultNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler where navKeyMap = M.fromList [ ((0,xK_Escape) , cancel) ,((0,xK_Return) , select) ,((0,xK_slash) , substringSearch defaultNavigation) ,((0,xK_Left) , move (-1,0) >> defaultNavigation) ,((0,xK_h) , move (-1,0) >> defaultNavigation) ,((0,xK_Right) , move (1,0) >> defaultNavigation) ,((0,xK_l) , move (1,0) >> defaultNavigation) ,((0,xK_Down) , move (0,1) >> defaultNavigation) ,((0,xK_j) , move (0,1) >> defaultNavigation) ,((0,xK_Up) , move (0,-1) >> defaultNavigation) ,((0,xK_k) , move (0,-1) >> defaultNavigation) ,((0,xK_Tab) , moveNext >> defaultNavigation) ,((0,xK_n) , moveNext >> defaultNavigation) ,((shiftMask,xK_Tab), movePrev >> defaultNavigation) ,((0,xK_p) , movePrev >> defaultNavigation) ] -- The navigation handler ignores unknown key symbols, therefore we const navDefaultHandler = const defaultNavigation -- | This navigation style combines navigation and search into one mode at the cost of losing vi style -- navigation. With this style, there is no substring search submode, -- but every typed character is added to the substring search. navNSearch :: TwoD a (Maybe a) navNSearch = makeXEventhandler $ shadowWithKeymap navNSearchKeyMap navNSearchDefaultHandler where navNSearchKeyMap = M.fromList [ ((0,xK_Escape) , cancel) ,((0,xK_Return) , select) ,((0,xK_Left) , move (-1,0) >> navNSearch) ,((0,xK_Right) , move (1,0) >> navNSearch) ,((0,xK_Down) , move (0,1) >> navNSearch) ,((0,xK_Up) , move (0,-1) >> navNSearch) ,((0,xK_Tab) , moveNext >> navNSearch) ,((shiftMask,xK_Tab), movePrev >> navNSearch) ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> navNSearch) ] -- The navigation handler ignores unknown key symbols, therefore we const navNSearchDefaultHandler (_,s,_) = do transformSearchString (++ s) navNSearch -- | Navigation submode used for substring search. It returns to the -- first argument navigation style when the user hits Return. substringSearch :: TwoD a (Maybe a) -> TwoD a (Maybe a) substringSearch returnNavigation = fix $ \me -> let searchKeyMap = M.fromList [ ((0,xK_Escape) , transformSearchString (const "") >> returnNavigation) ,((0,xK_Return) , returnNavigation) ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> me) ] searchDefaultHandler (_,s,_) = do transformSearchString (++ s) me in makeXEventhandler $ shadowWithKeymap searchKeyMap searchDefaultHandler -- FIXME probably move that into Utils? -- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a) hsv2rgb (h,s,v) = let hi = (div h 60) `mod` 6 :: Integer f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a q = v * (1-f) p = v * (1-s) t = v * (1-(1-f)*s) in case hi of 0 -> (v,t,p) 1 -> (q,v,p) 2 -> (p,v,t) 3 -> (p,q,v) 4 -> (t,p,v) 5 -> (v,p,q) _ -> error "The world is ending. x mod a >= a." -- | Default colorizer for Strings stringColorizer :: String -> Bool -> X (String, String) stringColorizer s active = let seed x = toInteger (sum $ map ((*x).fromEnum) s) :: Integer (r,g,b) = hsv2rgb ((seed 83) `mod` 360, (fromInteger ((seed 191) `mod` 1000))/2500+0.4, (fromInteger ((seed 121) `mod` 1000))/2500+0.4) in if active then return ("#faff69", "black") else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b] ), "white") -- | Colorize a window depending on it's className. fromClassName :: Window -> Bool -> X (String, String) fromClassName w active = runQuery className w >>= flip defaultColorizer active twodigitHex :: Word8 -> String twodigitHex a = printf "%02x" a -- | A colorizer that picks a color inside a range, -- and depending on the window's class. colorRangeFromClassName :: (Word8, Word8, Word8) -- ^ Beginning of the color range -> (Word8, Word8, Word8) -- ^ End of the color range -> (Word8, Word8, Word8) -- ^ Background of the active window -> (Word8, Word8, Word8) -- ^ Inactive text color -> (Word8, Word8, Word8) -- ^ Active text color -> Window -> Bool -> X (String, String) colorRangeFromClassName startC endC activeC inactiveT activeT w active = do classname <- runQuery className w if active then return (rgbToHex activeC, rgbToHex activeT) else return (rgbToHex $ mix startC endC $ stringToRatio classname, rgbToHex inactiveT) where rgbToHex :: (Word8, Word8, Word8) -> String rgbToHex (r, g, b) = '#':twodigitHex r ++twodigitHex g++twodigitHex b -- | Creates a mix of two colors according to a ratio -- (1 -> first color, 0 -> second color). mix :: (Word8, Word8, Word8) -> (Word8, Word8, Word8) -> Double -> (Word8, Word8, Word8) mix (r1, g1, b1) (r2, g2, b2) r = (mix' r1 r2, mix' g1 g2, mix' b1 b2) where mix' a b = truncate $ (fi a * r) + (fi b * (1 - r)) -- | Generates a Double from a string, trying to -- achieve a random distribution. -- 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 stringToRatio :: String -> Double stringToRatio "" = 0 stringToRatio s = let gen = mkStdGen $ sum $ map fromEnum s 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 -- select an element with cursors keys. The selected element is returned. gridselect :: GSConfig a -> [(String,a)] -> X (Maybe a) gridselect _ [] = return Nothing gridselect gsconfig elements = withDisplay $ \dpy -> do rootw <- asks theRoot scr <- gets $ screenRect . W.screenDetail . W.current . windowset win <- liftIO $ mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw (rect_x scr) (rect_y scr) (rect_width scr) (rect_height scr) liftIO $ mapWindow dpy win liftIO $ selectInput dpy win (exposureMask .|. keyPressMask .|. buttonReleaseMask) status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime io $ grabButton dpy button1 anyModifier win True buttonReleaseMask grabModeAsync grabModeAsync none none font <- initXMF (gs_font gsconfig) let screenWidth = toInteger $ rect_width scr screenHeight = toInteger $ rect_height scr selectedElement <- if (status == grabSuccess) then do let restriction ss cs = (fromInteger ss/fromInteger (cs gsconfig)-1)/2 :: Double restrictX = floor $ restriction screenWidth gs_cellwidth restrictY = floor $ restriction screenHeight gs_cellheight originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY coords = diamondRestrict restrictX restrictY originPosX originPosY s = TwoDState { td_curpos = (head coords), td_availSlots = coords, td_elements = elements, td_gsconfig = gsconfig, td_font = font, td_paneX = screenWidth, td_paneY = screenHeight, td_drawingWin = win, td_searchString = "", td_elementmap = [] } m <- generateElementmap s evalTwoD (updateAllElements >> (gs_navigate gsconfig)) (s { td_elementmap = m }) else return Nothing liftIO $ do unmapWindow dpy win destroyWindow dpy win sync dpy False releaseXMF font return selectedElement -- | Like `gridSelect' but with the current windows and their titles as elements gridselectWindow :: GSConfig Window -> X (Maybe Window) gridselectWindow gsconf = windowMap >>= gridselect gsconf -- | Brings up a 2D grid of windows in the center of the screen, and one can -- select a window with cursors keys. The selected window is then passed to -- a callback function. withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X () withSelectedWindow callback conf = do mbWindow <- gridselectWindow conf case mbWindow of Just w -> callback w Nothing -> return () windowMap :: X [(String,Window)] windowMap = do ws <- gets windowset wins <- mapM keyValuePair (W.allWindows ws) return wins where keyValuePair w = flip (,) w `fmap` decorateName' w decorateName' :: Window -> X String decorateName' w = do fmap show $ getName w -- | Builds a default gs config from a colorizer function. buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) borderColor :: String borderColor = "white" -- | Brings selected window to the current workspace. bringSelected :: GSConfig Window -> X () bringSelected = withSelectedWindow $ \w -> do windows (bringWindow w) XMonad.focus w windows W.shiftMaster -- | Switches to selected window's workspace and focuses that window. goToSelected :: GSConfig Window -> X () goToSelected = withSelectedWindow $ windows . W.focusWindow -- | Select an application to spawn from a given list spawnSelected :: GSConfig String -> [String] -> X () spawnSelected conf lst = gridselect conf (zip lst lst) >>= flip whenJust spawn -- | Select an action and run it in the X monad runSelectedAction :: GSConfig (X ()) -> [(String, X ())] -> X () runSelectedAction conf actions = do selectedActionM <- gridselect conf actions case selectedActionM of Just selectedAction -> selectedAction Nothing -> return () -- | Select a workspace and view it using the given function -- (normally 'W.view' or 'W.greedyView') -- -- Another option is to shift the current window to the selected workspace: -- -- > gridselectWorkspace (\ws -> W.greedyView ws . W.shift ws) gridselectWorkspace :: GSConfig WorkspaceId -> (WorkspaceId -> WindowSet -> WindowSet) -> X () gridselectWorkspace conf viewFunc = gridselectWorkspace' conf (windows . viewFunc) -- | Select a workspace and run an arbitrary action on it. gridselectWorkspace' :: GSConfig WorkspaceId -> (WorkspaceId -> X ()) -> X () gridselectWorkspace' conf func = withWindowSet $ \ws -> do let wss = map W.tag $ W.hidden ws ++ map W.workspace (W.current ws : W.visible ws) gridselect conf (zip wss wss) >>= flip whenJust func -- $rearrangers -- -- Rearrangers allow for arbitrary post-filter rearranging of the grid -- elements. -- -- For example, to be able to switch to a new dynamic workspace by typing -- in its name, you can use the following keybinding action: -- -- > import XMonad.Actions.DynamicWorkspaces (addWorkspace) -- > -- > gridselectWorkspace' defaultGSConfig -- > { gs_navigate = navNSearch -- > , gs_rearranger = searchStringRearrangerGenerator id -- > } -- > addWorkspace -- | A function taking the search string and a list of elements, and -- returning a potentially rearranged list of elements. type Rearranger a = String -> [(String, a)] -> X [(String, a)] -- | A rearranger that leaves the elements unmodified. noRearranger :: Rearranger a noRearranger _ = return -- | A generator for rearrangers that append a single element based on the -- search string, if doing so would not be redundant (empty string or value -- already present). searchStringRearrangerGenerator :: (String -> a) -> Rearranger a searchStringRearrangerGenerator f = let r "" xs = return $ xs r s xs | s `elem` map fst xs = return $ xs | otherwise = return $ xs ++ [(s, f s)] in r xmonad-contrib-0.12/XMonad/Actions/Promote.hs0000644000000000000000000000321212636047674017332 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Promote -- Copyright : (c) Miikka Koskinen 2007 -- License : BSD3-style (see LICENSE) -- -- Maintainer : xmonad@s001.ethrael.com -- Stability : unstable -- Portability : unportable -- -- Alternate promote function for xmonad. -- -- Moves the focused window to the master pane. All other windows -- retain their order. If focus is in the master, swap it with the -- next window in the stack. Focus stays in the master. -- ----------------------------------------------------------------------------- module XMonad.Actions.Promote ( -- * Usage -- $usage promote ) where import XMonad import XMonad.StackSet -- $usage -- -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.Promote -- -- then add a keybinding or substitute 'promote' in place of swapMaster: -- -- > , ((modm, xK_Return), promote) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Move the focused window to the master pane. All other windows -- retain their order. If focus is in the master, swap it with the -- next windo in the stack. Focus stays in the master. promote :: X () promote = windows $ modify' $ \c -> case c of Stack _ [] [] -> c Stack t [] (x:rs) -> Stack x [] (t:rs) Stack t ls rs -> Stack t [] (reverse ls ++ rs) xmonad-contrib-0.12/XMonad/Actions/RandomBackground.hs0000644000000000000000000000472312636047674021135 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.RandomBackground -- Copyright : (c) 2009 Anze Slosar -- translation to Haskell by Adam Vogt -- License : BSD3-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- An action to start terminals with a random background color -- ----------------------------------------------------------------------------- module XMonad.Actions.RandomBackground ( -- * Usage -- $usage randomBg', randomBg, RandomColor(HSV,RGB) ) where import XMonad(X, XConf(config), XConfig(terminal), io, spawn, MonadIO, asks) import System.Random import Control.Monad(liftM) import Numeric(showHex) -- $usage -- -- Add to your keybindings something like: -- -- > ,((modm .|. shiftMask, xK_Return), randomBg $ HSV 0xff 0x20 -- | RandomColor fixes constraints when generating random colors. All -- parameters should be in the range 0 -- 0xff data RandomColor = RGB { _colorMin :: Int , _colorMax :: Int } -- ^ specify the minimum and maximum lowest values for each color channel. | HSV { _colorSaturation :: Double , _colorValue :: Double } -- ^ specify the saturation and value, leaving the hue random. toHex :: [Int] -> String toHex = ("'#"++) . (++"'") . concatMap (ensure 2 . ($ "") . showHex) where ensure x = reverse . take x . (++repeat '0') . reverse randPermutation :: (RandomGen g) => [a] -> g -> [a] randPermutation xs g = swap $ zip (randoms g) xs where swap ((True,x):(c,y):ys) = y:swap ((c,x):ys) swap ((False,x):ys) = x:swap ys swap x = map snd x -- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@ randomBg' :: (MonadIO m) => RandomColor -> m String randomBg' (RGB l h) = io $ liftM (toHex . take 3 . randomRs (l,h)) newStdGen randomBg' (HSV s v) = io $ do g <- newStdGen let x = (^(2::Int)) $ fst $ randomR (0,sqrt $ pi / 3) g return $ toHex $ map round $ randPermutation [v,(v-s)*x + s,s] g -- | @randomBg@ starts a terminal with the background color taken from 'randomBg'' -- -- This depends on the your 'terminal' configuration field accepting an -- argument like @-bg '#ff0023'@ randomBg :: RandomColor -> X () randomBg x = do t <- asks (terminal . config) c <- randomBg' x spawn $ t ++ " -bg " ++ c xmonad-contrib-0.12/XMonad/Actions/WorkspaceNames.hs0000644000000000000000000001366012636047674020637 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.WorkspaceNames -- Copyright : (c) Tomas Janousek -- License : BSD3-style (see LICENSE) -- -- Maintainer : Tomas Janousek -- Stability : experimental -- Portability : unportable -- -- Provides bindings to rename workspaces, show these names in DynamicLog and -- swap workspaces along with their names. These names survive restart. -- Together with "XMonad.Layout.WorkspaceDir" this provides for a fully -- dynamic topic space workflow. -- ----------------------------------------------------------------------------- {-# LANGUAGE DeriveDataTypeable #-} module XMonad.Actions.WorkspaceNames ( -- * Usage -- $usage -- * Workspace naming renameWorkspace, workspaceNamesPP, getWorkspaceNames, setWorkspaceName, setCurrentWorkspaceName, -- * Workspace swapping swapTo, swapTo', swapWithCurrent, -- * Workspace prompt workspaceNamePrompt ) where import XMonad import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..)) import qualified XMonad.Actions.SwapWorkspaces as Swap import XMonad.Hooks.DynamicLog (PP(..)) import XMonad.Prompt (mkXPrompt, XPConfig) import XMonad.Prompt.Workspace (Wor(Wor)) import XMonad.Util.WorkspaceCompare (getSortByIndex) import qualified Data.Map as M import Data.Maybe (fromMaybe) import Data.List (isInfixOf) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Actions.WorkspaceNames -- -- Then add keybindings like the following: -- -- > , ((modm .|. shiftMask, xK_r ), renameWorkspace def) -- -- and apply workspaceNamesPP to your DynamicLog pretty-printer: -- -- > myLogHook = -- > workspaceNamesPP xmobarPP >>= dynamicLogString >>= xmonadPropLog -- -- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s -- functionality, which may be used this way: -- -- > , ((modMask .|. shiftMask, xK_Left ), swapTo Prev) -- > , ((modMask .|. shiftMask, xK_Right ), swapTo Next) -- -- > [((modm .|. controlMask, k), swapWithCurrent i) -- > | (i, k) <- zip workspaces [xK_1 ..]] -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Workspace names container. newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String) deriving (Typeable, Read, Show) instance ExtensionClass WorkspaceNames where initialValue = WorkspaceNames M.empty extensionType = PersistentExtension -- | Returns a function that maps workspace tag @\"t\"@ to @\"t:name\"@ for -- workspaces with a name, and to @\"t\"@ otherwise. getWorkspaceNames :: X (WorkspaceId -> String) getWorkspaceNames = do WorkspaceNames m <- XS.get return $ \wks -> case M.lookup wks m of Nothing -> wks Just s -> wks ++ ":" ++ s -- | Sets the name of a workspace. Empty string makes the workspace unnamed -- again. setWorkspaceName :: WorkspaceId -> String -> X () setWorkspaceName w name = do WorkspaceNames m <- XS.get XS.put $ WorkspaceNames $ if null name then M.delete w m else M.insert w name m refresh -- | Sets the name of the current workspace. See 'setWorkspaceName'. setCurrentWorkspaceName :: String -> X () setCurrentWorkspaceName name = do current <- gets (W.currentTag . windowset) setWorkspaceName current name -- | Prompt for a new name for the current workspace and set it. renameWorkspace :: XPConfig -> X () renameWorkspace conf = do mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName 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. swapTo :: Direction1D -> X () swapTo dir = swapTo' dir AnyWS -- | Swap with the previous or next workspace of the given type. swapTo' :: Direction1D -> WSType -> X () swapTo' dir which = findWorkspace getSortByIndex dir which 1 >>= swapWithCurrent -- | See 'XMonad.Actions.SwapWorkspaces.swapWithCurrent'. This is almost the -- same with names. swapWithCurrent :: WorkspaceId -> X () swapWithCurrent t = do current <- gets (W.currentTag . windowset) swapNames t current windows $ Swap.swapWorkspaces t current -- | Swap names of the two workspaces. swapNames :: WorkspaceId -> WorkspaceId -> X () swapNames w1 w2 = do WorkspaceNames m <- XS.get 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' 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. workspaceNamePrompt :: XPConfig -> (String -> X ()) -> X () workspaceNamePrompt conf job = do myWorkspaces <- gets $ map W.tag . W.workspaces . windowset myWorkspacesName <- getWorkspaceNames >>= \f -> return $ map f myWorkspaces let pairs = zip myWorkspacesName myWorkspaces mkXPrompt (Wor "Select workspace: ") conf (contains myWorkspacesName) (job . toWsId pairs) where toWsId pairs name = case lookup name pairs of Nothing -> "" Just i -> i contains completions input = return $ filter (Data.List.isInfixOf input) completions xmonad-contrib-0.12/XMonad/Actions/TagWindows.hs0000644000000000000000000001676512636047674020014 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.TagWindows -- Copyright : (c) Karsten Schoelzel -- License : BSD -- -- Maintainer : Karsten Schoelzel -- Stability : unstable -- Portability : unportable -- -- Functions for tagging windows and selecting them by tags. ----------------------------------------------------------------------------- module XMonad.Actions.TagWindows ( -- * Usage -- $usage addTag, delTag, unTag, setTags, getTags, hasTag, withTaggedP, withTaggedGlobalP, withFocusedP, withTagged , withTaggedGlobal , focusUpTagged, focusUpTaggedGlobal, focusDownTagged, focusDownTaggedGlobal, shiftHere, shiftToScreen, tagPrompt, tagDelPrompt, TagPrompt, ) where import Data.List (nub,sortBy) import Control.Monad import Control.Exception as E import XMonad.StackSet hiding (filter) import XMonad.Prompt import XMonad hiding (workspaces) econst :: Monad m => a -> IOException -> m a econst = const . return -- $usage -- -- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.TagWindows -- > import XMonad.Prompt -- to use tagPrompt -- -- and add keybindings such as the following: -- -- > , ((modm, xK_f ), withFocused (addTag "abc")) -- > , ((modm .|. controlMask, xK_f ), withFocused (delTag "abc")) -- > , ((modm .|. shiftMask, xK_f ), withTaggedGlobalP "abc" W.sink) -- > , ((modm, xK_d ), withTaggedP "abc" (W.shiftWin "2")) -- > , ((modm .|. shiftMask, xK_d ), withTaggedGlobalP "abc" shiftHere) -- > , ((modm .|. controlMask, xK_d ), focusUpTaggedGlobal "abc") -- > , ((modm, xK_g ), tagPrompt def (\s -> withFocused (addTag s))) -- > , ((modm .|. controlMask, xK_g ), tagDelPrompt def) -- > , ((modm .|. shiftMask, xK_g ), tagPrompt def (\s -> withTaggedGlobal s float)) -- > , ((modWinMask, xK_g ), tagPrompt def (\s -> withTaggedP s (W.shiftWin "2"))) -- > , ((modWinMask .|. shiftMask, xK_g ), tagPrompt def (\s -> withTaggedGlobalP s shiftHere)) -- > , ((modWinMask .|. controlMask, xK_g ), tagPrompt def (\s -> focusUpTaggedGlobal s)) -- -- NOTE: Tags are saved as space separated strings and split with -- 'unwords'. Thus if you add a tag \"a b\" the window will have -- the tags \"a\" and \"b\" but not \"a b\". -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | set multiple tags for a window at once (overriding any previous tags) setTags :: [String] -> Window -> X () setTags = setTag . unwords -- | set a tag for a window (overriding any previous tags) -- writes it to the \"_XMONAD_TAGS\" window property setTag :: String -> Window -> X () setTag s w = withDisplay $ \d -> io $ internAtom d "_XMONAD_TAGS" False >>= setTextProperty d w s -- | read all tags of a window -- reads from the \"_XMONAD_TAGS\" window property getTags :: Window -> X [String] getTags w = withDisplay $ \d -> io $ E.catch (internAtom d "_XMONAD_TAGS" False >>= getTextProperty d w >>= wcTextPropertyToTextList d) (econst [[]]) >>= return . words . unwords -- | check a window for the given tag hasTag :: String -> Window -> X Bool hasTag s w = (s `elem`) `fmap` getTags w -- | add a tag to the existing ones addTag :: String -> Window -> X () addTag s w = do tags <- getTags w if (s `notElem` tags) then setTags (s:tags) w else return () -- | remove a tag from a window, if it exists delTag :: String -> Window -> X () delTag s w = do tags <- getTags w setTags (filter (/= s) tags) w -- | remove all tags unTag :: Window -> X () unTag = setTag "" -- | Move the focus in a group of windows, which share the same given tag. -- The Global variants move through all workspaces, whereas the other -- ones operate only on the current workspace focusUpTagged, focusDownTagged, focusUpTaggedGlobal, focusDownTaggedGlobal :: String -> X () focusUpTagged = focusTagged' (reverse . wsToList) focusDownTagged = focusTagged' wsToList focusUpTaggedGlobal = focusTagged' (reverse . wsToListGlobal) focusDownTaggedGlobal = focusTagged' wsToListGlobal wsToList :: (Ord i) => StackSet i l a s sd -> [a] wsToList ws = crs ++ cls where (crs, cls) = (cms down, cms (reverse . up)) cms f = maybe [] f (stack . workspace . current $ ws) wsToListGlobal :: (Ord i) => StackSet i l a s sd -> [a] wsToListGlobal ws = concat ([crs] ++ rws ++ lws ++ [cls]) where curtag = currentTag ws (crs, cls) = (cms down, cms (reverse . up)) cms f = maybe [] f (stack . workspace . current $ ws) (lws, rws) = (mws (<), mws (>)) mws cmp = map (integrate' . stack) . sortByTag . filter (\w -> tag w `cmp` curtag) . workspaces $ ws sortByTag = sortBy (\x y -> compare (tag x) (tag y)) focusTagged' :: (WindowSet -> [Window]) -> String -> X () focusTagged' wl t = gets windowset >>= findM (hasTag t) . wl >>= maybe (return ()) (windows . focusWindow) findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a) findM _ [] = return Nothing findM p (x:xs) = do b <- p x if b then return (Just x) else findM p xs -- | apply a pure function to windows with a tag withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X () withTaggedP t f = withTagged' t (winMap f) withTaggedGlobalP t f = withTaggedGlobal' t (winMap f) winMap :: (Window -> WindowSet -> WindowSet) -> [Window] -> X () winMap f tw = when (tw /= []) (windows $ foldl1 (.) (map f tw)) withTagged, withTaggedGlobal :: String -> (Window -> X ()) -> X () withTagged t f = withTagged' t (mapM_ f) withTaggedGlobal t f = withTaggedGlobal' t (mapM_ f) withTagged' :: String -> ([Window] -> X ()) -> X () withTagged' t m = gets windowset >>= filterM (hasTag t) . index >>= m withTaggedGlobal' :: String -> ([Window] -> X ()) -> X () withTaggedGlobal' t m = gets windowset >>= filterM (hasTag t) . concat . map (integrate' . stack) . workspaces >>= m withFocusedP :: (Window -> WindowSet -> WindowSet) -> X () withFocusedP f = withFocused $ windows . f shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd 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 sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of [] -> s (t:_) -> shiftWin (tag . workspace $ t) w s data TagPrompt = TagPrompt instance XPrompt TagPrompt where showXPrompt TagPrompt = "Select Tag: " tagPrompt :: XPConfig -> (String -> X ()) -> X () tagPrompt c f = do sc <- tagComplList mkXPrompt TagPrompt c (mkComplFunFromList' sc) f tagComplList :: X [String] tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>= mapM getTags >>= return . nub . concat tagDelPrompt :: XPConfig -> X () tagDelPrompt c = do sc <- tagDelComplList if (sc /= []) then mkXPrompt TagPrompt c (mkComplFunFromList' sc) (\s -> withFocused (delTag s)) else return () tagDelComplList :: X [String] tagDelComplList = gets windowset >>= maybe (return []) getTags . peek xmonad-contrib-0.12/XMonad/Actions/Warp.hs0000644000000000000000000000760212636047674016625 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Warp -- Copyright : (c) daniel@wagner-home.com -- License : BSD3-style (see LICENSE) -- -- Maintainer : daniel@wagner-home.com -- Stability : unstable -- Portability : unportable -- -- Warp the pointer to a given window or screen. -- ----------------------------------------------------------------------------- module XMonad.Actions.Warp ( -- * Usage -- $usage banish, banishScreen, Corner(..), warpToScreen, warpToWindow ) where import Data.List import XMonad import XMonad.StackSet as W {- $usage You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: > import XMonad.Actions.Warp then add appropriate keybindings to warp the pointer; for example: > , ((modm, xK_z ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window > >-- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3 > > [((modm .|. controlMask, key), warpToScreen sc (1%2) (1%2)) > | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]] Note that warping to a particular screen may change the focus. -} -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". data Corner = UpperLeft | UpperRight | LowerLeft | LowerRight {- | Move the mouse cursor to a corner of the focused window. Useful for uncluttering things. Internally, this uses numerical parameters. We parametrize on the 'Corner' type so the user need not see the violence inherent in the system. 'warpToScreen' and 'warpToWindow' can be used in a variety of ways. Suppose you wanted to emulate Ratpoison's \'banish\' command, which moves the mouse pointer to a corner? warpToWindow can do that! -} banish :: Corner -> X () banish direction = case direction of LowerRight -> warpToWindow 1 1 LowerLeft -> warpToWindow 0 1 UpperLeft -> warpToWindow 0 0 UpperRight -> warpToWindow 1 0 {- | Same as 'banish' but moves the mouse to the corner of the currently focused screen -} banishScreen :: Corner -> X () banishScreen direction = case direction of LowerRight -> warpToCurrentScreen 1 1 LowerLeft -> warpToCurrentScreen 0 1 UpperLeft -> warpToCurrentScreen 0 0 UpperRight -> warpToCurrentScreen 1 0 where warpToCurrentScreen h v = do ws <- gets windowset warpToScreen (W.screen $ current ws) h v windows (const ws) fraction :: (Integral a, Integral b) => Rational -> a -> b fraction f x = floor (f * fromIntegral x) warp :: Window -> Position -> Position -> X () warp w x y = withDisplay $ \d -> io $ warpPointer d none w 0 0 0 0 x y -- | Warp the pointer to a given position relative to the currently -- focused window. Top left = (0,0), bottom right = (1,1). warpToWindow :: Rational -> Rational -> X () warpToWindow h v = withDisplay $ \d -> withFocused $ \w -> do wa <- io $ getWindowAttributes d w warp w (fraction h (wa_width wa)) (fraction v (wa_height wa)) -- | Warp the pointer to the given position (top left = (0,0), bottom -- right = (1,1)) on the given screen. warpToScreen :: ScreenId -> Rational -> Rational -> X () warpToScreen n h v = do root <- asks theRoot (StackSet {current = x, visible = xs}) <- gets windowset whenJust (fmap (screenRect . W.screenDetail) . find ((n==) . W.screen) $ x : xs) $ \r -> warp root (rect_x r + fraction h (rect_width r)) (rect_y r + fraction v (rect_height r)) xmonad-contrib-0.12/XMonad/Actions/PhysicalScreens.hs0000644000000000000000000001106512636047674021011 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.PhysicalScreens -- Copyright : (c) Nelson Elhage -- License : BSD -- -- Maintainer : Nelson Elhage -- Stability : unstable -- Portability : unportable -- -- Manipulate screens ordered by physical location instead of ID ----------------------------------------------------------------------------- module XMonad.Actions.PhysicalScreens ( -- * Usage -- $usage PhysicalScreen(..) , getScreen , viewScreen , sendToScreen , onNextNeighbour , onPrevNeighbour ) where import XMonad import qualified XMonad.StackSet as W import Data.List (sortBy,findIndex) import Data.Function (on) {- $usage This module allows you name Xinerama screens from XMonad using their physical location relative to each other (as reported by Xinerama), rather than their @ScreenID@ s, which are arbitrarily determined by your X server and graphics hardware. Screens are ordered by the upper-left-most corner, from top-to-bottom and then left-to-right. Example usage in your @~\/.xmonad\/xmonad.hs@ file: > import XMonad.Actions.PhysicalScreens > , ((modMask, xK_a), onPrevNeighbour W.view) > , ((modMask, xK_o), onNextNeighbour W.view) > , ((modMask .|. shiftMask, xK_a), onPrevNeighbour W.shift) > , ((modMask .|. shiftMask, xK_o), onNextNeighbour W.shift) > -- > -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3 > -- mod-shift-{w,e,r}, Move client to screen 1, 2, or 3 > -- > [((modm .|. mask, key), f sc) > | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..] > , (f, mask) <- [(viewScreen, 0), (sendToScreen, shiftMask)]] For detailed instructions on editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". -} -- | The type of the index of a screen by location newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real) -- | Translate a physical screen index to a "ScreenId" getScreen :: PhysicalScreen -> X (Maybe ScreenId) getScreen (P i) = do w <- gets windowset let screens = W.current w : W.visible w if i<0 || i >= length screens then return Nothing else let ss = sortBy (cmpScreen `on` (screenRect . W.screenDetail)) screens in return $ Just $ W.screen $ ss !! i -- | Switch to a given physical screen viewScreen :: PhysicalScreen -> X () viewScreen p = do i <- getScreen p whenJust i $ \s -> do w <- screenWorkspace s whenJust w $ windows . W.view -- | Send the active window to a given physical screen sendToScreen :: PhysicalScreen -> X () sendToScreen p = do i <- getScreen p whenJust i $ \s -> do w <- screenWorkspace s whenJust w $ windows . W.shift -- | Compare two screens by their top-left corners, ordering -- | top-to-bottom and then left-to-right. cmpScreen :: Rectangle -> Rectangle -> Ordering cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2) -- | Get ScreenId for neighbours of the current screen based on position offset. getNeighbour :: Int -> X ScreenId getNeighbour d = do w <- gets windowset let ss = map W.screen $ sortBy (cmpScreen `on` (screenRect . W.screenDetail)) $ W.current w : W.visible w curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss pos = (curPos + d) `mod` length ss return $ ss !! pos neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X () neighbourWindows d f = do s <- getNeighbour d w <- screenWorkspace s whenJust w $ windows . f -- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter. onNextNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X () onNextNeighbour = neighbourWindows 1 -- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter. onPrevNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X () onPrevNeighbour = neighbourWindows (-1) xmonad-contrib-0.12/XMonad/Actions/DynamicWorkspaces.hs0000644000000000000000000002326412636047674021344 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.DynamicWorkspaces -- Copyright : (c) David Roundy -- License : BSD3-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- Provides bindings to add and delete workspaces. -- ----------------------------------------------------------------------------- module XMonad.Actions.DynamicWorkspaces ( -- * Usage -- $usage addWorkspace, addWorkspacePrompt, appendWorkspace, appendWorkspacePrompt, addWorkspaceAt, removeWorkspace, removeWorkspaceByTag, removeEmptyWorkspace, removeEmptyWorkspaceAfter, removeEmptyWorkspaceAfterExcept, addHiddenWorkspace, addHiddenWorkspaceAt, withWorkspace, selectWorkspace, renameWorkspace, renameWorkspaceByName, toNthWorkspace, withNthWorkspace ) where import XMonad hiding (workspaces) import XMonad.StackSet hiding (filter, modify, delete) import XMonad.Prompt.Workspace ( Wor(Wor), workspacePrompt ) import XMonad.Prompt ( XPConfig, mkXPrompt ) import XMonad.Util.WorkspaceCompare ( getSortByIndex ) import Data.List (find) import Data.Maybe (isNothing) import Control.Monad (when) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Actions.DynamicWorkspaces -- > import XMonad.Actions.CopyWindow(copy) -- -- Then add keybindings like the following: -- -- > , ((modm .|. shiftMask, xK_BackSpace), removeWorkspace) -- > , ((modm .|. shiftMask, xK_v ), selectWorkspace def) -- > , ((modm, xK_m ), withWorkspace def (windows . W.shift)) -- > , ((modm .|. shiftMask, xK_m ), withWorkspace def (windows . copy)) -- > , ((modm .|. shiftMask, xK_r ), renameWorkspace def) -- -- > -- mod-[1..9] %! Switch to workspace N -- > -- mod-shift-[1..9] %! Move client to workspace N -- > ++ -- > zip (zip (repeat (modm)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..]) -- > ++ -- > zip (zip (repeat (modm .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..]) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". See also the documentation for -- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'XPConfig'. mkCompl :: [String] -> String -> IO [String] mkCompl l s = return $ filter (\x -> take (length s) x == s) l withWorkspace :: XPConfig -> (String -> X ()) -> X () withWorkspace c job = do ws <- gets (workspaces . windowset) sort <- getSortByIndex let ts = map tag $ sort ws job' t | t `elem` ts = job t | otherwise = addHiddenWorkspace t >> job t mkXPrompt (Wor "") c (mkCompl ts) job' renameWorkspace :: XPConfig -> X () renameWorkspace conf = workspacePrompt conf renameWorkspaceByName renameWorkspaceByName :: String -> X () renameWorkspaceByName w = windows $ \s -> let sett wk = wk { tag = w } setscr scr = scr { workspace = sett $ workspace scr } sets q = q { current = setscr $ current q } in sets $ removeWorkspace' w s toNthWorkspace :: (String -> X ()) -> Int -> X () toNthWorkspace job wnum = do sort <- getSortByIndex ws <- gets (map tag . sort . workspaces . windowset) case drop wnum ws of (w:_) -> job w [] -> return () withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X () withNthWorkspace job wnum = do sort <- getSortByIndex ws <- gets (map tag . sort . workspaces . windowset) case drop wnum ws of (w:_) -> windows $ job w [] -> return () selectWorkspace :: XPConfig -> X () selectWorkspace conf = workspacePrompt conf $ \w -> do s <- gets windowset if tagMember w s then windows $ greedyView w else addWorkspace w -- | Add a new workspace with the given name, or do nothing if a -- workspace with the given name already exists; then switch to the -- newly created workspace. addWorkspace :: String -> X () addWorkspace = addWorkspaceAt (:) -- | Same as addWorkspace, but adds the workspace to the end of the list of workspaces appendWorkspace :: String -> X() appendWorkspace = addWorkspaceAt (flip (++) . return) -- | Adds a new workspace with the given name to the current list of workspaces. -- This function allows the user to pass a function that inserts an element -- into a list at an arbitrary spot. addWorkspaceAt :: (WindowSpace -> [WindowSpace] -> [WindowSpace]) -> String -> X () addWorkspaceAt add newtag = addHiddenWorkspaceAt add newtag >> windows (greedyView newtag) -- | Prompt for the name of a new workspace, add it if it does not -- already exist, and switch to it. addWorkspacePrompt :: XPConfig -> X () addWorkspacePrompt conf = mkXPrompt (Wor "New workspace name: ") conf (const (return [])) addWorkspace -- | Prompt for the name of a new workspace, appending it to the end of the list of workspaces -- if it does not already exist, and switch to it. appendWorkspacePrompt :: XPConfig -> X () appendWorkspacePrompt conf = mkXPrompt (Wor "New workspace name: ") conf (const (return [])) appendWorkspace -- | Add a new hidden workspace with the given name, or do nothing if -- a workspace with the given name already exists. Takes a function to insert -- the workspace at an arbitrary spot in the list. addHiddenWorkspaceAt :: (WindowSpace -> [WindowSpace] -> [WindowSpace]) -> String -> X () addHiddenWorkspaceAt add newtag = whenX (gets (not . tagMember newtag . windowset)) $ do l <- asks (layoutHook . config) windows (addHiddenWorkspace' add newtag l) -- | Add a new hidden workspace with the given name, or do nothing if -- a workspace with the given name already exists. addHiddenWorkspace :: String -> X () addHiddenWorkspace = addHiddenWorkspaceAt (:) -- | Remove the current workspace if it contains no windows. removeEmptyWorkspace :: X () removeEmptyWorkspace = gets (currentTag . windowset) >>= removeEmptyWorkspaceByTag -- | Remove the current workspace. removeWorkspace :: X () removeWorkspace = gets (currentTag . windowset) >>= removeWorkspaceByTag -- | Remove workspace with specific tag if it contains no windows. removeEmptyWorkspaceByTag :: String -> X () removeEmptyWorkspaceByTag t = whenX (isEmpty t) $ removeWorkspaceByTag t -- | Remove workspace with specific tag. removeWorkspaceByTag :: String -> X () removeWorkspaceByTag torem = do s <- gets windowset case s of StackSet { current = Screen { workspace = cur }, hidden = (w:_) } -> do when (torem==tag cur) $ windows $ view $ tag w windows $ removeWorkspace' torem _ -> return () -- | Remove the current workspace after an operation if it is empty and hidden. -- Can be used to remove a workspace if it is empty when leaving it. The -- operation may only change workspace once, otherwise the workspace will not -- be removed. removeEmptyWorkspaceAfter :: X () -> X () removeEmptyWorkspaceAfter = removeEmptyWorkspaceAfterExcept [] -- | Like 'removeEmptyWorkspaceAfter' but use a list of sticky workspaces, -- whose entries will never be removed. removeEmptyWorkspaceAfterExcept :: [String] -> X () -> X () removeEmptyWorkspaceAfterExcept sticky f = do before <- gets (currentTag . windowset) f after <- gets (currentTag . windowset) when (before/=after && before `notElem` sticky) $ removeEmptyWorkspaceByTag before isEmpty :: String -> X Bool isEmpty t = do wsl <- gets $ workspaces . windowset let mws = find (\ws -> tag ws == t) wsl 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' 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 -- it exists. All the windows in that workspace are moved to the current -- workspace. 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 }) , hidden = hs }) = let (xs, ys) = break ((== torem) . tag) hs in removeWorkspace'' xs ys where meld Nothing Nothing = Nothing meld x Nothing = x meld Nothing x = x 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) } } , hidden = xs ++ ys } removeWorkspace'' _ _ = s xmonad-contrib-0.12/XMonad/Actions/ConstrainedResize.hs0000644000000000000000000000410012636047674021335 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.ConstrainedResize -- Copyright : (c) Dougal Stanton -- License : BSD3-style (see LICENSE) -- -- Maintainer : -- Stability : stable -- Portability : unportable -- -- Lets you constrain the aspect ratio of a floating -- window (by, say, holding shift while you resize). -- -- Useful for making a nice circular XClock window. -- ----------------------------------------------------------------------------- module XMonad.Actions.ConstrainedResize ( -- * Usage -- $usage XMonad.Actions.ConstrainedResize.mouseResizeWindow ) where import XMonad -- $usage -- -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import qualified XMonad.Actions.ConstrainedResize as Sqr -- -- Then add something like the following to your mouse bindings: -- -- > , ((modm, button3), (\w -> focus w >> Sqr.mouseResizeWindow w False)) -- > , ((modm .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True )) -- -- The line without the shiftMask replaces the standard mouse resize -- function call, so it's not completely necessary but seems neater -- this way. -- -- For detailed instructions on editing your mouse bindings, see -- "XMonad.Doc.Extending#Editing_mouse_bindings". -- | Resize (floating) window with optional aspect ratio constraints. mouseResizeWindow :: Window -> Bool -> X () mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do io $ raiseWindow d w wa <- io $ getWindowAttributes d w sh <- io $ getWMNormalHints d w io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa)) mouseDrag (\ex ey -> do let x = ex - fromIntegral (wa_x wa) y = ey - fromIntegral (wa_y wa) sz = if c then (max x y, max x y) else (x,y) io $ resizeWindow d w `uncurry` applySizeHintsContents sh sz) (float w) xmonad-contrib-0.12/XMonad/Actions/WorkspaceCursors.hs0000644000000000000000000002002312636047674021223 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.WorkspaceCursors -- Copyright : (c) 2009 Adam Vogt -- License : BSD -- -- Maintainer : Adam Vogt -- Stability : unstable -- Portability : unportable -- -- Like "XMonad.Actions.Plane" for an arbitrary number of dimensions. ----------------------------------------------------------------------------- module XMonad.Actions.WorkspaceCursors ( -- * Usage -- $usage focusDepth ,makeCursors ,toList ,workspaceCursors ,WorkspaceCursors ,getFocus -- * Modifying the focus ,modifyLayer ,modifyLayer' ,shiftModifyLayer,shiftLayer -- * Functions to pass to 'modifyLayer' ,focusNth' ,noWrapUp,noWrapDown, -- * Todo -- $todo -- * Types Cursors, ) where import qualified XMonad.StackSet as W import XMonad.Actions.FocusNth(focusNth') import XMonad.Layout.LayoutModifier(ModifiedLayout(..), LayoutModifier(handleMess, redoLayout)) import XMonad(Typeable, Message, WorkspaceId, X, XState(windowset), fromMessage, sendMessage, windows, gets) import Control.Monad((<=<), guard, liftM, liftM2, 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 -- -- Here is an example config: -- -- > import XMonad -- > import XMonad.Actions.WorkspaceCursors -- > import XMonad.Hooks.DynamicLog -- > import XMonad.Util.EZConfig -- > import qualified XMonad.StackSet as W -- > -- > main = do -- > x <- xmobar conf -- > xmonad x -- > -- > conf = additionalKeysP def -- > { layoutHook = workspaceCursors myCursors $ layoutHook def -- > , workspaces = toList myCursors } $ -- > [("M-"++shift++control++[k], f direction depth) -- > | (f,shift) <- zip [modifyLayer,shiftModifyLayer] ["","S-"] -- > , (direction,control) <- zip [W.focusUp',W.focusDown'] ["C-",""] -- > , (depth,k) <- zip (reverse [1..focusDepth myCursors]) "asdf"] -- > ++ moreKeybindings -- > -- > moreKeybindings = [] -- > -- > myCursors = makeCursors $ map (map (\x -> [x])) [ "1234", "abc", "xyz"] -- > -- myCursors = makeCursors [["wsA","wsB","wsC"],["-alpha-","-beta-","-gamma-"],["x","y"]] -- $todo -- -- * Find and document how to raise the allowable length of arguments: -- restoring xmonad's state results in: @xmonad: executeFile: resource -- exhausted (Argument list too long)@ when you specify more than about 50 -- workspaces. Or change it such that workspaces are created when you try to -- view it. -- -- * Function for pretty printing for DynamicLog that groups workspaces by -- common prefixes -- -- * Examples of adding workspaces to the cursors, having them appear multiple -- times for being able to show jumping to some n'th multiple workspace -- | makeCursors requires a nonempty string, and each sublist must be nonempty makeCursors :: [[String]] -> Cursors String makeCursors [] = error "Workspace Cursors cannot be empty" makeCursors a = concat . reverse <$> foldl addDim x xs where x = end $ map return $ head a xs = map (map return) $ tail a -- this could probably be simplified, but this true: -- toList . makeCursors == map (concat . reverse) . sequence . reverse . map (map (:[])) -- the strange order is used because it makes the regular M-1..9 -- bindings change the prefixes first addDim :: (Monoid a) => Cursors a -> [a] -> Cursors a addDim prev prefixes = Cons . fromJust . W.differentiate $ map ((<$> prev) . mappend) prefixes end :: [a] -> Cursors a end = Cons . fromJust . W.differentiate . map End data Cursors a = Cons (W.Stack (Cursors a)) | End a deriving (Eq,Show,Read,Typeable) instance Foldable Cursors where foldMap f (End x) = f x foldMap f (Cons (W.Stack x y z)) = foldMap f x `mappend` mconcat (map (foldMap f) $ reverse y ++ z) instance Functor Cursors where fmap f (End a) = End $ f a fmap f (Cons (W.Stack x y z)) = Cons $ W.Stack (fmap f x) (fmap (fmap f) y) (fmap (fmap f) z) changeFocus :: (Cursors t -> Bool) -> Cursors t -> [Cursors t] changeFocus p (Cons x) = do choose <- chFocus p x foc <- changeFocus p $ W.focus choose return . Cons $ choose { W.focus = foc } changeFocus p x = guard (p x) >> return x chFocus :: (a -> Bool) -> W.Stack a -> [W.Stack a] chFocus p st = filter (p . W.focus) $ zipWith const (iterate W.focusDown' st) (W.integrate st) getFocus :: Cursors b -> b getFocus (Cons x) = getFocus $ W.focus x getFocus (End x) = x -- This could be made more efficient, if the fact that the suffixes are grouped focusTo :: (Eq t) => t -> Cursors t -> Maybe (Cursors t) focusTo x = listToMaybe . filter ((x==) . getFocus) . changeFocus (const True) -- | non-wrapping version of 'W.focusUp'' noWrapUp :: W.Stack t -> W.Stack t noWrapUp (W.Stack t (l:ls) rs) = W.Stack l ls (t:rs) noWrapUp x@(W.Stack _ [] _ ) = x -- | non-wrapping version of 'W.focusDown'' noWrapDown :: W.Stack t -> W.Stack t noWrapDown = reverseStack . noWrapUp . reverseStack where reverseStack (W.Stack t ls rs) = W.Stack t rs ls focusDepth :: Cursors t -> Int focusDepth (Cons x) = 1 + focusDepth (W.focus x) focusDepth (End _) = 0 descend :: Monad m =>(W.Stack (Cursors a) -> m (W.Stack (Cursors a)))-> Int-> Cursors a-> m (Cursors a) descend f 1 (Cons x) = Cons `liftM` f x descend f n (Cons x) | n > 1 = liftM Cons $ descend f (pred n) `onFocus` x descend _ _ x = return x onFocus :: (Monad m) => (a1 -> m a1) -> W.Stack a1 -> m (W.Stack a1) 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 :: (W.Stack (Cursors String) -> W.Stack (Cursors String)) -> Int -> X () modifyLayer f depth = modifyCursors (descend (return . f) depth) -- | @shiftModifyLayer@ is the same as 'modifyLayer', but also shifts the -- currently focused window to the new workspace shiftModifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors WorkspaceId))-> Int-> X () shiftModifyLayer f = modifyLayer' $ \st -> do let st' = f st windows $ W.shift $ getFocus (Cons st') return st' -- | @shiftLayer@ is the same as 'shiftModifyLayer', but the focus remains on -- the current workspace. shiftLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors WorkspaceId))-> Int-> X () shiftLayer f = modifyLayer' $ \st -> do windows $ W.shift $ getFocus $ Cons $ f st return st -- | example usages are 'shiftLayer' and 'shiftModifyLayer' modifyLayer' :: (W.Stack (Cursors String) -> X (W.Stack (Cursors String))) -> Int -> X () modifyLayer' f depth = modifyCursors (descend f depth) modifyCursors :: (Cursors String -> X (Cursors String)) -> X () modifyCursors = sendMessage . ChangeCursors . (liftM2 (>>) updateXMD return <=<) data WorkspaceCursors a = WorkspaceCursors (Cursors String) deriving (Typeable,Read,Show) -- | The state is stored in the 'WorkspaceCursors' layout modifier. Put this as -- your outermost modifier, unless you want different cursors at different -- times (using "XMonad.Layout.MultiToggle") workspaceCursors :: Cursors String -> l a -> ModifiedLayout WorkspaceCursors l a workspaceCursors = ModifiedLayout . WorkspaceCursors data ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) } deriving (Typeable) instance Message ChangeCursors updateXMD :: Cursors WorkspaceId -> X () updateXMD cs = do changed <- gets $ (getFocus cs /=) . W.currentTag . windowset when changed $ windows $ W.greedyView $ getFocus cs instance LayoutModifier WorkspaceCursors a where redoLayout (WorkspaceCursors cs) _ _ arrs = do cws <- gets $ W.currentTag . windowset return (arrs,WorkspaceCursors <$> focusTo cws cs) handleMess (WorkspaceCursors cs) m = sequenceA $ fmap WorkspaceCursors . ($ cs) . unWrap <$> fromMessage m xmonad-contrib-0.12/XMonad/Actions/KeyRemap.hs0000644000000000000000000001362212636047674017430 0ustar0000000000000000 {-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.KeyRemap -- Copyright : (c) Christian Dietrich -- License : BSD-style (as xmonad) -- -- Maintainer : stettberger@dokucde.de -- Stability : unstable -- Portability : unportable -- -- Remap Keybinding on the fly, e.g having Dvorak char, but everything with Control/Shift -- is left us Layout -- ----------------------------------------------------------------------------- module XMonad.Actions.KeyRemap ( -- * Usage -- $usage setKeyRemap, buildKeyRemapBindings, setDefaultKeyRemap, KeymapTable (KeymapTable), emptyKeyRemap, dvorakProgrammerKeyRemap ) where import XMonad import XMonad.Util.Paste import Data.List import qualified XMonad.Util.ExtensibleState as XS import Control.Monad data KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show) instance ExtensionClass KeymapTable where initialValue = KeymapTable [] -- $usage -- Provides the possibility to remap parts of the keymap to generate different keys -- -- * E.g You want to type Programmers Dvorak, but your keybindings should be the normal us layout -- after all -- -- First, you must add all possible keybindings for all layout you want to use: -- -- > keys = myKeys ++ buildKeyRemapBindings [dvorakProgrammerKeyRemap,emptyKeyRemap] -- -- Then you must add setDefaultKeyRemap to your startup hook (e.g. you want to set the -- empty keyremap (no remapping is done) as default after startup): -- -- > myStartupHook :: X() -- > myStartupHook = do -- > setWMName "LG3D" -- > setDefaultKeyRemap emptyKeyRemap [dvorakProgrammerKeyRemap, emptyKeyRemap] -- -- Then you add keybindings for changing keyboard layouts; -- -- > , ((0 , xK_F1 ), setKeyRemap emptyKeyRemap) -- > , ((0 , xK_F2 ), setKeyRemap dvorakProgrammerKeyRemap) -- -- When defining your own keymappings, please be aware of: -- -- * If you want to emulate a key that is shifted on us you must emulate that keypress: -- -- > KeymapTable [((0, xK_a), (shiftMask, xK_5))] -- would bind 'a' to '%' -- > KeymapTable [((shiftMask, xK_a), (0, xK_5))] -- would bind 'A' to '5' -- -- * the dvorakProgrammerKeyRemap uses the original us layout as lookuptable to generate -- the KeymapTable -- -- * KeySym and (ord Char) are incompatible, therefore the magic numbers in dvorakProgrammerKeyRemap -- are nessesary doKeyRemap :: KeyMask -> KeySym -> X() doKeyRemap mask sym = do table <- XS.get let (insertMask, insertSym) = extractKeyMapping table mask sym sendKey insertMask insertSym -- | Using this in the keybindings to set the actual Key Translation table setKeyRemap :: KeymapTable -> X() setKeyRemap table = do let KeymapTable newtable = table KeymapTable oldtable <- XS.get XConf { display = dpy, theRoot = rootw } <- ask let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync let ungrab kc m = io $ ungrabKey dpy kc m rootw forM_ oldtable $ \((mask, sym), _) -> do kc <- io $ keysymToKeycode dpy sym -- "If the specified KeySym is not defined for any KeyCode, -- XKeysymToKeycode() returns zero." when (kc /= 0) $ ungrab kc mask forM_ newtable $ \((mask, sym), _) -> do kc <- io $ keysymToKeycode dpy sym -- "If the specified KeySym is not defined for any KeyCode, -- XKeysymToKeycode() returns zero." when (kc /= 0) $ grab kc mask XS.put table -- | Adding this to your startupHook, to select your default Key Translation table. -- You also must give it all the KeymapTables you are willing to use setDefaultKeyRemap :: KeymapTable -> [KeymapTable] -> X() setDefaultKeyRemap dflt keyremaps = do XS.put (KeymapTable mappings) setKeyRemap dflt where mappings = nub (keyremaps >>= \(KeymapTable table) -> table) extractKeyMapping :: KeymapTable -> KeyMask -> KeySym -> (KeyMask, KeySym) extractKeyMapping (KeymapTable table) mask sym = insertKey filtered where filtered = filter (\((m, s),_) -> m == mask && s == sym) table insertKey [] = (mask, sym) insertKey ((_, to):_) = to -- | Append the output of this function to your keybindings with ++ buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())] buildKeyRemapBindings keyremaps = [((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings] where mappings = concat (map (\(KeymapTable table) -> table) keyremaps) bindings = nub (map (\binding -> fst binding) mappings) -- Here come the Keymappings -- | The empty KeymapTable, does no translation emptyKeyRemap :: KeymapTable emptyKeyRemap = KeymapTable [] -- | The dvorak Programmers keymap, translates from us keybindings to dvorak programmers dvorakProgrammerKeyRemap :: KeymapTable dvorakProgrammerKeyRemap = KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) | (maskFrom, from, maskTo, to) <- (zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey)] where layoutUs = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?" :: [KeySym] layoutUsKey = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./" :: [KeySym] layoutUsShift = "0000000000000000000000000000000000000000000000011111111111111111111111111111111111111111111111" layoutDvorak = map (fromIntegral . fromEnum) "$&[{}(=*)+]!#;,.pyfgcrl/@\\aoeuidhtns-'qjkxbmwvz~%7531902468`:<>PYFGCRL?^|AOEUIDHTNS_\"QJKXBMWVZ" :: [KeySym] layoutDvorakShift = map getShift layoutDvorak layoutDvorakKey = map getKey layoutDvorak getKey char = let Just index = elemIndex char layoutUs in layoutUsKey !! index getShift char = let Just index = elemIndex char layoutUs in layoutUsShift !! index charToMask char = if [char] == "0" then 0 else shiftMask xmonad-contrib-0.12/XMonad/Actions/SinkAll.hs0000644000000000000000000000205712636047674017250 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.SinkAll -- License : BSD3-style (see LICENSE) -- Stability : unstable -- Portability : unportable -- -- Provides a simple binding that pushes all floating windows on the -- current workspace back into tiling. Note that the functionality of -- this module has been folded into the more general -- "XMonad.Actions.WithAll"; this module simply re-exports the -- 'sinkAll' function for backwards compatibility. ----------------------------------------------------------------------------- module XMonad.Actions.SinkAll ( -- * Usage -- $usage sinkAll) where import XMonad.Actions.WithAll (sinkAll) -- $usage -- -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.SinkAll -- -- then add a keybinding; for example: -- -- > , ((modm .|. shiftMask, xK_t), sinkAll) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". xmonad-contrib-0.12/XMonad/Actions/OnScreen.hs0000644000000000000000000001475612636047674017440 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.OnScreen -- Copyright : (c) 2009 Nils Schweinsberg -- License : BSD3-style (see LICENSE) -- -- Maintainer : Nils Schweinsberg -- Stability : unstable -- Portability : unportable -- -- Control workspaces on different screens (in xinerama mode). -- ----------------------------------------------------------------------------- module XMonad.Actions.OnScreen ( -- * Usage -- $usage onScreen , onScreen' , Focus(..) , viewOnScreen , greedyViewOnScreen , onlyOnScreen , toggleOnScreen , toggleGreedyOnScreen ) where import XMonad import XMonad.StackSet hiding (new) import Control.Monad (guard) -- import Control.Monad.State.Class (gets) import Data.Maybe (fromMaybe) -- | Focus data definitions data Focus = FocusNew -- ^ always focus the new screen | FocusCurrent -- ^ always keep the focus on the current screen | FocusTag WorkspaceId -- ^ always focus tag i on the new stack | FocusTagVisible WorkspaceId -- ^ focus tag i only if workspace with tag i is visible on the old stack -- | Run any function that modifies the stack on a given screen. This function -- will also need to know which Screen to focus after the function has been -- run. onScreen :: (WindowSet -> WindowSet) -- ^ function to run -> Focus -- ^ what to do with the focus -> ScreenId -- ^ screen id -> WindowSet -- ^ current stack -> WindowSet onScreen f foc sc st = fromMaybe st $ do ws <- lookupWorkspace sc st let fStack = f $ view ws st return $ setFocus foc st fStack -- set focus for new stack setFocus :: Focus -> WindowSet -- ^ old stack -> WindowSet -- ^ new stack -> WindowSet setFocus FocusNew _ new = new setFocus FocusCurrent old new = case lookupWorkspace (screen $ current old) new of Nothing -> new Just i -> view i new setFocus (FocusTag i) _ new = view i new setFocus (FocusTagVisible i) old new = if i `elem` map (tag . workspace) (visible old) then setFocus (FocusTag i) old new else setFocus FocusCurrent old new -- | A variation of @onScreen@ which will take any @X ()@ function and run it -- on the given screen. -- Warning: This function will change focus even if the function it's supposed -- to run doesn't succeed. onScreen' :: X () -- ^ X function to run -> Focus -- ^ focus -> ScreenId -- ^ screen id -> X () onScreen' x foc sc = do st <- gets windowset case lookupWorkspace sc st of Nothing -> return () Just ws -> do windows $ view ws x windows $ setFocus foc st -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @view@ to -- switch focus to the workspace @i@. viewOnScreen :: ScreenId -- ^ screen id -> WorkspaceId -- ^ index of the workspace -> WindowSet -- ^ current stack -> WindowSet viewOnScreen sid i = onScreen (view i) (FocusTag i) sid -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @greedyView@ -- to switch the current workspace with workspace @i@. greedyViewOnScreen :: ScreenId -- ^ screen id -> WorkspaceId -- ^ index of the workspace -> WindowSet -- ^ current stack -> WindowSet greedyViewOnScreen sid i = onScreen (greedyView i) (FocusTagVisible i) sid -- | Switch to workspace @i@ on screen @sc@. If @i@ is visible do nothing. onlyOnScreen :: ScreenId -- ^ screen id -> WorkspaceId -- ^ index of the workspace -> WindowSet -- ^ current stack -> WindowSet onlyOnScreen sid i = onScreen (view i) FocusCurrent sid -- | @toggleOrView@ as in "XMonad.Actions.CycleWS" for @onScreen@ with view toggleOnScreen :: ScreenId -- ^ screen id -> WorkspaceId -- ^ index of the workspace -> WindowSet -- ^ current stack -> WindowSet toggleOnScreen sid i = onScreen (toggleOrView' view i) FocusCurrent sid -- | @toggleOrView@ from "XMonad.Actions.CycleWS" for @onScreen@ with greedyView toggleGreedyOnScreen :: ScreenId -- ^ screen id -> WorkspaceId -- ^ index of the workspace -> WindowSet -- ^ current stack -> WindowSet toggleGreedyOnScreen sid i = onScreen (toggleOrView' greedyView i) FocusCurrent sid -- a \"pure\" version of X.A.CycleWS.toggleOrDoSkip toggleOrView' :: (WorkspaceId -> WindowSet -> WindowSet) -- ^ function to run -> WorkspaceId -- ^ tag to look for -> WindowSet -- ^ current stackset -> WindowSet toggleOrView' f i st = fromMaybe (f i st) $ do let st' = hidden st -- make sure we actually have to do something guard $ i == (tag . workspace $ current st) guard $ not (null st') -- finally, toggle! return $ f (tag . head $ st') st -- $usage -- -- This module provides an easy way to control, what you see on other screens in -- xinerama mode without having to focus them. Put this into your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.OnScreen -- -- Then add the appropriate keybindings, for example replace your current keys -- to switch the workspaces with this at the bottom of your keybindings: -- -- > ++ -- > [ ((m .|. modm, k), windows (f i)) -- > | (i, k) <- zip (workspaces conf) ([xK_1 .. xK_9] ++ [xK_0]) -- > , (f, m) <- [ (viewOnScreen 0, 0) -- > , (viewOnScreen 1, controlMask) -- > , (greedyView, controlMask .|. shiftMask) ] -- > ] -- -- This will provide you with the following keybindings: -- -- * modkey + 1-0: -- Switch to workspace 1-0 on screen 0 -- -- * modkey + control + 1-0: -- Switch to workspace 1-0 on screen 1 -- -- * modkey + control + shift + 1-0: -- Default greedyView behaviour -- -- -- A more basic version inside the default keybindings would be: -- -- > , ((modm .|. controlMask, xK_1), windows (viewOnScreen 0 "1")) -- -- where 0 is the first screen and \"1\" the workspace with the tag \"1\". -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". xmonad-contrib-0.12/XMonad/Actions/UpdateFocus.hs0000644000000000000000000000406612636047674020137 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.UpdateFocus -- Copyright : (c) Daniel Schoepe -- License : BSD3-style (see LICENSE) -- -- Maintainer : Daniel Schoepe -- Stability : unstable -- Portability : unportable -- -- Updates the focus on mouse move in unfocused windows. -- ----------------------------------------------------------------------------- module XMonad.Actions.UpdateFocus ( -- * Usage -- $usage focusOnMouseMove, adjustEventInput ) where import XMonad import qualified XMonad.StackSet as W import Control.Monad (when) import Data.Monoid -- $usage -- To make the focus update on mouse movement within an unfocused window, add the -- following to your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.UpdateFocus -- > xmonad $ def { -- > .. -- > startupHook = adjustEventInput -- > handleEventHook = focusOnMouseMove -- > .. -- > } -- -- This module is probably only useful when focusFollowsMouse is set to True(default). -- | Changes the focus if the mouse is moved within an unfocused window. focusOnMouseMove :: Event -> X All focusOnMouseMove (MotionEvent { ev_x = x, ev_y = y, ev_window = root }) = do -- check only every 15 px to avoid excessive calls to translateCoordinates when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do dpy <- asks display foc <- withWindowSet $ return . W.peek -- get the window under the pointer: (_,_,_,w) <- io $ translateCoordinates dpy root root (fromIntegral x) (fromIntegral y) when (foc /= Just w) $ focus w return (All True) focusOnMouseMove _ = return (All True) -- | Adjusts the event mask to pick up pointer movements. adjustEventInput :: X () adjustEventInput = withDisplay $ \dpy -> do rootw <- asks theRoot io $ selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask .|. buttonPressMask .|. pointerMotionMask xmonad-contrib-0.12/XMonad/Actions/DwmPromote.hs0000644000000000000000000000315512636047674020010 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.DwmPromote -- Copyright : (c) Miikka Koskinen 2007 -- License : BSD3-style (see LICENSE) -- -- Maintainer : arcatan@kapsi.fi -- Stability : stable -- Portability : unportable -- -- Dwm-like swap function for xmonad. -- -- Swaps focused window with the master window. If focus is in the -- master, swap it with the next window in the stack. Focus stays in the -- master. -- ----------------------------------------------------------------------------- module XMonad.Actions.DwmPromote ( -- * Usage -- $usage dwmpromote ) where import XMonad import XMonad.StackSet -- $usage -- -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.DwmPromote -- -- then add a keybinding or substitute 'dwmpromote' in place of promote: -- -- > , ((modm, xK_Return), dwmpromote) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Swap the focused window with the master window. If focus is in -- the master, swap it with the next window in the stack. Focus -- stays in the master. dwmpromote :: X () dwmpromote = windows $ modify' $ \c -> case c of Stack _ [] [] -> c Stack t [] (x:rs) -> Stack x [] (t:rs) Stack t ls rs -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls xmonad-contrib-0.12/XMonad/Actions/FloatSnap.hs0000644000000000000000000004126012636047674017601 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.FloatSnap -- Copyright : (c) 2009 Anders Engstrom -- License : BSD3-style (see LICENSE) -- -- Maintainer : Anders Engstrom -- Stability : unstable -- Portability : unportable -- -- Move and resize floating windows using other windows and the edge of the -- screen as guidelines. ----------------------------------------------------------------------------- module XMonad.Actions.FloatSnap ( -- * Usage -- $usage Direction2D(..), snapMove, snapGrow, snapShrink, snapMagicMove, snapMagicResize, snapMagicMouseResize, afterDrag, ifClick, ifClick') where import XMonad import Control.Applicative((<$>)) import Data.List (sort) import Data.Maybe (listToMaybe,fromJust,isNothing) import qualified XMonad.StackSet as W import qualified Data.Set as S import XMonad.Hooks.ManageDocks (calcGap) import XMonad.Util.Types (Direction2D(..)) import XMonad.Actions.AfterDrag -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.FloatSnap -- -- Then add appropriate key bindings, for example: -- -- > , ((modm, xK_Left), withFocused $ snapMove L Nothing) -- > , ((modm, xK_Right), withFocused $ snapMove R Nothing) -- > , ((modm, xK_Up), withFocused $ snapMove U Nothing) -- > , ((modm, xK_Down), withFocused $ snapMove D Nothing) -- > , ((modm .|. shiftMask, xK_Left), withFocused $ snapShrink R Nothing) -- > , ((modm .|. shiftMask, xK_Right), withFocused $ snapGrow R Nothing) -- > , ((modm .|. shiftMask, xK_Up), withFocused $ snapShrink D Nothing) -- > , ((modm .|. shiftMask, xK_Down), withFocused $ snapGrow D Nothing) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- -- And possibly add appropriate mouse bindings, for example: -- -- > , ((modm, button1), (\w -> focus w >> mouseMoveWindow w >> ifClick (snapMagicMove (Just 50) (Just 50) w))) -- > , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> ifClick (snapMagicResize [L,R,U,D] (Just 50) (Just 50) w))) -- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> ifClick (snapMagicResize [R,D] (Just 50) (Just 50) w))) -- -- For detailed instructions on editing your mouse bindings, see -- "XMonad.Doc.Extending#Editing_mouse_bindings". -- -- Using these mouse bindings, it will not snap while moving, but allow you to click the window once after it has been moved or resized to snap it into place. -- Note that the order in which the commands are applied in the mouse bindings are important. Snapping can also be used together with other window resizing -- functions, such as those from "XMonad.Actions.FlexibleResize" -- -- An alternative set of mouse bindings that will always snap after the drag is: -- -- > , ((modm, button1), (\w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicMove (Just 50) (Just 50) w))) -- > , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicResize [L,R,U,D] (Just 50) (Just 50) w))) -- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> afterDrag (snapMagicResize [R,D] (Just 50) (Just 50) w))) -- -- Interesting values for the distance to look for window in the orthogonal axis are Nothing (to snap against every window), Just 0 (to only snap -- against windows that we should collide with geometrically while moving) and Just 1 (to also snap against windows we brush against). -- -- For 'snapMagicMove', 'snapMagicResize' and 'snapMagicMouseResize', try instead setting it to the same as the maximum snapping distance. -- -- When a value is specified it can be geometrically conceived as adding a border with the specified width around the window and then checking which -- windows it should collide with. -- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen. Use the location of the -- mouse over the window to decide which edges to snap. In corners, the two adjoining edges will be snapped, along the middle of an edge only that edge -- will be snapped. In the center of the window all edges will snap. Intended to be used together with "XMonad.Actions.FlexibleResize" or -- "XMonad.Actions.FlexibleManipulate". snapMagicMouseResize :: Rational -- ^ How big the middle snap area of each axis should be. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary. -> Window -- ^ The window to move and resize. -> X () snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do wa <- io $ getWindowAttributes d w (_, _, _, px, py, _, _, _) <- io $ queryPointer d w let x = (fromIntegral px - wx wa)/(ww wa) y = (fromIntegral py - wy wa)/(wh wa) ml = if x <= (0.5 - middle/2) then [L] else [] mr = if x > (0.5 + middle/2) then [R] else [] mu = if y <= (0.5 - middle/2) then [U] else [] md = if y > (0.5 + middle/2) then [D] else [] mdir = ml++mr++mu++md dir = if mdir == [] then [L,R,U,D] else mdir snapMagicResize dir collidedist snapdist w where wx = fromIntegral.wa_x wy = fromIntegral.wa_y ww = fromIntegral.wa_width wh = fromIntegral.wa_height -- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen. snapMagicResize :: [Direction2D] -- ^ The edges to snap. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary. -> Window -- ^ The window to move and resize. -> X () snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do io $ raiseWindow d w wa <- io $ getWindowAttributes d w (xbegin,xend) <- handleAxis True d wa (ybegin,yend) <- handleAxis False d wa let xbegin' = if L `elem` dir then xbegin else (wx wa) xend' = if R `elem` dir then xend else (wx wa + ww wa) ybegin' = if U `elem` dir then ybegin else (wy wa) yend' = if D `elem` dir then yend else (wy wa + wh wa) io $ moveWindow d w (fromIntegral $ xbegin') (fromIntegral $ ybegin') io $ resizeWindow d w (fromIntegral $ xend' - xbegin') (fromIntegral $ yend' - ybegin') float w where wx = fromIntegral.wa_x wy = fromIntegral.wa_y ww = fromIntegral.wa_width wh = fromIntegral.wa_height handleAxis horiz d wa = do ((mbl,mbr,bs),(mfl,mfr,fs)) <- getSnap horiz collidedist d w let begin = if bs then wpos wa else case (mbl,mbr) of (Just bl,Just br) -> if wpos wa - bl < br - wpos wa then bl else br (Just bl,Nothing) -> bl (Nothing,Just br) -> br (Nothing,Nothing) -> wpos wa end = if fs then wpos wa + wdim wa 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,Nothing) -> fl (Nothing,Just fr) -> fr (Nothing,Nothing) -> wpos wa + wdim 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) return (begin',end') where (wpos, wdim, _, _) = constructors horiz -- | Move a window by both axises in any direction to snap against the closest part of other windows or the edge of the screen. snapMagicMove :: Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary. -> Window -- ^ The window to move. -> X () snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do io $ raiseWindow d w wa <- io $ getWindowAttributes d w nx <- handleAxis True d wa ny <- handleAxis False d wa io $ moveWindow d w (fromIntegral nx) (fromIntegral ny) float w where handleAxis horiz d wa = do ((mbl,mbr,bs),(mfl,mfr,fs)) <- getSnap horiz collidedist d w return $ if bs || fs then wpos wa else let b = case (mbl,mbr) of (Just bl,Just br) -> if wpos wa - bl < br - wpos wa then bl else br (Just bl,Nothing) -> bl (Nothing,Just br) -> br (Nothing,Nothing) -> wpos wa f = case (mfl,mfr) of (Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr (Just fl,Nothing) -> fl (Nothing,Just fr) -> fr (Nothing,Nothing) -> wpos 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) where (wpos, wdim, _, _) = constructors horiz -- | Move a window in the specified direction until it snaps against another window or the edge of the screen. snapMove :: Direction2D -- ^ What direction to move the window in. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Window -- ^ The window to move. -> X () snapMove L = doSnapMove True True snapMove R = doSnapMove True False snapMove U = doSnapMove False True snapMove D = doSnapMove False False doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X () doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do io $ raiseWindow d w wa <- io $ getWindowAttributes d w ((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w let (mb,mf) = if rev then (bl,fl) else (br,fr) newpos = fromIntegral $ case (mb,mf) of (Just b,Nothing) -> b (Nothing,Just f) -> f - wdim wa (Just b,Just f) -> if rev /= (b < f - wdim wa) then b else f - wdim wa _ -> wpos wa if horiz then io $ moveWindow d w newpos (fromIntegral $ wa_y wa) else io $ moveWindow d w (fromIntegral $ wa_x wa) newpos float w where (wpos, wdim, _, _) = constructors horiz -- | Grow the specified edge of a window until it snaps against another window or the edge of the screen. snapGrow :: Direction2D -- ^ What edge of the window to grow. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Window -- ^ The window to grow. -> X () snapGrow = snapResize True -- | Shrink the specified edge of a window until it snaps against another window or the edge of the screen. snapShrink :: Direction2D -- ^ What edge of the window to shrink. -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window. -> Window -- ^ The window to shrink. -> X () snapShrink = snapResize False snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X () snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do io $ raiseWindow d w wa <- io $ getWindowAttributes d w mr <- case dir of L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w return $ case (if grow then mg else ms) of Just v -> Just (v, wy wa, ww wa + wx wa - v, wh wa) _ -> Nothing R -> do ((_,_,_),(ms,mg,_)) <- getSnap True collidedist d w return $ case (if grow then mg else ms) of Just v -> Just (wx wa, wy wa, v - wx wa, wh wa) _ -> Nothing U -> do ((mg,ms,_),(_,_,_)) <- getSnap False collidedist d w return $ case (if grow then mg else ms) of Just v -> Just (wx wa, v, ww wa, wh wa + wy wa - v) _ -> Nothing D -> do ((_,_,_),(ms,mg,_)) <- getSnap False collidedist d w return $ case (if grow then mg else ms) of Just v -> Just (wx wa, wy wa, ww wa, v - wy wa) _ -> Nothing case mr of Nothing -> return () 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) else return () float w where wx = fromIntegral.wa_x wy = fromIntegral.wa_y ww = fromIntegral.wa_width wh = fromIntegral.wa_height getSnap :: Bool -> Maybe Int -> Display -> Window -> X ((Maybe Int,Maybe Int,Bool),(Maybe Int,Maybe Int,Bool)) getSnap horiz collidedist d w = do wa <- io $ getWindowAttributes d w screen <- W.current <$> gets windowset let sr = screenRect $ W.screenDetail screen wl = W.integrate' . W.stack $ W.workspace screen gr <- fmap ($sr) $ calcGap $ S.fromList [minBound .. maxBound] wla <- filter (collides wa) `fmap` (io $ mapM (getWindowAttributes d) $ filter (/=w) wl) return ( neighbours (back wa sr gr wla) (wpos wa) , neighbours (front wa sr gr wla) (wpos wa + wdim wa) ) where wborder = fromIntegral.wa_border_width (wpos, wdim, rpos, rdim) = constructors horiz (refwpos, refwdim, _, _) = constructors $ not horiz back wa sr gr wla = dropWhile (< rpos sr) $ takeWhile (< rpos sr + rdim sr) $ sort $ (rpos sr):(rpos gr):(rpos gr + rdim gr): foldr (\a as -> (wpos a):(wpos a + wdim a + wborder a + wborder wa):as) [] wla front wa sr gr wla = dropWhile (<= rpos sr) $ takeWhile (<= rpos sr + rdim sr) $ sort $ (rpos gr - 2*wborder wa):(rpos gr + rdim gr - 2*wborder wa):(rpos sr + rdim sr - 2*wborder wa): foldr (\a as -> (wpos a - wborder a - wborder wa):(wpos a + wdim a):as) [] wla neighbours l v = ( listToMaybe $ reverse $ takeWhile (< v) l , listToMaybe $ dropWhile (<= v) l , v `elem` l ) collides wa oa = case collidedist of Nothing -> True Just dist -> ( refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist && refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa ) constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int) constructors True = ( fromIntegral.wa_x , fromIntegral.wa_width , fromIntegral.rect_x , fromIntegral.rect_width ) constructors False = ( fromIntegral.wa_y , fromIntegral.wa_height , fromIntegral.rect_y , fromIntegral.rect_height ) xmonad-contrib-0.12/XMonad/Actions/PerWorkspaceKeys.hs0000644000000000000000000000337212636047674021155 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.PerWorkspaceKeys -- Copyright : (c) Roman Cheplyaka, 2008 -- License : BSD3-style (see LICENSE) -- -- Maintainer : Roman Cheplyaka -- Stability : unstable -- Portability : unportable -- -- Define key-bindings on per-workspace basis. -- ----------------------------------------------------------------------------- module XMonad.Actions.PerWorkspaceKeys ( -- * Usage -- $usage chooseAction, bindOn ) where import XMonad import XMonad.StackSet as S -- $usage -- -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.PerWorkspaceKeys -- -- > ,((0, xK_F2), bindOn [("1", spawn "rxvt"), ("2", spawn "xeyes"), ("", spawn "xmessage hello")]) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Uses supplied function to decide which action to run depending on current workspace name. chooseAction :: (String->X()) -> X() chooseAction f = withWindowSet (f . S.currentTag) -- | If current workspace is listed, run appropriate action (only the first match counts!) -- If it isn't listed, then run default action (marked with empty string, \"\"), or do nothing if default isn't supplied. bindOn :: [(String, X())] -> X() bindOn bindings = chooseAction chooser where chooser ws = case lookup ws bindings of Just action -> action Nothing -> case lookup "" bindings of Just action -> action Nothing -> return () xmonad-contrib-0.12/XMonad/Actions/Navigation2D.hs0000644000000000000000000012655012636047674020205 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.Navigation2D -- Copyright : (c) 2011 Norbert Zeh -- License : BSD3-style (see LICENSE) -- -- Maintainer : Norbert Zeh -- Stability : unstable -- Portability : unportable -- -- Navigation2D is an xmonad extension that allows easy directional -- navigation of windows and screens (in a multi-monitor setup). ----------------------------------------------------------------------------- module XMonad.Actions.Navigation2D ( -- * Usage -- $usage -- * Finer points -- $finer_points -- * Alternative directional navigation modules -- $alternatives -- * Incompatibilities -- $incompatibilities -- * Detailed technical discussion -- $technical -- * Exported functions and types -- #Exports# navigation2D , navigation2DP , additionalNav2DKeys , additionalNav2DKeysP , withNavigation2DConfig , Navigation2DConfig(..) , def , defaultNavigation2DConfig , Navigation2D , lineNavigation , centerNavigation , fullScreenRect , singleWindowRect , switchLayer , windowGo , windowSwap , windowToScreen , screenGo , screenSwap , Direction2D(..) ) where import Control.Applicative import qualified Data.List as L import qualified Data.Map as M import Data.Maybe import XMonad hiding (Screen) import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.EZConfig (additionalKeys, additionalKeysP) import XMonad.Util.Types -- $usage -- #Usage# -- Navigation2D provides directional navigation (go left, right, up, down) for -- windows and screens. It treats floating and tiled windows as two separate -- layers and provides mechanisms to navigate within each layer and to switch -- between layers. Navigation2D provides two different navigation strategies -- (see <#Technical_Discussion> for details): /Line navigation/ feels rather -- natural but may make it impossible to navigate to a given window from the -- current window, particularly in the floating layer. /Center navigation/ -- feels less natural in certain situations but ensures that all windows can be -- reached without the need to involve the mouse. Navigation2D allows different -- navigation strategies to be used in the two layers and allows customization -- of the navigation strategy for the tiled layer based on the layout currently -- in effect. -- -- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.Navigation2D -- -- Then add the configuration of the module to your main function: -- -- > main = xmonad $ navigation2D def -- > (xK_Up, xK_Left, xK_Down, xK_Right) -- > [(mod4Mask, windowGo ), -- > (mod4Mask .|. shiftMask, windowSwap)] -- > False -- > $ def -- -- Alternatively, you can use navigation2DP: -- -- > main = xmonad $ navigation2D def -- > ("", "", "", "") -- > [("M-", windowGo ), -- > ("M-S-", windowSwap)] -- > False -- > $ def -- -- That's it. If instead you'd like more control, you can combine -- withNavigation2DConfig and additionalNav2DKeys or additionalNav2DKeysP: -- -- > main = xmonad $ withNavigation2DConfig def -- > $ additionalNav2DKeys (xK_Up, xK_Left, xK_Down, xK_Right) -- > [(mod4Mask, windowGo ), -- > (mod4Mask .|. shiftMask, windowSwap)] -- > False -- > $ additionalNav2DKeys (xK_u, xK_l, xK_d, xK_r) -- > [(mod4Mask, screenGo ), -- > (mod4Mask .|. shiftMask, screenSwap)] -- > False -- > $ def -- -- Or you can add the configuration of the module to your main function: -- -- > main = xmonad $ withNavigation2DConfig def $ def -- -- And specify your keybindings normally: -- -- > -- Switch between layers -- > , ((modm, xK_space), switchLayer) -- > -- > -- Directional navigation of windows -- > , ((modm, xK_Right), windowGo R False) -- > , ((modm, xK_Left ), windowGo L False) -- > , ((modm, xK_Up ), windowGo U False) -- > , ((modm, xK_Down ), windowGo D False) -- > -- > -- Swap adjacent windows -- > , ((modm .|. controlMask, xK_Right), windowSwap R False) -- > , ((modm .|. controlMask, xK_Left ), windowSwap L False) -- > , ((modm .|. controlMask, xK_Up ), windowSwap U False) -- > , ((modm .|. controlMask, xK_Down ), windowSwap D False) -- > -- > -- Directional navigation of screens -- > , ((modm, xK_r ), screenGo R False) -- > , ((modm, xK_l ), screenGo L False) -- > , ((modm, xK_u ), screenGo U False) -- > , ((modm, xK_d ), screenGo D False) -- > -- > -- Swap workspaces on adjacent screens -- > , ((modm .|. controlMask, xK_r ), screenSwap R False) -- > , ((modm .|. controlMask, xK_l ), screenSwap L False) -- > , ((modm .|. controlMask, xK_u ), screenSwap U False) -- > , ((modm .|. controlMask, xK_d ), screenSwap D False) -- > -- > -- Send window to adjacent screen -- > , ((modm .|. mod1Mask, xK_r ), windowToScreen R False) -- > , ((modm .|. mod1Mask, xK_l ), windowToScreen L False) -- > , ((modm .|. mod1Mask, xK_u ), windowToScreen U False) -- > , ((modm .|. mod1Mask, xK_d ), windowToScreen D False) -- -- For detailed instruction on editing the key binding see: -- -- "XMonad.Doc.Extending#Editing_key_bindings". -- $finer_points -- #Finer_Points# -- The above should get you started. Here are some finer points: -- -- Navigation2D has the ability to wrap around at screen edges. For example, if -- you navigated to the rightmost window on the rightmost screen and you -- continued to go right, this would get you to the leftmost window on the -- leftmost screen. This feature may be useful for switching between screens -- that are far apart but may be confusing at least to novice users. Therefore, -- it is disabled in the above example (e.g., navigation beyond the rightmost -- window on the rightmost screen is not possible and trying to do so will -- simply not do anything.) If you want this feature, change all the 'False' -- values in the above example to 'True'. You could also decide you want -- wrapping only for a subset of the operations and no wrapping for others. -- -- By default, all layouts use the 'defaultTiledNavigation' strategy specified -- in the 'Navigation2DConfig' (by default, line navigation is used). To -- override this behaviour for some layouts, add a pair (\"layout name\", -- navigation strategy) to the 'layoutNavigation' list in the -- 'Navigation2DConfig', where \"layout name\" is the string reported by the -- layout's description method (normally what is shown as the layout name in -- your status bar). For example, all navigation strategies normally allow only -- navigation between mapped windows. The first step to overcome this, for -- example, for the Full layout, is to switch to center navigation for the Full -- layout: -- -- > myNavigation2DConfig = def { layoutNavigation = [("Full", centerNavigation)] } -- > -- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig -- > $ def -- -- The navigation between windows is based on their screen rectangles, which are -- available /and meaningful/ only for mapped windows. Thus, as already said, -- the default is to allow navigation only between mapped windows. However, -- there are layouts that do not keep all windows mapped. One example is the -- Full layout, which unmaps all windows except the one that has the focus, -- thereby preventing navigation to any other window in the layout. To make -- navigation to unmapped windows possible, unmapped windows need to be assigned -- rectangles to pretend they are mapped, and a natural way to do this for the -- Full layout is to pretend all windows occupy the full screen and are stacked -- on top of each other so that only the frontmost one is visible. This can be -- done as follows: -- -- > myNavigation2DConfig = def { layoutNavigation = [("Full", centerNavigation)] -- > , unmappedWindowRect = [("Full", singleWindowRect)] -- > } -- > -- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig -- > $ def -- -- With this setup, Left/Up navigation behaves like standard -- 'XMonad.StackSet.focusUp' and Right/Down navigation behaves like -- 'XMonad.StackSet.focusDown', thus allowing navigation between windows in the -- layout. -- -- In general, each entry in the 'unmappedWindowRect' association list is a pair -- (\"layout description\", function), where the function computes a rectangle -- for each unmapped window from the screen it is on and the window ID. -- Currently, Navigation2D provides only two functions of this type: -- 'singleWindowRect' and 'fullScreenRect'. -- -- With per-layout navigation strategies, if different layouts are in effect on -- different screens in a multi-monitor setup, and different navigation -- strategies are defined for these active layouts, the most general of these -- navigation strategies is used across all screens (because Navigation2D does -- not distinguish between windows on different workspaces), where center -- navigation is more general than line navigation, as discussed formally under -- <#Technical_Discussion>. -- $alternatives -- #Alternatives# -- -- There exist two alternatives to Navigation2D: -- "XMonad.Actions.WindowNavigation" and "XMonad.Layout.WindowNavigation". -- X.L.WindowNavigation has the advantage of colouring windows to indicate the -- window that would receive the focus in each navigation direction, but it does -- not support navigation across multiple monitors, does not support directional -- navigation of floating windows, and has a very unintuitive definition of -- which window receives the focus next in each direction. X.A.WindowNavigation -- does support navigation across multiple monitors but does not provide window -- colouring while retaining the unintuitive navigational semantics of -- X.L.WindowNavigation. This makes it very difficult to predict which window -- receives the focus next. Neither X.A.WindowNavigation nor -- X.L.WindowNavigation supports directional navigation of screens. -- $technical -- #Technical_Discussion# -- An in-depth discussion of the navigational strategies implemented in -- Navigation2D, including formal proofs of their properties, can be found -- at . -- $incompatibilities -- #Incompatibilities# -- Currently Navigation2D is known not to play nicely with tabbed layouts, but -- it should work well with any other tiled layout. My hope is to address the -- incompatibility with tabbed layouts in a future version. The navigation to -- unmapped windows, for example in a Full layout, by assigning rectangles to -- unmapped windows is more a workaround than a clean solution. Figuring out -- how to deal with tabbed layouts may also lead to a more general and cleaner -- solution to query the layout for a window's rectangle that may make this -- workaround unnecessary. At that point, the 'unmappedWindowRect' field of the -- 'Navigation2DConfig' will disappear. -- | A rectangle paired with an object type Rect a = (a, Rectangle) -- | A shorthand for window-rectangle pairs. Reduces typing. type WinRect = Rect Window -- | A shorthand for workspace-rectangle pairs. Reduces typing. type WSRect = Rect WorkspaceId ---------------------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------------------- -- -- -- PUBLIC INTERFACE -- -- -- ---------------------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------------------- -- | Encapsulates the navigation strategy data Navigation2D = N Generality (forall a . Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a) runNav :: forall a . Eq a => Navigation2D -> (Direction2D -> Rect a -> [Rect a] -> Maybe a) runNav (N _ nav) = nav -- | Score that indicates how general a navigation strategy is type Generality = Int instance Eq Navigation2D where (N x _) == (N y _) = x == y instance Ord Navigation2D where (N x _) <= (N y _) = x <= y -- | Line navigation. To illustrate this navigation strategy, consider -- navigating to the left from the current window. In this case, we draw a -- horizontal line through the center of the current window and consider all -- windows that intersect this horizontal line and whose right boundaries are to -- the left of the left boundary of the current window. From among these -- windows, we choose the one with the rightmost right boundary. lineNavigation :: Navigation2D lineNavigation = N 1 doLineNavigation -- | Center navigation. Again, consider navigating to the left. Then we -- consider the cone bounded by the two rays shot at 45-degree angles in -- north-west and south-west direction from the center of the current window. A -- window is a candidate to receive the focus if its center lies in this cone. -- We choose the window whose center has minimum L1-distance from the current -- window center. The tie breaking strategy for windows with the same distance -- is a bit complicated (see <#Technical_Discussion>) but ensures that all -- windows can be reached and that windows with the same center are traversed in -- their order in the window stack, that is, in the order -- 'XMonad.StackSet.focusUp' and 'XMonad.StackSet.focusDown' would traverse -- them. centerNavigation :: Navigation2D centerNavigation = N 2 doCenterNavigation -- | Stores the configuration of directional navigation. The 'Default' instance -- uses line navigation for the tiled layer and for navigation between screens, -- and center navigation for the float layer. No custom navigation strategies -- or rectangles for unmapped windows are defined for individual layouts. data Navigation2DConfig = Navigation2DConfig { defaultTiledNavigation :: Navigation2D -- ^ default navigation strategy for the tiled layer , floatNavigation :: Navigation2D -- ^ navigation strategy for the float layer , screenNavigation :: Navigation2D -- ^ strategy for navigation between screens , layoutNavigation :: [(String, Navigation2D)] -- ^ association list of customized navigation strategies -- for different layouts in the tiled layer. Each pair -- is of the form (\"layout description\", navigation -- strategy). If there is no pair in this list whose first -- component is the name of the current layout, the -- 'defaultTiledNavigation' strategy is used. , unmappedWindowRect :: [(String, Screen -> Window -> X (Maybe Rectangle))] -- ^ list associating functions to calculate rectangles -- for unmapped windows with layouts to which they are -- to be applied. Each pair in this list is of -- the form (\"layout description\", function), where the -- function calculates a rectangle for a given unmapped -- window from the screen it is on and its window ID. -- See <#Finer_Points> for how to use this. } deriving Typeable -- | Shorthand for the tedious screen type type Screen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail -- | Convenience function for enabling Navigation2D with typical keybindings. -- Takes a Navigation2DConfig, an (up, left, down, right) tuple, a mapping from -- modifier key to action, and a bool to indicate if wrapping should occur, and -- returns a function from XConfig to XConfig. -- Example: -- -- > navigation2D def (xK_w, xK_a, xK_s, xK_d) [(mod4Mask, windowGo), (mod4Mask .|. shiftMask, windowSwap)] False myConfig navigation2D :: Navigation2DConfig -> (KeySym, KeySym, KeySym, KeySym) -> [(ButtonMask, Direction2D -> Bool -> X ())] -> Bool -> XConfig l -> XConfig l navigation2D navConfig (u, l, d, r) modifiers wrap xconfig = additionalNav2DKeys (u, l, d, r) modifiers wrap $ withNavigation2DConfig navConfig xconfig -- | Convenience function for enabling Navigation2D with typical keybindings, -- using the syntax defined in 'XMonad.Util.EZConfig.mkKeymap'. Takes a -- Navigation2DConfig, an (up, left, down, right) tuple, a mapping from key -- prefix to action, and a bool to indicate if wrapping should occur, and -- returns a function from XConfig to XConfig. Example: -- -- > navigation2DP def ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig navigation2DP :: Navigation2DConfig -> (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] -> Bool -> XConfig l -> XConfig l navigation2DP navConfig (u, l, d, r) modifiers wrap xconfig = additionalNav2DKeysP (u, l, d, r) modifiers wrap $ withNavigation2DConfig navConfig xconfig -- | Convenience function for adding keybindings. Takes an (up, left, down, -- right) tuple, a mapping from key prefix to action, and a bool to indicate if -- wrapping should occur, and returns a function from XConfig to XConfig. -- Example: -- -- > additionalNav2DKeys (xK_w, xK_a, xK_s, xK_d) [(mod4Mask, windowGo), (mod4Mask .|. shiftMask, windowSwap)] False myConfig additionalNav2DKeys :: (KeySym, KeySym, KeySym, KeySym) -> [(ButtonMask, Direction2D -> Bool -> X ())] -> Bool -> XConfig l -> XConfig l additionalNav2DKeys (u, l, d, r) modifiers wrap = flip additionalKeys [((modif, k), func dir wrap) | (modif, func) <- modifiers, (k, dir) <- dirKeys] where dirKeys = [(u, U), (l, L), (d, D), (r, R)] -- | Convenience function for adding keybindings, using the syntax defined in -- 'XMonad.Util.EZConfig.mkKeymap'. Takes an (up, left, down, right) tuple, a -- mapping from key prefix to action, and a bool to indicate if wrapping should -- occur, and returns a function from XConfig to XConfig. Example: -- -- > additionalNav2DKeysP def ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig additionalNav2DKeysP :: (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] -> Bool -> XConfig l -> XConfig l additionalNav2DKeysP (u, l, d, r) modifiers wrap = flip additionalKeysP [(modif ++ k, func dir wrap) | (modif, func) <- modifiers, (k, dir) <- dirKeys] where dirKeys = [(u, U), (l, L), (d, D), (r, R)] -- So we can store the configuration in extensible state instance ExtensionClass Navigation2DConfig where initialValue = def -- | Modifies the xmonad configuration to store the Navigation2D configuration withNavigation2DConfig :: Navigation2DConfig -> XConfig a -> XConfig a withNavigation2DConfig conf2d xconf = xconf { startupHook = startupHook xconf >> 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 def = Navigation2DConfig { defaultTiledNavigation = lineNavigation , floatNavigation = centerNavigation , screenNavigation = lineNavigation , layoutNavigation = [] , unmappedWindowRect = [] } -- | Switches focus to the closest window in the other layer (floating if the -- current window is tiled, tiled if the current window is floating). Closest -- means that the L1-distance between the centers of the windows is minimized. switchLayer :: X () switchLayer = actOnLayer otherLayer ( \ _ cur wins -> windows $ doFocusClosestWindow cur wins ) ( \ _ cur wins -> windows $ doFocusClosestWindow cur wins ) ( \ _ _ _ -> return () ) False -- | Moves the focus to the next window in the given direction and in the same -- layer as the current window. The second argument indicates whether -- navigation should wrap around (e.g., from the left edge of the leftmost -- screen to the right edge of the rightmost screen). windowGo :: Direction2D -> Bool -> X () windowGo dir wrap = actOnLayer thisLayer ( \ conf cur wins -> windows $ doTiledNavigation conf dir W.focusWindow cur wins ) ( \ conf cur wins -> windows $ doFloatNavigation conf dir W.focusWindow cur wins ) ( \ conf cur wspcs -> windows $ doScreenNavigation conf dir W.view cur wspcs ) wrap -- | 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 -- changes for the two windows is their stacking order if they're on the same -- screen. If they're on different screens, each window is moved to the other -- window's screen but retains its position and size relative to the screen.) -- The second argument indicates wrapping (see 'windowGo'). windowSwap :: Direction2D -> Bool -> X () windowSwap dir wrap = actOnLayer thisLayer ( \ conf cur wins -> windows $ doTiledNavigation conf dir swap cur wins ) ( \ conf cur wins -> windows $ doFloatNavigation conf dir swap cur wins ) ( \ _ _ _ -> return () ) wrap -- | Moves the current window to the next screen in the given direction. The -- second argument indicates wrapping (see 'windowGo'). windowToScreen :: Direction2D -> Bool -> X () windowToScreen dir wrap = actOnScreens ( \ conf cur wspcs -> windows $ doScreenNavigation conf dir W.shift cur wspcs ) wrap -- | Moves the focus to the next screen in the given direction. The second -- argument indicates wrapping (see 'windowGo'). screenGo :: Direction2D -> Bool -> X () screenGo dir wrap = actOnScreens ( \ conf cur wspcs -> windows $ doScreenNavigation conf dir W.view cur wspcs ) wrap -- | Swaps the workspace on the current screen with the workspace on the screen -- in the given direction. The second argument indicates wrapping (see -- 'windowGo'). screenSwap :: Direction2D -> Bool -> X () screenSwap dir wrap = actOnScreens ( \ conf cur wspcs -> windows $ doScreenNavigation conf dir W.greedyView cur wspcs ) wrap -- | 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 -- respects statusbar struts. In such cases, it may be better to use -- 'singleWindowRect'. fullScreenRect :: Screen -> Window -> X (Maybe Rectangle) fullScreenRect scr _ = return (Just . screenRect . W.screenDetail $ scr) -- | Maps each window to the rectangle it would receive if it was the only -- window in the layout. Useful, for example, for determining the default -- rectangle for unmapped windows in a Full layout that respects statusbar -- struts. singleWindowRect :: Screen -> Window -> X (Maybe Rectangle) singleWindowRect scr win = listToMaybe . map snd . fst <$> runLayout ((W.workspace scr) { W.stack = W.differentiate [win] }) (screenRect . W.screenDetail $ scr) ---------------------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------------------- -- -- -- PRIVATE X ACTIONS -- -- -- ---------------------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------------------- -- | Acts on the appropriate layer using the given action functions actOnLayer :: ([WinRect] -> [WinRect] -> [WinRect]) -- ^ Chooses which layer to operate on, relative -- to the current window (same or other layer) -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the tiled layer -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the float layer -> (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -- ^ The action if the current workspace is empty -> Bool -- ^ Should navigation wrap around screen edges? -> X () actOnLayer choice tiledact floatact wsact wrap = withWindowSet $ \winset -> do conf <- XS.get (floating, tiled) <- navigableWindows conf wrap winset let cur = W.peek winset case cur of Nothing -> actOnScreens wsact wrap Just w | Just rect <- L.lookup w tiled -> tiledact conf (w, rect) (choice tiled floating) | Just rect <- L.lookup w floating -> floatact conf (w, rect) (choice floating tiled) | otherwise -> return () -- | Returns the list of windows on the currently visible workspaces navigableWindows :: Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect]) navigableWindows conf wrap winset = L.partition (\(win, _) -> M.member win (W.floating winset)) . addWrapping winset wrap . catMaybes . concat <$> ( mapM ( \scr -> mapM (maybeWinRect scr) $ W.integrate' $ W.stack $ W.workspace scr ) . sortedScreens ) winset where maybeWinRect scr win = do winrect <- windowRect win rect <- case winrect of Just _ -> return winrect Nothing -> maybe (return Nothing) (\f -> f scr win) (L.lookup (description . W.layout . W.workspace $ scr) (unmappedWindowRect conf)) return ((,) win <$> rect) -- | Returns the current rectangle of the given window, Nothing if the window isn't mapped windowRect :: Window -> X (Maybe Rectangle) windowRect win = withDisplay $ \dpy -> do mp <- isMapped win if mp then do (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw) `catchX` return Nothing else return Nothing -- | Acts on the screens using the given action function actOnScreens :: (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -> Bool -- ^ Should wrapping be used? -> X () actOnScreens act wrap = withWindowSet $ \winset -> do conf <- XS.get let wsrects = visibleWorkspaces winset wrap cur = W.tag . W.workspace . W.current $ winset rect = fromJust $ L.lookup cur wsrects act conf (cur, rect) wsrects -- | Determines whether a given window is mapped isMapped :: Window -> X Bool isMapped win = withDisplay $ \dpy -> io $ (waIsUnmapped /=) . wa_map_state <$> getWindowAttributes dpy win ---------------------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------------------- -- -- -- PRIVATE PURE FUNCTIONS -- -- -- ---------------------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------------------- -- | Finds the window closest to the given window and focuses it. Ties are -- broken by choosing the first window in the window stack among the tied -- windows. (The stack order is the one produced by integrate'ing each visible -- workspace's window stack and concatenating these lists for all visible -- workspaces.) doFocusClosestWindow :: WinRect -> [WinRect] -> (WindowSet -> WindowSet) doFocusClosestWindow (cur, rect) winrects | null winctrs = id | otherwise = W.focusWindow . fst $ L.foldl1' closer winctrs where ctr = centerOf rect winctrs = filter ((cur /=) . fst) $ map (\(w, r) -> (w, centerOf r)) winrects closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2 | otherwise = wc1 -- | Implements navigation for the tiled layer doTiledNavigation :: Navigation2DConfig -> Direction2D -> (Window -> WindowSet -> WindowSet) -> WinRect -> [WinRect] -> (WindowSet -> WindowSet) doTiledNavigation conf dir act cur winrects winset | Just win <- runNav nav dir cur winrects = act win winset | otherwise = winset where layouts = map (description . W.layout . W.workspace) $ W.screens winset nav = maximum $ map ( fromMaybe (defaultTiledNavigation conf) . flip L.lookup (layoutNavigation conf) ) $ layouts -- | Implements navigation for the float layer doFloatNavigation :: Navigation2DConfig -> Direction2D -> (Window -> WindowSet -> WindowSet) -> WinRect -> [WinRect] -> (WindowSet -> WindowSet) doFloatNavigation conf dir act cur winrects | Just win <- runNav nav dir cur winrects = act win | otherwise = id where nav = floatNavigation conf -- | Implements navigation between screens doScreenNavigation :: Navigation2DConfig -> Direction2D -> (WorkspaceId -> WindowSet -> WindowSet) -> WSRect -> [WSRect] -> (WindowSet -> WindowSet) doScreenNavigation conf dir act cur wsrects | Just ws <- runNav nav dir cur wsrects = act ws | otherwise = id where nav = screenNavigation conf -- | Implements line navigation. For layouts without overlapping windows, there -- is no need to break ties between equidistant windows. When windows do -- overlap, even the best tie breaking rule cannot make line navigation feel -- natural. Thus, we fairly arbtitrarily break ties by preferring the window -- that comes first in the window stack. (The stack order is the one produced -- by integrate'ing each visible workspace's window stack and concatenating -- these lists for all visible workspaces.) doLineNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a doLineNavigation dir (cur, rect) winrects | null winrects' = Nothing | otherwise = Just . fst $ L.foldl1' closer winrects' where -- The current window's center ctr@(xc, yc) = centerOf rect -- The list of windows that are candidates to receive focus. winrects' = filter dirFilter $ filter ((cur /=) . fst) $ winrects -- Decides whether a given window matches the criteria to be a candidate to -- receive the focus. dirFilter (_, r) = (dir == L && leftOf r rect && intersectsY yc r) || (dir == R && leftOf rect r && intersectsY yc r) || (dir == U && above r rect && intersectsX xc r) || (dir == D && above rect r && intersectsX xc r) -- Decide whether r1 is left of/above r2. leftOf r1 r2 = rect_x r1 + fi (rect_width r1) <= rect_x r2 above r1 r2 = rect_y r1 + fi (rect_height r1) <= rect_y r2 -- Check whether r's x-/y-range contains the given x-/y-coordinate. intersectsX x r = rect_x r <= x && rect_x r + fi (rect_width r) >= x intersectsY y r = rect_y r <= y && rect_y r + fi (rect_height r) >= y -- Decides whether r1 is closer to the current window's center than r2 closer wr1@(_, r1) wr2@(_, r2) | dist ctr r1 > dist ctr r2 = wr2 | otherwise = wr1 -- Returns the distance of r from the point (x, y) dist (x, y) r | dir == L = x - rect_x r - fi (rect_width r) | dir == R = rect_x r - x | dir == U = y - rect_y r - fi (rect_height r) | otherwise = rect_y r - y -- | Implements center navigation doCenterNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a doCenterNavigation dir (cur, rect) winrects | ((w, _):_) <- onCtr' = Just w | otherwise = closestOffCtr where -- The center of the current window (xc, yc) = centerOf rect -- All the windows with their center points relative to the current -- center rotated so the right cone becomes the relevant cone. -- The windows are ordered in the order they should be preferred -- when they are otherwise tied. winctrs = map (\(w, r) -> (w, dirTransform . centerOf $ r)) $ stackTransform $ winrects -- 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 -- is the one produced by integrate'ing each visible workspace's window -- stack and concatenating these lists for all visible workspaces.) stackTransform | dir == L || dir == U = reverse | otherwise = id -- Transform a point into a difference to the current window center and -- rotate it so that the relevant cone becomes the right cone. dirTransform (x, y) | dir == R = ( x - xc , y - yc ) | dir == L = (-(x - xc), -(y - yc)) | dir == D = ( y - yc , x - xc ) | otherwise = (-(y - yc), -(x - xc)) -- Partition the points into points that coincide with the center -- and points that do not. (onCtr, offCtr) = L.partition (\(_, (x, y)) -> x == 0 && y == 0) winctrs -- All the points that coincide with the current center and succeed it -- in the (appropriately ordered) window stack. onCtr' = L.tail $ L.dropWhile ((cur /=) . fst) onCtr -- tail should be safe here because cur should be in onCtr -- All the points that do not coincide with the current center and which -- lie in the (rotated) right cone. offCtr' = L.filter (\(_, (x, y)) -> x > 0 && y < x && y >= -x) offCtr -- The off-center point closest to the center and -- closest to the bottom ray of the cone. Nothing if no off-center -- point is in the cone closestOffCtr = if null offCtr' then Nothing else Just $ fst $ L.foldl1' closest offCtr' closest wp@(_, p@(_, yp)) wq@(_, q@(_, yq)) | lDist (0, 0) q < lDist (0, 0) p = wq -- q is closer than p | lDist (0, 0) p < lDist (0, 0) q = wp -- q is farther away than p | yq < yp = wq -- q is closer to the bottom ray than p | otherwise = wp -- q is farther away from the bottom ray than p -- or it has the same distance but comes later -- in the window stack -- | Swaps the current window with the window given as argument swap :: Window -> WindowSet -> WindowSet swap win winset = W.focusWindow cur $ L.foldl' (flip W.focusWindow) newwinset newfocused where -- The current window cur = fromJust $ W.peek winset -- All screens scrs = W.screens winset -- All visible workspaces visws = map W.workspace scrs -- The focused windows of the visible workspaces focused = mapMaybe (\ws -> W.focus <$> W.stack ws) visws -- The window lists of the visible workspaces wins = map (W.integrate' . W.stack) visws -- Update focused windows and window lists to reflect swap of windows. newfocused = map swapWins focused newwins = map (map swapWins) wins -- Replaces the current window with the argument window and vice versa. swapWins x | x == cur = win | x == win = cur | otherwise = x -- Reconstruct the workspaces' window stacks to reflect the swap. newvisws = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins newscrs = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws newwinset = winset { W.current = head newscrs , W.visible = tail newscrs } -- | Calculates the center of a rectangle centerOf :: Rectangle -> (Position, Position) 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 thisLayer, otherLayer :: a -> a -> a thisLayer = curry fst otherLayer = curry snd -- | Returns the list of visible workspaces and their screen rects visibleWorkspaces :: WindowSet -> Bool -> [WSRect] visibleWorkspaces winset wrap = addWrapping winset wrap $ map ( \scr -> ( W.tag . W.workspace $ scr , screenRect . W.screenDetail $ scr ) ) $ sortedScreens winset -- | Creates five copies of each (window/workspace, rect) pair in the input: the -- original and four offset one desktop size (desktop = collection of all -- screens) to the left, to the right, up, and down. Wrap-around at desktop -- edges is implemented by navigating into these displaced copies. addWrapping :: WindowSet -- ^ The window set, used to get the desktop size -> Bool -- ^ Should wrapping be used? Do nothing if not. -> [Rect a] -- ^ Input set of (window/workspace, rect) pairs -> [Rect a] addWrapping _ False wrects = wrects addWrapping winset True wrects = [ (w, r { rect_x = rect_x r + fi x , rect_y = rect_y r + fi y } ) | (w, r) <- wrects , (x, y) <- [(0, 0), (-xoff, 0), (xoff, 0), (0, -yoff), (0, yoff)] ] where (xoff, yoff) = wrapOffsets winset -- | Calculates the offsets for window/screen coordinates for the duplication -- of windows/workspaces that implements wrap-around. wrapOffsets :: WindowSet -> (Integer, Integer) wrapOffsets winset = (max_x - min_x, max_y - min_y) where min_x = fi $ minimum $ map rect_x rects min_y = fi $ minimum $ map rect_y 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 rects = map snd $ visibleWorkspaces winset False -- | Returns the list of screens sorted primarily by their centers' -- x-coordinates and secondarily by their y-coordinates. sortedScreens :: WindowSet -> [Screen] sortedScreens winset = L.sortBy cmp $ W.screens winset where cmp s1 s2 | x1 < x2 = LT | x1 > x2 = GT | y1 < x2 = LT | y1 > y2 = GT | otherwise = EQ where (x1, y1) = centerOf (screenRect . W.screenDetail $ s1) (x2, y2) = centerOf (screenRect . W.screenDetail $ s2) -- | Calculates the L1-distance between two points. lDist :: (Position, Position) -> (Position, Position) -> Int lDist (x1, y1) (x2, y2) = abs (fi $ x1 - x2) + abs (fi $ y1 - y2) xmonad-contrib-0.12/XMonad/Actions/SpawnOn.hs0000644000000000000000000001016412636047674017276 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.SpawnOn -- Copyright : (c) Spencer Janssen -- License : BSD -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- Provides a way to modify a window spawned by a command(e.g shift it to the workspace -- it was launched on) by using the _NET_WM_PID property that most windows set on creation. -- Hence this module won't work on applications that don't set this property. -- ----------------------------------------------------------------------------- module XMonad.Actions.SpawnOn ( -- * Usage -- $usage Spawner, manageSpawn, manageSpawnWithGC, spawnHere, spawnOn, spawnAndDo, shellPromptHere, shellPromptOn ) where import Data.List (isInfixOf) import System.Posix.Types (ProcessID) import XMonad import qualified XMonad.StackSet as W import XMonad.Hooks.ManageHelpers import XMonad.Prompt import XMonad.Prompt.Shell import qualified XMonad.Util.ExtensibleState as XS -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.SpawnOn -- -- > main = do -- > xmonad def { -- > ... -- > manageHook = manageSpawn <+> manageHook def -- > ... -- > } -- -- To ensure that application appears on a workspace it was launched at, add keybindings like: -- -- > , ((mod1Mask,xK_o), spawnHere "urxvt") -- > , ((mod1Mask,xK_s), shellPromptHere def) -- -- The module can also be used to apply other manage hooks to the window of -- the spawned application(e.g. float or resize it). -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]} deriving Typeable instance ExtensionClass Spawner where initialValue = Spawner [] -- | Get the current Spawner or create one if it doesn't exist. modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X () modifySpawner f = XS.modify (Spawner . f . pidsRef) -- | Provides a manage hook to react on process spawned with -- 'spawnOn', 'spawnHere' etc. manageSpawn :: ManageHook manageSpawn = manageSpawnWithGC (return . take 20) manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]) -- ^ function to stop accumulation of entries for windows that never set @_NET_WM_PID@ -> ManageHook manageSpawnWithGC garbageCollect = do Spawner pids <- liftX XS.get mp <- pid case flip lookup pids =<< mp of Nothing -> idHook Just mh -> do whenJust mp $ \p -> liftX $ do ps <- XS.gets pidsRef XS.put . Spawner =<< garbageCollect (filter ((/= p) . fst) ps) mh mkPrompt :: (String -> X ()) -> XPConfig -> X () mkPrompt cb c = do cmds <- io $ getCommands mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) cb -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches -- application on current workspace. shellPromptHere :: XPConfig -> X () shellPromptHere = mkPrompt spawnHere -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches -- application on given workspace. shellPromptOn :: WorkspaceId -> XPConfig -> X () shellPromptOn ws = mkPrompt (spawnOn ws) -- | Replacement for 'spawn' which launches -- application on current workspace. spawnHere :: String -> X () spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd -- | Replacement for 'spawn' which launches -- application on given workspace. spawnOn :: WorkspaceId -> String -> X () spawnOn ws cmd = spawnAndDo (doShift ws) cmd -- | Spawn an application and apply the manage hook when it opens. spawnAndDo :: ManageHook -> String -> X () spawnAndDo mh cmd = do p <- spawnPID $ mangle cmd modifySpawner $ ((p,mh) :) where -- TODO this is silly, search for a better solution mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs | otherwise = "exec " ++ xs metaChars = "&|;" xmonad-contrib-0.12/XMonad/Actions/DynamicWorkspaceOrder.hs0000644000000000000000000001446212636047674022155 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.DynamicWorkspaceOrder -- Copyright : (c) Brent Yorgey 2009 -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : experimental -- Portability : unportable -- -- Remember a dynamically updateable ordering on workspaces, together -- with tools for using this ordering with "XMonad.Actions.CycleWS" -- and "XMonad.Hooks.DynamicLog". -- ----------------------------------------------------------------------------- module XMonad.Actions.DynamicWorkspaceOrder ( -- * Usage -- $usage getWsCompareByOrder , getSortByOrder , swapWith , moveTo , moveToGreedy , shiftTo , withNthWorkspace ) where import XMonad import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.WorkspaceCompare (WorkspaceCompare, WorkspaceSort, mkWsSort) import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), doTo) import qualified Data.Map as M import qualified Data.Set as S import Data.Maybe (fromJust, fromMaybe) import Data.Ord (comparing) -- $usage -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: -- -- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO -- -- Then add keybindings to swap the order of workspaces (these -- examples use "XMonad.Util.EZConfig" emacs-style keybindings): -- -- > , ("M-C-", DO.swapWith Next NonEmptyWS) -- > , ("M-C-", DO.swapWith Prev NonEmptyWS) -- -- See "XMonad.Actions.CycleWS" for information on the possible -- arguments to 'swapWith'. -- -- However, by itself this will do nothing; 'swapWith' does not change -- the actual workspaces in any way. It simply keeps track of an -- auxiliary ordering on workspaces. Anything which cares about the -- order of workspaces must be updated to use the auxiliary ordering. -- -- To change the order in which workspaces are displayed by -- "XMonad.Hooks.DynamicLog", use 'getSortByOrder' in your -- 'XMonad.Hooks.DynamicLog.ppSort' field, for example: -- -- > ... dynamicLogWithPP $ byorgeyPP { -- > ... -- > , ppSort = DO.getSortByOrder -- > ... -- > } -- -- To use workspace cycling commands like those from -- "XMonad.Actions.CycleWS", use the versions of 'moveTo', -- 'moveToGreedy', and 'shiftTo' exported by this module. For example: -- -- > , ("M-S-", DO.shiftTo Next HiddenNonEmptyWS) -- > , ("M-S-", DO.shiftTo Prev HiddenNonEmptyWS) -- > , ("M-", DO.moveTo Next HiddenNonEmptyWS) -- > , ("M-", DO.moveTo Prev HiddenNonEmptyWS) -- -- For slight variations on these, use the source for examples and -- tweak as desired. -- | Extensible state storage for the workspace order. data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) } deriving (Typeable, Read, Show) instance ExtensionClass WSOrderStorage where initialValue = WSO Nothing extensionType = PersistentExtension -- | Lift a Map function to a function on WSOrderStorage. withWSO :: (M.Map WorkspaceId Int -> M.Map WorkspaceId Int) -> (WSOrderStorage -> WSOrderStorage) withWSO f = WSO . fmap f . unWSO -- | Update the ordering storage: initialize if it doesn't yet exist; -- add newly created workspaces at the end as necessary. updateOrder :: X () updateOrder = do WSO mm <- XS.get case mm of Nothing -> do -- initialize using ordering of workspaces from the user's config ws <- asks (workspaces . config) XS.put . WSO . Just . M.fromList $ zip ws [0..] Just m -> do -- check for new workspaces and add them at the end curWs <- gets (S.fromList . map W.tag . W.workspaces . windowset) let mappedWs = M.keysSet m newWs = curWs `S.difference` mappedWs nextIndex = 1 + maximum (-1 : M.elems m) newWsIxs = zip (S.toAscList newWs) [nextIndex..] XS.modify . withWSO . M.union . M.fromList $ newWsIxs -- | A comparison function which orders workspaces according to the -- stored dynamic ordering. getWsCompareByOrder :: X WorkspaceCompare getWsCompareByOrder = do updateOrder -- after the call to updateOrder we are guaranteed that the dynamic -- workspace order is initialized and contains all existing -- workspaces. WSO (Just m) <- XS.get return $ comparing (fromMaybe 1000 . flip M.lookup m) -- | Sort workspaces according to the stored dynamic ordering. getSortByOrder :: X WorkspaceSort getSortByOrder = mkWsSort getWsCompareByOrder -- | Swap the current workspace with another workspace in the stored -- dynamic order. swapWith :: Direction1D -> WSType -> X () swapWith dir which = findWorkspace getSortByOrder dir which 1 >>= swapWithCurrent -- | Swap the given workspace with the current one. swapWithCurrent :: WorkspaceId -> X () swapWithCurrent w = do cur <- gets (W.currentTag . windowset) swapOrder w cur -- | Swap the two given workspaces in the dynamic order. swapOrder :: WorkspaceId -> WorkspaceId -> X () swapOrder w1 w2 = do io $ print (w1,w2) WSO (Just m) <- XS.get let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2] XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1)) windows id -- force a status bar update -- | View the next workspace of the given type in the given direction, -- where \"next\" is determined using the dynamic workspace order. moveTo :: Direction1D -> WSType -> X () moveTo dir t = doTo dir t getSortByOrder (windows . W.view) -- | Same as 'moveTo', but using 'greedyView' instead of 'view'. moveToGreedy :: Direction1D -> WSType -> X () moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView) -- | Shift the currently focused window to the next workspace of the -- given type in the given direction, using the dynamic workspace order. shiftTo :: Direction1D -> WSType -> X () shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift) -- | Do something with the nth workspace in the dynamic order. The -- callback is given the workspace's tag as well as the 'WindowSet' -- of the workspace itself. withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X () 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 ()xmonad-contrib-0.12/XMonad/Actions/Launcher.hs0000644000000000000000000001112112636047674017444 0ustar0000000000000000{- | Module : XMonad.Actions.Launcher Copyright : (C) 2012 Carlos López-Camey License : None; public domain Maintainer : Stability : unstable A set of prompts for XMonad -} module XMonad.Actions.Launcher( -- * Description and use -- $description defaultLauncherModes , ExtensionActions , LauncherConfig(..) , launcherPrompt ) where import Data.List (find, findIndex, isPrefixOf, tails) import qualified Data.Map as M import Data.Maybe (isJust) import XMonad hiding (config) import XMonad.Prompt import XMonad.Util.Run {- $description This module exemplifies usage of `XMonad.Prompt.mkXPromptWithModes`. It includes two modes: * Hoogle mode: Search for functions using hoogle, choosing a function leads you to documentation in Haddock. * Calc: Uses the program calc to do calculations. To test it, modify your local .xmonad: > import XMonad.Prompt(def) > import XMonad.Actions.Launcher > ((modm .|. controlMask, xK_l), launcherPrompt def $ defaultLauncherModes launcherConfig) A LauncherConfig contains settings for the default modes, modify them accordingly. > launcherConfig = LauncherConfig { pathToHoogle = "/home/YOU/.cabal/bin/hoogle" , browser = "firefox"} Restart xmonad. Press Ctrl + Your_Modkey + L and the first prompt should pop up. If you used the default 'XPConfig', you can change mode with 'xK_grave'. If you are using your own 'XPConfig', define the value for 'changeModeKey'. -} data HoogleMode = HMode FilePath String --path to hoogle and browser data CalculatorMode = CalcMode data LauncherConfig = LauncherConfig { browser :: String , pathToHoogle :: String } type ExtensionActions = M.Map String (String -> X()) -- | Uses the command `calc` to compute arithmetic expressions instance XPrompt CalculatorMode where showXPrompt CalcMode = "calc %s> " commandToComplete CalcMode = id --send the whole string to `calc` completionFunction CalcMode = \s -> if (length s == 0) then return [] else do fmap lines $ runProcessWithInput "calc" [s] "" modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard -- | Uses the program `hoogle` to search for functions instance XPrompt HoogleMode where showXPrompt _ = "hoogle %s> " commandToComplete _ = id completionFunction (HMode pathToHoogleBin' _) = \s -> completionFunctionWith pathToHoogleBin' ["--count","8",s] -- This action calls hoogle again to find the URL corresponding to the autocompleted item modeAction (HMode pathToHoogleBin'' browser') query result = do completionsWithLink <- liftIO $ completionFunctionWith pathToHoogleBin'' ["--count","5","--link",query] let link = do s <- find (isJust . \complStr -> findSeqIndex complStr result) completionsWithLink i <- findSeqIndex s "http://" return $ drop i s case link of Just l -> spawn $ browser' ++ " " ++ l _ -> return () where -- | Receives a sublist and a list. It returns the index where the sublist appears in the list. findSeqIndex :: (Eq a) => [a] -> [a] -> Maybe Int findSeqIndex xs xss = findIndex (isPrefixOf xss) $ tails xs -- | 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 cmd args = do fmap lines $ runProcessWithInput cmd args "" -- | Creates a prompt with the given modes launcherPrompt :: XPConfig -> [XPMode] -> X() launcherPrompt config modes = mkXPromptWithModes modes config -- | Create a list of modes based on : -- a list of extensions mapped to actions -- the path to hoogle defaultLauncherModes :: LauncherConfig -> [XPMode] defaultLauncherModes cnf = let ph = pathToHoogle cnf in [ hoogleMode ph $ browser cnf , calcMode] hoogleMode :: FilePath -> String -> XPMode hoogleMode pathToHoogleBin browser' = XPT $ HMode pathToHoogleBin browser' calcMode :: XPMode calcMode = XPT CalcMode {- -- ideas for XMonad.Prompt running on mode XPMultipleModes * Switch to mode by name of the prompt, 1. ':' at an empty(?) buffer, 2. autocomplete name in buffer should happen, 3. switch to mode with enter (cancel switch with C-g) * Support for actions of type String -> X a -- ideas for this module * Hoogle mode: add a setting in the action to either go to documentation or to the source code (needs hoogle change?) * Hoogle mode: add setting to query hoogle at haskell.org instead (with &mode=json) -} xmonad-contrib-0.12/XMonad/Actions/CycleSelectedLayouts.hs0000644000000000000000000000336512636047674022007 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleSelectedLayouts -- Copyright : (c) Roman Cheplyaka -- License : BSD3-style (see LICENSE) -- -- Maintainer : Roman Cheplyaka -- Stability : unstable -- Portability : unportable -- -- This module allows to cycle through the given subset of layouts. -- ----------------------------------------------------------------------------- module XMonad.Actions.CycleSelectedLayouts ( -- * Usage -- $usage cycleThroughLayouts) where import XMonad import Data.List (findIndex) import Data.Maybe (fromMaybe) import XMonad.Layout.LayoutCombinators (JumpToLayout(..)) import qualified XMonad.StackSet as S -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad hiding ((|||)) -- > import XMonad.Layout.LayoutCombinators ((|||)) -- > import XMonad.Actions.CycleSelectedLayouts -- -- > , ((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 lst a = do -- not beautiful but simple and readable ind <- findIndex (a==) lst 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, -- apply the first layout from list. cycleThroughLayouts :: [String] -> X () cycleThroughLayouts lst = do winset <- gets windowset let ld = description . S.layout . S.workspace . S.current $ winset let newld = fromMaybe (head lst) (cycleToNext lst ld) sendMessage $ JumpToLayout newld xmonad-contrib-0.12/XMonad/Actions/FlexibleManipulate.hs0000644000000000000000000001106612636047674021465 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.FlexibleManipulate -- Copyright : (c) Michael Sloan -- License : BSD3-style (see LICENSE) -- -- Maintainer : -- Stability : stable -- Portability : unportable -- -- Move and resize floating windows without warping the mouse. -- ----------------------------------------------------------------------------- -- Based on the FlexibleResize code by Lukas Mai (mauke). module XMonad.Actions.FlexibleManipulate ( -- * Usage -- $usage mouseWindow, discrete, linear, resize, position ) where import XMonad import qualified Prelude as P import Prelude (($), (.), fst, snd, uncurry, const, id, Ord(..), Monad(..), fromIntegral, Double, Integer, map, round, otherwise) -- $usage -- First, add this import to your @~\/.xmonad\/xmonad.hs@: -- -- > import qualified XMonad.Actions.FlexibleManipulate as Flex -- -- Now set up the desired mouse binding, for example: -- -- > , ((modm, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w)) -- -- * Flex.'linear' indicates that positions between the edges and the -- middle indicate a combination scale\/position. -- -- * Flex.'discrete' indicates that there are discrete pick -- regions. (The window is divided by thirds for each axis.) -- -- * Flex.'resize' performs only a resize of the window, based on which -- quadrant the mouse is in. -- -- * Flex.'position' is similar to the built-in -- 'XMonad.Operations.mouseMoveWindow'. -- -- You can also write your own function for this parameter. It should take -- a value between 0 and 1 indicating position, and return a value indicating -- the corresponding position if plain Flex.'linear' was used. -- -- For detailed instructions on editing your mouse bindings, see -- "XMonad.Doc.Extending#Editing_mouse_bindings". discrete, linear, resize, position :: Double -> Double -- | Manipulate the window based on discrete pick regions; the window -- is divided into regions by thirds along each axis. discrete x | x < 0.33 = 0 | x > 0.66 = 1 | otherwise = 0.5 -- | Scale\/reposition the window by factors obtained from the mouse -- position by linear interpolation. Dragging precisely on a corner -- resizes that corner; dragging precisely in the middle moves the -- window without resizing; anything else is an interpolation -- between the two. linear = id -- | Only resize the window, based on the window quadrant the mouse is in. resize x = if x < 0.5 then 0 else 1 -- | Only reposition the window. position = const 0.5 -- | Given an interpolation function, implement an appropriate window -- manipulation action. mouseWindow :: (Double -> Double) -> Window -> X () mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do io $ raiseWindow d w [wpos, wsize] <- io $ getWindowAttributes d w >>= return . winAttrs sh <- io $ getWMNormalHints d w pointer <- io $ queryPointer d w >>= return . pointerPos let uv = (pointer - wpos) / wsize 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 atl = ((1, 1) - fc) * mul abr = fc * mul mouseDrag (\ex ey -> io $ do let offset = (fromIntegral ex, fromIntegral ey) - pointer npos = wpos + offset * atl nbr = (wpos + wsize) + offset * abr ntl = minP (nbr - (32, 32)) npos --minimum size nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl) moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth return ()) (float w) float w where pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt winAttrs :: WindowAttributes -> [Pnt] winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height] -- I'd rather I didn't have to do this, but I hate writing component 2d math type Pnt = (Double, Double) pairUp :: [a] -> [(a,a)] pairUp [] = [] pairUp [_] = [] pairUp (x:y:xs) = (x, y) : (pairUp xs) mapP :: (a -> b) -> (a, a) -> (b, b) mapP f (x, y) = (f x, f y) zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c) zipP f (ax,ay) (bx,by) = (f ax bx, f ay by) minP :: Ord a => (a,a) -> (a,a) -> (a,a) minP = zipP min infixl 6 +, - infixl 7 *, / (+), (-), (*) :: (P.Num a) => (a,a) -> (a,a) -> (a,a) (+) = zipP (P.+) (-) = zipP (P.-) (*) = zipP (P.*) (/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a) (/) = zipP (P./) xmonad-contrib-0.12/XMonad/Actions/TopicSpace.hs0000644000000000000000000003066612636047674017754 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.TopicSpace -- Copyright : (c) Nicolas Pouillard -- License : BSD-style (see LICENSE) -- -- Maintainer : Nicolas Pouillard -- Stability : unstable -- Portability : unportable -- -- Turns your workspaces into a more topic oriented system. ----------------------------------------------------------------------------- module XMonad.Actions.TopicSpace ( -- * Overview -- $overview -- * Usage -- $usage Topic , Dir , TopicConfig(..) , def , defaultTopicConfig , getLastFocusedTopics , setLastFocusedTopic , reverseLastFocusedTopics , pprWindowSet , topicActionWithPrompt , topicAction , currentTopicAction , switchTopic , switchNthLastFocused , shiftNthLastFocused , currentTopicDir , checkTopicConfig , (>*>) ) where import XMonad import Data.List 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 XMonad.Prompt import XMonad.Prompt.Workspace import XMonad.Hooks.UrgencyHook import XMonad.Hooks.DynamicLog (PP(..)) import qualified XMonad.Hooks.DynamicLog as DL import XMonad.Util.Run (spawnPipe) import qualified XMonad.Util.ExtensibleState as XS -- $overview -- This module allows to organize your workspaces on a precise topic basis. So -- instead of having a workspace called `work' you can setup one workspace per -- task. Here we call these workspaces, topics. The great thing with -- topics is that one can attach a directory that makes sense to each -- particular topic. One can also attach an action which will be triggered -- when switching to a topic that does not have any windows in it. So you can -- attach your mail client to the mail topic, some terminals in the right -- directory to the xmonad topic... This package also provides a nice way to -- display your topics in an historical way using a custom `pprWindowSet' -- function. You can also easily switch to recent topics using this history -- of last focused topics. -- $usage -- Here is an example of configuration using TopicSpace: -- -- > -- The list of all topics/workspaces of your xmonad configuration. -- > -- The order is important, new topics must be inserted -- > -- at the end of the list if you want hot-restarting -- > -- to work. -- > myTopics :: [Topic] -- > myTopics = -- > [ "dashboard" -- the first one -- > , "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc" -- > , "mail", "movie", "music", "talk", "text", "tools", "web", "xmonad" -- > , "yi", "documents", "twitter", "pdf" -- > ] -- > -- > myTopicConfig :: TopicConfig -- > myTopicConfig = def -- > { topicDirs = M.fromList $ -- > [ ("conf", "w/conf") -- > , ("dashboard", "Desktop") -- > , ("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) -- > ] -- > } -- > -- > -- extend your keybindings -- > 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 = currentTopicDir myTopicConfig >>= spawnShellIn -- > -- > spawnShellIn :: Dir -> X () -- > spawnShellIn dir = spawn $ "urxvt '(cd ''" ++ dir ++ "'' && " ++ myShell ++ " )'" -- > -- > goto :: Topic -> X () -- > goto = switchTopic myTopicConfig -- > -- > promptedGoto :: X () -- > promptedGoto = workspacePrompt myXPConfig goto -- > -- > promptedShift :: X () -- > promptedShift = workspacePrompt myXPConfig $ windows . W.shift -- > -- > myConfig = do -- > checkTopicConfig myTopics myTopicConfig -- > myLogHook <- makeMyLogHook -- > return $ def -- > { borderWidth = 1 -- Width of the window border in pixels. -- > , workspaces = myTopics -- > , layoutHook = myModifiers myLayout -- > , manageHook = myManageHook -- > , logHook = myLogHook -- > , handleEventHook = myHandleEventHook -- > , terminal = myTerminal -- The preferred terminal program. -- > , normalBorderColor = "#3f3c6d" -- > , focusedBorderColor = "#4f66ff" -- > , XMonad.modMask = mod1Mask -- > , keys = myKeys -- > , mouseBindings = myMouseBindings -- > } -- > -- > main :: IO () -- > main = xmonad =<< myConfig -- | An alias for @flip replicateM_@ (>*>) :: Monad m => m a -> Int -> m () (>*>) = flip replicateM_ infix >*> -- | 'Topic' is just an alias for 'WorkspaceId' type Topic = WorkspaceId -- | 'Dir' is just an alias for 'FilePath' but should points to a directory. type Dir = FilePath -- | Here is the topic space configuration area. data TopicConfig = TopicConfig { topicDirs :: M.Map Topic Dir -- ^ This mapping associate a directory to each topic. , topicActions :: M.Map Topic (X ()) -- ^ This mapping associate an action to trigger when -- switching to a given topic which workspace is empty. , defaultTopicAction :: Topic -> X () -- ^ This is the default topic action. , defaultTopic :: Topic -- ^ This is the default topic. , maxTopicHistory :: Int -- ^ This setups the maximum depth of topic history, usually -- 10 is a good default since we can bind all of them using -- numeric keypad. } instance Default TopicConfig where def = TopicConfig { topicDirs = M.empty , topicActions = M.empty , defaultTopicAction = const (ask >>= spawn . terminal . config) , defaultTopic = "1" , maxTopicHistory = 10 } {-# DEPRECATED defaultTopicConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.TopicSpace) instead." #-} defaultTopicConfig :: TopicConfig defaultTopicConfig = def newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable) instance ExtensionClass PrevTopics where initialValue = PrevTopics [] extensionType = PersistentExtension -- | Returns the list of last focused workspaces the empty list otherwise. getLastFocusedTopics :: X [String] getLastFocusedTopics = XS.gets getPrevTopics -- | 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" reverseLastFocusedTopics :: X () reverseLastFocusedTopics = XS.modify $ PrevTopics . reverse . getPrevTopics -- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration -- and a pretty-printing record 'PP'. It will show the list of topics sorted historically -- and highlighting topics with urgent windows. pprWindowSet :: TopicConfig -> PP -> X String pprWindowSet tg pp = do winset <- gets windowset urgents <- readUrgents let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset maxDepth = maxTopicHistory tg setLastFocusedTopic (W.tag . W.workspace . W.current $ winset) (`notElem` empty_workspaces) lastWs <- getLastFocusedTopics let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic]) add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible } sortWindows = take maxDepth . sortBy (comparing $ depth . W.tag) return $ DL.pprWindowSet sortWindows urgents pp' winset -- | Given a prompt configuration and a topic configuration, triggers the action associated with -- the topic given in prompt. topicActionWithPrompt :: XPConfig -> TopicConfig -> X () topicActionWithPrompt xp tg = workspacePrompt xp (liftM2 (>>) (switchTopic tg) (topicAction tg)) -- | Given a configuration and a topic, triggers the action associated with the given topic. topicAction :: TopicConfig -> Topic -> X () topicAction tg topic = fromMaybe (defaultTopicAction tg topic) $ M.lookup topic $ topicActions tg -- | Trigger the action associated with the current topic. currentTopicAction :: TopicConfig -> X () currentTopicAction tg = topicAction tg =<< gets (W.tag . W.workspace . W.current . windowset) -- | Switch to the given topic. switchTopic :: TopicConfig -> Topic -> X () switchTopic tg topic = do windows $ W.greedyView topic wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset) when (null wins) $ topicAction tg topic -- | Switch to the Nth last focused topic or failback to the 'defaultTopic'. switchNthLastFocused :: TopicConfig -> Int -> X () switchNthLastFocused tg depth = do lastWs <- getLastFocusedTopics switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth -- | Shift the focused window to the Nth last focused topic, or fallback to doing nothing. shiftNthLastFocused :: Int -> X () shiftNthLastFocused n = do ws <- fmap (listToMaybe . drop n) getLastFocusedTopics whenJust ws $ windows . W.shift -- | Returns the directory associated with current topic returns the empty string otherwise. currentTopicDir :: TopicConfig -> X String currentTopicDir tg = do topic <- gets (W.tag . W.workspace . W.current . windowset) return . fromMaybe "" . M.lookup topic $ topicDirs tg -- | Check the given topic configuration for duplicates topics or undefined topics. checkTopicConfig :: [Topic] -> TopicConfig -> IO () checkTopicConfig tags tg = do -- tags <- gets $ map W.tag . workspaces . windowset let seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg) dups = tags \\ nub tags diffTopic = seenTopics \\ sort tags check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst check diffTopic "Seen but missing topics/workspaces" check dups "Duplicate topics/workspaces" -- | Display the given message using the @xmessage@ program. xmessage :: String -> IO () xmessage s = do h <- spawnPipe "xmessage -file -" hPutStr h s hClose h xmonad-contrib-0.12/XMonad/Actions/RotSlaves.hs0000644000000000000000000000447712636047674017645 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.RotSlaves -- Copyright : (c) Hans Philipp Annen , Mischa Dieterle -- License : BSD3-style (see LICENSE) -- -- Maintainer : Hans Philipp Annen -- Stability : stable -- Portability : unportable -- -- Rotate all windows except the master window and keep the focus in -- place. ----------------------------------------------------------------------------- module XMonad.Actions.RotSlaves ( -- $usage rotSlaves', rotSlavesUp, rotSlavesDown, rotAll', rotAllUp, rotAllDown ) where import XMonad.StackSet import XMonad -- $usage -- -- To use this module, import it with: -- -- > import XMonad.Actions.RotSlaves -- -- and add whatever keybindings you would like, for example: -- -- > , ((modm .|. shiftMask, xK_Tab ), rotSlavesUp) -- -- This operation will rotate all windows except the master window, -- while the focus stays where it is. It is useful together with the -- TwoPane layout (see "XMonad.Layout.TwoPane"). -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Rotate the windows in the current stack, excluding the first one -- (master). rotSlavesUp,rotSlavesDown :: X () rotSlavesUp = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l])) rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l))) -- | The actual rotation, as a pure function on the window stack. rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a rotSlaves' _ s@(Stack _ [] []) = s rotSlaves' f (Stack t [] rs) = Stack t [] (f rs) -- Master has focus rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs' -- otherwise where (master:ws) = integrate s (revls',t':rs') = splitAt (length ls) (master:(f ws)) -- | Rotate all the windows in the current stack. rotAllUp,rotAllDown :: X () rotAllUp = windows $ modify' (rotAll' (\l -> (tail l)++[head l])) rotAllDown = windows $ modify' (rotAll' (\l -> [last l]++(init l))) -- | The actual rotation, as a pure function on the window stack. rotAll' :: ([a] -> [a]) -> Stack a -> Stack a rotAll' f s = Stack r (reverse revls) rs where (revls,r:rs) = splitAt (length (up s)) (f (integrate s)) xmonad-contrib-0.12/XMonad/Actions/FindEmptyWorkspace.hs0000644000000000000000000000461212636047674021470 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.FindEmptyWorkspace -- Copyright : (c) Miikka Koskinen 2007 -- License : BSD3-style (see LICENSE) -- -- Maintainer : arcatan@kapsi.fi -- Stability : stable -- Portability : unportable -- -- Find an empty workspace. -- ----------------------------------------------------------------------------- module XMonad.Actions.FindEmptyWorkspace ( -- * Usage -- $usage viewEmptyWorkspace, tagToEmptyWorkspace, sendToEmptyWorkspace ) where import Data.List import Data.Maybe ( isNothing ) import XMonad import XMonad.StackSet -- $usage -- -- To use, import this module into your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.FindEmptyWorkspace -- -- and add the desired keybindings, for example: -- -- > , ((modm, xK_m ), viewEmptyWorkspace) -- > , ((modm .|. shiftMask, xK_m ), tagToEmptyWorkspace) -- -- Now you can jump to an empty workspace with @mod-m@. @Mod-shift-m@ -- will tag the current window to an empty workspace and view it. -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Find the first hidden empty workspace in a StackSet. Returns -- Nothing if all workspaces are in use. Function searches currently -- focused workspace, other visible workspaces (when in Xinerama) and -- hidden workspaces in this order. findEmptyWorkspace :: StackSet i l a s sd -> Maybe (Workspace i l a) findEmptyWorkspace = find (isNothing . stack) . allWorkspaces where allWorkspaces ss = (workspace . current) ss : (map workspace . visible) ss ++ hidden ss withEmptyWorkspace :: (WorkspaceId -> X ()) -> X () withEmptyWorkspace f = do ws <- gets windowset whenJust (findEmptyWorkspace ws) (f . tag) -- | Find and view an empty workspace. Do nothing if all workspaces are -- in use. viewEmptyWorkspace :: X () viewEmptyWorkspace = withEmptyWorkspace (windows . view) -- | Tag current window to an empty workspace and view it. Do nothing if -- all workspaces are in use. tagToEmptyWorkspace :: X () tagToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ view w . shift w -- | Send current window to an empty workspace. Do nothing if -- all workspaces are in use. sendToEmptyWorkspace :: X () sendToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ shift w xmonad-contrib-0.12/XMonad/Actions/GroupNavigation.hs0000644000000000000000000002107212636047674021025 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} ---------------------------------------------------------------------- -- | -- Module : XMonad.Actions.GroupNavigation -- Copyright : (c) nzeh@cs.dal.ca -- License : BSD3-style (see LICENSE) -- -- Maintainer : nzeh@cs.dal.ca -- Stability : unstable -- Portability : unportable -- -- Provides methods for cycling through groups of windows across -- workspaces, ignoring windows that do not belong to this group. A -- group consists of all windows matching a user-provided boolean -- query. -- -- Also provides a method for jumping back to the most recently used -- window in any given group. -- ---------------------------------------------------------------------- module XMonad.Actions.GroupNavigation ( -- * Usage -- $usage Direction (..) , nextMatch , nextMatchOrDo , nextMatchWithThis , historyHook ) where import Control.Monad.Reader import Data.Foldable as Fold import Data.Map as Map import Data.Sequence as Seq import Data.Set as Set import Graphics.X11.Types import Prelude hiding (concatMap, drop, elem, filter, null, reverse) import XMonad.Core import XMonad.ManageHook import XMonad.Operations (windows, withFocused) import qualified XMonad.StackSet as SS import qualified XMonad.Util.ExtensibleState as XS {- $usage Import the module into your @~\/.xmonad\/xmonad.hs@: > import XMonad.Actions.GroupNavigation To support cycling forward and backward through all xterm windows, add something like this to your keybindings: > , ((modm , xK_t), nextMatch Forward (className =? "XTerm")) > , ((modm .|. shiftMask, xK_t), nextMatch Backward (className =? "XTerm")) These key combinations do nothing if there is no xterm window open. If you rather want to open a new xterm window if there is no open xterm window, use 'nextMatchOrDo' instead: > , ((modm , xK_t), nextMatchOrDo Forward (className =? "XTerm") (spawn "xterm")) > , ((modm .|. shiftMask, xK_t), nextMatchOrDo Backward (className =? "XTerm") (spawn "xterm")) You can use 'nextMatchWithThis' with an arbitrary query to cycle through all windows for which this query returns the same value as the current window. For example, to cycle through all windows in the same window class as the current window use: > , ((modm , xK_f), nextMatchWithThis Forward className) > , ((modm , xK_b), nextMatchWithThis Backward className) Finally, you can define keybindings to jump to the most recent window matching a certain Boolean query. To do this, you need to add 'historyHook' to your logHook: > main = xmonad $ def { logHook = historyHook } Then the following keybindings, for example, allow you to return to the most recent xterm or emacs window or to simply to the most recent window: > , ((modm .|. controlMask, xK_e), nextMatch History (className =? "Emacs")) > , ((modm .|. controlMask, xK_t), nextMatch History (className =? "XTerm")) > , ((modm , xK_BackSpace), nextMatch History (return True)) Again, you can use 'nextMatchOrDo' instead of 'nextMatch' if you want to execute an action if no window matching the query exists. -} --- Basic cyclic navigation based on queries ------------------------- -- | The direction in which to look for the next match data Direction = Forward -- ^ Forward from current window or workspace | Backward -- ^ Backward from current window or workspace | History -- ^ Backward in history -- | Focuses the next window for which the given query produces the -- same result as the currently focused window. Does nothing if there -- is no focused window (i.e., the current workspace is empty). nextMatchWithThis :: Eq a => Direction -> Query a -> X () nextMatchWithThis dir qry = withFocused $ \win -> do prop <- runQuery qry win nextMatch dir (qry =? prop) -- | Focuses the next window that matches the given boolean query. -- Does nothing if there is no such window. This is the same as -- 'nextMatchOrDo' with alternate action @return ()@. nextMatch :: Direction -> Query Bool -> X () nextMatch dir qry = nextMatchOrDo dir qry (return ()) -- | Focuses the next window that matches the given boolean query. If -- there is no such window, perform the given action instead. nextMatchOrDo :: Direction -> Query Bool -> X () -> X () nextMatchOrDo dir qry act = orderedWindowList dir >>= focusNextMatchOrDo qry act -- Produces the action to perform depending on whether there's a -- matching window focusNextMatchOrDo :: Query Bool -> X () -> Seq Window -> X () focusNextMatchOrDo qry act = findM (runQuery qry) >=> maybe act (windows . SS.focusWindow) -- Returns the list of windows ordered by workspace as specified in -- ~/.xmonad/xmonad.hs orderedWindowList :: Direction -> X (Seq Window) orderedWindowList History = liftM (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get orderedWindowList dir = withWindowSet $ \ss -> do wsids <- asks (Seq.fromList . workspaces . config) let wspcs = orderedWorkspaceList ss wsids wins = dirfun dir $ Fold.foldl' (><) Seq.empty $ fmap (Seq.fromList . SS.integrate' . SS.stack) wspcs cur = SS.peek ss return $ maybe wins (rotfun wins) cur where dirfun Backward = Seq.reverse dirfun _ = id rotfun wins x = rotate $ rotateTo (== x) wins -- Returns the ordered workspace list as specified in ~/.xmonad/xmonad.hs orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs' where wspcs = SS.workspaces ss wspcsMap = Fold.foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs wspcs' = fmap (\wsid -> wspcsMap ! wsid) wsids isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss) --- History navigation, requires a layout modifier ------------------- -- The state extension that holds the history information data HistoryDB = HistoryDB (Maybe Window) -- currently focused window (Seq Window) -- previously focused windows deriving (Read, Show, Typeable) instance ExtensionClass HistoryDB where initialValue = HistoryDB Nothing Seq.empty extensionType = PersistentExtension -- | Action that needs to be executed as a logHook to maintain the -- focus history of all windows as the WindowSet changes. historyHook :: X () historyHook = XS.get >>= updateHistory >>= XS.put -- Updates the history in response to a WindowSet change updateHistory :: HistoryDB -> X HistoryDB updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do let newcur = SS.peek ss wins = Set.fromList $ SS.allWindows ss newhist = flt (flip Set.member wins) (ins oldcur oldhist) return $ HistoryDB newcur (del newcur newhist) where ins x xs = maybe xs (<| 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 -------------------------------------------- -- Rotates the sequence by one position rotate :: Seq a -> Seq a rotate xs = rotate' (viewl xs) where rotate' EmptyL = Seq.empty rotate' (x' :< xs') = xs' |> x' -- Rotates the sequence until an element matching the given condition -- is at the beginning of the sequence. rotateTo :: (a -> Bool) -> Seq a -> Seq a rotateTo cond xs = let (lxs, rxs) = brkl cond xs in rxs >< lxs --- A monadic find --------------------------------------------------- -- Applies the given action to every sequence element in turn until -- the first element is found for which the action returns true. The -- remaining elements in the sequence are ignored. findM :: Monad m => (a -> m Bool) -> Seq a -> m (Maybe a) findM cond xs = findM' cond (viewl xs) where findM' _ EmptyL = return Nothing findM' qry (x' :< xs') = do isMatch <- qry x' if isMatch then return (Just x') else findM qry xs' xmonad-contrib-0.12/XMonad/Actions/SimpleDate.hs0000644000000000000000000000227112636047674017740 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.SimpleDate -- Copyright : (c) Don Stewart 2007 -- License : BSD3-style (see LICENSE) -- -- Maintainer : dons@cse.unsw.edu.au -- Stability : stable -- Portability : portable -- -- An example external contrib module for XMonad. -- Provides a simple binding to dzen2 to print the date as a popup menu. -- ----------------------------------------------------------------------------- module XMonad.Actions.SimpleDate ( -- * Usage -- $usage date ) where import XMonad.Core import XMonad.Util.Run -- $usage -- To use, import this module into @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.SimpleDate -- -- and add a keybinding, for example: -- -- > , ((modm, xK_d ), date) -- -- In this example, a popup date menu will now be bound to @mod-d@. -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". date :: X () date = unsafeSpawn "(date; sleep 10) | dzen2" xmonad-contrib-0.12/XMonad/Actions/NoBorders.hs0000644000000000000000000000172312636047674017607 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.NoBorders -- Copyright : (c) Lukas Mai -- License : BSD3-style (see LICENSE) -- -- Maintainer : Lukas Mai -- Stability : stable -- Portability : unportable -- -- This module provides helper functions for dealing with window borders. -- ----------------------------------------------------------------------------- module XMonad.Actions.NoBorders ( toggleBorder ) where import XMonad -- | Toggle the border of the currently focused window. To use it, add a -- keybinding like so: -- -- > , ((modm, xK_g ), withFocused toggleBorder) -- toggleBorder :: Window -> X () toggleBorder w = do bw <- asks (borderWidth . config) withDisplay $ \d -> io $ do cw <- wa_border_width `fmap` getWindowAttributes d w if cw == 0 then setWindowBorderWidth d w bw else setWindowBorderWidth d w 0 xmonad-contrib-0.12/XMonad/Actions/WindowGo.hs0000644000000000000000000002003512636047674017444 0ustar0000000000000000{- | Module : XMonad.Actions.WindowGo License : Public domain Maintainer : Stability : unstable Portability : unportable Defines a few convenient operations for raising (traveling to) windows based on XMonad's Query monad, such as 'runOrRaise'. runOrRaise will run a shell command unless it can find a specified window; you would use this to automatically travel to your Firefox or Emacs session, or start a new one (for example), instead of trying to remember where you left it or whether you still have one running. -} module XMonad.Actions.WindowGo ( -- * Usage -- $usage raise, raiseNext, runOrRaise, runOrRaiseNext, raiseMaybe, raiseNextMaybe, raiseBrowser, raiseEditor, runOrRaiseAndDo, runOrRaiseMaster, raiseAndDo, raiseMaster, ifWindows, ifWindow, raiseHook, module XMonad.ManageHook ) where import Control.Monad import Data.Char (toLower) import Data.Monoid import XMonad (Query(), X(), ManageHook, withWindowSet, runQuery, liftIO, ask) import Graphics.X11 (Window) import XMonad.ManageHook import XMonad.Operations (windows) import XMonad.Prompt.Shell (getBrowser, getEditor) import qualified XMonad.StackSet as W (allWindows, peek, swapMaster, focusWindow) import XMonad.Util.Run (safeSpawnProg) {- $usage Import the module into your @~\/.xmonad\/xmonad.hs@: > import XMonad.Actions.WindowGo and define appropriate key bindings: > , ((modm .|. shiftMask, xK_g), raise (className =? "Firefox")) > , ((modm .|. shiftMask, xK_b), runOrRaise "firefox" (className =? "Firefox")) (Note that Firefox v3 and up have a class-name of \"Firefox\" and \"Navigator\"; lower versions use other classnames such as \"Firefox-bin\". Either choose the appropriate one, or cover your bases by using instead something like: > (className =? "Firefox" <||> className =? "Firefox-bin") For detailed instructions on editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". -} -- | If windows that satisfy the query exist, apply the supplied -- function to them, otherwise run the action given as -- second parameter. ifWindows :: Query Bool -> ([Window] -> X ()) -> X () -> X () ifWindows qry f el = withWindowSet $ \wins -> do matches <- filterM (runQuery qry) $ W.allWindows wins case matches of [] -> el ws -> f ws -- | The same as ifWindows, but applies a ManageHook to the first match -- instead and discards the other matches ifWindow :: Query Bool -> ManageHook -> X () -> X () ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . head) {- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found. Presumably this executable is the same one that you were looking for. Note that this does not go through the shell. If you wish to run an arbitrary IO action (such as 'spawn', which will run its String argument through the shell), then you will want to use 'raiseMaybe' directly. -} runOrRaise :: String -> Query Bool -> X () runOrRaise = raiseMaybe . safeSpawnProg -- | See 'raiseMaybe'. If the Window can't be found, quietly give up and do nothing. raise :: Query Bool -> X () raise = raiseMaybe $ return () {- | 'raiseMaybe' queries all Windows based on a boolean provided by the user. Currently, there are 3 such useful booleans defined in "XMonad.ManageHook": 'title', 'resource', 'className'. Each one tests based pretty much as you would think. ManageHook also defines several operators, the most useful of which is (=?). So a useful test might be finding a @Window@ whose class is Firefox. Firefox 3 declares the class \"Firefox\", so you'd want to pass in a boolean like @(className =? \"Firefox\")@. If the boolean returns @True@ on one or more windows, then XMonad will quickly make visible the first result. If no @Window@ meets the criteria, then the first argument comes into play. The first argument is an arbitrary IO function which will be executed if the tests fail. This is what enables 'runOrRaise' to use 'raiseMaybe': it simply runs the desired program if it isn't found. But you don't have to do that. Maybe you want to do nothing if the search fails (the definition of 'raise'), or maybe you want to write to a log file, or call some prompt function, or something crazy like that. This hook gives you that flexibility. You can do some cute things with this hook. Suppose you want to do the same thing for Mutt which you just did for Firefox - but Mutt runs inside a terminal window? No problem: you search for a terminal window calling itself \"mutt\", and if there isn't you run a terminal with a command to run Mutt! Here's an example (borrowing 'runInTerm' from "XMonad.Util.Run"): > , ((modm, xK_m), raiseMaybe (runInTerm "-title mutt" "mutt") (title =? "mutt")) -} raiseMaybe :: X () -> Query Bool -> X () raiseMaybe f qry = ifWindow qry raiseHook f -- | A manage hook that raises the window. raiseHook :: ManageHook raiseHook = ask >>= doF . W.focusWindow -- | See 'runOrRaise' and 'raiseNextMaybe'. Version that allows cycling through matches. runOrRaiseNext :: String -> Query Bool -> X () runOrRaiseNext = raiseNextMaybe . safeSpawnProg -- | See 'raise' and 'raiseNextMaybe'. Version that allows cycling through matches. raiseNext :: Query Bool -> X () raiseNext = raiseNextMaybe $ return () {- | See 'raiseMaybe'. 'raiseNextMaybe' is an alternative version that allows cycling through the matching windows. If the focused window matches the query the next matching window is raised. If no matches are found the function f is executed. -} raiseNextMaybe :: X () -> Query Bool -> X () raiseNextMaybe f qry = flip (ifWindows qry) f $ \ws -> do foc <- withWindowSet $ return . W.peek case foc of Just w | w `elem` ws -> let (_:y:_) = dropWhile (/=w) $ cycle ws -- cannot fail to match in windows $ W.focusWindow y _ -> windows . W.focusWindow . head $ ws -- | Given a function which gets us a String, we try to raise a window with that classname, -- or we then interpret that String as a executable name. raiseVar :: IO String -> X () raiseVar getvar = liftIO getvar >>= \var -> runOrRaise var (fmap (map toLower) className =? var) {- | 'raiseBrowser' and 'raiseEditor' grab $BROWSER and $EDITOR respectively and they either take you to the specified program's window, or they try to run it. This is most useful if your variables are simple and look like \"firefox\" or \"emacs\". -} raiseBrowser, raiseEditor :: X () raiseBrowser = raiseVar getBrowser raiseEditor = raiseVar getEditor {- | If the window is found the window is focused and the third argument is called otherwise, the first argument is called See 'raiseMaster' for an example. -} raiseAndDo :: X () -> Query Bool -> (Window -> X ()) -> X () raiseAndDo f qry after = ifWindow qry (afterRaise `mappend` raiseHook) f where afterRaise = ask >>= (>> idHook) . liftX . after {- | If a window matching the second argument is found, the window is focused and the third argument is called; otherwise, the first argument is called. -} runOrRaiseAndDo :: String -> Query Bool -> (Window -> X ()) -> X () runOrRaiseAndDo = raiseAndDo . safeSpawnProg {- | if the window is found the window is focused and set to master otherwise, the first argument is called. > raiseMaster (runInTerm "-title ghci" "zsh -c 'ghci'") (title =? "ghci") -} raiseMaster :: X () -> Query Bool -> X () raiseMaster raisef thatUserQuery = raiseAndDo raisef thatUserQuery (\_ -> windows W.swapMaster) {- | If the window is found the window is focused and set to master otherwise, action is run. > runOrRaiseMaster "firefox" (className =? "Firefox")) -} runOrRaiseMaster :: String -> Query Bool -> X () runOrRaiseMaster run query = runOrRaiseAndDo run query (\_ -> windows W.swapMaster) xmonad-contrib-0.12/XMonad/Actions/DynamicProjects.hs0000644000000000000000000002663312636047674021017 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} -------------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.DynamicProjects -- Copyright : (c) Peter J. Jones -- License : BSD3-style (see LICENSE) -- -- Maintainer : Peter Jones -- Stability : unstable -- Portability : not portable -- -- Imbues workspaces with additional features so they can be treated -- as individual project areas. -------------------------------------------------------------------------------- module XMonad.Actions.DynamicProjects ( -- * Overview -- $overview -- * Usage -- $usage -- * Types Project (..) , ProjectName -- * Hooks , dynamicProjects -- * Bindings , switchProjectPrompt , shiftToProjectPrompt , renameProjectPrompt -- * Helper Functions , switchProject , shiftToProject , lookupProject , currentProject , activateProject ) where -------------------------------------------------------------------------------- import Control.Applicative ((<|>)) import Control.Monad (when, unless) import Data.List (sort, union, stripPrefix) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe, isNothing) import Data.Monoid ((<>)) import System.Directory (setCurrentDirectory, getHomeDirectory) import XMonad import XMonad.Actions.DynamicWorkspaces import XMonad.Prompt import XMonad.Prompt.Directory (directoryPrompt) import XMonad.Prompt.Workspace (Wor(..)) import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS -------------------------------------------------------------------------------- -- $overview -- Inspired by @TopicSpace@, @DynamicWorkspaces@, and @WorkspaceDir@, -- @DynamicProjects@ treats workspaces as projects while maintaining -- compatibility with all existing workspace-related functionality in -- XMonad. -- -- Instead of using generic workspace names such as @3@ or @work@, -- @DynamicProjects@ allows you to dedicate workspaces to specific -- projects and then switch between projects easily. -- -- A project is made up of a name, working directory, and a start-up -- hook. When you switch to a workspace, @DynamicProjects@ changes -- the working directory to the one configured for the matching -- project. If the workspace doesn't have any windows, the project's -- start-up hook is executed. This allows you to launch applications -- or further configure the workspace/project. -- -- When using the @switchProjectPrompt@ function, workspaces are -- created as needed. This means you can create new project spaces -- (and therefore workspaces) on the fly. (These dynamic projects are -- not preserved across restarts.) -- -- Additionally, frequently used projects can be configured statically -- in your XMonad configuration. Doing so allows you to configure the -- per-project start-up hook. -------------------------------------------------------------------------------- -- $usage -- To use @DynamicProjects@ you need to add it to your XMonad -- configuration and then configure some optional key bindings. -- -- > import XMonad.Actions.DynamicProjects -- -- Start by defining some projects: -- -- > projects :: [Project] -- > projects = -- > [ Project { projectName = "scratch" -- > , projectDirectory = "~/" -- > , projectStartHook = Nothing -- > } -- > -- > , Project { projectName = "browser" -- > , projectDirectory = "~/download" -- > , projectStartHook = Just $ do spawn "conkeror" -- > spawn "chromium" -- > } -- > ] -- -- Then inject @DynamicProjects@ into your XMonad configuration: -- -- > main = xmonad $ dynamicProjects projects def -- -- And finally, configure some optional key bindings: -- -- > , ((modm, xK_space), switchProjectPrompt) -- > , ((modm, xK_slash), shiftToProjectPrompt) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -------------------------------------------------------------------------------- type ProjectName = String type ProjectTable = Map ProjectName Project -------------------------------------------------------------------------------- -- | Details about a workspace that represents a project. data Project = Project { projectName :: !ProjectName -- ^ Workspace name. , projectDirectory :: !FilePath -- ^ Working directory. , projectStartHook :: !(Maybe (X ())) -- ^ Optional start-up hook. } deriving Typeable -------------------------------------------------------------------------------- -- | Internal project state. data ProjectState = ProjectState { projects :: !ProjectTable , previousProject :: !(Maybe WorkspaceId) } deriving Typeable -------------------------------------------------------------------------------- instance ExtensionClass ProjectState where initialValue = ProjectState Map.empty Nothing -------------------------------------------------------------------------------- -- | Add dynamic projects support to the given config. dynamicProjects :: [Project] -> XConfig a -> XConfig a dynamicProjects ps c = c { startupHook = startupHook c <> dynamicProjectsStartupHook ps , logHook = logHook c <> dynamicProjectsLogHook } -------------------------------------------------------------------------------- -- | Log hook for tracking workspace changes. dynamicProjectsLogHook :: X () dynamicProjectsLogHook = do name <- gets (W.tag . W.workspace . W.current . windowset) state <- XS.get unless (Just name == previousProject state) $ do XS.put (state {previousProject = Just name}) activateProject . fromMaybe (defProject name) $ Map.lookup name (projects state) -------------------------------------------------------------------------------- -- | Start-up hook for recording configured projects. dynamicProjectsStartupHook :: [Project] -> X () dynamicProjectsStartupHook ps = XS.modify go where go :: ProjectState -> ProjectState go s = s {projects = update $ projects s} update :: ProjectTable -> ProjectTable update = Map.union (Map.fromList $ map entry ps) entry :: Project -> (ProjectName, Project) entry p = (projectName p, addDefaultHook p) -- Force the hook to be a @Just@ so that it doesn't automatically -- get deleted when switching away from a workspace with no -- windows. addDefaultHook :: Project -> Project addDefaultHook p = p { projectStartHook = projectStartHook p <|> Just (return ()) } -------------------------------------------------------------------------------- -- | Find a project based on its name. lookupProject :: ProjectName -> X (Maybe Project) lookupProject name = Map.lookup name `fmap` XS.gets projects -------------------------------------------------------------------------------- -- | Fetch the current project (the one being used for the currently -- active workspace). currentProject :: X Project currentProject = do name <- gets (W.tag . W.workspace . W.current . windowset) proj <- lookupProject name return $ fromMaybe (defProject name) proj -------------------------------------------------------------------------------- -- | Switch to the given project. switchProject :: Project -> X () switchProject p = do oldws <- gets (W.workspace . W.current . windowset) oldp <- currentProject let name = W.tag oldws ws = W.integrate' (W.stack oldws) -- If the project we are switching away from has no windows, and -- it's a dynamic project, remove it from the configuration. when (null ws && isNothing (projectStartHook oldp)) $ XS.modify (\s -> s {projects = Map.delete name $ projects s}) appendWorkspace (projectName p) -------------------------------------------------------------------------------- -- | Prompt for a project name and then switch to it. Automatically -- creates a project if a new name is returned from the prompt. switchProjectPrompt :: XPConfig -> X () switchProjectPrompt c = projectPrompt c switch where switch :: ProjectTable -> ProjectName -> X () switch ps name = case Map.lookup name ps of Just p -> switchProject p Nothing | null name -> return () | otherwise -> directoryPrompt dirC "Project Dir: " (mkProject name) dirC :: XPConfig dirC = c { alwaysHighlight = False } -- Fix broken tab completion. mkProject :: ProjectName -> FilePath -> X () mkProject name dir = do let p = Project name dir Nothing XS.modify $ \s -> s {projects = Map.insert name p $ projects s} switchProject p -------------------------------------------------------------------------------- -- | Shift the currently focused window to the given project. shiftToProject :: Project -> X () shiftToProject p = do addHiddenWorkspace (projectName p) windows (W.shift $ projectName p) -------------------------------------------------------------------------------- -- | Prompts for a project name and then shifts the currently focused -- window to that project. shiftToProjectPrompt :: XPConfig -> X () shiftToProjectPrompt c = projectPrompt c go where go :: ProjectTable -> ProjectName -> X () go ps name = shiftToProject . fromMaybe (defProject name) $ Map.lookup name ps -------------------------------------------------------------------------------- -- | Prompt for a project name. projectPrompt :: 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. renameProjectPrompt :: XPConfig -> X () renameProjectPrompt c = mkXPrompt (Wor "New Project Name: ") c (return . (:[])) go where go :: String -> X () go name = do p <- currentProject ps <- XS.gets projects renameWorkspaceByName name let p' = fromMaybe (p { projectName = name }) $ Map.lookup name ps ps' = Map.insert name p' $ Map.delete (projectName p) ps XS.modify $ \s -> s {projects = ps'} activateProject p' -------------------------------------------------------------------------------- -- | Activate a project by updating the working directory and -- possibly running its start-up hook. This function is automatically -- invoked when the workspace changes. activateProject :: Project -> X () activateProject p = do ws <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset) home <- io getHomeDirectory -- Change to the project's directory. catchIO (setCurrentDirectory $ expandHome home $ projectDirectory p) -- Possibly run the project's startup hook. when (null ws) $ fromMaybe (return ()) (projectStartHook p) where -- Replace an initial @~@ character with the home directory. expandHome :: FilePath -> FilePath -> FilePath expandHome home dir = case stripPrefix "~" dir of Nothing -> dir Just xs -> home ++ xs -------------------------------------------------------------------------------- -- | Default project. defProject :: ProjectName -> Project defProject name = Project name "~/" Nothing xmonad-contrib-0.12/XMonad/Actions/LinkWorkspaces.hs0000644000000000000000000001732512636047674020656 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.LinkWorkspaces -- Copyright : (c) Jan-David Quesel -- License : BSD3-style (see LICENSE) -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- Provides bindings to add and delete links between workspaces. It is aimed -- at providing useful links between workspaces in a multihead setup. Linked -- workspaces are view at the same time. -- ----------------------------------------------------------------------------- {-# LANGUAGE DeriveDataTypeable #-} module XMonad.Actions.LinkWorkspaces ( -- * Usage -- $usage switchWS, removeAllMatchings, unMatch, toggleLinkWorkspaces, defaultMessageConf, MessageConfig(..) ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Layout.IndependentScreens(countScreens) import qualified XMonad.Util.ExtensibleState as XS (get, put) import XMonad.Actions.OnScreen(Focus(FocusCurrent), onScreen') import qualified Data.Map as M ( insert, delete, Map, lookup, empty, filter ) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Actions.LinkWorkspaces -- -- and add a function to print messages like -- -- > message_command (S screen) = " dzen2 -p 1 -w 300 -xs " ++ show (screen + 1) -- > message_color_func c1 c2 msg = dzenColor c1 c2 msg -- > message screen c1 c2 msg = spawn $ "echo '" ++ (message_color_func c1 c2 msg) ++ "' | " ++ message_command screen -- -- alternatively you can use the noMessages function as the argument -- -- Then add keybindings like the following: -- -- > ,((modm, xK_p), toggleLinkWorkspaces message) -- > ,((modm .|. shiftMask, xK_p), removeAllMatchings message) -- -- > [ ((modm .|. m, k), a i) -- > | (a, m) <- [(switchWS (\y -> windows $ view y) message, 0),(switchWS (\x -> windows $ shift x . view x) message, shiftMask)] -- > , (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]] -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". data MessageConfig = MessageConfig { messageFunction :: (ScreenId -> [Char] -> [Char] -> [Char] -> X()) , foreground :: [Char] , alertedForeground :: [Char] , background :: [Char] } defaultMessageConf :: MessageConfig defaultMessageConf = MessageConfig { messageFunction = noMessageFn , background = "#000000" , alertedForeground = "#ff7701" , foreground = "#00ff00" } noMessageFn :: ScreenId -> [Char] -> [Char] -> [Char] -> X() noMessageFn _ _ _ _ = return () :: X () -- | Stuff for linking workspaces data WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable) instance ExtensionClass WorkspaceMap where initialValue = WorkspaceMap M.empty extensionType = PersistentExtension switchWS :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> X () 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 -- | we already did switching on switchWS' :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> (Maybe ScreenId) -> X () switchWS' switchFn message workspace stopAtScreen = do ws <- gets windowset nScreens <- countScreens let now = W.screen (W.current ws) let next = ((now + 1) `mod` nScreens) switchFn workspace case stopAtScreen of Nothing -> sTM now next (Just now) Just sId -> if sId == next then return () else sTM now next (Just sId) where sTM = switchToMatching (switchWS' switchFn message) message workspace -- | 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. switchToMatching :: (WorkspaceId -> (Maybe ScreenId) -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId -> ScreenId -> (Maybe ScreenId) -> X () switchToMatching f message t now next stopAtScreen = do WorkspaceMap matchings <- XS.get :: X WorkspaceMap case (M.lookup t matchings) of Nothing -> return () :: X() Just newWorkspace -> do onScreen' (f newWorkspace stopAtScreen) FocusCurrent next messageFunction message now (foreground message) (background message) ("Switching to: " ++ (t ++ " and " ++ newWorkspace)) -- | Insert a mapping between t1 and t2 or remove it was already present toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X () toggleMatching message t1 t2 = do WorkspaceMap matchings <- XS.get :: X WorkspaceMap case (M.lookup t1 matchings) of Nothing -> setMatching message t1 t2 matchings Just t -> if t == t2 then removeMatching' message t1 t2 matchings else setMatching message t1 t2 matchings return () -- | Insert a mapping between t1 and t2 and display a message setMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X () setMatching message t1 t2 matchings = do ws <- gets windowset let now = W.screen (W.current ws) XS.put $ WorkspaceMap $ M.insert t1 t2 matchings messageFunction message now (foreground message) (background message) ("Linked: " ++ (t1 ++ " " ++ t2)) -- currently this function is called manually this means that if workspaces -- were deleted, some links stay in the RAM even though they are not used -- anymore... because of the small amount of memory used for those there is no -- special cleanup so far removeMatching' :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X () removeMatching' message t1 t2 matchings = do ws <- gets windowset let now = W.screen (W.current ws) XS.put $ WorkspaceMap $ M.delete t1 matchings messageFunction message now (alertedForeground message) (background message) ("Unlinked: " ++ t1 ++ " " ++ t2) -- | Remove all maps between workspaces removeAllMatchings :: MessageConfig -> X () removeAllMatchings message = do ws <- gets windowset let now = W.screen (W.current ws) XS.put $ WorkspaceMap $ M.empty messageFunction message now (alertedForeground message) (background message) "All links removed!" -- | remove all matching regarding a given workspace unMatch :: WorkspaceId -> X () unMatch workspace = do WorkspaceMap matchings <- XS.get :: X WorkspaceMap XS.put $ WorkspaceMap $ M.delete workspace (M.filter (/= workspace) matchings) -- | Toggle the currently displayed workspaces as matching. Starting from the one with focus -- | a linked list of workspaces is created that will later be iterated by switchToMatching. toggleLinkWorkspaces :: MessageConfig -> X () toggleLinkWorkspaces message = withWindowSet $ \ws -> toggleLinkWorkspaces' (W.screen (W.current ws)) message toggleLinkWorkspaces' :: ScreenId -> MessageConfig -> X () toggleLinkWorkspaces' first message = do ws <- gets windowset nScreens <- countScreens let now = W.screen (W.current ws) let next = (now + 1) `mod` nScreens if next == first then return () else do -- this is also the case if there is only one screen case (W.lookupWorkspace next ws) of Nothing -> return () Just name -> toggleMatching message (W.currentTag ws) (name) onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next xmonad-contrib-0.12/XMonad/Actions/Workscreen.hs0000644000000000000000000001054612636047674020037 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Workscreen -- Copyright : (c) 2012 kedals0 -- License : BSD3-style (see LICENSE) -- -- Maintainer : Dal -- Stability : unstable -- Portability: unportable -- -- A workscreen permits to display a set of workspaces on several -- screens. In xinerama mode, when a workscreen is viewed, workspaces -- associated to all screens are visible. -- -- The first workspace of a workscreen is displayed on first screen, -- second on second screen, etc. Workspace position can be easily -- changed. If the current workscreen is called again, workspaces are -- shifted. -- -- 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. ----------------------------------------------------------------------------- {-# LANGUAGE DeriveDataTypeable #-} module XMonad.Actions.Workscreen ( -- * Usage -- $usage configWorkscreen ,viewWorkscreen ,Workscreen(..) ,shiftToWorkscreen ,fromWorkspace ,expandWorkspace ) where import XMonad hiding (workspaces) import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Actions.OnScreen -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.Workscreen -- > myWorkspaces = let myOldWorkspaces = ["adm","work","mail"] -- > in Workscreen.expandWorkspace 2 myOldWorkspaces -- > myStartupHook = do Workscreen.configWorkscreen (Workscreen.fromWorkspace 2 myWorkspaces) -- > return () -- -- Then, replace normal workspace view and shift keybinding: -- -- > [((m .|. modm, k), f i) -- > | (i, k) <- zip [0..] [1..12] -- > , (f, m) <- [(Workscreen.viewWorkscreen, 0), (Workscreen.shiftToWorkscreen, shiftMask)]] -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". data Workscreen = Workscreen{workscreenId::Int,workspaces::[WorkspaceId]} deriving (Show,Typeable) type WorkscreenId=Int data WorkscreenStorage = WorkscreenStorage WorkscreenId [Workscreen] deriving (Show,Typeable) instance ExtensionClass WorkscreenStorage where initialValue = WorkscreenStorage 0 [] -- | Helper to group workspaces. Multiply workspace by screens number. expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId] expandWorkspace nscr ws = concat $ map expandId ws where expandId wsId = let t = wsId ++ "_" in map ((++) t . show ) [1..nscr] -- | Create workscreen list from workspace list. Group workspaces to -- packets of screens number size. fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen] fromWorkspace n ws = map (\(a,b) -> Workscreen a b) $ zip [0..] (fromWorkspace' n ws) fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]] fromWorkspace' _ [] = [] fromWorkspace' n ws = take n ws : fromWorkspace' n (drop n ws) -- | Initial configuration of workscreens configWorkscreen :: [Workscreen] -> X () configWorkscreen wscrn = XS.put (WorkscreenStorage 0 wscrn) -- | View workscreen of index @WorkscreenId@. If current workscreen is asked -- workscreen, workscreen's workspaces are shifted. viewWorkscreen :: WorkscreenId -> X () viewWorkscreen wscrId = do (WorkscreenStorage c a) <- XS.get let wscr = if wscrId == c then Workscreen wscrId $ shiftWs (workspaces $ a !! wscrId) else a !! wscrId (x,_:ys) = splitAt wscrId a newWorkscreenStorage = WorkscreenStorage wscrId (x ++ [wscr] ++ ys) windows (viewWorkscreen' wscr) XS.put newWorkscreenStorage viewWorkscreen' :: Workscreen -> WindowSet -> WindowSet viewWorkscreen' (Workscreen _ ws) = \s -> foldl wsToSc' s (zip [0..] ws) where wsToSc' s (scr,wsId) = greedyViewOnScreen scr wsId s shiftWs :: [WorkspaceId] -> [WorkspaceId] shiftWs a = drop 1 a ++ take 1 a -- | Shift a window on the first workspace of workscreen -- @WorkscreenId@. shiftToWorkscreen :: WorkscreenId -> X () shiftToWorkscreen wscrId = do (WorkscreenStorage _ a) <- XS.get let ws = head . workspaces $ a !! wscrId windows $ W.shift ws xmonad-contrib-0.12/XMonad/Actions/AfterDrag.hs0000644000000000000000000000526312636047674017554 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.AfterDrag -- Copyright : (c) 2014 Anders Engstrom -- License : BSD3-style (see LICENSE) -- -- Maintainer : Anders Engstrom -- Stability : unstable -- Portability : unportable -- -- Perform an action after the current mouse drag is completed. ----------------------------------------------------------------------------- module XMonad.Actions.AfterDrag ( -- * Usage -- $usage afterDrag, ifClick, ifClick') where import XMonad import System.Time -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.AfterDrag -- -- Then add appropriate mouse bindings, for example: -- -- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> ifClick (windows $ W.float w $ W.RationalRect 0 0 1 1))) -- -- This will allow you to resize windows as usual, but if you instead of -- draging click the mouse button the window will be automatically resized to -- fill the whole screen. -- -- For detailed instructions on editing your mouse bindings, see -- "XMonad.Doc.Extending#Editing_mouse_bindings". -- -- More practical examples are available in "XMonad.Actions.FloatSnap". -- | Schedule a task to take place after the current dragging is completed. afterDrag :: X () -- ^ The task to schedule. -> X () afterDrag task = do drag <- gets dragging case drag of Nothing -> return () -- Not dragging Just (motion, cleanup) -> modify $ \s -> s { dragging = Just(motion, cleanup >> task) } -- | Take an action if the current dragging can be considered a click, -- supposing the drag just started before this function is called. -- A drag is considered a click if it is completed within 300 ms. ifClick :: X () -- ^ The action to take if the dragging turned out to be a click. -> X () ifClick action = ifClick' 300 action (return ()) -- | Take an action if the current dragging is completed within a certain time (in milliseconds.) ifClick' :: Int -- ^ Maximum time of dragging for it to be considered a click (in milliseconds.) -> X () -- ^ The action to take if the dragging turned out to be a click. -> X () -- ^ The action to take if the dragging turned out to not be a click. -> X () ifClick' ms click drag = do start <- io $ getClockTime afterDrag $ do stop <- io $ getClockTime if diffClockTimes stop start <= noTimeDiff { tdPicosec = fromIntegral ms * 10^(9 :: Integer) } then click else drag xmonad-contrib-0.12/XMonad/Actions/Submap.hs0000644000000000000000000000535512636047674017146 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Submap -- Copyright : (c) Jason Creighton -- License : BSD3-style (see LICENSE) -- -- Maintainer : Jason Creighton -- Stability : unstable -- Portability : unportable -- -- A module that allows the user to create a sub-mapping of key bindings. -- ----------------------------------------------------------------------------- module XMonad.Actions.Submap ( -- * Usage -- $usage submap, submapDefault ) where import Data.Bits import XMonad hiding (keys) import qualified Data.Map as M import Control.Monad.Fix (fix) {- $usage First, import this module into your @~\/.xmonad\/xmonad.hs@: > import XMonad.Actions.Submap Allows you to create a sub-mapping of keys. Example: > , ((modm, xK_a), submap . M.fromList $ > [ ((0, xK_n), spawn "mpc next") > , ((0, xK_p), spawn "mpc prev") > , ((0, xK_z), spawn "mpc random") > , ((0, xK_space), spawn "mpc toggle") > ]) So, for example, to run 'spawn \"mpc next\"', you would hit mod-a (to trigger the submapping) and then 'n' to run that action. (0 means \"no modifier\"). You are, of course, free to use any combination of modifiers in the submapping. However, anyModifier will not work, because that is a special value passed to XGrabKey() and not an actual modifier. For detailed instructions on editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". -} -- | Given a 'Data.Map.Map' from key bindings to X () actions, return -- an action which waits for a user keypress and executes the -- corresponding action, or does nothing if the key is not found in -- the map. submap :: M.Map (KeyMask, KeySym) (X ()) -> X () submap keys = submapDefault (return ()) keys -- | Like 'submap', but executes a default action if the key did not match. submapDefault :: X () -> M.Map (KeyMask, KeySym) (X ()) -> X () submapDefault defAction keys = do XConf { theRoot = root, display = d } <- ask io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime (m, s) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do maskEvent d keyPressMask p KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p keysym <- keycodeToKeysym d code 0 if isModifierKey keysym then nextkey else return (m, keysym) -- Remove num lock mask and Xkb group state bits m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1) io $ ungrabKeyboard d currentTime maybe defAction id (M.lookup (m', s) keys) xmonad-contrib-0.12/XMonad/Actions/FocusNth.hs0000644000000000000000000000266012636047674017444 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.FocusNth -- Copyright : (c) Karsten Schoelzel -- License : BSD -- -- Maintainer : Karsten Schoelzel -- Stability : stable -- Portability : unportable -- -- Focus the nth window of the current workspace. ----------------------------------------------------------------------------- module XMonad.Actions.FocusNth ( -- * Usage -- $usage focusNth,focusNth') where import XMonad.StackSet import XMonad -- $usage -- Add the import to your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.FocusNth -- -- Then add appropriate keybindings, for example: -- -- > -- mod4-[1..9] @@ Switch to window N -- > ++ [((modm, k), focusNth i) -- > | (i, k) <- zip [0 .. 8] [xK_1 ..]] -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Give focus to the nth window of the current workspace. focusNth :: Int -> X () focusNth = windows . modify' . focusNth' focusNth' :: Int -> Stack a -> Stack a focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s | otherwise = listToStack n (integrate s) listToStack :: Int -> [a] -> Stack a listToStack n l = Stack t ls rs where (t:rs) = drop n l ls = reverse (take n l) xmonad-contrib-0.12/XMonad/Actions/WithAll.hs0000644000000000000000000000313212636047674017252 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.WithAll -- License : BSD3-style (see LICENSE) -- Stability : unstable -- Portability : unportable -- -- Provides functions for performing a given action on all windows of -- the current workspace. ----------------------------------------------------------------------------- module XMonad.Actions.WithAll ( -- * Usage -- $usage sinkAll, withAll, withAll', killAll) where import Data.Foldable hiding (foldr) import XMonad import XMonad.StackSet -- $usage -- -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.WithAll -- -- then add a keybinding; for example: -- -- , ((modm .|. shiftMask, xK_t), sinkAll) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Un-float all floating windows on the current workspace. sinkAll :: X () sinkAll = withAll' sink -- | Apply a function to all windows on the current workspace. withAll' :: (Window -> WindowSet -> WindowSet) -> X () withAll' f = windows $ \ws -> let all' = integrate' . stack . workspace . current $ ws in foldr f ws all' -- | Execute an 'X' action for each window on the current workspace. withAll :: (Window -> X ()) -> X() withAll f = withWindowSet $ \ws -> let all' = integrate' . stack . workspace . current $ ws in forM_ all' f -- | Kill all the windows on the current workspace. killAll :: X() killAll = withAll killWindowxmonad-contrib-0.12/XMonad/Actions/UpdatePointer.hs0000644000000000000000000001012212636047674020466 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonadContrib.UpdatePointer -- Copyright : (c) Robert Marlow -- License : BSD3-style (see LICENSE) -- -- Maintainer : Robert Marlow -- Stability : stable -- Portability : portable -- -- Causes the pointer to follow whichever window focus changes to. Compliments -- the idea of switching focus as the mouse crosses window boundaries to -- keep the mouse near the currently focused window -- ----------------------------------------------------------------------------- module XMonad.Actions.UpdatePointer ( -- * Usage -- $usage updatePointer ) where import XMonad import XMonad.Util.XUtils (fi) import Control.Arrow import Control.Monad import XMonad.StackSet (member, peek, screenDetail, current) import Data.Maybe -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad -- > import XMonad.Actions.UpdatePointer -- -- Enable it by including it in your logHook definition, e.g.: -- -- > logHook = updatePointer (0.5, 0.5) (1, 1) -- -- which will move the pointer to the nearest point of a newly focused -- window. The first argument establishes a reference point within the -- newly-focused window, while the second argument linearly interpolates -- between said reference point and the edges of the newly-focused window to -- obtain a bounding box for the pointer. -- -- > logHook = updatePointer (0.5, 0.5) (0, 0) -- exact centre of window -- > logHook = updatePointer (0.25, 0.25) (0.25, 0.25) -- near the top-left -- > logHook = updatePointer (0.5, 0.5) (1.1, 1.1) -- within 110% of the edge -- -- To use this with an existing logHook, use >> : -- -- > logHook = dynamicLog -- > >> updatePointer (1, 1) (0, 0) -- -- which moves the pointer to the bottom-right corner of the focused window. -- | Update the pointer's location to the currently focused -- window or empty screen unless it's already there, or unless the user was changing -- focus with the mouse updatePointer :: (Rational, Rational) -> (Rational, Rational) -> X () updatePointer refPos ratio = do ws <- gets windowset dpy <- asks display rect <- case peek ws of Nothing -> return $ (screenRect . screenDetail .current) ws Just w -> windowAttributesToRectangle `fmap` io (getWindowAttributes dpy w) root <- asks theRoot mouseIsMoving <- asks mouseFocused (_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root drag <- gets dragging unless (pointWithin (fi rootX) (fi rootY) rect || mouseIsMoving || isJust drag || not (currentWindow `member` ws || currentWindow == none)) $ let -- focused rectangle (rectX, rectY) = (rect_x &&& rect_y) rect (rectW, rectH) = (fi . rect_width &&& fi . rect_height) rect -- reference position, with (0,0) and (1,1) being top-left and bottom-right refX = lerp (fst refPos) rectX (rectX + rectW) refY = lerp (snd refPos) rectY (rectY + rectH) -- final pointer bounds, lerped *outwards* from reference position boundsX = join (***) (lerp (fst ratio) refX) (rectX, rectX + rectW) boundsY = join (***) (lerp (snd ratio) refY) (rectY, rectY + rectH) -- ideally we ought to move the pointer in a straight line towards the -- reference point until it is within the above bounds, but… in io $ warpPointer dpy none root 0 0 0 0 (round . clip boundsX $ fi rootX) (round . clip boundsY $ fi rootY) windowAttributesToRectangle :: WindowAttributes -> Rectangle windowAttributesToRectangle wa = Rectangle (fi (wa_x wa)) (fi (wa_y wa)) (fi (wa_width wa + 2 * wa_border_width wa)) (fi (wa_height wa + 2 * wa_border_width wa)) lerp :: (RealFrac r, Real a, Real b) => r -> a -> b -> r lerp r a b = (1 - r) * realToFrac a + r * realToFrac b clip :: Ord a => (a, a) -> a -> a clip (lower, upper) x = if x < lower then lower else if x > upper then upper else x xmonad-contrib-0.12/XMonad/Actions/MouseGestures.hs0000644000000000000000000001060512636047674020523 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.MouseGestures -- Copyright : (c) Lukas Mai -- License : BSD3-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Support for simple mouse gestures. -- ----------------------------------------------------------------------------- module XMonad.Actions.MouseGestures ( -- * Usage -- $usage Direction2D(..), mouseGestureH, mouseGesture, mkCollect ) where import XMonad import XMonad.Util.Types (Direction2D(..)) import Data.IORef import qualified Data.Map as M import Data.Map (Map) import Data.Maybe import Control.Monad -- $usage -- -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.MouseGestures -- > import qualified XMonad.StackSet as W -- -- then add an appropriate mouse binding: -- -- > , ((modm .|. shiftMask, button3), mouseGesture gestures) -- -- where @gestures@ is a 'Data.Map.Map' from gestures to actions on -- windows, for example: -- -- > gestures = M.fromList -- > [ ([], focus) -- > , ([U], \w -> focus w >> windows W.swapUp) -- > , ([D], \w -> focus w >> windows W.swapDown) -- > , ([R, D], \_ -> sendMessage NextLayout) -- > ] -- -- This is just an example, of course; you can use any mouse button and -- gesture definitions you want. -- -- For detailed instructions on editing your mouse bindings, see -- "XMonad.Doc.Extending#Editing_mouse_bindings". type Pos = (Position, Position) delta :: Pos -> Pos -> Position delta (ax, ay) (bx, by) = max (d ax bx) (d ay by) where d a b = abs (a - b) dir :: Pos -> Pos -> Direction2D dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax) where trans :: Double -> Direction2D trans x | rg (-3/4) (-1/4) x = D | rg (-1/4) (1/4) x = R | rg (1/4) (3/4) x = U | otherwise = L rg a z x = a <= x && x < z gauge :: (Direction2D -> X ()) -> Pos -> IORef (Maybe (Direction2D, Pos)) -> Position -> Position -> X () gauge hook op st nx ny = do let np = (nx, ny) stx <- io $ readIORef st let (~(Just od), pivot) = case stx of Nothing -> (Nothing, op) Just (d, zp) -> (Just d, zp) cont = do guard $ significant np pivot return $ do let d' = dir pivot np when (isNothing stx || od /= d') $ hook d' io $ writeIORef st (Just (d', np)) fromMaybe (return ()) cont where significant a b = delta a b >= 10 -- | @'mouseGestureH' moveHook endHook@ is a mouse button -- event handler. It collects mouse movements, calling @moveHook@ for each -- update; when the button is released, it calls @endHook@. mouseGestureH :: (Direction2D -> X ()) -> X () -> X () mouseGestureH moveHook endHook = do dpy <- asks display root <- asks theRoot (pos, acc) <- io $ do (_, _, _, ix, iy, _, _, _) <- queryPointer dpy root r <- newIORef Nothing return ((fromIntegral ix, fromIntegral iy), r) mouseDrag (gauge moveHook pos acc) endHook -- | A utility function on top of 'mouseGestureH'. It uses a 'Data.Map.Map' to -- look up the mouse gesture, then executes the corresponding action (if any). mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X () mouseGesture tbl win = do (mov, end) <- mkCollect mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest -> case M.lookup gest tbl of Nothing -> return () Just f -> f win -- | A callback generator for 'mouseGestureH'. 'mkCollect' returns two -- callback functions for passing to 'mouseGestureH'. The move hook will -- collect mouse movements (and return the current gesture as a list); the end -- hook will return a list of the completed gesture, which you can access with -- 'Control.Monad.>>='. mkCollect :: (MonadIO m, MonadIO m') => m (Direction2D -> m' [Direction2D], m' [Direction2D]) mkCollect = liftIO $ do acc <- newIORef [] let mov d = liftIO $ do ds <- readIORef acc let ds' = d : ds writeIORef acc ds' return $ reverse ds' end = liftIO $ do ds <- readIORef acc writeIORef acc [] return $ reverse ds return (mov, end) xmonad-contrib-0.12/XMonad/Actions/DeManage.hs0000644000000000000000000000361412636047674017354 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.DeManage -- Copyright : (c) Spencer Janssen -- License : BSD3-style (see LICENSE) -- -- Maintainer : Spencer Janssen -- Stability : stable -- Portability : unportable -- -- This module provides a method to cease management of a window -- without unmapping it. This is especially useful for applications -- like kicker and gnome-panel. See also "XMonad.Hooks.ManageDocks" for -- more a more automated solution. -- -- To make a panel display correctly with xmonad: -- -- * Determine the pixel size of the panel, add that value to -- 'XMonad.Core.XConfig.defaultGaps' -- -- * Launch the panel -- -- * Give the panel window focus, then press @mod-d@ (or whatever key -- you have bound 'demanage' to) -- -- * Convince the panel to move\/resize to the correct location. Changing the -- panel's position setting several times seems to work. -- ----------------------------------------------------------------------------- module XMonad.Actions.DeManage ( -- * Usage -- $usage demanage ) where import qualified XMonad.StackSet as W import XMonad -- $usage -- To use demanage, add this import to your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.DeManage -- -- And add a keybinding, such as: -- -- > , ((modm, xK_d ), withFocused demanage) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Stop managing the currently focused window. demanage :: Window -> X () demanage w = do -- use modify to defeat automatic 'unmanage' calls. modify (\s -> s { windowset = W.delete w (windowset s) }) refresh xmonad-contrib-0.12/XMonad/Actions/FlexibleResize.hs0000644000000000000000000000550312636047674020626 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.FlexibleResize -- Copyright : (c) Lukas Mai -- License : BSD3-style (see LICENSE) -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- Resize floating windows from any corner. -- ----------------------------------------------------------------------------- module XMonad.Actions.FlexibleResize ( -- * Usage -- $usage XMonad.Actions.FlexibleResize.mouseResizeWindow, XMonad.Actions.FlexibleResize.mouseResizeEdgeWindow ) where import XMonad import XMonad.Util.XUtils (fi) import Foreign.C.Types -- $usage -- To use, first import this module into your @~\/.xmonad\/xmonad.hs@ file: -- -- > import qualified XMonad.Actions.FlexibleResize as Flex -- -- Then add an appropriate mouse binding: -- -- > , ((modm, button3), (\w -> focus w >> Flex.mouseResizeWindow w)) -- -- For detailed instructions on editing your mouse bindings, see -- "XMonad.Doc.Extending#Editing_mouse_bindings". -- | Resize a floating window from whichever corner the mouse is -- closest to. mouseResizeWindow :: Window -- ^ The window to resize. -> X () mouseResizeWindow = mouseResizeEdgeWindow 0 -- | Resize a floating window from whichever corner or edge the mouse is -- closest to. mouseResizeEdgeWindow :: Rational -- ^ The size of the area where only one edge is resized. -> Window -- ^ The window to resize. -> X () mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do io $ raiseWindow d w wa <- io $ getWindowAttributes d w sh <- io $ getWMNormalHints d w (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w let [pos_x, pos_y, width, height] = map (fi . ($ wa)) [wa_x, wa_y, wa_width, wa_height] west = findPos ix width north = findPos iy height (cx, fx, gx) = mkSel west width pos_x (cy, fy, gy) = mkSel north height pos_y io $ warpPointer d none w 0 0 0 0 cx cy mouseDrag (\ex ey -> do let (nw,nh) = applySizeHintsContents sh (gx ex, gy ey) io $ moveResizeWindow d w (fx nw) (fy nh) nw nh) (float w) where findPos :: CInt -> Position -> Maybe Bool findPos m s = if p < 0.5 - edge/2 then Just True else if p < 0.5 + edge/2 then Nothing else Just False where p = fi m / fi s mkSel :: Maybe Bool -> Position -> Position -> (Position, Dimension -> Position, Position -> Dimension) mkSel b k p = case b of Just True -> (0, (fi k + fi p -).fi, (fi k + fi p -).fi) Nothing -> (k `div` 2, const p, const $ fi k) Just False -> (k, const p, subtract (fi p) . fi) xmonad-contrib-0.12/XMonad/Actions/MessageFeedback.hs0000644000000000000000000000712112636047674020701 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.MessageFeedback -- Copyright : (c) Quentin Moser -- License : BSD3 -- -- Maintainer : orphaned -- Stability : unstable -- Portability : unportable -- -- Alternative to 'XMonad.Operations.sendMessage' that provides knowledge -- of whether the message was handled, and utility functions based on -- this facility. ----------------------------------------------------------------------------- module XMonad.Actions.MessageFeedback ( -- * Usage -- $usage send , tryMessage , tryMessage_ , tryInOrder , tryInOrder_ , sm , sendSM , sendSM_ ) where import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX ) import XMonad.StackSet ( current, workspace, layout, tag ) import XMonad.Operations ( updateLayout ) import Control.Monad.State ( gets ) import Data.Maybe ( isJust ) import Control.Applicative ((<$>)) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.MessageFeedback -- -- You can then use this module's functions wherever an action is expected. -- -- Note that most functions in this module have a return type of @X Bool@ -- whereas configuration options will expect a @X ()@ action. -- For example, the key binding -- -- > -- Shrink the master area of a tiled layout, or move the focused window -- > -- to the left in a WindowArranger-based layout -- > ((modKey, xK_Left), tryMessage Shrink (MoveLeft 50)) -- -- is mis-typed. For this reason, this module provides alternatives (ending with -- an underscore, e.g. tryMessage_) that discard their result and return an @X ()@. -- For example, to correct the previous example: -- -- > ((modKey, xK_Left), tryMessage_ Shrink (MoveLeft 50)) -- -- | Behaves like 'XMonad.Operations.sendMessage', but returns True of the -- message was handled by the layout, False otherwise. send :: Message a => a -> X Bool send = sendSM . sm -- | Sends the first message, and if it was not handled, sends the second. -- Returns True if either message was handled, False otherwise. tryMessage :: (Message a, Message b) => a -> b -> X Bool tryMessage m1 m2 = do b <- send m1 if b then return True else send m2 tryMessage_ :: (Message a, Message b) => a -> b -> X () tryMessage_ m1 m2 = tryMessage m1 m2 >> return () -- | Tries sending every message of the list in order until one of them -- is handled. Returns True if one of the messages was handled, False otherwise. tryInOrder :: [SomeMessage] -> X Bool tryInOrder [] = return False tryInOrder (m:ms) = do b <- sendSM m if b then return True else tryInOrder ms tryInOrder_ :: [SomeMessage] -> X () tryInOrder_ ms = tryInOrder ms >> return () -- | Convenience shorthand for 'XMonad.Core.SomeMessage'. sm :: Message a => a -> SomeMessage sm = SomeMessage sendSM :: SomeMessage -> X Bool sendSM m = do w <- workspace . current <$> gets windowset ml' <- handleMessage (layout w) m `catchX` return Nothing updateLayout (tag w) ml' return $ isJust ml' sendSM_ :: SomeMessage -> X () sendSM_ m = sendSM m >> return ()xmonad-contrib-0.12/XMonad/Actions/WindowBringer.hs0000644000000000000000000001151712636047674020474 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.WindowBringer -- Copyright : Devin Mullins -- License : BSD-style (see LICENSE) -- -- Maintainer : Devin Mullins -- Stability : stable -- Portability : unportable -- -- dmenu operations to bring windows to you, and bring you to windows. -- That is to say, it pops up a dmenu with window names, in case you forgot -- where you left your XChat. -- ----------------------------------------------------------------------------- module XMonad.Actions.WindowBringer ( -- * Usage -- $usage gotoMenu, gotoMenu', gotoMenuArgs, gotoMenuArgs', bringMenu, bringMenu', bringMenuArgs, bringMenuArgs', windowMap, bringWindow ) where import Data.Char (toLower) import qualified Data.Map as M import qualified XMonad.StackSet as W import XMonad import qualified XMonad as X import XMonad.Util.Dmenu (menuMapArgs) import XMonad.Util.NamedWindows (getName) -- $usage -- -- Import the module into your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.WindowBringer -- -- and define appropriate key bindings: -- -- > , ((modm .|. shiftMask, xK_g ), gotoMenu) -- > , ((modm .|. shiftMask, xK_b ), bringMenu) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Default menu command defaultCmd :: String defaultCmd = "dmenu" -- | Pops open a dmenu with window titles. Choose one, and you will be -- taken to the corresponding workspace. gotoMenu :: X () gotoMenu = gotoMenuArgs [] -- | Pops open a dmenu with window titles. Choose one, and you will be -- taken to the corresponding workspace. This version takes a list of -- arguments to pass to dmenu. gotoMenuArgs :: [String] -> X () gotoMenuArgs menuArgs = gotoMenuArgs' defaultCmd menuArgs -- | Pops open an application with window titles given over stdin. Choose one, -- and you will be taken to the corresponding workspace. gotoMenu' :: String -> X () gotoMenu' menuCmd = gotoMenuArgs' menuCmd [] -- | Pops open an application with window titles given over stdin. Choose one, -- and you will be taken to the corresponding workspace. This version takes a -- list of arguments to pass to dmenu. gotoMenuArgs' :: String -> [String] -> X () gotoMenuArgs' menuCmd menuArgs = actionMenu menuCmd menuArgs W.focusWindow -- | Pops open a dmenu with window titles. Choose one, and it will be -- dragged, kicking and screaming, into your current workspace. bringMenu :: X () bringMenu = bringMenuArgs [] -- | Pops open a dmenu with window titles. Choose one, and it will be -- dragged, kicking and screaming, into your current workspace. This version -- takes a list of arguments to pass to dmenu. bringMenuArgs :: [String] -> X () bringMenuArgs menuArgs = bringMenuArgs' defaultCmd menuArgs -- | Pops open an application with window titles given over stdin. Choose one, -- and it will be dragged, kicking and screaming, into your current -- workspace. bringMenu' :: String -> X () bringMenu' menuCmd = bringMenuArgs' menuCmd [] -- | Pops open an application with window titles given over stdin. Choose one, -- and it will be dragged, kicking and screaming, into your current -- workspace. This version allows arguments to the chooser to be specified. bringMenuArgs' :: String -> [String] -> X () bringMenuArgs' menuCmd menuArgs = actionMenu menuCmd menuArgs bringWindow -- | Brings the specified window into the current workspace. bringWindow :: Window -> X.WindowSet -> X.WindowSet bringWindow w ws = W.shiftWin (W.currentTag ws) w ws -- | Calls dmenuMap to grab the appropriate Window, and hands it off to action -- if found. actionMenu :: String -> [String] -> (Window -> X.WindowSet -> X.WindowSet) -> X () actionMenu menuCmd menuArgs action = windowMap >>= menuMapFunction >>= flip X.whenJust (windows . action) where menuMapFunction :: M.Map String a -> X (Maybe a) menuMapFunction selectionMap = menuMapArgs menuCmd menuArgs selectionMap -- | A map from window names to Windows. windowMap :: X (M.Map String Window) windowMap = do ws <- gets X.windowset M.fromList `fmap` concat `fmap` mapM keyValuePairs (W.workspaces ws) where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws) keyValuePair ws w = flip (,) w `fmap` decorateName ws w -- | Returns the window name as will be listed in dmenu. -- Lowercased, for your convenience (since dmenu is case-sensitive). -- Tagged with the workspace ID, to guarantee uniqueness, and to let the user -- know where he's going. decorateName :: X.WindowSpace -> Window -> X String decorateName ws w = do name <- fmap (map toLower . show) $ getName w return $ name ++ " [" ++ W.tag ws ++ "]" xmonad-contrib-0.12/XMonad/Actions/BluetileCommands.hs0000644000000000000000000000664712636047674021153 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.BluetileCommands -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- This is a list of selected commands that can be made available using -- "XMonad.Hooks.ServerMode" to allow external programs to control -- the window manager. Bluetile () -- uses this to enable its dock application to do things like changing -- workspaces and layouts. -- ----------------------------------------------------------------------------- module XMonad.Actions.BluetileCommands ( -- * Usage -- $usage bluetileCommands ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Layout.LayoutCombinators import System.Exit -- $usage -- -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.ServerMode -- > import XMonad.Actions.BluetileCommands -- -- Then edit your @handleEventHook@: -- -- > main = xmonad def { handleEventHook = serverModeEventHook' bluetileCommands } -- -- See the documentation of "XMonad.Hooks.ServerMode" for details on -- how to actually invoke the commands from external programs. workspaceCommands :: Int -> X [(String, X ())] workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return [(("greedyView" ++ show i), activateScreen sid >> windows (W.greedyView i)) | i <- spaces ] layoutCommands :: Int -> [(String, X ())] layoutCommands sid = [ ("layout floating" , activateScreen sid >> sendMessage (JumpToLayout "Floating")) , ("layout tiled1" , activateScreen sid >> sendMessage (JumpToLayout "Tiled1")) , ("layout tiled2" , activateScreen sid >> sendMessage (JumpToLayout "Tiled2")) , ("layout fullscreen" , activateScreen sid >> sendMessage (JumpToLayout "Fullscreen")) ] masterAreaCommands :: Int -> [(String, X ())] masterAreaCommands sid = [ ("increase master n", activateScreen sid >> sendMessage (IncMasterN 1)) , ("decrease master n", activateScreen sid >> sendMessage (IncMasterN (-1))) ] quitCommands :: [(String, X ())] quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess)) , ("quit bluetile and start metacity", restart "metacity" False) ] bluetileCommands :: X [(String, X ())] bluetileCommands = do let restartCommand = [ ("restart bluetile", restart "bluetile" True) ] wscmds0 <- workspaceCommands 0 wscmds1 <- workspaceCommands 1 return $ restartCommand ++ wscmds0 ++ layoutCommands 0 ++ masterAreaCommands 0 ++ quitCommands ++ wscmds1 ++ layoutCommands 1 ++ masterAreaCommands 1 ++ quitCommands activateScreen :: Int -> X () activateScreen sid = screenWorkspace (S sid) >>= flip whenJust (windows . W.view) xmonad-contrib-0.12/XMonad/Actions/WindowMenu.hs0000644000000000000000000000542112636047674020005 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.WindowMenu -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- Uses "XMonad.Actions.GridSelect" to display a number of actions related to -- window management in the center of the focused window. Actions include: Closing, -- maximizing, minimizing and shifting the window to another workspace. -- -- Note: For maximizing and minimizing to actually work, you will need -- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your -- setup. See the documentation of those modules for more information. -- ----------------------------------------------------------------------------- module XMonad.Actions.WindowMenu ( -- * Usage -- $usage windowMenu ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Actions.GridSelect import XMonad.Layout.Maximize import XMonad.Layout.Minimize import XMonad.Util.XUtils (fi) -- $usage -- -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.WindowMenu -- -- Then add a keybinding, e.g. -- -- > , ((modm, xK_o ), windowMenu) colorizer :: a -> Bool -> X (String, String) colorizer _ isFg = do fBC <- asks (focusedBorderColor . config) nBC <- asks (normalBorderColor . config) return $ if isFg then (fBC, nBC) else (nBC, fBC) windowMenu :: X () windowMenu = withFocused $ \w -> do tags <- asks (workspaces . config) Rectangle x y wh ht <- getSize w Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset let originFractX = (fi x - fi sx + fi wh / 2) / fi swh originFractY = (fi y - fi sy + fi ht / 2) / fi sht gsConfig = (buildDefaultGSConfig colorizer) { gs_originFractX = originFractX , gs_originFractY = originFractY } actions = [ ("Cancel menu", return ()) , ("Close" , kill) , ("Maximize" , sendMessage $ maximizeRestore w) , ("Minimize" , minimizeWindow w) ] ++ [ ("Move to " ++ tag, windows $ W.shift tag) | tag <- tags ] runSelectedAction gsConfig actions getSize :: Window -> X (Rectangle) getSize w = do d <- asks display wa <- io $ getWindowAttributes d w let x = fi $ wa_x wa y = fi $ wa_y wa wh = fi $ wa_width wa ht = fi $ wa_height wa return (Rectangle x y wh ht) xmonad-contrib-0.12/XMonad/Actions/MouseResize.hs0000644000000000000000000001214312636047674020162 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.MouseResize -- Copyright : (c) 2007 Andrea Rossato -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A layout modifier to resize windows with the mouse by grabbing the -- window's lower right corner. -- -- This module must be used together with "XMonad.Layout.WindowArranger". ----------------------------------------------------------------------------- module XMonad.Actions.MouseResize ( -- * Usage: -- $usage mouseResize , MouseResize (..) ) where import XMonad import XMonad.Layout.Decoration import XMonad.Layout.WindowArranger import XMonad.Util.XUtils -- $usage -- Usually this module is used to create layouts, but you can also use -- it to resize windows in any layout, together with the -- "XMonad.Layout.WindowArranger". For usage example see -- "XMonad.Layout.SimpleFloat" or "XMonad.Layout.DecorationMadness". -- -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.MouseResize -- > import XMonad.Layout.WindowArranger -- -- Then edit your @layoutHook@ by modifying a given layout: -- -- > myLayout = mouseResize $ windowArrange $ layoutHook def -- -- and then: -- -- > main = xmonad def { layoutHook = myLayout } -- -- For more detailed instructions on editing the layoutHook see: -- -- "XMonad.Doc.Extending#Editing_the_layout_hook" mouseResize :: l a -> ModifiedLayout MouseResize l a mouseResize = ModifiedLayout (MR []) data MouseResize a = MR [((a,Rectangle),Maybe a)] instance Show (MouseResize a) where show _ = "" instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)] instance LayoutModifier MouseResize Window where redoLayout _ _ Nothing wrs = return (wrs, Nothing) redoLayout (MR st) _ (Just s) wrs | [] <- st = initState >>= \nst -> return (wrs, Just $ MR nst) | otherwise = processState >>= \nst -> return (wrs, Just $ MR nst) where wrs' = wrs_to_state [] . filter (isInStack s . fst) $ wrs initState = 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 wrs_to_state rs ((w,r):xs) | ir `isVisible` rs = ((w,r),Just ir) : wrs_to_state (r:ir:rs) xs | otherwise = ((w,r),Nothing) : wrs_to_state (r: rs) xs where ir = inputRectangle r wrs_to_state _ [] = [] handleMess (MR s) m | Just e <- fromMessage m :: Maybe Event = handleResize s e >> return Nothing | Just Hide <- fromMessage m = releaseResources >> return (Just $ MR []) | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ MR []) where releaseResources = mapM_ (deleteInputWin . snd) s handleMess _ _ = return Nothing handleResize :: [((Window,Rectangle),Maybe Window)] -> Event -> X () handleResize st ButtonEvent { ev_window = ew, ev_event_type = et } | et == buttonPress , Just (w,Rectangle wx wy _ _) <- getWin ew st = do focus w mouseDrag (\x y -> do let rect = Rectangle wx wy (max 1 . fi $ x - wx) (max 1 . fi $ y - wy) sendMessage (SetGeometry rect)) (return ()) where getWin w (((win,r),tw):xs) | Just w' <- tw , w == w' = Just (win,r) | otherwise = getWin w xs getWin _ [] = Nothing handleResize _ _ = return () createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window) createInputWindow ((w,r),mr) = do case mr of Just tr -> withDisplay $ \d -> do tw <- mkInputWindow d tr io $ selectInput d tw (exposureMask .|. buttonPressMask) cursor <- io $ createFontCursor d xC_bottom_right_corner io $ defineCursor d tw cursor io $ freeCursor d cursor showWindow tw return ((w,r), Just tw) Nothing -> return ((w,r), Nothing) deleteInputWin :: Maybe Window -> X () deleteInputWin = maybe (return ()) deleteWindow mkInputWindow :: Display -> Rectangle -> X Window mkInputWindow d (Rectangle x y w h) = do rw <- asks theRoot let screen = defaultScreenOfDisplay d visual = defaultVisualOfScreen screen attrmask = cWOverrideRedirect io $ allocaSetWindowAttributes $ \attributes -> do set_override_redirect attributes True createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes xmonad-contrib-0.12/XMonad/Actions/WindowNavigation.hs0000644000000000000000000002254312636047674021204 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.WindowNavigation -- Copyright : (c) 2007 David Roundy , -- Devin Mullins -- Maintainer : Devin Mullins -- License : BSD3-style (see LICENSE) -- Stability : unstable -- Portability : unportable -- -- This is a rewrite of "XMonad.Layout.WindowNavigation". WindowNavigation -- lets you assign keys to move up\/down\/left\/right, based on actual cartesian -- window coordinates, rather than just going j\/k on the stack. -- -- This module is experimental. You'll have better luck with the original. -- -- This module differs from the other in a few ways: -- -- (1) You can go up\/down\/left\/right across multiple screens. -- -- (2) It doesn't provide little border colors for your neighboring windows. -- -- (3) It doesn't provide the \'Move\' action, which seems to be related to -- the XMonad.Layout.Combo extension. -- -- (4) It tries to be slightly smarter about tracking your current position. -- -- (5) Configuration is different. -- ----------------------------------------------------------------------------- module XMonad.Actions.WindowNavigation ( -- * Usage -- $usage withWindowNavigation, withWindowNavigationKeys, WNAction(..), go, swap, Direction2D(..), WNState, ) where import XMonad import XMonad.Util.Types (Direction2D(..)) import qualified XMonad.StackSet as W import Control.Applicative ((<$>)) import Control.Arrow (second) import Data.IORef import Data.List (sortBy) import Data.Map (Map()) import qualified Data.Map as M import Data.Maybe (catMaybes, fromMaybe, listToMaybe) import Data.Ord (comparing) import qualified Data.Set as S -- $usage -- -- To use it, you're going to apply the 'withWindowNavigation' function. -- 'withWindowNavigation' performs some IO operations, so the syntax you'll use -- is the same as the spawnPipe example in "XMonad.Hooks.DynamicLog". -- In particular: -- -- > main = do -- > config <- withWindowNavigation (xK_w, xK_a, xK_s, xK_d) -- > $ def { ... } -- > xmonad config -- -- 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@ -- to swap windows. -- -- If you want more flexibility over your keybindings, you can use -- 'withWindowNavigationKeys', which takes a list of @keys@-esque entries rather -- than a tuple of the four directional keys. See the source code of -- 'withWindowNavigation' for an example. -- TODO: -- - monad for WNState? -- - cleanup (including inr) -- - more documentation -- - tests? (esp. for edge cases in currentPosition) -- - screen 1, 1+2/w 3, M-d, M-w, M-2 (1+2/w 2), M-e, M-a - goes to w 3, should be w 2 -- - solve the 2+3, middle right to bottom left problem -- - command to iteratively swapUp/swapDown instead of directly swapping with target -- - manageHook to draw window decos? withWindowNavigation :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l) withWindowNavigation (u,l,d,r) conf@XConfig{modMask=modm} = withWindowNavigationKeys [ ((modm , u), WNGo U), ((modm , l), WNGo L), ((modm , d), WNGo D), ((modm , r), WNGo R), ((modm .|. shiftMask, u), WNSwap U), ((modm .|. shiftMask, l), WNSwap L), ((modm .|. shiftMask, d), WNSwap D), ((modm .|. shiftMask, r), WNSwap R) ] conf withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l) withWindowNavigationKeys wnKeys conf = do posRef <- newIORef M.empty return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys) `M.union` keys conf cnf, logHook = logHook conf >> trackMovement posRef } where fromWNAction posRef (WNGo dir) = go posRef dir fromWNAction posRef (WNSwap dir) = swap posRef dir data WNAction = WNGo Direction2D | WNSwap Direction2D type WNState = Map WorkspaceId Point -- go: -- 1. get current position, verifying it matches the current window -- 2. get target windowrect -- 3. focus window -- 4. set new position go :: IORef WNState -> Direction2D -> X () go = withTargetWindow W.focusWindow swap :: IORef WNState -> Direction2D -> X () swap = withTargetWindow swapWithFocused where swapWithFocused targetWin winSet = case W.peek winSet of Just currentWin -> W.focusWindow currentWin $ mapWindows (swapWin currentWin targetWin) winSet Nothing -> winSet mapWindows f ss = W.mapWorkspace (mapWindows' f) ss 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) swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X () withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do targets <- filter ((/= win) . fst) <$> navigableTargets pos dir whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do windows (adj targetWin) setPosition posRef pos targetRect trackMovement :: IORef WNState -> X () trackMovement posRef = fromCurrentPoint posRef $ \win pos -> do windowRect win >>= flip whenJust (setPosition posRef pos . snd) fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X () fromCurrentPoint posRef f = withFocused $ \win -> do currentPosition posRef >>= f win -- Gets the current position from the IORef passed in, or if nothing (say, from -- a restart), derives the current position from the current window. Also, -- verifies that the position is congruent with the current window (say, if you -- used mod-j/k or mouse or something). currentPosition :: IORef WNState -> X Point currentPosition posRef = do root <- asks theRoot currentWindow <- gets (W.peek . windowset) currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow) wsid <- gets (W.currentTag . windowset) mp <- M.lookup wsid <$> io (readIORef posRef) return $ maybe (middleOf currentRect) (`inside` currentRect) mp where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h) setPosition :: IORef WNState -> Point -> Rectangle -> X () setPosition posRef oldPos newRect = do wsid <- gets (W.currentTag . windowset) io $ modifyIORef posRef $ M.insert wsid (oldPos `inside` newRect) inside :: Point -> Rectangle -> Point Point x y `inside` Rectangle rx ry rw rh = Point (x `within` (rx, rw)) (y `within` (ry, rh)) where pos `within` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim then pos else midPoint lower dim midPoint :: Position -> Dimension -> Position midPoint pos dim = pos + fromIntegral dim `div` 2 navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)] navigableTargets point dir = navigable dir point <$> windowRects -- Filters and sorts the windows in terms of what is closest from the Point in -- the Direction2D. navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)] navigable d pt = sortby d . filter (inr d pt . snd) -- Produces a list of normal-state windows, on any screen. Rectangles are -- adjusted based on screen position relative to the current screen, because I'm -- bad like that. windowRects :: X [(Window, Rectangle)] windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped windowRect :: Window -> X (Maybe (Window, Rectangle)) windowRect win = withDisplay $ \dpy -> do (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win return $ Just $ (win, Rectangle x y (w + 2 * bw) (h + 2 * bw)) `catchX` return Nothing -- Modified from droundy's implementation of WindowNavigation: inr :: Direction2D -> Point -> Rectangle -> Bool inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w && py < ry + fromIntegral h inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w && py > ry inr R (Point px py) (Rectangle rx ry _ h) = px < rx && py >= ry && py < ry + fromIntegral h inr L (Point px py) (Rectangle rx ry w h) = px > rx + fromIntegral w && py >= ry && py < ry + fromIntegral h sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)] sortby D = sortBy $ comparing (rect_y . snd) sortby R = sortBy $ comparing (rect_x . snd) sortby U = reverse . sortby D sortby L = reverse . sortby R xmonad-contrib-0.12/XMonad/Actions/CycleWindows.hs0000644000000000000000000002476712636047674020341 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleWindows -- Copyright : (c) Wirt Wolff -- License : BSD3-style (see LICENSE) -- -- Maintainer : Wirt Wolff -- Stability : unstable -- Portability : unportable -- -- Provides bindings to cycle windows up or down on the current workspace -- stack while maintaining focus in place. -- -- Bindings are available to: -- -- * Cycle nearby or nth windows into the focused frame -- -- * Cycle a window halfway around the stack -- -- * Cycle windows through the focused position. -- -- * Cycle unfocused windows. -- -- These bindings are especially useful with layouts that hide some of -- the windows in the stack, such as Full, "XMonad.Layout.TwoPane" or -- when using "XMonad.Layout.LimitWindows" to only show three or four -- panes. See also "XMonad.Actions.RotSlaves" for related actions. ----------------------------------------------------------------------------- module XMonad.Actions.CycleWindows ( -- * Usage -- $usage -- * Cycling nearby or nth window into current frame -- $cycle cycleRecentWindows, cycleStacks', -- * Cycling half the stack to get rid of a boring window -- $opposite rotOpposite', rotOpposite, -- * Cycling windows through the current frame -- $focused rotFocused', rotFocusedUp, rotFocusedDown, shiftToFocus', -- * Cycling windows through other frames -- $unfocused rotUnfocused', rotUnfocusedUp, rotUnfocusedDown, -- * Updating the mouse pointer -- $pointer -- * Generic list rotations -- $generic rotUp, rotDown ) where import XMonad import qualified XMonad.StackSet as W import XMonad.Actions.RotSlaves import Control.Arrow (second) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Actions.CycleWindows -- > -- config -- > -- other key bindings with x here your config -- > -- > -- make sure mod matches keysym -- > , ((mod4Mask, xK_s), cycleRecentWindows [xK_Super_L] xK_s xK_w) -- > , ((modm, xK_z), rotOpposite) -- > , ((modm , xK_i), rotUnfocusedUp) -- > , ((modm , xK_u), rotUnfocusedDown) -- > , ((modm .|. controlMask, xK_i), rotFocusedUp) -- > , ((modm .|. controlMask, xK_u), rotFocusedDown) -- -- Also, if you use focus follows mouse, you will want to read the section -- on updating the mouse pointer below. For detailed instructions on -- editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". {- $pointer With FocusFollowsMouse == True, the focus is updated after binding actions, possibly focusing a window you didn't intend to focus. Most people using TwoPane probably already have a logHook causing the mouse to follow focus. (See "XMonad.Actions.UpdatePointer", or "XMonad.Actions.Warp") If you want this built into the key binding instead, use the appropriate action from one of those modules to also have your bindings move the pointer to the point of your choice on the current window: > import XMonad.Actions.UpdatePointer -- or Actions.Warp and either > -- modify the window rotation bindings > , ((modm .|. controlMask, xK_i ), rotFocusedUp > >> updatePointer (Relative 1 1)) > , ((modm .|. controlMask, xK_u ), rotFocusedDown > >> updatePointer (Relative 1 1)) > > -- or add to xmonad's logHook > , logHook = dynamicLogWithPP xmobarPP > >> updatePointer Nearest -- or your preference -} -- $cycle -- Cycle windows into focus from below or above the focused pane by pressing -- a key while one or more modifier keys is held down. The window order isn't -- changed until a modifier is released, leaving the previously focused window -- just below the new one, (or above if the window just above is chosen.) For -- best results use the same modifier + key combination as the one used to invoke -- the \"bring from below\" action. Also, once cycling, pressing a number key n -- will focus the nth window, with 0 being the one originally focused. cycleRecentWindows :: [KeySym] -- ^ A list of modifier keys used when invoking this action. -- As soon as one of them is released, the final switch is made. -> KeySym -- ^ Key used to shift windows from below the current choice into the current frame. -> KeySym -- ^ Key used to shift windows from above the current choice into the current frame. -- If it's the same as the first key, it is effectively ignored. -> X () cycleRecentWindows = cycleStacks' stacks where stacks s = map (shiftToFocus' `flip` s) (wins s) wins (W.Stack t l r) = t : r ++ reverse l -- | Cycle through a /finite/ list of window stacks with repeated presses -- of a key while a modifier key is held down. For best results use the same -- mod key + key combination as the one used to invoke the \"bring from below\" -- action. You could use cycleStacks' with a different stack permutations -- function to, for example, cycle from one below to one above to two below, -- etc. instead of in order. You are responsible for having it generate a -- finite list, though, or xmonad may hang seeking its length. cycleStacks' :: (W.Stack Window -> [W.Stack Window]) -- ^ A function to a finite list of permutations of a given stack. -> [KeySym] -- ^ A list of modifier keys used to invoke 'cycleStacks''. -- As soon as any is released, we're no longer cycling on the [Stack Window] -> KeySym -- ^ Key used to select a \"next\" stack. -> KeySym -- ^ Key used to select a \"previous\" stack. -> X () cycleStacks' filteredPerms mods keyNext keyPrev = do XConf {theRoot = root, display = d} <- ask stacks <- gets $ maybe [] filteredPerms . W.stack . W.workspace . W.current . windowset let evt = allocaXEvent $ \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p s <- keycodeToKeysym d c 0 return (t, s) choose n (t, s) | t == keyPress && s == keyNext = io evt >>= choose (n+1) | t == keyPress && s == keyPrev = io evt >>= choose (n-1) | t == keyPress && s `elem` [xK_0..xK_9] = io evt >>= choose (numKeyToN s) | t == keyRelease && s `elem` mods = return () | otherwise = doStack n >> io evt >>= choose n doStack n = windows . W.modify' . const $ stacks `cycref` n io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime io evt >>= choose 1 io $ ungrabKeyboard d currentTime where cycref l i = l !! (i `mod` length l) -- modify' ensures l is never [], but must also be finite numKeyToN = subtract 48 . read . show -- | Given a stack element and a stack, shift or insert the element (window) -- at the currently focused position. shiftToFocus' :: (Eq a, Show a, Read a) => a -> W.Stack a -> W.Stack a shiftToFocus' w s@(W.Stack _ ls _) = W.Stack w (reverse revls') rs' where (revls', rs') = splitAt (length ls) . filter (/= w) $ W.integrate s -- $opposite -- Shifts the focused window as far as possible from the current focus, -- i.e. halfway around the stack. Windows above the focus up to the \"opposite\" -- position remain in place, while those above the insertion shift toward -- the current focus. This is useful for people who use lots of windows in Full, -- TwoPane, etc., to get rid of boring windows while cycling and swapping -- near the focus. rotOpposite :: X() rotOpposite = windows $ W.modify' rotOpposite' -- | The opposite rotation on a Stack. rotOpposite' :: W.Stack a -> W.Stack a rotOpposite' (W.Stack t l r) = W.Stack t' l' r' where rrvl = r ++ reverse l part = (length rrvl + 1) `div` 2 (l',t':r') = second reverse . splitAt (length l) $ reverse (take part rrvl ++ t : drop part rrvl) -- $focused -- Most people will want the @rotAllUp@ or @rotAllDown@ actions from -- "XMonad.Actions.RotSlaves" to cycle all windows in the stack. -- -- The following actions keep the \"next\" window stable, which is -- mostly useful in two window layouts, or when you have a log viewer or -- buffer window you want to keep next to the cycled window. -- | Rotate windows through the focused frame, excluding the \"next\" window. -- With, e.g. TwoPane, this allows cycling windows through either the -- master or slave pane, without changing the other frame. When the master -- is focused, the window below is skipped, when a non-master window is -- focused, the master is skipped. rotFocusedUp :: X () rotFocusedUp = windows . W.modify' $ rotFocused' rotUp rotFocusedDown :: X () rotFocusedDown = windows . W.modify' $ rotFocused' rotDown -- | The focused rotation on a stack. rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a rotFocused' _ s@(W.Stack _ [] []) = s rotFocused' f (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus where (t':rs') = f (t:rs) rotFocused' f s@(W.Stack _ _ _) = rotSlaves' f s -- otherwise -- $unfocused -- Rotate windows through the unfocused frames. This is similar to -- @rotSlaves@, from "XMonad.Actions.RotSlaves", but excludes the current -- frame rather than master. rotUnfocusedUp :: X () rotUnfocusedUp = windows . W.modify' $ rotUnfocused' rotUp rotUnfocusedDown :: X () rotUnfocusedDown = windows . W.modify' $ rotUnfocused' rotDown -- | The unfocused rotation on a stack. rotUnfocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a rotUnfocused' _ s@(W.Stack _ [] []) = s rotUnfocused' f s@(W.Stack _ [] _ ) = rotSlaves' f s -- Master has focus rotUnfocused' f (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwise where (master:revls) = reverse ls (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs) -- $generic -- Generic list rotations such that @rotUp [1..4]@ is equivalent to -- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are -- @id@ for null or singleton lists. rotUp :: [a] -> [a] rotUp l = drop 1 l ++ take 1 l rotDown :: [a] -> [a] rotDown = reverse . rotUp . reverse xmonad-contrib-0.12/XMonad/Actions/SwapWorkspaces.hs0000644000000000000000000000464312636047674020672 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.SwapWorkspaces -- Copyright : (c) Devin Mullins -- License : BSD3-style (see LICENSE) -- -- Maintainer : Devin Mullins -- Stability : unstable -- Portability : unportable -- -- Lets you swap workspace tags, so you can keep related ones next to -- each other, without having to move individual windows. -- ----------------------------------------------------------------------------- module XMonad.Actions.SwapWorkspaces ( -- * Usage -- $usage swapWithCurrent, swapTo, swapWorkspaces, Direction1D(..) ) where import XMonad (windows, X()) import XMonad.StackSet import XMonad.Actions.CycleWS import XMonad.Util.WorkspaceCompare -- $usage -- Add this import to your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.SwapWorkspaces -- -- Then throw something like this in your keys definition: -- -- > ++ -- > [((modm .|. controlMask, k), windows $ swapWithCurrent i) -- > | (i, k) <- zip workspaces [xK_1 ..]] -- -- After installing this update, if you're on workspace 1, hitting mod-ctrl-5 -- will swap workspaces 1 and 5. -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Swaps the currently focused workspace with the given workspace tag, via -- @swapWorkspaces@. swapWithCurrent :: Eq i => i -> StackSet i l a s sd -> StackSet i l a s sd swapWithCurrent t s = swapWorkspaces t (currentTag s) s -- | Say @swapTo Next@ or @swapTo Prev@ to move your current workspace. -- This is an @X ()@ so can be hooked up to your keybindings directly. swapTo :: Direction1D -> X () swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurrent -- | Takes two workspace tags and an existing XMonad.StackSet and returns a new -- 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 t1 t2 = mapWorkspace swap where swap w = if tag w == t1 then w { tag = t2 } else if tag w == t2 then w { tag = t1 } else w xmonad-contrib-0.12/XMonad/Actions/CopyWindow.hs0000644000000000000000000001565012636047674020020 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CopyWindow -- Copyright : (c) David Roundy , Ivan Veselov , Lanny Ripple -- License : BSD3-style (see LICENSE) -- -- Maintainer : ??? -- Stability : unstable -- Portability : unportable -- -- Provides bindings to duplicate a window on multiple workspaces, -- providing dwm-like tagging functionality. -- ----------------------------------------------------------------------------- module XMonad.Actions.CopyWindow ( -- * Usage -- $usage copy, copyToAll, copyWindow, runOrCopy , killAllOtherCopies, kill1 -- * Highlight workspaces containing copies in logHook -- $logHook , wsContainingCopies ) where import XMonad import Control.Arrow ((&&&)) import qualified Data.List as L import XMonad.Actions.WindowGo import qualified XMonad.StackSet as W -- $usage -- -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file: -- -- > import XMonad.Actions.CopyWindow -- -- Then add something like this to your keybindings: -- -- > -- mod-[1..9] @@ Switch to workspace N -- > -- mod-shift-[1..9] @@ Move client to workspace N -- > -- mod-control-shift-[1..9] @@ Copy client to workspace N -- > [((m .|. modm, k), windows $ f i) -- > | (i, k) <- zip (workspaces x) [xK_1 ..] -- > , (f, m) <- [(W.view, 0), (W.shift, shiftMask), (copy, shiftMask .|. controlMask)]] -- -- To use the above key bindings you need also to import -- "XMonad.StackSet": -- -- > import qualified XMonad.StackSet as W -- -- You may also wish to redefine the binding to kill a window so it only -- removes it from the current workspace, if it's present elsewhere: -- -- > , ((modm .|. shiftMask, xK_c ), kill1) -- @@ Close the focused window -- -- Instead of copying a window from one workspace to another maybe you don't -- want to have to remember where you placed it. For that consider: -- -- > , ((modm, xK_b ), runOrCopy "firefox" (className =? "Firefox")) -- @@ run or copy firefox -- -- Another possibility which this extension provides is 'making window -- always visible' (i.e. always on current workspace), similar to corresponding -- metacity functionality. This behaviour is emulated through copying given -- window to all the workspaces and then removing it when it's unneeded on -- all workspaces any more. -- -- Here is the example of keybindings which provide these actions: -- -- > , ((modm, xK_v ), windows copyToAll) -- @@ Make focused window always visible -- > , ((modm .|. shiftMask, xK_v ), killAllOtherCopies) -- @@ Toggle window state back -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- $logHook -- To distinguish workspaces containing copies of the focused window use -- something like: -- -- > sampleLogHook h = do -- > copies <- wsContainingCopies -- > let check ws | ws `elem` copies = pad . xmobarColor "red" "black" $ ws -- > | otherwise = pad ws -- > dynamicLogWithPP myPP {ppHidden = check, ppOutput = hPutStrLn h} -- > -- > main = do -- > h <- spawnPipe "xmobar" -- > xmonad def { logHook = sampleLogHook h } -- | 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 n s | Just w <- W.peek s = copyWindow w n s | otherwise = s -- | 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 s = foldr copy s $ map W.tag (W.workspaces s) -- | 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 w n = copy' where copy' s = if n `W.tagMember` s then W.view (W.currentTag s) $ insertUp' w $ W.view n s else s insertUp' a s = W.modify (Just $ W.Stack a [] []) (\(W.Stack t l r) -> if a `elem` t:l++r then Just $ W.Stack t l r else Just $ W.Stack a (L.delete a l) (L.delete a (t:r))) s -- | runOrCopy will run the provided shell command unless it can -- find a specified window in which case it will copy the window to -- the current workspace. Similar to (i.e., stolen from) "XMonad.Actions.WindowGo". runOrCopy :: String -> Query Bool -> X () runOrCopy = copyMaybe . spawn -- | Copy a window if it exists, run the first argument otherwise. copyMaybe :: X () -> Query Bool -> X () copyMaybe f qry = ifWindow qry copyWin f where copyWin = ask >>= \w -> doF (\ws -> copyWindow w (W.currentTag ws) ws) -- | Remove the focused window from this workspace. If it's present in no -- other workspace, then kill it instead. If we do kill it, we'll get a -- delete notify back from X. -- -- There are two ways to delete a window. Either just kill it, or if it -- supports the delete protocol, send a delete event (e.g. firefox). kill1 :: X () kill1 = do ss <- gets windowset whenJust (W.peek ss) $ \w -> if W.member w $ delete'' w ss then windows $ delete'' w else kill where delete'' w = W.modify Nothing (W.filter (/= w)) -- | Kill all other copies of focused window (if they're present). -- 'All other' means here 'copies which are not on the current workspace'. killAllOtherCopies :: X () killAllOtherCopies = do ss <- gets windowset whenJust (W.peek ss) $ \w -> windows $ W.view (W.currentTag ss) . delFromAllButCurrent w where delFromAllButCurrent w ss = foldr ($) ss $ map (delWinFromWorkspace w . W.tag) $ W.hidden ss ++ map W.workspace (W.visible ss) 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 -- | A list of hidden workspaces containing a copy of the focused window. wsContainingCopies :: X [WorkspaceId] wsContainingCopies = do ws <- gets windowset return $ copiesOfOn (W.peek ws) (taggedWindows $ W.hidden ws) -- | Get a list of tuples (tag, [Window]) for each workspace. taggedWindows :: [W.Workspace i l a] -> [(i, [a])] taggedWindows = map $ W.tag &&& W.integrate' . W.stack -- | Get tags with copies of the focused window (if present.) copiesOfOn :: (Eq a) => Maybe a -> [(i, [a])] -> [i] copiesOfOn foc tw = maybe [] hasCopyOf foc where hasCopyOf f = map fst $ filter ((f `elem` ) . snd) tw xmonad-contrib-0.12/XMonad/Config/0000755000000000000000000000000012636047674015160 5ustar0000000000000000xmonad-contrib-0.12/XMonad/Config/Xfce.hs0000644000000000000000000000225512636047674016405 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Xfce -- Copyright : (c) Ivan Miljenovic -- License : BSD -- -- Maintainer : none -- Stability : unstable -- Portability : unportable -- -- This module provides a config suitable for use with the Xfce desktop -- environment. module XMonad.Config.Xfce ( -- * Usage -- $usage xfceConfig ) 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.Xfce -- > -- > main = xmonad xfceConfig -- -- For examples of how to further customize @xfceConfig@ see "XMonad.Config.Desktop". xfceConfig = desktopConfig { terminal = "Terminal" , keys = xfceKeys <+> keys desktopConfig } xfceKeys (XConfig {modMask = modm}) = M.fromList $ [ ((modm, xK_p), spawn "xfrun4") , ((modm .|. shiftMask, xK_p), spawn "xfce4-appfinder") , ((modm .|. shiftMask, xK_q), spawn "xfce4-session-logout") ] xmonad-contrib-0.12/XMonad/Config/Dmwit.hs0000644000000000000000000003075012636047674016605 0ustar0000000000000000-- boilerplate {{{ {-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults #-} module XMonad.Config.Dmwit where -- system imports import Control.Applicative import Control.Monad import Control.Monad.Trans import Data.Char import Data.List import Data.Map (Map, fromList) import Data.Ratio import Data.Word import GHC.Real import System.Environment import System.Exit import System.IO import System.Process -- xmonad core import XMonad import XMonad.StackSet hiding (workspaces) -- xmonad contrib import XMonad.Actions.SpawnOn import XMonad.Actions.Warp import XMonad.Hooks.DynamicLog import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers import XMonad.Layout.Grid import XMonad.Layout.IndependentScreens import XMonad.Layout.Magnifier import XMonad.Layout.NoBorders import XMonad.Util.Dzen hiding (x, y) import XMonad.Util.SpawnOnce -- }}} -- volume {{{ outputOf :: String -> IO String outputOf s = do uninstallSignalHandlers (hIn, hOut, hErr, p) <- runInteractiveCommand s mapM_ hClose [hIn, hErr] hGetContents hOut <* waitForProcess p <* installSignalHandlers geomMean :: Floating a => [a] -> a geomMean xs = product xs ** (recip . fromIntegral . length $ xs) arithMean :: Floating a => [a] -> a arithMean xs = sum xs / fromIntegral (length xs) namedNumbers n s = do l <- lines s guard (sentinel `isPrefixOf` l) return (drop (length sentinel) l) where sentinel = n ++ " #" -- Data.List.Split.splitOn ":", but without involving an extra dependency splitColon xs = case break (==':') xs of (a, ':':b) -> a : splitColon b (a, _) -> [a] parse s = arithMean $ do l <- lines s guard ("\tVolume: " `isPrefixOf` l) part <- splitColon l (n,'%':_) <- reads part return n modVolume :: String -> Integer -> IO Double modVolume kind n = do is <- namedNumbers parseKind <$> outputOf listCommand forM_ is (outputOf . setCommand) parse <$> outputOf listCommand where sign | n > 0 = "+" | otherwise = "-" ctlKind = map (\c -> if c == ' ' then '-' else c) kind parseKind = unwords . map (\(c:cs) -> toUpper c : cs) . words $ kind setCommand i = "pactl set-" ++ ctlKind ++ "-volume " ++ i ++ " -- " ++ sign ++ show (abs n) ++ "%" listCommand = "pactl list " ++ ctlKind ++ "s" -- }}} -- convenient actions {{{ centerMouse = warpToWindow (1/2) (1/2) statusBarMouse = warpToScreen 0 (5/1600) (5/1200) withScreen s f = screenWorkspace s >>= flip whenJust (windows . f) makeLauncher yargs run exec close = concat ["exe=`yeganesh ", yargs, "` && ", run, " ", exec, "$exe", close] launcher = makeLauncher "" "eval" "\"exec " "\"" termLauncher = makeLauncher "-p withterm" "exec urxvt -e" "" "" viewShift i = view i . shift i floatAll = composeAll . map (\s -> className =? s --> doFloat) sinkFocus = peek >>= maybe id sink showMod k n = liftIO (modVolume k n) >>= volumeDzen . show . round volumeDzen = dzenConfig $ onCurr (center 170 66) >=> font "-*-helvetica-*-r-*-*-64-*-*-*-*-*-*-*,-*-terminus-*-*-*-*-64-*-*-*-*-*-*-*" -- }}} altMask = mod1Mask bright = "#80c0ff" dark = "#13294e" -- manage hooks for mplayer {{{ fullscreen43on169 = expand $ RationalRect 0 (-1/6) 1 (4/3) where expand (RationalRect x y w h) = RationalRect (x - bwx) (y - bwy) (w + 2 * bwx) (h + 2 * bwy) bwx = 2 / 1920 -- borderwidth bwy = 2 / 1080 fullscreenMPlayer = className =? "MPlayer" --> do dpy <- liftX $ asks display win <- ask hints <- liftIO $ getWMNormalHints dpy win case fmap (approx . fst) (sh_aspect hints) of Just ( 4 :% 3) -> viewFullOn 0 "5" win Just (16 :% 9) -> viewFullOn 1 "5" win _ -> doFloat where fi = fromIntegral :: Dimension -> Double approx (n, d) = approxRational (fi n / fi d) (1/100) operationOn f s n w = do let ws = marshall s n currws <- liftX $ screenWorkspace s doF $ view ws . maybe id view currws . shiftWin ws w . f w viewFullOn = operationOn sink centerWineOn = operationOn (`XMonad.StackSet.float` RationalRect (79/960) (-1/540) (401/480) (271/270)) -- }}} -- debugging {{{ class Show a => PPrint a where pprint :: Int -> a -> String pprint _ = show data PPrintable = forall a. PPrint a => P a instance Show PPrintable where show (P x) = show x instance PPrint PPrintable where pprint n (P x) = pprint n x record :: String -> Int -> [(String, PPrintable)] -> String record s n xs = preamble ++ intercalate newline fields ++ postlude where indentation = '\n' : replicate n '\t' preamble = s ++ " {" ++ indentation postlude = indentation ++ "}" newline = ',' : indentation fields = map (\(name, value) -> name ++ " = " ++ pprint (n+1) value) xs instance PPrint a => PPrint (Maybe a) where pprint n (Just x) = "Just (" ++ pprint n x ++ ")" pprint _ x = show x instance PPrint a => PPrint [a] where pprint _ [] = "[]" pprint n xs = preamble ++ intercalate newline allLines ++ postlude where indentation = '\n' : replicate n '\t' preamble = "[" ++ indentation allLines = map (pprint (n+1)) xs newline = ',' : indentation postlude = indentation ++ "]" instance PPrint Rectangle where pprint n x = record "Rectangle" n [ ("rect_x", P (rect_x x)), ("rect_y", P (rect_y x)), ("rect_width", P (rect_width x)), ("rect_height", P (rect_height x)) ] instance PPrint a => PPrint (Stack a) where pprint n x = record "Stack" n [ ("focus", P (XMonad.StackSet.focus x)), ("up", P (up x)), ("down", P (down x)) ] instance (PPrint i, PPrint l, PPrint a) => PPrint (Workspace i l a) where pprint n x = record "Workspace" n [ ("tag", P (tag x)), ("layout", P (layout x)), ("stack", P (stack x)) ] instance PPrint ScreenDetail where pprint n x = record "SD" n [("screenRect", P (screenRect x))] instance (PPrint i, PPrint l, PPrint a, PPrint sid, PPrint sd) => PPrint (XMonad.StackSet.Screen i l a sid sd) where pprint n x = record "Screen" n [ ("workspace", P (workspace x)), ("screen", P (screen x)), ("screenDetail", P (screenDetail x)) ] instance (PPrint i, PPrint l, PPrint a, PPrint sid, PPrint sd) => PPrint (StackSet i l a sid sd) where pprint n x = record "StackSet" n [ ("current", P (current x)), ("visible", P (visible x)), ("hidden", P (hidden x)), ("floating", P (floating x)) ] instance PPrint (Layout a) instance PPrint Int instance PPrint XMonad.Screen instance PPrint Integer instance PPrint Position instance PPrint Dimension instance PPrint Char instance PPrint Word64 instance PPrint ScreenId instance (Show a, Show b) => PPrint (Map a b) -- }}} -- main {{{ dmwitConfig nScreens = def { borderWidth = 2, workspaces = withScreens nScreens (map show [1..5]), terminal = "urxvt", normalBorderColor = dark, focusedBorderColor = bright, modMask = mod4Mask, keys = keyBindings, layoutHook = magnifierOff $ avoidStruts (GridRatio 0.9) ||| noBorders Full, manageHook = (title =? "CGoban: Main Window" --> doF sinkFocus) <+> (className =? "Wine" <&&> (appName =? "hl2.exe" <||> appName =? "portal2.exe") --> ask >>= viewFullOn {-centerWineOn-} 1 "5") <+> (className =? "VirtualBox" --> ask >>= viewFullOn 1 "5") <+> (isFullscreen --> doFullFloat) -- TF2 matches the "isFullscreen" criteria, so its manage hook should appear after (e.g., to the left of a <+> compared to) this one <+> (appName =? "huludesktop" --> doRectFloat fullscreen43on169) <+> fullscreenMPlayer <+> floatAll ["Gimp", "Wine"] <+> manageDocks <+> manageSpawn, logHook = allPPs nScreens, startupHook = refresh >> mapM_ (spawnOnce . xmobarCommand) [0 .. nScreens-1] } main = countScreens >>= xmonad . dmwitConfig -- }}} -- keybindings {{{ keyBindings conf = let m = modMask conf in fromList . anyMask $ [ ((m , xK_BackSpace ), spawnHere "urxvt"), ((m , xK_p ), spawnHere launcher), ((m .|. shiftMask , xK_p ), spawnHere termLauncher), ((m .|. shiftMask , xK_c ), kill), ((m , xK_q ), restart "xmonad" True), ((m .|. shiftMask , xK_q ), io (exitWith ExitSuccess)), ((m , xK_grave ), sendMessage NextLayout), ((m .|. shiftMask , xK_grave ), setLayout $ layoutHook conf), ((m , xK_o ), sendMessage Toggle), ((m , xK_x ), withFocused (windows . sink)), ((m , xK_Home ), windows focusUp), ((m .|. shiftMask , xK_Home ), windows swapUp), ((m , xK_End ), windows focusDown), ((m .|. shiftMask , xK_End ), windows swapDown), ((m , xK_a ), windows focusMaster), ((m .|. shiftMask , xK_a ), windows swapMaster), ((m , xK_Control_L ), withScreen 0 view), ((m .|. shiftMask , xK_Control_L ), withScreen 0 viewShift), ((m , xK_Alt_L ), withScreen 1 view), ((m .|. shiftMask , xK_Alt_L ), withScreen 1 viewShift), ((m , xK_u ), centerMouse), ((m .|. shiftMask , xK_u ), statusBarMouse), ((m , xK_s ), spawnHere "chromium --password-store=gnome"), ((m , xK_n ), spawnHere "gvim todo"), ((m , xK_t ), spawnHere "mpc toggle"), ((m , xK_h ), spawnHere "urxvt -e alsamixer"), ((m , xK_d ), spawnHere "wyvern"), ((m , xK_l ), spawnHere "urxvt -e sup"), ((m , xK_r ), spawnHere "urxvt -e ncmpcpp"), ((m , xK_c ), spawnHere "urxvt -e ghci"), ((m , xK_g ), spawnHere "slock" >> spawnHere "xscreensaver-command -lock"), ((m , xK_f ), spawnHere "gvim ~/.xmonad/xmonad.hs"), (( noModMask , xK_F8 ), showMod "sink input" (-4)), (( noModMask , xK_F9 ), showMod "sink input" 4 ), (( shiftMask , xK_F8 ), showMod "sink" (-4)), (( shiftMask , xK_F9 ), showMod "sink" 4 ), (( noModMask , xK_Super_L ), return ()) -- make VirtualBox ignore stray hits of the Windows key ] ++ [ ((m .|. e , key ), windows (onCurrentScreen f ws)) | (key, ws) <- zip [xK_1..xK_9] (workspaces' conf) , (e, f) <- [(0, view), (shiftMask, viewShift)] ] atSchool school home = do host <- liftIO (getEnv "HOST") return $ case host of "sorghum" -> home "buckwheat" -> home _ -> school anyMask xs = do ((mask, key), action) <- xs extraMask <- [0, controlMask, altMask, controlMask .|. altMask] return ((mask .|. extraMask, key), action) -- }}} -- logHook {{{ pipeName n s = "/home/dmwit/.xmonad/pipe-" ++ n ++ "-" ++ show s xmobarCommand (S s) = unwords ["xmobar", "-x", show s, "-t", template s, "-C", pipeReader ] where template 0 = "}%focus%{%workspaces%" template _ = "%date%}%focus%{%workspaces%" pipeReader = "'[\ \Run PipeReader \"" ++ pipeName "focus" s ++ "\" \"focus\",\ \Run PipeReader \"" ++ pipeName "workspaces" s ++ "\" \"workspaces\"\ \]'" allPPs nScreens = sequence_ [dynamicLogWithPP (pp s) | s <- [0..nScreens-1], pp <- [ppFocus, ppWorkspaces]] color c = xmobarColor c "" ppFocus s@(S s_) = whenCurrentOn s def { ppOrder = \(_:_:windowTitle:_) -> [windowTitle], ppOutput = appendFile (pipeName "focus" s_) . (++ "\n") } ppWorkspaces s@(S s_) = marshallPP s def { ppCurrent = color "white", ppVisible = color "white", ppHiddenNoWindows = color dark, ppUrgent = color "red", ppSep = "", ppOrder = \(wss:_layout:_title:_) -> [wss], ppOutput = appendFile (pipeName "workspaces" s_) . (++"\n") } -- }}} xmonad-contrib-0.12/XMonad/Config/Droundy.hs0000644000000000000000000002161512636047674017145 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Copyright : (c) Spencer Janssen 2007 -- License : BSD3-style (see LICENSE) -- ------------------------------------------------------------------------ module XMonad.Config.Droundy ( config, mytab ) where import XMonad hiding (keys, config, (|||)) import qualified XMonad (keys) import qualified XMonad.StackSet as W import qualified Data.Map as M import System.Exit ( exitWith, ExitCode(ExitSuccess) ) import XMonad.Layout.Tabbed ( tabbed, shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) ) import XMonad.Layout.Combo ( combineTwo ) import XMonad.Layout.Named ( named ) import XMonad.Layout.LayoutCombinators import XMonad.Layout.Square ( Square(Square) ) import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction2D(U,D,R,L), windowNavigation ) import XMonad.Layout.BoringWindows ( boringWindows, markBoring, clearBoring, focusUp, focusDown ) import XMonad.Layout.NoBorders ( smartBorders ) import XMonad.Layout.WorkspaceDir ( changeDir, workspaceDir ) import XMonad.Layout.ToggleLayouts ( toggleLayouts, ToggleLayout(ToggleLayout) ) import XMonad.Layout.ShowWName ( showWName ) import XMonad.Layout.Magnifier ( maximizeVertical, MagnifyMsg(Toggle) ) import XMonad.Prompt ( font, height, XPConfig ) import XMonad.Prompt.Layout ( layoutPrompt ) import XMonad.Prompt.Shell ( shellPrompt ) import XMonad.Actions.CopyWindow ( kill1, copy ) import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace, selectWorkspace, renameWorkspace, removeWorkspace ) import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ), Direction1D( Prev, Next) ) import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks ) import XMonad.Hooks.EwmhDesktops ( ewmh ) myXPConfig :: XPConfig myXPConfig = def {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*" ,height=22} ------------------------------------------------------------------------ -- Key bindings: -- | The xmonad key bindings. Add, modify or remove key bindings here. -- -- (The comment formatting character is used when generating the manpage) -- keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) keys x = M.fromList $ -- launching and killing programs [ ((modMask x .|. shiftMask, xK_c ), kill1) -- %! Close the focused window , ((modMask x .|. shiftMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms , ((modMask x .|. controlMask .|. shiftMask, xK_L ), setLayout $ layoutHook x) -- %! Reset the layouts on the current workspace to default -- move focus up or down the window stack , ((modMask x, xK_Tab ), focusDown) -- %! Move focus to the next window , ((modMask x, xK_j ), focusDown) -- %! Move focus to the next window , ((modMask x, xK_k ), focusUp ) -- %! Move focus to the previous window , ((modMask x .|. shiftMask, xK_j ), windows W.swapDown ) -- %! Swap the focused window with the next window , ((modMask x .|. shiftMask, xK_k ), windows W.swapUp ) -- %! Swap the focused window with the previous window -- floating layer support , ((modMask x, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling -- quit, or restart , ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad , ((modMask x , xK_Escape), restart "xmonad" True) -- %! Restart xmonad , ((modMask x .|. shiftMask, xK_Right), moveTo Next HiddenNonEmptyWS) , ((modMask x .|. shiftMask, xK_Left), moveTo Prev HiddenNonEmptyWS) , ((modMask x, xK_Right), sendMessage $ Go R) , ((modMask x, xK_Left), sendMessage $ Go L) , ((modMask x, xK_Up), sendMessage $ Go U) , ((modMask x, xK_Down), sendMessage $ Go D) , ((modMask x .|. controlMask, xK_Right), sendMessage $ Swap R) , ((modMask x .|. controlMask, xK_Left), sendMessage $ Swap L) , ((modMask x .|. controlMask, xK_Up), sendMessage $ Swap U) , ((modMask x .|. controlMask, xK_Down), sendMessage $ Swap D) , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R) , ((modMask x .|. controlMask .|. shiftMask, xK_Left), sendMessage $ Move L) , ((modMask x .|. controlMask .|. shiftMask, xK_Up), sendMessage $ Move U) , ((modMask x .|. controlMask .|. shiftMask, xK_Down), sendMessage $ Move D) , ((0, xK_F2 ), spawn "gnome-terminal") -- %! Launch gnome-terminal , ((0, xK_F3 ), shellPrompt myXPConfig) -- %! Launch program , ((0, xK_F11 ), spawn "ksnapshot") -- %! Take snapshot , ((modMask x .|. shiftMask, xK_b ), markBoring) , ((controlMask .|. modMask x .|. shiftMask, xK_b ), clearBoring) , ((modMask x .|. shiftMask, xK_x ), changeDir myXPConfig) , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace) , ((modMask x .|. shiftMask, xK_v ), selectWorkspace myXPConfig) , ((modMask x, xK_m ), withWorkspace myXPConfig (windows . W.shift)) , ((modMask x .|. shiftMask, xK_m ), withWorkspace myXPConfig (windows . copy)) , ((modMask x .|. shiftMask, xK_r), renameWorkspace myXPConfig) , ((modMask x, xK_l ), layoutPrompt myXPConfig) , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout) , ((modMask x, xK_space), sendMessage Toggle) ] ++ zip (zip (repeat $ modMask x) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..]) ++ zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..]) config = ewmh def { borderWidth = 1 -- Width of the window border in pixels. , XMonad.workspaces = ["mutt","iceweasel"] , layoutHook = showWName $ workspaceDir "~" $ boringWindows $ smartBorders $ windowNavigation $ maximizeVertical $ toggleLayouts Full $ avoidStruts $ named "tabbed" mytab ||| named "xclock" (mytab ****//* combineTwo Square mytab mytab) ||| named "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) ||| named "widescreen" ((mytab *||* mytab) ****//* combineTwo Square mytab mytab) -- ||| --mosaic 0.25 0.5 , manageHook = manageHook def <+> manageDocks -- add panel-handling , terminal = "xterm" -- The preferred terminal program. , normalBorderColor = "#222222" -- Border color for unfocused windows. , focusedBorderColor = "#00ff00" -- Border color for focused windows. , XMonad.modMask = mod1Mask , XMonad.keys = keys } mytab = tabbed CustomShrink def instance Shrinker CustomShrink where shrinkIt shr s | Just s' <- dropFromHead " " s = shrinkIt shr s' shrinkIt shr s | Just s' <- dropFromTail " " s = shrinkIt shr s' shrinkIt shr s | Just s' <- dropFromTail "- Iceweasel" s = shrinkIt shr s' shrinkIt shr s | Just s' <- dropFromTail "- KPDF" s = shrinkIt shr s' shrinkIt shr s | Just s' <- dropFromHead "file://" s = shrinkIt shr s' shrinkIt shr s | Just s' <- dropFromHead "http://" s = shrinkIt shr s' shrinkIt _ s | n > 9 = s : map cut [2..(halfn-3)] ++ shrinkIt shrinkText s where n = length s halfn = n `div` 2 rs = reverse s cut x = take (halfn - x) s ++ "..." ++ reverse (take (halfn-x) rs) shrinkIt _ s = shrinkIt shrinkText s dropFromTail :: String -> String -> Maybe String dropFromTail "" _ = Nothing dropFromTail t s | drop (length s - length t) s == t = Just $ take (length s - length t) s | otherwise = Nothing dropFromHead :: String -> String -> Maybe String dropFromHead "" _ = Nothing dropFromHead h s | take (length h) s == h = Just $ drop (length h) s | otherwise = Nothing {- data FocusUrgencyHook = FocusUrgencyHook deriving (Read, Show) instance UrgencyHook FocusUrgencyHook Window where urgencyHook _ w = modify copyAndFocus where copyAndFocus s | Just w == W.peek (windowset s) = s | has w $ W.stack $ W.workspace $ W.current $ windowset s = s { windowset = until ((Just w ==) . W.peek) W.focusUp $ windowset s } | otherwise = let t = W.currentTag $ windowset s in s { windowset = until ((Just w ==) . W.peek) W.focusUp $ copyWindow w t $ windowset s } has _ Nothing = False has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr) -} xmonad-contrib-0.12/XMonad/Config/dmwit.xmobarrc0000644000000000000000000000047412636047674020050 0ustar0000000000000000Config { font = "xft:Monospace:pixelsize=14,-*-*-*-r-*-*-16-*-*-*-*-*-*-*", bgColor = "#000040", fgColor = "#80c0ff", position = TopSize C 100 26, lowerOnStart = True, commands = [ Run Com "date" ["+%H:%M"] "" 30 ], sepChar = "%", alignSep = "}{" } xmonad-contrib-0.12/XMonad/Config/Desktop.hs0000644000000000000000000001424012636047674017126 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Desktop -- Copyright : (c) Spencer Janssen -- License : BSD -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- This module provides a config suitable for use with a desktop -- environment such as KDE or GNOME. ----------------------------------------------------------------------------- module XMonad.Config.Desktop ( -- | Several basic integration settings are common to all of xmonad's -- desktop integration configurations. The specific desktop environment -- (DE) modules like "XMonad.Config.Gnome" use this module's -- @desktopConfig@ to set up basic communication between xmonad and -- the DE via a subset of the Extended Window Manager Hints (EWMH) -- specification. Extra xmonad settings unique to specific DE's are -- added by overriding or modifying @desktopConfig@ fields in the -- same way that the default configuration is customized in -- @~\/.xmonad/xmonad.hs@. -- -- For more information about EWMH see: -- -- -- -- See also: "XMonad.Hooks.EwmhDesktops", "XMonad.Hooks.ManageDocks", -- "XMonad.Util.EZConfig". -- * Usage -- $usage desktopConfig, -- * Customizing a desktop config -- $customizing -- ** Modifying layouts, manageHook, or key bindings -- $layouts desktopLayoutModifiers -- ** Modifying the logHook -- $logHook -- ** Modifying the handleEventHook -- $eventHook -- ** Modifying the startupHook -- $startupHook ) where import XMonad import XMonad.Hooks.ManageDocks import XMonad.Hooks.EwmhDesktops import XMonad.Util.Cursor import qualified Data.Map as M -- $usage -- While this document describes how to configure xmonad, you also need -- to set up your Desktop Environment (DE) and display manager to use -- xmonad as its window manager. For DE and distro specific tips on -- how to do so, see the xmonad wiki: -- -- -- -- To configure xmonad for use with a DE or with DE tools like panels -- and pagers, in place of @def@ in your @~\/.xmonad/xmonad.hs@, -- use @desktopConfig@ or one of the other desktop configs from the -- @XMonad.Config@ namespace. The following setup and customization examples -- work the same way for the other desktop configs as for @desktopConfig@. -- If you are using a specific DE config, import its module instead, and -- use its config in place of @desktopConfig@ in the following examples. -- -- > import XMonad -- > import XMonad.Config.Desktop -- > -- > main = xmonad desktopConfig -- -- @desktopConfig@ is an 'XConfig' that configures xmonad to -- ignore and leave room for dock type windows like panels and trays, adds -- the default key binding to toggle panel visibility, and activates basic -- EWMH support. It also sets a prettier root window mouse pointer. -- $customizing -- To customize a desktop config, modify its fields as is illustrated with -- the default configuration @def@ in "XMonad.Doc.Extending#Extending xmonad". -- $layouts -- See also "XMonad.Util.EZConfig" for more options for modifying key bindings. -- To add to layouts, manageHook or key bindings use something like the following -- to combine your modifications with the desktop config settings: -- -- > import XMonad -- > import XMonad.Config.Desktop -- > import XMonad.Layout.Tabbed -- > import XMonad.Util.EZConfig (additionalKeys) -- > -- > main = -- > xmonad $ desktopConfig { -- > -- add manage hooks while still ignoring panels and using default manageHooks -- > manageHook = myManageHook <+> manageHook desktopConfig -- > -- > -- add a fullscreen tabbed layout that does not avoid covering -- > -- up desktop panels before the desktop layouts -- > , layoutHook = simpleTabbed ||| layoutHook desktopConfig -- > } -- > -- add a screenshot key to the default desktop bindings -- > `additionalKeys` [ ((mod4Mask, xK_F8), spawn "scrot") ] -- -- To replace the desktop layouts with your own choices, but still -- allow toggling panel visibility, use 'desktopLayoutModifiers' to -- modify your layouts: -- -- > , layoutHook = desktopLayoutModifiers $ simpleTabbed ||| Tall 1 0.03 0.5 -- -- @desktopLayoutModifiers@ modifies a layout to avoid covering docks, panels, -- etc. that set the @_NET_WM_STRUT_PARTIAL@ property. -- See also "XMonad.Hooks.ManageDocks". -- $logHook -- To add to the logHook while still sending workspace and window information -- to DE apps use something like: -- -- > , logHook = myLogHook <+> logHook desktopConfig -- -- Or for more elaborate logHooks you can use @do@: -- -- > , logHook = do -- > dynamicLogWithPP xmobarPP -- > updatePointer (Relative 0.9 0.9) -- > logHook desktopConfig -- -- $eventHook -- To customize xmonad's event handling while still having it respond -- to EWMH events from pagers, task bars: -- -- > , handleEventHook = myEventHooks <+> handleEventHook desktopConfig -- -- or 'mconcat' if you write a list event of event hooks -- -- > , handleEventHook = mconcat -- > [ myMouseHandler -- > , myMessageHandler -- > , handleEventHook desktopConfig ] -- -- Note that the event hooks are run left to right (in contrast to -- 'ManageHook'S which are right to left) -- $startupHook -- To run the desktop startupHook, plus add further actions to be run each -- time xmonad starts or restarts, use '<+>' to combine actions as in the -- logHook example, or something like: -- -- > , startupHook = do -- > startupHook desktopConfig -- > spawn "xmonad-restart.sh" -- > adjustEventInput -- desktopConfig = ewmh def { startupHook = setDefaultCursor xC_left_ptr , layoutHook = desktopLayoutModifiers $ layoutHook def , manageHook = manageHook def <+> manageDocks , keys = desktopKeys <+> keys def } desktopKeys (XConfig {modMask = modm}) = M.fromList $ [ ((modm, xK_b), sendMessage ToggleStruts) ] desktopLayoutModifiers layout = avoidStruts layout xmonad-contrib-0.12/XMonad/Config/Bepo.hs0000644000000000000000000000262512636047674016406 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Bepo -- Copyright : (c) Yorick Laupa -- License : BSD -- -- Maintainer : Yorick Laupa -- Stability : stable -- Portability : unportable -- -- This module fixes some of the keybindings for the francophone among you who -- use a BEPO keyboard layout. Based on XMonad.Config.Azerty module XMonad.Config.Bepo ( -- * Usage -- $usage bepoConfig, bepoKeys ) where import XMonad import qualified XMonad.StackSet as W import qualified Data.Map as M -- $usage -- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Bepo -- > -- > main = xmonad bepoConfig -- -- If you prefer, an bepoKeys function is provided which you can use as so: -- -- > import qualified Data.Map as M -- > main = xmonad someConfig { keys = \c -> bepoKeys c `M.union` keys someConfig c } bepoConfig = def { keys = bepoKeys <+> keys def } bepoKeys conf@(XConfig { modMask = modm }) = M.fromList $ [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))] ++ [((m .|. modm, k), windows $ f i) | (i, k) <- zip (workspaces conf) [0x22,0xab,0xbb,0x28,0x29,0x40,0x2b,0x2d,0x2f,0x2a], (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] xmonad-contrib-0.12/XMonad/Config/Kde.hs0000644000000000000000000000316712636047674016226 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Kde -- Copyright : (c) Spencer Janssen -- License : BSD -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- This module provides a config suitable for use with the KDE desktop -- environment. module XMonad.Config.Kde ( -- * Usage -- $usage kdeConfig, kde4Config ) 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.Kde -- > -- > main = xmonad kdeConfig -- -- For KDE 4, replace 'kdeConfig' with 'kde4Config' -- -- For examples of how to further customize @kdeConfig@ see "XMonad.Config.Desktop". kdeConfig = desktopConfig { terminal = "konsole" , keys = kdeKeys <+> keys desktopConfig } kde4Config = desktopConfig { terminal = "konsole" , keys = kde4Keys <+> keys desktopConfig } kdeKeys (XConfig {modMask = modm}) = M.fromList $ [ ((modm, xK_p), spawn "dcop kdesktop default popupExecuteCommand") , ((modm .|. shiftMask, xK_q), spawn "dcop kdesktop default logout") ] kde4Keys (XConfig {modMask = modm}) = M.fromList $ [ ((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") ] xmonad-contrib-0.12/XMonad/Config/Arossato.hs0000644000000000000000000002013612636047674017311 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE NoMonomorphismRestriction #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Arossato -- Copyright : (c) Andrea Rossato 2007 -- License : BSD3-style (see LICENSE) -- -- Maintainer : andrea.rossato@unibz.it -- Stability : stable -- Portability : portable -- -- This module specifies my xmonad defaults. -- ------------------------------------------------------------------------ module XMonad.Config.Arossato ( -- * Usage -- $usage arossatoConfig ) where import qualified Data.Map as M import XMonad hiding ( (|||) ) import qualified XMonad.StackSet as W import XMonad.Actions.CycleWS import XMonad.Hooks.DynamicLog hiding (xmobar) import XMonad.Hooks.ManageDocks import XMonad.Hooks.ServerMode import XMonad.Layout.Accordion import XMonad.Layout.LayoutCombinators import XMonad.Layout.Magnifier import XMonad.Layout.NoBorders import XMonad.Layout.SimpleFloat import XMonad.Layout.Tabbed import XMonad.Layout.WindowArranger import XMonad.Prompt.Shell import XMonad.Prompt.Ssh import XMonad.Prompt.Theme import XMonad.Prompt.Window import XMonad.Prompt.XMonad import XMonad.Util.Run import XMonad.Util.Themes -- $usage -- The simplest way to use this configuration module is to use an -- @~\/.xmonad\/xmonad.hs@ like this: -- -- > module Main (main) where -- > -- > import XMonad -- > import XMonad.Config.Arossato (arossatoConfig) -- > -- > main :: IO () -- > main = xmonad =<< arossatoConfig -- -- NOTE: that I'm using xmobar and, if you don't have xmobar in your -- PATH, this configuration will produce an error and xmonad will not -- start. If you don't want to install xmobar get rid of this line at -- the beginning of 'arossatoConfig'. -- -- You can use this module also as a starting point for writing your -- own configuration module from scratch. Save it as your -- @~\/.xmonad\/xmonad.hs@ and: -- -- 1. Change the module name from -- -- > module XMonad.Config.Arossato -- > ( -- * Usage -- > -- $usage -- > arossatoConfig -- > ) where -- -- to -- -- > module Main where -- -- 2. Add a line like: -- -- > main = xmonad =<< arossatoConfig -- -- 3. Start playing with the configuration options...;) arossatoConfig = do xmobar <- spawnPipe "xmobar" -- REMOVE this line if you do not have xmobar installed! return $ def { workspaces = ["home","var","dev","mail","web","doc"] ++ map show [7 .. 9 :: Int] , logHook = myDynLog xmobar -- REMOVE this line if you do not have xmobar installed! , manageHook = newManageHook , layoutHook = avoidStruts $ decorated ||| noBorders mytabs ||| otherLays , terminal = "urxvt +sb" , normalBorderColor = "white" , focusedBorderColor = "black" , keys = newKeys , handleEventHook = serverModeEventHook , focusFollowsMouse = False } where -- layouts mytabs = tabbed shrinkText (theme smallClean) decorated = simpleFloat' shrinkText (theme smallClean) tiled = Tall 1 (3/100) (1/2) otherLays = windowArrange $ magnifier tiled ||| noBorders Full ||| Mirror tiled ||| Accordion -- manageHook myManageHook = composeAll [ resource =? "win" --> doF (W.shift "doc") -- xpdf , resource =? "firefox-bin" --> doF (W.shift "web") ] newManageHook = myManageHook -- xmobar myDynLog h = dynamicLogWithPP def { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]" , ppTitle = xmobarColor "green" "" . shorten 40 , ppVisible = wrap "(" ")" , ppOutput = hPutStrLn h } -- key bindings stuff defKeys = keys def delKeys x = foldr M.delete (defKeys x) (toRemove x) newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x) -- remove some of the default key bindings toRemove x = [ (modMask x , xK_j) , (modMask x , xK_k) , (modMask x , xK_p) , (modMask x .|. shiftMask, xK_p) , (modMask x .|. shiftMask, xK_q) , (modMask x , xK_q) ] ++ -- I want modMask .|. shiftMask 1-9 to be free! [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]] -- These are my personal key bindings toAdd x = [ ((modMask x , xK_F12 ), xmonadPrompt def ) , ((modMask x , xK_F3 ), shellPrompt def ) , ((modMask x , xK_F4 ), sshPrompt def ) , ((modMask x , xK_F5 ), themePrompt def ) , ((modMask x , xK_F6 ), windowPromptGoto def ) , ((modMask x , xK_F7 ), windowPromptBring def ) , ((modMask x , xK_comma ), prevWS ) , ((modMask x , xK_period), nextWS ) , ((modMask x , xK_Right ), windows W.focusDown ) , ((modMask x , xK_Left ), windows W.focusUp ) -- other stuff: launch some useful utilities , ((modMask x , xK_F2 ), spawn "urxvt -fg white -bg black +sb" ) , ((modMask x .|. shiftMask, xK_F4 ), spawn "~/bin/dict.sh" ) , ((modMask x .|. shiftMask, xK_F5 ), spawn "~/bin/urlOpen.sh" ) , ((modMask x .|. shiftMask, xK_t ), spawn "~/bin/teaTime.sh" ) , ((modMask x , xK_c ), kill ) , ((modMask x .|. shiftMask, xK_comma ), sendMessage (IncMasterN 1 ) ) , ((modMask x .|. shiftMask, xK_period), sendMessage (IncMasterN (-1)) ) -- commands fo the Magnifier layout , ((modMask x .|. controlMask , xK_plus ), sendMessage MagnifyMore) , ((modMask x .|. controlMask , xK_minus), sendMessage MagnifyLess) , ((modMask x .|. controlMask , xK_o ), sendMessage ToggleOff ) , ((modMask x .|. controlMask .|. shiftMask, xK_o ), sendMessage ToggleOn ) -- windowArranger , ((modMask x .|. controlMask , xK_a ), sendMessage Arrange ) , ((modMask x .|. controlMask .|. shiftMask, xK_a ), sendMessage DeArrange ) , ((modMask x .|. controlMask , xK_Left ), sendMessage (DecreaseLeft 10)) , ((modMask x .|. controlMask , xK_Up ), sendMessage (DecreaseUp 10)) , ((modMask x .|. controlMask , xK_Right), sendMessage (IncreaseRight 10)) , ((modMask x .|. controlMask , xK_Down ), sendMessage (IncreaseDown 10)) , ((modMask x .|. shiftMask , xK_Left ), sendMessage (MoveLeft 10)) , ((modMask x .|. shiftMask , xK_Right), sendMessage (MoveRight 10)) , ((modMask x .|. shiftMask , xK_Down ), sendMessage (MoveDown 10)) , ((modMask x .|. shiftMask , xK_Up ), sendMessage (MoveUp 10)) -- gaps , ((modMask x , xK_b ), sendMessage ToggleStruts ) ] ++ -- Use modMask .|. shiftMask .|. controlMask 1-9 instead [( (m .|. modMask x, k), windows $ f i) | (i, k) <- zip (workspaces x) [xK_1 .. xK_9] , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)] ] xmonad-contrib-0.12/XMonad/Config/Sjanssen.hs0000644000000000000000000000607112636047674017304 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} module XMonad.Config.Sjanssen (sjanssenConfig) where import XMonad hiding (Tall(..)) import qualified XMonad.StackSet as W import XMonad.Actions.CopyWindow import XMonad.Layout.Tabbed import XMonad.Layout.HintedTile import XMonad.Layout.NoBorders import XMonad.Hooks.DynamicLog import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat) import XMonad.Hooks.EwmhDesktops import XMonad.Prompt import XMonad.Actions.SpawnOn import XMonad.Util.SpawnOnce import XMonad.Layout.LayoutScreens import XMonad.Layout.TwoPane import qualified Data.Map as M sjanssenConfig = ewmh $ def { terminal = "exec urxvt" , workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int] , mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $ [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w)) , ((modm, button2), (\w -> focus w >> windows W.swapMaster)) , ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ] , keys = \c -> mykeys c `M.union` keys def c , logHook = dynamicLogString sjanssenPP >>= xmonadPropLog , layoutHook = modifiers layouts , manageHook = composeAll [className =? x --> doShift w | (x, w) <- [ ("Firefox", "web") , ("Ktorrent", "7") , ("Amarokapp", "7")]] <+> manageHook def <+> manageDocks <+> manageSpawn <+> (isFullscreen --> doFullFloat) , startupHook = mapM_ spawnOnce spawns } where tiled = HintedTile 1 0.03 0.5 TopLeft layouts = (tiled Tall ||| (tiled Wide ||| Full)) ||| tabbed shrinkText myTheme modifiers = avoidStruts . smartBorders spawns = [ "xmobar" , "xset -b", "xset s off", "xset dpms 0 600 1200" , "nitrogen --set-tiled wallpaper/wallpaper.jpg" , "trayer --transparent true --expand true --align right " ++ "--edge bottom --widthtype request" ] mykeys (XConfig {modMask = modm}) = M.fromList $ [((modm, xK_p ), shellPromptHere myPromptConfig) ,((modm .|. shiftMask, xK_Return), spawnHere =<< asks (terminal . config)) ,((modm .|. shiftMask, xK_c ), kill1) ,((modm .|. shiftMask .|. controlMask, xK_c ), kill) ,((modm .|. shiftMask, xK_0 ), windows $ copyToAll) ,((modm, xK_z ), layoutScreens 2 $ TwoPane 0.5 0.5) ,((modm .|. shiftMask, xK_z ), rescreen) , ((modm , xK_b ), sendMessage ToggleStruts) ] myFont = "xft:Bitstream Vera Sans Mono:pixelsize=10" myTheme = def { fontName = myFont } myPromptConfig = def { position = Top , font = myFont , showCompletionOnTab = True , historyFilter = deleteConsecutive , promptBorderWidth = 0 } xmonad-contrib-0.12/XMonad/Config/Mate.hs0000644000000000000000000000521012636047674016400 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Mate -- Copyright : (c) Brandon S Allbery KF8NH, 2014 -- License : BSD -- -- Maintainer : allbery.b@gmail.com -- Stability : unstable -- Portability : unportable -- -- This module provides a config suitable for use with the MATE desktop -- environment. -- ----------------------------------------------------------------------------- module XMonad.Config.Mate ( -- * Usage -- $usage mateConfig, mateRun, mateRegister ) where import XMonad import XMonad.Config.Desktop import XMonad.Util.Run (safeSpawn) import qualified Data.Map as M import System.Environment (getEnvironment) -- $usage -- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Mate -- > -- > main = xmonad mateConfig -- -- For examples of how to further customize @mateConfig@ see "XMonad.Config.Desktop". mateConfig = desktopConfig { terminal = "mate-terminal" , keys = mateKeys <+> keys desktopConfig , startupHook = mateRegister >> startupHook desktopConfig } mateKeys (XConfig {modMask = modm}) = M.fromList $ [ ((modm, xK_p), mateRun) , ((modm .|. shiftMask, xK_q), spawn "mate-session-save --logout-dialog") ] -- | Launch the "Run Application" dialog. mate-panel must be running for this -- to work. mateRun :: X () mateRun = withDisplay $ \dpy -> do rw <- asks theRoot mate_panel <- getAtom "_MATE_PANEL_ACTION" panel_run <- getAtom "_MATE_PANEL_ACTION_RUN_DIALOG" io $ allocaXEvent $ \e -> do setEventType e clientMessage setClientMessageEvent e rw mate_panel 32 panel_run 0 sendEvent dpy rw False structureNotifyMask e sync dpy False -- | Register xmonad with mate. 'dbus-send' must be in the $PATH with which -- xmonad is started. -- -- This action reduces a delay on startup only if you have configured -- mate-session to start xmonad with a command such as (check local -- documentation): -- -- > dconf write /org/mate/desktop/session/required_components/windowmanager "'xmonad'" -- -- (the extra quotes are required by dconf) mateRegister :: MonadIO m => m () mateRegister = io $ do x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment whenJust x $ \sessionId -> safeSpawn "dbus-send" ["--session" ,"--print-reply=literal" ,"--dest=org.mate.SessionManager" ,"/org/mate/SessionManager" ,"org.mate.SessionManager.RegisterClient" ,"string:xmonad" ,"string:"++sessionId] xmonad-contrib-0.12/XMonad/Config/Bluetile.hs0000644000000000000000000002302612636047674017264 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS -fno-warn-missing-signatures #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Bluetile -- Copyright : (c) Jan Vornberger 2009 -- License : BSD3-style (see LICENSE) -- -- Maintainer : jan.vornberger@informatik.uni-oldenburg.de -- Stability : unstable -- Portability : not portable -- -- This is the default configuration of Bluetile -- (). If you -- are migrating from Bluetile to xmonad or want to create -- a similar setup, then this will give you pretty much -- the same thing, except for Bluetile's helper applications -- such as the dock. -- ----------------------------------------------------------------------------- module XMonad.Config.Bluetile ( -- * Usage -- $usage bluetileConfig ) where import XMonad hiding ( (|||) ) import XMonad.Layout.BorderResize import XMonad.Layout.BoringWindows import XMonad.Layout.ButtonDecoration import XMonad.Layout.Decoration import XMonad.Layout.DecorationAddons import XMonad.Layout.DraggingVisualizer import XMonad.Layout.LayoutCombinators import XMonad.Layout.Maximize import XMonad.Layout.Minimize import XMonad.Layout.MouseResizableTile import XMonad.Layout.Named import XMonad.Layout.NoBorders import XMonad.Layout.PositionStoreFloat import XMonad.Layout.WindowSwitcherDecoration import XMonad.Actions.BluetileCommands import XMonad.Actions.CycleWS import XMonad.Actions.WindowMenu import XMonad.Hooks.CurrentWorkspaceOnTop import XMonad.Hooks.EwmhDesktops import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageHelpers import XMonad.Hooks.PositionStoreHooks import XMonad.Hooks.Minimize import XMonad.Hooks.ServerMode import XMonad.Hooks.WorkspaceByPos import XMonad.Config.Gnome import qualified XMonad.StackSet as W import qualified Data.Map as M import System.Exit import Data.Monoid import Control.Monad(when) -- $usage -- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Bluetile -- > import XMonad.Util.Replace -- > -- > main = replace >> xmonad bluetileConfig -- -- The invocation of 'replace' will replace a currently running -- window manager. This is the default behaviour of Bluetile as well. -- See "XMonad.Util.Replace" for more information. bluetileWorkspaces :: [String] bluetileWorkspaces = ["1","2","3","4","5","6","7","8","9","0"] bluetileKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $ -- launching and killing programs [ ((modMask' , xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal , ((modMask', xK_p ), gnomeRun) -- %! Launch Gnome "Run application" dialog , ((modMask' .|. shiftMask, xK_c ), kill) -- %! Close the focused window , ((modMask', xK_F5 ), refresh) -- %! Resize viewed windows to the correct size , ((modMask' .|. shiftMask, xK_F5 ), setLayout $ XMonad.layoutHook conf) -- %! Reset the layouts on the current workspace to default , ((modMask', xK_o ), windowMenu) -- move focus up or down the window stack , ((modMask', xK_Tab ), focusDown) -- %! Move focus to the next window , ((modMask' .|. shiftMask, xK_Tab ), focusUp) -- %! Move focus to the previous window , ((modMask', xK_j ), focusDown) -- %! Move focus to the next window , ((modMask', xK_k ), focusUp) -- %! Move focus to the previous window , ((modMask', xK_space ), focusMaster) -- %! Move focus to the master window -- modifying the window order , ((modMask' .|. shiftMask, xK_space ), windows W.swapMaster) -- %! Swap the focused window and the master window , ((modMask' .|. shiftMask, xK_j ), windows W.swapDown ) -- %! Swap the focused window with the next window , ((modMask' .|. shiftMask, xK_k ), windows W.swapUp ) -- %! Swap the focused window with the previous window -- resizing the master/slave ratio , ((modMask', xK_h ), sendMessage Shrink) -- %! Shrink the master area , ((modMask', xK_l ), sendMessage Expand) -- %! Expand the master area , ((modMask', xK_u ), sendMessage ShrinkSlave) -- %! Shrink a slave area , ((modMask', xK_i ), sendMessage ExpandSlave) -- %! Expand a slave area -- floating layer support , ((modMask', xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling , ((modMask' .|. shiftMask, xK_t ), withFocused $ float ) -- %! Float window -- 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_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area -- quit, or restart , ((modMask' .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit , ((modMask' , xK_q ), restart "xmonad" True) -- %! Restart -- Metacity-like workspace switching , ((mod1Mask .|. controlMask, xK_Left), prevWS) , ((mod1Mask .|. controlMask, xK_Right), nextWS) , ((mod1Mask .|. controlMask .|. shiftMask, xK_Left), shiftToPrev >> prevWS) , ((mod1Mask .|. controlMask .|. shiftMask, xK_Right), shiftToNext >> nextWS) -- more Metacity keys , ((mod1Mask , xK_F2), gnomeRun) , ((mod1Mask , xK_F4), kill) -- Switching to layouts , ((modMask' , xK_a), sendMessage $ JumpToLayout "Floating") , ((modMask' , xK_s), sendMessage $ JumpToLayout "Tiled1") , ((modMask' , xK_d), sendMessage $ JumpToLayout "Tiled2") , ((modMask' , xK_f), sendMessage $ JumpToLayout "Fullscreen") -- Maximizing , ((modMask' , xK_z), withFocused (sendMessage . maximizeRestore)) -- Minimizing , ((modMask', xK_m ), withFocused minimizeWindow) , ((modMask' .|. shiftMask, xK_m ), sendMessage RestoreNextMinimizedWin) ] ++ -- mod-[1..9] ++ [0] %! Switch to workspace N -- mod-shift-[1..9] ++ [0] %! Move client to workspace N [((m .|. modMask', k), windows $ f i) | (i, k) <- zip (XMonad.workspaces conf) ([xK_1 .. xK_9] ++ [xK_0]) , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] ++ -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3 -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3 [((m .|. modMask', key), screenWorkspace sc >>= flip whenJust (windows . f)) | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..] , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) bluetileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $ -- mod-button1 %! Move a floated window by dragging [ ((modMask', button1), (\w -> isFloating w >>= \isF -> when (isF) $ focus w >> mouseMoveWindow w >> windows W.shiftMaster)) -- mod-button2 %! Switch to next and first layout , ((modMask', button2), (\_ -> sendMessage NextLayout)) , ((modMask' .|. shiftMask, button2), (\_ -> sendMessage $ JumpToLayout "Floating")) -- mod-button3 %! Resize a floated window by dragging , ((modMask', button3), (\w -> isFloating w >>= \isF -> when (isF) $ focus w >> mouseResizeWindow w >> windows W.shiftMaster)) ] isFloating :: Window -> X (Bool) isFloating w = do ws <- gets windowset return $ M.member w (W.floating ws) bluetileManageHook :: ManageHook bluetileManageHook = composeAll [ workspaceByPos, positionStoreManageHook (Just defaultThemeWithButtons) , className =? "MPlayer" --> doFloat , isFullscreen --> doFullFloat , manageDocks] bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ ( named "Floating" floating ||| named "Tiled1" tiled1 ||| named "Tiled2" tiled2 ||| named "Fullscreen" fullscreen ) where floating = floatingDeco $ maximize $ borderResize $ positionStoreFloat tiled1 = tilingDeco $ maximize $ mouseResizableTileMirrored tiled2 = tilingDeco $ maximize $ mouseResizableTile fullscreen = tilingDeco $ maximize $ smartBorders Full tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l) floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l bluetileConfig = def { modMask = mod4Mask, -- logo key manageHook = bluetileManageHook, layoutHook = bluetileLayoutHook, logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook, handleEventHook = ewmhDesktopsEventHook `mappend` fullscreenEventHook `mappend` minimizeEventHook `mappend` serverModeEventHook' bluetileCommands `mappend` positionStoreEventHook, workspaces = bluetileWorkspaces, keys = bluetileKeys, mouseBindings = bluetileMouseBindings, focusFollowsMouse = False, focusedBorderColor = "#000000", terminal = "gnome-terminal" } xmonad-contrib-0.12/XMonad/Config/Prime.hs0000644000000000000000000006213612636047674016600 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, MultiParamTypeClasses, UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Prime -- Copyright : Devin Mullins -- License : BSD-style (see LICENSE) -- -- Maintainer : Devin Mullins -- Stability : unstable -- Portability : unportable -- -- This is a draft of a brand new config syntax for xmonad. It aims to be: -- -- * easier to copy/paste snippets from the docs -- -- * easier to get the gist for what's going on, for you imperative programmers -- -- It's brand new, so it's pretty much guaranteed to break or change syntax. -- But what's the worst that could happen? Xmonad crashes and logs you out? -- It probably won't do that. Give it a try. -- ----------------------------------------------------------------------------- module XMonad.Config.Prime ( -- Note: The identifiers here are listed in the order that makes the most sense -- for a user, while the definitions below are listed in the order that makes -- the most sense for a developer. -- * Start here -- $start_here xmonad, nothing, -- * Attributes you can set -- $settables normalBorderColor, focusedBorderColor, terminal, modMask, borderWidth, focusFollowsMouse, clickJustFocuses, SettableClass(..), UpdateableClass(..), -- * Attributes you can add to -- $summables manageHook, handleEventHook, workspaces, logHook, startupHook, clientMask, rootMask, SummableClass(..), -- * Attributes you can add to or remove from -- $removables keys, mouseBindings, RemovableClass(..), -- * Modifying the list of workspaces -- $workspaces withWorkspaces, wsNames, wsKeys, wsActions, wsSetName, -- * Modifying the screen keybindings -- $screens withScreens, sKeys, sActions, onScreens, -- * Modifying the layoutHook -- $layout addLayout, resetLayout, modifyLayout, -- * Updating the XConfig en masse -- $update startWith, apply, applyIO, -- * The rest of the world -- | Everything you know and love from the core "XMonad" module is available -- for use in your config file, too. module XMonad, -- | (Almost) everything you know and love from the Haskell "Prelude" is -- available for use in your config file. Note that '>>' has been overriden, so -- if you want to create do-blocks for normal monads, you'll need some let -- statements or a separate module. (See the Troubleshooting section.) module Prelude, -- * Core -- | These are the building blocks on which the config language is built. -- Regular people shouldn't need to know about these. Prime, Arr, (>>), ifThenElse, -- * Example config -- $example -- * Troubleshooting -- $troubleshooting ) where import Prelude hiding ((>>), mod) import qualified Prelude as P ((>>=), (>>)) import Data.Monoid (All) import XMonad hiding (xmonad, XConfig(..)) import XMonad (XConfig(XConfig)) import qualified XMonad.StackSet as W import qualified XMonad as X (xmonad, XConfig(..)) import XMonad.Util.EZConfig (additionalKeysP, additionalMouseBindings, checkKeymap, removeKeysP, removeMouseBindings) -- $start_here -- To start with, create a @~\/.xmonad\/xmonad.hs@ that looks like this: -- -- > {-# LANGUAGE RebindableSyntax #-} -- > import XMonad.Config.Prime -- > -- > -- Imports go here. -- > -- > main = xmonad $ do -- > nothing -- > -- Configs go here. -- -- This will give you a default xmonad install, with room to grow. The lines -- starting with double dashes are comments. You may delete them. Note that -- Haskell is a bit precise about indentation. Make sure all the statements in -- your do-block start at the same column, and make sure that any multi-line -- statements are formatted with a hanging indent. (For an example, see the -- 'keys =+' statement in the /Example config/ section, below.) -- -- After changing your config file, restart xmonad with mod-q (where, by -- default, "mod" == "alt"). -- -- The Prime "Monad" -- -- | A Prime is a function that transforms an XConfig. It's not a monad, but we -- turn on RebindableSyntax so we can abuse the pretty do notation. type Prime l l' = Arr (XConfig l) (XConfig l') -- | An Arr is a generalization of Prime. Don't reference the type, if you can -- avoid it. It might go away in the future. type Arr x y = x -> IO y -- | Composes two Arrs using 'Prelude.>>=' from "Prelude". (>>) :: Arr x y -> Arr y z -> Arr x z (>>) x y c = (P.>>=) (x c) y -- | Because of RebindableSyntax, this is necessary to enable you to use -- if-then-else expressions. No need to call it directly. ifThenElse :: Bool -> a -> a -> a ifThenElse True a _ = a ifThenElse False _ b = b -- | This is the xmonad main function. It passes 'XMonad.Config.def' (the -- default 'XConfig') into your do-block, takes the modified config out of your -- do-block, and then runs xmonad. -- -- The do-block is a 'Prime'. Advanced readers can skip right to that -- definition. xmonad :: (Default a, Read (l Window), LayoutClass l Window) => (a -> IO (XConfig l)) -> IO () xmonad prime = (P.>>=) (prime def) X.xmonad -- | This doesn't modify the config in any way. It's just here for your initial -- config because Haskell doesn't allow empty do-blocks. Feel free to delete it -- once you've added other stuff. nothing :: Prime l l nothing = return -- $settables -- These are a bunch of attributes that you can set. Syntax looks like this: -- -- > terminal =: "urxvt" -- -- Strings are double quoted, Dimensions are unquoted integers, booleans are -- 'True' or 'False' (case-sensitive), and 'modMask' is usually 'mod1Mask' or -- 'mod4Mask'. class UpdateableClass s x y | s -> x y where -- | This lets you apply a function to an attribute (i.e. read, modify, write). (=.) :: s c -> (x -> y) -> Arr c c class SettableClass s x y | s -> x y where -- | This lets you modify an attribute. (=:) :: s c -> y -> Arr c c -- Undecideable instance. But it's nice to leave open the possibility to write -- fields you can't read (e.g. `wmName =: ...`). instance UpdateableClass s x y => SettableClass s x y where s =: y = s =. const y data Settable x c = Settable (c -> x) -- getter (x -> c -> c) -- setter instance UpdateableClass (Settable x) x x where (Settable g s =. f) c = return $ s (f $ g c) c -- | Non-focused windows border color. Default: @\"#dddddd\"@ normalBorderColor :: Settable String (XConfig l) normalBorderColor = Settable X.normalBorderColor (\x c -> c { X.normalBorderColor = x }) -- | Focused windows border color. Default: @\"#ff0000\"@ focusedBorderColor :: Settable String (XConfig l) focusedBorderColor = Settable X.focusedBorderColor (\x c -> c { X.focusedBorderColor = x }) -- | The preferred terminal application. Default: @\"xterm\"@ terminal :: Settable String (XConfig l) terminal = Settable X.terminal (\x c -> c { X.terminal = x }) -- | The mod modifier, as used by key bindings. Default: @mod1Mask@ (which is -- probably alt on your computer). modMask :: Settable KeyMask (XConfig l) modMask = Settable X.modMask (\x c -> c { X.modMask = x }) -- | The border width (in pixels). Default: @1@ borderWidth :: Settable Dimension (XConfig l) borderWidth = Settable X.borderWidth (\x c -> c { X.borderWidth = x }) -- | Whether window focus follows the mouse cursor on move, or requires a mouse -- click. (Mouse? What's that?) Default: @True@ focusFollowsMouse :: Settable Bool (XConfig l) focusFollowsMouse = Settable X.focusFollowsMouse (\x c -> c { X.focusFollowsMouse = x }) -- | If True, a mouse click on an inactive window focuses it, but the click is -- not passed to the window. If False, the click is also passed to the window. -- Default @True@ clickJustFocuses :: Settable Bool (XConfig l) clickJustFocuses = Settable X.clickJustFocuses (\x c -> c { X.clickJustFocuses = x }) -- $summables -- In addition to being able to set these attributes, they have a special -- syntax for being able to add to them. The operator is @=+@ (the plus comes -- /after/ the equals), but each attribute has a different syntax for what -- comes after the operator. class SummableClass s y | s -> y where -- | This lets you add to an attribute. (=+) :: s c -> y -> Arr c c infix 0 =+ data Summable x y c = Summable (c -> x) -- getter (x -> c -> c) -- setter (x -> y -> x) -- accumulator instance UpdateableClass (Summable x y) x x where (Summable g s _ =. f) c = return $ s (f $ g c) c instance SummableClass (Summable x y) y where (Summable g s a =+ y) c = return $ s (g c `a` y) c -- | The action to run when a new window is opened. Default: -- -- > manageHook =: composeAll [className =? "MPlayer" --> doFloat, className =? "Gimp" --> doFloat] -- -- To add more rules to this list, you can say, for instance: -- -- > import XMonad.StackSet -- > ... -- > manageHook =+ (className =? "Emacs" --> doF kill) -- > manageHook =+ (className =? "Vim" --> doF shiftMaster) -- -- Note that operator precedence mandates the parentheses here. manageHook :: Summable ManageHook ManageHook (XConfig l) manageHook = Summable X.manageHook (\x c -> c { X.manageHook = x }) (<+>) -- | Custom X event handler. Return @All True@ if the default handler should -- also be run afterwards. Default does nothing. To add an event handler: -- -- > import XMonad.Hooks.ServerMode -- > ... -- > handleEventHook =+ serverModeEventHook handleEventHook :: Summable (Event -> X All) (Event -> X All) (XConfig l) handleEventHook = Summable X.handleEventHook (\x c -> c { X.handleEventHook = x }) (<+>) -- | List of workspaces' names. Default: @map show [1 .. 9 :: Int]@. Adding -- appends to the end: -- -- > workspaces =+ ["0"] -- -- This is useless unless you also create keybindings for this. workspaces :: Summable [String] [String] (XConfig l) workspaces = Summable X.workspaces (\x c -> c { X.workspaces = x }) (++) -- | The action to perform when the windows set is changed. This happens -- whenever focus change, a window is moved, etc. @logHook =+@ takes an @X ()@ -- and appends it via '(>>)'. For instance: -- -- > import XMonad.Hooks.ICCCMFocus -- > ... -- > logHook =+ takeTopFocus -- -- Note that if your expression is parametrically typed (e.g. of type -- @MonadIO m => m ()@), you'll need to explicitly annotate it, like so: -- -- > logHook =+ (io $ putStrLn "Hello, world!" :: X ()) logHook :: Summable (X ()) (X ()) (XConfig l) logHook = Summable X.logHook (\x c -> c { X.logHook = x }) (P.>>) -- | The action to perform on startup. @startupHook =+@ takes an @X ()@ and -- appends it via '(>>)'. For instance: -- -- > import XMonad.Hooks.SetWMName -- > ... -- > startupHook =+ setWMName "LG3D" -- -- Note that if your expression is parametrically typed (e.g. of type -- @MonadIO m => m ()@), you'll need to explicitly annotate it, as documented -- in 'logHook'. startupHook :: Summable (X ()) (X ()) (XConfig l) startupHook = Summable X.startupHook (\x c -> c { X.startupHook = x }) (P.>>) -- | The client events that xmonad is interested in. This is useful in -- combination with handleEventHook. Default: @structureNotifyMask .|. -- enterWindowMask .|. propertyChangeMask@ -- -- > clientMask =+ keyPressMask .|. keyReleaseMask clientMask :: Summable EventMask EventMask (XConfig l) clientMask = Summable X.clientMask (\x c -> c { X.clientMask = x }) (.|.) -- | The root events that xmonad is interested in. This is useful in -- combination with handleEventHook. Default: @substructureRedirectMask .|. -- substructureNotifyMask .|. enterWindowMask .|. leaveWindowMask .|. -- structureNotifyMask .|. buttonPressMask@ rootMask :: Summable EventMask EventMask (XConfig l) rootMask = Summable X.rootMask (\x c -> c { X.rootMask = x }) (.|.) -- $removables -- The following support the the @=+@ for adding items and the @=-@ operator -- for removing items. class RemovableClass r y | r -> y where -- | This lets you remove from an attribute. (=-) :: r c -> y -> Arr c c infix 0 =- data Keys c = Keys { kAdd :: [(String, X ())] -> c -> c, kRemove :: [String] -> c -> c } instance SummableClass Keys [(String, X ())] where Keys { kAdd = a } =+ newKeys = return . a newKeys instance RemovableClass Keys [String] where Keys { kRemove = r } =- sadKeys = return . r sadKeys -- | Key bindings to 'X' actions. Default: see @`man xmonad`@. 'keys' -- takes a list of keybindings specified emacs-style, as documented in -- 'XMonad.Util.EZConfig.mkKeyMap'. For example, to change the "kill window" -- key: -- -- > keys =- ["M-S-c"] -- > keys =+ [("M-M1-x", kill)] keys :: Keys (XConfig l) keys = Keys { -- Note that since checkKeymap happens on newKeys, it doesn't check for -- duplicates between repeated applications. Probably OK. (Especially since -- overriding defaults is a common behavior.) Also note that there's no -- reference cycle here. Yay! kAdd = \newKeys c -> (c `additionalKeysP` newKeys) { X.startupHook = (P.>>) (X.startupHook c) (checkKeymap c newKeys) }, kRemove = flip removeKeysP } data MouseBindings c = MouseBindings { mAdd :: [((ButtonMask, Button), Window -> X ())] -> c -> c, mRemove :: [(ButtonMask, Button)] -> c -> c } instance SummableClass MouseBindings [((ButtonMask, Button), Window -> X ())] where MouseBindings { mAdd = a } =+ newBindings = return . a newBindings instance RemovableClass MouseBindings [(ButtonMask, Button)] where MouseBindings { mRemove = r } =- sadBindings = return . r sadBindings -- | Mouse button bindings to an 'X' actions on a window. Default: see @`man -- xmonad`@. To make mod- switch workspaces: -- -- > import XMonad.Actions.CycleWS (nextWS, prevWS) -- > ... -- > mouseBindings =+ [((mod4Mask, button4), const prevWS), -- > ((mod4Mask, button5), const nextWS)] -- -- Note that you need to specify the numbered mod-mask e.g. 'mod4Mask' instead -- of just 'modMask'. mouseBindings :: MouseBindings (XConfig l) mouseBindings = MouseBindings { mAdd = flip additionalMouseBindings, mRemove = flip removeMouseBindings } -- $workspaces -- Workspaces can be configured through 'workspaces', but then the 'keys' need -- to be set, and this can be a bit laborious. 'withWorkspaces' provides a -- convenient mechanism for common workspace updates. -- | Configure workspaces through a Prime-like interface. Example: -- -- > withWorkspaces $ do -- > wsKeys =+ ["0"] -- > wsActions =+ [("M-M1-", windows . swapWithCurrent)] -- > wsSetName 1 "mail" -- -- This will set 'workspaces' and add the necessary keybindings to 'keys'. Note -- that it won't remove old keybindings; it's just not that clever. withWorkspaces :: Arr WorkspaceConfig WorkspaceConfig -> Prime l l withWorkspaces wsarr xconf = (P.>>=) (wsarr def) $ \wsconf -> wsprime wsconf xconf where wsprime :: WorkspaceConfig -> Prime l l wsprime wsconf = (workspaces =: allNames) >> (keys =+ [(mod ++ key, action name) | (name, key) <- zip allNames (wsKeys_ wsconf), (mod, action) <- wsActions_ wsconf]) where allNames = zipWith chooseName (wsNames_ wsconf) (wsKeys_ wsconf) chooseName name keyspec = if not (null name) then name else keyspec data WorkspaceConfig = WorkspaceConfig { wsNames_ :: [String], wsKeys_ :: [String], wsActions_ :: [(String, String -> X ())] } instance Default WorkspaceConfig where def = WorkspaceConfig { wsNames_ = repeat "", wsKeys_ = map (:[]) ['1'..'9'], -- The hungry monkey eats dots and turns them into numbers. wsActions_ = [("M-", windows . W.greedyView), ("M-S-", windows . W.shift)] } -- | The list of workspace names, like 'workspaces' but with two differences: -- -- 1. If any entry is the empty string, it'll be replaced with the -- corresponding entry in 'wsKeys'. -- 2. The list is truncated to the size of 'wsKeys'. -- -- The default value is @'repeat' ""@. -- -- If you'd like to create workspaces without associated keyspecs, you can do -- that afterwards, outside the 'withWorkspaces' block, with @'workspaces' =+@. wsNames :: Settable [String] WorkspaceConfig wsNames = Settable wsNames_ (\x c -> c { wsNames_ = x }) -- | The list of workspace keys. These are combined with the modifiers in -- 'wsActions' to form the keybindings for navigating to workspaces. Default: -- @["1","2",...,"9"]@. wsKeys :: Summable [String] [String] WorkspaceConfig wsKeys = Summable wsKeys_ (\x c -> c { wsKeys_ = x }) (++) -- | Mapping from key prefix to command. Its type is @[(String, String -> -- X())]@. The key prefix may be a modifier such as @\"M-\"@, or a submap -- prefix such as @\"M-a \"@, or both, as in @\"M-a M-\"@. The command is a -- function that takes a workspace name and returns an @X ()@. 'withWorkspaces' -- creates keybindings for the cartesian product of 'wsKeys' and 'wsActions'. -- -- Default: -- -- > [("M-", windows . W.greedyView), -- > ("M-S-", windows . W.shift)] wsActions :: Summable [(String, String -> X ())] [(String, String -> X ())] WorkspaceConfig wsActions = Summable wsActions_ (\x c -> c { wsActions_ = x }) (++) -- | A convenience for just modifying one entry in 'wsNames', in case you only -- want a few named workspaces. Example: -- -- > wsSetName 1 "mail" -- > wsSetName 2 "web" wsSetName :: Int -> String -> Arr WorkspaceConfig WorkspaceConfig wsSetName index newName = wsNames =. (map maybeSet . zip [0..]) where maybeSet (i, oldName) | i == (index - 1) = newName | otherwise = oldName -- $screens -- 'withScreens' provides a convenient mechanism to set keybindings for moving -- between screens, much like 'withWorkspaces'. -- | Configure screen keys through a Prime-like interface: -- -- > withScreens $ do -- > sKeys =: ["e", "r"] -- -- This will add the necessary keybindings to 'keys'. Note that it won't remove -- old keybindings; it's just not that clever. withScreens :: Arr ScreenConfig ScreenConfig -> Prime l l withScreens sarr xconf = (P.>>=) (sarr def) $ \sconf -> sprime sconf xconf where sprime :: ScreenConfig -> Prime l l sprime sconf = (keys =+ [(mod ++ key, action sid) | (sid, key) <- zip [0..] (sKeys_ sconf), (mod, action) <- sActions_ sconf]) data ScreenConfig = ScreenConfig { sKeys_ :: [String], sActions_ :: [(String, ScreenId -> X ())] } instance Default ScreenConfig where def = ScreenConfig { sKeys_ = ["w", "e", "r"], sActions_ = [("M-", windows . onScreens W.view), ("M-S-", windows . onScreens W.shift)] } -- | The list of screen keys. These are combined with the modifiers in -- 'sActions' to form the keybindings for navigating to workspaces. Default: -- @["w","e","r"]@. sKeys :: Summable [String] [String] ScreenConfig sKeys = Summable sKeys_ (\x c -> c { sKeys_ = x }) (++) -- | Mapping from key prefix to command. Its type is @[(String, ScreenId -> -- X())]@. Works the same as 'wsActions' except for a different function type. -- -- Default: -- -- > [("M-", windows . onScreens W.view), -- > ("M-S-", windows . onScreens W.shift)] sActions :: Summable [(String, ScreenId -> X ())] [(String, ScreenId -> X ())] ScreenConfig sActions = Summable sActions_ (\x c -> c { sActions_ = x }) (++) -- | Converts a stackset transformer parameterized on the workspace type into one -- parameterized on the screen type. For example, you can use @onScreens W.view -- 0@ to navigate to the workspace on the 0th screen. If the screen id is not -- recognized, the returned transformer acts as an identity function. onScreens :: Eq s => (i -> W.StackSet i l a s sd -> W.StackSet i l a s sd) -> s -> W.StackSet i l a s sd -> W.StackSet i l a s sd onScreens f sc ws = maybe id f (W.lookupWorkspace sc ws) ws -- $layout -- Layouts are special. You can't modify them using the @=:@ or @=.@ operator. -- You need to use the following functions. -- | Add a layout to the list of layouts choosable with mod-space. For instance: -- -- > import XMonad.Layout.Tabbed -- > ... -- > addLayout simpleTabbed addLayout :: (LayoutClass l Window, LayoutClass r Window) => r Window -> Prime l (Choose l r) addLayout r c = return c { X.layoutHook = X.layoutHook c ||| r } -- | Reset the layoutHook from scratch. For instance, to get rid of the wide -- layout: -- -- > resetLayout $ Tall 1 (3/100) (1/2) ||| Full -- -- (The dollar is like an auto-closing parenthesis, so all the stuff to the -- right of it is treated like an argument to resetLayout.) resetLayout :: (LayoutClass r Window) => r Window -> Prime l r resetLayout r c = return c { X.layoutHook = r } -- | Modify your 'layoutHook' with some wrapper function. You probably want to call -- this after you're done calling 'addLayout'. Example: -- -- > import XMonad.Layout.NoBorders -- > ... -- > modifyLayout smartBorders modifyLayout :: (LayoutClass r Window) => (l Window -> r Window) -> Prime l r modifyLayout f c = return c { X.layoutHook = f $ X.layoutHook c } -- $update -- Finally, there are a few contrib modules that bundle multiple attribute -- updates together. There are three types: 1) wholesale replacements for the -- default config, 2) pure functions on the config, and 3) IO actions on the -- config. The syntax for each is different. Examples: -- -- 1) To start with a 'XMonad.Config.Gnome.gnomeConfig' instead of the default, -- we use 'startWith': -- -- > import XMonad.Config.Gnome -- > ... -- > startWith gnomeConfig -- -- 2) 'XMonad.Hooks.UrgencyHook.withUrgencyHook' is a pure function, so we need -- to use 'apply': -- -- > import XMonad.Hooks.UrgencyHook -- > ... -- > apply $ withUrgencyHook dzenUrgencyHook -- -- 3) 'XMonad.Hooks.DynamicLog.xmobar' returns an @IO (XConfig l)@, so we need -- to use 'applyIO': -- -- > import XMonad.Hooks.DynamicLog -- > ... -- > applyIO xmobar -- | Replace the current 'XConfig' with the given one. If you use this, you -- probably want it to be the first line of your config. startWith :: XConfig l' -> Prime l l' startWith = const . return -- | Turns a pure function on 'XConfig' into a 'Prime'. apply :: (XConfig l -> XConfig l') -> Prime l l' apply f = return . f -- | Turns an IO function on 'XConfig' into a 'Prime'. applyIO :: (XConfig l -> IO (XConfig l')) -> Prime l l' applyIO = id -- This is here in case we want to change the Prime type later. -- $example -- As an example, I've included below a subset of my current config. Note that -- my import statements specify individual identifiers in parentheticals. -- That's optional. The default is to import the entire module. I just find it -- helpful to remind me where things came from. -- -- > {-# LANGUAGE RebindableSyntax #-} -- > import XMonad.Config.Prime -- > -- > import XMonad.Actions.CycleWS (prevWS, nextWS) -- > import XMonad.Actions.SwapWorkspaces (swapWithCurrent) -- > import XMonad.Actions.WindowNavigation (withWindowNavigation) -- > import XMonad.Layout.Fullscreen (fullscreenSupport) -- > import XMonad.Layout.NoBorders (smartBorders) -- > import XMonad.Layout.Tabbed (simpleTabbed) -- > -- > main = xmonad $ do -- > modMask =: mod4Mask -- > normalBorderColor =: "#222222" -- > terminal =: "urxvt" -- > focusFollowsMouse =: False -- > resetLayout $ Tall 1 (3/100) (1/2) ||| simpleTabbed -- > modifyLayout smartBorders -- > apply fullscreenSupport -- > applyIO $ withWindowNavigation (xK_w, xK_a, xK_s, xK_d) -- > withWorkspaces $ do -- > wsKeys =+ ["0"] -- > wsActions =+ [("M-M1-", windows . swapWithCurrent)] -- > keys =+ [ -- > ("M-,", sendMessage $ IncMasterN (-1)), -- > ("M-.", sendMessage $ IncMasterN 1), -- > ("M-M1-d", spawn "date | dzen2 -fg '#eeeeee' -p 2"), -- > ("C-S-q", return ()), -- > ("", spawn "amixer set Master 5%-"), -- > ("", spawn "amixer set Master 5%+"), -- > ("M-M1-x", kill), -- > ("M-i", prevWS), -- > ("M-o", nextWS) -- > ] -- $troubleshooting -- === Only the last line of my config seems to take effect. What gives? -- You're missing the @{-\# LANGUAGE RebindableSyntax \#-}@ line at the top. -- -- === How do I do use normal monads like 'X' or 'IO'? -- Here are a couple of ways: -- -- > import qualified Prelude as P -- > ... -- > test1, test2 :: X () -- > test1 = spawn "echo Hi" P.>> spawn "echo Bye" -- > test2 = do spawn "echo Hi" -- > spawn "echo Bye" -- > where (>>) = (P.>>) -- -- === How do I use the old keyboard syntax? -- You can use 'apply' and supply your own Haskell function. For instance: -- -- > apply $ flip additionalKeys $ [((mod1Mask, xK_z), spawn "date | dzen2 -fg '#eeeeee' -p 2")] -- -- === How do I run a command before xmonad starts (like 'spawnPipe')? -- If you're using it for a status bar, see if 'XMonad.Hooks.DynamicLog.dzen' -- or 'XMonad.Hooks.DynamicLog.xmobar' does what you want. If so, you can apply -- it with 'applyIO'. -- -- If not, you can write your own @XConfig l -> IO (XConfig l)@ and apply it -- with 'applyIO'. When writing this function, see the above tip about using -- normal monads. -- -- Alternatively, you could do something like this this: -- -- > import qualified Prelude as P (>>) -- > -- > main = -- > openFile ".xmonad.log" AppendMode >>= \log -> -- > hSetBuffering log LineBuffering P.>> -- > (xmonad $ do -- > nothing -- Prime config here. -- > ) xmonad-contrib-0.12/XMonad/Config/Gnome.hs0000644000000000000000000000507112636047674016564 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Gnome -- Copyright : (c) Spencer Janssen -- License : BSD -- -- Maintainer : Spencer Janssen -- Stability : unstable -- Portability : unportable -- -- This module provides a config suitable for use with the GNOME desktop -- environment. module XMonad.Config.Gnome ( -- * Usage -- $usage gnomeConfig, gnomeRun, gnomeRegister ) where import XMonad import XMonad.Config.Desktop import XMonad.Util.Run (safeSpawn) import qualified Data.Map as M import System.Environment (getEnvironment) -- $usage -- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Gnome -- > -- > main = xmonad gnomeConfig -- -- For examples of how to further customize @gnomeConfig@ see "XMonad.Config.Desktop". gnomeConfig = desktopConfig { terminal = "gnome-terminal" , keys = gnomeKeys <+> keys desktopConfig , startupHook = gnomeRegister >> startupHook desktopConfig } gnomeKeys (XConfig {modMask = modm}) = M.fromList $ [ ((modm, xK_p), gnomeRun) , ((modm .|. shiftMask, xK_q), spawn "gnome-session-save --kill") ] -- | Launch the "Run Application" dialog. gnome-panel must be running for this -- to work. gnomeRun :: X () gnomeRun = withDisplay $ \dpy -> do rw <- asks theRoot gnome_panel <- getAtom "_GNOME_PANEL_ACTION" panel_run <- getAtom "_GNOME_PANEL_ACTION_RUN_DIALOG" io $ allocaXEvent $ \e -> do setEventType e clientMessage setClientMessageEvent e rw gnome_panel 32 panel_run 0 sendEvent dpy rw False structureNotifyMask e sync dpy False -- | Register xmonad with gnome. 'dbus-send' must be in the $PATH with which -- xmonad is started. -- -- This action reduces a delay on startup only only if you have configured -- gnome-session>=2.26: to start xmonad with a command as such: -- -- > gconftool-2 -s /desktop/gnome/session/required_components/windowmanager xmonad --type string gnomeRegister :: MonadIO m => m () gnomeRegister = io $ do x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment whenJust x $ \sessionId -> safeSpawn "dbus-send" ["--session" ,"--print-reply=literal" ,"--dest=org.gnome.SessionManager" ,"/org/gnome/SessionManager" ,"org.gnome.SessionManager.RegisterClient" ,"string:xmonad" ,"string:"++sessionId] xmonad-contrib-0.12/XMonad/Config/Azerty.hs0000644000000000000000000000267412636047674017003 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Config.Azerty -- Copyright : (c) Devin Mullins -- License : BSD -- -- Maintainer : Devin Mullins -- Stability : stable -- Portability : unportable -- -- This module fixes some of the keybindings for the francophone among you who -- use an AZERTY keyboard layout. Config stolen from TeXitoi's config on the -- wiki. module XMonad.Config.Azerty ( -- * Usage -- $usage azertyConfig, azertyKeys ) where import XMonad import qualified XMonad.StackSet as W import qualified Data.Map as M -- $usage -- To use this module, start with the following @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad -- > import XMonad.Config.Azerty -- > -- > main = xmonad azertyConfig -- -- If you prefer, an azertyKeys function is provided which you can use as so: -- -- > import qualified Data.Map as M -- > main = xmonad someConfig { keys = \c -> azertyKeys c `M.union` keys someConfig c } azertyConfig = def { keys = azertyKeys <+> keys def } azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $ [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))] ++ [((m .|. modm, k), windows $ f i) | (i, k) <- zip (workspaces conf) [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0], (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]] xmonad-contrib-0.12/XMonad/Prompt/0000755000000000000000000000000012636047674015234 5ustar0000000000000000xmonad-contrib-0.12/XMonad/Prompt/AppLauncher.hs0000644000000000000000000000513212636047674017773 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.AppLauncher -- Copyright : (C) 2008 Luis Cabellos -- License : BSD3 -- -- Maintainer : zhen.sydow@gmail.com -- Stability : unstable -- Portability : unportable -- -- A module for launch applicationes that receive parameters in the command -- line. The launcher call a prompt to get the parameters. -- ----------------------------------------------------------------------------- module XMonad.Prompt.AppLauncher ( -- * Usage -- $usage launchApp ,module XMonad.Prompt -- * Use case: launching gimp with file -- $tip -- * Types ,Application, AppPrompt, ) where import XMonad (X(),MonadIO) import XMonad.Core (spawn) import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig(searchPredicate)) import XMonad.Prompt.Shell (getShellCompl) {- $usage This module is intended to allow the launch of the same application but changing the parameters using the user response. For example, when you want to open a image in gimp program, you can open gimp and then use the File Menu to open the image or you can use this module to select the image in the command line. We use Prompt to get the user command line. This also allow to autoexpand the names of the files when we are writing the command line. -} {- $tip First, you need to import necessary modules. Prompt is used to get the promp configuration and the AppLauncher module itself. > import XMonad.Prompt > import XMonad.Prompt.AppLauncher as AL Then you can add the bindings to the applications. > ... > , ((modm, xK_g), AL.launchApp def "gimp" ) > , ((modm, xK_g), AL.launchApp def "evince" ) > ... -} -- A customized prompt data AppPrompt = AppPrompt String instance XPrompt AppPrompt where showXPrompt (AppPrompt n) = n ++ " " type Application = String type Parameters = String {- | Given an application and its parameters, launch the application. -} launch :: MonadIO m => Application -> Parameters -> m () launch app params = spawn ( app ++ " " ++ params ) {- | Get the user's response to a prompt an launch an application using the input as command parameters of the application.-} launchApp :: XPConfig -> Application -> X () launchApp config app = mkXPrompt (AppPrompt app) config (getShellCompl [] $ searchPredicate config) $ launch app xmonad-contrib-0.12/XMonad/Prompt/Layout.hs0000644000000000000000000000345212636047674017051 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Layout -- Copyright : (C) 2007 Andrea Rossato, David Roundy -- License : BSD3 -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- A layout-selection prompt for XMonad -- ----------------------------------------------------------------------------- module XMonad.Prompt.Layout ( -- * Usage -- $usage layoutPrompt ) where import Data.List ( sort, nub ) import XMonad hiding ( workspaces ) import XMonad.Prompt import XMonad.Prompt.Workspace ( Wor(..) ) import XMonad.StackSet ( workspaces, layout ) import XMonad.Layout.LayoutCombinators ( JumpToLayout(..) ) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Layout -- -- > , ((modm .|. shiftMask, xK_m ), layoutPrompt def) -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". -- -- WARNING: This prompt won't display all possible layouts, because the -- code to enable this was rejected from xmonad core. It only displays -- layouts that are actually in use. Also, you can only select layouts if -- you are using NewSelect, rather than the Select defined in xmonad core -- (which doesn't have this feature). So all in all, this module is really -- more a proof-of-principle than something you can actually use -- productively. layoutPrompt :: XPConfig -> X () layoutPrompt c = do ls <- gets (map (description . layout) . workspaces . windowset) mkXPrompt (Wor "") c (mkComplFunFromList' $ sort $ nub ls) (sendMessage . JumpToLayout) xmonad-contrib-0.12/XMonad/Prompt/RunOrRaise.hs0000644000000000000000000000526612636047674017632 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.RunOrRaise -- Copyright : (C) 2008 Justin Bogner -- License : BSD3 -- -- Maintainer : mail@justinbogner.com -- Stability : unstable -- Portability : unportable -- -- A prompt for XMonad which will run a program, open a file, -- or raise an already running program, depending on context. -- ----------------------------------------------------------------------------- module XMonad.Prompt.RunOrRaise ( -- * Usage -- $usage runOrRaisePrompt, RunOrRaisePrompt, ) where import XMonad hiding (config) import XMonad.Prompt import XMonad.Prompt.Shell import XMonad.Actions.WindowGo (runOrRaise) import XMonad.Util.Run (runProcessWithInput) import Control.Exception as E import Control.Monad (liftM, liftM2) import System.Directory (doesDirectoryExist, doesFileExist, executable, getPermissions) econst :: Monad m => a -> IOException -> m a econst = const . return {- $usage 1. In your @~\/.xmonad\/xmonad.hs@: > import XMonad.Prompt > import XMonad.Prompt.RunOrRaise 2. In your keybindings add something like: > , ((modm .|. controlMask, xK_x), runOrRaisePrompt def) For detailed instruction on editing the key binding see "XMonad.Doc.Extending#Editing_key_bindings". -} data RunOrRaisePrompt = RRP instance XPrompt RunOrRaisePrompt where showXPrompt RRP = "Run or Raise: " runOrRaisePrompt :: XPConfig -> X () runOrRaisePrompt c = do cmds <- io getCommands mkXPrompt RRP c (getShellCompl cmds $ searchPredicate c) open open :: String -> X () open path = io (isNormalFile path) >>= \b -> if b then spawn $ "xdg-open \"" ++ path ++ "\"" else uncurry runOrRaise . getTarget $ path where isNormalFile f = exists f >>= \e -> if e then notExecutable f else return False exists f = fmap or $ sequence [doesFileExist f,doesDirectoryExist f] notExecutable = fmap (not . executable) . getPermissions getTarget x = (x,isApp x) isApp :: String -> Query Bool isApp "firefox" = className =? "Firefox-bin" <||> className =? "Firefox" isApp "thunderbird" = className =? "Thunderbird-bin" <||> className =? "Thunderbird" isApp x = liftM2 (==) pid $ pidof x pidof :: String -> Query Int pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `E.catch` econst 0 pid :: Query Int pid = ask >>= (\w -> liftX $ withDisplay $ \d -> getPID d w) where getPID d w = getAtom "_NET_WM_PID" >>= \a -> io $ liftM getPID' (getWindowProperty32 d a w) getPID' (Just (x:_)) = fromIntegral x getPID' (Just []) = -1 getPID' (Nothing) = -1 xmonad-contrib-0.12/XMonad/Prompt/Ssh.hs0000644000000000000000000000765512636047674016342 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Ssh -- Copyright : (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A ssh prompt for XMonad -- ----------------------------------------------------------------------------- module XMonad.Prompt.Ssh ( -- * Usage -- $usage sshPrompt, Ssh, ) where import XMonad import XMonad.Util.Run import XMonad.Prompt import System.Directory import System.Environment import Control.Exception as E import Control.Monad import Data.Maybe import Data.List(elemIndex) econst :: Monad m => a -> IOException -> m a econst = const . return -- $usage -- 1. In your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Ssh -- -- 2. In your keybindings add something like: -- -- > , ((modm .|. controlMask, xK_s), sshPrompt def) -- -- Keep in mind, that if you want to use the completion you have to -- disable the "HashKnownHosts" option in your ssh_config -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". data Ssh = Ssh instance XPrompt Ssh where showXPrompt Ssh = "SSH to: " commandToComplete _ c = maybe c (\(_u,h) -> h) (parseHost c) nextCompletion _t c l = maybe next (\(u,_h) -> u ++ "@" ++ next) hostPared where hostPared = parseHost c next = getNextCompletion (maybe c (\(_u,h) -> h) hostPared) l sshPrompt :: XPConfig -> X () sshPrompt c = do sc <- io sshComplList mkXPrompt Ssh c (mkComplFunFromList sc) ssh ssh :: String -> X () ssh = runInTerm "" . ("ssh " ++ ) sshComplList :: IO [String] sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal sshComplListLocal :: IO [String] sshComplListLocal = do h <- getEnv "HOME" s1 <- sshComplListFile $ h ++ "/.ssh/known_hosts" s2 <- sshComplListConf $ h ++ "/.ssh/config" return $ s1 ++ s2 sshComplListGlobal :: IO [String] sshComplListGlobal = do env <- getEnv "SSH_KNOWN_HOSTS" `E.catch` econst "/nonexistent" fs <- mapM fileExists [ env , "/usr/local/etc/ssh/ssh_known_hosts" , "/usr/local/etc/ssh_known_hosts" , "/etc/ssh/ssh_known_hosts" , "/etc/ssh_known_hosts" ] case catMaybes fs of [] -> return [] (f:_) -> sshComplListFile' f sshComplListFile :: String -> IO [String] sshComplListFile kh = do f <- doesFileExist kh if f then sshComplListFile' kh else return [] sshComplListFile' :: String -> IO [String] sshComplListFile' kh = do l <- readFile kh return $ map (getWithPort . takeWhile (/= ',') . concat . take 1 . words) $ filter nonComment $ lines l sshComplListConf :: String -> IO [String] sshComplListConf kh = do f <- doesFileExist kh if f then sshComplListConf' kh else return [] sshComplListConf' :: String -> IO [String] sshComplListConf' kh = do l <- readFile kh return $ map (!!1) $ filter isHost $ map words $ lines l where isHost ws = take 1 ws == ["Host"] && length ws > 1 fileExists :: String -> IO (Maybe String) fileExists kh = do f <- doesFileExist kh if f then return $ Just kh else return Nothing nonComment :: String -> Bool nonComment [] = False nonComment ('#':_) = False nonComment ('|':_) = False -- hashed, undecodeable nonComment _ = True getWithPort :: String -> String getWithPort ('[':str) = host ++ " -p " ++ port where (host,p) = break (==']') str port = case p of ']':':':x -> x _ -> "22" getWithPort str = str parseHost :: String -> Maybe (String, String) parseHost a = elemIndex '@' a >>= (\c-> Just ( (take c a), (drop (c+1) a) ) ) xmonad-contrib-0.12/XMonad/Prompt/Theme.hs0000644000000000000000000000313412636047674016633 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Theme -- Copyright : (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A prompt for changing the theme of the current workspace ----------------------------------------------------------------------------- module XMonad.Prompt.Theme ( -- * Usage -- $usage themePrompt, ThemePrompt, ) where import Control.Arrow ( (&&&) ) import qualified Data.Map as M import Data.Maybe ( fromMaybe ) import XMonad import XMonad.Prompt import XMonad.Layout.Decoration import XMonad.Util.Themes -- $usage -- You can use this module with the following in your -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Theme -- -- in your keybindings add: -- -- > , ((modm .|. controlMask, xK_t), themePrompt def) -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". data ThemePrompt = ThemePrompt instance XPrompt ThemePrompt where showXPrompt ThemePrompt = "Select a theme: " commandToComplete _ c = c nextCompletion _ = getNextCompletion themePrompt :: XPConfig -> X () themePrompt c = mkXPrompt ThemePrompt c (mkComplFunFromList' . map ppThemeInfo $ listOfThemes) changeTheme where changeTheme t = sendMessage . SetTheme . fromMaybe def $ M.lookup t mapOfThemes mapOfThemes :: M.Map String Theme mapOfThemes = M.fromList . uncurry zip . (map ppThemeInfo &&& map theme) $ listOfThemes xmonad-contrib-0.12/XMonad/Prompt/AppendFile.hs0000644000000000000000000000507712636047674017610 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.AppendFile -- Copyright : (c) 2007 Brent Yorgey -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : stable -- Portability : unportable -- -- A prompt for appending a single line of text to a file. Useful for -- keeping a file of notes, things to remember for later, and so on--- -- using a keybinding, you can write things down just about as quickly -- as you think of them, so it doesn't have to interrupt whatever else -- you're doing. -- -- Who knows, it might be useful for other purposes as well! -- ----------------------------------------------------------------------------- module XMonad.Prompt.AppendFile ( -- * Usage -- $usage appendFilePrompt, AppendFile, ) where import XMonad.Core import XMonad.Prompt import System.IO import Control.Exception.Extensible (bracket) -- $usage -- -- You can use this module by importing it, along with -- "XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.AppendFile -- -- and adding an appropriate keybinding, for example: -- -- > , ((modm .|. controlMask, xK_n), appendFilePrompt def "/home/me/NOTES") -- -- Additional notes can be added via regular Haskell or XMonad functions; for -- example, to preface notes with the time they were made, one could write a -- binding like -- -- > , ((modm .|. controlMask, xK_n), do -- > spawn ("date>>"++"/home/me/NOTES") -- > appendFilePrompt def "/home/me/NOTES" -- > ) -- -- (Put the spawn on the line after the prompt to append the time instead.) -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". data AppendFile = AppendFile FilePath instance XPrompt AppendFile where showXPrompt (AppendFile fn) = "Add to " ++ fn ++ ": " -- | Given an XPrompt configuration and a file path, prompt the user -- for a line of text, and append it to the given file. appendFilePrompt :: XPConfig -> FilePath -> X () appendFilePrompt c fn = mkXPrompt (AppendFile fn) c (const (return [])) (doAppend fn) -- | Append a string to a file. doAppend :: FilePath -> String -> X () doAppend fn = io . bracket (openFile fn AppendMode) hClose . flip hPutStrLn xmonad-contrib-0.12/XMonad/Prompt/Pass.hs0000644000000000000000000001275412636047674016507 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Pass -- Copyright : (c) 2014 Igor Babuschkin, Antoine R. Dumont -- License : BSD3-style (see LICENSE) -- -- Maintainer : Antoine R. Dumont -- Stability : unstable -- Portability : unportable -- -- This module provides 3 to ease passwords manipulation (generate, read, remove): -- -- - one to lookup passwords in the password-storage. -- -- - one to generate a password for a given password label that the user inputs. -- -- - one to delete a stored password for a given password label that the user inputs. -- -- All those prompts benefit from the completion system provided by the module . -- -- The password store is setuped through an environment variable PASSWORD_STORE_DIR. -- If this is set, use the content of the variable. -- Otherwise, the password store is located on user's home @$HOME\/.password-store@. -- -- -- Source: -- -- - The password storage implementation is . -- -- - Inspired from -- ----------------------------------------------------------------------------- module XMonad.Prompt.Pass ( -- * Usages -- $usages passPrompt , passGeneratePrompt , passRemovePrompt ) where import Control.Monad (liftM) import XMonad.Core import XMonad.Prompt ( XPrompt , showXPrompt , commandToComplete , nextCompletion , getNextCompletion , XPConfig , mkXPrompt , mkComplFunFromList) import System.Directory (getHomeDirectory) import System.FilePath (takeExtension, dropExtension, combine) import System.Posix.Env (getEnv) import XMonad.Util.Run (runProcessWithInput) -- $usages -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Prompt.Pass -- -- Then add a keybinding for 'passPrompt', 'passGeneratePrompt' or 'passRemovePrompt': -- -- > , ((modMask x , xK_p) , passPrompt xpconfig) -- > , ((modMask x .|. controlMask, xK_p) , passGeneratePrompt xpconfig) -- > , ((modMask x .|. controlMask .|. shiftMask, xK_p), passRemovePrompt xpconfig) -- -- For detailed instructions on: -- -- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". -- -- - how to setup the password storage, see -- type PromptLabel = String data Pass = Pass PromptLabel instance XPrompt Pass where showXPrompt (Pass prompt) = prompt ++ ": " commandToComplete _ c = c nextCompletion _ = getNextCompletion -- | Default password store folder in $HOME/.password-store -- passwordStoreFolderDefault :: String -> String passwordStoreFolderDefault home = combine home ".password-store" -- | Compute the password store's location. -- Use the PASSWORD_STORE_DIR environment variable to set the password store. -- If empty, return the password store located in user's home. -- passwordStoreFolder :: IO String passwordStoreFolder = getEnv "PASSWORD_STORE_DIR" >>= computePasswordStoreDir where computePasswordStoreDir Nothing = liftM passwordStoreFolderDefault getHomeDirectory computePasswordStoreDir (Just storeDir) = return storeDir -- | A pass prompt factory -- mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X () mkPassPrompt promptLabel passwordFunction xpconfig = do passwords <- io (passwordStoreFolder >>= getPasswords) mkXPrompt (Pass promptLabel) xpconfig (mkComplFunFromList passwords) passwordFunction -- | A prompt to retrieve a password from a given entry. -- passPrompt :: XPConfig -> X () passPrompt = mkPassPrompt "Select password" selectPassword -- | A prompt to generate a password for a given entry. -- This can be used to override an already stored entry. -- (Beware that no confirmation is asked) -- passGeneratePrompt :: XPConfig -> X () passGeneratePrompt = mkPassPrompt "Generate password" generatePassword -- | A prompt to remove a password for a given entry. -- (Beware that no confirmation is asked) -- passRemovePrompt :: XPConfig -> X () passRemovePrompt = mkPassPrompt "Remove password" removePassword -- | Select a password. -- selectPassword :: String -> X () selectPassword passLabel = spawn $ "pass --clip " ++ passLabel -- | Generate a 30 characters password for a given entry. -- If the entry already exists, it is updated with a new password. -- generatePassword :: String -> X () generatePassword passLabel = spawn $ "pass generate --force " ++ passLabel ++ " 30" -- | Remove a password stored for a given entry. -- removePassword :: String -> X () removePassword passLabel = spawn $ "pass rm --force " ++ passLabel -- | Retrieve the list of passwords from the password storage 'passwordStoreDir getPasswords :: FilePath -> IO [String] getPasswords passwordStoreDir = do files <- runProcessWithInput "find" [ passwordStoreDir, "-type", "f", "-name", "*.gpg", "-printf", "%P\n"] [] return $ map removeGpgExtension $ lines files removeGpgExtension :: String -> String removeGpgExtension file | takeExtension file == ".gpg" = dropExtension file | otherwise = file xmonad-contrib-0.12/XMonad/Prompt/Input.hs0000644000000000000000000001076712636047674016702 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Input -- Copyright : (c) 2007 Brent Yorgey -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : stable -- Portability : unportable -- -- A generic framework for prompting the user for input and passing it -- along to some other action. -- ----------------------------------------------------------------------------- module XMonad.Prompt.Input ( -- * Usage -- $usage inputPrompt, inputPromptWithCompl, (?+), InputPrompt, ) where import XMonad.Core import XMonad.Prompt -- $usage -- -- To use this module, import it along with "XMonad.Prompt": -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Input -- -- This module provides no useful functionality in isolation, but -- is intended for use in building other actions which require user -- input. -- -- For example, suppose Mr. Big wants a way to easily fire his -- employees. We'll assume that he already has a function -- -- > fireEmployee :: String -> X () -- -- which takes as input the name of an employee, and fires them. He -- just wants a convenient way to provide the input for this function -- from within xmonad. Here is where the "XMonad.Prompt.Input" module -- comes into play. He can use the 'inputPrompt' function to create a -- prompt, and the '?+' operator to compose the prompt with the -- @fireEmployee@ action, like so: -- -- > firingPrompt :: X () -- > firingPrompt = inputPrompt defaultXPConfig "Fire" ?+ fireEmployee -- -- If @employees@ contains a list of all his employees, he could also -- create an autocompleting version, like this: -- -- > firingPrompt' = inputPromptWithCompl defaultXPConfig "Fire" -- > (mkComplFunFromList employees) ?+ fireEmployee -- -- Now all he has to do is add a keybinding to @firingPrompt@ (or -- @firingPrompt'@), such as -- -- > , ((modm .|. controlMask, xK_f), firingPrompt) -- -- Now when Mr. Big hits mod-ctrl-f, a prompt will pop up saying -- \"Fire: \", waiting for him to type the name of someone to fire. -- If he thinks better of it after hitting mod-ctrl-f and cancels the -- prompt (e.g. by hitting Esc), the @fireEmployee@ action will not be -- invoked. -- -- (For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings".) -- -- "XMonad.Prompt.Input" is also intended to ease the process of -- developing other modules which require user input. For an example -- of a module developed using this functionality, see -- "XMonad.Prompt.Email", which prompts the user for a recipient, -- subject, and one-line body, and sends a quick email. data InputPrompt = InputPrompt String instance XPrompt InputPrompt where showXPrompt (InputPrompt s) = s ++ ": " -- | Given a prompt configuration and some prompt text, create an X -- action which pops up a prompt waiting for user input, and returns -- whatever they type. Note that the type of the action is @X -- (Maybe String)@, which reflects the fact that the user might -- cancel the prompt (resulting in @Nothing@), or enter an input -- string @s@ (resulting in @Just s@). inputPrompt :: XPConfig -> String -> X (Maybe String) inputPrompt c p = inputPromptWithCompl c p (const (return [])) -- | The same as 'inputPrompt', but with a completion function. The -- type @ComplFunction@ is @String -> IO [String]@, as defined in -- "XMonad.Prompt". The 'mkComplFunFromList' utility function, also -- defined in "XMonad.Prompt", is useful for creating such a -- function from a known list of possibilities. inputPromptWithCompl :: XPConfig -> String -> ComplFunction -> X (Maybe String) inputPromptWithCompl c p compl = mkXPromptWithReturn (InputPrompt p) c compl return infixr 1 ?+ -- | A combinator for hooking up an input prompt action to a function -- which can take the result of the input prompt and produce another -- action. If the user cancels the input prompt, the -- second function will not be run. -- -- The astute student of types will note that this is actually a -- very general combinator and has nothing in particular to do -- with input prompts. If you find a more general use for it and -- want to move it to a different module, be my guest. (?+) :: (Monad m) => m (Maybe a) -> (a -> m ()) -> m () x ?+ k = x >>= maybe (return ()) k xmonad-contrib-0.12/XMonad/Prompt/Window.hs0000644000000000000000000000634512636047674017047 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Window -- Copyright : Devin Mullins -- Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Devin Mullins -- Andrea Rossato -- Stability : unstable -- Portability : unportable -- -- xprompt operations to bring windows to you, and bring you to windows. -- ----------------------------------------------------------------------------- module XMonad.Prompt.Window ( -- * Usage -- $usage windowPromptGoto, windowPromptBring, windowPromptBringCopy, WindowPrompt, ) where import qualified Data.Map as M import qualified XMonad.StackSet as W import XMonad import XMonad.Prompt import XMonad.Actions.CopyWindow import XMonad.Actions.WindowBringer -- $usage -- WindowPrompt brings windows to you and you to windows. -- That is to say, it pops up a prompt with window names, in case you forgot -- where you left your XChat. -- -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Window -- -- and in the keys definition: -- -- > , ((modm .|. shiftMask, xK_g ), windowPromptGoto def) -- > , ((modm .|. shiftMask, xK_b ), windowPromptBring def) -- -- The autoComplete option is a handy complement here: -- -- > , ((modm .|. shiftMask, xK_g ), windowPromptGoto -- > def { autoComplete = Just 500000 } ) -- -- The \'500000\' is the number of microseconds to pause before sending you to -- your new window. This is useful so that you don't accidentally send some -- keystrokes to the selected client. -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". data WindowPrompt = Goto | Bring | BringCopy instance XPrompt WindowPrompt where showXPrompt Goto = "Go to window: " showXPrompt Bring = "Bring window: " showXPrompt BringCopy = "Bring a copy: " commandToComplete _ c = c nextCompletion _ = getNextCompletion windowPromptGoto, windowPromptBring, windowPromptBringCopy :: XPConfig -> X () windowPromptGoto = doPrompt Goto windowPromptBring = doPrompt Bring windowPromptBringCopy = doPrompt BringCopy -- | Pops open a prompt with window titles. Choose one, and you will be -- taken to the corresponding workspace. doPrompt :: WindowPrompt -> XPConfig -> X () doPrompt t c = do a <- case t of Goto -> fmap gotoAction windowMap Bring -> fmap bringAction windowMap BringCopy -> fmap bringCopyAction windowMap wm <- windowMap mkXPrompt t c (compList wm) a where winAction a m = flip whenJust (windows . a) . flip M.lookup m gotoAction = winAction W.focusWindow bringAction = winAction bringWindow bringCopyAction = winAction bringCopyWindow compList m s = return . filter (searchPredicate c s) . map fst . M.toList $ m -- | Brings a copy of the specified window into the current workspace. bringCopyWindow :: Window -> WindowSet -> WindowSet bringCopyWindow w ws = copyWindow w (W.currentTag ws) ws xmonad-contrib-0.12/XMonad/Prompt/XMonad.hs0000644000000000000000000000307612636047674016764 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.XMonad -- Copyright : (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : andrea.rossato@unibz.it -- Stability : unstable -- Portability : unportable -- -- A prompt for running XMonad commands -- ----------------------------------------------------------------------------- module XMonad.Prompt.XMonad ( -- * Usage -- $usage xmonadPrompt, xmonadPromptC, XMonad, ) where import XMonad import XMonad.Prompt import XMonad.Actions.Commands (defaultCommands) import Data.Maybe (fromMaybe) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.XMonad -- -- in your keybindings add: -- -- > , ((modm .|. controlMask, xK_x), xmonadPrompt def) -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". data XMonad = XMonad instance XPrompt XMonad where showXPrompt XMonad = "XMonad: " xmonadPrompt :: XPConfig -> X () xmonadPrompt c = do cmds <- defaultCommands xmonadPromptC cmds c -- | An xmonad prompt with a custom command list xmonadPromptC :: [(String, X ())] -> XPConfig -> X () xmonadPromptC commands c = mkXPrompt XMonad c (mkComplFunFromList' (map fst commands)) $ fromMaybe (return ()) . (`lookup` commands) xmonad-contrib-0.12/XMonad/Prompt/Shell.hs0000644000000000000000000001345412636047674016646 0ustar0000000000000000{- | Module : XMonad.Prompt.Shell Copyright : (C) 2007 Andrea Rossato License : BSD3 Maintainer : andrea.rossato@unibz.it Stability : unstable Portability : unportable A shell prompt for XMonad -} module XMonad.Prompt.Shell ( -- * Usage -- $usage Shell (..) , shellPrompt -- ** Variations on shellPrompt -- $spawns , prompt , safePrompt , unsafePrompt -- * Utility functions , getCommands , getBrowser , getEditor , getShellCompl , split ) where import Codec.Binary.UTF8.String (encodeString) import Control.Exception as E import Control.Monad (forM) import Data.Char (toLower) import Data.List (isPrefixOf, sortBy) import System.Directory (getDirectoryContents) import System.Environment (getEnv) import System.Posix.Files (getFileStatus, isDirectory) import XMonad hiding (config) import XMonad.Prompt import XMonad.Util.Run econst :: Monad m => a -> IOException -> m a econst = const . return {- $usage 1. In your @~\/.xmonad\/xmonad.hs@: > import XMonad.Prompt > import XMonad.Prompt.Shell 2. In your keybindings add something like: > , ((modm .|. controlMask, xK_x), shellPrompt def) For detailed instruction on editing the key binding see "XMonad.Doc.Extending#Editing_key_bindings". -} data Shell = Shell type Predicate = String -> String -> Bool instance XPrompt Shell where showXPrompt Shell = "Run: " completionToCommand _ = escape shellPrompt :: XPConfig -> X () shellPrompt c = do cmds <- io getCommands mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) spawn {- $spawns See safe and unsafeSpawn in "XMonad.Util.Run". prompt is an alias for unsafePrompt; safePrompt and unsafePrompt work on the same principles, but will use XPrompt to interactively query the user for input; the appearance is set by passing an XPConfig as the second argument. The first argument is the program to be run with the interactive input. You would use these like this: > , ((modm, xK_b), safePrompt "firefox" greenXPConfig) > , ((modm .|. shiftMask, xK_c), prompt ("xterm" ++ " -e") greenXPConfig) Note that you want to use safePrompt for Firefox input, as Firefox wants URLs, and unsafePrompt for the XTerm example because this allows you to easily start a terminal executing an arbitrary command, like 'top'. -} prompt, unsafePrompt, safePrompt :: FilePath -> XPConfig -> X () prompt = unsafePrompt safePrompt c config = mkXPrompt Shell config (getShellCompl [c] $ searchPredicate config) run where run = safeSpawn c . return unsafePrompt c config = mkXPrompt Shell config (getShellCompl [c] $ searchPredicate config) run where run a = unsafeSpawn $ c ++ " " ++ a getShellCompl :: [String] -> Predicate -> String -> IO [String] getShellCompl cmds p s | s == "" || last s == ' ' = return [] | otherwise = do f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file -- " ++ s ++ "\n") files <- case f of [x] -> do fs <- getFileStatus (encodeString x) if isDirectory fs then return [x ++ "/"] else return [x] _ -> return f return . sortBy typedFirst . uniqSort $ files ++ commandCompletionFunction cmds p s where typedFirst x y | x `startsWith` s && not (y `startsWith` s) = LT | y `startsWith` s && not (x `startsWith` s) = GT | otherwise = x `compare` y startsWith str ps = isPrefixOf (map toLower ps) (map toLower str) commandCompletionFunction :: [String] -> Predicate -> String -> [String] commandCompletionFunction cmds p str | '/' `elem` str = [] | otherwise = filter (p str) cmds getCommands :: IO [String] getCommands = do p <- getEnv "PATH" `E.catch` econst [] let ds = filter (/= "") $ split ':' p es <- forM ds $ \d -> getDirectoryContents d `E.catch` econst [] return . uniqSort . filter ((/= '.') . head) . concat $ es split :: Eq a => a -> [a] -> [[a]] split _ [] = [] split e l = f : split e (rest ls) where (f,ls) = span (/=e) l rest s | s == [] = [] | otherwise = tail s escape :: String -> String escape [] = "" escape (x:xs) | isSpecialChar x = '\\' : x : escape xs | otherwise = x : escape xs isSpecialChar :: Char -> Bool isSpecialChar = flip elem " &\\@\"'#?$*()[]{};" -- | Ask the shell environment for the value of a variable in XMonad's environment, with a default value. -- In order to /set/ an environment variable (eg. combine with a prompt so you can modify @$HTTP_PROXY@ dynamically), -- you need to use 'System.Posix.putEnv'. env :: String -> String -> IO String env variable fallthrough = getEnv variable `E.catch` econst fallthrough {- | Ask the shell what browser the user likes. If the user hasn't defined any $BROWSER, defaults to returning \"firefox\", since that seems to be the most common X web browser. Note that if you don't specify a GUI browser but a textual one, that'll be a problem as 'getBrowser' will be called by functions expecting to be able to just execute the string or pass it to a shell; so in that case, define $BROWSER as something like \"xterm -e elinks\" or as the name of a shell script doing much the same thing. -} getBrowser :: IO String getBrowser = env "BROWSER" "firefox" -- | Like 'getBrowser', but should be of a text editor. This gets the $EDITOR variable, defaulting to \"emacs\". getEditor :: IO String getEditor = env "EDITOR" "emacs" xmonad-contrib-0.12/XMonad/Prompt/Directory.hs0000644000000000000000000000235512636047674017541 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Directory -- Copyright : (C) 2007 Andrea Rossato, David Roundy -- License : BSD3 -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- A directory prompt for XMonad -- ----------------------------------------------------------------------------- module XMonad.Prompt.Directory ( -- * Usage -- $usage directoryPrompt, Dir, ) where import XMonad import XMonad.Prompt import XMonad.Util.Run ( runProcessWithInput ) -- $usage -- For an example usage see "XMonad.Layout.WorkspaceDir" data Dir = Dir String instance XPrompt Dir where showXPrompt (Dir x) = x directoryPrompt :: XPConfig -> String -> (String -> X ()) -> X () directoryPrompt c prom = mkXPrompt (Dir prom) c getDirCompl getDirCompl :: String -> IO [String] getDirCompl s = (filter notboring . lines) `fmap` runProcessWithInput "bash" [] ("compgen -A directory " ++ s ++ "\n") notboring :: String -> Bool notboring ('.':'.':_) = True notboring ('.':_) = False notboring _ = True xmonad-contrib-0.12/XMonad/Prompt/ConfirmPrompt.hs0000644000000000000000000000363712636047674020400 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.ConfirmPrompt -- Copyright : (C) 2015 Antoine Beaupré -- License : BSD3 -- -- Maintainer : Antoine Beaupré -- Stability : unstable -- Portability : unportable -- -- A module for setting up simple confirmation prompts for keybindings. -- ----------------------------------------------------------------------------- module XMonad.Prompt.ConfirmPrompt (confirmPrompt -- * Usage -- $usage , module XMonad.Prompt -- * Use case: confirming exit -- $tip , EnterPrompt ) where import XMonad (X) import XMonad.Prompt (XPConfig, XPrompt, showXPrompt, mkXPrompt, mkComplFunFromList) {- $usage This module makes it easy to add a confirmation prompt for specific actions. Instead of just running the action, a simple confirmation prompt will be created using 'XMonad.Prompt' primitives. The action will then run normally if the user confirms. -} {- $tip This should be used something like this: > ... > , ((modm , xK_l), confirmPrompt defaultXPConfig "exit" $ io (exitWith ExitSuccess)) > ... -} {- | Customized 'XPrompt' prompt that will ask to confirm the given string -} data EnterPrompt = EnterPrompt String instance XPrompt EnterPrompt where showXPrompt (EnterPrompt n) = "Confirm " ++ n ++ " (esc/ENTER)" {- | Prompt the user to confirm a given action. We offer no completion and simply ask to confirm (ENTER) or cancel (ESCAPE). The actual key handling is done by mkXPrompt.-} confirmPrompt :: XPConfig -> String -> X() -> X() confirmPrompt config app func = mkXPrompt (EnterPrompt app) config (mkComplFunFromList []) $ const func xmonad-contrib-0.12/XMonad/Prompt/Workspace.hs0000644000000000000000000000304312636047674017526 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Workspace -- Copyright : (C) 2007 Andrea Rossato, David Roundy -- License : BSD3 -- -- Maintainer : -- Stability : unstable -- Portability : unportable -- -- A workspace prompt for XMonad -- ----------------------------------------------------------------------------- module XMonad.Prompt.Workspace ( -- * Usage -- $usage workspacePrompt, -- * For developers Wor(Wor), ) where import XMonad hiding ( workspaces ) import XMonad.Prompt import XMonad.StackSet ( workspaces, tag ) import XMonad.Util.WorkspaceCompare ( getSortByIndex ) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Workspace -- -- > , ((modm .|. shiftMask, xK_m ), workspacePrompt def (windows . W.shift)) -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". data Wor = Wor String instance XPrompt Wor where showXPrompt (Wor x) = x workspacePrompt :: XPConfig -> (String -> X ()) -> X () workspacePrompt c job = do ws <- gets (workspaces . windowset) sort <- getSortByIndex let ts = map tag $ sort ws mkXPrompt (Wor "") c (mkComplFunFromList' ts) job xmonad-contrib-0.12/XMonad/Prompt/Email.hs0000644000000000000000000000412712636047674016623 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Email -- Copyright : (c) 2007 Brent Yorgey -- License : BSD-style (see LICENSE) -- -- Maintainer : -- Stability : stable -- Portability : unportable -- -- A prompt for sending quick, one-line emails, via the standard GNU -- \'mail\' utility (which must be in your $PATH). This module is -- intended mostly as an example of using "XMonad.Prompt.Input" to -- build an action requiring user input. -- ----------------------------------------------------------------------------- module XMonad.Prompt.Email ( -- * Usage -- $usage emailPrompt ) where import XMonad.Core import XMonad.Util.Run import XMonad.Prompt import XMonad.Prompt.Input -- $usage -- -- You can use this module by importing it, along with -- "XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Email -- -- and adding an appropriate keybinding, for example: -- -- > , ((modm .|. controlMask, xK_e), emailPrompt def addresses) -- -- where @addresses@ is a list of email addresses that should -- autocomplete, for example: -- -- > addresses = ["me@me.com", "mr@big.com", "tom.jones@foo.bar"] -- -- You can still send email to any address, but sending to these -- addresses will be faster since you only have to type a few -- characters and then hit \'tab\'. -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- | Prompt the user for a recipient, subject, and body, and send an -- email via the GNU \'mail\' utility. The second argument is a list -- of addresses for autocompletion. emailPrompt :: XPConfig -> [String] -> X () emailPrompt c addrs = inputPromptWithCompl c "To" (mkComplFunFromList addrs) ?+ \to -> inputPrompt c "Subject" ?+ \subj -> inputPrompt c "Body" ?+ \body -> runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n") >> return () xmonad-contrib-0.12/XMonad/Prompt/DirExec.hs0000644000000000000000000000730212636047674017115 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.DirExec -- Copyright : (C) 2008 Juraj Hercek -- License : BSD3 -- -- Maintainer : juhe_xmonad@hck.sk -- Stability : unstable -- Portability : unportable -- -- A directory file executables prompt for XMonad. This might be useful if you -- don't want to have scripts in your PATH environment variable (same -- executable names, different behavior) - otherwise you might want to use -- "XMonad.Prompt.Shell" instead - but you want to have easy access to these -- executables through the xmonad's prompt. -- ----------------------------------------------------------------------------- module XMonad.Prompt.DirExec ( -- * Usage -- $usage dirExecPrompt , dirExecPromptNamed , DirExec ) where import Control.Exception as E import System.Directory import Control.Monad import Data.List import XMonad import XMonad.Prompt econst :: Monad m => a -> IOException -> m a econst = const . return -- $usage -- 1. In your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Prompt.DirExec -- -- 2. In your keybindings add something like: -- -- > , ("M-C-x", dirExecPrompt def spawn "/home/joe/.scipts") -- -- or -- -- > , ("M-C-x", dirExecPromptNamed def spawn -- > "/home/joe/.scripts" "My Scripts: ") -- -- or add this after your default bindings: -- -- > ++ -- > [ ("M-x " ++ key, dirExecPrompt def fn "/home/joe/.scripts") -- > | (key, fn) <- [ ("x", spawn), ("M-x", runInTerm "-hold") ] -- > ] -- > ++ -- -- The first alternative uses the last element of the directory path for -- a name of prompt. The second alternative uses the provided string -- for the name of the prompt. The third alternative defines 2 key bindings, -- first one spawns the program by shell, second one runs the program in -- terminal -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". data DirExec = DirExec String instance XPrompt DirExec where showXPrompt (DirExec name) = name -- | Function 'dirExecPrompt' starts the prompt with list of all executable -- files in directory specified by 'FilePath'. The name of the prompt is taken -- from the last element of the path. If you specify root directory - @\/@ - as -- the path, name @Root:@ will be used as the name of the prompt instead. The -- 'XPConfig' parameter can be used to customize visuals of the prompt. -- The runner parameter specifies the function used to run the program - see -- usage for more information dirExecPrompt :: XPConfig -> (String -> X ()) -> FilePath -> X () dirExecPrompt cfg runner path = do let name = (++ ": ") . last . (["Root"] ++) -- handling of "/" path parameter . words . map (\x -> if x == '/' then ' ' else x) $ path dirExecPromptNamed cfg runner path name -- | Function 'dirExecPromptNamed' does the same as 'dirExecPrompt' except -- the name of the prompt is specified by 'String' parameter. dirExecPromptNamed :: XPConfig -> (String -> X ()) -> FilePath -> String -> X () dirExecPromptNamed cfg runner path name = do let path' = path ++ "/" cmds <- io $ getDirectoryExecutables path' mkXPrompt (DirExec name) cfg (compList cmds) (runner . (path' ++)) where compList cmds s = return . filter (isInfixOf s) $ cmds getDirectoryExecutables :: FilePath -> IO [String] getDirectoryExecutables path = (getDirectoryContents path >>= filterM (\x -> let x' = path ++ x in liftM2 (&&) (doesFileExist x') (liftM executable (getPermissions x')))) `E.catch` econst [] xmonad-contrib-0.12/XMonad/Prompt/Man.hs0000644000000000000000000000675512636047674016320 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : XMonad.Prompt.Man -- Copyright : (c) 2007 Valery V. Vorotyntsev -- License : BSD3-style (see LICENSE) -- -- Maintainer : Valery V. Vorotyntsev -- Portability : non-portable (uses "manpath" and "bash") -- -- A manual page prompt for XMonad window manager. -- -- TODO -- -- * narrow completions by section number, if the one is specified -- (like @\/etc\/bash_completion@ does) ----------------------------------------------------------------------------- module XMonad.Prompt.Man ( -- * Usage -- $usage manPrompt , getCommandOutput , Man ) where import XMonad import XMonad.Prompt import XMonad.Util.Run import XMonad.Prompt.Shell (split) import System.Directory import System.Process import System.IO import qualified Control.Exception.Extensible as E import Control.Monad import Data.List import Data.Maybe -- $usage -- 1. In your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Prompt -- > import XMonad.Prompt.Man -- -- 2. In your keybindings add something like: -- -- > , ((modm, xK_F1), manPrompt def) -- -- For detailed instruction on editing the key binding see -- "XMonad.Doc.Extending#Editing_key_bindings". data Man = Man instance XPrompt Man where showXPrompt Man = "Manual page: " -- | Query for manual page to be displayed. manPrompt :: XPConfig -> X () manPrompt c = do mans <- io getMans mkXPrompt Man c (manCompl mans) $ runInTerm "" . (++) "man " getMans :: IO [String] getMans = do paths <- do let getout cmd = getCommandOutput cmd `E.catch` \E.SomeException{} -> return "" -- one of these combinations should give some output p1 <- getout "manpath -g 2>/dev/null" p2 <- getout "manpath 2>/dev/null" return $ intercalate ":" $ lines $ p1 ++ p2 let sects = ["man" ++ show n | n <- [1..9 :: Int]] dirs = [d ++ "/" ++ s | d <- split ':' paths, s <- sects] mans <- forM (nub dirs) $ \d -> do exists <- doesDirectoryExist d if exists then map (stripExt . stripSuffixes [".gz", ".bz2"]) `fmap` getDirectoryContents d else return [] return $ uniqSort $ concat mans manCompl :: [String] -> String -> IO [String] manCompl mans s | s == "" || last s == ' ' = return [] | otherwise = do -- XXX readline instead of bash's compgen? f <- lines `fmap` getCommandOutput ("bash -c 'compgen -A file " ++ s ++ "'") mkComplFunFromList (f ++ mans) s -- | Run a command using shell and return its output. -- -- XXX Merge into 'XMonad.Util.Run'? -- -- (Ask \"gurus\" whether @evaluate (length ...)@ approach is -- better\/more idiomatic.) getCommandOutput :: String -> IO String getCommandOutput s = do -- we can ignore the process handle because we ignor SIGCHLD (pin, pout, perr, _) <- runInteractiveCommand s hClose pin output <- hGetContents pout E.evaluate (length output) hClose perr return output stripExt :: String -> String stripExt = reverse . drop 1 . dropWhile (/= '.') . reverse stripSuffixes :: Eq a => [[a]] -> [a] -> [a] stripSuffixes sufs fn = head . catMaybes $ map (flip rstrip fn) sufs ++ [Just fn] rstrip :: Eq a => [a] -> [a] -> Maybe [a] rstrip suf lst | suf `isSuffixOf` lst = Just $ take (length lst - length suf) lst | otherwise = Nothing xmonad-contrib-0.12/tests/0000755000000000000000000000000012636047674013727 5ustar0000000000000000xmonad-contrib-0.12/tests/genMain.hs0000644000000000000000000000501312636047674015640 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} {- | generate another Main from all modules in the current directory, extracting all functions with @prop_@. Usage (your QuickCheck-1 version may vary): > ln -s ../../xmonad/tests/Properties.hs . > runghc genMain.hs > Main.hs > ghc -DTESTING -i.. -i. -package QuickCheck-1.2.0.0 Main.hs -e ':main 200' -} module Main where import Control.Monad.List import Data.Char import Data.IORef import Data.List import qualified Data.Set as S import System.Directory import System.FilePath import Text.PrettyPrint.HughesPJ main = do imports <- newIORef S.empty props <- runListT $ do f @ ((isUpper -> True) : (takeExtension -> ".hs")) <- ListT (getDirectoryContents ".") guard $ f `notElem` ["Main.hs", "Common.hs", "Properties.hs"] let b = takeBaseName f nesting <- io $ newIORef 0 decl : _ <- ListT $ (map words . lines) `fmap` readFile f case decl of "{-" -> io $ modifyIORef nesting succ "-}" -> io $ modifyIORef nesting pred _ -> return () 0 <- io $ readIORef nesting guard $ "prop_" `isPrefixOf` decl io $ modifyIORef imports (S.insert b) return (b ++ "." ++ decl) imports <- S.toList `fmap` readIORef imports print $ genModule imports props genModule :: [String] -> [String] -> Doc genModule imports props = vcat [header,imports', main ] where header = text "module Main where" imports' = text "import Test.QuickCheck; import Data.Maybe; \ \import System.Environment; import Text.Printf; \ \import Properties hiding (main); import Control.Monad" $$ vcat [ text "import qualified" <+> text im | im <- imports ] props' = [ parens $ doubleQuotes (text p) <> comma <> text "mytest" <+> text p | p <- props ] main = hang (text "main = do") 4 $ text "n <- maybe (return 100) readIO . listToMaybe =<< getArgs" $$ hang (text "let props = ") 8 (brackets $ foldr1 (\x xs -> x <> comma $$ xs) props') $$ text "(results, passed) <- liftM unzip $ \ \mapM (\\(s,a) -> printf \"%-40s: \" s >> a n) props" $$ text "printf \"Passed %d tests!\\n\" (sum passed)" $$ text "when (any not results) $ fail \"Not all tests passed!\"" io x = liftIO x xmonad-contrib-0.12/tests/Selective.hs0000644000000000000000000000653712636047674016221 0ustar0000000000000000{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE ScopedTypeVariables, FlexibleInstances #-} module Selective where -- Tests for limitSelect-related code in L.LimitWindows. -- To run these tests, export (select,update,Selection(..),updateAndSelect) from -- L.LimitWindows. import XMonad.Layout.LimitWindows import XMonad.StackSet hiding (focusUp, focusDown, filter) import Control.Applicative ((<$>)) import Test.QuickCheck import Control.Arrow (second) instance Arbitrary (Stack Int) where arbitrary = do xs <- arbNat ys <- arbNat return $ Stack { up=[xs-1,xs-2..0], focus=xs, down=[xs+1..xs+ys] } coarbitrary = undefined instance Arbitrary (Selection a) where arbitrary = do nm <- arbNat st <- arbNat nr <- arbPos return $ Sel nm (st+nm) nr coarbitrary = undefined arbNat = abs <$> arbitrary arbPos = (+1) . abs <$> arbitrary -- as many windows as possible should be selected -- (when the selection is normalized) prop_select_length sel (stk :: Stack Int) = (length . integrate $ select sel' stk) == ((nMaster sel' + nRest sel') `min` length (integrate stk)) where sel' = update sel stk -- update normalizes selections (is idempotent) prop_update_idem sel (stk :: Stack Int) = sel' == update sel' stk where sel' = update sel stk -- select selects the master pane prop_select_master sel (stk :: Stack Int) = take (nMaster sel) (integrate stk) == take (nMaster sel) (integrate $ select sel stk) -- the focus should always be selected in normalized selections prop_select_focus sel (stk :: Stack Int) = focus stk == (focus $ select sel' stk) where sel' = update sel stk -- select doesn't change order (or duplicate elements) -- relies on the Arbitrary instance for Stack Int generating increasing stacks prop_select_increasing sel (stk :: Stack Int) = let res = integrate $ select sel stk in and . zipWith (<) res $ tail res -- selection has the form [0..l] ++ [m..n] -- relies on the Arbitrary instance for Stack Int generating stacks like [0..k] prop_select_two_consec sel (stk :: Stack Int) = let wins = integrate $ select sel stk in (length . filter not . zipWith ((==) . (+1)) wins $ tail wins) <= 1 -- update preserves invariants on selections prop_update_nm sel (stk :: Stack Int) = nMaster (update sel stk) >= 0 prop_update_start sel (stk :: Stack Int) = nMaster sel' <= start sel' where sel' = update sel stk prop_update_nr sel (stk :: Stack Int) = nRest (update sel stk) >= 0 -- moving the focus to a window that's already selected doesn't change the selection prop_update_focus_up sel (stk :: Stack Int) x' = (length (up stk) >= x) && ((up stk !! (x-1)) `elem` integrate stk') ==> sel' == update sel' (iterate focusUp stk !! x) where x = 1 + abs x' sel' = update sel stk stk' = select sel' stk prop_update_focus_down sel (stk :: Stack Int) x' = (length (down stk) >= x) && ((down stk !! (x-1)) `elem` integrate stk') ==> sel' == update sel' (iterate focusDown stk !! x) where x = 1 + abs x' sel' = update sel stk stk' = select sel' stk focusUp stk = stk { up=tail (up stk), focus=head (up stk), down=focus stk:down stk } focusDown stk = stk { down=tail (down stk), focus=head (down stk), up=focus stk:up stk } xmonad-contrib-0.12/tests/XPrompt.hs0000644000000000000000000000450512636047674015700 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------- -- -- Tests for XPrompt and ShellPrompt -- ------------------------------------- module XPrompt where import Data.Char import Test.QuickCheck import Data.List import XMonad.Prompt import qualified XMonad.Prompt.Shell as S import Properties {- instance Arbitrary Char where arbitrary = choose ('\32', '\255') coarbitrary c = variant (ord c `rem` 4) -} doubleCheck p = check (defaultConfig { configMaxTest = 1000}) p deepCheck p = check (defaultConfig { configMaxTest = 10000}) p deepestCheck p = check (defaultConfig { configMaxTest = 100000}) p -- brute force check for exceptions prop_split (str :: [Char]) = forAll (elements str) $ \e -> S.split e str == S.split e str -- check if the first element of the new list is indeed the first part -- of the string. prop_spliInSubListsAt (x :: Int) (str :: [Char]) = x < length str ==> result == take x str where result = case splitInSubListsAt x str of [] -> [] x -> head x -- skipLastWord is complementary to getLastWord, unless the only space -- in the string is the final character, in which case skipLastWord -- and getLastWord will produce the same result. prop_skipGetLastWord (str :: [Char]) = skipLastWord str ++ getLastWord str == str || skipLastWord str == getLastWord str -- newIndex and newCommand get only non empy lists elemGen :: Gen ([String],String) elemGen = do a <- arbitrary :: Gen [[Char]] let l = case filter (/= []) a of [] -> ["a"] x -> x e <- elements l return (l,e) {- newIndex and newCommand have since been renamed or are no longer used -- newIndex calculates the index of the next completion in the -- completion list, so the index must be within the range of the -- copletions list prop_newIndex_range = forAll elemGen $ \(l,c) -> newIndex c l >= 0 && newIndex c l < length l -} -- this is actually the definition of newCommand... -- just to check something. {- prop_newCommandIndex = forAll elemGen $ \(l,c) -> (skipLastWord c ++ (l !! (newIndex c l))) == newCommand c l -} main = do putStrLn "Testing ShellPrompt.split" deepCheck prop_split putStrLn "Testing spliInSubListsAt" deepCheck prop_spliInSubListsAt putStrLn "Testing skip + get lastWord" deepCheck prop_skipGetLastWord xmonad-contrib-0.12/tests/ManageDocks.hs0000644000000000000000000000104012636047674016432 0ustar0000000000000000module ManageDocks where import XMonad import XMonad.Hooks.ManageDocks import Test.QuickCheck import Foreign.C.Types import Properties instance Arbitrary CLong where arbitrary = fromIntegral `fmap` (arbitrary :: Gen Int) instance Arbitrary RectC where arbitrary = do (x,y) <- arbitrary NonNegative w <- arbitrary NonNegative h <- arbitrary return $ RectC (x,y,x+w,y+h) prop_r2c_c2r :: RectC -> Bool prop_r2c_c2r r = r2c (c2r r) == r prop_c2r_r2c :: Rectangle -> Bool prop_c2r_r2c r = c2r (r2c r) == r xmonad-contrib-0.12/tests/SwapWorkspaces.hs0000644000000000000000000000443512636047674017245 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module SwapWorkspaces where import Data.List(find,union) import Data.Maybe(fromJust) import Test.QuickCheck import XMonad.StackSet import Properties(T, NonNegative) -- requires tests/Properties.hs from xmonad-core import XMonad.Actions.SwapWorkspaces -- Ensures that no "loss of information" can happen from a swap. prop_double_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) = t1 `tagMember` ss && t2 `tagMember` ss ==> ss == swap (swap ss) where swap = swapWorkspaces t1 t2 -- Degrade nicely when given invalid data. prop_invalid_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) = not (t1 `tagMember` ss || t2 `tagMember` ss) ==> ss == swapWorkspaces t1 t2 ss -- This doesn't pass yet. Probably should. -- prop_half_invalid_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) = -- t1 `tagMember` ss && not (t2 `tagMember` ss) ==> -- ss == swapWorkspaces t1 t2 ss zipWorkspacesWith :: (Workspace i l a -> Workspace i l a -> n) -> StackSet i l a s sd -> StackSet i l a s sd -> [n] zipWorkspacesWith f s t = f (workspace $ current s) (workspace $ current t) : zipWith f (map workspace $ visible s) (map workspace $ visible t) ++ zipWith f (hidden s) (hidden t) -- Swap only modifies the workspaces tagged t1 and t2 -- leaves all others alone. prop_swap_only_two (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) = t1 `tagMember` ss && t2 `tagMember` ss ==> and $ zipWorkspacesWith mostlyEqual ss (swapWorkspaces t1 t2 ss) where mostlyEqual w1 w2 = map tag [w1, w2] `elem` [[t1, t2], [t2, t1]] || w1 == w2 -- swapWithCurrent stays on current prop_swap_with_current (ss :: T) (t :: NonNegative Int) = t `tagMember` ss ==> layout before == layout after && stack before == stack after where before = workspace $ current ss after = workspace $ current $ swapWithCurrent t ss main = do putStrLn "Testing double swap" quickCheck prop_double_swap putStrLn "Testing invalid swap" quickCheck prop_invalid_swap -- putStrLn "Testing half-invalid swap" -- quickCheck prop_half_invalid_swap putStrLn "Testing swap only two" quickCheck prop_swap_only_two putStrLn "Testing swap with current" quickCheck prop_swap_with_current