From b1402e8bd6a68a891b00a214d6cf184d66defe19 Mon Sep 17 00:00:00 2001 From: aarne Date: Mon, 22 Sep 2003 13:16:55 +0000 Subject: Founding the newly structured GF2.0 cvs archive. --- src/GF/Fudgets/FudgetOps.hs | 47 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 src/GF/Fudgets/FudgetOps.hs (limited to 'src/GF/Fudgets/FudgetOps.hs') diff --git a/src/GF/Fudgets/FudgetOps.hs b/src/GF/Fudgets/FudgetOps.hs new file mode 100644 index 000000000..6c4e1a8b2 --- /dev/null +++ b/src/GF/Fudgets/FudgetOps.hs @@ -0,0 +1,47 @@ +module FudgetOps where + +import Fudgets + +-- auxiliary Fudgets for GF syntax editor + +-- save and display + +showAndSaveF fud = (writeFileF >+< textWindowF) >==< saveF fud + +saveF :: F a String -> F (Either String a) (Either (String,String) String) +saveF fud = + absF (saveSP "EMPTY") + >==< + (popupStringInputF "Save" "foo.tmp" "Save to file:" >+< fud) + +saveSP :: String -> SP (Either String String) (Either (String,String) String) +saveSP contents = getSP $ \msg -> case msg of + Left file -> putSP (Left (file,contents)) (saveSP contents) + Right string -> putSP (Right string) (saveSP string) + +textWindowF = writeOutputF + +-- to replace stringInputF by a pop-up slot behind a button +popupStringInputF :: String -> String -> String -> F String String +popupStringInputF label deflt msg = + mapF snd + >==< + (popupSizeP $ stringPopupF deflt) + >==< + mapF (\_ -> (Just msg,Nothing)) + >==< + decentButtonF label + >==< + mapF (\_ -> Click) + +decentButtonF = spacerF (sizeS (Point 80 20)) . buttonF + +popupSizeP = spacerF (sizeS (Point 240 100)) + +--- the Unicode stuff should be inserted here + +writeOutputF = moreF >==< mapF lines + +writeInputF = stringInputF + + -- cgit v1.2.3