From 5f36dbbca79945674f4112e6f729f7a1360595e5 Mon Sep 17 00:00:00 2001
From: Brent Yorgey <byorgey@gmail.com>
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 +++++++++++++++++++++++++++++++++-------------------
 1 file changed, 33 insertions(+), 19 deletions(-)

(limited to 'XMonad/Prompt.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!!
-- 
cgit v1.2.3