{-# OPTIONS_GHC -fno-warn-orphans #-}{-# LANGUAGE ExistentialQuantification, FlexibleContexts, FlexibleInstances, StandaloneDeriving #-}---------------------------------------------------------------------- |-- Module : XMonad.Util.NamedActions-- Copyright : 2009 Adam Vogt <vogt.adam@gmail.com>-- License : BSD3-style (see LICENSE)---- Maintainer : Adam Vogt <vogt.adam@gmail.com>-- Stability : unstable-- Portability : unportable---- A wrapper for keybinding configuration that can list the available-- keybindings.--------------------------------------------------------------------moduleXMonad.Util.NamedActions(-- * Usage:-- $usagesendMessage',spawn',submapName,addDescrKeys,xMessage,showKmSimple,showKm,noName,oneName,addName,separator,subtitle,(^++^),NamedAction(..),HasName,defaultKeysDescr)whereimportXMonad.Actions.Submap(submap)importXMonadimportSystem.Posix.Process(executeFile)importControl.Arrow(Arrow((&&&),second,(***)))importData.Bits(Bits((.&.),complement))importData.List(groupBy)importSystem.Exit(ExitCode(ExitSuccess),exitWith)importControl.Applicative((<*>))importqualifiedData.MapasMimportqualifiedXMonad.StackSetasW-- $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-- > defaultConfig { modMask = mod4Mask }-- >-- > myKeys c = (subtitle "Custom Keys":) $ mkNamedKeymap c $-- > [("M-x a", addName "useless message" $ spawn "xmessage foo"),-- > ("M-c", sendMessage' Expand)]-- > ^++^-- > [("<XF86AudioPlay>", spawn "mpc toggle" :: X ()),-- > ("<XF86AudioNext>", 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 bindingderivinginstanceShowXMonad.ResizederivinginstanceShowXMonad.IncMasterN-- | 'sendMessage' but add a description that is @show message@. Note that not-- all messages have show instances.sendMessage'::(Messagea,Showa)=>a->NamedActionsendMessage'x=NamedAction$(XMonad.sendMessagex,showx)-- | 'spawn' but the description is the string passedspawn'::String->NamedActionspawn'x=addNamex$spawnxclassHasNameawhereshowName::a->[String]showName=const[""]getAction::a->X()instanceHasName(X())wheregetAction=idinstanceHasName(IO())wheregetAction=ioinstanceHasName[Char]wheregetAction_=return()showName=(:[])instanceHasName(X(),String)whereshowName=(:[]).sndgetAction=fstinstanceHasName(X(),[String])whereshowName=sndgetAction=fst-- show only the outermost descriptioninstanceHasName(NamedAction,String)whereshowName=(:[]).sndgetAction=getAction.fstinstanceHasNameNamedActionwhereshowName(NamedActionx)=showNamexgetAction(NamedActionx)=getActionx-- | An existential wrapper so that different types can be combined in lists,-- and mapsdataNamedAction=foralla.HasNamea=>NamedActiona-- | 'submap', but propagate the descriptions of the actions. Does this belong-- in "XMonad.Actions.Submap"?submapName::(HasNamea)=>[((KeyMask,KeySym),a)]->NamedActionsubmapName=NamedAction.(submap.M.mapgetAction.M.fromList&&&showKm).map(secondNamedAction)-- | Combine keymap lists with actions that may or may not have names(^++^)::(HasNameb,HasNameb1)=>[(d,b)]->[(d,b1)]->[(d,NamedAction)]a^++^b=map(secondNamedAction)a++map(secondNamedAction)b-- | Or allow another lookup table?modToString::KeyMask->StringmodToStringmask=concatMap(++"-")$filter(not.null)$map(uncurrypick)[(mod1Mask,"M1"),(mod2Mask,"M2"),(mod3Mask,"M3"),(mod4Mask,"M4"),(mod5Mask,"M5"),(controlMask,"C"),(shiftMask,"Shift")]wherepickmstr=ifm.&.complementmask==0thenstrelse""keyToString::(KeyMask,KeySym)->[Char]keyToString=uncurry(++).(modToString***keysymToString)showKmSimple::[((KeyMask,KeySym),NamedAction)]->[[Char]]showKmSimple=concatMap(\(k,e)->ifsndk==0then"":showNameeelsemap((keyToStringk++).smartSpace)$showNamee)smartSpace::String->StringsmartSpace[]=[]smartSpacexs=' ':xs_test::String_test=unlines$showKm$defaultKeysDescrXMonad.defaultConfig{XMonad.layoutHook=XMonad.Layout$XMonad.layoutHookXMonad.defaultConfig}showKm::[((KeyMask,KeySym),NamedAction)]->[String]showKmkeybindings=padding$do(k,e)<-keybindingsifsndk==0thenmap((,)"")$showNameeelsemap((,)(keyToStringk).smartSpace)$showNameewherepadding=letpadn(k,e)=ifnullkthen"\n>> "++eelsetaken(k++repeat' ')++eexpandxsn=map(padn)xsgetMax=map(maximum.map(length.fst))inconcat.(zipWithexpand<*>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)]->NamedActionxMessagex=addName"Show Keybindings"$io$doxfork$executeFile"xmessage"True["-default","okay",unlines$showKmx]Nothingreturn()-- | Merge the supplied keys with 'defaultKeysDescr', also adding a keybinding-- to run an action for showing the keybindings.addDescrKeys::(HasNameb1,HasNameb)=>((KeyMask,KeySym),[((KeyMask,KeySym),NamedAction)]->b)->(XConfigLayout->[((KeyMask,KeySym),b1)])->XConfigl->XConfigladdDescrKeyskks=addDescrKeys'k(\l->defaultKeysDescrl^++^ksl)-- | Without merging with 'defaultKeysDescr'addDescrKeys'::(HasNameb)=>((KeyMask,KeySym),[((KeyMask,KeySym),NamedAction)]->b)->(XConfigLayout->[((KeyMask,KeySym),NamedAction)])->XConfigl->XConfigladdDescrKeys'(k,f)ksconf=letshkl=f$[(k,f$ksl)]^++^kslkeylistl=M.mapgetAction$M.fromList$ksl^++^[(k,shkl)]inconf{keys=keylist}-- | A version of the default keys from 'XMonad.Config.defaultConfig', but with-- 'NamedAction' instead of @X ()@defaultKeysDescr::XConfigLayout->[((KeyMask,KeySym),NamedAction)]defaultKeysDescrconf@(XConfig{XMonad.modMask=modm})=[subtitle"launching and killing programs",((modm.|.shiftMask,xK_Return),addName"Launch Terminal"$spawn$XMonad.terminalconf)-- %! 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.layoutHookconf)-- %! 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"$windowsW.focusDown)-- %! Move focus to the next window,((modm.|.shiftMask,xK_Tab),addName"Focus up"$windowsW.focusUp)-- %! Move focus to the previous window,((modm,xK_j),addName"Focus down"$windowsW.focusDown)-- %! Move focus to the next window,((modm,xK_k),addName"Focus up"$windowsW.focusUp)-- %! Move focus to the previous window,((modm,xK_m),addName"Focus the master"$windowsW.focusMaster)-- %! Move focus to the master window,subtitle"modifying the window order",((modm,xK_Return),addName"Swap with the master"$windowsW.swapMaster)-- %! Swap the focused window and the master window,((modm.|.shiftMask,xK_j),addName"Swap down"$windowsW.swapDown)-- %! Swap the focused window with the next window,((modm.|.shiftMask,xK_k),addName"Swap up"$windowsW.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'(IncMasterN1))-- %! 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(exitWithExitSuccess))-- %! 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$fi)|(f,m,n)<-[(W.greedyView,0,"Switch to workspace "),(W.shift,shiftMask,"Move client to workspace ")],(i,k)<-zip(XMonad.workspacesconf)[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++showsc)$screenWorkspacesc>>=flipwhenJust(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 otherwiseseparator::((KeyMask,KeySym),NamedAction)separator=((0,0),NamedAction(return()::X(),[]::[String]))subtitle::String->((KeyMask,KeySym),NamedAction)subtitlex=((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()->NamedActionnoName=NamedActiononeName::(X(),String)->NamedActiononeName=NamedActionaddName::String->X()->NamedActionaddName=flip(curryNamedAction)