summaryrefslogtreecommitdiffhomepage
path: root/UI/Zenity.hs
diff options
context:
space:
mode:
Diffstat (limited to 'UI/Zenity.hs')
-rw-r--r--UI/Zenity.hs61
1 files changed, 46 insertions, 15 deletions
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