From 9473fee1bb0f9f549de41eec9f7b7d141f2ebfd3 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 16 Aug 2016 16:08:13 -0400
Subject: key selection working

---
 UI/Zenity.hs | 61 +++++++++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 46 insertions(+), 15 deletions(-)

(limited to 'UI/Zenity.hs')

diff --git a/UI/Zenity.hs b/UI/Zenity.hs
index c8fca2d..3c3f313 100644
--- a/UI/Zenity.hs
+++ b/UI/Zenity.hs
@@ -23,8 +23,10 @@ zenityUI = UI
 		loc <- filterM (\p -> doesFileExist (p </> "zenity")) ps
 		return (not (null loc))
 	, showError = myShowError
+	, promptQuestion = myPromptQuestion
 	, promptName = myPromptName
 	, promptPassword = myPromptPassword
+	, promptKeyId = myPromptKeyId
 	, withProgress = myWithProgress
 	}
 
@@ -40,6 +42,16 @@ myShowError desc = bracket go cleanup (\_ -> return ())
 		_ <- waitZenity h
 		return ()
 
+myPromptQuestion :: Title -> Desc -> IO Bool
+myPromptQuestion title desc = do
+	h <- runZenity
+		[ "--question"
+		, "--title", title
+		, "--text",  desc
+		]
+	(_, ok) <- waitZenity h
+	return ok
+
 myPromptName :: Title -> Desc -> Name -> (Name -> Maybe Problem) -> IO (Maybe Name)
 myPromptName title desc (Name suggested) checkproblem = go ""
   where
@@ -59,31 +71,50 @@ myPromptName title desc (Name suggested) checkproblem = go ""
 					Just problem -> go problem
 			else return Nothing
 
-myPromptPassword :: Title -> Desc -> (Password -> Maybe Problem) -> IO (Maybe Password)
-myPromptPassword title desc checkproblem = go ""
+myPromptPassword :: Bool -> Title -> Desc -> IO (Maybe Password)
+myPromptPassword confirm title desc = go ""
   where
 	go extradesc = do
-		h <- runZenity
+		h <- runZenity $
 			[ "--forms"
 			, "--title", title
 			, "--text", desc ++ "\n" ++ extradesc ++ "\n"
-			, "--add-password", "Enter password"
-			, "--add-password", "Confirm password"
 			, "--separator", "\BEL"
-			]
+			, "--add-password", "Enter password"
+			] ++ if confirm
+				then [ "--add-password", "Confirm password" ]
+				else []
 		(ret, ok) <- waitZenity h
 		if ok
-			then
-				let (p1, _:p2) = break (== '\BEL') ret
-				in if p1 /= p2
-					then go "Passwords didn't match, try again..."
-					else
-						let p = Password $ BU8.fromString p1
-						in case checkproblem p of
-							Nothing -> return $ Just p
-							Just problem -> go problem
+			then if confirm
+				then 
+					let (p1, _:p2) = break (== '\BEL') ret
+						in if p1 /= p2
+						then go "Passwords didn't match, try again..."
+						else return $ Just $ Password $ BU8.fromString p1
+				else return $ Just $ Password $ BU8.fromString ret
 			else return Nothing
 
+myPromptKeyId :: Title -> Desc -> [(Name, KeyId)] -> IO (Maybe KeyId)
+myPromptKeyId _ _ [] = return Nothing
+myPromptKeyId title desc l = do
+	h <- runZenity $
+		[ "--list"
+		, "--title", title
+		, "--text", desc
+		, "--column", "gpg secret key name"
+		, "--column", "keyid"
+		, "--print-column", "ALL"
+		, "--separator", "\BEL"
+		, "--width", "500"
+		] ++ concatMap (\(Name n, KeyId kid) -> [BU8.toString n, BU8.toString kid]) l
+	(ret, ok) <- waitZenity h
+	if ok
+		then do
+			let (_n, _:kid) = break (== '\BEL') ret
+			return $ Just (KeyId (BU8.fromString kid))
+		else return Nothing
+
 myWithProgress :: Title -> Desc -> ((Percent -> IO ()) -> IO ()) -> IO ()
 myWithProgress title desc a = bracket setup teardown (a . sendpercent)
   where
-- 
cgit v1.2.3