From 5f36dbbca79945674f4112e6f729f7a1360595e5 Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Wed, 28 Nov 2007 15:24:17 +0100 Subject: refactor XMonad.Prompt, add new modules XMonad.Prompt.{Input,Email} XMonad.Prompt.Input is a new module which provides a framework for prompting the user for input and passing it along to some other action, useful for building actions which require user input. XMonad.Prompt.Email is a simple example of the use of XMonad.Prompt.Input, which prompts the user for a recipient, subject, and body, and sends a one-line email. I also made a small refactoring to XMonad.Prompt in order to support XMonad.Prompt.Input. darcs-hash:20071128142417-bd4d7-659505bd53d074cd3d11df65014a722b6275d57c.gz --- XMonad/Prompt.hs | 52 +++++++++++++--------- XMonad/Prompt/Email.hs | 63 +++++++++++++++++++++++++++ XMonad/Prompt/Input.hs | 114 +++++++++++++++++++++++++++++++++++++++++++++++++ xmonad-contrib.cabal | 2 + 4 files changed, 212 insertions(+), 19 deletions(-) create mode 100644 XMonad/Prompt/Email.hs create mode 100644 XMonad/Prompt/Input.hs diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs index 01bb31c..69fff8c 100644 --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -18,6 +18,7 @@ module XMonad.Prompt ( -- * Usage -- $usage mkXPrompt + , mkXPromptWithReturn , defaultXPConfig , mkComplFunFromList , XPType (..) @@ -51,6 +52,7 @@ import XMonad.Util.XSelection (getSelection) import Control.Arrow ((&&&)) import Control.Monad.Reader import Control.Monad.State +import Control.Applicative ((<$>)) import Data.Bits import Data.Char import Data.Maybe @@ -146,19 +148,14 @@ initState :: XPrompt p => Display -> Window -> Window -> Rectangle -> ComplFunct initState d rw w s compl gc fonts pt h c = XPS d rw w s Nothing Nothing compl gc fonts (XPT pt) "" 0 h c --- | Creates a prompt given: --- --- * a prompt type, instance of the 'XPrompt' class. --- --- * a prompt configuration ('defaultXPConfig' 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 = do +-- | 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 c <- ask let d = display c rw = theRoot c @@ -175,10 +172,27 @@ mkXPrompt t conf compl action = do releaseXMF fs liftIO $ freeGC d gc liftIO $ hClose h - when (command st' /= "") $ do - let htw = take (historySize conf) (history st') - liftIO $ writeHistory htw - action (command st') + if (command st' /= "") + then do + let htw = take (historySize conf) (history st') + liftIO $ writeHistory htw + Just <$> action (command st') + else + return Nothing + +-- | Creates a prompt given: +-- +-- * a prompt type, instance of the 'XPrompt' class. +-- +-- * a prompt configuration ('defaultXPConfig' 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 () runXP :: XP () runXP = do @@ -313,12 +327,12 @@ killWord :: Direction -> XP () killWord d = do XPS { command = c, offset = o } <- get let (f,ss) = splitAt o c - delNextWord w = + delNextWord w = case w of ' ':x -> x word -> snd . break isSpace $ word delPrevWord = reverse . delNextWord . reverse - (ncom,noff) = + (ncom,noff) = case d of Next -> (f ++ delNextWord ss, o) Prev -> (delPrevWord f ++ ss, length $ delPrevWord f) -- laziness!! diff --git a/XMonad/Prompt/Email.hs b/XMonad/Prompt/Email.hs new file mode 100644 index 0000000..7468c9f --- /dev/null +++ b/XMonad/Prompt/Email.hs @@ -0,0 +1,63 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Email +-- Copyright : (c) 2007 Brent Yorgey +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- 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: +-- +-- > , ((modMask x .|. controlMask, xK_e), emailPrompt defaultXPConfig 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 -> + io $ runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n") + >> return () diff --git a/XMonad/Prompt/Input.hs b/XMonad/Prompt/Input.hs new file mode 100644 index 0000000..27a0a56 --- /dev/null +++ b/XMonad/Prompt/Input.hs @@ -0,0 +1,114 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Prompt.Input +-- Copyright : (c) 2007 Brent Yorgey +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- 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, + (?+) + ) 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 +-- +-- > , ((modMask x .|. 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 \ No newline at end of file diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 587f9d5..6709a5e 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -123,6 +123,8 @@ library XMonad.Prompt.Workspace XMonad.Prompt.XMonad XMonad.Prompt.AppendFile + XMonad.Prompt.Input + XMonad.Prompt.Email XMonad.Util.Anneal XMonad.Util.CustomKeys XMonad.Util.Dmenu -- cgit v1.2.3