1 patch for repository http://code.haskell.org/XMonadContrib: Sun Dec 15 20:51:00 CST 2013 polson2@hawk.iit.edu * Generalized XMonad.Hooks.ServerMode New patches: [Generalized XMonad.Hooks.ServerMode polson2@hawk.iit.edu**20131216025100 Ignore-this: e58da3b168a1058f32982833ea25a739 ] { hunk ./XMonad/Hooks/ServerMode.hs 4 ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ServerMode --- Copyright : (c) Andrea Rossato and David Roundy 2007 +-- Copyright : (c) Peter Olson 2013 and Andrea Rossato and David Roundy 2007 -- License : BSD-style (see xmonad/LICENSE) -- hunk ./XMonad/Hooks/ServerMode.hs 7 --- Maintainer : andrea.rossato@unibz.it +-- Maintainer : polson2@hawk.iit.edu -- Stability : unstable -- Portability : unportable -- hunk ./XMonad/Hooks/ServerMode.hs 19 -- > import Graphics.X11.Xlib -- > import Graphics.X11.Xlib.Extras -- > import System.Environment +-- > import System.IO -- > import Data.Char hunk ./XMonad/Hooks/ServerMode.hs 21 --- > --- > usage :: String -> String --- > usage n = "Usage: " ++ n ++ " command number\nSend a command number to a running instance of XMonad" --- > +-- > -- > main :: IO () hunk ./XMonad/Hooks/ServerMode.hs 23 --- > main = do --- > args <- getArgs --- > pn <- getProgName --- > let com = case args of --- > [] -> error $ usage pn --- > w -> (w !! 0) --- > sendCommand com --- > --- > sendCommand :: String -> IO () --- > sendCommand s = do +-- > 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 hunk ./XMonad/Hooks/ServerMode.hs 56 --- > a <- internAtom d "XMONAD_COMMAND" False +-- > a <- internAtom d addr False +-- > m <- internAtom d s False -- > allocaXEvent $ \e -> do -- > setEventType e clientMessage hunk ./XMonad/Hooks/ServerMode.hs 60 --- > setClientMessageEvent e rw a 32 (fromIntegral (read s)) currentTime +-- > setClientMessageEvent e rw a 32 m currentTime -- > sendEvent d rw False structureNotifyMask e -- > sync d False hunk ./XMonad/Hooks/ServerMode.hs 63 +-- > +-- > 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.") -- hunk ./XMonad/Hooks/ServerMode.hs 68 --- compile with: @ghc --make sendCommand.hs@ +-- +-- compile with: @ghc --make xmonadctl.hs@ -- -- run with -- hunk ./XMonad/Hooks/ServerMode.hs 73 --- > sendCommand command number +-- > xmonadctl command +-- +-- or with -- hunk ./XMonad/Hooks/ServerMode.hs 77 --- For instance: +-- > $ xmonadctl +-- > command1 +-- > command2 +-- > . +-- > . +-- > . +-- > ^D -- hunk ./XMonad/Hooks/ServerMode.hs 85 --- > sendCommand 0 +-- Usage will change depending on which event hook(s) you use. More examples are shown below. -- hunk ./XMonad/Hooks/ServerMode.hs 87 --- will ask to xmonad to print the list of command numbers in --- stderr (so you can read it in @~\/.xsession-errors@). ----------------------------------------------------------------------------- module XMonad.Hooks.ServerMode hunk ./XMonad/Hooks/ServerMode.hs 92 ( -- * Usage -- $usage - ServerMode (..) - , serverModeEventHook + serverModeEventHook , serverModeEventHook' hunk ./XMonad/Hooks/ServerMode.hs 94 + , serverModeEventHookCmd + , serverModeEventHookCmd' + , serverModeEventHookF ) where import Control.Monad (when) hunk ./XMonad/Hooks/ServerMode.hs 100 +import Data.Maybe import Data.Monoid import System.IO hunk ./XMonad/Hooks/ServerMode.hs 112 -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.ServerMode --- > import XMonad.Actions.Commands -- hunk ./XMonad/Hooks/ServerMode.hs 113 --- Then edit your @handleEventHook@ by adding the 'serverModeEventHook': +-- 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 } hunk ./XMonad/Hooks/ServerMode.hs 120 +-- +-- > xmonadctl 0 # tells xmonad to output command list +-- > xmonadctl 1 # tells xmonad to switch to workspace 1 -- hunk ./XMonad/Hooks/ServerMode.hs 124 - -data ServerMode = ServerMode deriving ( Show, Read ) - --- | Executes a command of the list when receiving its index via a special ClientMessageEvent --- (indexing starts at 1) serverModeEventHook :: Event -> X All serverModeEventHook = serverModeEventHook' defaultCommands hunk ./XMonad/Hooks/ServerMode.hs 130 -- | serverModeEventHook' additionally takes an action to generate the list of -- commands. serverModeEventHook' :: X [(String,X ())] -> Event -> X All -serverModeEventHook' cmdAction (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do +serverModeEventHook' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev + where helper cmd = do cl <- cmdAction + case lookup cmd (zip (map show [1..]) 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 hunk ./XMonad/Hooks/ServerMode.hs 164 - a <- io $ internAtom d "XMONAD_COMMAND" False + a <- io $ internAtom d key False when (mt == a && dt /= []) $ do hunk ./XMonad/Hooks/ServerMode.hs 166 - cl <- cmdAction - let listOfCommands = map (uncurry (++)) . zip (map show ([1..] :: [Int])) . map ((++) " - " . fst) - case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of - Just (_,action) -> action - Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl + let atom = fromIntegral $ toInteger $ foldr1 (\a b -> a + (b*2^32)) 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) hunk ./XMonad/Hooks/ServerMode.hs 172 -serverModeEventHook' _ _ = return (All True) +serverModeEventHookF _ _ _ = return (All True) } Context: [fix UrgencyHook and add filterUrgencyHook Adam Vogt **20130924224738 Ignore-this: 3b7c62275701e6758397977c5c09b744 ] [export XMonad.Hooks.UrgencyHook.clearUrgency (issue 533) Adam Vogt **20130923031349 Ignore-this: dafe5763d9abcfa606f5c1a8cf5c57d6 ] [minor documentation fix: manageDocks doesn't do anything with struts, so don't claim it does Daniel Wagner **20130814125106 Ignore-this: a2610d6c1318ac0977abfc21d1b91632 ] [don't pretend to be LG3D in X.C.Dmwit because this confuses modern GTK Daniel Wagner **20130813211636 Ignore-this: 8f728dc1b4bf5e472d99419cc5920e51 ] [XMonad.Actions.UpdatePointer: generalise updatePointer Liyang HU **20130730071007 Ignore-this: 3374a62b6c63dcc152dbf843cd0577f0 ] [XMonad.Actions.UpdatePointer: document TowardsCentre Liyang HU **20130730053746 Ignore-this: 2d684b12e4fff0ebec254bea4a4546a3 ] [Haddock formatting in H.Minimize Adam Vogt **20130723155658 Ignore-this: 5db3186a51dec58f78954466ded339cb ] [Bump version (and xmonad dependency) to 0.12 Adam Vogt **20130720205857 Ignore-this: ce165178ca916223501f266339f1de39 This makes a breakage due to missing patches in core a bit more obvious. Previously you would have a build failure regarding some missing identifiers (def re-exported by XMonad from Data.Default), while after applying this patch it will be clear that xmonad-core needs to be updated. ] [Fix issue 551 by also getting manpath without -g flag. Adam Vogt **20130716030536 Ignore-this: ded2d51eb7b7697c0fdfaa8158d612df Instead of taking Ondrej's approach of figuring out which man (man-db or http://primates.ximian.com/~flucifredi/man/) is used by the system, just try both sets of flags. ] [Escape dzen markup and remove xmobar tags from window titles by default. Adam Vogt **20130708144813 Ignore-this: cf56bff752fbf78ea06d5c0cb755f615 The issue was that window titles, such as those set by, for example a browser, could set the window title to display something like normal title Which could be executed by xmobar (or dzen). This adds a ppTitleSanitize which does the above functions. This way when users override ppTitle, the benefits are not lost. Thanks to Raúl Benencia and Joachim Breitner for bringing this to my attention. ] [DynamicBars-use-ExtensibleState gopsychonauts@gmail.com**20130618074755 Ignore-this: afacba51af2be8ede65b9bcf9b002a7 Hooks.DynamicBars was previously using an MVar and the unsafePerformIO hack ( http://www.haskell.org/haskellwiki/Top_level_mutable_state ) to store bar state. Since ExtensibleState exists to solve these sorts of problems, I've switched the file over to use unsafePerformIO instead. Some functions' types had to be changed to allow access to XState, but the public API is unchanged. ] [Catch exceptions when finding commands on PATH in Prompt.Shell Thomas Tuegel **20130616230219 Ignore-this: 5a4d08c80301864bc14ed784f1054c3f ] [Fix haddock parse error in X.A.LinkWorkspaces Adam Vogt **20130528133448 Ignore-this: 42f05cf8ca9e6d1ffae3bd20666d87ab ] [use Data.Default wherever possible, and deprecate the things it replaces Daniel Wagner **20130528013909 Ignore-this: 898458b1d2868a70dfb09faf473dc7aa ] [eliminate references to defaultConfig Daniel Wagner **20130528005825 Ignore-this: 37ae613e4b943e99c5200915b9d95e58 ] [minimal change needed to get xmonad-contrib to build with xmonad's data-default patch Daniel Wagner **20130528001040 Ignore-this: 291e4f6cd74fc2b808062e0369665170 ] [Remove unneeded XSync call in Layout.ShowWName Francesco Ariis **20130517153341 Ignore-this: 4d107c680572eff464c8f6ed9fabdd41 ] [Remove misleading comment: we definitely don't support ghc-6.6 anymore Adam Vogt **20130514215851 Ignore-this: 2d071cb05709a16763d039222264b426 ] [Fix module name in comment of X.L.Fullscreen Adam Vogt **20130514215727 Ignore-this: cb5cf18c301c5daf5e1a2527da1ef6bf ] [Minor update to cabal file (adding modules & maintainership) Adam Vogt **20130514215632 Ignore-this: 82785e02e544e1f797799bed5b5d9be2 ] [Remove trailing whitespace in X.A.LinkWorkspaces Adam Vogt **20130514215421 Ignore-this: 5015ab4468e7931876eb66b019af804c ] [Update documentation of LinkWorkspaces Module quesel@informatik.uni-oldenburg.de**20110328072813 Ignore-this: da863534931181f551c9c54bc4076c05 ] [Added a module for linking workspaces quesel@informatik.uni-oldenburg.de**20110210165018 Ignore-this: 1dba2164cc3387409873d33099596d91 This module provides a way to link certain workspaces in a multihead setup. That way, when switching to the first one the other heads display the linked workspaces. ] [Cache results from calcGap in ManageDocks Adam Vogt **20130425155811 Ignore-this: e5076fdbdfc68bc159424dd4e0f14456 http://www.haskell.org/pipermail/xmonad/2013-April/013670.html ] [Remove unnecessary contexts from L.MultiToggle Adam Vogt **20130217163356 Ignore-this: 6b0e413d8c3a58f62088c32a96c57c51 ] [Generalises modWorkspace to take any layout-transforming function gopsychonauts@gmail.com**20130501151425 Ignore-this: 28c7dc1f6216bb1ebdffef5434ccbcbd modWorkspace already was capable of modifying the layout with an arbitrary layout -> layout function, but its original type restricted it such that it could only apply a single LayoutModifier; this was often inconvenient, as for example it was not possible simply to compose LayoutModifiers for use with modWorkspace. This patch also reimplements onWorkspaces in terms of modWorkspaces, since with the latter's less restrictive type this is now possible. ] [since XMonad.Config.Dmwit mentions xmobar, we should include the associated .xmobarrc file Daniel Wagner **20130503194055 Ignore-this: 2f6d7536df81eb767262b79b60eb1b86 ] [warning police Daniel Wagner **20130502012700 Ignore-this: ae7412ac77c57492a7ad6c5f8f50b9eb ] [XMonad.Config.Dmwit Daniel Wagner **20130502012132 Ignore-this: 7402161579fd2e191b60a057d955e5ea ] [minor fixes to the haddock markup in X.L.IndependentScreens Daniel Wagner **20130411193849 Ignore-this: b6a139aa43fdb39fc1b86566c0c34c7a ] [add whenCurrentOn to X.L.IndependentScreens Daniel Wagner **20130408225251 Ignore-this: ceea3d391f270abc9ed8e52ce19fb1ac ] [Allow to specify the initial gaps' states in X.L.Gaps Paul Fertser **20130222072232 Ignore-this: 31596d918d0050e36ce3f64f56205a64 ] [should bump X11 dependency, too, to make sure we have getAtomName Daniel Wagner **20130225180527 Ignore-this: 260711f27551f18cc66afeb7b4846b9f ] [getAtomName is now defined in the X11 library Daniel Wagner **20130225180323 Ignore-this: 3b9e17c234679e98752a47c37132ee4e ] [Allow to limit maximum row count in X.Prompt completion window Paul Fertser **20130221122050 Ignore-this: 923656f02996f2de2b1336275392c5f9 On a keyboard-less device (such as a smartphone), where one has to use an on-screen keyboard, the maximum completion window height must be limited to avoid overlapping the keyboard. ] [Note in U.NameActions that xmonad core can list default keys now Adam Vogt **20130217233026 Ignore-this: 937bff636fa88171932d5192fe8e290b ] [Export U.NamedActions.addDescrKeys per evaryont's request. Adam Vogt **20130217232619 Ignore-this: a694a0a3ece70b52fba6e8f688d86344 ] [Add EWMH DEMANDS_ATTENTION support to UrgencyHook. Maarten de Vries **20130212181229 Ignore-this: 5a4b314d137676758fad9ec8f85ce422 Add support for the _NET_WM_STATE_DEMANDS_ATTENTION atom by treating it the same way as the WM_HINTS urgency flag. ] [Unconditionally set _NET_WORKAREA in ManageDocks Adam Vogt **20130117180851 Ignore-this: 9f57e53fba9573d8a92cf153beb7fe7a ] [spawn command when no completion is available (if alwaysHighlight is True); changes commandToComplete in Prompt/Shell to complete the whole word instead of using getLastWord c.lopez@kmels.net**20130209190456 Ignore-this: ca7d354bb301b555b64d5e76e31d10e8 ] [order-unindexed-ws-last matthewhague@zoho.com**20120703222726 Ignore-this: 4af8162ee8b16a60e8fd62fbc915d3c0 Changes the WorkspaceCompare module's comparison by index to put workspaces without an index last (rather than first). ] [SpawnOn modification for issue 523 Adam Vogt **20130114014642 Ignore-this: 703f7dc0f800366b752f0ec1cecb52e5 This moves the function to help clean up the `Spawner' to the ManageHook rather than in functions like spawnOn. Probably it makes no difference, the reason is because there's one manageSpawn function but many different so this way there are less functions to write. ] [Update L.TrackFloating.useTransient example code Adam Vogt **20130112041239 Ignore-this: e4e31cf1db742778c1d59d52fdbeed7a Suggest useTransient goes to the right of trackFloating which is the configuration actually tested. ] [Adapt ideas of issue 306 patch to a new modifier in L.TrackFloating Adam Vogt **20130112035701 Ignore-this: d54d27b71b97144ef0660f910fd464aa ] [Make X.A.CycleWS not rely on hidden WS order Dmitri Iouchtchenko **20130109023328 Ignore-this: 8717a154b33253c5df4e9a0ada4c2c3e ] [Add X.H.WorkspaceHistory Dmitri Iouchtchenko **20130109023307 Ignore-this: c9e7ce33a944facc27481dde52c7cc80 ] [Allow removing arbitrary workspaces Dmitri Iouchtchenko **20121231214343 Ignore-this: 6fce4bd3d0c5337e5122158583138e74 ] [Remove first-hidden restriction from X.A.DynamicWorkspaces.removeWorkspace' Dmitri Iouchtchenko **20121231214148 Ignore-this: 55fb0859e9a5f476a834ecbdb774aac8 ] [Add authorspellings file for `darcs show authors'. Adam Vogt **20130101040031 Ignore-this: c3198072ebc6a71d635bec4d8e2c78fd This authorspellings file includes a couple people who've contributed to xmonad (not XMonadContrib). When people have multiple addresses, the most recent one has been picked. ] [TAG 0.11 Adam Vogt **20130101014231 Ignore-this: 57cf32412fd1ce912811cb7fafe930f5 ] Patch bundle hash: 919d364fcdae765b3ad0f330dd518eea9fb16a9e