From fccf788a5ce9788d7c073321a3d19941bc1269b1 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 16 Aug 2016 14:58:16 -0400
Subject: more command line interface improvements

---
 UI/Zenity.hs | 31 ++++++++++++++++++++++---------
 1 file changed, 22 insertions(+), 9 deletions(-)

(limited to 'UI/Zenity.hs')

diff --git a/UI/Zenity.hs b/UI/Zenity.hs
index f61bb44..c8fca2d 100644
--- a/UI/Zenity.hs
+++ b/UI/Zenity.hs
@@ -22,13 +22,26 @@ zenityUI = UI
 		ps <- getSearchPath
 		loc <- filterM (\p -> doesFileExist (p </> "zenity")) ps
 		return (not (null loc))
-	, promptName = name
-	, promptPassword = password
-	, withProgress = progress
+	, showError = myShowError
+	, promptName = myPromptName
+	, promptPassword = myPromptPassword
+	, withProgress = myWithProgress
 	}
 
-name :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
-name title desc (Name suggested) checkproblem = go ""
+myShowError :: Desc -> IO ()
+myShowError desc = bracket go cleanup (\_ -> return ())
+  where
+	go = runZenity
+		[ "--error"
+		, "--title", "keysafe"
+		, "--text", "Error: " ++ desc
+		]
+	cleanup h = do
+		_ <- waitZenity h
+		return ()
+
+myPromptName :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
+myPromptName title desc (Name suggested) checkproblem = go ""
   where
 	go extradesc = do
 		h <- runZenity
@@ -46,8 +59,8 @@ name title desc (Name suggested) checkproblem = go ""
 					Just problem -> go problem
 			else return Nothing
 
-password :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password)
-password title desc checkproblem = go ""
+myPromptPassword :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password)
+myPromptPassword title desc checkproblem = go ""
   where
 	go extradesc = do
 		h <- runZenity
@@ -71,8 +84,8 @@ password title desc checkproblem = go ""
 							Just problem -> go problem
 			else return Nothing
 
-progress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO ()
-progress title desc a = bracket setup teardown (a . sendpercent)
+myWithProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO ()
+myWithProgress title desc a = bracket setup teardown (a . sendpercent)
   where
 	setup = do
 		h <- runZenity
-- 
cgit v1.2.3