packages feed

ginsu (empty) → 0.8.0

raw patch · 58 files changed

+16495/−0 lines, 58 filesdep +arraydep +basedep +bytestringsetup-changed

Dependencies added: array, base, bytestring, containers, ghc-binary, haskell98, mtl, network, old-locale, old-time, parsec, pretty, process, regex-posix, syb, unix, utf8-string

Files

+ Atom.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, DeriveDataTypeable #-}+module Atom(+    Atom(),+    Atom.toString,+    FromAtom(..),+    ToAtom(..),+    atomIndex,+    dumpAtomTable,+    fromPackedStringIO,+    fromString,+    fromStringIO,+    intToAtom,+    toPackedString+    ) where++import Data.Generics+import Data.Monoid+import Foreign+import List(sort)+import qualified Data.HashTable as HT+import Data.Binary++import PackedString+++instance Monoid Atom where+    mempty = toAtom nilPS+    mappend x y = toAtom $ appendPS (fromAtom x)  (fromAtom y)+    mconcat xs = toAtom $ concatPS (map fromAtom xs)++{-# NOINLINE table #-}+table :: HT.HashTable PackedString Atom+table = unsafePerformIO (HT.new (==) (fromIntegral . hashPS))++{-# NOINLINE reverseTable #-}+reverseTable :: HT.HashTable Int PackedString+reverseTable = unsafePerformIO (HT.new (==) (fromIntegral))++{-# NOINLINE intPtr #-}+intPtr :: Ptr Int+intPtr = unsafePerformIO (new 1)+++newtype Atom = Atom Int+    deriving(Typeable, Data,Eq,Ord)++instance Show Atom where+    showsPrec _ atom = (toString atom ++)++instance Read Atom where+    readsPrec _ s = [ (fromString s,"") ]+    --readsPrec p s = [ (fromString x,y) |  (x,y) <- readsPrec p s]++toPackedString atom = atomToPS atom+toString atom = unpackPS $ toPackedString atom+atomIndex (Atom x) = x++instance Binary Atom where+    put x = put (toPackedString x)+    get = (unsafePerformIO . fromPackedStringIO) `fmap` get++{- these are separate in case operations are one-way -}+class ToAtom a where+    toAtom :: a -> Atom+class FromAtom a where+    fromAtom :: Atom -> a++instance ToAtom String where+    toAtom = fromString+instance FromAtom String where+    fromAtom = toString+instance FromAtom (String -> String) where+    fromAtom x = showsPS (fromAtom x)++instance ToAtom PackedString where+    toAtom x = unsafePerformIO $ fromPackedStringIO x+instance FromAtom PackedString where+    fromAtom = toPackedString++instance ToAtom Atom where+    toAtom x = x+instance FromAtom Atom where+    fromAtom x = x++instance ToAtom Char where+    toAtom x = toAtom [x]+++fromString :: String -> Atom+fromString xs = unsafePerformIO $ fromStringIO xs++fromStringIO :: String -> IO Atom+fromStringIO cs = fromPackedStringIO (packString cs)++fromPackedStringIO :: PackedString -> IO Atom+fromPackedStringIO ps = HT.lookup table ps >>= \x -> case x of+    Just z -> return z+    Nothing -> do+        i <- peek intPtr+        poke intPtr (i + 2)+        let a = Atom i+        HT.insert table ps a+        HT.insert reverseTable i ps+        return a+++-- The following are 'unwise' in that they may reveal internal structure that may differ between program runs++dumpAtomTable = do+    x <- HT.toList table+    mapM_ putStrLn [ show i ++ " " ++ show ps  | (ps,Atom i) <- sort x]+++intToAtom :: Monad m => Int -> m Atom+intToAtom i = unsafePerformIO $  HT.lookup reverseTable i >>= \x -> case x of+    Just _ -> return (return $ Atom i)+    Nothing -> return $ fail $ "intToAtom: " ++ show i++atomToPS :: Atom -> PackedString+atomToPS (Atom i) = unsafePerformIO $  HT.lookup reverseTable i >>= \x -> case x of+    Just ps -> return ps+    Nothing -> return $ error $ "atomToPS: " ++ show i+
+ Boolean/Algebra.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE UndecidableInstances, OverlappingInstances, FlexibleInstances #-}++-- | This is the main module of the Boolean hierachy and provides a class which+-- abstracts common operations on boolean algebras.  note, we redefine some+-- prelude functions, but the new definitons mean the same thing for Bool so it+-- will not hurt existing code.+--+-- to use properly:+--+-- > import Boolean.Algebra+-- > import Prelude hiding((&&),(||),not,and,or,any,all)+--+++module Boolean.Algebra(+    SemiBooleanAlgebra(..),+    BooleanAlgebra(..),+    and1, or1, fromBool+) where++import Prelude hiding((&&),(||),not,and,or,any,all)+import Monad++infixr 3 &&+infixr 2 ||+infixr 2 `xor`++--------------+-- The class+--------------++-- | This class is mainly for syntax re-use, there are many types which are very similar+-- to boolean algebras, but do not have suitable distinguished values to choose for true+-- and false.+--+-- '&&' and '||' should be strict only in their first argument, and return one+-- of their arguments if possible.++class SemiBooleanAlgebra a where+    (&&) :: a -> a -> a+    (||) :: a -> a -> a+    --a && b = not (not a || not b)+    --a || b = not (not a && not b)+++++-- | This is the main class, providing all the operations one would expect on+-- a boolean algebra.+class SemiBooleanAlgebra a => BooleanAlgebra a where+    true :: a+    false :: a+    not :: a -> a+    -- the following are in case there is a more efficient implementation+    -- than the default+    xor :: a -> a -> a+    and :: [a] -> a+    or :: [a] -> a+    any :: (x -> a) -> [x] -> a+    all :: (x -> a) -> [x] -> a++    any f xs = or (map f xs)+    all f xs = and (map f xs)+    and xs  = foldr (&&) true xs+    or xs  = foldr (||) false xs+    xor a b = (a && not b) || (b && not a)+    true = not false+    false = not true+    not x = xor true x++------------------------+-- some useful functions+------------------------++-- | this behaves identically to 'and' but requires there be at least one item in+-- the list and has a more general type.+and1 :: SemiBooleanAlgebra a => [a] -> a+and1 xs = foldr1 (&&) xs+++-- | this behaves identically to 'or' but requires there be at least one item in+-- the list and has a more general type.+or1 :: SemiBooleanAlgebra a => [a] -> a+or1 xs = foldr1 (||) xs++-- | convert a 'Bool' into an arbitrary membor of BooleanAlgebra.+fromBool :: BooleanAlgebra a => Bool -> a+fromBool True = true+fromBool False = false+++------------+-- Instances+------------++instance SemiBooleanAlgebra (Maybe a) where+    (Just _) && x = x+    x && _ = x+    Nothing || x = x+    x || _ = x++-- | This behaves similarly to the Maybe instance, treating the empty list as+-- false, and any other list as true. Both routines will return one of their+-- arguments unmodified after evaluating their first argument.++instance SemiBooleanAlgebra [a] where+    (_:_) && x = x+    x && _ = x+    [] || x = x+    x || _ = x++-- | For the purposes of this instance 'Left' is considered false and 'Right'+-- true.++instance SemiBooleanAlgebra (Either a b) where+    (Right _) && x = x+    x && _ = x+    (Left _) || x = x+    x || _ = x++instance SemiBooleanAlgebra Bool where+    False && _ = False+    True && x = x+    True || _ = True+    False || x = x++instance BooleanAlgebra Bool where+    true = True+    false = False+    not True = False+    not False = True+    xor True False = True+    xor False True = True+    xor _ _ = False+++instance SemiBooleanAlgebra a => SemiBooleanAlgebra (x -> a) where+    f && g = \x -> f x && g x+    f || g = \x -> f x || g x+++-- | This is the space of predicates+instance BooleanAlgebra a => BooleanAlgebra (x -> a) where+    true = \_ -> true+    false = \_ -> false+    not f = \x -> not (f x)+    xor f g = \x -> f x `xor` g x+++-- TODO need more instances for tuples+instance (SemiBooleanAlgebra a, SemiBooleanAlgebra b) => SemiBooleanAlgebra (a,b) where+    (x,y) && (x',y') = (x && x', y && y')+    (x,y) || (x',y') = (x || x', y || y')++instance (BooleanAlgebra a, BooleanAlgebra b) => BooleanAlgebra (a,b) where+    not (x,y)  = (not x, not y)+    true = (true,true)+    false = (false,false)+++-- | zero is false, any other value is true+instance SemiBooleanAlgebra Int where+    0 && _ = 0+    _ && b = b+    0 || b = b+    a || _ = a++instance BooleanAlgebra Int where+    false = 0+    true = 1+    not 0 = 1+    not _ = 0+    xor 0 b = b+    xor _ b = not b++instance SemiBooleanAlgebra Integer where+    0 && _ = 0+    _ && b = b+    0 || b = b+    a || _ = a++instance BooleanAlgebra Integer where+    false = 0+    true = 1+    not 0 = 1+    not _ = 0+    xor 0 b = b+    xor _ b = not b+++instance (Monad m, SemiBooleanAlgebra a) => SemiBooleanAlgebra (m a)  where+    (&&) = liftM2 (&&)+    (||) = liftM2 (||)++instance (Monad m, SemiBooleanAlgebra (m a), BooleanAlgebra a) => BooleanAlgebra (m a)  where+    xor = liftM2 xor+    not = liftM not+    true = return true+    false = return false+    and xs = sequence xs >>= return . and+    or xs = sequence xs >>= return . or+    any f xs = mapM f xs >>= return . or+    all f xs = mapM f xs >>= return . and++
+ Boolean/Boolean.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE UndecidableInstances, OverlappingInstances, PatternGuards #-}++-- | This module provides a data constructor which lifts any type into a+-- boolean algebra and some operations on said lifted type.+--++module Boolean.Boolean(+    Boolean(..),+    simplifyBoolean,+    showBoolean,+    evaluate,+    evaluateM,+    parseBoolean,+    parseBoolean',+    dropBoolean+) where++import Boolean.Algebra+import Prelude hiding((&&),(||),not,and,or,any,all)+import qualified Prelude+import Monad+import List hiding(and,or)+import Text.ParserCombinators.Parsec++++----------------+-- the data type+----------------++-- true is BoolAnd []+-- false is BoolOr []+data Boolean a =+    BoolNot (Boolean a)+    | BoolAnd [Boolean a]+    | BoolOr [Boolean a]+    | BoolJust a+    deriving( Eq, Ord, Show, Read)++instance Functor Boolean where+    fmap f (BoolNot x) = BoolNot (fmap f x)+    fmap f (BoolAnd xs) = BoolAnd (map (fmap f) xs)+    fmap f (BoolOr xs) = BoolOr (map (fmap f) xs)+    fmap f (BoolJust x) = BoolJust (f x)+++instance Monad Boolean where+    --a >> b = a && b+    a >>= f = dropBoolean (fmap f a)+    return x = BoolJust x+    fail _ = false++instance MonadPlus Boolean where+    a `mplus` b = a || b+    mzero = false++showBoolean :: (a -> String) -> Boolean a -> String+showBoolean f (BoolNot b) = '!':showBoolean f b+showBoolean f (BoolJust x) = f x+showBoolean _ (BoolAnd []) = "true"+showBoolean _ (BoolOr []) = "false"+--show (BoolAnd [x]) = show x+--show (BoolOr [x]) = show x+showBoolean f (BoolAnd xs) = "(" ++ unwords (map (showBoolean f) xs) ++ ")"+showBoolean f (BoolOr xs) = "(" ++ concat (intersperse " ; " (map (showBoolean f) xs)) ++ ")"+++-- | very safe simplification routine. This will never duplicate terms+-- or change the order terms occur in the formula, so is safe to use even+-- when bottom is present.+--+-- what it does is:+--+-- * removes double negatives+--+-- * evaluates constant terms+--+-- * removes manifest tautologies+--+-- * flattens and of and, or of or+--+-- * flattens single element terms+--+-- if the first argument is true, it also uses de morgan's laws to ensure+-- BoolNot may only occur as the parent of a BoolJust. This may allow+-- additional flattening and simplification, but may increase the number of+-- negations performed and change the ratio between ands and ors done. It does+-- not affect term order either way.+++simplifyBoolean :: Bool -> Boolean a -> Boolean a+simplifyBoolean demorgan x = simplifyBoolean' x where+    simplifyBoolean' x@(BoolAnd []) = x+    simplifyBoolean' x@(BoolOr []) = x+    simplifyBoolean' (BoolAnd [x]) = simplifyBoolean' x+    simplifyBoolean' (BoolOr [x]) = simplifyBoolean' x+    simplifyBoolean' x@(BoolJust _) = x+    simplifyBoolean' (BoolNot z)+        | BoolNot y <- x = simplifyBoolean' y+        | BoolAnd [] <- x = BoolOr []+        | BoolOr [] <- x = BoolAnd []+        | demorgan, BoolAnd xs <- x = simplifyBoolean' $ BoolOr (map BoolNot xs)+        | demorgan, BoolOr xs <- x = simplifyBoolean' $ BoolAnd (map BoolNot xs)+        | otherwise = BoolNot x+        where x = (simplifyBoolean' z)+    simplifyBoolean' (BoolAnd xs)+        | [x] <- xs' = x+        | Prelude.any isFalse xs' = false+        | otherwise = BoolAnd xs'+        where+            xs' = concat $ f [] (dropWhile isTrue (map simplifyBoolean' xs))+            f xs [] = reverse xs+            f z (BoolAnd x:xs) =  f (x:z) xs+            f z (x:xs) = f ([x]:z) xs+    simplifyBoolean' (BoolOr xs)+        | [x] <- xs' = x+        | Prelude.any isTrue xs' = true+        | otherwise = BoolOr xs'+        where+            xs' = concat $ f [] (dropWhile isFalse (map simplifyBoolean' xs))+            f xs [] = reverse xs+            f z (BoolOr x:xs) =  f (x:z) xs+            f z (x:xs) = f ([x]:z) xs++-- these only account for trivial truths+isTrue (BoolAnd []) = True+isTrue _ = False+isFalse (BoolOr []) = True+isFalse _ = False+++-- | perform the Boolean actions on the underlying type, flattening out the+-- Boolean wrapper. This is useful for things like wrapping an expensive to+-- compute predicate for the purposes of optimization.++dropBoolean :: BooleanAlgebra a => Boolean a -> a+dropBoolean (BoolNot x) = not (dropBoolean x)+dropBoolean (BoolOr xs) = or (map dropBoolean xs)+dropBoolean (BoolAnd xs) = and (map dropBoolean xs)+dropBoolean (BoolJust x) = x+++-- | evalute Boolean given a function to evaluate its primitives++evaluate :: BooleanAlgebra r => (a -> r) -> Boolean a -> r+evaluate f x = dropBoolean (fmap f x)++-- | evalute Boolean given a monadic function to evaluate its primitives+evaluateM :: (Monad m, BooleanAlgebra r) => (a -> m r) -> Boolean a -> m r+evaluateM f (BoolJust x) = f x+evaluateM f (BoolNot x) = evaluateM f x >>= return . not+evaluateM f (BoolAnd xs) = mapM (evaluateM f) xs >>= return . and+evaluateM f (BoolOr xs) = mapM (evaluateM f) xs >>= return . or+++-- | A parsec routine to parse a 'Boolean a' given a parser for 'a'.+-- The format is the same as produced by 'showBoolean':+--+-- > a ; b  - a or b+-- > a b    - a and b+-- > !a     - not a+-- > ( a )  - a+--+-- The parser passed as an argument should eat all whitespace after it matches and+-- ensure its syntax does not conflict with the Boolean syntax.++parseBoolean' ::+       Parser s -- ^ parser for whitespace+    -> Parser t -- ^ parser for true+    -> Parser f -- ^ parser for false+    -> Parser a  -- ^ parser for a+    -> Parser (Boolean a) -- ^ parser for Boolean a+parseBoolean' spaces t f pa = disj where+    disj = fmap boolOr (sepBy1 conj (char ';' >> spaces)) <?> "disjunction"+    conj = fmap boolAnd (many1 item) <?> "conjunction"+    item = do+        n <- option id (char '!' >> spaces >> return BoolNot)+        v <- (parened <|> (t >> return true) <|> (f >> return false) <|> fmap BoolJust pa)+        spaces+        return $ n v+    parened = between (char '(' >> spaces) (char ')' >> spaces) disj <?> "parenthesis"+    boolOr [x] = x+    boolOr xs = BoolOr xs+    boolAnd [x] = x+    boolAnd xs = BoolAnd xs++-- | specialized version of parser which understands 'true', 'false' and the+-- normal whitespace characters.++parseBoolean = parseBoolean' spaces (try t >> spaces) (try f >> spaces) where+    t = (string "true" >> notFollowedBy alphaNum)  <?> "true"+    f = (string "false" >> notFollowedBy alphaNum) <?> "false"+++instance SemiBooleanAlgebra (Boolean a) where+    x && y = BoolAnd [x,y]+    x || y = BoolOr [x,y]++instance BooleanAlgebra (Boolean a) where+    not x = BoolNot x+    and xs = BoolAnd xs+    or xs = BoolOr xs+    true = BoolAnd []+    false = BoolOr []+
+ Boolean/README view
@@ -0,0 +1,3 @@++A general boolean algebra class and some instances for haskell. +The main module is Boolean.Algebra.
+ CacheIO.hs view
@@ -0,0 +1,188 @@++module CacheIO(+    -- cacheIO+    CacheIO,+    cacheIO,+    cacheIOeq,+    newCacheIO,+    MonadIO(..),+    JVar,+    modifyJVar,+    readJVar,+    waitJVar,+    waitJVarEq,+    waitJVarBy,+    newJVar,+    Readable(..),+    Writable(..),+    Token,+    waitJVarToken,+    badToken,+    combineVal++    ) where+++import Control.Monad.Trans+import Control.Concurrent+import Monad+import System.Mem.StableName+import Control.Exception+import System.IO.Unsafe(unsafePerformIO)+import Data.IORef+--import IOExts++newtype CacheIO a = CacheIO { unCacheIO :: (IO (a, [IO Bool])) }+++newCacheIO :: CacheIO a -> IO (IO a)+newCacheIO (CacheIO c) =  newMVar  (undefined, return False) >>= \mv -> return $ modifyMVar mv $ \z@(x,dep) -> do+    up <- dep+    if up then return (z,x) else c >>= \(x,deps) -> return ((x, (foldl (liftM2 (&&)) (return True) deps)),x)+++cacheIO :: IO a -> CacheIO a+cacheIO io = CacheIO $ do+    v <- io+    sn <- makeStableName $! v+    let cc = do+        v <- io+        sn' <- makeStableName $! v+        return $ sn == sn'+    return (v,[cc])+++cacheIOeq :: Eq a => IO a -> CacheIO a+cacheIOeq io = CacheIO $ do+    v <- io+    let cc = do+        v' <- io+        return $ v == v'+    return (v,[cc])++instance Functor CacheIO where+    fmap = liftM++instance Monad CacheIO where+    {-# INLINE (>>=) #-}+    {-# INLINE return #-}+    CacheIO a >>= b = CacheIO $ a >>= \(x,cv) -> unCacheIO (b x) >>= \(y,cv') -> return  (y,cv ++ cv')+    return a = CacheIO (return (a, []))++instance MonadIO CacheIO where+    {-# INLINE liftIO #-}+    liftIO a = CacheIO $ a >>= \x -> return (x,[])+++newtype JVar a = JVar (MVar (a,[MVar ()]))+newtype Token a = Token (StableName a)++newJVar :: a -> IO (JVar a)+newJVar x = do+    mv <- newMVar (x,[])+    return $ JVar mv++modifyJVar :: JVar a -> (a -> IO (a,b)) -> IO b+modifyJVar (JVar mv) action = modifyMVar mv $ \(v,ws) -> do+    (nv, r) <- action v+    mapM_ (flip putMVar ()) ws+    return ((nv,[]),r)++readJVar :: JVar a -> IO a+readJVar (JVar mv) = readMVar mv >>= \(x,_) -> return x++badToken :: Token a+badToken = Token $ unsafePerformIO $ makeStableName myUndefined where+    myUndefined = myUndefined++waitJVarToken :: JVar a -> Token a -> IO (a,Token a)+waitJVarToken = undefined++waitJVarEq :: Eq a => JVar a -> a -> IO a+waitJVarEq = waitJVarBy (==)++waitJVarBy :: (a -> a -> Bool) -> JVar a -> a -> IO a+waitJVarBy eq jv@(JVar mv) a = do+    rv <- modifyMVar mv $ \v@(b,ws) -> if a `eq` b then do+            w <- newEmptyMVar+            return ((b,w:ws),Left w)+        else return (v,Right b)+    case rv of+        (Left w) -> takeMVar w >>= \() -> waitJVarBy eq jv a+        (Right v) -> return v+++waitJVar :: JVar a -> a -> IO a+waitJVar jv@(JVar mv) a = do+    rv <- modifyMVar mv $ \v@(b,ws) -> do+        an <- makeStableName $! a+        bn <- makeStableName $! b+        if an == bn then do+            w <- newEmptyMVar+            return ((b,w:ws),Left w)+         else return (v,Right b)+    case rv of+        (Left w) -> takeMVar w >>= \() -> waitJVar  jv a+        (Right v) -> return v++instance Readable JVar where+    readVal x = liftIO $ readJVar x++instance Writable JVar where+    modifyVal a b = liftIO $ modifyJVar a b++instance Readable MVar where+    readVal x = liftIO $ readMVar x+instance Writable MVar where+    modifyVal a b = liftIO $ modifyMVar a b++class Readable c where+    readVal :: MonadIO m => c a -> m a++newtype ArbitraryReader a = ArbitraryReader (IO a)++instance Readable ArbitraryReader where+    readVal (ArbitraryReader x) = liftIO x++combineVal :: (Readable c1,Readable c2) => c1 a -> c2 b -> IO (ArbitraryReader (a,b))+combineVal sva svb = do+    let lsv = do+	av <- readVal sva+	bv <- readVal svb+        return (av,bv)+    return $ ArbitraryReader lsv++instance Readable IO where+    readVal = liftIO++class Readable c => Writable c where+    writeVal :: MonadIO m => c a -> a -> m ()+    swapVal :: MonadIO m => c a -> a -> m a+    modifyVal :: MonadIO m => c a -> (a -> IO (a,b)) -> m b+    modifyVal_ :: MonadIO m => c a -> (a -> IO a) -> m ()+    mapVal :: MonadIO m => c a -> (a -> a) -> m ()++    writeVal v x = swapVal v x >> return ()+    swapVal v x = modifyVal v $ \y -> return (x,y)+    modifyVal_ v action = modifyVal v $ \y -> action y >>= \x -> return (x,())+    mapVal v f = modifyVal_ v (return . f)+++newtype StrictVar v a = StrictVar (v a)++instance Readable v => Readable (StrictVar v) where+    readVal (StrictVar  mv) = readVal mv++instance Writable v => Writable (StrictVar v) where+    modifyVal (StrictVar mv) f = modifyVal mv (\x -> f x >>= \(nx,r) -> evaluate nx >>= \nnx -> return (nnx,r))+++instance Readable IORef where+    readVal x = liftIO $ readIORef x++instance Writable IORef where+    modifyVal ior f = liftIO $ do+        v <- readIORef ior+        (nv,r) <- f v+        writeIORef ior nv+        return r
+ Charset.hs view
@@ -0,0 +1,70 @@+module Charset(stringToBytes, bytesToString, charsetSetup, csHPutStr) where++import qualified Codec.Binary.UTF8.String as U+import System+import Char+import Word(Word8)+import System.IO.Unsafe+import List+import EIO+import ErrorLog+import Data.IORef+import MyLocale++{-# NOINLINE stb_r #-}+{-# NOINLINE bts_r #-}+stb_r = unsafePerformIO $ newIORef toLatin1+bts_r = unsafePerformIO $ newIORef fromSingleByte++{-# INLINE stringToBytes #-}+stringToBytes :: String -> [Word8]+stringToBytes s = f s where+    f = unsafePerformIO $ readIORef stb_r++{-# INLINE bytesToString #-}+bytesToString :: [Word8] -> String+bytesToString s = f s where+    f = unsafePerformIO $ readIORef bts_r+++charMap = [+    (["UTF8"],(U.encode,U.decode)),+    (["ASCII", "ANSIX341968"],(toAscii,fromSingleByte)),+    (["LATIN1","ISO88591"],(toLatin1,fromSingleByte)) ]+++normalize s = map toUpper . filter isAlphaNum $ s++charsetSetup :: Maybe String -> IO ()+charsetSetup (Just s) = case [x| (al ,x) <- charMap, normalize s `elem` al ] of+    ((a,b):_) -> writeIORef stb_r a >> writeIORef bts_r b+    _ -> return ()+charsetSetup Nothing = do+    --ts <- getCharset+    es <- tryMapM id [getCharset, getEnv "LC_CTYPE", getEnv "LANG", return "LATIN1"]+    let (cn,(a,b)) = head [(head al,x)| e <- es, (al ,x) <- charMap,  any (`isSuffixOf` (normalize e)) al ]+    putLog LogInfo ("chose charset " ++ cn ++ " via " ++ show es)+    writeIORef stb_r a >> writeIORef bts_r b++++toAscii :: String -> [Word8]+toAscii s = map f s where+    f x | ord x > 127 = fromIntegral (ord '?')+    f x = fromIntegral $ ord x++toLatin1 :: String -> [Word8]+toLatin1 s = map f s where+    f x | ord x > 255 = fromIntegral (ord '?')+    f x = fromIntegral $ ord x++fromSingleByte :: [Word8] -> String+fromSingleByte = map (chr . fromIntegral)++++csHPutStr h s = do+    conv <- readIORef stb_r+    putRaw h (conv s)++
+ CircularBuffer.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE ParallelListComp, PatternGuards #-}+module CircularBuffer(+    CircularBuffer,+    new,+    get,+    append,+    toList,+    CircularBuffer.length+    ) where++import Control.Concurrent+import Data.Array.IO++data Meta = Full {-# UNPACK #-} !Int | Partial {-# UNPACK #-} !Int+data CircularBuffer e = CB { arr :: !(IOArray Int e), mvar :: !(MVar Meta)}+--    FullCB    { start :: !Int, arr ::  }+--    | PartialCB { len :: !Int, arr :: !(IOArray Int e) }++new :: Int -> IO (CircularBuffer a)+new s | s < 1 = fail "cannot create that small of a circular buffer"+new s = do+    a <- newArray_ (0,s - 1)+    m <- newMVar $ Partial 0+    return CB { mvar = m,  arr = a }++get :: CircularBuffer a -> Int -> IO a+get CB { arr = arr, mvar = mvar} w = withMVar mvar go where+    go (Partial 0) = fail "attempt to read empty CircularBuffer"+    go (Partial len) = do+        let m = w `mod` len+            w' = if m < 0 then m + len else m+        readArray arr w'+    go (Full start) = do+        bnds <- getBounds arr+        let m = (w + start) `mod` len+            w' = if m < 0 then m + len else m+            len = snd bnds + 1+        readArray arr w'++length :: CircularBuffer a -> IO Int+length CB { arr = arr, mvar = mvar} = withMVar mvar go where+    go (Full _) = do+        bnds <- getBounds arr+        return $ (snd bnds) + 1+    go (Partial len) = return len++append :: CircularBuffer a -> [a] -> IO ()+append CB {arr = arr, mvar = mvar} xs = do+    bnds <- getBounds arr+    let alen = snd bnds + 1+        xslen = Prelude.length xs+        go _ | xslen >= alen = do+            sequence_ [writeArray arr i e | i <- [0..] | e <- (drop $ xslen - alen) xs  ]+            return (Full 0)+        go (Full start) = do+            let nstart = (start + xslen) `mod` alen+            sequence_ [writeArray arr (i `mod` alen) e | i <- [start..] | e <-  xs  ]+            return (Full nstart)+        go (Partial len) | len + xslen ==  alen = do+            sequence_ [writeArray arr i e | i <- [len..] | e <-  xs  ]+            return (Full 0)+        go (Partial len) | nlen <- len + xslen, nlen < alen = do+            sequence_ [writeArray arr i e | i <- [len..] | e <-  xs  ]+            return (Partial nlen)+        go (Partial len)  = do+            sequence_ [writeArray arr (i `mod` alen) e | i <- [len..] | e <-  xs  ]+            return (Full (xslen + len - alen))+    modifyMVar_ mvar go++++--prepend :: CircularBuffer a -> [a] -> IO ()++toList :: CircularBuffer a -> IO [a]+toList CB { arr = arr, mvar = mvar} = withMVar mvar go where+    go (Partial len) = do+        es <- getElems arr+        return (take len es)+    go (Full start) = do+        es <- getElems arr+        let (a,b) = splitAt start es+        return (b ++ a)++--first cb = read cb 0+--last cb = read cb -1+
+ ConfigFile.hs view
@@ -0,0 +1,188 @@+module ConfigFile(+    configLookupBool,+    configLookup,+    configLookupList,+    configLookupElse,+    -- new interface+    configGet,+    configSetup,+    reloadConfigFiles,+    mapConfig,+    configFile,+    configEnv,+    configDefault,+    configShow,+    toConfig,+    defaultConfig,+    parseConfigFile+++    ) where++import Char+import System+import System.IO.Unsafe++import CacheIO+import ErrorLog+import Data.Monoid++newtype Config = Config (String -> IO [(String,(String,String))])+type ConfigFile = [(String, String)]++toConfig = Config++-- dealing with global config settings+++{-# NOTINLINE config_default #-}+config_default :: JVar Config+config_default = unsafePerformIO (newJVar mempty)+++configSetup :: Config -> IO ()+configSetup c = writeVal config_default c >> reloadConfigFiles++defaultConfig :: IO Config+defaultConfig = readVal config_default++configGet :: String -> IO [(String,(String,String))]+configGet k = do+        Config c <- defaultConfig+        v <- c k+        mapM fixUp v where+            fixUp (w,(k,v)) = do+                v' <- conv v+                return (w,(k,v'))+            conv v = case (span (/= '$') v) of+                (xs,"") -> return xs+                (xs,('$':'$':ys)) -> conv ys >>= \r -> return (xs ++ "$" ++ r)+                (xs,('$':c:ys)) | isDigit c -> conv ys >>= \r -> return (xs ++ ['$',c] ++ r)+                (xs,('$':ys)) -> case span isPropName ys of+                    (pn,ys) -> do+                        n <- configLookupElse pn ""+                        r <- conv ys+                        return (xs ++ n ++ r)+                _ -> error "shouldn't happen"+++-- | reload all configuration files emit a config signal.+reloadConfigFiles :: IO ()+reloadConfigFiles = writeVal config_files_var [] {->> signal configSignal ()-}+++++{-# NOTINLINE config_files_var #-}+config_files_var :: JVar [(String,ConfigFile)]+config_files_var = unsafePerformIO (newJVar [])+++basicLookup n cl k = return [ (n,(k,v)) | (k',v) <- cl, k == k']++configDefault :: [(String,String)] -> Config+configDefault cl = Config $ \k -> basicLookup "default" cl k++configFile :: String -> Config+configFile fn = Config $ \k -> do+    cf <- readVal config_files_var+    case lookup fn cf of+	Just cl -> basicLookup fn cl k+	Nothing -> do+	    cl <- catchMost (fmap parseConfigFile $ readFile fn) (\_ -> return [])+	    mapVal config_files_var ((fn,cl):)+	    basicLookup fn cl k++configEnv :: Config+configEnv = Config $ \k -> do+    ev <- catch (fmap return $ getEnv k) (\_ -> return [])+    return $ fmap (\v -> ("enviornment", (k,v))) ev++mapConfig :: (String -> String) -> Config -> Config+mapConfig f (Config c) = Config $ \s -> c (f s)++instance Monoid Config where+    mempty =  Config $ \_ -> return []+    mappend (Config c1) (Config c2) = Config $ \s -> do+	x <- c1 s+	y <- c2 s+	return (x ++ y)++configShow :: [String] -> Config -> IO String+configShow ss (Config c) = do+    v <- mapM c ss+    return $ unlines $ map p $ zip ss v where+	p (k,((w,(k',v))):_) = k ++ " " ++ v ++ "\n#  in " ++ w +++	    if k' /= k then " as " ++ k' else ""+	p (k,[]) = "#" ++ k ++ " Not Found."+++-- types of config sources:+-- enviornment+-- enviornment after transformation of query+-- file+-- default++++++isPropName c = isAlphaNum c || c `elem` "-_"++parseConfigFile :: String -> ConfigFile+parseConfigFile s = concatMap bl (fixup $ lines (uncomment s)) where+    uncomment ('#':xs) = uncomment (dropWhile (/= '\n') xs)+    uncomment ('-':'-':xs) = uncomment (dropWhile (/= '\n') xs)+    uncomment (x:xs) = x:uncomment xs+    uncomment [] = []+    fixup (x:y@(c:_):xs) | isSpace c = fixup ((x ++ y):xs)+    fixup (x:xs) = x: fixup xs+    fixup [] = []+    bl s = let (n,r) = span isPropName (dropWhile isSpace s) in+	if null n then [] else [(n,dropWhile isSpace r)]++{-++{-# NOINLINE config_file_var #-}+config_file_var :: SVar ConfigFile+config_file_var = unsafePerformIO $ newSVar []+++loadStdConfiguration :: String -> IO ()+loadStdConfiguration f = do+    c <- getConfiguration f+    writeSVar config_file_var c+    return ()++getConfiguration :: String -> IO ConfigFile+getConfiguration s = do+    e <- getEnv "HOME"+    c <- readFile (e ++ "/" ++ s)+    return $ parseConfigFile c+-}++configLookupBool k = do+    x <- configLookup k+    case x of+	Just s | cond -> return True where+	    cond = (map toLower s) `elem` ["true", "yes", "on", "y", "t"]+	_ -> return False+++configLookup k = do+    vs <- configGet k+    case vs of+        ((_,(_,v)):_) -> return $ Just v+        [] -> return Nothing+++configLookupList k = do+    vs <- configGet k+    return $ [ y| (_,(_,y)) <- vs]++configLookupElse k e = do+    v <- configLookup k+    case v of+        Just v -> return v+        Nothing -> return e+
+ Curses.hsc view
@@ -0,0 +1,1180 @@+{-# LANGUAGE OverlappingInstances, ForeignFunctionInterface, EmptyDataDecls, GeneralizedNewtypeDeriving #-}+module Curses (+    --------------------------------------------------------------------++    Window,      -- data Window deriving Eq+    stdScr,      -- :: Window+    initScr,     -- :: IO Window+    cBreak,      -- :: Bool -> IO ()+    raw,         -- :: Bool -> IO ()+    echo,        -- :: Bool -> IO ()+    nl,          -- :: Bool -> IO ()+    intrFlush,   -- :: Bool -> IO ()+    keypad,      -- :: Window -> Bool -> IO ()+    initCurses,  -- :: IO ()+    useDefaultColors, -- :: IO ()+    endWin,      -- :: IO ()+    resizeTerminal,++    --------------------------------------------------------------------++    scrSize,          -- :: IO (Int, Int)+    refresh,          -- :: IO ()++    --------------------------------------------------------------------++    hasColors,      -- :: IO Bool+    startColor,     -- :: IO ()+    Pair(..),       -- newtype Pair = Pair Int deriving (Eq, Ord, Ix)+    colorPairs,     -- :: IO Int+    Color(..),      -- newtype Color = Color Int deriving (Eq, Ord, Ix)+    colors,         -- :: IO Int+--    black, red, green, yellow, blue, magenta, cyan, white, -- :: Color+    initPair,       -- :: Pair -> Color -> Color -> IO ()+    pairContent,    -- :: Pair -> IO (Color, Color)+    canChangeColor, -- :: IO Bool+    initColor,      -- :: Color -> (Int, Int, Int) -> IO ()+    colorContent,   -- :: Color -> IO (Int, Int, Int)+    withColor,+    withColorId,+    withAttr,++    --------------------------------------------------------------------++    Attr,  -- data Attr deriving Eq+    attr0, -- :: Attr++    isAltCharset, isBlink, isBold, isDim, isHorizontal, isInvis,+    isLeft, isLow, isProtect, isReverse, isRight, isStandout, isTop,+    isUnderline, isVertical,+        -- :: Attr -> Bool++    setAltCharset, setBlink, setBold, setDim, setHorizontal, setInvis,+    setLeft, setLow, setProtect, setReverse, setRight, setStandout,+    setTop, setUnderline, setVertical,+        -- :: Attr -> Bool -> Attr++    attrSet, -- :: Attr -> Pair -> IO ()+    attrOn, attrOff,++    --------------------------------------------------------------------++    wAddStr,+    addLn,         -- :: IO ()+    mvWAddStr,+    wMove,++    --------------------------------------------------------------------++    bkgrndSet,      -- :: Attr -> Pair -> IO ()+    erase,          -- :: IO ()+    wclear,         -- :: Window -> IO ()+    clrToEol,       -- :: IO ()+    move,           -- :: Int -> Int -> IO ()++    -- Cursor Routines+    CursorVisibility(..),+    withCursor,++    standout,standend,+    attrDim, attrBold,+    attrDimOn, attrDimOff,+    attrBoldOn, attrBoldOff,+    wAttrOn,+    wAttrOff,+    touchWin,+    --------------------------------------------------------------------+    -- Mouse Routines+    withMouseEventMask,+    ButtonEvent(..),+    MouseEvent(..),++    --------------------------------------------------------------------++    Key(..),+    getCh,+    newPad, pRefresh, delWin, newWin,+    wClrToEol,+    withProgram,++{-+    ulCorner, llCorner, urCorner, lrCorner, rTee, lTee, bTee, tTee, hLine,+    vLine, plus, s1, s9, diamond, ckBoard, degree, plMinus, bullet,+    lArrow, rArrow, dArrow, uArrow, board, lantern, block,+    s3, s7, lEqual, gEqual, pi, nEqual, sterling,+-}++    beep, wAttrSet, wAttrGet,++    cursesSigWinch,+    cursesTest+    )++    --------------------------------------------------------------------+    where++import Prelude hiding (pi)+import Monad+import Char           (chr, ord, isPrint, isSpace, toLower)+import Ix             (Ix)++import Control.Concurrent+import Foreign+import Foreign.C++import Control.Exception hiding(block)++import GenUtil(foldl')+import System.Posix.Signals+import List+import Doc.Chars hiding(elem)+import Maybe+import Data.IORef+++#include "my_curses.h"+++------------------------------------------------------------------------++fi = fromIntegral++throwIfErr :: Num a => String -> IO a -> IO a+--throwIfErr name act = do+--    res <- act+--    if res == (#const ERR)+--        then ioError (userError ("Curses: "++name++" failed"))+--        else return res+throwIfErr s = throwIf (== (#const ERR)) (\a -> "Curses[" ++ show a ++ "]:"  ++ s)++throwIfErr_ :: Num a => String -> IO a -> IO ()+throwIfErr_ name act = void $ throwIfErr name act++------------------------------------------------------------------------++data WindowTag+type Window = Ptr WindowTag++stdScr :: Window+stdScr = unsafePerformIO (peek stdscr)+--foreign import ccall "static my_curses.h &stdscr" stdscr :: Ptr Window+foreign import ccall "my_curses.h get_stdscr" stdscr :: Ptr Window+++initScr :: IO Window+initScr = throwIfNull "initscr" initscr+foreign import ccall unsafe "my_curses.h initscr" initscr :: IO Window++cBreak :: Bool -> IO ()+cBreak True  = throwIfErr_ "cbreak"   cbreak+cBreak False = throwIfErr_ "nocbreak" nocbreak+foreign import ccall unsafe "my_curses.h cbreak" cbreak :: IO CInt+foreign import ccall unsafe "my_curses.h nocbreak" nocbreak :: IO CInt++raw :: Bool -> IO ()+raw False = throwIfErr_ "noraw" noraw+raw True  = throwIfErr_ "raw"   raw_c+foreign import ccall unsafe "my_curses.h noraw" noraw :: IO CInt+foreign import ccall unsafe "my_curses.h raw" raw_c :: IO CInt++echo :: Bool -> IO ()+echo False = throwIfErr_ "noecho" noecho+echo True  = throwIfErr_ "echo"   echo_c+foreign import ccall unsafe "my_curses.h noecho" noecho :: IO CInt+foreign import ccall unsafe "my_curses.h echo" echo_c :: IO CInt++nl :: Bool -> IO ()+nl True  = throwIfErr_ "nl"   nl_c+nl False = throwIfErr_ "nonl" nonl+foreign import ccall unsafe "my_curses.h nl" nl_c :: IO CInt+foreign import ccall unsafe "my_curses.h nonl" nonl :: IO CInt++intrFlush :: Bool -> IO ()+intrFlush bf =+    throwIfErr_ "intrflush" $ intrflush stdScr (if bf then 1 else 0)+foreign import ccall unsafe "my_curses.h intrflush" intrflush :: Window -> (#type bool) -> IO CInt++keypad :: Window -> Bool -> IO ()+keypad win bf =+    throwIfErr_ "keypad" $ keypad_c win (if bf then 1 else 0)+foreign import ccall unsafe "my_curses.h keypad" keypad_c :: Window -> (#type bool) -> IO CInt++foreign import ccall unsafe "my_curses.h leaveok" leaveok_c :: Window -> (#type bool) -> IO CInt++leaveOk True = leaveok_c stdScr 1+leaveOk False = leaveok_c stdScr 0++useDefaultColors :: IO ()++#if HAVE_USE_DEFAULT_COLORS+foreign import ccall unsafe "my_curses.h use_default_colors" use_default_colors :: IO ()++defaultBackground = Color (-1)+defaultForeground = Color (-1)++foreign import ccall unsafe "my_curses.h define_key" define_key :: Ptr CChar -> CInt -> IO ()+defineKey k s =  withCString s (\s -> define_key s k) >> return ()++useDefaultColors = do+    b <- hasColors+    when b $ do+        use_default_colors+        initColorPairs defaultBackground++#else++useDefaultColors = return ()++++defaultBackground = Color (#const COLOR_BLACK)+defaultForeground = Color (#const COLOR_WHITE)++defineKey k s = return ()++#endif++{-# NOINLINE nColorPairs #-}+nColorPairs :: IORef Int+nColorPairs = unsafePerformIO $ newIORef 0++-- we want only full intensity colors, and assume the default 88- and 256-color xterm palettes+initColorPairs :: Color -> IO ()+initColorPairs bg = do+    cs <- colors+    ps <- colorPairs+    ccc <- canChangeColor+    icp ccc (min cs ps) >>= writeIORef nColorPairs+    where+    f n m = initPair (Pair n) (Color m) bg+    i l = zipWithM_ f [1 .. n] l >> return n where n = length l+    -- the full intensity colors of a w*w*w rgb box+    rgbbox w = [ b+o |+	  b <- [0, w*w .. (w-2)*w*w ],+	  o <- [w-1, 2*w-1 .. (w-1)*w-1] -- blue+	    ++ [(w-1)*w .. w*w-1] ] -- green+	++ [(w-1)*w*w .. w*w*w-1] -- red+    icp _ n+      | n < 2 = return 0+      | n < 8 = initPair (Pair 1) defaultForeground bg >> return 1+      | n == 88 = i $ [1 .. 7] ++ map (16+) (rgbbox 4)+      | n >= 256 = i $ [1 .. 7] ++ map (16+) (rgbbox 6)+      | otherwise = i [1 .. 7]++initCurses :: IO ()+initCurses = do+    initScr+    b <- hasColors+    when b $ do+        startColor+	initColorPairs (Color 0)+    --when b useDefaultColors+    --cBreak True+    cbreak+    echo False+    nl False+    leaveOk True+    intrFlush False+    keypad stdScr True+    defineKey (#const KEY_UP) "\x1b[1;2A"+    defineKey (#const KEY_DOWN) "\x1b[1;2B"+    defineKey (#const KEY_SLEFT) "\x1b[1;2D"+    defineKey (#const KEY_SRIGHT) "\x1b[1;2C"++endWin :: IO ()+endWin = throwIfErr_ "endwin" endwin+foreign import ccall unsafe "my_curses.h endwin" endwin :: IO CInt++------------------------------------------------------------------------++scrSize :: IO (Int, Int)+scrSize = do+    lines <- peek linesPtr+    cols  <- peek colsPtr+    return (fromIntegral lines, fromIntegral cols)++--foreign import ccall "my_curses.h &LINES" linesPtr :: Ptr CInt+--foreign import ccall "my_curses.h &COLS" colsPtr :: Ptr CInt++foreign import ccall "my_curses.h get_LINES" linesPtr :: Ptr CInt+foreign import ccall "my_curses.h get_COLS" colsPtr :: Ptr CInt+++refresh :: IO ()+refresh = throwIfErr_ "refresh" refresh_c+foreign import ccall unsafe "my_curses.h refresh" refresh_c :: IO CInt++------------------------------------------------------------------------++hasColors :: IO Bool+hasColors = liftM (/= 0) has_colors+foreign import ccall unsafe "my_curses.h has_colors" has_colors :: IO (#type bool)++startColor :: IO ()+startColor = throwIfErr_ "start_color" start_color+foreign import ccall unsafe start_color :: IO CInt++newtype Pair = Pair Int deriving (Eq, Ord, Ix)++colorPairs :: IO Int+colorPairs = fmap fromIntegral $ peek colorPairsPtr+++--foreign import ccall "my_curses.h &COLOR_PAIRS" colorPairsPtr :: Ptr CInt+foreign import ccall "my_curses.h get_COLOR_PAIRS" colorPairsPtr :: Ptr CInt++newtype Color = Color Int deriving (Eq, Ord, Ix)++colors :: IO Int+colors = liftM fromIntegral $ peek colorsPtr++--foreign import ccall "my_curses.h &COLORS" colorsPtr :: Ptr CInt+foreign import ccall "my_curses.h get_COLORS" colorsPtr :: Ptr CInt++--black, red, green, yellow, blue, magenta, cyan, white :: Color++color :: String -> Maybe Color+color "default"  = Just $ Color (-1)+color "black"    = Just $ Color (#const COLOR_BLACK)+color "red"      = Just $ Color (#const COLOR_RED)+color "green"    = Just $ Color (#const COLOR_GREEN)+color "yellow"   = Just $ Color (#const COLOR_YELLOW)+color "blue"     = Just $ Color (#const COLOR_BLUE)+color "magenta"  = Just $ Color (#const COLOR_MAGENTA)+color "cyan"     = Just $ Color (#const COLOR_CYAN)+color "white"    = Just $ Color (#const COLOR_WHITE)+color _ =  Nothing++data Attribute = Attribute [String] String String+parseAttr :: String -> Attribute+parseAttr s = Attribute as fg bg where+    rs = filter (not . f . head) $ groupBy (\x y -> f x && f y) (map toLower s)+    as = filter (`elem` attributes) rs+    col x = if isJust (color x) then return x else Nothing+    fg = fromJust $ msum (map (cGet "fg") rs)  `mplus` msum (map col rs) `mplus` return "default"+    bg = fromJust $ msum (map (cGet "bg") rs) `mplus` return "default"+    f ',' = True+    f c | isSpace c = True+    f _ = False+    cGet p r | (p ++ ":") `isPrefixOf` r = col (drop (length p + 1) r)+    cGet _ _ = Nothing+    attributes = ["normal", "bold", "blink", "dim", "reverse", "underline" ]+++initPair :: Pair -> Color -> Color -> IO ()+initPair (Pair p) (Color f) (Color b) =+    throwIfErr_ "init_pair" $+        init_pair (fromIntegral p) (fromIntegral f) (fromIntegral b)+foreign import ccall unsafe init_pair :: CShort -> CShort -> CShort -> IO CInt++pairContent :: Pair -> IO (Color, Color)+pairContent (Pair p) =+    alloca $ \fPtr ->+    alloca $ \bPtr -> do+        throwIfErr "pair_content" $ pair_content (fromIntegral p) fPtr bPtr+        f <- peek fPtr+        b <- peek bPtr+        return (Color (fromIntegral f), Color (fromIntegral b))+foreign import ccall unsafe pair_content :: CShort -> Ptr CShort -> Ptr CShort -> IO CInt++canChangeColor :: IO Bool+canChangeColor = liftM (/= 0) can_change_color+foreign import ccall unsafe can_change_color :: IO (#type bool)++initColor :: Color -> (Int, Int, Int) -> IO ()+initColor (Color c) (r, g, b) =+    throwIfErr_ "init_color" $+        init_color (fromIntegral c) (fromIntegral r) (fromIntegral g) (fromIntegral b)+foreign import ccall unsafe init_color :: CShort -> CShort -> CShort -> CShort -> IO CInt++colorContent :: Color -> IO (Int, Int, Int)+colorContent (Color c) =+    alloca $ \rPtr ->+    alloca $ \gPtr ->+    alloca $ \bPtr -> do+        throwIfErr "color_content" $ color_content (fromIntegral c) rPtr gPtr bPtr+        r <- peek rPtr+        g <- peek gPtr+        b <- peek bPtr+        return (fromIntegral r, fromIntegral g, fromIntegral b)+foreign import ccall unsafe color_content :: CShort -> Ptr CShort -> Ptr CShort -> Ptr CShort -> IO CInt++foreign import ccall unsafe "my_curses.h hs_curses_color_pair" colorPair :: Pair -> (#type chtype)++-------------+-- Attributes+-------------++foreign import ccall unsafe "my_curses.h attr_set" attr_set :: Attr -> CShort -> Ptr a -> IO Int+-- foreign import ccall unsafe "my_curses.h attr_get" :: Attr -> CShort -> Ptr a -> IO Int++foreign import ccall unsafe "my_curses.h wattr_set" wattr_set :: Window -> Attr -> CInt -> Ptr a -> IO CInt+foreign import ccall unsafe "my_curses.h wattr_get" wattr_get :: Window -> Ptr Attr -> Ptr CShort -> Ptr a -> IO CInt++foreign import ccall "my_curses.h attr_on" attr_on :: (#type attr_t) -> Ptr a -> IO Int+foreign import ccall "my_curses.h attr_off" attr_off :: (#type attr_t) -> Ptr a -> IO Int+foreign import ccall "my_curses.h attron" attron :: Int -> IO Int+foreign import ccall "my_curses.h attroff" attroff :: Int -> IO Int+foreign import ccall unsafe "my_curses.h wattron" wattron :: Window -> CInt -> IO CInt+foreign import ccall unsafe "my_curses.h wattroff" wattroff :: Window -> CInt -> IO CInt+foreign import ccall standout :: IO Int+foreign import ccall standend :: IO Int++wAttrSet :: Window -> (Attr,Pair) -> IO ()+wAttrSet w (a,(Pair p)) = throwIfErr_ "wattr_set" $ wattr_set w a (fromIntegral p) nullPtr+wAttrGet :: Window -> IO (Attr,Pair)+wAttrGet w =  alloca $ \pa -> alloca $ \pp -> (throwIfErr_ "wattr_get" $ wattr_get w pa pp nullPtr) >> (peek pa >>=  \a -> peek pp >>=  \p -> return (a,Pair (fromIntegral p)))++withColor :: Window -> Pair -> IO a -> IO a+withColor win np action = do+    x <- hasColors+    if x then (do+        (a,p) <- wAttrGet win+        wAttrSet win (a,np)+        x <- action+        wAttrSet win (a,p)+        return x)+      else action++withColorId :: Window -> Int -> IO a -> IO a+withColorId win c action = do+    ncp <- readIORef nColorPairs+    if ncp == 0 +      then action+      else withColor win (Pair $ 1 + c `mod` ncp) action++newtype Attr = Attr (#type attr_t) deriving (Eq,Storable,Bits, Num, Show)++attr0 :: Attr+attr0 = Attr (#const WA_NORMAL)++isAltCharset, isBlink, isBold, isDim, isHorizontal, isInvis, isLeft,+    isLow, isProtect, isReverse, isRight, isStandout, isTop,+    isUnderline, isVertical+    :: Attr -> Bool+isAltCharset = isAttr (#const WA_ALTCHARSET)+isBlink      = isAttr (#const WA_BLINK)+isBold       = isAttr (#const WA_BOLD)+isDim        = isAttr (#const WA_DIM)+isHorizontal = isAttr (#const WA_HORIZONTAL)+isInvis      = isAttr (#const WA_INVIS)+isLeft       = isAttr (#const WA_LEFT)+isLow        = isAttr (#const WA_LOW)+isProtect    = isAttr (#const WA_PROTECT)+isReverse    = isAttr (#const WA_REVERSE)+isRight      = isAttr (#const WA_RIGHT)+isStandout   = isAttr (#const WA_STANDOUT)+isTop        = isAttr (#const WA_TOP)+isUnderline  = isAttr (#const WA_UNDERLINE)+isVertical   = isAttr (#const WA_VERTICAL)++isAttr :: (#type attr_t) -> Attr -> Bool+isAttr bit (Attr a) = a .&. bit /= 0++setAltCharset, setBlink, setBold, setDim, setHorizontal, setInvis,+    setLeft, setLow, setProtect, setReverse, setRight, setStandout,+    setTop, setUnderline, setVertical+    :: Attr -> Bool -> Attr+setAltCharset = setAttr (#const WA_ALTCHARSET)+setBlink      = setAttr (#const WA_BLINK)+setBold       = setAttr (#const WA_BOLD)+setDim        = setAttr (#const WA_DIM)+setHorizontal = setAttr (#const WA_HORIZONTAL)+setInvis      = setAttr (#const WA_INVIS)+setLeft       = setAttr (#const WA_LEFT)+setLow        = setAttr (#const WA_LOW)+setProtect    = setAttr (#const WA_PROTECT)+setReverse    = setAttr (#const WA_REVERSE)+setRight      = setAttr (#const WA_RIGHT)+setStandout   = setAttr (#const WA_STANDOUT)+setTop        = setAttr (#const WA_TOP)+setUnderline  = setAttr (#const WA_UNDERLINE)+setVertical   = setAttr (#const WA_VERTICAL)++setAttr :: (#type attr_t) -> Attr -> Bool -> Attr+setAttr bit (Attr a) False = Attr (a .&. complement bit)+setAttr bit (Attr a) True  = Attr (a .|.            bit)++attrSet :: Attr -> Pair -> IO ()+attrSet attr (Pair p) = throwIfErr_ "attrset" $+    attr_set attr (fromIntegral p) nullPtr++attrOn :: Attr -> IO ()+attrOn (Attr attr) = throwIfErr_ "attr_on" $+    attr_on attr nullPtr+++attrOff :: Attr -> IO ()+attrOff (Attr attr) = throwIfErr_ "attr_off" $+    attr_off attr nullPtr+++withAttr :: Window -> Int -> IO a -> IO a+withAttr win attr action = do+    x <- wAttrGet win+    wAttrOn win attr+    a <- action+    wAttrSet win x+    return a++wAttrOn :: Window -> Int -> IO ()+wAttrOn w x = throwIfErr_ "wattron" $ wattron w (fi x)++wAttrOff :: Window -> Int -> IO ()+wAttrOff w x = throwIfErr_ "wattroff" $ wattroff w (fi x)++attrDimOn :: IO ()+attrDimOn  = throwIfErr_ "attron A_DIM" $+    attron (#const A_DIM)++attrDimOff :: IO ()+attrDimOff = throwIfErr_ "attroff A_DIM" $+    attroff (#const A_DIM)++attrBoldOn :: IO ()+attrBoldOn  = throwIfErr_ "attron A_BOLD" $+    attron (#const A_BOLD)++attrBoldOff :: IO ()+attrBoldOff = throwIfErr_ "attroff A_BOLD" $+    attroff (#const A_BOLD)+++attrDim :: Int+attrDim = (#const A_DIM)+attrBold :: Int+attrBold = (#const A_BOLD)++------------------------------------------------------------------------+++mvWAddStr :: Window -> Int -> Int -> String -> IO ()+mvWAddStr w y x str = wMove w y x >> wAddStr w str++addLn :: IO ()+addLn = wAddStr stdScr "\n"++sanifyOutput :: String -> String+sanifyOutput = map f . filter (/= '\r') where+    f c | isPrint c  = c+        | otherwise = '~'++#if defined(__STDC_ISO_10646__)  && defined(HAVE_WADDNWSTR)++--wAddStr :: Window -> String -> IO ()+--wAddStr w str = throwIfErr_ ("waddnwstr: " ++ show str) $ withCWStringLen (sanifyOutput str) (\(ws,len) -> waddnwstr w ws (fi len))++foreign import ccall unsafe waddnwstr :: Window -> CWString -> CInt -> IO CInt+foreign import ccall unsafe waddch :: Window -> (#type chtype) -> IO CInt++wAddStr :: Window -> String -> IO ()+wAddStr win str = do+    let+        convStr f = case f [] of+            [] -> return ()+            s  -> throwIfErr_ "waddnstr" $+                withCWStringLen  (sanifyOutput s) (\(ws,len) ->  (waddnwstr win ws (fi len)))+        loop []        acc = convStr acc+        loop (ch:str') acc = recognize+            ch+            (loop str' (acc . (ch:)))+            (\ch' -> do+                convStr acc+                throwIfErr "waddch" $ waddch win ch'+                loop str' id)+    loop str id++#else+++foreign import ccall unsafe waddnstr :: Window -> CString -> CInt -> IO CInt+foreign import ccall unsafe waddch :: Window -> (#type chtype) -> IO CInt++wAddStr :: Window -> String -> IO ()+wAddStr win str = do+    let+        convStr f = case f [] of+            [] -> return ()+            s  -> throwIfErr_ "waddnstr" $+                withCStringLen  (sanifyOutput s) (\(ws,len) ->  (waddnstr win ws (fi len)))+        loop []        acc = convStr acc+        loop (ch:str') acc = recognize+            ch+            (loop str' (acc . (ch:)))+            (\ch' -> do+                convStr acc+                throwIfErr "waddch" $ waddch win ch'+                loop str' id)+    loop str id+#endif+{-++wAddStr :: Window -> String -> IO ()+wAddStr w str =  withLCStringLen (sanifyOutput str) (\(ws,len) -> throwIfErr_ ("waddnstr: " ++ show len ++ " " ++ show str) $ waddnstr w ws (fi len))+foreign import ccall unsafe waddch :: Window -> (#type chtype) -> IO CInt++wAddStr :: Window -> String -> IO ()+wAddStr win str = do+    let+        convStr f = case f [] of+            [] -> return ()+            s  -> throwIfErr_ "waddnstr" $+                withLCString  (sanifyOutput s) (\(ws,len) ->  (waddnstr win ws (fi len)))+        loop []        acc = convStr acc+        loop (ch:str') acc = recognize+            ch+            (loop str' (acc . (ch:)))+            (\ch' -> do+                convStr acc+                throwIfErr "waddch" $ waddch win ch'+                loop str' id)+    loop str id+-}+------------------------------------------------------------------------++#let translate_attr attr =                              \+    "(if a .&. %lu /= 0 then %lu else 0) .|.",          \+    (unsigned long) WA_##attr, (unsigned long) A_##attr++bkgrndSet :: Attr -> Pair -> IO ()+bkgrndSet (Attr a) p = bkgdset $+    fromIntegral (ord ' ') .|.+    #translate_attr ALTCHARSET+    #translate_attr BLINK+    #translate_attr BOLD+    #translate_attr DIM+    #translate_attr INVIS+    #translate_attr PROTECT+    #translate_attr REVERSE+    #translate_attr STANDOUT+    #translate_attr UNDERLINE+    colorPair p+foreign import ccall unsafe bkgdset :: (#type chtype) -> IO ()++erase :: IO ()+erase = throwIfErr_ "erase" $ werase_c  stdScr+foreign import ccall unsafe "werase" werase_c :: Window -> IO CInt++wclear :: Window -> IO ()+wclear w = throwIfErr_ "wclear" $ wclear_c  w+foreign import ccall unsafe "wclear" wclear_c :: Window -> IO CInt++++clrToEol :: IO ()+clrToEol = throwIfErr_ "clrtoeol" clrtoeol+foreign import ccall unsafe clrtoeol :: IO CInt++move :: Int -> Int -> IO ()+move y x =+    throwIfErr_ "move" $ move_c (fromIntegral y) (fromIntegral x)+foreign import ccall unsafe "move" move_c :: CInt -> CInt -> IO CInt++wMove :: Window -> Int -> Int -> IO ()+wMove w y x = throwIfErr_ "wmove" $ wmove w (fi y) (fi x)+foreign import ccall unsafe  wmove :: Window -> CInt -> CInt -> IO CInt++------------------+-- Cursor routines+------------------++data CursorVisibility = CursorInvisible | CursorVisible | CursorVeryVisible++vis_c :: CursorVisibility -> CInt+vis_c vis = case vis of+    CursorInvisible   -> 0+    CursorVisible     -> 1+    CursorVeryVisible -> 2++foreign import ccall unsafe "my_curses.h curs_set" curs_set :: CInt -> IO CInt++cursSet 0 = leaveOk True >> curs_set 0+cursSet n = leaveOk False >> curs_set n++withCursor :: CursorVisibility -> IO a -> IO a+withCursor nv action = Control.Exception.bracket (cursSet (vis_c nv)) (\v -> case v of+		(#const ERR) -> return 0+		x -> cursSet x) (\_ -> action)++++------------------------------------------------------------------------++foreign import ccall unsafe doupdate :: IO CInt++touchWin :: Window -> IO ()+touchWin w = throwIfErr_ "touchwin" $ touchwin w+foreign import ccall touchwin :: Window -> IO CInt++newPad :: Int -> Int -> IO Window+newPad nlines ncols = throwIfNull "newpad" $ newpad (fromIntegral nlines) (fromIntegral ncols)++pRefresh :: Window -> Int -> Int -> Int -> Int -> Int -> Int -> IO ()+pRefresh pad pminrow pmincol sminrow smincol smaxrow smaxcol = throwIfErr_ "prefresh" $+    prefresh pad (fromIntegral pminrow) (fromIntegral pmincol) (fromIntegral sminrow) (fromIntegral smincol) (fromIntegral smaxrow) (fromIntegral smaxcol)++delWin :: Window -> IO ()+delWin w = throwIfErr_ "delwin" $ delwin w++foreign import ccall unsafe prefresh :: Window -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt+foreign import ccall unsafe newpad :: CInt -> CInt -> IO Window+foreign import ccall unsafe delwin :: Window -> IO CInt+++newWin :: Int -> Int -> Int -> Int -> IO Window+newWin nlines ncolumn begin_y begin_x = throwIfNull "newwin" $ newwin (fi nlines) (fi ncolumn) (fi begin_y) (fi begin_x)++foreign import ccall unsafe newwin :: CInt -> CInt -> CInt -> CInt -> IO Window+++wClrToEol :: Window -> IO ()+wClrToEol w = throwIfErr_ "wclrtoeol" $ wclrtoeol w+foreign import ccall unsafe wclrtoeol :: Window -> IO CInt+++++foreign import ccall threadsafe getch :: IO CInt+++foreign import ccall unsafe def_prog_mode :: IO CInt+foreign import ccall unsafe reset_prog_mode :: IO CInt+foreign import ccall unsafe flushinp :: IO CInt+++withProgram :: IO a -> IO a+withProgram action = withCursor CursorVisible $ Control.Exception.bracket_ (endWin) (flushinp) action+--withProgram action = withCursor CursorVisible $ Control.Exception.bracket_ ({-def_prog_mode >> -}endWin) (return ()){-reset_prog_mode-} action+++foreign import ccall unsafe "my_curses.h beep" c_beep :: IO CInt+foreign import ccall unsafe "my_curses.h flash" c_flash :: IO CInt++beep :: IO ()+beep = do+    br <- c_beep+    when (br /= (#const OK)) (c_flash >> return ())+++---------------+-- Key Routines+---------------++data Key+    = KeyChar Char | KeyBreak | KeyDown | KeyUp | KeyLeft | KeyRight+    | KeyHome | KeyBackspace | KeyF Int | KeyDL | KeyIL | KeyDC+    | KeyIC | KeyEIC | KeyClear | KeyEOS | KeyEOL | KeySF | KeySR+    | KeyNPage | KeyPPage | KeySTab | KeyCTab | KeyCATab | KeyEnter+    | KeySReset | KeyReset | KeyPrint | KeyLL | KeyA1 | KeyA3+    | KeyB2 | KeyC1 | KeyC3 | KeyBTab | KeyBeg | KeyCancel | KeyClose+    | KeyCommand | KeyCopy | KeyCreate | KeyEnd | KeyExit | KeyFind+    | KeyHelp | KeyMark | KeyMessage | KeyMove | KeyNext | KeyOpen+    | KeyOptions | KeyPrevious | KeyRedo | KeyReference | KeyRefresh+    | KeyReplace | KeyRestart | KeyResume | KeySave | KeySBeg+    | KeySCancel | KeySCommand | KeySCopy | KeySCreate | KeySDC+    | KeySDL | KeySelect | KeySEnd | KeySEOL | KeySExit | KeySFind+    | KeySHelp | KeySHome | KeySIC | KeySLeft | KeySMessage | KeySMove+    | KeySNext | KeySOptions | KeySPrevious | KeySPrint | KeySRedo+    | KeySReplace | KeySRight | KeySRsume | KeySSave | KeySSuspend+    | KeySUndo | KeySuspend | KeyUndo | KeyResize | KeyMouse | KeyUnknown Int+    deriving (Eq,Show,Ord)++decodeKey :: CInt -> Key+decodeKey key = case key of+    _ | key >= 0 && key <= 255 -> KeyChar (chr (fromIntegral key))+    (#const KEY_BREAK)         -> KeyBreak+    (#const KEY_DOWN)          -> KeyDown+    (#const KEY_UP)            -> KeyUp+    (#const KEY_LEFT)          -> KeyLeft+    (#const KEY_RIGHT)         -> KeyRight+    (#const KEY_HOME)          -> KeyHome+    (#const KEY_BACKSPACE)     -> KeyBackspace+    _ | key >= (#const KEY_F0) && key <= (#const KEY_F(63))+                               -> KeyF (fromIntegral (key - #const KEY_F0))+    (#const KEY_DL)            -> KeyDL+    (#const KEY_IL)            -> KeyIL+    (#const KEY_DC)            -> KeyDC+    (#const KEY_IC)            -> KeyIC+    (#const KEY_EIC)           -> KeyEIC+    (#const KEY_CLEAR)         -> KeyClear+    (#const KEY_EOS)           -> KeyEOS+    (#const KEY_EOL)           -> KeyEOL+    (#const KEY_SF)            -> KeySF+    (#const KEY_SR)            -> KeySR+    (#const KEY_NPAGE)         -> KeyNPage+    (#const KEY_PPAGE)         -> KeyPPage+    (#const KEY_STAB)          -> KeySTab+    (#const KEY_CTAB)          -> KeyCTab+    (#const KEY_CATAB)         -> KeyCATab+    (#const KEY_ENTER)         -> KeyEnter+    (#const KEY_SRESET)        -> KeySReset+    (#const KEY_RESET)         -> KeyReset+    (#const KEY_PRINT)         -> KeyPrint+    (#const KEY_LL)            -> KeyLL+    (#const KEY_A1)            -> KeyA1+    (#const KEY_A3)            -> KeyA3+    (#const KEY_B2)            -> KeyB2+    (#const KEY_C1)            -> KeyC1+    (#const KEY_C3)            -> KeyC3+    (#const KEY_BTAB)          -> KeyBTab+    (#const KEY_BEG)           -> KeyBeg+    (#const KEY_CANCEL)        -> KeyCancel+    (#const KEY_CLOSE)         -> KeyClose+    (#const KEY_COMMAND)       -> KeyCommand+    (#const KEY_COPY)          -> KeyCopy+    (#const KEY_CREATE)        -> KeyCreate+    (#const KEY_END)           -> KeyEnd+    (#const KEY_EXIT)          -> KeyExit+    (#const KEY_FIND)          -> KeyFind+    (#const KEY_HELP)          -> KeyHelp+    (#const KEY_MARK)          -> KeyMark+    (#const KEY_MESSAGE)       -> KeyMessage+    (#const KEY_MOVE)          -> KeyMove+    (#const KEY_NEXT)          -> KeyNext+    (#const KEY_OPEN)          -> KeyOpen+    (#const KEY_OPTIONS)       -> KeyOptions+    (#const KEY_PREVIOUS)      -> KeyPrevious+    (#const KEY_REDO)          -> KeyRedo+    (#const KEY_REFERENCE)     -> KeyReference+    (#const KEY_REFRESH)       -> KeyRefresh+    (#const KEY_REPLACE)       -> KeyReplace+    (#const KEY_RESTART)       -> KeyRestart+    (#const KEY_RESUME)        -> KeyResume+    (#const KEY_SAVE)          -> KeySave+    (#const KEY_SBEG)          -> KeySBeg+    (#const KEY_SCANCEL)       -> KeySCancel+    (#const KEY_SCOMMAND)      -> KeySCommand+    (#const KEY_SCOPY)         -> KeySCopy+    (#const KEY_SCREATE)       -> KeySCreate+    (#const KEY_SDC)           -> KeySDC+    (#const KEY_SDL)           -> KeySDL+    (#const KEY_SELECT)        -> KeySelect+    (#const KEY_SEND)          -> KeySEnd+    (#const KEY_SEOL)          -> KeySEOL+    (#const KEY_SEXIT)         -> KeySExit+    (#const KEY_SFIND)         -> KeySFind+    (#const KEY_SHELP)         -> KeySHelp+    (#const KEY_SHOME)         -> KeySHome+    (#const KEY_SIC)           -> KeySIC+    (#const KEY_SLEFT)         -> KeySLeft+    (#const KEY_SMESSAGE)      -> KeySMessage+    (#const KEY_SMOVE)         -> KeySMove+    (#const KEY_SNEXT)         -> KeySNext+    (#const KEY_SOPTIONS)      -> KeySOptions+    (#const KEY_SPREVIOUS)     -> KeySPrevious+    (#const KEY_SPRINT)        -> KeySPrint+    (#const KEY_SREDO)         -> KeySRedo+    (#const KEY_SREPLACE)      -> KeySReplace+    (#const KEY_SRIGHT)        -> KeySRight+    (#const KEY_SRSUME)        -> KeySRsume+    (#const KEY_SSAVE)         -> KeySSave+    (#const KEY_SSUSPEND)      -> KeySSuspend+    (#const KEY_SUNDO)         -> KeySUndo+    (#const KEY_SUSPEND)       -> KeySuspend+    (#const KEY_UNDO)          -> KeyUndo+#ifdef KEY_RESIZE+    (#const KEY_RESIZE)        -> KeyResize+#endif+#ifdef KEY_MOUSE+    (#const KEY_MOUSE)        -> KeyMouse+#endif+    _                          -> KeyUnknown (fromIntegral key)++++++getCh :: IO Key+getCh = threadWaitRead 0 >> (liftM decodeKey $ throwIfErr "getch" getch)++--getCh :: IO Key+--getCh = liftM decodeKey $ throwIfErr "getch" getch++-- getCh :: IO Key+-- getCh = do+--     nodelay stdScr 1+--     --halfdelay 1+--     v <- getch+--     case v of+-- 	(#const ERR) -> yield >> getCh+-- 	x -> return $ decodeKey x+++resizeTerminal :: Int -> Int -> IO ()++#ifdef HAVE_RESIZETERM++resizeTerminal a b = throwIfErr_ "resizeterm"  $ resizeterm (fi a) (fi b)++foreign import ccall unsafe "my_curses.h resizeterm" resizeterm :: CInt -> CInt -> IO CInt++#else++resizeTerminal _ _ = return ()++#endif+++cursesSigWinch :: Maybe Signal++#ifdef SIGWINCH++cursesSigWinch = Just (#const SIGWINCH)++#else++cursesSigWinch = Nothing++#endif++++------------+-- Test case+------------++cursesTest :: IO ()+cursesTest = do+    initScr+    hc <- hasColors+    when hc startColor+    ccc <- canChangeColor+    (ys,xs) <- scrSize+    cp <- colorPairs+    cs <- colors+    endWin+    putStrLn $ "ScreenSize: " ++ show (xs,ys)+    putStrLn $ "hasColors: " ++ show hc+    putStrLn $ "canChangeColor: " ++ show ccc+    putStrLn $ "colorPairs: " ++ show cp+    putStrLn $ "colors: " ++ show cs+++++-----------------+-- Mouse Routines+-----------------++data MouseEvent = MouseEvent {+    mouseEventId :: Int,+    mouseEventX :: Int,+    mouseEventY :: Int,+    mouseEventZ :: Int,+    mouseEventButton :: [ButtonEvent]+   } deriving(Show)++data ButtonEvent = ButtonPressed Int | ButtonReleased Int | ButtonClicked Int |+    ButtonDoubleClicked Int | ButtonTripleClicked Int | ButtonShift | ButtonControl | ButtonAlt+	deriving(Eq,Show)++withMouseEventMask :: [ButtonEvent] -> IO a -> IO a++#ifdef KEY_MOUSE++foreign import ccall unsafe "my_curses.h mousemask" mousemask :: (#type mmask_t) -> Ptr (#type mmask_t) -> IO (#type mmask_t)++withMouseEventMask bes action = do+    ov <- alloca (\a ->  mousemask (besToMouseMask bes) a >> peek a)+    r <- action+    mousemask ov nullPtr+    return r++besToMouseMask :: [ButtonEvent] -> (#type mmask_t)+besToMouseMask bes = foldl' (.|.) 0 (map cb bes) where+    cb (ButtonPressed 1) = (#const BUTTON1_PRESSED)+    cb (ButtonPressed 2) = (#const BUTTON2_PRESSED)+    cb (ButtonPressed 3) = (#const BUTTON3_PRESSED)+    cb (ButtonPressed 4) = (#const BUTTON4_PRESSED)+    cb (ButtonReleased 1) = (#const BUTTON1_RELEASED)+    cb (ButtonReleased 2) = (#const BUTTON2_RELEASED)+    cb (ButtonReleased 3) = (#const BUTTON3_RELEASED)+    cb (ButtonReleased 4) = (#const BUTTON4_RELEASED)+    cb (ButtonClicked 1) = (#const BUTTON1_CLICKED)+    cb (ButtonClicked 2) = (#const BUTTON2_CLICKED)+    cb (ButtonClicked 3) = (#const BUTTON3_CLICKED)+    cb (ButtonClicked 4) = (#const BUTTON4_CLICKED)+    cb ButtonShift = (#const BUTTON_SHIFT)+    cb ButtonAlt = (#const BUTTON_ALT)+    cb ButtonControl = (#const BUTTON_CTRL)+    cb _ = 0+++#else+withMouseEventMask _ a = a++#endif+++++{-+ulCorner, llCorner, urCorner, lrCorner, rTee, lTee, bTee, tTee, hLine,+    vLine, plus, s1, s9, diamond, ckBoard, degree, plMinus, bullet,+    lArrow, rArrow, dArrow, uArrow, board, lantern, block,+    s3, s7, lEqual, gEqual, pi, nEqual, sterling+    :: Char++ulCorner = chr 0x250C+llCorner = chr 0x2514+urCorner = chr 0x2510+lrCorner = chr 0x2518+rTee     = chr 0x2524+lTee     = chr 0x251C+bTee     = chr 0x2534+tTee     = chr 0x252C+hLine    = chr 0x2500+vLine    = chr 0x2502+plus     = chr 0x253C+s1       = chr 0x23BA -- was: 0xF800+s9       = chr 0x23BD -- was: 0xF804+diamond  = chr 0x25C6+ckBoard  = chr 0x2592+degree   = chr 0x00B0+plMinus  = chr 0x00B1+bullet   = chr 0x00B7+lArrow   = chr 0x2190+rArrow   = chr 0x2192+dArrow   = chr 0x2193+uArrow   = chr 0x2191+board    = chr 0x2591+lantern  = chr 0x256C+block    = chr 0x2588+s3       = chr 0x23BB -- was: 0xF801+s7       = chr 0x23BC -- was: 0xF803+lEqual   = chr 0x2264+gEqual   = chr 0x2265+pi       = chr 0x03C0+nEqual   = chr 0x2260+sterling = chr 0x00A3+-}++-- #if defined(__STDC_ISO_10646__)  && defined(HAVE_WADDNWSTR)+-- #else++#if 1++recognize :: Char -> IO a -> ((#type chtype) -> IO a) -> IO a+recognize ch noConvert convert+    | ch <= '\x7F'   = noConvert -- Handle the most common case first.+    | [ch] == ulCorner = convert =<< hs_curses_acs_ulcorner+    | [ch] == llCorner = convert =<< hs_curses_acs_llcorner+    | [ch] == urCorner = convert =<< hs_curses_acs_urcorner+    | [ch] == lrCorner = convert =<< hs_curses_acs_lrcorner+    | [ch] == rTee     = convert =<< hs_curses_acs_rtee+    | [ch] == lTee     = convert =<< hs_curses_acs_ltee+    | [ch] == bTee     = convert =<< hs_curses_acs_btee+    | [ch] == tTee     = convert =<< hs_curses_acs_ttee+    | [ch] == hLine    = convert =<< hs_curses_acs_hline+    | [ch] == vLine    = convert =<< hs_curses_acs_vline+    | [ch] == plus     = convert =<< hs_curses_acs_plus+    | [ch] == s1       = convert =<< hs_curses_acs_s1+    | [ch] == s9       = convert =<< hs_curses_acs_s9+    | [ch] == diamond  = convert =<< hs_curses_acs_diamond+    | [ch] == ckBoard  = convert =<< hs_curses_acs_ckboard+    | [ch] == degree   = convert =<< hs_curses_acs_degree+    | [ch] == plMinus  = convert =<< hs_curses_acs_plminus+    | [ch] == bullet   = convert =<< hs_curses_acs_bullet+--    | [ch] == lArrow   = convert =<< hs_curses_acs_larrow+--    | [ch] == rArrow   = convert =<< hs_curses_acs_rarrow+--    | [ch] == dArrow   = convert =<< hs_curses_acs_darrow+--    | [ch] == uArrow   = convert =<< hs_curses_acs_uarrow+--    | [ch] == board    = convert =<< hs_curses_acs_board+--    | [ch] == lantern  = convert =<< hs_curses_acs_lantern+--    | [ch] == block    = convert =<< hs_curses_acs_block    -- not usually available+#  ifdef ACS_S3+    | [ch] == s3       = convert =<< hs_curses_acs_s3+    | [ch] == s7       = convert =<< hs_curses_acs_s7+    | [ch] == lEqual   = convert =<< hs_curses_acs_lequal+    | [ch] == gEqual   = convert =<< hs_curses_acs_gequal+    | [ch] == pi       = convert =<< hs_curses_acs_pi+    | [ch] == nEqual   = convert =<< hs_curses_acs_nequal+    | [ch] == sterling = convert =<< hs_curses_acs_sterling+#  endif+    | otherwise      = noConvert++foreign import ccall unsafe hs_curses_acs_ulcorner :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_llcorner :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_urcorner :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_lrcorner :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_rtee     :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_ltee     :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_btee     :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_ttee     :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_hline    :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_vline    :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_plus     :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_s1       :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_s9       :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_diamond  :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_ckboard  :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_degree   :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_plminus  :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_bullet   :: IO (#type chtype)+--foreign import ccall unsafe hs_curses_acs_larrow   :: IO (#type chtype)+--foreign import ccall unsafe hs_curses_acs_rarrow   :: IO (#type chtype)+--foreign import ccall unsafe hs_curses_acs_darrow   :: IO (#type chtype)+--foreign import ccall unsafe hs_curses_acs_uarrow   :: IO (#type chtype)+--foreign import ccall unsafe hs_curses_acs_board    :: IO (#type chtype)+--foreign import ccall unsafe hs_curses_acs_lantern  :: IO (#type chtype)+--foreign import ccall unsafe hs_curses_acs_block    :: IO (#type chtype)+#  ifdef ACS_S3+foreign import ccall unsafe hs_curses_acs_s3       :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_s7       :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_lequal   :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_gequal   :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_pi       :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_nequal   :: IO (#type chtype)+foreign import ccall unsafe hs_curses_acs_sterling :: IO (#type chtype)+#  endif++#endif++-------------------------+-- code graveyard+-------------------------+++++#if 0++addStr :: String -> IO ()+addStr str =+    throwIfErr_ "addstr" $+    withCStringConv (readIORef cursesOutConv) str addstr+foreign import ccall unsafe addstr :: Ptr CChar -> IO CInt++addStrLn :: Strin -> IO ()+addStrLn str = do addStr str; addLn++wAddStr :: Window -> String -> IO ()+wAddStr w str = throwIfErr_ "waddstr" $+    withCStringConv (readIORef cursesOutConv) str (waddstr w)++foreign import ccall unsafe waddstr :: Window -> Ptr CChar -> IO CInt+++addGraphStr :: String -> IO ()+addGraphStr str = do+    conv <- readIORef cursesOutConv+    let+        convStr f = case f [] of+            [] -> return ()+            s  -> throwIfErr_ "addstr" $+                withCStringConv (return conv) s addstr+        loop []        acc = convStr acc+        loop (ch:str') acc = recognize+            ch+            (loop str' (acc . (ch:)))+            (\ch' -> do+                convStr acc+                throwIfErr "addch" $ addch ch'+                loop str' id)+    loop str id++addGraphStrLn :: String -> IO ()+addGraphStrLn str = do addGraphStr str; addLn+++#endif
+ Doc/Chars.hs view
@@ -0,0 +1,71 @@+-- | A variety of useful constant documents representing many unicode characters.++module Doc.Chars where++import Char(chr)+import Doc.DocLike++ulCorner, llCorner, urCorner, lrCorner, rTee, lTee, bTee, tTee, hLine,+ vLine, plus, s1, s9, diamond, ckBoard, degree, plMinus, bullet, lArrow,+ rArrow, dArrow, uArrow, board, lantern, block, s3, s7, lEqual, gEqual,+ pi, nEqual, sterling, coloncolon, alpha, beta, lambda, forall, exists,+ box, bot, bottom, top, pI, lAmbda, star, elem, notElem, and, or, sqoparen, sqcparen  :: TextLike a => a++ulCorner  = char $ chr 0x250C+llCorner = char $ chr 0x2514+urCorner = char $ chr 0x2510+lrCorner = char $ chr 0x2518+rTee     = char $ chr 0x2524+lTee     = char $ chr 0x251C+bTee     = char $ chr 0x2534+tTee     = char $ chr 0x252C+hLine    = char $ chr 0x2500+vLine    = char $ chr 0x2502+plus     = char $ chr 0x253C+s1       = char $ chr 0x23BA -- was: 0xF800+s9       = char $ chr 0x23BD -- was: 0xF804+diamond  = char $ chr 0x25C6+ckBoard  = char $ chr 0x2592+degree   = char $ chr 0x00B0+plMinus  = char $ chr 0x00B1+bullet   = char $ chr 0x00B7+lArrow   = char $ chr 0x2190+rArrow   = char $ chr 0x2192+dArrow   = char $ chr 0x2193+uArrow   = char $ chr 0x2191+board    = char $ chr 0x2591+lantern  = char $ chr 0x256C+block    = char $ chr 0x2588+s3       = char $ chr 0x23BB -- was: 0xF801+s7       = char $ chr 0x23BC -- was: 0xF803+lEqual   = char $ chr 0x2264+gEqual   = char $ chr 0x2265+pi       = char $ chr 0x03C0+nEqual   = char $ chr 0x2260+sterling = char $ chr 0x00A3++coloncolon = char $ chr 0x2237  -- ∷++alpha    = char $ chr 0x03b1  -- α+beta     = char $ chr 0x03b2  -- β+++lambda   = char $ chr 0x03bb  -- λ+forall   = char $ chr 0x2200  -- ∀+exists   = char $ chr 0x2203  -- ∃+box      = char $ chr 0x25a1  -- □++bot      = char $ chr 0x22a5  -- ⊥+bottom   = char $ chr 0x22a5  -- ⊥+top      = char $ chr 0x22a4  -- T+pI       = char $ chr 0x03a0+lAmbda   = char $ chr 0x039b  -- Λ  (capital λ)+and      = char $ chr 0x2227  -- ∧+or       = char $ chr 0x2228  -- ∨+star     = char $ chr 0x22c6+elem     = char $ chr 0x2208  -- ∈+notElem  = char $ chr 0x2209++sqoparen = char $ chr 0x3014  -- 〔+sqcparen = char $ chr 0x3015  --  〕+
+ Doc/DocLike.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE UndecidableInstances, OverlappingInstances, TypeSynonymInstances, FlexibleInstances #-}+module Doc.DocLike where++import Data.Monoid+import Control.Monad.Reader()+import List+import qualified Text.PrettyPrint.HughesPJ as P++infixr 5 <$> -- ,<//>,<$>,<$$>+infixr 6 <>+infixr 6 <+>+++class TextLike a where+    empty :: a+    text :: String -> a+    --string :: String -> a+    char :: Char -> a+    --char '\n' = string "\n"+    char x = text [x]+    empty = text ""+++class (TextLike a) => DocLike a where+    (<>) :: a -> a -> a+    (<+>) :: a -> a -> a+    (<$>) :: a -> a -> a+    hsep :: [a] -> a+    hcat :: [a] -> a+    vcat :: [a] -> a+    tupled :: [a] -> a+    list :: [a] -> a+    semiBraces :: [a] -> a+    enclose :: a -> a -> a -> a+    encloseSep :: a -> a -> a -> [a] -> a++    hcat [] = empty+    hcat xs = foldr1 (<>) xs+    hsep [] = empty+    hsep xs = foldr1 (<+>) xs+    vcat [] = empty+    vcat xs = foldr1 (\x y -> x <> char '\n' <> y) xs+    x <+> y = x <> char ' ' <> y+    x <$> y = x <> char '\n' <> y+    encloseSep l r s ds = enclose l r (hcat $ punctuate s ds)+    enclose l r x   = l <> x <> r+    list            = encloseSep lbracket rbracket comma+    tupled          = encloseSep lparen   rparen  comma+    semiBraces      = encloseSep lbrace   rbrace  semi+++------------------------+-- Basic building blocks+------------------------++tshow :: (Show a,DocLike b) => a -> b+tshow x = text (show x)++++lparen,rparen,langle,rangle,+    lbrace,rbrace,lbracket,rbracket,squote,+    dquote,semi,colon,comma,space,dot,backslash,equals+    :: TextLike a => a+lparen          = char '('+rparen          = char ')'+langle          = char '<'+rangle          = char '>'+lbrace          = char '{'+rbrace          = char '}'+lbracket        = char '['+rbracket        = char ']'++squote          = char '\''+dquote          = char '"'+semi            = char ';'+colon           = char ':'+comma           = char ','+space           = char ' '+dot             = char '.'+backslash       = char '\\'+equals          = char '='+++squotes x = enclose squote squote x+dquotes x = enclose dquote dquote x+parens x = enclose lparen rparen x+braces x = enclose lbrace rbrace x+brackets x = enclose lbracket rbracket x+angles x = enclose langle rangle x++-----------------------------------------------------------+-- punctuate p [d1,d2,...,dn] => [d1 <> p,d2 <> p, ... ,dn]+-----------------------------------------------------------+punctuate _ []      = []+punctuate _ [d]     = [d]+punctuate p (d:ds)  = (d <> p) : punctuate p ds++------------------+-- String instance+------------------+instance TextLike String where+    empty = ""+    text x = x++instance TextLike Char where+    empty = error "TextLike: empty char"+    char x = x+    text [ch] = ch+    text _ = error "TextLike: string to char"++instance DocLike String where+    a <> b = a ++ b+    a <+> b = a ++ " " ++ b+++instance TextLike ShowS where+    empty = id+    text x = (x ++)+    char c = (c:)++instance DocLike ShowS where+    a <> b = a . b++instance (TextLike a, Monad m) => TextLike (m a) where+    empty = return empty+    char x = return (char x)+    text x = return (text x)+++instance (DocLike a, Monad m,TextLike (m a)) => DocLike (m a) where+    a <$> b = do+        a <- a+        b <- b+        return (a <$> b)+    a <> b = do+        a <- a+        b <- b+        return (a <> b)+    a <+> b = do+        a <- a+        b <- b+        return (a <+> b)+    vcat xs = sequence xs >>= return . vcat+    hsep xs = sequence xs >>= return . hsep++---------------------+-- HughesPJ instances+---------------------++instance TextLike P.Doc where+    empty = P.empty+    text = P.text+    char = P.char++instance Monoid P.Doc where+    mappend = (P.<>)+    mempty = P.empty+    mconcat = P.hcat++instance DocLike P.Doc where+    (<>) = (P.<>)+    (<+>) = (P.<+>)+    (<$>) = (P.$$)+    hsep = P.hsep+    vcat = P.vcat++    --brackets = P.brackets+    --parens = P.parens++--------+-- simple instances to allow distribution of an environment+--------+--instance Monoid a => Monoid (b -> a) where+--    mempty = \_ -> mempty+--    mappend x y = \a -> mappend (x a) (y a)+--    mconcat xs = \a -> mconcat (map ($ a) xs)+--+--instance (DocLike a, Monoid (b -> a)) => DocLike (b -> a) where+--    parens x = \a -> parens (x a)+--    (<+>) x y = \a -> x a <+> y a+
+ EIO.hs view
@@ -0,0 +1,113 @@+module EIO(readRawFile,writeRawFile,  putRaw, readRaw,atomicWriteFile, getUniqueName, atomicWrite, getTempFileName, memoIO, withTempfile, hPutRawContents) where++import Char+import Control.Monad+import Control.Exception as E+import Data.Array.IO+import Data.Unique+import Directory(removeFile)+import System.IO.Unsafe+import Data.IORef+import System.Posix+import Word+import System.IO++bufSize = 4096++readRawFile :: String -> IO [Word8]+readRawFile fn = E.bracket (openBinaryFile fn ReadMode) hClose hGetRawContents++writeRawFile :: String -> [Word8] -> IO ()+writeRawFile fn xs = E.bracket (openBinaryFile fn WriteMode) hClose $ \h -> hPutRawContents h xs++hGetRawContents :: Handle -> IO [Word8]+hGetRawContents h = do+    a <- newArray_ (1,bufSize)+    getall a where+	getall a = do+	    sz <- hGetArray h a bufSize+	    av <- getElems a+	    if sz == 0 then return [] else do+		r <- getall a+		return (take sz av ++ r)++hPutRawContents :: Handle -> [Word8] -> IO ()+hPutRawContents h xs = do+    a <- newArray_ (1,bufSize)+    prc a h xs where+	prc _ _ [] = return ()+	prc a h xs@(_:_) = do+	    let (ys,zs) = splitAt bufSize xs+	    if null zs+	      then do -- work around a ghc bug in hPutArray+	        let lys = length ys+		a' <- newListArray (1,lys) ys+		hPutArray h a' lys+	      else do+		zipWithM_ (writeArray a) [1..] ys+		hPutArray h a bufSize+		prc a h zs+++putRaw :: Handle -> [Word8] -> IO ()+putRaw h v = hPutStr h (map (chr . fromIntegral) v)++readRaw :: Handle -> Int -> IO [Word8]+readRaw _ 0 = return []+readRaw h n = do+    a <- newArray_ (0,(n - 1))+    sz <- hGetArray h a n+    av <- (getElems a)+    return $! (take sz av)+-- v <- replicateM n (hGetChar h)+--    return $ map (fromIntegral . ord) v+++atomicWrite :: String -> (Handle -> IO a) -> IO a+atomicWrite fn action = do+    n <- getUniqueName+    let tn = fn ++ "." ++ n+    v <- E.bracket (openBinaryFile tn WriteMode) hClose action+    rename tn fn+    return v+++atomicWriteFile :: String -> String -> IO ()+atomicWriteFile name s = do+    n <- getUniqueName+    let tn = name ++ "." ++ n+    writeFile tn s+    rename tn name+++getUniqueName :: IO String+getUniqueName = do+    id <- getProcessID+    u <- newUnique+    n <- liftM nodeName getSystemID+    t <- epochTime+    return $ n ++ "." ++ show id ++ "." ++ show t ++ "." ++ show (hashUnique u)+++memoIO :: IO a -> IO a+memoIO ioa = do+    v <- readIORef var+    case v of+	Just x -> return x+	Nothing -> do+	    x <- ioa+	    writeIORef var (Just x)+	    return x+     where+        {-# NOTINLINE var #-}+	var = unsafePerformIO $ newIORef Nothing++getTempFileName :: IO String+getTempFileName = do+    u <- getUniqueName+    return $ "/tmp/" ++ u+++withTempfile :: (String -> IO a) -> IO a+withTempfile action = E.bracket getTempFileName removeFile action+
+ ErrorLog.hs view
@@ -0,0 +1,251 @@+-- Copyright (c) 2002 John Meacham (john@foo.net)+--+-- Permission is hereby granted, free of charge, to any person obtaining a+-- copy of this software and associated documentation files (the+-- "Software"), to deal in the Software without restriction, including+-- without limitation the rights to use, copy, modify, merge, publish,+-- distribute, sublicense, and/or sell copies of the Software, and to+-- permit persons to whom the Software is furnished to do so, subject to+-- the following conditions:+--+-- The above copyright notice and this permission notice shall be included+-- in all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+-- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+-- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+++-- | Manages an error log with proper locking. has a number of useful routines for detecting+-- and reporting erronious conditions.++module ErrorLog(+    -- * Log handling+    LogLevel(..),+    withErrorLog,+    withStartEndEntrys,+    withErrorMessage,+    setLogLevel,+    setErrorLogPutStr,+    -- ** adding log entries+    putLogLn,putLog,+    putLogException,+    -- ** annotating exceptions+    emapM, eannM,+    -- ** exception-aware composition+    retry,+    first,+    tryMap, tryMapM,+    trySeveral,+    -- ** random functions+    attempt, tryElse, tryMost, tryMost_, catchMost,+    handleMost,+    ioElse,+    indent+    ) where++import Exception as E+import IO hiding(bracket, try, catch)+import System.IO.Unsafe+import Monad+import Control.Concurrent+import Time(getClockTime)+import List(delete)++------------+-- Error log+------------++data LogLevel = LogEmergency | LogAlert | LogCritical | LogError | LogWarning | LogNotice | LogInfo | LogDebug+    deriving (Eq, Enum, Ord)++{-# NOINLINE ior #-}+ior :: MVar Handle+ior = unsafePerformIO $ newMVar stderr++{-# NOINLINE log_level #-}+log_level :: MVar LogLevel+log_level = unsafePerformIO $ newMVar LogNotice++{-# NOINLINE hPutStr_v #-}+hPutStr_v :: MVar (Handle -> String -> IO ())+hPutStr_v = unsafePerformIO $ newMVar hPutStr++-- | open file for logging and run action, with errors being logged to the file.+-- This will reinstall the old errorlog handle when it finishes, by default stderr+-- is used and this routine need not be called unless you wish to log somewhere else.+-- the filename consisting of a single dash is treated specially and sets the errorlog+-- to stderr. note, that while the errorlog will function properly with concurrent+-- applications, a single errorlog is shared by all threads.+withErrorLog :: String    -- ^ filename of log+		-> IO a      -- ^ action to execute with logging to file+		-> IO a+withErrorLog "-" action = bracket (swapMVar ior stderr) (swapMVar ior) (\_ -> action)+withErrorLog fn action = E.bracket (openFile fn WriteMode) hClose $ \h -> do+	hSetBuffering h LineBuffering+	bracket (swapMVar ior h) (swapMVar ior) (\_ -> action)++-- | sets log level to new value, returns old log level.+setLogLevel :: LogLevel -> IO LogLevel+setLogLevel ll = swapMVar log_level ll++-- | add entries to log at the start and end of action with timestamp.+-- If the action throws an exception, it will be logged along with the+-- exit entry.+withStartEndEntrys :: String  -- ^ title to use in log entries+		      -> IO a    -- ^ action to execute+		      -> IO a+withStartEndEntrys n action = do+    gct >>= \ct -> putLogLn (ct ++ " " ++ n ++ " Starting")+    handle+	(\e -> gct >>= \ct -> putLogException (ct ++ " " ++ n ++ " Ending due to Exception:" ) e >> throw e)+	(action >>= \r -> gct >>= \ct -> putLogLn (ct ++ " " ++ n ++ " Ending") >> return r) where+	    gct = getClockTime >>= \ct -> return $ "[" ++ show ct ++ "]"+++-- | run an action, printing an error message to the log if it ends with an exception.+-- this is similar to 'withStartEndEntrys' but only adds an entry on error.+withErrorMessage :: String -> IO a -> IO a+withErrorMessage n action = do+    handleMost+	(\e -> gct >>= \ct -> putLogLn (normalize n ++ ct ++ " Ending due to Exception:\n" ++ indent 4 (show e) ) >> throw e )+	action  where+	    gct = getClockTime >>= \ct -> return $ "[" ++ show ct ++ "]"+++-- | set routine with same signature as 'hPutStr' to use for writing to log.+-- useful for charset conversions which might be necisarry. By default the+-- haskell 98 'IO.hPutStr' is used.+setErrorLogPutStr :: (Handle -> String -> IO ()) -> IO ()+setErrorLogPutStr hp = swapMVar hPutStr_v hp >> return ()++++normalize :: String -> String+normalize = unlines . lines++-- | place log entry, normalize string to always have a single \'\n\' at the end+-- of the string. A single log entry is created for each 'putLogLn', do not+-- split entrys among calls to this function.+putLogLn :: String -> IO ()+putLogLn s = do+    hp <- readMVar hPutStr_v+    withMVar ior (\h -> hp h (normalize s))+    withMVar ior (\h -> hFlush h)++{-+-- | log entry, depreciated. will be used for more general logging interface at some point.+putLog :: String -> IO ()+putLog s = do+    hp <- readMVar hPutStr_v+    withMVar ior (\h -> hp h s)++-}++-- | create log entry with given loglevel. entry is normalized as in 'putLogLn'.+putLog :: LogLevel -> String -> IO ()+putLog ll s = do+    cll <- readMVar log_level+    when (ll <= cll) $ putLogLn s++-- | transform an exception with a function.+emapM :: (Exception -> Exception) -> IO a -> IO a+emapM f action = do+    handle (\e -> throw (f e)) action+++-- | annotates an exception using emapM, the original+-- type of the error cannot be recovered so this should only be used+-- if the exception is not meant to be caught later.+eannM :: String -> IO a -> IO a+eannM s action = emapM f action where+    f (ErrorCall es) = ErrorCall $ normalize s ++ normalize es+    f e = ErrorCall $ normalize s ++ normalize (show e)++-- | attempt an action, add a log entry with the exception if it+-- fails+attempt :: IO a -> IO ()+attempt action = tryMost action >>= \x -> case x of+    Left e -> putLogException "attempt ExceptionCaught" e+    Right _ -> return ()+++tryElse r x = tryMost x >>= \y -> case y of+    Left e -> putLogException "tryElse ExceptionCaught" e >> return r+    Right v -> return v++tryMost_ x = tryMost x >> return ()++tryMap :: (a -> b) -> [a] -> IO [b]+tryMap f xs = do+    ys <- mapM (tryMost . evaluate . f ) xs+    return [y|(Right y) <- ys]++tryMapM :: (a -> IO b) -> [a] -> IO [b]+tryMapM f xs = do+    ys <- mapM (tryMost . f ) xs+    return [y|(Right y) <- ys]++tryMost = E.tryJust passKilled++passKilled (AsyncException ThreadKilled) = Nothing+passKilled x = Just x++catchMost = E.catchJust passKilled+handleMost = E.handleJust passKilled++-- | return the first non-excepting action. if all actions throw exceptions,+-- the last actions exception is rethrown.+first :: [IO a] -> IO a+first [] = fail "empty  argument to first"+first [x] = x+first (x:xs) = E.try x >>= \z -> case z of+    Left e@(AsyncException ThreadKilled) -> throw e+    Left _ -> first xs+    Right v -> return v++ioElse :: IO a -> IO a -> IO a+ioElse a b = tryMost a >>= \x -> case x of+    Left _ -> b+    Right x -> return x++indent :: Int -> String -> String+indent n s = unlines $ map (replicate n ' ' ++)$ lines s++-- | Retry an action untill it succeeds.+retry :: Float      -- ^ number of seconds to pause between trys+	 -> String  -- ^ string to annotate log entries with when retrying+	 -> IO a    -- ^ action to retry+	 -> IO a+retry delay n action = do+    handleMost (\e -> putLogException (n ++ " (retrying in " ++ show delay ++ "s):") e >> threadDelay (floor $ 1000000 * delay) >> retry delay n action) action+++putLogException :: String -> Exception -> IO ()+putLogException n e =  putLog LogError (n ++ "\n" ++ indent 4 (show e))+++-- | concurrently try several IO actions, returning the result of the first to finish.+-- if all actions throw exceptions, one is passed on non-deterministically+trySeveral :: [IO a] -> IO a+trySeveral [] = error "trySeveral has nothing to try!"+trySeveral arms = do+    v <- newEmptyMVar+    ts <- mapM (forkIO . f v) arms+    g v ts where+	f v arm = do+	    t <- myThreadId+	    r <- tryMost arm+	    putMVar v (t,r)+	g v ts = do+	    (t,r) <- takeMVar v+	    let ts' = delete t ts+	    case r of+		Left e -> if null ts' then throw e else g v ts'+		Right x -> do+		    mapM_ killThread ts'+		    return x
+ ExampleConf.hsgen view
@@ -0,0 +1,10 @@+conf=ginsu.config.sample+echo "module ExampleConf(exampleConf, exampleConfFile) where"+echo "import Paths_ginsu"+echo "exampleConfFile :: IO FilePath"+echo "exampleConfFile = getDataFileName \"$conf\""+echo "{-# NOINLINE exampleConf #-}"+echo "exampleConf :: String"+echo "exampleConf = unlines ["+sed -e 's/"/\\"/g;s/.*/    "&",/' $conf+echo "  \"\"]"
+ Exception.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE CPP #-}+#if MIN_VERSION_base(4,0,0)+#define MODULE Control.OldException+#else+#define MODULE Control.Exception+#endif+module Exception (module MODULE) where import MODULE
+ Filter.hs view
@@ -0,0 +1,227 @@+{-# LANGUAGE EmptyDataDecls #-}+module Filter(+    Filter,+    BasicFilter(..),+    parseFilter,+    showFilter,+    filterAp+    ) where++import Atom+import Boolean.Algebra+import Boolean.Boolean+import Char+import PackedString+import Prelude hiding((&&),(||),not,and,or,any,all)+import Gale.Puff+import Regex+import Text.ParserCombinators.Parsec++------------------------+-- Filter implementation+------------------------++type Filter = Boolean BasicFilter++data BasicFilter =+    FilterAuthor String+    | FilterCategory Category+    | FilterRegex Atom Rx+    | FilterSearchAll Rx+    | FilterFlag Atom+    | FilterMark {-# UNPACK #-} !Char+    | FilterAlias Atom+++parseFlag :: Parser BasicFilter+parseFlag = do+    char '?'+    n <- many1 (satisfy isAlpha)+    spaces+    return $ FilterFlag (toAtom n)+++parseTrue = try $ do+    FilterFlag n <- parseFlag+    if n == toAtom "true" then return () else fail "true"+parseFalse = try $ do+    FilterFlag n <- parseFlag+    if n == toAtom "false" then return () else fail "false"+++parseBasic = parseMark <|> parseFlag <|> parseSlash <|> parseTwiddle <|> parseAlias where+    parseSlash = do+        char '/'+        s <- string+        spaces+        s <- compileRx s+        return $ FilterSearchAll s+    parseTwiddle = do+        char '~'+        f <- satisfy isAlpha+	option ':' (char ':')+        s <- string+        spaces+        z f s+    parseMark = do+        char '"'+        c <- satisfy isAlphaNum+        spaces+        return $ FilterMark c++    z 'a' s = return $ FilterAuthor s+    z 'c' s = return $ FilterCategory (catParseNew s)+    z 't' s = return $ FilterCategory (catParseNew s) -- TODO+    z 's' s = compileRx s >>= return . FilterRegex f_messageSender+    z 'k' s = compileRx s >>= return . FilterRegex f_messageKeyword+    z 'b' s = compileRx s >>= return . (FilterRegex f_messageBody)+    z x _ = fail $ "unknown filter type: ~" ++ [x]+    parseAlias = do+        n <- many1 (satisfy isAlphaNum)+        return $ FilterAlias (toAtom n)+    string = qstring <|> many1 (noneOf " \t\n':;|")+    qstring = between (char '\'') (char '\'') $ many ((char '\'' >> char '\'' >> return '\'') <|> noneOf "'")+++parseFilter :: Monad m => String -> m Filter+parseFilter s = case parse (between spaces eof pb)  "" s  of+        Left e -> fail (show e)+        Right x -> return x+    where+    pb = parseBoolean' spaces parseTrue parseFalse parseBasic++{-+parseFilter :: Monad m => String -> m Filter+parseFilter = parser (between spaces eof rmp) where+    rmp = do+	fa <- mp+	r <- rmp'+	case r of+	    [] -> return fa+	    _ -> return $ FilterOr (fa:r)+    rmp' = (do+	char ';'+	spaces+	v <- mp+	r <- rmp'+	return (v:r)) <|> return []+    mp = many1 fp >>= \v -> case v of+	    [x] -> return x+	    xs -> return $ FilterAnd xs+    fp = nf <|> flt <|> pr <|> bool <|> do s <- (token string); liftM (FilterRegex f_messageBody) (compileRx s)+    pr = do+	char '('+	spaces+	v <- rmp+	char ')'+	spaces+	return v+    nf = char '!' >> liftM FilterNot fp+    string = qstring <|> many1 (noneOf " \t\n~'!();%")+    qstring = between (char '\'') (char '\'') $ many ((char '\'' >> char '\'' >> return '\'') <|> noneOf "'")+    bool = do+	char '%'+	c <- sat isAlpha+	spaces+	return $ b c+    flt = do+	char '~'+	c <- sat isAlpha+	option ':' (char ':')+	s <- string+	spaces+	z c s+    z 'a' s = return $ FilterAuthor s+    z 'c' s = return $ FilterCategory (catParseNew s)+    z 't' s = return $ FilterCategory (catParseNew s) -- TODO+    z 's' s = compileRx s >>= return . FilterRegex f_messageSender+    z 'k' s = compileRx s >>= return . FilterRegex f_messageKeyword+    z _ s = compileRx s >>= return . (FilterRegex f_messageBody)+    b 'p' = FilterPrivate+    b 'P' = FilterNot FilterPrivate+    b _ = FilterTrue+-}++showFilter f = showBoolean showBasicFilter f++showBasicFilter :: BasicFilter -> String+showBasicFilter (FilterAuthor a) = "~a:" ++  a+showBasicFilter (FilterCategory c) = "~c:" ++ catShowNew c+showBasicFilter (FilterRegex fn s)+    | fn == f_messageKeyword = "~k:" ++ show s+    | fn == f_messageSender = "~s:" ++ show s+    | fn == f_messageBody = "~b:" ++ show s+    | otherwise = "~UNKNOWN"+showBasicFilter (FilterSearchAll s) = "/" ++ show s+showBasicFilter (FilterFlag s) = "?" ++ fromAtom s+showBasicFilter (FilterAlias x) = fromAtom x+showBasicFilter (FilterMark m) = '"':m:""+--showBasicFilter (FilterAny fn r) = "~A:" ++ toString fn ++ ":" ++ show r+--showBasicFilter (FilterRegex fn r) = "~R:" ++ toString fn ++ ":" ++ show r+--showBasicFilter (FilterNot f) = "!" ++ showFilter f+--showBasicFilter (FilterAnd fs) = concat (intersperse " " (map showFilter fs))+--showBasicFilter (FilterOr fs) = "(" ++ (concat $ intersperse " ; " (map showFilter fs)) ++ ")"+--showBasicFilter FilterPrivate = "%p"+--showBasicFilter (FilterNot FilterPrivate) = "%P"+--showBasicFilter FilterTrue = "%t"+--showBasicFilter (FilterNot FilterTrue) = "%f"++{-+applyFilterStack :: [Filter] -> [(Int, Puff)] -> [(Int, Puff)]+applyFilterStack fs = concatMap f where+    f a@(_,p) | all (flip (evaluate filterAp) p) fs = [a]+    f _ = []+-}++siglookup c (Unverifyable (Key n _):_) | c == n = True+siglookup c (Signed (Key n _):_) | c == n = True+siglookup c (_:xs) = siglookup c xs+siglookup _ [] = False++isSigned Signed {} = True+isSigned Unverifyable {} = True+isSigned _ = False++isEncrypted Encrypted {} = True+isEncrypted _ = False++{-+data FilterEnv = FilterEnv {+    feMarkLookup :: Char -> Filter,+    feAliasLookup :: Atom -> Filter,+    feIsPrivate :: Category -> Bool,+    feIsPublic :: Category -> Bool+    }+-}++data FilterEnv++filterAp :: Filter -> Puff -> Bool+filterAp f p = evaluate (filterAp' undefined p) f++filterAp' :: FilterEnv -> Puff -> BasicFilter ->  Bool+filterAp' _ p (FilterAuthor c)  = siglookup c (signature p)+filterAp' _ p (FilterCategory c) = any (`subCategory` c) (cats p)+filterAp' _ p (FilterRegex fn re) = any (matchRx re) (getFragmentStrings p fn)+filterAp' _ p (FilterSearchAll re)  = any (matchRx re) (concatMap (getFragmentForceStrings p) [f_messageBody, f_messageKeyword, f_messageSender, f_idTime] ++ cs ++ a)  where+    cs = map (packString . catShowNew) (cats p)+    a = [packString $ getAuthor p]+filterAp' _ p (FilterFlag f)+    | f == toAtom "signed" = any isSigned (signature p)+    | f == toAtom "encrypted" = any isEncrypted (signature p)+    | f == toAtom "true" = true+    | f == toAtom "false" = false+    | otherwise = false+filterAp' _ _ (FilterMark _)  = False+filterAp' _ _ (FilterAlias _) = False++--filterAp (FilterAnd fs) p = all (`filterAp` p) fs+--filterAp (FilterOr fs) p = any (`filterAp` p) fs+--filterAp (FilterAny fn re) p = any (matchRx re) (getFragmentForceStrings p fn)+--filterAp (FilterNot f) p = not $ filterAp f p+--filterAp FilterTrue _ = True+--filterAp FilterPrivate _ = False++--showFilter _ = ""++
+ Format.hs view
@@ -0,0 +1,266 @@+-- Copyright (c) 2002 John Meacham (john@foo.net)+--+-- Permission is hereby granted, free of charge, to any person obtaining a+-- copy of this software and associated documentation files (the+-- "Software"), to deal in the Software without restriction, including+-- without limitation the rights to use, copy, modify, merge, publish,+-- distribute, sublicense, and/or sell copies of the Software, and to+-- permit persons to whom the Software is furnished to do so, subject to+-- the following conditions:+--+-- The above copyright notice and this permission notice shall be included+-- in all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+-- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+-- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+++-- | General text formatting routines, similar to C printf-style formatting.+--+-- > General pattern format+-- > '%' '%'                                             output literal '%'+-- > '%' flags width '.' precision '\'' string '\''      always print string as is.+-- > '%' flags width '.' precision formatChar            passed to class instance.+-- > '%' '(' sub1, sub2, ... ')' flags width '.' precision formatChar  subpatterns+--+-- > Flags is zero or more of the following+-- > ' ' a blank should be left before positive numbers+-- > '#' value should be printed in alternate form+-- > '0' value should be zero padded+-- > '-' value should be left adjusted+-- > '+' value should always have a sign+-- > '\'' numerical values should be grouped+--+-- > formatChar is a character affecting formatting+-- > '/' always format as if by the following translation+-- >     fmt "%fx.yv" [fa x] -> fmt "%fx.ys" [fa (show x)]+-- > 'l' format as list+-- > 's' print list compactly, similar to %(%c)l+-- > 'x' hexadecimal+-- > 'i' integral+-- > 'b' binary+-- > 'o' octal+-- > 'c' print compactly, as is used in 's'+++module Format(+    -- * The Format class+    Format(..),+    -- * Functions+    -- ** Formatting routines+    fmt, fmtS, fmtSs, errorf,+    -- ** Arguments+    fa, fS, fi, fs, ff,+    -- * Internals, useful for creating instances of Format+    Pattern(..),+    formatIntegral, formatString, formatShow,+    testFormat+    ) where++import Char(isDigit,ord)+import List(intersperse)++-- | the type of patterns+data Pattern = Pattern {+    patternSub :: [String], -- ^ subpatterns+    patternFlags :: [Char],+    patternWidth :: Maybe Int,+    patternPrecision :: Maybe Int,+    patternChar :: Char+    }++pattern :: Pattern+pattern = Pattern { patternSub = [], patternFlags = [],+    patternWidth = Nothing, patternPrecision = Nothing,+    patternChar = '/' }+++++type F = Pattern -> String++-- | class for use with 'fa'+class Show a => Format a where+    format :: a -> Pattern -> String+    format = formatShow++-- | format anything+fa :: (Format a) => a -> F+fa x p | patternChar p == '/' = formatShow x p+fa x p = format x p+-- | format showable+fS :: (Show a) => a -> F+fS x = fs (show x)+-- | format integer. specialization of 'fa', useful to resolve ambiguity.+fi :: Int -> F+fi = fa+-- | format string. specialization of 'fa', useful to resolve ambiguity.+fs :: String -> F+fs = fa+-- | format float. specialization of 'fa', useful to resolve ambiguity.+ff :: Float -> F+ff = fa++++-- | main formatting routine.+-- @fmt \"%s has %i pets\" [fa \"John\", fi 3]@++fmt :: String -> [F] -> String+fmt ('%':'%':xs) fs = '%':fmt xs fs+fmt ('%':xs) (f:fs) =  case xs5 of+	('\'':cs) -> let (a,b) = gs "" cs in formatString a bp ++ fmt b fs+	(c:cs) -> f (bp {patternChar = c}) ++ fmt cs fs+	[] -> []+     where+    bp = pattern {patternSub = ss, patternFlags = flags, patternWidth = w, patternPrecision =  p}+    (flags,xs2) = span (`elem` "# 0-+'") xs+    (w,xs3) = grabNum xs2+    (p,xs4) = case xs3 of+	('.':xs) -> grabNum xs+	xs -> (Nothing, xs)+    (ss,xs5) = case xs4 of+	('(':xs) -> let (u,v) = span (/= ')') xs in ([u],tail v)+	xs -> ([],xs)+    grabNum xs = let (u,v) = span isDigit xs in if null u then (Nothing,v) else (Just (read u),v)+    gs x ('\'':'\'':cs) = gs ('\'':x) cs+    gs x ('\'':cs) = (reverse x,cs)+    gs x (c:cs) = gs (c:x) cs+    gs x [] = (reverse x,[])+fmt (x:xs) fs = x:fmt xs fs+fmt "" _ = ""++-- | format a single string+fmtS :: String -> String -> String+fmtS f x = fmt f [fs x]++-- | format a set of strings+fmtSs :: String -> [String] -> String+fmtSs f xs = fmt f (map fs xs)+++-- | throws an error created by format+errorf :: String -> [F] -> a+errorf s fs = error $ fmt s fs++putBase :: Int -> Integer -> String+putBase base x = if null v then "0" else v where+    v = reverse (foo x)+    hex = "0123456789abcdef"+    foo 0 = ""+    foo x = let (u,v) = x `divMod` (toInteger base) in+	(hex !! fromIntegral v) : foo u+++childFmt :: Pattern -> [F] -> String+childFmt (Pattern {patternSub = [s]})  = fmt s+childFmt _ = fmt "%/"++instance Format Float+instance Format ()+instance Format Int where format = formatIntegral+instance Format Integer where format = formatIntegral+instance (Format a, Format b) => Format (a,b) where+    format (x,y) p | patternChar p == 't' = format x p ++ format y p+    format x p = formatShow x p+instance Format a => Format [a] where+    format xs p | ( '#' `elem` patternFlags p) && patternChar p == 's' = "\""  ++ formatString (concatMap (flip format $ pattern {patternChar = 'c'}) xs) p ++ "\""+    format xs p | patternChar p == 's' = formatString ( concatMap (flip format $ pattern {patternChar = 'c'}) xs ) p+    format xs p | ( '#' `elem` patternFlags p) && patternChar p == 'l' = "[" ++ concat (intersperse ", " (map (\x -> childFmt p [fa x]) xs)) ++ "]"+    format xs p | patternChar p == 'l' = ( concat (map (\x -> childFmt p [fa x]) xs))+    format xs p = formatShow xs p++instance Format a => Format (Maybe a) where+    format (Just x) p = childFmt p [fa x]+    format  Nothing p = "<Nothing>"+instance Format Char where+    format x p | patternChar p == 'c' = x:[]+    format x p | patternChar p `elem` integralChars = formatIntegral (ord x) p+    format x p = formatShow x p+    --format x _  = show x++instance (Format a,Format b) => Format (Either a b) where+    format (Left x) p | ( '#' `elem` patternFlags p)  = "Left " ++ childFmt p [fa x]+    format (Right x) p | ( '#' `elem` patternFlags p)  = "Right " ++ childFmt p [fa x]+    format (Left x) p = childFmt p [fa x]+    format (Right x) p = childFmt p [fa x]++instance Format Bool where+    format True p | patternChar p == 'b' = "true"+    format False p | patternChar p == 'b' = "false"+    format v p  = formatShow v p+++formatShow :: Show a => a -> Pattern -> String+formatShow x = formatString (show x)++integralChars = "xboiu"++formatIntegral :: Integral n => n -> Pattern -> String+formatIntegral v p@(Pattern {patternChar = 'x'}) = integralFmt p v 16+formatIntegral v p@(Pattern {patternChar = 'b'}) = integralFmt p v 2+formatIntegral v p@(Pattern {patternChar = 'o'}) = integralFmt p v 8+formatIntegral v p@(Pattern {patternChar = 'i'}) = integralFmt p v 10+formatIntegral v p@(Pattern {patternChar = 'u'}) = integralFmt p v 10+formatIntegral v p = formatShow v p++integralFmt p v base = pre ++ val where+    pos = if ' ' `elem` patternFlags p then " " else if '+' `elem` patternFlags p then "+" else ""+    pre = if v < 0 then "-" else pos+    val = putBase base (abs $ toInteger v)++formatString ::  String -> Pattern -> String+formatString s p@(Pattern {patternPrecision = Just x }) = formatString (take x s) (p {patternPrecision = Nothing})+formatString s (Pattern {patternWidth = Just w }) | length s >= w = s+formatString s (Pattern {patternFlags = pf, patternWidth = Just w} ) = if '-' `elem` pf then s ++ e else e ++ s where+    e = replicate (w - length s) ' '+formatString s _ = s+++{-+fmtStr :: Bool -> Int -> String -> String+fmtStr _ 0 s = s+fmtStr False n s = take (abs n) s+fmtStr True n s | length s > (abs n) = take (abs n) s+fmtStr True n s | n > 0 =  replicate (n - length s) ' ' ++ s+fmtStr True n s | n < 0 = s ++ replicate ((negate n) - length s) ' '+-}+++------------+-- test case+------------++concatInter p xs = concat (intersperse p xs)++nums :: [Integer]+nums = [ 0,  878987, -2830,  77, 0xabcdef]++twords = ["foo", "a", "fuzz"]++fmts = ["%8i", "%-+8i", "%b", "%o", "%x"]+++tfmt :: String -> [F] -> String+tfmt f v = show (fmt f v) ++ "\t\t<- fmt \"" ++ f ++ "\" [" ++ fmt (concatInter ", " (replicate (length v) "%v")) v ++ "]" where+    fmtEsc ('%':xs) = '%':'%':fmtEsc xs+    fmtEsc (x:xs) = x:fmtEsc xs+    fmtEsc "" = ""+fmtsAp x = tfmt (unwords fmts) (replicate (length fmts) (fa x)) where+    --v = map (\(fe, f) -> "(" ++ fe ++ " " ++ f ++ ")") $ zip (map fmtEsc fmts) fmts+    fmtEsc ('%':xs) = '%':'%':fmtEsc xs+    fmtEsc (x:xs) = x:fmtEsc xs+    fmtEsc "" = ""+++testFormat = do+    putStr $ unlines (map fmtsAp nums)+    --putStr $ unlines $ map (\x -> fmt "*%s*" [fa x]) [(f,fmt f [fs x]) | f <- ["%8s","%-8s","%s"], x <- twords]+    putStr $ unlines $ [tfmt f [fa x] | f <- ["%8s","%-8s","%s", "%#s", "%2.2s", "%l", "%#l", "%#(chr 0x%x)l", "%(-)l"], x <- twords]++
+ Gale/Gale.hs view
@@ -0,0 +1,605 @@+{-# LANGUAGE OverlappingInstances, FlexibleInstances, PatternGuards #-}+module Gale.Gale(+    GaleContext,+    galeNextPuff,+    reconnectGaleContext,+    connectionStatus,+    galeSendPuff,+    hostStrings,+    galeWillPuff,+    withGale,+    galeSetProxys,+    galeAddCategories,+    verifyDestinations,+    gCategory,+    keyCache,+    getGaleDir) where+++import Char(chr,ord)+import IO hiding(bracket, bracket_)+import List+import Maybe+import System.Time++import Control.Concurrent+import Control.Exception as E+import Data.Bits+import Network.BSD+import Network.Socket+import PackedString+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString as BS++import Atom+import Control.Monad.Error (when, replicateM)+import Data.Array.IO+import Data.Monoid+import EIO+import ErrorLog+import Gale.Proto+import Gale.KeyCache+import Gale.Puff+import GenUtil hiding(replicateM)+import qualified System.Posix as Posix+import RSA+import SimpleParser++-- TODO - prove concurrent-correctness, make sure all network errors are accounted for.++-------------------+-- Gale Constants+-------------------++galePort :: PortNumber+galePort = 11512+hostStrings s = [s, "gale." ++ s, s ++ ".gale.org."]+++type PuffStatus = ()++data GaleContext = GaleContext {+    connectionStatus :: !(MVar (Either String String)),+    channel :: !(Chan Puff),+    proxy :: !(MVar [String]),+    gThread :: ThreadId,+    gHandle :: !(MVar Handle),+    gCategory :: !(MVar [Category]),+    keyCache :: !KeyCache+    }++void a = a >> return ()+++++-----------------+-- Implementation+-----------------++withGale :: [String] -> (GaleContext -> IO a) -> IO a+withGale ps io = withSocketsDo $ do+    Posix.installHandler Posix.sigPIPE Posix.Ignore Nothing+    bracket (newGaleContext ps []) destroyGaleContext io+    --gc <- newGaleContext ps []+    --r- <- io gc+    --destroyGaleContext gc+    --return r++newGaleContext ps cs = do+    let ncs = map catParseNew cs+    cats <- newMVar $ ncs+    c <- newChan+    ps <- return (case ps of [] -> snub (concatMap (hostStrings . categoryCell) ncs); _ -> ps)+    status <- newMVar $ Left $ "Attempting to connect to: " ++ unwords ps+    pmv <- newMVar ps+    hv <- newEmptyMVar+    --keycachev <- newMVar []+    --pkcache <- newMVar emptyFM+    galeDir <- getGaleDir+    keyCache <- newKeyCache galeDir+    let gc = GaleContext { connectionStatus = status, gThread = undefined, gHandle = hv, gCategory = cats, channel = c, proxy = pmv, keyCache = keyCache {- keyCache = keycachev, publicKeyCache = pkcache -} }+    thd <- forkIO (connectThread gc ps hv)+    sendGimme gc+    return gc { gThread = thd }++galeAddCategories :: GaleContext -> [Category] -> IO ()+galeAddCategories gc cs = do+    action <- modifyMVar (gCategory gc) $ \cs' ->+        let ncs = snub (cs ++ cs') in+         if ncs == cs' then return (ncs,return ()) else return (ncs,sendGimme gc)+    action+    --sendGimme gc++galeSetProxys :: GaleContext -> [String] -> IO ()+galeSetProxys gc ps = do+    modifyMVar_ (proxy gc) $ \_ -> return (snub ps)+    sendGimme gc++sendGimme :: GaleContext -> IO ()+sendGimme gc = void $ forkIO $ do+    withMVar (gHandle gc) $ \h -> do+        ncs <- readMVar $ gCategory gc+        putLog LogDebug $ "sendGimme:" ++ (show $ ncs)+        let gs = concatInter ":" (map catShowOld ncs)+        putWord32 h 2+        putWord32 h (fromIntegral $ length gs * 2)+        putRaw h $ galeEncodeString gs+        hFlush h++destroyGaleContext gc = killThread $ gThread gc++connectTo hostname port = do+    --proto <- getProtocolNumber "tcp"+    bracketOnError+	(socket AF_INET Stream 6)+	(sClose)  -- only done if there's an error+        (\sock -> do+      	  he <- getHostByName hostname+      	  connect sock (SockAddrInet port (hostAddress he))+      	  socketToHandle sock ReadWriteMode+	)++++attemptConnect s = do+    h <- connectTo s galePort+    --hSetBuffering h NoBuffering+    return (h,s)++spc [] = []+spc s = v : spc (drop 1 r) where+    (v,r) = span (/= ':') s++emptyPuffer :: MVar Handle -> IO ()+emptyPuffer hv = repeatM_ (threadDelay 30000000 >> sendEmptyPuff) where+	sendEmptyPuff = withMVar hv $ \h -> do+		putWord32 h 0+		putWord32 h 8+		putWord32 h 0+		putWord32 h 0+		hFlush h++connectThread :: GaleContext ->  [String] -> MVar Handle -> IO ()+connectThread gc _ hv = retry 5.0 ("ConnectionError") doit where+    openHandle = do+        ds <- readMVar $ proxy gc+        swapMVar (connectionStatus gc)  $ Left $ "Attempting to connect to: " ++ unwords ds+        trySeveral (map attemptConnect ds)+    doit = bracket openHandle (hClose . fst) $ \(h,hn) -> do+	putWord32 h 1+	_ <- readWord32 h  -- version+        sendGimme gc+        swapMVar (connectionStatus gc) $ Right hn+	bracket_ (putMVar hv h) (takeMVar hv) $+	  bracket (forkIO (emptyPuffer hv)) killThread $ \_ -> repeatM_ $ do+	    w <- readWord32 h+	    l <- readWord32 h+            bs <- LBS.hGet h (fromIntegral l)+	    when (w == 0) $ do+                let hash = sha1 bs+                let (cat,puff) = runGet decodePuff bs+                cat <- tryMapM parseCategoryOld (spc $ cat)+                ct <- getClockTime+                let ef = \xs -> ((fromString "_ginsu.timestamp",FragmentTime ct):(fromString "_ginsu.spumbuster", FragmentText (packString (bsToHex hash))):xs)+                p' <- galeDecryptPuff gc Puff { signature = [], cats = cat, fragments = ef puff}+                writeChan (channel gc) $ p'+                case getFragmentData p' f_answerKey' of+                    Just d -> putKey (keyCache gc) d+                    Nothing -> return ()+                case (cats p',getFragmentString p' f_answerKeyError') of+                    ([Category (n,d)],Just _) | "_gale.key." `isPrefixOf` n -> noKey (keyCache gc) (catShowNew $ Category (drop 10 n,d))+                    (_,_) -> return ()+++decodePuff :: Get (String,FragmentList)+decodePuff = do+    clen <- getWord32be+    cs <- replicateM (fromIntegral (clen `div` 2)) getWord16be+    --getWord32be+    skip 4+    fl <- decodeFrags+    return (map (chr . fromIntegral) cs, fl)+++galeNextPuff :: GaleContext -> IO Puff+galeNextPuff gc = do+    p <- readChan $ channel gc+    --p' <- galeDecryptPuff gc p+    --case getFragmentData p' f_answerKey' of+    --    Just d -> putKey (keyCache gc) d+    --    Nothing -> return ()+    putLog LogDebug $ "Puff gotten: \n" ++ (indent 4 $ showPuff p)+    return p++reconnectGaleContext gc = do+    -- p <- readMVar $ proxy gc+    void $ forkIO $ attempt $ readMVar (gHandle gc) >>= hClose+++galeSendPuff :: GaleContext -> Puff -> IO PuffStatus+galeSendPuff gc puff = void $ forkIO $ do+    putLog LogInfo $ "sending puff:\n" ++ (indent 4 $ showPuff puff)+    puff' <- expandEncryptionList gc puff+    writeChan (channel gc) puff'+    d <- createPuff  gc False puff'+    retry 3.0 "error sending puff" $ withMVar (gHandle gc) $ \h -> LBS.hPut h d >> hFlush h++galeWillPuff :: GaleContext -> Puff -> IO ()+galeWillPuff gc puff = void $ forkIO $ do+    putLog LogDebug $ "willing puff:\n" ++ (indent 4 $ showPuff puff)+    d <- createPuff gc True puff+    retry 3.0 "error sending puff" $ withMVar (gHandle gc) $ \h -> LBS.hPut h d >> hFlush h+++getPrivateKey kc kn = getPKey kc kn >>= \n -> case n of+    Just (k,_) | not $ keyIsPrivKey k -> return Nothing+    o -> return o++collectSigs :: [Signature] -> ([String],[String])+collectSigs ss = liftT2 (snub, snub) $ cs ss ([],[]) where+    cs ((Unverifyable _):_) _ = error "attempt to create unverifyable puff"+    cs (Signed (Key k _):ss) (ks,es) = cs ss (k:ks,es)+    cs (Encrypted es':ss) (ks,es) = cs ss (ks,es' ++ es)+    cs [] x = x+++tagWord :: Int -> Put -> Put+tagWord i p = putWord32be (fromIntegral i) >> p++class RawPut a where+    rawPut :: a -> Put++instance RawPut BS.ByteString where+    rawPut = putByteString++instance RawPut LBS.ByteString where+    rawPut = putLazyByteString++instance RawPut [Word8] where+    rawPut = putByteString . BS.pack++runPutBS = BS.concat . LBS.toChunks . runPut++createPuff :: GaleContext -> Bool -> Puff -> IO LBS.ByteString+createPuff _ will puff | [] <- signature puff = do+    let cn = runPut $ putGaleString (concatInter ":" (map catShowOld $ cats puff))+    let ad = runPut $ tagWord (fromIntegral $ LBS.length cn) $ do putLazyByteString cn; tagWord 0 $ putFragments (fragments puff)+    let pd = tagWord (if will then 1 else 0) (tagWord (fromIntegral $ LBS.length ad) (putLazyByteString ad))+    evaluate $ runPut pd+createPuff gc will p | (kn:_,es) <-  collectSigs (signature p) = do+    getPrivateKey (keyCache gc) kn >>= \v -> case v of+	Nothing -> createPuff gc will $ p {signature = []}+	Just (Key _ kfl,pkey) -> do+	    sfl <- case fragmentString f_keyOwner kfl of+		Just o -> return [(f_messageSender, FragmentText o)]+		Nothing -> return []+	    let fl = runPutBS $ tagWord 0 (putFragments (fragments p `mergeFrags` sfl))+	    sig <- signAll pkey fl+	    let sd = runPutBS $ do+                    putByteString bs_signature_magic1+                    tagWord (BS.length sig) (putByteString sig)+                    putByteString (BS.pack pubkey_magic3)+                    tagWord (fromIntegral $ length kn) (putGaleString kn)+                fd = tagWord (BS.length sd) (putByteString sd) >> putByteString fl+                fragments = [(f_securitySignature,FragmentData (runPutBS fd))]+            nfragments <- cryptFragments gc es fragments+	    createPuff gc will $ p {signature = [], fragments = nfragments }+createPuff _ _ _ = error "createPuff: invalid arguments"++cryptFragments :: GaleContext -> [String] -> FragmentList -> IO FragmentList+cryptFragments _ [] fl = return fl+cryptFragments gc ss fl = do+    putLog LogDebug $ "cryptFragments " ++ show ss+    ks <-  mapM (getPKey (keyCache gc)) ss+    let ks' = [ (n,x) | Just (Key n _,x) <- ks]+        fl' = putWord32be 0 >> (putFragments fl)+        n = fromIntegral (length ks')+    --putStrLn $ show (ks,ks',fl')+    (d,ks,iv) <- encryptAll (snds ks') (BS.concat (LBS.toChunks $ runPut fl'))+    return [(f_securityEncryption,FragmentData . BS.concat $ [bs_cipher_magic2,iv] ++ LBS.toChunks (runPut $ do putWord32be n;  mapM_ g (zip (fsts ks') ks) ; putByteString d))]+  where+     g (kn,kd) = do+        putWord32be (fromIntegral $ length kn)+        putGaleString kn+        putWord32be (fromIntegral $ BS.length kd)+        putByteString kd++++expandEncryptionList :: GaleContext -> Puff -> IO Puff+expandEncryptionList gc p = do+    ks <- fmap (normalizeDest . mconcat) $ mapM (findDest gc ) (cats p)+    case ks of+        DestPublic -> return p+        DestUnknown _ -> return p+        DestEncrypted ks -> return p { signature = Encrypted [ n | k@(Key n _) <- ks, keyIsPubKey k ]: signature p }++--    if any (maybe True (keyIsPublic ) ) (snds ks) then return p else do+--        return p { signature = Encrypted [ n | Just k@(Key n _) <-  snds ks, keyIsPubKey k ]: signature p }++putGaleString :: String -> Put+putGaleString s = putByteString . BS.pack $ galeEncodeString s++putFragments :: FragmentList -> Put+putFragments fl = mapM_ f fl where+    f (s',f) = putWord32be t >> putWord32be (fromIntegral $ LBS.length nxs) >> putLazyByteString nxs  where+        nxs = runPut (n >> xs)+	(t, xs) = g f+	n = putWord32be (fromIntegral $ length s) >> (putGaleString s)+        s = toString s'+    g (FragmentData ws) = (1, putByteString ws)+    g (FragmentText s) = (0, putGaleString (unpackPS s))+    g (FragmentTime (TOD s _)) = (2, putWord64be (fromIntegral s) >> putWord64be 0)+    g (FragmentInt i) = (3, putWord32be (fromIntegral i))+    g (FragmentNest fl) = (4, putFragments fl)++++catfixes = [ ("/", ".|"), (".", "/"), (":", "..") ]++parseCategoryOld :: Monad m => String -> m Category+parseCategoryOld = parser p where+    con cs | [nv] <- [x ++ (con $ drop (length y) cs) |(x,y) <- catfixes, y `isPrefixOf` cs] = nv+    con (c:cs) = c:con cs+    con "" = ""+    bl [] = []+    bl [_] = []+    bl (x:xs) = x:bl xs+    p = do+	char '@'+	d <- many (noneOf "/")+	parseExact "/user/"+	c <- parseRest+	return (Category (con (bl c),d))++catShowOld :: Category -> String+catShowOld (Category (c,d)) = "@" ++ d ++ "/user/" ++ con c ++ "/" where+    con cs | [nv] <- [x ++ (con $ drop (length y) cs) |(y,x) <- catfixes, y `isPrefixOf` cs] = nv+    con (c:cs) = c:con cs+    con "" = ""+++--------------------+-- Security routines+--------------------++galeDecryptPuff :: GaleContext -> Puff -> IO Puff+galeDecryptPuff gc p | (Just xs) <- getFragmentData p (f_securitySignature) = tryElse p $ do+    let (l,xs') = xdrReadUInt (BS.unpack xs)+	(sb,xs'') = xdrReadUInt (drop 4 xs')+	fl = (decodeFragments $ drop (fromIntegral l + 4) xs') ++ [f|f <- fragments p, fst f /= f_securitySignature]+    key <- parseKey $ take (fromIntegral (l - (8 + sb))) (drop (fromIntegral sb) xs'')+    galeDecryptPuff gc $ p {signature = (Unverifyable key): signature p, fragments = fl}+galeDecryptPuff gc p | (Just xs) <- getFragmentData p f_securityEncryption = tryElse p $ do+    (cd,ks) <- parser pe (BS.unpack xs)+    dfl <- first (map (td' (BS.pack cd)) [ (BS.pack x,y,BS.pack z) | (x,y,z) <- ks])+    let dfl' = dfl ++ [f|f <- fragments p, fst f /= f_securityEncryption]+    galeDecryptPuff gc $ p {signature = (Encrypted (map (\(_,n,_) -> n) ks)): signature p, fragments = dfl'}  where+	pe = (parseExact cipher_magic1 >> pr parseNullString) <|> (parseExact cipher_magic2 >> pr parseLenString)+	pk pkname iv = do+	    kname <- pkname+	    keydata <- parseLenData+	    return $ (iv,kname,keydata)+	pr pkname = do+	    iv <- parseSome 8+	    keycount <-  parseIntegral32+	    ks <- replicateM keycount (pk pkname iv)+	    xs <- parseRest+	    return (xs,ks)+	td' cd (iv,kname,keydata) = do+	    Just (_,pkey) <- getPrivateKey (keyCache gc) kname+	    dd <- decryptAll keydata iv pkey cd+	    --let dfl = decodeFragments (drop 4 (BS.unpack dd))+	    return $ runGet decodeFrags (LBS.fromChunks [BS.drop 4 dd])+galeDecryptPuff _ x = return x+++--data DestinationStatus = DSPublic { dsComment :: String } | DSPrivate { dsComment :: String } | DSGroup { dsComment :: String, dsComponents :: [DestinationStatus] } | DSUnknown++--verifyDestinations :: [Category] -> [(Category,DestinationStatus)]+--verifyDestinations cs = [ (c,DSUnknown) | c <- cs ]++++verifyDestinations' :: GaleContext -> [Category] -> IO [(Category, String)]+verifyDestinations' gc cs = mapM dc cs where+    dc c | categoryIsSystem c = return (c,"Special location (puff will not be encrypted)")+    dc c = dc' c >>= return . (,) c+    dc' c = do+        ks <- findDest gc c+        case ks of+            DestPublic -> return "Public category (puff will not be encrypted)"+            DestEncrypted _ -> return "Private category"+            -- DestUnknown _ | Just x <- nextTry (fst c) -> dc' (x,snd c)+            DestUnknown _ -> return "Unknown destination (puff will not be encrypted)"+--    nextTry "*" = fail "no more"+--    nextTry ss = return $ reverse (nt (reverse ss)) where+--        nt ('*':'.':ss)  = nt ss+--        nt ss =  '*' : dropWhile (/= '.') ss+++{-+        if any isNothing (snds ks) then+            if fst c == "*" then+                return "*UNKNOWN*  (puff will not be encrypted)"+             else+                dc' (nextTry (fst c), snd c)+         else+          pp [ (x,y) | (x,Just y) <- ks]++    pp ks | any isPublic (snds ks) = return "Public Category (puff will not be encrypted)"+    pp _ = return "Private Category"+    isPublic key = any nullPS (getFragmentStrings key f_keyMember)++fetchKeymembers :: GaleContext -> String -> IO [(String,Maybe Key)]+fetchKeymembers gc s = do+    km <- fk [s] []+    putLog LogNotice $ "fetchKeymembers " ++ s ++ "\n" ++ show km+    return km+   where+    fk [] xs = return xs      -- we are done+    fk ("":_) xs = return xs  -- public category+    fk (s:ss) xs | s `elem` fsts xs = fk ss xs+    fk (s:ss) xs = getPublicKey (keyCache gc) s >>= maybe (fk ss ((s,Nothing):xs)) (r . fst) where+        r :: Key -> IO [(String,Maybe Key)]+        r k = fk (map unpackPS (getFragmentStrings k f_keyMember) ++ ss) ((s,Just k):xs)++fetchKeymembers :: GaleContext -> String -> IO [(String,Maybe Key)]+fetchKeymembers _ s | "_gale." `isPrefixOf` s = return [(s,Just $ emptyKey s)]+fetchKeymembers gc s = do+    km <- fk [s] []+    putLog LogNotice $ "fetchKeymembers: " ++ s ++  show km+    return km+   where+    fk [] xs = return xs      -- we are done+    fk ("":_) _ = return [(s,Just $ emptyKey s)]  -- public category+    fk (s:ss) xs | s `elem` fsts xs = fk ss xs+    fk (s:ss) xs = getKey (keyCache gc) s >>= maybe (fk ss ((s,Nothing):xs)) r where+        r :: Key -> IO [(String,Maybe Key)]+        r k = fk (map unpackPS (getFragmentStrings k f_keyMember) ++ ss) ((s,Just k):xs)+-}++data Dest = DestPublic | DestUnknown [String] | DestEncrypted [Key]+    deriving(Eq,Show)++instance Monoid Dest where+    mempty = DestEncrypted []+    DestUnknown a `mappend` DestUnknown b = DestUnknown (a ++ b)+    DestUnknown a `mappend` _ = DestUnknown a+    _ `mappend` DestUnknown a  = DestUnknown a+    DestPublic `mappend` _ = DestPublic+    _ `mappend` DestPublic = DestPublic+    DestEncrypted a `mappend` DestEncrypted b = DestEncrypted (a ++ b)++normalizeDest DestPublic = DestPublic+normalizeDest (DestUnknown xs) = DestUnknown $ snub xs+normalizeDest (DestEncrypted xs) = DestEncrypted $ snub xs++fetchKeys :: GaleContext -> String -> IO Dest+fetchKeys _ s | "_gale." `isPrefixOf` s = return DestPublic+fetchKeys _ s | "_gale@" `isPrefixOf` s = return DestPublic+fetchKeys gc s = do+    km <- fk [s] []+    putLog LogDebug $ "fetchKeys: " ++ s ++  show km+    return $ normalizeDest (mconcat $ snds km) where+        fk [] xs = return xs      -- we are done+        fk ("":_) _ = return [("",DestPublic)]+        fk (s:ss) xs | s `elem` fsts xs = fk ss xs+        fk (s:ss) xs = getKey (keyCache gc) s >>= maybe (requestKey gc (catParseNew s) >> fk ss ((s,DestUnknown [s]):xs)) r where+            r (Key _ []) = fk ss ((s,DestUnknown [s]):xs)+            r k = fk (map unpackPS (getFragmentStrings k f_keyMember) ++ ss) ((s,DestEncrypted [k]):xs)++categoryIsSystem (Category (n,_)) | "_gale." `isPrefixOf` n = True+categoryIsSystem (Category (n,_)) | "_gale" == n = True+categoryIsSystem _ = False+++requestKey _ c | categoryIsSystem c = return ()+requestKey gc c = do+    let c' = catShowNew c+    v <- getKey (keyCache gc) c'+    when (isNothing v) $ do+        galeAddCategories gc [Category ("_gale.key", categoryCell c)]+        d <- createPuff  gc False $ keyRequestPuff c'+        putLog LogDebug $ "sending request for: " ++ c'+        retry 3.0 "error sending puff" $ withMVar (gHandle gc) $ \h -> LBS.hPut h d >> hFlush h+++findDest gc c = fd c >>= res where+    -- cn = catShowNew c+    fd c = do+        ks <- fetchKeys gc (catShowNew c)+        case ks of+                DestUnknown _ | Category (a,b) <- c, Just x <- nextTry a -> fd (Category (x,b))+                k -> return k+    res x = case x of+        DestUnknown _ -> do+--            let cs = map catParseNew ss+--            galeAddCategories gc (("_gale.key", snd c):[("_gale.key", x) | x <- snds cs])+--            let f Nothing = []+--                f (Just x) = x:f (nextTry x)+--                ac = snub $ concat $ map (flip (,) (snd c)) (f $ Just $ fst c) : [ map (flip (,) d)  (f $ Just n) | (n,d) <- cs]+--                g x = requestKey gc x+--            putLog LogDebug $ "attempting to lookup: " ++ show ac+--            --mapM_ g (f $ Just $ fst c)+--            mapM_ g ac+            threadDelay 1000000  -- try again after one second+            fd c+        k -> return k+++++++nextTry "*" = fail "no more"+nextTry ss = return $ reverse (nt (reverse ss)) where+    nt ('*':'.':ss)  = nt ss+    nt ss =  '*' : dropWhile (/= '.') ss+++verifyDestinations :: GaleContext -> [Category] -> IO String++verifyDestinations _ [] = return "** No Destinations **"+verifyDestinations gc cs = do+    (ds) <- verifyDestinations' gc cs+    let --x = "DestinationStatus: " ++ d+        xs = map f ds+        f (c,x) =  (catShowNew c) ++ ": " ++ x+    return (unlines (xs))++++++----------------------+-- Gale stream Parsing+----------------------+++putWord32 :: Handle -> Word32 -> IO ()+putWord32 h x = do+    hPutChar h $ chr $ fromIntegral $ (x `shiftR` 24)+    hPutChar h $ chr $ fromIntegral $ (x `shiftR` 16) .&. 0xFF+    hPutChar h $ chr $ fromIntegral $ (x `shiftR` 8) .&. 0xFF+    hPutChar h $ chr $ fromIntegral $ x .&. 0xFF++readWord32 :: Handle -> IO Word32+readWord32 h = do+    a <- newArray_ (0,3)+    n <- hGetArray h a 4+    when (n /= 4) $ fail "short read."+    [b1,b2,b3,b4] <- getElems a+    return $ (fromIntegral b4) .|. (fromIntegral b3 `shiftL` 8) .|.+	     (fromIntegral b2 `shiftL` 16) .|. (fromIntegral b1 `shiftL` 24)++galeEncodeString :: String -> [Word8]+galeEncodeString cs = concatMap (f . ord) (concat $ map (\c -> if c == '\n' then "\r\n" else [c]) cs) where+    f x = (b1:b2:[]) where+	b1 = fromIntegral $ (x `shiftR` 8) .&. 0xFF+	b2 = fromIntegral $ x .&. 0xFF+++--------------+-- Key Parsing+--------------++stons :: [Char] -> [Word8]+stons = map (fromIntegral . ord)++cipher_magic1, cipher_magic2 :: [Word8]+bs_signature_magic1 :: BS.ByteString++cipher_magic1 = stons "h\DC3\002\000"+cipher_magic2 = stons "h\DC3\002\001"++bs_cipher_magic1 = BS.pack cipher_magic1+bs_cipher_magic2 = BS.pack cipher_magic2++bs_signature_magic1 = BS.pack $ stons "h\DC3\001\000"++
+ Gale/KeyCache.hs view
@@ -0,0 +1,561 @@+{-# LANGUAGE PatternGuards #-}+module Gale.KeyCache(+    dumpKey,+    KeyCache,+    newKeyCache,+    getKey,+    getPKey,+    parseKey,+    keyIsPubKey,+    keyIsPrivKey,+    keyIsPublic,+    putKey,+    noKey,+    numberKeys,+    keyRequestPuff++    ) where++import Atom+import Bits+import Char+import Control.Concurrent+import Directory+import EIO+import ErrorLog+import Gale.Proto(decodeTime, decodeFrags, xdrReadUInt, getGaleDir, decodeFragments)+import GenUtil+import List+import Monad+import PackedString+import Gale.Puff+import RSA+import System.Mem.Weak+import Word+import qualified Data.Map as Map+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Text.ParserCombinators.ReadP.ByteString+import Data.Binary.Get(runGet,Get())++stons :: [Char] -> [Word8]+stons = map (fromIntegral . ord)++private_magic1, private_magic2, private_magic3 :: BS.ByteString+pubkey_magic1, pubkey_magic2 :: BS.ByteString++private_magic1 = BS.pack $ stons "h\DC3\000\001"+private_magic2 = BS.pack $ stons "h\DC3\000\003"+private_magic3 = BS.pack $ stons "GALE\000\002"+++pubkey_magic1 = BS.pack $ stons "h\DC3\000\000"+pubkey_magic2 = BS.pack $ stons "h\DC3\000\002"+pubkey_magic3 = BS.pack $ stons "GALE\000\001"++galeRSAModulusBits = 1024+galeRSAModulusLen = (galeRSAModulusBits + 7) `div` 8+galeRSAPrimeBits = (galeRSAModulusBits + 1) `div` 2+galeRSAPrimeLen = (galeRSAPrimeBits + 7) `div` 8+++data KeyCache = KeyCache {+    pkeyCache :: !(MVar (Map.Map String (Weak (Key,EvpPkey)))),+    kkeyCache :: !(MVar (Map.Map String (Weak Key))),+    galeDir :: String+    }++numberKeys kc = fmap Map.size $ readMVar (kkeyCache kc)++keyIsPubKey k =  (hasFragment k f_rsaExponent)+keyIsPrivKey k =  (hasFragment k f_rsaPrivateExponent)+keyIsPublic k = any nullPS $ getFragmentStrings k f_keyMember++newKeyCache galeDir = do+    pk <- newMVar Map.empty+    kk <- newMVar Map.empty+    return KeyCache { {- keyCache = kc, publicKeyCache = pkc,-} galeDir = galeDir, pkeyCache = pk, kkeyCache = kk }++keyToRSAElems :: Monad m => Key -> m (RSAElems BS.ByteString)+keyToRSAElems fl = do+    if not (keyIsPubKey fl) then fail "key does not have bits" else do+    n <- getFragmentData fl f_rsaModulus+    e <- getFragmentData fl f_rsaExponent+    if not (keyIsPrivKey fl) then+        return RSAElemsPublic { rsaN = n, rsaE = e } else do+    d <- getFragmentData fl f_rsaPrivateExponent+    iqmp <- getFragmentData fl f_rsaPrivateCoefficient+    pq <- getFragmentData fl f_rsaPrivatePrime+    dmpq1 <- getFragmentData fl f_rsaPrivatePrimeExponent+    let (p,q) = BS.splitAt galeRSAPrimeLen pq     -- should be "rsa.bits"?+        (dmp1,dmq1) = BS.splitAt galeRSAPrimeLen dmpq1+    return RSAElemsPrivate {+        rsaN = n,+        rsaE = e,+        rsaD = d ,+        rsaIQMP = iqmp,+        rsaP = p,+        rsaQ =  q,+        rsaDMP1 = dmp1,+        rsaDMQ1 = dmq1+        }++{-+keyToRSAElems :: Monad m => Key -> m (RSAElems [Word8])+keyToRSAElems fl = do+    if not (keyIsPubKey fl) then fail "key does not have bits" else do+    n <- getFragmentData fl f_rsaModulus+    e <- getFragmentData fl f_rsaExponent+    if not (keyIsPrivKey fl) then+        return RSAElemsPublic { rsaN = BS.unpack n, rsaE = BS.unpack e } else do+    d <- getFragmentData fl f_rsaPrivateExponent+    iqmp <- getFragmentData fl f_rsaPrivateCoefficient+    pq <- getFragmentData fl f_rsaPrivatePrime+    dmpq1 <- getFragmentData fl f_rsaPrivatePrimeExponent+    let (p,q) = splitAt galeRSAPrimeLen (BS.unpack pq)     -- should be "rsa.bits"?+        (dmp1,dmq1) = splitAt galeRSAPrimeLen (BS.unpack dmpq1)+    return RSAElemsPrivate {+        rsaN = BS.unpack n,+        rsaE = BS.unpack e,+        rsaD = BS.unpack d ,+        rsaIQMP = BS.unpack iqmp,+        rsaP = p,+        rsaQ =  q,+        rsaDMP1 = dmp1,+        rsaDMQ1 = dmq1+        }+        -}++++keyToPkey :: Key -> IO EvpPkey+keyToPkey key  = do+    re <- keyToRSAElems key+    putLog LogDebug $ show re++    createPkey re++getPKey :: KeyCache -> String -> IO (Maybe (Key,EvpPkey))+getPKey kc kn =  modifyMVar (pkeyCache kc) f where+    f pkeyCache | Just v <- Map.lookup kn pkeyCache = do+        v <- deRefWeak v+        case v of+            Just _ -> return (pkeyCache, v)+            Nothing -> g pkeyCache+    f pkeyCache = g pkeyCache+    g pkeyCache = do+        k <- getKey kc kn+        case k of+            Nothing -> return (pkeyCache, Nothing)+            Just v | not (hasFragment v f_rsaModulus) ->  return (pkeyCache, Nothing)+            Just key -> do+                --rsa <- keyToRSA v+                --pkey <- pkeyNewRSA rsa+                pkey <- keyToPkey key+                let kp =  (key,pkey)+                ptr <- mkWeakPtr kp Nothing+                return (Map.insert  kn ptr pkeyCache, Just kp)++blankKey kn = (Key kn [])++noKey :: KeyCache -> String -> IO ()+noKey kc kn = modifyMVar (kkeyCache kc) f where+    f kkeyCache | Just _ <- Map.lookup kn kkeyCache = return (kkeyCache, ())+    f kkeyCache = do+        n <- mkWeakPtr (blankKey kn) Nothing+        return (Map.insert kn n  kkeyCache, ())+++++putKey :: KeyCache -> BS.ByteString -> IO ()+putKey kc xs = do+    mk <- first [fmap Just (parseKey $ BS.unpack xs),return Nothing]+    case mk of+        Nothing -> return ()+        Just v'@(Key kn _) -> do+            modifyMVar (kkeyCache kc) f where+                f kkeyCache | Just _ <- Map.lookup kn kkeyCache = return (kkeyCache, ())+                f kkeyCache = do+                    first [createDirectory $ galeDir kc ++ "/auth/", return ()]+                    first [createDirectory $ galeDir kc ++ "/auth/cache/", return ()]+                    --xs <- unsafeThaw xs+                    --bnds <- getBounds xs+                    atomicWrite  (galeDir kc ++ "/auth/cache/" ++ kn ++ ".gpub")  $+                        \h -> BS.hPut h xs -- hPutArray h xs (rangeSize bnds)+                    v' <- mkWeakPtr v' Nothing+                    return (Map.insert kn v' kkeyCache, ())+++getKey :: KeyCache -> String -> IO (Maybe Key)+getKey kc kn = modifyMVar (kkeyCache kc) f where+    f kkeyCache | Just v <- Map.lookup kn kkeyCache = do+        v <- deRefWeak v+        case v of+            Just _ -> return (kkeyCache, v)+            Nothing -> g kkeyCache+    f kkeyCache = g kkeyCache+    g kkeyCache = do+	    v <- ioM getFromDisk+            case v of+                Nothing -> return (kkeyCache, Nothing)+                Just v' -> do+                    v'' <- mkWeakPtr v' Nothing+                    return (Map.insert kn v'' kkeyCache, Just v')+    getFromDisk :: IO Key+    getFromDisk = do+        let pc = galeDir kc ++ "/auth/cache/"+            pp = galeDir kc ++ "/auth/private/"+            knames = [ pp ++ kn ++ ".gpri", pp ++ kn ++ ".gpub", pp ++ kn , pc ++ kn ++ ".gpub" ]+            gn = (map (\fn -> (readRawFile fn >>= parseKey >>= \c -> return (c,fn))) knames)+        --putLog LogDebug $ "Looking for: " ++ show  knames+        xs <- mapM tryMost gn+        let ks = [ k | Right (k@(Key n _),_) <- xs, kn == n]+        let nk = foldr (\(Key _ fl) (Key n fl') -> Key n (fl `mergeFrags` fl')) (Key kn []) ks+        --(key_c, fn) <- (first  gn)+	--key <- parseKey key_c+	--rsa <- pubKeyToRSA key+	--pkey <- pkeyNewRSA rsa+        if null (getFragmentList nk) then ioError $ userError "bad key" else return nk++flipLocalPart :: String -> String+flipLocalPart s | '@' `notElem` s = s+flipLocalPart s = nbp ++ ep where+    nbp = concat $ reverse (groupBy f bp)+    (bp,ep) = span (/= '@') s+    f '.' '.' = True+    f x y | x /= '.' && y /= '.' = True+    f _ _ = False++keyRequestPuff :: String -> Puff+keyRequestPuff s = emptyPuff { cats = [Category ("_gale.query." ++ n, d)], fragments = [(f_questionKey, FragmentText $ packString s), (f_questionKey',FragmentText $ packString s')]} where+    s' = flipLocalPart s+    Category (n,d) = catParseNew s++--la xs = listArray (0, length xs - 1) xs+--la xs = BS.pack xs++parseWord32 :: ReadP Word32+parseWord32 = do+    b1 <- get+    b2 <- get+    b3 <- get+    b4 <- get+    return $ (fromIntegral b4) .|. (fromIntegral b3 `shiftL` 8) .|.+	    (fromIntegral b2 `shiftL` 16) .|. (fromIntegral b1 `shiftL` 24)++parseWord16 :: ReadP Word16+parseWord16 = do+    b1 <- get+    b2 <- get+    return $ (fromIntegral b2) .|. (fromIntegral b1 `shiftL` 8)++parseIntegral32 = fmap fromIntegral parseWord32+++keyDecode12 = do+    bits <- parseIntegral32+    modulusD <- splitRLE galeRSAModulusLen+    exponentD <- splitRLE galeRSAModulusLen+    privateExponentD <- splitRLE (galeRSAPrimeLen * 2)+    privatePrimeD <- splitRLE galeRSAModulusLen+    privatePrimeExponentD <- splitRLE (galeRSAPrimeLen * 2)+    privateCoefficientD <- splitRLE galeRSAPrimeLen+    let fl = [("rsa.modulus",FragmentData  modulusD),+	  ("rsa.exponent",FragmentData exponentD),+	  ("rsa.private.exponent",FragmentData  privateExponentD),+	  ("rsa.private.prime",FragmentData  privatePrimeD),+	  ("rsa.private.prime.exponent",FragmentData privatePrimeExponentD),+	  ("rsa.private.coefficient",FragmentData  privateCoefficientD),+	  ("rsa.bits", FragmentInt (fromIntegral bits))+	 ]+    return [ (fromString x,y) | (x,y) <- fl]+    {-+    (bits,ys) = xdrReadUInt xs+    (modulusD,xs') = splitRLE galeRSAModulusLen ys+    (exponentD,xs'') = splitRLE galeRSAModulusLen xs'+    (privateExponentD,xs''') = splitRLE (galeRSAPrimeLen * 2) xs''+    (privatePrimeD,xs'''') = splitRLE galeRSAModulusLen xs'''+    (privatePrimeExponentD,xs''''') = splitRLE (galeRSAPrimeLen * 2) xs''''+    (privateCoefficientD,_) = splitRLE galeRSAPrimeLen xs'''''++-}++eof = do+    l <- look+    guard $ BS.null l++parseNullString :: ReadP String+parseNullString = map (chr . fromIntegral) `fmap` manyTill get (char 0)++parseLenString :: ReadP String+parseLenString = do+    len <- parseIntegral32+    ws <- replicateM len parseWord16+    return $ map (chr . fromIntegral) ws++++keyParse :: ReadP Key+keyParse = choice [ppk1,ppk2,ppk3,pk1,pk2,pk3] where+    ppk1 = do+	string private_magic1+	kn <- fmap flipLocalPart parseNullString+	fl <- keyDecode12+	return $ Key kn fl+    ppk2 = do+	string private_magic2+	kn <- fmap flipLocalPart parseLenString+	fl <- keyDecode12+	return $ Key kn fl+    ppk3 = do+	string private_magic3+	kn <- fmap flipLocalPart parseLenString+	fl <- toParser decodeFrags+	return $ Key kn fl+    pk1 = do+	string pubkey_magic1+	kn <- fmap flipLocalPart parseNullString+	(eof >> return (Key kn [])) +++ do+	comment <- parseNullString+	fl <- parsePublic12+	skipMany get -- the signature+	return $ Key kn ([(f_keyOwner, FragmentText (packString comment))] ++ fl)+    pk2 = do+	string pubkey_magic2+	kn <- fmap flipLocalPart parseLenString+	(eof >> return (Key kn [])) +++ do+	comment <- parseLenString+	fl' <- parsePublic12+	let fl = ((f_keyOwner, FragmentText (packString comment)):fl')+	(eof >> return (Key kn fl)) +++ do+	ts <- replicateM 16 get+	te <- replicateM 16 get+        skipMany get+	--_signature <- parseRest+	return $ Key kn $ fl ++ [(f_keySigned,FragmentTime (decodeTime ts)), (f_keyExpires,FragmentTime (decodeTime te))]+    pk3 = do+	string pubkey_magic3+	kn <- fmap flipLocalPart parseLenString+	fl <- toParser decodeFrags+	return $ Key kn fl+    parsePublic12 = do+	bits <- parseIntegral32+	--modulus <- (MkP (\x -> Just (splitRLE galeRSAModulusLen x)))+	--exponent <- (MkP (\x -> Just (splitRLE galeRSAModulusLen x)))+	modulus <- splitRLE galeRSAModulusLen+	exponent <- splitRLE galeRSAModulusLen+	return [(f_rsaModulus, FragmentData modulus),+		(f_rsaExponent, FragmentData exponent),+		(f_rsaBits, FragmentInt $ fromIntegral bits)]+++parser :: Monad m => ReadP a -> BS.ByteString -> m a+parser p bs = case readP_to_S p bs of+    [(a,bs)] | BS.null bs -> return a+    _ -> fail "parser failed"++parseKey :: [Word8] -> IO Key+parseKey xs = do+    (Key kn fl) <- parser keyParse (BS.pack xs)+    fl <- unsignFragments fl+    return $ Key kn fl++splitRLE :: Int -> ReadP BS.ByteString+splitRLE n = f n [] where+    f n _ | n < 0 = fail "invalid RLE encoding"+    f 0 xs = return $ BS.concat (reverse xs)+    f n rs = plain +++ rep where+        plain = do+            c <- get+            guard $ c .&. 0x80 /= 0+            let count = fromIntegral $ (c .&. 0x7f) + 1+            (x,_) <- gather (skip count)+            f (n - count) (x:rs)+        rep = do+            c <- get+            guard $ c .&. 0x80 == 0+            x <- get+            let count = fromIntegral $ (c .&. 0x7f) + 1+            f (n - count) (BS.replicate count x:rs)++{-++splitRLE :: Int -> [Word8] -> ([Word8], [Word8])+splitRLE n _ | n < 0 = error "invalid RLE encoding"+splitRLE 0 xs = ([],xs)+splitRLE n (c:xs) | c .&. 0x80 /= 0 = (take count xs ++ ys,rest) where+    count = fromIntegral $ (c .&. 0x7f) + 1+    (ys,rest) = splitRLE (n - count) (drop count xs)+splitRLE n (c:x:xs) | c .&. 0x80 == 0 = (replicate count x ++ ys,rest) where+    count = fromIntegral $ (c .&. 0x7f) + 1+    (ys,rest) = splitRLE (n - count) xs+splitRLE _ _  = error "invalid RLE encoding"++-}++rest = do+    s <- look+    skip (BS.length s)+    return s++toParser :: Get a -> ReadP a+toParser g = (runGet g . LBS.fromChunks . (:[])) `fmap` rest++{-+unsignData :: Monad m => BS.ByteString -> m (FragmentList,Key)+unsignData xs = flip parser xs $ do+    l <- parseIntegral32+    skip 4+    sb <- parseIntegral32++-}++++unsignData :: [Word8] -> IO (FragmentList,Key)+unsignData xs = do+    key <- parseKey $ take (fromIntegral (l - (8 + sb))) (drop (fromIntegral sb) xs'')+    return (fl,key) where+	(l,xs') = xdrReadUInt xs+	(sb,xs'') = xdrReadUInt (drop 4 xs')+	fl = (decodeFragments $ drop (fromIntegral l + 4) xs')++unsignFragments :: FragmentList -> IO FragmentList+unsignFragments tfl | (xs:_) <- [xs | (n,FragmentData xs) <- tfl, n == f_securitySignature] = do+    (fl,_) <- unsignData (BS.unpack xs)+    unsignFragments fl+unsignFragments x = return x++----------------+-- test code+----------------++{-# NOTINLINE dumpKey #-}+dumpKey :: String -> IO ()+dumpKey arg = do+    gd <- getGaleDir+    kc <- newKeyCache gd+    nk <- getKey kc arg+    key <- case nk of+        Just key -> return key+        Nothing -> do+            c <- readRawFile arg+            parseKey c+    putStrLn $ showKey key++++{-++getPrivateKey :: KeyCache -> String -> IO (Maybe (Key,EvpPkey))+getPrivateKey gc kn = modifyMVar (keyCache gc) f where+    f kc = case [x|x@(Key kn' _,_) <- kc, kn == kn'] of+	(v:_) -> return (kc,Just v)+	[] -> do+	    v <- ioMp getFromDisk+	    return ((maybeToList v ++ kc),v)+    getFromDisk = do+	let gd = galeDir gc+	let p = (gd ++ "/auth/private/")+	    knames = [p ++ kn, p ++ kn ++ ".gpri"]+	    gn = (map (\fn -> (readRawFile fn >>= \c -> return (c,fn))) knames)+	(key_c, fn) <- (first  gn)+	key <- parseKey key_c+	rsa <- privkeyToRSA key+	pkey <- pkeyNewRSA rsa+	putLog LogNotice $ "Retrieved private key from disk: " ++ fn+	return (key,pkey)++++getPublicKey :: KeyCache -> String -> IO (Maybe (Key,EvpPkey))+getPublicKey gc kn = modifyMVar (publicKeyCache gc) f where+    f keyCache | Just v <- lookupFM keyCache kn = return (keyCache, Just v)+    f keyCache = do+	    v <- ioM getFromDisk+            return $ case v of+                Nothing -> (keyCache, Nothing)+                Just v' -> (addToFM keyCache kn v', Just v')+    getFromDisk :: IO (Key,EvpPkey)+    getFromDisk = do+        let gd = galeDir gc+        let p = (gd ++ "/auth/cache/")+            knames = [ p ++ kn ++ ".gpub"]+            gn = (map (\fn -> (readRawFile fn >>= \c -> return (c,fn))) knames)+        putLog LogDebug $ "Looking for: " ++ show  knames+        (key_c, fn) <- (first  gn)+	key <- parseKey key_c+	rsa <- pubKeyToRSA key+	pkey <- pkeyNewRSA rsa+        return (key,pkey)+-}++{-+fragmentData' x y = fragmentData (packString x) y+privkeyToRSA :: Key -> IO RSA+privkeyToRSA (Key _ fl)  = do+    rsa <- rsaNew+    fragmentData' "rsa.modulus" fl >>= bn_bin2bn >>= rsaSetN rsa+    fragmentData' "rsa.exponent" fl >>= bn_bin2bn >>= rsaSetE rsa+    fragmentData' "rsa.private.exponent" fl >>= bn_bin2bn >>= rsaSetD rsa+    fragmentData' "rsa.private.coefficient" fl >>= bn_bin2bn >>= rsaSetIQMP rsa+    xs <- fragmentData' "rsa.private.prime" fl+    let (p,q) = splitAt galeRSAPrimeLen xs+    bn_bin2bn p >>= rsaSetP rsa+    bn_bin2bn q >>= rsaSetQ rsa+    xs <- fragmentData' "rsa.private.prime.exponent" fl+    let (dmp1,dmq1) = splitAt galeRSAPrimeLen xs+    bn_bin2bn dmp1 >>= rsaSetDMP1 rsa+    bn_bin2bn dmq1 >>= rsaSetDMQ1 rsa+    rsaCheckKey rsa+    return rsa++pubKeyToRSA :: Key -> IO RSA+pubKeyToRSA (Key _ fl)  = do+    rsa <- rsaNew+    fragmentData' "rsa.modulus" fl >>= bn_bin2bn >>= rsaSetN rsa+    fragmentData' "rsa.exponent" fl >>= bn_bin2bn >>= rsaSetE rsa+    --fragmentData' "rsa.private.exponent" fl >>= bn_bin2bn >>= rsaSetD rsa+    --fragmentData' "rsa.private.coefficient" fl >>= bn_bin2bn >>= rsaSetIQMP rsa+    --xs <- fragmentData' "rsa.private.prime" fl+    --let (p,q) = splitAt galeRSAPrimeLen xs+    --bn_bin2bn p >>= rsaSetP rsa+    --bn_bin2bn q >>= rsaSetQ rsa+    --xs <- fragmentData' "rsa.private.prime.exponent" fl+    --let (dmp1,dmq1) = splitAt galeRSAPrimeLen xs+    --bn_bin2bn dmp1 >>= rsaSetDMP1 rsa+    --bn_bin2bn dmq1 >>= rsaSetDMQ1 rsa+    --rsaCheckKey rsa+    return rsa++-}+{-+keyToRSA :: Key -> IO RSA+keyToRSA (Key _ fl)  = do+    rsa <- rsaNew+    fragmentData' "rsa.modulus" fl >>= bn_bin2bn >>= rsaSetN rsa+    fragmentData' "rsa.exponent" fl >>= bn_bin2bn >>= rsaSetE rsa+    if  (hasFragment fl (packString "rsa.private.exponent")) then  do+        fragmentData' "rsa.private.exponent" fl >>= bn_bin2bn >>= rsaSetD rsa+        fragmentData' "rsa.private.coefficient" fl >>= bn_bin2bn >>= rsaSetIQMP rsa+        xs <- fragmentData' "rsa.private.prime" fl+        let (p,q) = splitAt galeRSAPrimeLen xs     -- should be "rsa.bits"?+        bn_bin2bn p >>= rsaSetP rsa+        bn_bin2bn q >>= rsaSetQ rsa+        xs <- fragmentData' "rsa.private.prime.exponent" fl+        let (dmp1,dmq1) = splitAt galeRSAPrimeLen xs+        bn_bin2bn dmp1 >>= rsaSetDMP1 rsa+        bn_bin2bn dmq1 >>= rsaSetDMQ1 rsa+        rsaCheckKey rsa+      else do+        return ()++       -- rsaSetD rsa nullPtr+       -- rsaSetIQMP rsa nullPtr+       -- rsaSetP rsa nullPtr+       -- rsaSetQ rsa nullPtr+       -- rsaSetDMP1 rsa nullPtr+       -- rsaSetDMQ1 rsa nullPtr+    return rsa+-}
+ Gale/Proto.hs view
@@ -0,0 +1,130 @@+module Gale.Proto where++import Atom+import Bits+import Char+import GenUtil+import PackedString+import Gale.Puff+import SimpleParser+import System+import System.Time+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Data.Binary.Get+import Word+++pubkey_magic3 :: [Word8]+pubkey_magic3 = map (fromIntegral . ord) "GALE\000\001"++decodeFragments :: [Word8] -> FragmentList+decodeFragments [] = []+decodeFragments xs = decodeFragment ft f : decodeFragments r where+    (ft,xs') = xdrReadUInt xs+    (fl,xs'') = xdrReadUInt xs'+    (f,r) = splitAt (fromIntegral fl) xs''++decodeFragment :: Word32 -> [Word8] -> (Atom, Fragment)+decodeFragment t xs = (fn,f t) where+    (fnl,xs') = xdrReadUInt xs+    (fn,xs'') = liftT2 (fromString . galeDecodeString,id) (splitAt (fromIntegral $ fnl * 2) xs')+    f 0 = FragmentText $ packString (galeDecodeString xs'')+    f 1 = FragmentData $ BS.pack  xs''+    f 2 = FragmentTime $ decodeTime xs''+    f 3 = FragmentInt (fromIntegral $ fst $ xdrReadUInt xs'')+    f 4 = FragmentNest (decodeFragments xs'')+    f x = error $ "unknown fragment: " ++ show x++decodeTime :: [Word8] -> ClockTime+decodeTime xs = TOD (fromIntegral t) 0 where+    (t,_) = xdrReadUInt (drop 4 xs)+++parseNullString :: GenParser Word8 String+parseNullString = (sat (== 0) >> return "") <|> (parseSome 1 >>= \[x] -> fmap ((chr $ fromIntegral x):) parseNullString)++galeDecodeString :: [Word8] -> String+galeDecodeString [] = []+galeDecodeString (b1:b2:xs) = (chr $ (fromIntegral b2) .|. (fromIntegral b1 `shiftL` 8)) : galeDecodeString xs+galeDecodeString _ = error "invalid gale string"+++++xdrReadUInt :: [Word8] -> ( Word32,[Word8])+xdrReadUInt (b1:b2:b3:b4:bs) = (x,bs) where+    x = (fromIntegral b4) .|. (fromIntegral b3 `shiftL` 8) .|.+	    (fromIntegral b2 `shiftL` 16) .|. (fromIntegral b1 `shiftL` 24)+xdrReadUInt bs = error $ "xdrReadUInt " ++ show bs++parseWord32 :: GenParser Word8 Word32+parseWord32 = do+    [b1,b2,b3,b4] <- parseSome 4+    return $ (fromIntegral b4) .|. (fromIntegral b3 `shiftL` 8) .|.+	    (fromIntegral b2 `shiftL` 16) .|. (fromIntegral b1 `shiftL` 24)++parseLenData = parseWord32 >>= parseSome++parseIntegral32 :: Integral a => GenParser Word8 a+parseIntegral32 = fmap fromIntegral parseWord32++parseLenString :: GenParser Word8 String+parseLenString = do+    len <- parseIntegral32+    w <- parseSome (len * 2)+    return $ galeDecodeString w+{-+decodeTime (x:y:_) | x > 0 || y > 0 = endOfTime+decodeTime xs = TimeDiff {tdDay = 0, tdPicosec = 0, tdYear = 0, tdMonth = 0, tdHour = 0, tdMin = fromIntegral (t `div` 60) , tdSec = fromIntegral (t `mod` 60)} `addToClockTime` epoch where+    (t,_) = xdrReadUInt (drop 4 xs)++-}++getGaleDir :: IO String+getGaleDir = do+    gd <- lookupEnv "GALE_DIR"+    case gd of+	Just v -> return $ v ++ "/"+	Nothing -> do+	    h <- getEnv "HOME"+	    return (h ++ "/.gale/")++decodeFrags :: Get FragmentList+decodeFrags = df [] where+    df xs = do+        b <- isEmpty+        if b then return (reverse xs) else do+        z <- decodeFrag+        df (z:xs)++decodeFrag :: Get (Atom,Fragment)+decodeFrag = do+    ty <- getWord32be+    ln <- getWord32be+    fnl <- getWord32be+    fn <- replicateM (fromIntegral fnl) getWord16be+    let fn' = fromString (map (chr . fromIntegral) fn)+    let dl = fromIntegral $ ln - (4 + (fnl * 2))+    let x <+> y = x ++ " " ++ y+    fr <- case ty of+        0 -> do+            tx <- replicateM (dl `div` 2) getWord16be+            return $ FragmentText $ packString (map (chr . fromIntegral) tx)+        1 -> do+            --d <- bytes dl+            --d <- replicateM dl byte+            up <- getBytes dl+            return $ FragmentData up+        2 -> do+            w <- getWord64be+            skip 8 --word64+            return $ FragmentTime (TOD (fromIntegral w) 0)+        3 -> do+            w <- getWord32be+            return $ FragmentInt (fromIntegral w)+        4 -> do+            up <- getBytes dl+            return $ FragmentNest (runGet decodeFrags (LBS.fromChunks [up]))+        _ -> fail $ "unknown fragment type: " <+> show ty <+> show ln <+> show fnl <+> show fn'+    return (fn', fr)
+ Gale/Puff.hs view
@@ -0,0 +1,375 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving #-}+module Gale.Puff(+    Puff(..),+    Fragment(..),+    Signature(..),+    Key(..),+    FragmentList,+    HasFragmentList(..),+    Category(Category),+    readPuffs, writePuffs, emptyPuff,+    categoryHead, categoryCell,+    catParseNew, catShowNew,+    subCategory, fragmentData,+    getFragmentString, getFragmentStrings, getFragmentForceStrings, showPuff, showKey, showFragments,+    fragmentString, mergeFrags, getFragmentData, getFragmentTime,+    getAuthor, getSigner, hasFragment, hasFragmentString, emptyKey,+    getAllFragmentForceStrings,+    showSignature,+    f_keySigned,+    f_keyRedirect,+    f_keyMember,+    f_keyExpires,+    f_rsaModulus,+    f_rsaPrivateExponent,+    f_rsaPrivateCoefficient,+    f_rsaPrivatePrime,+    f_rsaPrivatePrimeExponent,+    f_rsaExponent,+    f_rsaBits,+    f_keyOwner,+    f_messageSender,+    f_securitySignature,+    f_messageBody,+    f_messageKeyword,+    f_idTime,+    f_messageId,+    f_questionReceipt,+    f_outGone,+    f_noticePresence,+    f_noticePresence',+    f_securityEncryption,+    f_questionKey,+    f_questionKey',+    f_answerKey',+    f_answerKeyError'+    ) where++import Atom+import Data.Binary+import EIO+import ErrorLog+import GenUtil+import Int(Int32)+import List+import Maybe(isJust)+import PackedString+import System.IO+import System.Time+import RSA++import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString as BS++newtype Category = Category (String,String)+    deriving(Binary,Eq,Ord)++instance Show Category where+    show c = catShowNew c++type FragmentList = [(Atom,Fragment)]++data Puff = Puff {+    cats :: [Category],+    signature :: [Signature],+    fragments :: FragmentList+    }+data Fragment =+    FragmentText !PackedString+    | FragmentData !BS.ByteString+    | FragmentTime !ClockTime+    | FragmentInt !Int32+    | FragmentNest FragmentList++data Signature =+    Unverifyable Key+    | Signed Key+    | Encrypted [String]++data Key = Key String FragmentList++emptyKey n = Key n [( f_keyMember, FragmentText nilPS)]++instance Eq Key where+    (==) (Key kn _) (Key kn' _) = kn == kn'+instance Ord Key where+    compare (Key kn _) (Key kn' _) = compare kn kn'+++f_answerKeyError' = fromString "answer/key/error"+f_answerKey' = fromString "answer/key"+f_idTime = fromString "id/time"+f_keyExpires = fromString "key.expires"+f_keyMember = fromString "key.member"+f_keyOwner = fromString "key.owner"+f_keyRedirect = fromString "key.redirect"+f_keySigned = fromString "key.signed"+f_messageBody = fromString "message/body"+f_messageId = fromString "message.id"+f_messageKeyword = fromString "message.keyword"+f_messageSender = fromString "message/sender"+f_noticePresence = fromString "notice.presence"+f_noticePresence' = fromString "notice/presence"+f_outGone = fromString "out.gone"+f_questionKey = fromString "question.key"+f_questionKey' = fromString "question/key"+f_questionReceipt = fromString "question.receipt"+f_rsaBits = fromString "rsa.bits"+f_rsaExponent = fromString "rsa.exponent"+f_rsaModulus = fromString "rsa.modulus"+f_rsaPrivateCoefficient = fromString "rsa.private.coefficient"+f_rsaPrivateExponent = fromString "rsa.private.exponent"+f_rsaPrivatePrimeExponent = fromString "rsa.private.prime.exponent"+f_rsaPrivatePrime  = fromString "rsa.private.prime"+f_securityEncryption = fromString "security/encryption"+f_securitySignature = fromString "security/signature"++--------------------+-- Category Routines+--------------------++subCategory :: Category -> Category -> Bool+Category (x1,y1) `subCategory` Category (x2,y2) = x2 `isPrefixOf` x1 && y2 `isSuffixOf` y1++catParseNew :: String -> Category+catParseNew cs = Category (c,(drop 1) d) where+    (c,d) = span (/= '@') cs+++catShowNew :: Category -> String+catShowNew (Category (x,"")) = x+catShowNew (Category (x,y)) = x ++ "@" ++ y++---------------------+-- working with puffs+---------------------++getAuthor p = maybe "unknown" id (getSigner p)++getSigner p = ss (signature p) where+	    ss (Signed (Key n _):_) = Just n+	    ss (Unverifyable (Key n _):_) = Just n+	    ss (_:sig) = ss sig+	    ss [] = Nothing++showSignature (Signed (Key n _)) = "Signed by " ++ n+showSignature (Unverifyable (Key n _)) = "Signed by " ++ n ++ " (unverified)"+showSignature (Encrypted xs) = "Encrypted to " ++ concatInter ", " xs++emptyPuff = Puff {cats = [], signature = [], fragments = []}++fragmentData :: Monad m => Atom -> FragmentList -> m BS.ByteString+fragmentData s fl = case lookup s fl of+    Just (FragmentData xs) -> return xs+    _ -> fail $ "fragment not found: " ++ toString s++fragmentString :: Monad m => Atom -> FragmentList -> m PackedString+fragmentString s fl = case lookup s fl of+    Just (FragmentText xs) -> return xs+    _ -> fail $ "fragment not found: " ++ toString s++mergeFrags :: FragmentList -> FragmentList -> FragmentList+mergeFrags fla flb = fla ++ [f|f@(s,_) <- flb, s `notElem` fsts fla]+++{-+getFragmentString :: Monad m => Puff -> String -> m String+getFragmentString (Puff {fragments = frags}) s = case lookup s frags of+    Just (FragmentText s) -> return s+    _ -> fail $ "fragment not found: " ++ s+-}++getFragmentStrings :: HasFragmentList fl => fl -> Atom -> [PackedString]+getFragmentStrings fl s = [v|(n,FragmentText v) <- getFragmentList fl, n == s]++getFragmentForceStrings :: HasFragmentList fl => fl -> Atom -> [PackedString]+getFragmentForceStrings fl s = concatMap f [v | (n,v) <- getFragmentList fl, n == s] where+    f (FragmentText t) = [t]+    f (FragmentData _) = []+    f (FragmentTime t) = [packString (show t)]+    f (FragmentInt i) = [packString (show i)]+    f (FragmentNest fl) = getFragmentForceStrings fl s++getAllFragmentForceStrings :: HasFragmentList fl => fl -> [PackedString]+getAllFragmentForceStrings fl  = concatMap f [v | (_,v) <- getFragmentList fl] where+    f (FragmentText t) = [t]+    f (FragmentData _) = []+    f (FragmentTime t) = [packString (show t)]+    f (FragmentInt i) = [packString (show i)]+    f (FragmentNest fl) = getAllFragmentForceStrings fl++showPuff (Puff {cats = s, fragments =  fl, signature = sigs}) = unwords (map catShowNew s) ++ "\n" ++ unlines (map showSignature sigs) ++ indentLines 2 (showFragments fl)+showFragments fl = concatMap (\(n,f) -> toString n ++ ": " ++ show f ++ "\n") fl++instance Show Puff where+    show = showPuff++instance Show Key where+    show = showKey++instance Show Fragment where+    show (FragmentText s) = show s+    --show (FragmentData xs) = "<DATA:" ++ show (rangeSize $ bounds xs)  ++ ":" ++ show (map (chr . fromIntegral) $ elems xs) ++ ">"+    show (FragmentData xs) = "<DATA:" ++ show (BS.length xs)  ++ ":" ++ bsToHex (sha1 $ LBS.fromChunks [xs]) ++ ">"+    show (FragmentTime ct) = show ct+    show (FragmentInt x) = show x+    show (FragmentNest fl) = "Nest:" ++ (indentLines 2 $ showFragments fl)+++showKey :: Key -> String+showKey (Key n fl) = "Key: " ++ n ++ "\n" ++ (indentLines 4 $ showFragments fl)++getFragmentData :: (Monad m,HasFragmentList fl) => fl -> Atom -> m BS.ByteString+getFragmentData fl s = case [xs | (s',FragmentData xs) <- getFragmentList fl, s' == s] of+    (s:_) -> return s+    [] -> fail $ "data fragment not found: " ++ toString s++getFragmentString :: (Monad m, HasFragmentList fl)  => fl -> Atom -> m PackedString+getFragmentString fl s = case [xs | (s',FragmentText xs) <- getFragmentList fl, s' == s] of+    (s:_) -> return s+    [] -> fail $ "text fragment not found: " ++ toString s++hasFragmentString fl s = isJust (getFragmentString fl s)++hasFragment fl s = s `elem` fsts (getFragmentList fl)++getFragmentTime :: (Monad m, HasFragmentList fl)  => fl -> Atom -> m ClockTime+getFragmentTime fl s = case [xs | (s',FragmentTime xs) <- getFragmentList fl, s' == s] of+    (s:_) -> return s+    [] -> fail $ "time fragment not found: " ++ toString s++class HasFragmentList a where+    getFragmentList :: a -> FragmentList++instance HasFragmentList FragmentList where+    getFragmentList = id++instance HasFragmentList Puff where+    getFragmentList (Puff {fragments = fl}) = fl++instance HasFragmentList Key where+    getFragmentList (Key _ fl) = fl++instance HasFragmentList (Atom,Fragment) where+    getFragmentList f = [f]++instance HasFragmentList Fragment where+    getFragmentList (FragmentNest fl) = fl+    getFragmentList _ = []++-- flattenFragmentList :: HasFragmentList fl => fl -> FragmentList++----------------+-- Puff Pickling+----------------++writePuffs :: String -> [Puff] -> IO ()+writePuffs fn ps = attempt $ putFile fn ps++readPuffs :: String -> IO [Puff]+readPuffs fn = tryElse [] $ getFile fn+++putFile fn a = atomicWrite fn $ \h -> do+    hSetBuffering h (BlockBuffering Nothing)+    LBS.hPut h (encode a)++getFile :: Binary a => FilePath -> IO a+getFile fn = decodeFile fn+++categoryHead (Category (h,_)) = h+categoryCell (Category (_,c)) = c+++{- Generated by DrIFT (Automatic class derivations for Haskell) -}+{-* Generated by DrIFT : Look, but Don't Touch. *-}++instance Data.Binary.Binary Puff where+    put (Puff aa ab ac) = do+	    Data.Binary.put aa+	    Data.Binary.put ab+	    Data.Binary.put ac+    get = do+    aa <- get+    ab <- get+    ac <- get+    return (Puff aa ab ac)++instance Data.Binary.Binary Fragment where+    put (FragmentText aa) = do+	    Data.Binary.putWord8 0+	    Data.Binary.put aa+    put (FragmentData ab) = do+	    Data.Binary.putWord8 1+	    Data.Binary.put ab+    put (FragmentTime ac) = do+	    Data.Binary.putWord8 2+	    Data.Binary.put ac+    put (FragmentInt ad) = do+	    Data.Binary.putWord8 3+	    Data.Binary.put ad+    put (FragmentNest ae) = do+	    Data.Binary.putWord8 4+	    Data.Binary.put ae+    get = do+	    h <- Data.Binary.getWord8+	    case h of+	      0 -> do+		    aa <- Data.Binary.get+		    return (FragmentText aa)+	      1 -> do+		    ab <- Data.Binary.get+		    return (FragmentData ab)+	      2 -> do+		    ac <- Data.Binary.get+		    return (FragmentTime ac)+	      3 -> do+		    ad <- Data.Binary.get+		    return (FragmentInt ad)+	      4 -> do+		    ae <- Data.Binary.get+		    return (FragmentNest ae)+	      _ -> fail "invalid binary data found"++instance Data.Binary.Binary Signature where+    put (Unverifyable aa) = do+	    Data.Binary.putWord8 0+	    Data.Binary.put aa+    put (Signed ab) = do+	    Data.Binary.putWord8 1+	    Data.Binary.put ab+    put (Encrypted ac) = do+	    Data.Binary.putWord8 2+	    Data.Binary.put ac+    get = do+	    h <- Data.Binary.getWord8+	    case h of+	      0 -> do+		    aa <- Data.Binary.get+		    return (Unverifyable aa)+	      1 -> do+		    ab <- Data.Binary.get+		    return (Signed ab)+	      2 -> do+		    ac <- Data.Binary.get+		    return (Encrypted ac)+	      _ -> fail "invalid binary data found"++instance Data.Binary.Binary Key where+    put (Key aa ab) = do+	    Data.Binary.put aa+	    Data.Binary.put ab+    get = do+    aa <- get+    ab <- get+    return (Key aa ab)++instance Binary ClockTime where+    put (TOD a b) = put a >> put b+    get = do+        x <- get+        y <- get+        return (TOD x y)++--  Imported from other files :-
+ GenUtil.hs view
@@ -0,0 +1,782 @@+{-# LANGUAGE ParallelListComp #-}+-- Copyright (c) 2002 John Meacham (john@foo.net)+--+-- Permission is hereby granted, free of charge, to any person obtaining a+-- copy of this software and associated documentation files (the+-- "Software"), to deal in the Software without restriction, including+-- without limitation the rights to use, copy, modify, merge, publish,+-- distribute, sublicense, and/or sell copies of the Software, and to+-- permit persons to whom the Software is furnished to do so, subject to+-- the following conditions:+--+-- The above copyright notice and this permission notice shall be included+-- in all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+-- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+-- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.++----------------------------------------+-- | This is a collection of random useful utility functions written in pure+-- Haskell 98. In general, it trys to conform to the naming scheme put forth+-- the haskell prelude and fill in the obvious omissions, as well as provide+-- useful routines in general. To ensure maximum portability, no instances are+-- exported so it may be added to any project without conflicts.+----------------------------------------++module GenUtil(+    -- * Functions+    -- ** Error reporting+    putErr,putErrLn,putErrDie,+    -- ** Simple deconstruction+    fromLeft,fromRight,fsts,snds,splitEither,rights,lefts,+    isLeft,isRight,+    -- ** System routines+    exitSuccess, System.exitFailure, epoch, lookupEnv,endOfTime,+    -- ** Random routines+    repMaybe,+    liftT2, liftT3, liftT4,+    snub, snubFst, snubUnder, smerge, sortFst, groupFst, foldl',+    fmapLeft,fmapRight,isDisjoint,isConjoint,+    groupUnder,+    sortUnder,+    minimumUnder,+    maximumUnder,+    sortGroupUnder,+    sortGroupUnderF,+    sortGroupUnderFG,+    sameLength,+    naturals,++    -- ** Monad routines+    perhapsM,+    repeatM, repeatM_, replicateM, replicateM_, maybeToMonad,+    toMonadM, ioM, ioMp, foldlM, foldlM_, foldl1M, foldl1M_,+    -- ** Text Routines+    -- *** Quoting+    shellQuote, simpleQuote, simpleUnquote,+    -- *** Layout+    indentLines,+    buildTableLL,+    buildTableRL,+    buildTable,+    trimBlankLines,+    paragraph,+    paragraphBreak,+    expandTabs,+    chunkText,+    -- *** Scrambling+    rot13,+    -- ** Random+    concatInter,+    powerSet,+    randomPermute,+    randomPermuteIO,+    chunk,+    rtup,+    triple,+    fromEither,+    mapFst,+    mapSnd,+    mapFsts,+    mapSnds,+    tr,+    readHex,+    overlaps,+    showDuration,+    readM,+    readsM,+    split,+    tokens,+    count,+    hasRepeatUnder,+    -- ** Option handling+    getArgContents,+    parseOpt,+    getOptContents,+    doTime,+    getPrefix,+    rspan,+    rbreak,+    rdropWhile,+    rtakeWhile,+    rbdropWhile,+    concatMapM,+    on,+    mapMsnd,+    mapMfst,+++    -- * Classes+    UniqueProducer(..)+    ) where++import Char(isAlphaNum, isSpace, toLower, ord, chr)+import List+import Monad+import qualified IO+import qualified System+import Random(StdGen, newStdGen, Random(randomR))+import Time+import CPUTime++{-# SPECIALIZE snub :: [String] -> [String] #-}+{-# SPECIALIZE snub :: [Int] -> [Int] #-}++{-# RULES "snub/snub" forall x . snub (snub x) = snub x #-}+{-# RULES "snub/nub" forall x . snub (nub x) = snub x #-}+{-# RULES "nub/snub" forall x . nub (snub x) = snub x #-}+{-# RULES "snub/sort" forall x . snub (sort x) = snub x #-}+{-# RULES "sort/snub" forall x . sort (snub x) = snub x #-}+{-# RULES "snub/[]" snub [] = [] #-}+{-# RULES "snub/[x]" forall x . snub [x] = [x] #-}++-- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.+snub :: Ord a => [a] -> [a]+snub = map head . group . sort++-- | sorted nub of list of tuples, based solely on the first element of each tuple.+snubFst :: Ord a => [(a,b)] -> [(a,b)]+snubFst = map head . groupBy (\(x,_) (y,_) -> x == y) . sortBy (\(x,_) (y,_) -> compare x y)++-- | sorted nub of list based on function of values+snubUnder :: Ord b => (a -> b) -> [a] -> [a]+snubUnder f = map head . groupUnder f . sortUnder f++-- | sort list of tuples, based on first element of each tuple.+sortFst :: Ord a => [(a,b)] -> [(a,b)]+sortFst = sortBy (\(x,_) (y,_) -> compare x y)++-- | group list of tuples, based only on equality of the first element of each tuple.+groupFst :: Eq a => [(a,b)] -> [[(a,b)]]+groupFst = groupBy (\(x,_) (y,_) -> x == y)++concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]+concatMapM f xs = do+    res <- mapM f xs+    return $ concat res++on :: (a -> a -> b) -> (c -> a) -> c -> c -> b+(*) `on` f = \x y -> f x * f y++mapMsnd :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)]+mapMsnd f xs = do+    let g (a,b) = do+            c <- f b+            return (a,c)+    mapM g xs++mapMfst :: Monad m => (b -> m c) -> [(b,a)] -> m [(c,a)]+mapMfst f xs = do+    let g (a,b) = do+            c <- f a+            return (c,b)+    mapM g xs++rspan :: (a -> Bool) -> [a] -> ([a], [a])+rspan fn xs = f xs [] where+    f [] rs = ([],reverse rs)+    f (x:xs) rs+        | fn x = f xs (x:rs)+        | otherwise = (reverse rs ++ x:za,zb) where+            (za,zb) = f xs []++rbreak :: (a -> Bool) -> [a] -> ([a], [a])+rbreak fn xs = rspan (not . fn) xs++rdropWhile :: (a -> Bool) -> [a] -> [a]+rdropWhile fn xs = f xs [] where+    f [] _ = []+    f (x:xs) rs+        | fn x = f xs (x:rs)+        | otherwise = reverse rs ++ x:(f xs [])++rtakeWhile :: (a -> Bool) -> [a] -> [a]+rtakeWhile fn xs = f xs [] where+    f [] rs = reverse rs+    f (x:xs) rs+        | fn x = f xs (x:rs)+        | otherwise = f xs []++rbdropWhile :: (a -> Bool) -> [a] -> [a]+rbdropWhile fn xs = rdropWhile fn (dropWhile fn xs)++-- | group a list based on a function of the values.+groupUnder :: Eq b => (a -> b) -> [a] -> [[a]]+groupUnder f = groupBy (\x y -> f x == f y)+-- | sort a list based on a function of the values.+sortUnder :: Ord b => (a -> b) -> [a] -> [a]+sortUnder f = sortBy (\x y -> f x `compare` f y)++-- | merge sorted lists in linear time+smerge :: Ord a => [a] -> [a] -> [a]+smerge (x:xs) (y:ys)+    | x == y = x:smerge xs ys+    | x < y = x:smerge xs (y:ys)+    | otherwise = y:smerge (x:xs) ys+smerge [] ys = ys+smerge xs [] = xs++sortGroupUnder :: Ord a => (b -> a) -> [b] -> [[b]]+sortGroupUnder f = groupUnder f . sortUnder f+sortGroupUnderF :: Ord a => (b -> a) -> [b] -> [(a,[b])]+sortGroupUnderF f xs = [ (f x, xs) |  xs@(x:_) <- sortGroupUnder f xs]++sortGroupUnderFG :: Ord b => (a -> b) -> (a -> c) -> [a] -> [(b,[c])]+sortGroupUnderFG f g xs = [ (f x, map g xs) |  xs@(x:_) <- sortGroupUnder f xs]++minimumUnder :: Ord b => (a -> b) -> [a] -> a+minimumUnder _ [] = error "minimumUnder: empty list"+minimumUnder _ [x] = x+minimumUnder f (x:xs) = g (f x) x xs where+    g _ x [] = x+    g fb b (x:xs)+        | fx < fb = g fx x xs+        | otherwise = g fb b xs where+            fx = f x++maximumUnder :: Ord b => (a -> b) -> [a] -> a+maximumUnder _ [] = error "maximumUnder: empty list"+maximumUnder _ [x] = x+maximumUnder f (x:xs) = g (f x) x xs where+    g _ x [] = x+    g fb b (x:xs)+        | fx > fb = g fx x xs+        | otherwise = g fb b xs where+            fx = f x++-- | Flushes stdout and writes string to standard error+putErr :: String -> IO ()+putErr s = IO.hFlush IO.stdout >> IO.hPutStr IO.stderr s++-- | Flush stdout and write string and newline to standard error+putErrLn :: String -> IO ()+putErrLn s = IO.hFlush IO.stdout >> IO.hPutStrLn IO.stderr s+++-- | Flush stdout, write string and newline to standard error,+-- then exit program with failure.+putErrDie :: String -> IO a+putErrDie s = putErrLn s >> System.exitFailure+++-- | exit program successfully. 'exitFailure' is+-- also exported from System.+exitSuccess :: IO a+exitSuccess = System.exitWith System.ExitSuccess+++{-# INLINE fromRight #-}+fromRight :: Either a b -> b+fromRight (Right x) = x+fromRight _ = error "fromRight"++{-# INLINE fromLeft #-}+fromLeft :: Either a b -> a+fromLeft (Left x) = x+fromLeft _ = error "fromLeft"++-- | recursivly apply function to value until it returns Nothing+repMaybe :: (a -> Maybe a) -> a -> a+repMaybe f e = case f e of+    Just e' -> repMaybe f e'+    Nothing -> e++{-# INLINE liftT2 #-}+{-# INLINE liftT3 #-}+{-# INLINE liftT4 #-}++liftT4 (f1,f2,f3,f4) (v1,v2,v3,v4) = (f1 v1, f2 v2, f3 v3, f4 v4)+liftT3 (f,g,h) (x,y,z) = (f x, g y, h z)+-- | apply functions to values inside a tupele. 'liftT3' and 'liftT4' also exist.+liftT2 :: (a -> b, c -> d) -> (a,c) -> (b,d)+liftT2 (f,g) (x,y) = (f x, g y)+++-- | class for monads which can generate+-- unique values.+class Monad m => UniqueProducer m where+    -- | produce a new unique value+    newUniq :: m Int++--    peekUniq :: m Int+--    modifyUniq :: (Int -> Int) -> m ()+--    newUniq = do+--	v <- peekUniq+--	modifyUniq (+1)+--	return v++rtup a b = (b,a)+triple a b c = (a,b,c)++-- | the standard unix epoch+epoch :: ClockTime+epoch = toClockTime $ CalendarTime { ctYear = 1970, ctMonth = January, ctDay = 0, ctHour = 0, ctMin = 0, ctSec = 0, ctTZ = 0, ctPicosec = 0, ctWDay = undefined, ctYDay = undefined, ctTZName = undefined, ctIsDST = undefined}++-- | an arbitrary time in the future+endOfTime :: ClockTime+endOfTime = toClockTime $ CalendarTime { ctYear = 2020, ctMonth = January, ctDay = 0, ctHour = 0, ctMin = 0, ctSec = 0, ctTZ = 0, ctPicosec = 0, ctWDay = undefined, ctYDay = undefined, ctTZName = undefined, ctIsDST = undefined}++{-# INLINE fsts #-}+-- | take the fst of every element of a list+fsts :: [(a,b)] -> [a]+fsts = map fst++{-# INLINE snds #-}+-- | take the snd of every element of a list+snds :: [(a,b)] -> [b]+snds = map snd++{-# INLINE repeatM #-}+{-# SPECIALIZE repeatM :: IO a -> IO [a] #-}+repeatM :: Monad m => m a -> m [a]+repeatM x = sequence $ repeat x++{-# INLINE repeatM_ #-}+{-# SPECIALIZE repeatM_ :: IO a -> IO () #-}+repeatM_ :: Monad m => m a -> m ()+repeatM_ x = sequence_ $ repeat x++{-# RULES "replicateM/0" replicateM 0 = const (return []) #-}+{-# RULES "replicateM_/0" replicateM_ 0 = const (return ()) #-}++{-# INLINE replicateM #-}+{-# SPECIALIZE replicateM :: Int -> IO a -> IO [a] #-}+replicateM :: Monad m => Int -> m a -> m [a]+replicateM n x = sequence $ replicate n x++{-# INLINE replicateM_ #-}+{-# SPECIALIZE replicateM_ :: Int -> IO a -> IO () #-}+replicateM_ :: Monad m => Int -> m a -> m ()+replicateM_ n x = sequence_ $ replicate n x++{-# SPECIALIZE maybeToMonad :: Maybe a -> IO a #-}+-- | convert a maybe to an arbitrary failable monad+maybeToMonad :: Monad m => Maybe a -> m a+maybeToMonad (Just x) = return x+maybeToMonad Nothing = fail "Nothing"++toMonadM :: Monad m => m (Maybe a) -> m a+toMonadM action = join $ liftM maybeToMonad action++foldlM :: Monad m => (a -> b -> m a) -> a -> [b] -> m a+foldlM f v (x:xs) = (f v x) >>= \a -> foldlM f a xs+foldlM _ v [] = return v++foldl1M :: Monad m => (a -> a -> m a) ->  [a] -> m a+foldl1M f (x:xs) = foldlM f x xs+foldl1M _ _ = error "foldl1M"+++foldlM_ :: Monad m => (a -> b -> m a) -> a -> [b] -> m ()+foldlM_ f v xs = foldlM f v xs >> return ()++foldl1M_ ::Monad m => (a -> a -> m a)  -> [a] -> m ()+foldl1M_ f xs = foldl1M f xs >> return ()++-- | partition a list of eithers.+splitEither :: [Either a b] -> ([a],[b])+splitEither  (r:rs) = case splitEither rs of+    (xs,ys) -> case r of+        Left x -> (x:xs,ys)+        Right y -> (xs,y:ys)+splitEither          [] = ([],[])++isLeft Left {} = True+isLeft _ = False++isRight Right {} = True+isRight _ = False++perhapsM :: Monad m => Bool -> a -> m a+perhapsM True a = return a+perhapsM False _ = fail "perhapsM"++sameLength (_:xs) (_:ys) = sameLength xs ys+sameLength [] [] = True+sameLength _ _ = False++fromEither :: Either a a -> a+fromEither (Left x) = x+fromEither (Right x) = x++{-# INLINE mapFst #-}+{-# INLINE mapSnd #-}+mapFst :: (a -> b) -> (a,c) -> (b,c)+mapFst  f   (x,y) = (f x,  y)+mapSnd :: (a -> b) -> (c,a) -> (c,b)+mapSnd    g (x,y) = (  x,g y)++{-# INLINE mapFsts #-}+{-# INLINE mapSnds #-}+mapFsts :: (a -> b) -> [(a,c)] -> [(b,c)]+mapFsts f xs = [(f x, y) | (x,y) <- xs]+mapSnds :: (a -> b) -> [(c,a)] -> [(c,b)]+mapSnds g xs = [(x, g y) | (x,y) <- xs]++{-# INLINE rights #-}+-- | take just the rights+rights :: [Either a b] -> [b]+rights xs = [x | Right x <- xs]++{-# INLINE lefts #-}+-- | take just the lefts+lefts :: [Either a b] -> [a]+lefts xs = [x | Left x <- xs]++-- | Trasform IO errors into the failing of an arbitrary monad.+ioM :: Monad m => IO a -> IO (m a)+ioM action = catch (fmap return action) (\e -> return (fail (show e)))++-- | Trasform IO errors into the mzero of an arbitrary member of MonadPlus.+ioMp :: MonadPlus m => IO a -> IO (m a)+ioMp action = catch (fmap return action) (\_ -> return mzero)++-- | reformat a string to not be wider than a given width, breaking it up+-- between words.++paragraph :: Int -> String -> String+paragraph maxn xs = drop 1 (f maxn (words xs)) where+    f n (x:xs) | lx < n = (' ':x) ++ f (n - lx) xs where+        lx = length x + 1+    f _ (x:xs) = '\n': (x ++ f (maxn - length x) xs)+    f _ [] = "\n"++chunk :: Int -> [a] -> [[a]]+chunk 0 _  = repeat []+chunk _ [] = []+chunk mw s = case splitAt mw s of+    (a,[]) -> [a]+    (a,b) -> a : chunk mw b++chunkText :: Int -> String -> String+chunkText mw s = concatMap (unlines . chunk mw) $ lines s++rot13Char :: Char -> Char+rot13Char c+    | c >= 'a' && c <= 'm' || c >= 'A' && c <= 'M' = chr $ ord c + 13+    | c >= 'n' && c <= 'z' || c >= 'N' && c <= 'Z' = chr $ ord c - 13+    | otherwise                                    = c++rot13 :: String -> String+rot13 = map rot13Char++{-+paragraphBreak :: Int -> String -> String+paragraphBreak  maxn xs = unlines (map ( unlines . map (unlines . chunk maxn) . lines . f maxn ) $ lines xs) where+    f _ "" = ""+    f n xs | length ss > 0 = if length ss + r rs > n then '\n':f maxn rs else ss where+        (ss,rs) = span isSpace xs+    f n xs = ns ++ f (n - length ns) rs where+        (ns,rs) = span (not . isSpace) xs+    r xs = length $ fst $ span (not . isSpace) xs+-}++paragraphBreak :: Int -> String -> String+paragraphBreak  maxn xs = unlines $ (map f) $ lines xs where+    f s | length s <= maxn = s+    f s | isSpace (head b) = a ++ "\n" ++ f (dropWhile isSpace b)+        | all (not . isSpace) a = a ++ "\n" ++ f b+        | otherwise  = reverse (dropWhile isSpace sa) ++ "\n" ++ f (reverse ea ++ b) where+            (ea, sa) = span (not . isSpace) $ reverse a+            (a,b) = splitAt maxn s++expandTabs' :: Int -> Int -> String -> String+expandTabs' 0 _ s = filter (/= '\t') s+expandTabs' sz off ('\t':s) = replicate len ' ' ++ expandTabs' sz (off + len) s where+    len = (sz - (off `mod` sz))+expandTabs' sz _ ('\n':s) = '\n': expandTabs' sz 0 s+expandTabs' sz off (c:cs) = c: expandTabs' sz (off + 1) cs+expandTabs' _ _ "" = ""+++-- | expand tabs into spaces in a string assuming tabs are every 8 spaces and we are starting at column 0.+expandTabs :: String -> String+expandTabs s = expandTabs' 8 0 s++++-- | Translate characters to other characters in a string, if the second argument is empty,+-- delete the characters in the first argument, else map each character to the+-- cooresponding one in the second argument, cycling the second argument if+-- necessary.++tr :: String -> String -> String -> String+tr as "" s = filter (`notElem` as) s+tr as bs s = map (f as bs) s where+    f (a:_) (b:_) c | a == c = b+    f (_:as) (_:bs) c = f as bs c+    f [] _ c = c+    f as' [] c = f as' bs c+    --f _ _ _ = error "invalid tr"+++-- | quote strings rc style. single quotes protect any characters between+-- them, to get an actual single quote double it up. Inverse of 'simpleUnquote'+simpleQuote :: [String] -> String+simpleQuote ss = unwords (map f ss) where+    f s | any isBad s || null s = "'" ++ dquote s ++ "'"+    f s = s+    dquote s = concatMap (\c -> if c == '\'' then "''" else [c]) s+    isBad c = isSpace c || c == '\''++-- | inverse of 'simpleQuote'+simpleUnquote :: String -> [String]+simpleUnquote s = f (dropWhile isSpace s)  where+    f [] = []+    f ('\'':xs) = case quote' "" xs of (x,y) ->  x:f (dropWhile isSpace y)+    f xs = case span (not . isSpace) xs of (x,y) ->  x:f (dropWhile isSpace y)+    quote' a ('\'':'\'':xs) = quote' ('\'':a) xs+    quote' a ('\'':xs) = (reverse a, xs)+    quote' a (x:xs) = quote' (x:a) xs+    quote' a [] = (reverse a, "")++-- | quote a set of strings as would be appropriate to pass them as+-- arguments to a sh style shell+shellQuote :: [String] -> String+shellQuote ss = unwords (map f ss) where+    f s | any (not . isGood) s || null s  = "'" ++ dquote s ++ "'"+    f s = s+    dquote s = concatMap (\c -> if c == '\'' then "'\\''" else [c]) s+    isGood c = isAlphaNum c || c `elem` "@/.-_"+++-- | looks up an enviornment variable and returns it in an arbitrary Monad rather+-- than raising an exception if the variable is not set.+lookupEnv :: Monad m => String -> IO (m String)+lookupEnv s = catch (fmap return $ System.getEnv s) (\e -> if IO.isDoesNotExistError e then return (fail (show e)) else ioError e)++{-# SPECIALIZE fmapLeft :: (a -> c) -> [(Either a b)] -> [(Either c b)] #-}+fmapLeft :: Functor f => (a -> c) -> f (Either a b) -> f (Either c b)+fmapLeft fn = fmap f where+    f (Left x) = Left (fn x)+    f (Right x)  = Right x++{-# SPECIALIZE fmapRight :: (b -> c) -> [(Either a b)] -> [(Either a c)] #-}+fmapRight :: Functor f => (b -> c) -> f (Either a b) -> f (Either a c)+fmapRight fn = fmap f where+    f (Left x) = Left x+    f (Right x)  = Right (fn x)++{-# SPECIALIZE isDisjoint :: [String] -> [String] -> Bool #-}+{-# SPECIALIZE isConjoint :: [String] -> [String] -> Bool #-}+{-# SPECIALIZE isDisjoint :: [Int] -> [Int] -> Bool #-}+{-# SPECIALIZE isConjoint :: [Int] -> [Int] -> Bool #-}+-- | set operations on lists. (slow!)+isDisjoint, isConjoint :: Eq a => [a] -> [a] -> Bool+isConjoint xs ys = or [x == y | x <- xs, y <- ys]+isDisjoint xs ys = not (isConjoint xs ys)++-- | 'concat' composed with 'List.intersperse'. Can be used similarly to join in perl.+concatInter :: String -> [String] -> String+concatInter x = concat . (intersperse x)++-- | place spaces before each line in string.+indentLines :: Int -> String -> String+indentLines n s = unlines $ map (replicate n ' ' ++)$ lines s++-- | trim blank lines at beginning and end of string+trimBlankLines :: String -> String+trimBlankLines cs = unlines $ rbdropWhile (all isSpace) (lines cs)++buildTableRL :: [(String,String)] -> [String]+buildTableRL ps = map f ps where+    f (x,"") = x+    f (x,y) = replicate (bs - length x) ' ' ++ x ++ replicate 4 ' ' ++ y+    bs = maximum (map (length . fst) [ p | p@(_,_:_) <- ps ])++buildTableLL :: [(String,String)] -> [String]+buildTableLL ps = map f ps where+    f (x,y) = x ++ replicate (bs - length x) ' ' ++ replicate 4 ' ' ++ y+    bs = maximum (map (length . fst) ps)++{-# INLINE foldl' #-}+-- | strict version of 'foldl'+foldl' :: (a -> b -> a) -> a -> [b] -> a+foldl' _ a []     = a+foldl' f a (x:xs) = (foldl' f $! f a x) xs++-- | count elements of list that have a given property+count :: (a -> Bool) -> [a] -> Int+count f xs = g 0 xs where+    g n [] = n+    g n (x:xs)+        | f x = let x = n + 1 in x `seq` g x xs+        | otherwise = g n xs++-- | randomly permute a list, using the standard random number generator.+randomPermuteIO :: [a] -> IO [a]+randomPermuteIO xs = newStdGen >>= \g -> return (randomPermute g xs)++-- | randomly permute a list given a RNG+randomPermute :: StdGen -> [a] -> [a]+randomPermute _   []  = []+randomPermute gen xs  = (head tl) : randomPermute gen' (hd ++ tail tl)+   where (idx, gen') = randomR (0,length xs - 1) gen+         (hd,  tl)   = splitAt idx xs++hasRepeatUnder f xs = any (not . null . tail) $ sortGroupUnder f xs++-- | compute the power set of a list++powerSet       :: [a] -> [[a]]+powerSet []     = [[]]+powerSet (x:xs) = xss /\/ map (x:) xss+                where xss = powerSet xs++-- | interleave two lists lazily, alternating elements from them. This can also be+-- used instead of concatination to avoid space leaks in certain situations.++(/\/)        :: [a] -> [a] -> [a]+[]     /\/ ys = ys+(x:xs) /\/ ys = x : (ys /\/ xs)++++readHexChar a | a >= '0' && a <= '9' = return $ ord a - ord '0'+readHexChar a | z >= 'a' && z <= 'f' = return $ 10 + ord z - ord 'a' where z = toLower a+readHexChar x = fail $ "not hex char: " ++ [x]++readHex :: Monad m => String -> m Int+readHex [] = fail "empty string"+readHex cs = mapM readHexChar cs >>= \cs' -> return (rh $ reverse cs') where+    rh (c:cs) =  c + 16 * (rh cs)+    rh [] =  0+++{-# SPECIALIZE overlaps :: (Int,Int) -> (Int,Int) -> Bool #-}++-- | determine if two closed intervals overlap at all.++overlaps :: Ord a => (a,a) -> (a,a) -> Bool+(a,_) `overlaps` (_,y) | y < a = False+(_,b) `overlaps` (x,_) | b < x = False+_ `overlaps` _ = True++-- | translate a number of seconds to a string representing the duration expressed.+showDuration :: Integral a => a -> String+showDuration x = st "d" dayI ++ st "h" hourI ++ st "m" minI ++ show secI ++ "s" where+        (dayI, hourI) = divMod hourI' 24+        (hourI', minI) = divMod minI' 60+        (minI',secI) = divMod x 60+        st _ 0 = ""+        st c n = show n ++ c++-- | behave like while(<>) in perl, go through the argument list, reading the+-- concation of each file name mentioned or stdin if '-' is on it. If no+-- arguments are given, read stdin.++getArgContents :: IO String+getArgContents = do+    as <- System.getArgs+    let f "-" = getContents+        f fn = readFile fn+    cs <- mapM f as+    if null as then getContents else return $ concat cs++-- | Combination of parseOpt and getArgContents.+getOptContents :: String -> IO (String,[Char],[(Char,String)])+getOptContents args = do+    as <- System.getArgs+    (as,o1,o2) <- parseOpt args as+    let f "-" = getContents+        f fn = readFile fn+    cs <- mapM f as+    s <- if null as then getContents else return $ concat cs+    return (s,o1,o2)+++-- | Process options with an option string like the standard C getopt function call.+parseOpt :: Monad m =>+    String -- ^ Argument string, list of valid options with : after ones which accept an argument+    -> [String]  -- ^ Arguments+    -> m ([String],[Char],[(Char,String)])  -- ^ (non-options,flags,options with arguments)+parseOpt ps as = f ([],[],[]) as where+    (args,oargs) = g ps [] [] where+        g (':':_) _ _ = error "getOpt: Invalid option string"+        g (c:':':ps) x y = g ps x (c:y)+        g (c:ps) x y = g ps (c:x) y+        g [] x y = (x,y)+    f cs [] = return cs+    f (xs,ys,zs) ("--":rs) = return (xs ++ rs, ys, zs)+    f cs (('-':as@(_:_)):rs) = z cs as where+        z (xs,ys,zs) (c:cs)+            | c `elem` args = z (xs,c:ys,zs) cs+            | c `elem` oargs = case cs of+                [] -> case rs of+                    (x:rs) -> f (xs,ys,(c,x):zs) rs+                    [] -> fail $ "Option requires argument: " ++ [c]+                x -> f (xs,ys,(c,x):zs) rs+            | otherwise = fail $ "Invalid option: " ++ [c]+        z cs [] = f cs rs+    f (xs,ys,zs) (r:rs) = f (xs ++ [r], ys, zs) rs++readM :: (Monad m, Read a) => String -> m a+readM cs = case [x | (x,t) <-  reads cs, ("","") <- lex t] of+    [x] -> return x+    [] -> fail "readM: no parse"+    _ -> fail "readM: ambiguous parse"++readsM :: (Monad m, Read a) => String -> m (a,String)+readsM cs = case readsPrec 0 cs of+    [(x,s)] -> return (x,s)+    _ -> fail "cannot readsM"++-- | Splits a list into components delimited by separators, where the+-- predicate returns True for a separator element.  The resulting+-- components do not contain the separators.  Two adjacent separators+-- result in an empty component in the output.  eg.+--+-- > split (=='a') "aabbaca"+-- > ["", "", "bb", "c", ""]+--+split :: (a -> Bool) -> [a] -> [[a]]+split p s = case rest of+                []     -> [chunk]+                _:rest -> chunk : split p rest+  where (chunk, rest) = break p s++-- | Like 'split', except that sequences of adjacent separators are+-- treated as a single separator. eg.+--+--   > tokens (=='a') "aabbaca"+--   > ["bb","c"]+tokens :: (a -> Bool) -> [a] -> [[a]]+tokens p = filter (not.null) . split p+++buildTable ::  [String] -> [(String,[String])] -> String+buildTable ts rs = bt [ x:xs | (x,xs) <- ("",ts):rs ] where+    bt ts = unlines (map f ts) where+        f xs = concatInter " " [  es n s | s <- xs | n <- cw ]+        cw = [ maximum (map length xs) | xs <- transpose ts]+    es n s = replicate (n - length s) ' ' ++ s++-- | time task+doTime :: String -> IO a -> IO a+doTime str action = do+    start <- getCPUTime+    x <- action+    end <- getCPUTime+    putStrLn $ "Timing: " ++ str ++ " " ++ show ((end - start) `div` cpuTimePrecision)+    return x++getPrefix :: Monad m => String -> String -> m String+getPrefix a b = f a b where+    f [] ss = return ss+    f _  [] = fail "getPrefix: value too short"+    f (p:ps) (s:ss)+        | p == s = f ps ss+        | otherwise = fail $ "getPrefix: " ++ a ++ " " ++ b+++{-# INLINE naturals #-}+naturals :: [Int]+naturals = [0..]+++
+ GinsuConfig.hs view
@@ -0,0 +1,146 @@+module GinsuConfig(+    checkConfigIsGood,+    configureGinsu,+    doCheckConfig,+    getGaleProxy,+    getGaleId,+    getGaleDomain,+    getGaleAliases,+    galeFile,+    getEditor+    ) where++import ConfigFile+import Exception+import Data.Monoid+import Directory+import ErrorLog+import ExampleConf+import Gale.Gale+import Gale.Puff+import GenUtil+import Monad+import System+import System.Posix as Posix hiding (getEnv)++checkConfigIsGood = do+    gd <- configLookup "GALE_DOMAIN"+    case gd of+        Just _ -> return ()+        Nothing -> putStrLn "GALE_DOMAIN is not set! either set $GALE_DOMAIN in the enviornment or set it in ~/.gale/conf or ~/.gale/ginsu.conf\n" >> doCheckConfig++configFileG xs = mapConfig ("GINSU_" ++) (configFile xs) `mappend` configFile xs++configureGinsu = do+    galeDir <- getGaleDir+    configSetup $ mconcat+            [mapConfig ("GINSU_" ++) configEnv,+            configFileG (galeDir  ++ "ginsu.config"),+            configEnv,+            configFileG (galeDir ++ "conf"),+            configDefault (parseConfigFile exampleConf),+            configBuilder]++doCheckConfig = do+    galeDir <- getGaleDir+++    gp <- getGaleProxy+    gid <- configLookupElse "GALE_ID" "* Not Found *"+    galeDomain <- configLookupElse "GALE_DOMAIN" "* Not Found *"+    galeAliases <- getGaleAliases+    galeSubscribe <- configLookupList "GALE_SUBSCRIBE"+++    mapM_ putStrLn $ buildTableLL [+	( "GALE_DIR ",  galeDir),+	( "GALE_DOMAIN ", galeDomain),+	( "GALE_ID ", gid),+	( "GALE_PROXY ", simpleQuote gp),+	( "GALE_SUBSCRIBE ", unwords (snub galeSubscribe)) ]+    when (galeAliases /= []) $ putStrLn $ "GALE_ALIASES \n" +++	unlines ( map  (\ (l,cat) -> "  " ++ l ++ " -> " ++ show cat)  galeAliases)++    let p = (galeDir ++ "/auth/private/")+	knames = [p ++ gid, p ++ gid ++ ".gpri"]+    gn <- (mapM (\fn -> (doesFileExist fn >>= \b -> if b then return (Just fn) else return Nothing)) knames)+    case msum gn of+	Just fn -> putStrLn $ "Private key found in: " ++ fn+	Nothing -> putStrLn $ "Private key for '" ++ gid ++ "' not found in " ++ p+    putStrLn ""+    --putStrLn showKeyInfo+    --kt <- buildKeyTable+    --print kt+    exitSuccess++configBuilder = toConfig cb where+    cb "GALE_ID" = do+        n <- first [getEnv "LOGNAME", getEnv "USER", Posix.getLoginName]+        d <- configLookup "GALE_DOMAIN"+        case d of+            Just d -> return [("<LOGIN>@$GALE_DOMAIN",("GALE_ID", n ++ "@" ++ d))]+            Nothing -> return []+    cb _ = return []++getGaleProxy :: IO [String]+getGaleProxy = do+    gps <- configLookup "GALE_PROXY"+    case gps of+	Nothing -> do+	    v <- configLookup "GALE_DOMAIN"+            case v of+                Just v -> return $ hostStrings v+                Nothing -> return []+	(Just x) -> return (words x)+++getGaleId :: IO String+getGaleId = do+    v <- configLookup "GALE_ID"+    case v of+        Just x -> return x+        Nothing -> return ""++getGaleDomain :: IO String+getGaleDomain = do+    v <- configLookup "GALE_DOMAIN"+    case v of+        Just x -> return x+        Nothing -> do+            gid <- getGaleId+            return $ drop 1 (dropWhile (/= '@') gid)+++getGaleAliases :: IO [(String,Category)]+getGaleAliases = do+    v <- galeFile "aliases/"+    fs <- handle (\_ -> return []) $ getDirectoryContents v+    --putLog LogDebug $ "aliases/ " ++ show fs+    let f fn = do+	--fc <- first [readFile (v ++ fn), readSymbolicLink (v ++ fn)]+        fc <- readAlias (v ++ fn)+        --putLog LogDebug $ "readAlias " ++ (v ++ fn) ++ " " ++ fc+	return (fn, catParseNew fc)+    ks <- mapM (\x -> tryMost (f x)) fs+    return [x | (Right x) <- ks]+++readAlias :: String -> IO String+readAlias fn = getSymbolicLinkStatus fn >>= \s -> if isRegularFile s then readFile fn else+    (if isSymbolicLink s then  readSymbolicLink fn else fail "bad alias")++++varsLookupElse :: [String] -> IO String -> IO String+varsLookupElse ss action = do+    v <- fmap concat $ mapM configLookupList ss+    case v of+        (x:_) -> return x+        _ -> action++galeFile :: String -> IO String+galeFile fn = do+    gd <- getGaleDir+    return (gd ++ fn)++getEditor = varsLookupElse ["VISUAL", "EDITOR"] (return "vi")
+ Help.hs view
@@ -0,0 +1,126 @@+module Help(+    bugMsg,+    getHelpTable,+    usageHeader,+    usageTrailer+    ) where++import GenUtil(buildTableRL, indentLines)+import KeyName++{-# NOINLINE usageHeader #-}+{-# NOINLINE usageTrailer #-}+{-# NOINLINE bugMsg #-}+{-# NOINLINE getHelpTable #-}++usageHeader :: String+usageTrailer :: String+bugMsg :: String++usageHeader = "Usage: ginsu [OPTION...] categories..."++usageTrailer = unlines [+    "For more information see the homepage at",+    "   <http://repetae.net/john/computer/ginsu/>",+    "To report a bug go to:",+    "   <http://bugs.ofb.net/cgi-bin/bugzilla/enter_bug.cgi?product=Ginsu>",+    "When reporting a bug, include the last few lines of ~/.gale/ginsu.errorlog if it seems appropriate."+    ]++bugMsg = unlines [+    "There has been an internal error",+    "verify the output of ginsu --checkconfig and",+    "please inform <john@ugcs.caltech.edu> or file a bug report at",+    "<http://bugs.ofb.net/cgi-bin/bugzilla/enter_bug.cgi?product=Ginsu>",+    "Include the following text in any error report:"+    ]+++++getHelpTable = do+    ht <- getKeyHelpTable (0,0)+    return ("Keybindings:\n" ++ indentLines 2 ht ++ filters ++ "\nFor more info see the manual at\n  http://repetae.net/john/computer/ginsu/ginsu-manual.html\n")+++filters = "\nFilter Reference:\n" ++ indentLines 2 (unlines (buildTableRL [+    ("",""),+    ("Primitive Filters:",""),+    (" ~a:<gale-id>","author of puff"),+    (" ~c:<category>","category puff was sent too"),+    (" ~k:<regex>","regex match against keyword"),+    (" ~s:<regex>","regex match against senders real name"),+    (" ~b:<regex>","regex match against message body"),+    (" /<regex>","search for <regex> in visible fragments"),+    ("",""),+    ("Combining Filters:",""),+    (" A ; B", "Filter A or filter B"),+    (" A B", "Filter A and filter B"),+    (" !A", "Not filter A"),+    (" (A)", "Grouping, same as filter A"),+    (" /'foo bar'", "Single quotes are used to quote strings")+    ])) ++ "\n" ++ filterExamples+++filterExamples = "Filter Examples:\n"  ++ indentLines 4 (unlines es) where+    es = [+	"(~a:john@ugcs.caltech.edu)\n  all puffs by john@ugcs",+	"(~c:pub.tv.buffy ~a:jtr@ofb.net)\n  puffs from jtr and to pub.tv.buffy",+	"(/ginsu ; ~c:pub.gale.ginsu)\n  puffs containing the word ginsu or directed to pub.comp.ginsu",+	"(!~k:spoil)\n  no spoilers",+	"(~c:pub.tv.buffy !~c:pub.meow)\n  puffs to buffy which are not about cats"+	]++{-++paragraph maxn xs = drop 1 (f maxn (words xs)) where+    f n (x:xs) | lx <- length x + 1, lx < n = (' ':x) ++ f (n - lx) xs+    f n (x:xs) = '\n': (x ++ f (maxn - length x) xs)+    f n [] = "\n"++ keys = buildTableRL [+    ("Keys:", ""),+    ("<F1>", "Help Screen"),+    ("<F2>", "Main Screen"),+    ("<F3>", "Presence Status Screen"),+    ("",""),+    ("j","next puff"),+    ("k","previous puff"),+    ("<Home>","first puff"),+    ("<End>","last puff"),+    ("<Enter> <C-E>","forward one line"),+    ("<BackSpace> <C-Y>","back one line"),+    ("<C-F> <PgDown>","forward one page"),+    ("<C-B> <PgUp>","back one page"),+    ("<C-D>","forward one half-page"),+    ("<C-U>","back one half-page"),+    ("",""),+    ("d","Show puff details"),+    ("v","Visit links in puff"),+    ("",""),+    ("c ~","add new filter"),+    ("u","pop one filter"),+    ("U","pop all filters"),+    ("!","invert filter at top of stack"),+    ("x","swap top two filters on stack"),+    ("a","filter to current author"),+    ("t","filter to current thread"),+    ("T","filter to strict thread"),+    ("m[1-9]","set mark - save current filter stack at given key"),+    ("[1-9]","recall filter stack saved here with 'm'"),+    ("C[1-9]","recall filter stack and add it to current filter stack"),+    ("",""),+    ("f","follow-up to category"),+    ("p","compose new puff"),+    ("r","reply to author"),+    ("g","group reply, sends to recipients and author of puff"),+    ("R","resend selected puff"),+    ("N","modify public presence string"),+    ("",""),+    ("<C-R>","reconnect to all servers"),+    ("E","edit and reload configuration file"),+    ("q Q","quit program"),+    ("<C-L>","redraw screen")+    ]++-}
+ KeyHelpTable.hsgen view
@@ -0,0 +1,1 @@+perl gen_keyhelp.prl -h actions.def
+ KeyName.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE PatternGuards #-}+module KeyName(+    stringToKeys,+    keyCanon,+    keysToString,+    showKeyInfo,+    buildKeyTable,+    getKeyHelpTable+    ) where++import Char+import ConfigFile+import GenUtil+import KeyHelpTable+import List+import Screen(Key(..))++stringToKeys :: String -> [Key]+stringToKeys "" = []+stringToKeys ('\\':'x':a:b:cs) = (dh [a,b]) : stringToKeys cs  where+    dh x = case readHex x of+        Nothing -> KeyUnknown 0+        Just k -> KeyChar (chr k)+--stringToKeys ('<':c:'-':x:'>':cs) | c `elem` "cC" = KeyChar (ord (toLower x) - 0x40) : stringToKeys cs+stringToKeys ('<':cs) = let (n,r) = span (/= '>') cs in+     case lookup ((map toLower $ filter (not . isSpace) n)) ftl of+	Just k -> k+	Nothing -> KeyUnknown 0+      : stringToKeys (drop 1 r)+stringToKeys (c:cs) = KeyChar c : stringToKeys cs+++namedKeyTableInt = [+    ("NUL",0),+    ("Backspace",8),+    ("BS",8),+    ("Tab",9),+    ("Enter",13),+    ("Enter",10),+    ("NL",10),+    ("CR",13),+    ("Return",13),+    ("ESC",27),+    ("Space",32),+    ("LT",60),+    ("Backslash",92),+    ("SingleQuote",39),+    ("DoubleQuote",34),+    ("Bar",124),+    ("Backspace",127)+    ]++namedKeyTableKey = [+    ("Up",KeyUp),+    ("Down",KeyDown),+    ("Left",KeyLeft),+    ("Right",KeyRight),+    ("Help",KeyHelp),+    ("Undo",KeyUndo),+    ("Insert",KeyIC),+    ("Home",KeyHome),+    ("End",KeyEnd),+    ("PageUp",KeyPPage),+    ("PageDown",KeyNPage),+    ("Delete",KeyDC),+    ("Enter",KeyEnter),+    ("Print",KeyPrint),+    ("Backspace",KeyBackspace)+    ]+++fTable = map (\n -> ('F':show n,KeyF n)) [0..31]++cTable = map (\n -> ("C-" ++ [chr (n + 64)], KeyChar (chr n))) [0..31]++ft,ftl :: [(String,Key)]+ft = fTable ++ namedKeyTableKey ++ map (\(x,y) -> (x, KeyChar (chr y))) namedKeyTableInt ++ cTable+ftl = map (\(x,y) -> (map toLower x,y)) ft++kg :: [[Key]]+kg = transitiveGroup $ map (snub . map snd) (groupBy (\(x,_) (y,_) -> x == y)+	(sort ftl))++lkg :: Key -> [Key]+lkg k = case lookup k kgm of+        Just g -> g+        Nothing -> [k]+kgm = concatMap (\xs -> map (\x -> (x,xs)) xs) kg++transitiveGroup :: Eq a => [[a]] -> [[a]]+transitiveGroup gs = tg [] gs where+    tg x [] = x+    tg gs (g:rg) = tg (f gs g) rg+    f [] g = [g]+    f (x:xs) g | isConjoint g x = nub (x ++ g):xs+    f (x:xs) g = x:f xs g++showKeyInfo :: String+showKeyInfo = unlines $ (buildTableRL $ map (\(x,y) -> (x,show y)) ft) ++ sort (map (show . sort) kg)+++keyCanon :: Key -> Key+keyCanon k | ((y:_):_) <- [z| z <- kg, k `elem` z] = y+keyCanon k = k++keysToString ks = concatMap ck ks where+    ck c | (x:_) <- [n| (n,k) <- ft, k == c] = '<' : (x ++ ">")+    ck (KeyChar c) | ord c >= 0x80 && ord c < 0xa0 = "<" ++ show c ++ ">"+    ck (KeyChar c) = [c]+    ck k = "<KeyUnknown:" ++ show k ++ ">"+++type Action = String++++buildKeyTable :: IO [(Key,Action)]+buildKeyTable = do+    cl <- configLookupList "bind"+    let fl = concatMap ((\x -> do (a:b:_) <- return x ; return (a,b)) . words) cl+    return  (concatMap mk fl) where+        mk (k,a) | (k:_) <- stringToKeys k = map (rtup a) (lkg k)+        mk _ = []+++{-# NOTINLINE getKeyHelpTable #-}+getKeyHelpTable :: (Int,Int) -> IO String+getKeyHelpTable (_,_) = buildKeyTable >>= \kt -> let+    tl = concatMap f (keyHelpTable gk)+    f (Right (x,y)) = [(x,y)]+    f (Left x) = [("",""),(x ++ ":","")]+    gk :: String -> String+    gk s = maybe "" id $ lookup s m+    m :: [(String,String)]+    m = [ (fst (head xs),ks (snub (snds xs))) | xs <- groupFst (sort [ (y,x) | (x,y) <- kt])]+    ks ks = concatInter ", " (snub $ map (\x -> keysToString [x]) ks)++      in return $ unlines (bTableRL tl)++bTableRL :: [(String,String)] -> [String]+bTableRL ps = map f ps where+    f ("","") = ""+    f (x,"") = x+    f ("",y) = y+    f (x,y) = replicate (bs - length x) ' ' ++ x ++ replicate 4 ' ' ++ y+    bs = maximum (map (length . fst) [p | p <- ps, not (null (snd p))])+
+ LICENSE view
@@ -0,0 +1,23 @@+Unless otherwise stated the following licence applies:++Copyright (c) 2002-2004 John Meacham (john at repetae dot net)++Permission is hereby granted, free of charge, to any person obtaining a+copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+
+ Main.hs view
@@ -0,0 +1,1110 @@+{-# LANGUAGE OverlappingInstances, PatternGuards #-}+module Main(main) where++import Char+import Directory+import List hiding(or,and,any,all)+import Maybe+import System.Cmd+import System.Time+import Random++import Control.Concurrent+import Exception as Control.Exception+import Data.Array.IO+import Data.IORef+import Data.Unique+import qualified Data.HashTable as Hash+import qualified System.Posix as Posix+import qualified System.Posix.IO as PosixIO+import System.IO++import Atom+import Boolean.Algebra+import Boolean.Boolean+import CacheIO+import Charset+import ConfigFile+import Control.Monad.Error+import Curses+import Doc.Chars(rTee,hLine,lTee)+import Doc.DocLike hiding(space)+import EIO+import ErrorLog+import Filter+import Gale.Gale+import Gale.KeyCache(numberKeys)+import Gale.Puff+import GenUtil+import GinsuConfig+import Help+import KeyName+import MyLocale+import Options+import PackedString+import Prelude hiding((&&),(||),not,and,or,any,all)+import Regex+import RSA+import Screen+import Status+import System.Locale+import Version++import qualified Data.ByteString.Lazy as LBS++idleThreshold = 240+pufflog = "ginsu.5.pufflog"+helpText = "Need help? Press F1 or ?"++getTmpFile = do+    pid <- Posix.getProcessID+    u <- newUnique+    return ("/tmp/ginsu.puff." ++ show pid ++ "." ++ show (hashUnique u))++data MainEvent = MainEventKey Curses.Key | MainEventPuff Puff | MainEventComposed (Maybe Puff) (IO ())+insertKeys ic s = mapM_ (\c -> writeChan ic (MainEventKey c)) (stringToKeys s)++{-# NOTINLINE main #-}+main = do+    setupLocale+    configureGinsu+    (flags, acats) <- ginsuOpts+    checkConfigIsGood++    withErrorMessage bugMsg $ do++    logname <- case envErrorLog flags of+	Just x -> return x+	Nothing -> galeFile "ginsu.errorlog"++    withErrorLog logname $ withStartEndEntrys "Ginsu" $ do++    case (envVerbose flags) of+	1 -> do+	    setLogLevel LogInfo+	    putLog LogNotice $ "Verbosity level: Info"+	n | n > 1 -> do+	    setLogLevel LogDebug+	    putLog LogNotice $ "Verbosity level: Debug"+	_ -> return ()++    cs <- configLookup "CHARSET"++    charsetSetup cs+++    setErrorLogPutStr $ \h s -> do+        Status.log s+        Charset.csHPutStr h s+++    galeDir <- getGaleDir+    gp <- getGaleProxy+    gid <- getGaleId+    galeDomain <- getGaleDomain+    galeAliases <- getGaleAliases++    Status.set "Ginsu.Version" Version.fullName+    Status.set "Ginsu.Errorlog" logname+    Status.setF "Ginsu.Charset" MyLocale.getCharset++    Status.setF "Gale.Config.Domain" getGaleDomain+    Status.setF "Gale.Config.Id" getGaleId+    Status.setF "Gale.Config.Proxy" (fmap simpleQuote getGaleProxy)+    Status.setF "Gale.Config.Dir" getGaleDir++    putLog LogInfo $ "GALE_DIR " ++ galeDir+    putLog LogInfo $ "GALE_DOMAIN " ++ galeDomain+    putLog LogInfo $ "GALE_ID " ++ gid+    putLog LogInfo $ "GALE_PROXY " ++ simpleQuote gp+    putLog LogInfo $ "GALE_ALIASES \n" +++	unlines ( map  (\(l,cat) -> "  " ++ l ++ " -> " ++ show cat)  galeAliases)+++    Control.Exception.bracket_ initCurses endWin $ do+    b <- configLookupBool "USE_DEFAULT_COLORS"+    when b useDefaultColors++    withCursor CursorInvisible $ do++    ic <- newChan+    b <- configLookupBool "DISABLE_SIGWINCH"++    redraw_r <- newRenderContext++    Posix.installHandler Posix.sigINT Posix.Ignore Nothing+    Posix.installHandler Posix.sigPIPE Posix.Ignore Nothing+    case (b,cursesSigWinch) of+	(False,Just s) -> Posix.installHandler s (Posix.Catch (resizeRenderContext redraw_r (writeChan ic (MainEventKey KeyResize)))) Nothing >> return ()+	_ -> return ()++    gs <- fmap (concat . map words) $ configLookupList "GALE_SUBSCRIBE"+    gps <- getGaleProxy+    let c =  if envJustArgs flags then acats else gs ++ acats+        nc = map ("_gale.notice@" ++) $ snub (map categoryCell (map catParseNew c))+    --let c =  gs ++ acats+    --    nc = map ("_gale.notice@" ++) $ snub (snds (map catParseNew c))+    withGale gps $ \gc -> do++    Status.setF "Gale.Server" (fmap fromEither $ readMVar $ connectionStatus gc )+    Status.setF "Gale.Categories"  (fmap (unwords . map catShowNew ) $ readMVar $ gCategory gc )+    Status.setFS "Gale.Keys.Cached" (numberKeys $ keyCache gc)++    galeAddCategories gc $ map catParseNew (snub $ c ++ nc)+    Category (name,domain) <- fmap catParseNew getGaleId+    galeAddCategories gc $ [Category ("_gale.rr." ++ name ,domain)]+    doRender widgetEmpty+    pl <- forkIO $ puffLoop ic gc+    gl <- forkIO $ getchLoop ic+    yo <- newIORef (0::Int)+    plog <- galeFile pufflog+    ops <- if envNoPufflog flags then return [] else+        doRender (widgetCenter $  widgetText "Reading pufflog...") >> readPuffs plog+    ps <- newMVar ((reverse $ zip [1..] (reverse ops)))+    next_r <- newIORef (length ops + 1)+    pcount_r <- newIORef 0+    unless (envNoWritePufflog flags || envNoPufflog flags) $ (forkIO $ pufflogLoop ps pcount_r 0) >> return ()++    (Just s) <- configLookup "ON_STARTUP"+    insertKeys ic s++    doRender (widgetCenter $  widgetText "Entering main loop...")+    mainLoop gc ic yo ps next_r pcount_r redraw_r+    killThread pl+    killThread gl+    ps <- liftM (map snd) $ readVal ps+    unless (envNoPufflog flags || envNoWritePufflog flags) $ doRender (widgetCenter $ widgetText "Writing pufflog...") >>  writePufflog ps++pufflogLoop ps_r pcount_r n = do+    rnd <- randomIO+    threadDelay (30000000 + (rnd `mod` 10000000))+    n' <- readVal pcount_r+    if n' /= n+        then do+	    ps <- liftM (map snd) $ readVal ps_r+	    writePufflog ps+	    pufflogLoop ps_r pcount_r n'+        else pufflogLoop ps_r pcount_r n++writePufflog ps = do+    plog <- galeFile pufflog+    plsize <- fmap (read . fromJust) $ configLookup "PUFFLOG_SIZE"+    withPrivateFiles $ writePuffs plog (if (plsize > 0) then (take plsize ps) else ps)+++++puffLoop ic gc = repeatM_ $  galeNextPuff gc >>= \p -> (writeChan ic $ MainEventPuff p)+getchLoop ic = repeatM_ (getCh >>= \x -> writeChan ic (MainEventKey x))+++apHead f (x:xs) = f x:xs+apHead _ [] = []+++expandAliases :: [Category] -> IO [Category]+expandAliases cats = do+    as <- getGaleAliases+    gd <- getGaleDomain+    let ec x@(Category (c,"")) = de $ head $ [Category (tc ++ drop (length f) c,td) | (f,Category (tc,td)) <- as, f `isPrefixOf` c] ++ [x]+	ec x = x+	de (Category (c,"")) = Category (c,gd)+	de x = x+    return $ map ec cats++{-+statusBarWidget :: SVar String -> SVar Int -> SVar Int -> Widget+statusBarWidget svm svs svpc = widgetHorizontalBox False [(NoExpand,m), (Expand, widgetEmpty), (NoExpand,s), (NoExpand,widgetText "/"), (NoExpand, pc), (NoExpand,widgetText " ") ] where+    m = newSVarWidget svm widgetText+    s = newSVarWidget svs (widgetText . show)+    pc = newSVarWidget svpc (widgetText . show)+-}++type PresenceData = [(String,(String,String))]+presenceString (_,(_,n)) = n++--presenceView :: PresenceData -> Widget+presenceView idleHash pl = dynamicWidget $ do+    itl <- Hash.toList idleHash+    (TOD ct _) <- getClockTime+    let pt = unlines $ "Online:": buildTableLL (concatMap rt (gf  plon)) ++ ["", "Offline:"] ++ buildTableLL (concatMap rt (gf ploff))+        gf ts = map (\ts -> (fst (head ts), snds ts)) (groupBy (\(a,_) (b,_) -> a == b) (sort ts))+        (ploff,plon) = partition (\p -> "out" `isPrefixOf` presenceString p ) pl+        rt (a,bs) = [(a,it a ++ concatInter ", " (snub (snds bs)))]+        it a = case lookup a itl of+            Just n | n == epoch -> "[not idle]"+            Just (TOD nct _) ->  if (ct - nct) < idleThreshold then "[not idle] " else "[" ++ showDuration (ct - nct) ++ "] "+            Nothing -> ""+    return $ widgetText pt++++presenceViewUser :: String -> PresenceData -> Widget+presenceViewUser user pl = widgetText pt where+    pt = user ++ ":\n" ++ indentLines 2  (unlines $ buildTableLL ([b|(a,b) <- pl, a == user]))++++dialog "" = widgetEmpty+dialog s = widgetCenter $ widgetAttr [AttrBold] $ widgetSimpleFrame wb where+    wb = widgetText $ unlines ([les] ++ map f es ++ [les])+    m  = (maximum (map length es))+    f es = es ++ replicate (m - length es) ' '+    les = replicate m ' '+    es = map (\s -> " " ++ s ++ " " ) (lines s)++generateIdInstance = do+    pid <- Posix.getProcessID+    n <- liftM Posix.nodeName Posix.getSystemID+    return $ n ++ "/" ++ show pid+++puffTemplate :: IO Puff+puffTemplate = do+    idText <- generateIdInstance+    gi <- getGaleId+    t <- getClockTime+    u <- newUnique+    gn <- configLookup "GALE_NAME"+    n <- case gn of+	Just n -> return ((f_messageSender,FragmentText (packString n)):)+	Nothing -> return id+    let mid = sha1 . LBS.pack $ map (fromIntegral . ord) (show t ++ " " ++ idText ++ " " ++ show (hashUnique u))+    let sig = [Signed (Key gi [])]+    let ef = n [+	    (f_messageId, FragmentText $ packString $ bsToHex mid),+	    (fromString "id/class",FragmentText $ packString (package ++ "/" ++ version) ),+	    (fromString "id/instance", FragmentText $ packString idText),+	    (f_idTime,FragmentTime t)]+    return emptyPuff {fragments = ef, signature = sig}+++type Position =  Int+data Marks = Marks !(IOArray Char (Maybe [Filter])) !(IOArray Char (Maybe Position))++newMarks = go where+    go = do+        a1 <- newArray ('0', 'z') Nothing+        a2 <- newArray ('0', 'z') Nothing+        mapM_ (checkMark a1) ['1' .. '9']+        return (Marks a1 a2)+    checkMark ma n = do+        let name = ("MARK_" ++ [n])+        v <- configLookup name+        case v of+            Nothing -> return ()+            Just z -> case parseFilter z of+                Left err -> putLog LogError ("Could not parse mark:" <+> name <+> z <+> err) >> return ()+                Right y -> writeArray ma n (Just [y])++mark_set_filter :: Marks -> Char -> [Filter] -> IO ()+mark_set_filter (Marks arr _) c f = writeArray arr c (Just f)+mark_set_pos (Marks _ arr) c p = writeArray arr c (Just p)++mark_get_value (Marks a b) c = do+    f <- readArray a c+    p <- readArray b c+    return (f,p)++{-+mark_set_value m c (f,p) = do+    mark_set_filter m c f+    mark_set_pos m c p+-}+mark_valid :: Char -> Bool+mark_valid ch = ch >= '0' && ch <= 'z'++data GinsuState = GinsuState { gsMarks :: !Marks , gsWorkspace :: !(MVar Char) }+newGinsuState = do+    marks <- newMarks+    workspace_r <- newMVar '1'+    return GinsuState { gsMarks = marks, gsWorkspace = workspace_r }+++messageBox :: RenderContext -> Widget -> String -> IO Bool+messageBox rc fw s = setRenderWidget rc (stackedWidgets [keyCatcherWidget pk (dialog s), fw]) >> return True where+    pk _ =  setRenderWidget rc fw >> return True+askBox rc fw s pk = setRenderWidget rc (stackedWidgets [keyCatcherWidget pk  (dialog s), fw]) >> return True++markBox rc fw s action = askBox rc fw  s pk where+    pk (KeyChar n) | mark_valid n  = do+        action n+        setRenderWidget rc fw+        return True+    pk key = messageBox rc fw ("Invalid mark: " ++ keysToString [key])++mainLoop gc ic yor psr next_r pcount_r rc = do++    gs <- newGinsuState++    -- mark_set_r <- newIORef (listArray (0,9) (replicate 10 []))+    hw <- helpWidget+    statusWidget <- statusWidget++    selected_r <- newMVar 0+    let puffcount_r = readVal psr >>= return . length+    filter_r <- newMVar []++    presence_r <- newMVar []++    rot13_r <- newMVar False++    editing_r <- newMVar False++    presence <- configLookupElse "GALE_PRESENCE" "in.perhaps"+    myPresence <- newJVar presence++    Status.setF "Gale.Presence" (readVal myPresence)++    idleHash <- Hash.new (==) Hash.hashString+    puffRRHash <- Hash.new (==) Hash.hashString++    presenceWidget <- widgetScroll (newSVarWidget presence_r (presenceView idleHash))++    ct <- getClockTime+    userActionTime <- newJVar ct++    keyTable <- buildKeyTable+    matchTable <- buildMatchTable++    icmain <- newChan++    let fsw = newSVarWidget filter_r $ \fs ->+	    widgetHorizontalBox False (intersperse (NoExpand, widgetText " ") $ map (\w -> (NoExpand,widgetAttr [AttrReverse] (widgetText w))) (map showFilter fs))++    selPuff <- newCacheIO $ do+        ps <-  readVal psr+        selected <- cacheIO $ readVal selected_r+        return $ lookup selected ps++++    getFilteredPuffs <- newCacheIO $ do+        (_,xs) <- cacheIOeq scrSize+        ps <- cacheIO $ readVal psr+        fs <- cacheIO $ readVal filter_r+        let f p = all (`filterAp` p) fs+        return  [(x,puffHeight p xs)| x@(_,p) <- ps, f p]+++    buf_size <- newCacheIO $ cacheIO getFilteredPuffs >>= \ps -> return $ sum [x| (_,x) <- ps]+    let statusHeight = do+            fs <- readVal filter_r+            return $ if length fs == 0 then 1 else 2++    let sb = dynamicWidget $ do+        let m = widgetText helpText+        s <- fmap (widgetText . show) $ readVal selected_r+        nf <- fmap (widgetText . show) $ fmap length getFilteredPuffs+        pc <- fmap (widgetText . show) $  puffcount_r+        ws <- fmap (widgetText . show) $  readVal (gsWorkspace gs)+        st <- readVal $ connectionStatus gc+        let wt s = (NoExpand,widgetText s)+            ne w = (NoExpand,w)+        let f = case st of+                Right _ -> id+                Left s -> \w -> widgetVerticalBox False [ne w, (NoExpand,widgetAttr [AttrReverse] (widgetText $ "*** " ++ s ++ " ***"))]+        return $ f $ widgetHorizontalBox False [ne m, (Expand, widgetEmpty), wt "Workspace:", ne ws ,wt " ", ne s, wt " (", ne nf , wt "/", ne pc , wt ") " ]+    let	keyError s k = messageBox rc fw (s ++ ": " ++ keysToString [k] ++ " -- " ++ helpText) >> return ()+        setMessage m = messageBox rc fw m >> return ()+	scrollPuffs x = mapVal yor (+ x)+        autoSaveMark = do+            n <- readVal (gsWorkspace gs)+            s <- readVal selected_r+            mark_set_pos (gsMarks gs) n s+            fs <- readVal filter_r+            mark_set_filter (gsMarks gs) n fs+        setWorkspace n = do+            autoSaveMark+            writeVal (gsWorkspace gs) n+            (f,s) <- mark_get_value (gsMarks gs) n+            modifyFilter $ maybe id const f+            maybe (return ()) (writeVal selected_r) s+            select_perhaps select_next+            center_puff+	filter_thread = do+	    p <-  selPuff+	    case p of+		Just (Puff {cats = [c]}) -> modifyFilter (BoolJust (FilterCategory c):)+		Just (Puff {cats = cs}) -> modifyFilter (or (map (BoolJust . FilterCategory) cs):)+		_ -> return ()++	addPuff p = do+            let author = getAuthor p+            Category (name,domain) <- fmap catParseNew getGaleId+	    case getFragmentString p (f_noticePresence') of+		Nothing -> return ()+		Just pn -> do+		    let np@(a',(b',_)) = (author, (maybe "unknown" unpackPS (getFragmentString p (fromString "id/instance")), unpackPS pn))+		    mapVal presence_r (\xs -> (np:[x| x@(a,(b,_)) <- xs, a /= a' || b /= b']))+	    case getFragmentTime p (fromString "status.idle") of+		Nothing -> return ()+                Just pn | pn == epoch -> Hash.delete idleHash author >> getClockTime >>=  Hash.insert idleHash author+		Just pn -> do+                    mt <- Hash.lookup idleHash author+                    Hash.delete idleHash author+                    Hash.insert idleHash author $ fromJust $ max mt (Just pn)+            case getFragmentString p (fromString "answer.receipt") of+                Just n | [Category (cat,dom)] <- cats p, dom == domain, ("_gale.rr." ++ name) `isPrefixOf` cat -> do+                    mv <- Hash.lookup puffRRHash (drop (10 + length name) cat)+                    Hash.delete puffRRHash (drop (10 + length name) cat)+                    Hash.insert puffRRHash (drop (10 + length name) cat) (unpackPS n:concat (maybeToMonad mv))+                _ -> return ()+++	    case getFragmentString p (f_questionReceipt) of+		Nothing -> return ()+		Just _ -> buildReciept p >>= \p -> forkIO (galeSendPuff gc p) >> return ()+	    case fmap unpackPS $ getFragmentString p f_messageBody of+		Nothing -> return ()+		Just n -> when (not $ (all isSpace n) && (all (("_gale" `isPrefixOf`) . categoryHead) (cats p))) $ do+                    mt <- Hash.lookup idleHash author+                    pn <- getClockTime+                    Hash.insert idleHash author $ fromJust $ max mt (Just pn)+		    v <- configLookupList "BEEP"+		    let f = or (catMaybes (map parseFilter v))+		    when (filterAp f p) Curses.beep+		    n <- readVal next_r+		    mapVal next_r (+1)+		    mapVal pcount_r (+1)+		    mapVal psr (\ps -> ((n,p):ps))+                    sbsize <- fmap (read . fromJust) $ configLookup "SCROLLBACK_SIZE"+		    case sbsize of+		        0 -> return ()+                        _ -> do+                            let keep = min n sbsize+                            mapVal psr (\ps -> zip [keep, (keep - 1) .. 1] (snds $ take keep ps))+                            mapVal selected_r (\s -> s - (n - keep))+                            mapVal next_r (\s -> s - (n - keep))+		    select_perhaps select_next+		    --touchRenderContext rc+	composePuff :: IO () -> [Category] -> [PackedString] -> IO ()+	composePuff done cs kwds = do+	    p <- puffTemplate+	    editPuff (p {cats = cs, fragments = fragments p ++ [ (f_messageKeyword,FragmentText k) | k <- kwds]}) ic done+	getPresenceFrags = do+	    mp <- readVal myPresence+	    (TOD ct _) <- getClockTime+	    uaT@(TOD uat _) <- readVal userActionTime+	    (it,is,notIdle) <- return $ case ct - uat of+		n | n < idleThreshold -> (epoch," (not idle)",True)+		n -> (uaT," (" ++ (showDuration n) ++ " idle)",False)+	    return ([+		    (f_noticePresence',FragmentText (packString (mp ++ is))),+		    (fromString "status.presence", FragmentText $ packString mp),+		    (fromString "status.idle", FragmentTime it)],notIdle)+	buildReciept p = do+	    np <- puffTemplate+	    r <- getFragmentString p (fromString "question.receipt")+	    gid <- getGaleId+	    let rid = maybe [] (\x -> [(fromString "receipt.id",FragmentText x)]) $ getFragmentString p (f_messageId)+	    (pf,_) <- getPresenceFrags+	    return $ np { cats = [catParseNew (unpackPS r)], fragments = fragments np ++ pf ++ rid ++ [(fromString "answer.receipt",FragmentText $ packString gid)]}+	presenceLoop = do+	    let loopIsIdle ct = do+                    ct' <- waitJVarEq userActionTime ct+                    notIdle <- sendPresence True+                    if notIdle then loopNotIdle else loopIsIdle ct'+		loopNotIdle = do+		    notIdle <- sendPresence False+		    threadDelay $ (fromIntegral idleThreshold) * 1000000+		    if notIdle then loopNotIdle else readVal userActionTime >>= loopIsIdle+	    sendPresence True+	    loopNotIdle+	sendPresence sendIfNotIdle = do+            notifyCategory <- getMyNotifyCategory+	    (pf,notIdle) <- getPresenceFrags+	    when (sendIfNotIdle || not notIdle) $ do+		p <- puffTemplate+		galeSendPuff gc $ p {cats = [notifyCategory], fragments = fragments p ++ pf}+	    return notIdle+	gonePresencePuff = do+            notifyCategory <- getMyNotifyCategory+	    p <- puffTemplate+	    let ef = [(f_noticePresence' ,FragmentText (toPackedString f_outGone)), (f_noticePresence, FragmentText (toPackedString f_outGone))]+	    return $ p {cats = [notifyCategory], fragments = fragments p ++ ef }+	modifyFilter f = do+	    mapVal filter_r f+	    select_perhaps select_next >> select_perhaps select_prev+	    center_puff+	center_puff = do+	    (ys,_) <- scrSize+	    selected <- readVal selected_r+	    ps <- liftM reverse getFilteredPuffs+	    let f t (((n,_),h):_) | n == selected = (t,t+h)+		f t ((_,h):rest) = f (t + h) rest+		f _ [] = (1000000,0)+	    let (mn,mx) = (f 0) ps+	    mapVal yor (min mn)+	    sh <- statusHeight+	    mapVal yor (max (mx - (ys - sh) ))+	is_at_end = do+	    (ys,_) <- scrSize+	    bs <- buf_size+	    sh <- statusHeight+	    fmap ((max (bs - (ys - sh)) 0) ==) $ readVal yor+        scroll_end = do+	    (ys,_) <- scrSize+	    bs <- buf_size+	    sh <- statusHeight+	    writeVal yor (max (bs - (ys - sh)) 0)+	doRedraw _ (xs,ys) = do+	    bs <- buf_size+	    sh <- statusHeight+	    mapVal yor (min (max 0 (bs - (ys - sh))))+	    selected <- readVal selected_r+	    ps <- getFilteredPuffs+	    yo <- readVal yor+	    isRot13 <- readVal rot13_r+	    let rp _ [] =  return ()+		rp y (((i,p),n):rest) = do+		    when ((0,ys) `overlaps` (y - yo, y - yo + n)) $ renderPuff p xs stdScr (y - yo) (xs,ys) (i == selected) (if isRot13 then rot13 else id)+		    rp (y + n) rest+	    attempt (rp 0 (reverse ps))+	select_perhaps a = do+	    ps <- getFilteredPuffs+	    n <- readVal selected_r+	    unless (maybe False (const True) $ lookup n (fsts ps)) a+	select_prev = do+	    ps <- liftM fsts getFilteredPuffs+	    let f sel ((n,_):_) | n < sel = n+		f sel (_:ps) = f sel ps+		f sel [] = sel+	    mapVal selected_r (\s ->(f s ps))+	select_next = do+	    ps <- liftM fsts getFilteredPuffs+	    let f sel _ ((n,_):ps) | n > sel = f sel n ps+		f sel bg ((n,_):ps) | n > sel = f sel bg ps+		f _ bg _ = bg+	    mapVal selected_r (\s ->(f s s ps))++        fw = widgetVerticalBox False [(ExpandFill, mwidget), (NoExpand, widgetAttr [AttrBold] sb), (NoExpand, fsw)]+	mwidget = widgetEmpty { render = rnd,  processKey = pk}+	rnd canvas = doRedraw (origin canvas) (bounds canvas)+	continue = return True+        keyTable' = (map (\(a,b) -> (a, perform_action b)) keyTable)+        pk x = case lookup x keyTable' of+            Nothing -> case x of+                (KeyChar n) | n `elem` "123456789" -> setWorkspace n >> continue+                key -> keyError "Invalid key" key >> continue+            Just x -> x+        withEditing f = do+            lv <- readVal editing_r+            if lv then continue else writeVal editing_r True >> f+        perform_action x = case x of+                "reconnect_to_servers" -> reloadConfigFiles >> getGaleProxy >>= \gp -> galeSetProxys gc gp >>  reconnectGaleContext gc >> continue+                "ask_quit" ->+                    let pk x = case x of+                            (KeyChar 'y') -> return False+                            (KeyChar 'Y') -> return False+                            _ -> setRenderWidget rc fw >> return True+                        in setRenderWidget rc (stackedWidgets [keyCatcherWidget pk (dialog "Really quit (y/n)?"), fw]) >> return True+                "fast_quit" -> return False+                "next_line" -> scrollPuffs 1 >> continue+                "previous_line" -> scrollPuffs (-1) >> continue+                "forward_half_page" -> scrSize >>= \(ys,_) ->  scrollPuffs (ys - 2 `div` 2) >> continue+                "backward_half_page" -> scrSize >>= \(ys,_) ->  scrollPuffs (- (ys - 2 `div` 2)) >> continue+                "next_page" -> scrSize >>= \(ys,_) -> scrollPuffs (ys - 2) >> continue+                "previous_page" -> scrSize >>= \(ys,_) -> scrollPuffs (-ys - 2) >> continue+                "edit_config_file" -> do+                    gc <- galeFile "ginsu.config"+                    e <- getEditor+                    --mySystem (e ++ " " ++ gc)+                    myRawSystem e [gc]+                    reloadConfigFiles+                    --touchRenderContext rc+                    return True+                "first_puff" -> writeVal selected_r 0 >> select_perhaps select_next >> writeVal yor 0 >> continue+                "last_puff" -> do+                    ps <- readVal psr+                    case ps of+                        ((n,_):_) -> writeVal selected_r n >> select_perhaps select_prev >> scroll_end >> continue+                        _ -> continue+                "next_puff" -> select_next >> center_puff >> continue+                "previous_puff" -> select_prev >> center_puff >> continue+                "pop_one_filter" -> modifyFilter  (drop 1) >> continue+                "pop_all_filters" -> modifyFilter (const []) >> continue+                "invert_filter" -> modifyFilter (apHead f) >> continue where+                    f (BoolNot x) = x+                    f x = not x+                "swap_filters" -> modifyFilter f >> continue where+                    f (x:y:r) = y:x:r+                    f x = x+                "filter_current_thread" -> filter_thread >> continue+                "recall_combine_mark" -> markBox rc fw "Combine which filter mark?" fn where+                    fn n = do+                        (f,_) <- mark_get_value (gsMarks gs) n+                        modifyFilter $ maybe id (++) f+                "recall_filter_mark" -> markBox rc fw "Recall which filter mark?" fn where+                    fn n = do+                        (f,_) <- mark_get_value (gsMarks gs) n+                        modifyFilter $ maybe id const f+                "set_filter_mark" -> markBox rc fw "Set which mark?" fn where+                    fn n = do+                        fs <- readVal filter_r+                        mark_set_filter (gsMarks gs) n fs+                "set_mark" ->  markBox rc fw "Set which mark?" fn where+                    fn n = do+                        s <- readVal selected_r+                        mark_set_pos (gsMarks gs) n s+                "recall_mark" ->  markBox rc fw "Recall which mark?" fn where+                    fn n = do+                        (_,s) <- mark_get_value (gsMarks gs) n+                        maybe (return ()) (writeVal selected_r) s+                        select_perhaps select_next+                        center_puff+                "filter_current_author" -> do+                    p <- readVal selPuff+                    case p of+                        Nothing -> continue+                        Just p -> case getSigner p of+                            Just a -> do+                                modifyFilter (BoolJust (FilterAuthor a):)+                                continue+                            Nothing -> setMessage "No signed puff to get author from" >> continue+                "prompt_new_filter" -> do+                    (ys,_) <- scrSize+                    v <- commandRead justGetKey stdScr (ys - 1) "Filter: " ""+                    case v >>= parseFilter >>= \x -> return (modifyFilter (x:)) of+                        Right a -> a+                        Left "" -> return ()+                        Left err -> setMessage $ "Invalid filter:" <+> err+                    continue+                "prompt_new_filter_slash" -> do+                    (ys,_) <- scrSize+                    v <- commandRead justGetKey stdScr (ys - 1) "Filter: " "/"+                    case v >>= parseFilter >>= \x -> return (modifyFilter (x:)) of+                        Right a -> a+                        Left "" -> return ()+                        Left err -> setMessage $ "Invalid filter:" <+> err+                    continue+                "prompt_new_filter_twiddle" -> do+                    (ys,_) <- scrSize+                    v <- commandRead justGetKey stdScr (ys - 1) "Filter: " "~"+                    case v >>= parseFilter >>= \x -> return (modifyFilter (x:)) of+                        Right a -> a+                        Left "" -> return ()+                        Left err -> setMessage $ "Invalid filter:" <+> err+                    continue+                "toggle_rot13" -> mapVal rot13_r not >> continue+                "show_puff_details" -> do+                    p <- readVal selPuff+                    case p of+                        Nothing -> setMessage "No puff selected" >> continue+                        Just p -> do+                            pdw <- puffDetailsWidget p+                            setRenderWidget rc (keyCatcherWidget (\_ -> setRenderWidget rc fw >> return True) pdw) >> continue+                "new_puff" -> withEditing $ composePuff (setRenderWidget rc fw)[] [] >> continue+                "modify_presence_string" -> do+                    p <- readVal myPresence+                    (ys,_) <- scrSize+                    v <- commandRead justGetKey stdScr (ys - 1) "Presence: " p+                    case v of+                        Just v -> writeVal myPresence v >> setMessage ("Presence updated: " ++ v)+                        Nothing -> setMessage "Presence unchanged"+                    continue+                "reply_to_author" -> withEditing $ do+                    p <- readVal selPuff+                    case p of+                        Nothing -> return ()+                        Just p -> do+                            pkw <- fmap (concat . (map words)) $ configLookupList "PRESERVED_KEYWORDS"+                            let kws = filter (`elem` (map packString pkw)) (getFragmentStrings p f_messageKeyword)+                            composePuff(setRenderWidget rc fw) [catParseNew (getAuthor p)] kws+                    continue+                "goto_match" -> do+                    p <- readVal selPuff+                    case p of+                        Just p | Just b <- getFragmentString p f_messageBody -> let+                            v = if null mw then continue else setRenderWidget rc (stackedWidgets [keyCatcherWidget pk  (dialog tw), fw]) >> return True+                            cs = ['a' .. 'z'] ++ ['A' .. 'Z']+                            mw = zip cs $ matchWords matchTable (unpackPS b)+                            tw = unlines (map (\(a,(_,b)) -> a :' ':b)  mw)+                            --pk x = do+                            --    setRenderWidget rc fw+                            --    return True+                            pk x = case x of+                                        (KeyChar n) | Just (a,_) <- lookup n mw -> do+                                            --rawSystem a []+                                            mySystem a+                                            return ()+                                        key -> keyError "Unknown match" key+                                    >> do+                                    setRenderWidget rc fw+                                    return True+                              in v+                        _ -> continue++                "follow_up" -> withEditing $ do+                    p <- readVal selPuff+                    case p of+                        Nothing -> setMessage "No puff selected"+                        Just p -> do+                            pkw <- fmap (concat . (map words)) $ configLookupList "PRESERVED_KEYWORDS"+                            let kws = filter (`elem` (map packString pkw)) (getFragmentStrings p f_messageKeyword)+                            composePuff (setRenderWidget rc fw) (cats p) kws+                    continue+                "group_reply" -> withEditing $ do+                    p <- readVal selPuff+                    case p of+                        Nothing -> setMessage "No puff selected"+                        Just p -> do+                            pkw <- fmap (concat . (map words)) $ configLookupList "PRESERVED_KEYWORDS"+                            let kws = filter (`elem` (map packString pkw)) (getFragmentStrings p f_messageKeyword)+                            composePuff (setRenderWidget rc fw) (nub $ catParseNew (getAuthor p):cats p) kws+                    continue+                "resend_puff" -> withEditing $ do+                    p <- readVal selPuff+                    case p of+                        Nothing -> setMessage "No puff selected"+                        Just p -> do+                            pcw <- puffConfirm gc (setRenderWidget rc fw) p ic+                            setRenderWidget rc pcw+                    continue+		"redraw_screen" -> attempt (touchWin stdScr)  >> resizeRenderContext rc (return ()) >> continue+		"show_help_screen" -> setRenderWidget rc (keyCatcherWidget (\_ -> setRenderWidget rc fw >> return True) hw) >> continue+		"show_status_screen" -> setRenderWidget rc (keyCatcherWidget (\_ -> setRenderWidget rc fw >> return True) statusWidget) >> continue+		"show_presence_status" -> setRenderWidget rc (keyCatcherWidget (\_ -> setRenderWidget rc fw >> return True) presenceWidget) >> continue+                act -> setMessage ("Unknown action: " ++ act ++ " -- " ++ helpText) >> continue+	puffDetailsWidget p = do+	    (_,xs) <- scrSize+	    let pv = newSVarWidget presence_r (presenceViewUser (getAuthor p))+            wr <- case fmap unpackPS (getFragmentString p (f_messageId)) of+                    Nothing -> return ""+                    Just mid ->  Hash.lookup puffRRHash mid >>= \ml -> case ml of+                        Nothing -> return ""+                        Just ml -> return $ "\nReceieved by:\n" ++ unlines (snub ml)+	    v <- widgetScroll (widgetVerticalBox False [(NoExpand,widgetText $ chunkText (xs - 1) ((showPuff p) ++ wr)), (NoExpand, widgetText "\n\n\n"), (NoExpand, pv)])+	    return v+	justGetKey = readChan ic >>= \v -> case v of+	    (MainEventPuff p) -> addPuff p >> justGetKey+	    (MainEventKey k) -> do+		    getClockTime >>= writeVal userActionTime+		    return $ keyCanon k+	    _ -> writeChan icmain v >> justGetKey+	nextKey = do+	    ce <- isEmptyChan ic+	    when ce $ tryDrawRenderContext rc+	    cemain <- isEmptyChan icmain+	    v <- if cemain then readChan ic else readChan icmain+	    case v of+		(MainEventPuff p) -> do+                    v <- is_at_end+		    addPuff p+                    when v scroll_end+		    s <- configLookupElse "ON_INCOMING_PUFF" ""+		    mapM_ (processKey mwidget) (stringToKeys s)+		    nextKey+		(MainEventKey KeyResize) ->  nextKey+		(MainEventKey k) -> do+		    getClockTime >>= writeVal userActionTime+		    b <- keyRenderContext rc $ keyCanon k+		    if b then nextKey else return ()+		(MainEventComposed ep done) -> do+		    case ep of+			Nothing -> setMessage "Puff cancelled"+			Just p -> do+			    pcw <- puffConfirm gc done p ic+			    setRenderWidget rc pcw+		    writeVal editing_r False+		    nextKey+    np <- configLookupBool "NO_PRESENCE_NOTIFY"++    done <- if np then return (return ()) else do+        gonePresencePuff >>= galeWillPuff gc+        ploopID <- forkIO presenceLoop+        return $ killThread ploopID+    forkIO $ let f n = waitJVar myPresence  n >>= \n' -> sendPresence True >> f n' in f presence+    setRenderWidget rc fw+    nextKey+    done++getMyNotifyCategory = do+    Category (n,d) <- fmap catParseNew getGaleId+    return $ Category (("_gale.notice." ++ n),d)++-- makeURLRegex :: IO Regex+-- makeURLRegex = regcomp "^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\\?([^#]*))?(#(.*))?" regExtended+++-- rendered puffs height+puffHeight :: Puff+    -> Int -- ^ Width of screen in characters+    -> Int -- ^ height of puff when rendered+puffHeight (Puff {fragments = frags}) mw = n + 2 where+    body' = maybe [] (lines . paragraphBreak mw . expandTabs ) $ fmap unpackPS (getFragmentString frags  f_messageBody)+    n = length body'++renderPuff :: Puff+    -> Int  -- ^ width of screen in characters+    -> Window -- ^ where to draw puff+    -> Int+    -> (Int,Int)+    -> Bool+    -> (String -> String)+    -> IO ()++renderPuff p@(Puff {cats =cats, fragments = frags}) mw w y (_,ys) selected textFilter = doit where+    sender = maybe "" unpackPS $ getFragmentString p f_messageSender+    body' = maybe [] (lines . paragraphBreak mw . expandTabs . textFilter) $ fmap unpackPS (getFragmentString frags  f_messageBody)+    Just time = getFragmentTime frags f_idTime `mplus` getFragmentTime frags (fromString "_ginsu.timestamp")+    kwds = getFragmentStrings p f_messageKeyword+    n = length body'+    addCat w (Category (x,y)) = withColorId w c $ Curses.withAttr w attrBold (waddstr w x) >> waddstr w ('@':y)  where+        c = fromIntegral $ hashPS (packString (x ++ "@" ++ y))+    doit = do+        let ac = fromIntegral $ hashPS $ packString (getAuthor p)+	when (y >= 0 && y < ys) $ do+	    wmove w y 0+	    when selected $ standout >> return ()+	    sequence (intersperse (space w) $ map (addCat w) cats)+	    when selected $ standend >> return ()+	    space w >> space w+	    when selected $ standout >> return ()+            waddstr w (unwords (map (('/':) . unpackPS)  kwds))+            Just fmt <- configLookup "PUFF_DATE_FORMAT"+            st <-  fmap (formatCalendarTime defaultTimeLocale fmt) $ toCalendarTime time+            let lst = length st+            wAttrOn w attrBold+            withColorId w ac $ mvwaddstr w y (mw - length sender - lst - 1) sender+            wAttrOff w attrBold+            mvwaddstr w y (mw - lst) st+            when selected $  standend >> return ()+        mapM_ (\(p,s) ->  when (y + p < ys) (mvwaddstr stdScr (y + p) 0 s)) (zip [1..] $ body')+        --let bs = (if selected then "======" ++ [rTee] else replicate 6 hLine ++ [rTee])+        let bs = (if selected then "======" ++ [rTee] else replicate 6 hLine ++ [rTee]) ++ getAuthor p ++ [lTee] ++ cycle (if selected then "=" else [hLine])+        --let es =  [lTee] ++ cycle (if selected then "=" else [hLine])+        --when (y + 1 + n < ys) $ mvwaddstr w (y + 1 + n) 0 (take mw $ cycle $ if selected then "=" else  "-")+        when selected $ wAttrOn w attrBold+        when (y + 1 + n < ys) $ do+            mvwaddstr w (y + 1 + n) 0 (take mw bs)+            --mvwaddstr w (y + 1 + n) 0 (bs)+            --withColorId w ac $ mvwaddstr w (y + 1 + n) (length bs) (getAuthor p)+            --mvwaddstr w (y + 1 + n) (length bs + length (getAuthor p)) (take mw es)+        when selected $ wAttrOff w attrBold+        return ()+++++------------------+-- Curses routines+------------------++waddstr w s = Control.Exception.try (wAddStr w s) >> return ()+mvwaddstr w y x s = Control.Exception.try (mvWAddStr w y x s) >> return ()+wmove w y x = Control.Exception.try (wMove w y x) >> return ()++space w = waddstr w " "++--------------+-- help screen+--------------+++helpWidget = do+    helpTable <- getHelpTable+    let w = widgetText helpTable+        s = "Help Screen"+        v = "* scroll with direction keys - any other key to return to main screen *"+    sw <- widgetScroll w+    return $ widgetVerticalBox False [(NoExpand,widgetAttr [AttrBold] (widgetText s)),(NoExpand,widgetText v),(ExpandFill, widgetSimpleFrame sw)]++statusWidget = do+    let gs = do+            st <- Status.getStatus+            ls <- Status.getLog+            return $  concat ([st, "\n--- Log ---\n"] ++ ls)+    let w = dynamicWidget $  fmap widgetText gs+        s = "Status Screen"+        v = "* scroll with direction keys - any other key to return to main screen *"+    sw <- widgetScroll w+    return $ widgetVerticalBox False [(NoExpand,widgetAttr [AttrBold] (widgetText s)),(NoExpand,widgetText v),(ExpandFill, widgetSimpleFrame sw)]++-------------------+-- Puff composition+-------------------++withPrivateFiles action = do+    om <- Posix.setFileCreationMask (Posix.groupModes `Posix.unionFileModes` Posix.otherModes)+    v <- action+    Posix.setFileCreationMask om+    return v++noBodyWords fl = [x|x@(n,_) <- fl, n /= f_messageBody, n /= f_messageKeyword]++withNBRWorkaround f = do+    System.IO.stdin `seq` return ()+    PosixIO.setFdOption 0 PosixIO.NonBlockingRead False+    f+    PosixIO.setFdOption 0 PosixIO.NonBlockingRead False++mySystem s = do+    putLog LogInfo $ "system " ++ show s+    withNBRWorkaround $ withProgram $ System.Cmd.system s++myRawSystem e s = do+    withNBRWorkaround $ withProgram $ System.Cmd.rawSystem e s++editPuff :: Puff -> Chan MainEvent -> IO () -> IO ()+editPuff puff ic done = do+    e <- getEditor+    fn <- getTmpFile+    eob <- configLookupList "EDITOR_OPTION"+    eonew <- configLookupList "EDITOR_NEWPUFF_OPTION"+    let eo = if null (cats puff) then eonew else eob+    let it = ["To: " ++ simpleQuote (showDestination (cats puff) (map unpackPS $ getFragmentStrings puff f_messageKeyword)) , "--------"]+    let mb = case fmap unpackPS (getFragmentString puff f_messageBody) of+            Just mb -> mb+            Nothing -> "\n"+    withPrivateFiles $ writeRawFile fn (stringToBytes $ unlines it ++ mb)+    putLog LogInfo $ "system: " ++  (e ++ " " ++ unwords eo ++ " " ++ shellQuote [fn])+    bgedit <- configLookupBool "BACKGROUND_EDIT"+    bgcmd <- if bgedit then configLookupList "BACKGROUND_COMMAND" else return []+    let (cmd:args) = (concatMap words bgcmd) ++ [e] ++ (concatMap words eo) ++ [fn]+    let after = editPuffDone fn ic done it puff+    let handle = do st <- try $ Posix.getAnyProcessStatus False False+                    case st of Right (Just _) -> handle+                               _ -> after+    if bgedit then do+            Posix.installHandler Posix.sigCHLD (Posix.CatchOnce handle) Nothing >> return ()+            Posix.forkProcess (Posix.executeFile cmd True args Nothing) >> return ()+        else do+            myRawSystem cmd args+            after++editPuffDone :: String -> Chan MainEvent -> IO () -> [String] -> Puff -> IO ()+editPuffDone fn ic done it puff = do+    pn <- fmap (lines . bytesToString)$ readRawFile fn+    handleMost (\_ -> return ()) (removeFile fn)+    ep <- if not (length pn > 1 && pn /= it) then return Nothing else do+        let (cs',kwds') = readDestination (drop 4 (head pn))+        ncats <- expandAliases (cs')+        tw <- configLookupBool "TRIM_BLANKLINES"+        body <- return $ if not tw then (unlines $ (drop 2 pn)) else+            trimBlankLines (unlines $ (drop 2 pn))+        return $ if body == "" then Nothing else+                Just puff { cats = ncats, fragments = noBodyWords (fragments puff) ++ [(f_messageBody,FragmentText (packString body))] ++ [ (f_messageKeyword,FragmentText (packString k)) | k <- kwds']}+    writeChan ic $ MainEventComposed ep done++showDestination cs kwds = (map catShowNew cs ++ map ('/':) kwds)+readDestination :: String -> ([Category],[String])+readDestination s = splitEither (map pi (simpleUnquote s)) where+    pi ('/':s) = Right s+    pi x = Left (catParseNew x)++--------------------+-- Puff confirmation+--------------------++anonymousFragments = map (liftT2 (fromString,\x -> FragmentText (packString x))) [("id/class", "anonymous"), ("id/instance",  "anonymous"), ("message/sender",  "Anonymous")]++minusFrag fl s = [x |x@(n,_) <- fl, n /= s]++prettyPuff puff = unlines xs ++  body where+    to = ["To: " ++ simpleQuote (showDestination (cats puff) (map unpackPS $ getFragmentStrings puff f_messageKeyword)) ]+    from = ["From: " ++ unpackPS t| (n,FragmentText t) <- fragments puff,  n == f_messageSender]+    body = case [ unpackPS t | (n,FragmentText t) <- fragments puff, n == f_messageBody] of+        (t:_) -> t+        [] -> ""+    rr = if hasFragment puff (f_questionReceipt) then ["Return receipt: Yes"] else []+    xs = to ++ from ++ rr ++ ["-------"]+++puffConfirm ::  GaleContext -> IO () -> Puff -> Chan MainEvent -> IO Widget+puffConfirm gc done puff ic = do+    (_,xs) <- scrSize+    gid <- getGaleId+    ncats <- expandAliases (cats puff)+    puff <- return $ puff {cats = ncats}+    psv <- newMVar puff+    let Category (n,d) = catParseNew gid+    let rr_cat = case getFragmentString puff (f_messageId) of+            Just mid -> "_gale.rr." ++ n ++ "." ++ unpackPS mid ++ "@" ++ d+            Nothing -> gid++    gs <- fmap (concat . map words) $ configLookupList "GALE_SUBSCRIBE"+    when  (not (or [c `subCategory` catParseNew g | c <- cats puff, g <- gs] ) || packString "ping" `elem` getFragmentStrings puff f_messageKeyword) $+            writeVal psv (puff {fragments = (f_questionReceipt, FragmentText (packString rr_cat)) : fragments puff})+    sbsv <- newMVar ""+    psvs <- newMVar (prettyPuff, showPuff)+    csv <- combineVal psv psvs+    let pw = newSVarWidget csv (\(p,(f,_)) -> dynamicWidget (verifyDestinations gc (cats p) >>= \text -> return $ widgetText $ text ++ "--\n" ++ (chunkText (xs - 4) (f p))))+    let w = (widgetCenter $  widgetText "Send puff?")+        h = (widgetCenter $ widgetText (paragraph xs $ "y:send q:cancel e:edit r:returnReceipt h:allHeaders A:anonymize <C-o>:rot13" ))+        pk (KeyChar 'q')  = done >> return True+        pk (KeyChar 'n')  = done >> return True+        pk (KeyChar 'r') = do+            p <- readVal psv+            if hasFragment p (f_questionReceipt) then+                writeVal psv (p {fragments = [x | x@(n,_) <- fragments p , n /= f_questionReceipt]})+                    else writeVal psv (p {fragments = (f_questionReceipt, FragmentText (packString rr_cat)) : fragments p})+            return True+        pk (KeyChar 'h') = do+            mapVal psvs (\(x,y) -> (y,x))+            return True+        pk (KeyChar 'A') = do+            p <- readVal psv+            if hasFragment p (f_messageId) then do+                writeVal psv (p {signature = [], fragments = anonymousFragments `mergeFrags` (fragments p `minusFrag` f_messageId)})+                    else do+                        pt <- puffTemplate+                        writeVal psv (p {signature = signature pt, fragments = (fragments pt `minusFrag` f_idTime) `mergeFrags` fragments p})+            return True+        pk (KeyChar 'y')  = do+            puff <- readVal psv+            galeSendPuff gc puff+            done+            return True+        pk (KeyChar 'e') = do+            puff <- readVal psv+            done+            editPuff puff ic done+            return True+        pk (KeyChar '\x0F') = do+            p <- readVal psv+            case fmap unpackPS (getFragmentString p f_messageBody) of+                Just mb -> writeVal psv (p {fragments = [(f_messageBody, FragmentText(packString $ rot13 mb))] `mergeFrags` (fragments p `minusFrag` f_messageBody)})+                Nothing -> return ()+            return True+        pk key = do+            writeVal sbsv $  "Invalid keystroke: " ++ keysToString [key]+            return True+    pb <- widgetScroll $ pw+    return $ keyCatcherWidget pk $ widgetVerticalBox False [(NoExpand, w), (NoExpand, widgetAttr [AttrBold] h), (ExpandFill, widgetSimpleFrame pb),(NoExpand, simpleStatusBarWidget sbsv)]++simpleStatusBarWidget svm  = widgetAttr [AttrBold] $ newSVarWidget svm widgetText+++++commandRead :: Monad m => IO Curses.Key -> Window -> Int -> String -> String -> IO (m String)+commandRead ic win yloc prompt init = withCursor CursorVisible  $ cr (length init) (reverse init)+    where+    l n v = min (max n 0) (length v)+    cr cloc v = pc cloc v >> ic >>= \x -> case x of+	(KeyChar '\n') -> return $ return (reverse v)+	(KeyChar '\r') -> return $ return (reverse v)+	(KeyEnter) -> return $ return (reverse v)+	(KeyChar '\b') -> let z = (let (a,b) = splitAt (length v - cloc) v in a ++ drop 1 b) in  cr (l (cloc - 1) z) z+	(KeyBackspace) -> let z = (let (a,b) = splitAt (length v - cloc) v in a ++ drop 1 b) in  cr (l (cloc - 1) z) z+        (KeyHome) -> cr 0 v+        (KeyEnd) -> cr (length v) v+        (KeyLeft) -> cr (l (cloc - 1) v) v+        (KeyRight) -> cr (l (cloc + 1) v) v+        (KeyChar '\x0B') -> cr cloc (drop (length v - cloc) v)+        (KeyChar '\BEL') -> return (fail "")+	(KeyChar c) -> cr (cloc + 1) (let (a,b) = splitAt (length v - cloc) v in a ++ [c] ++ b)++	_ -> return (fail "unknown key")+    pc cloc v = do+	wmove win yloc 0+	wClrToEol win+	wAttrOn win attrBold+	waddstr win prompt+	wAttrOff win attrBold+	waddstr win (reverse v)+	wmove win yloc (cloc + length prompt)+	refresh++
+ MyLocale.hsc view
@@ -0,0 +1,115 @@+{-# LANGUAGE ForeignFunctionInterface, MagicHash, UnliftedFFITypes #-}+module MyLocale(+    setupLocale,+    getCharset,+    getDateFmt,+    getDateTimeFmt,+    getTimeFmt,+    getYesRegex,+    getNoRegex+    -- nl_langinfo+    ) where++import Foreign+import Foreign.C+import GHC.Exts+++#include <locale.h>+#include <langinfo.h>++foreign import ccall unsafe "locale.h setlocale" setlocale :: CInt -> Addr## -> IO (Ptr CChar)+foreign import ccall unsafe "langinfo.h nl_langinfo" nl_langinfo :: (#type nl_item) -> IO (Ptr CChar)++setupLocale :: IO ()+setupLocale = setlocale (#const LC_ALL) ""## >> return ()++getCharset :: IO String+getCharset =  nl_langinfo (#const CODESET) >>= peekCString++getDateFmt :: IO String+getDateFmt = nl_langinfo (#const D_FMT) >>= peekCString++getDateTimeFmt :: IO String+getDateTimeFmt = nl_langinfo (#const D_T_FMT) >>= peekCString++getTimeFmt :: IO String+getTimeFmt = nl_langinfo (#const T_FMT) >>= peekCString++getYesRegex :: IO String+getYesRegex = nl_langinfo (#const YESEXPR) >>= peekCString++getNoRegex :: IO String+getNoRegex = nl_langinfo (#const NOEXPR) >>= peekCString++{-+LC_COLLATE+    Affects the behavior of regular expressions and the collation functions.+LC_CTYPE+    Affects the behavior of regular expressions, character classification,+    character conversion functions, and wide-character functions.+LC_MESSAGES+     Affects what strings are expected by commands and utilities as affirmative+     or negative responses.  It also affects what strings are given by commands+     and utilities as affirmative or negative responses, and the content of+     messages.+LC_MONETARY+    Affects the behavior of functions that handle monetary values.+LC_NUMERIC+    Affects the behavior of functions that handle numeric values.+LC_TIME+    Affects the behavior of the time conversion functi++data Locale = LC_CTYPE | LC_NUMERIC | LC_TIME | LC_COLLATE | LC_MONETARY | LC_MESSAGES | LC_ALL | LC_PAPER | LC_NAME | LC_ADDRESS | LC_TELEPHONE | LC_MEASUREMENT | LC_IDENTIFICATION+    deriving(Show, Enum, Read, Ord, Eq)++decodeLocale :: Locale -> CInt+decodeLocale LC_CTYPE = (#const LC_CTYPE)+decodeLocale LC_NUMERIC = (#const LC_NUMERIC)+decodeLocale LC_COLLATE = (#const LC_COLLATE)+decodeLocale LC_MONETARY = (#const LC_MONETARY)+decodeLocale LC_TIME = (#const LC_TIME)+#ifdef LC_MESSAGES+decodeLocale LC_MESSAGES = (#const LC_MESSAGES)+#endif+#ifdef LC_PAPER+decodeLocale LC_PAPER = (#const LC_PAPER)+#endif+#ifdef LC_NAME+decodeLocale LC_NAME = (#const LC_NAME)+#endif+#ifdef LC_ADDRESS+decodeLocale LC_ADDRESS = (#const LC_ADDRESS)+#endif+#ifdef LC_TELEPHONE+decodeLocale LC_TELEPHONE = (#const LC_TELEPHONE)+#endif+#ifdef LC_MEASUREMENT+decodeLocale LC_MEASUREMENT = (#const LC_MEASUREMENT)+#endif+#ifdef LC_IDENTIFICATION+decodeLocale LC_IDENTIFICATION = (#const LC_IDENTIFICATION)+#endif+decodeLocale _ = -1++dString :: IO (Ptr CChar) -> IO (Maybe String)+dString action = do+    v <- action+    if v == nullPtr then return Nothing else fmap Just (peekCString v)++setLocaleAll :: String -> IO (Maybe String)+setLocaleAll s =  dString $ withCString s (setlocale (#const LC_ALL))++getLocaleAll :: IO (Maybe String)+getLocaleAll = getLocale LC_ALL++setLocale :: Locale -> String -> IO (Maybe String)+setLocale l s = case decodeLocale l of+    -1 -> return Nothing+    nl -> dString $ withCString s (setlocale nl)++getLocale :: Locale -> IO (Maybe String)+getLocale l = case decodeLocale l of+    -1 -> return Nothing+    nl -> dString $ setlocale nl nullPtr+-}
+ Options.hs view
@@ -0,0 +1,101 @@+module Options(+    Env(..),+    ginsuOpts+    ) where++import Curses+import ErrorLog+import ExampleConf+import GenUtil+import GinsuConfig+import Help+import Gale.KeyCache+import KeyName+import System+import System.Console.GetOpt+import Version++-------------------------+-- options/initialization+-------------------------+data Env = Env {+    envAction :: IO (),+    envVerbose :: Int,+    envConfig :: (Maybe String),+    envJustArgs :: Bool,+    envErrorLog :: Maybe String,+    envNoPufflog :: Bool,+    envNoWritePufflog :: Bool+    }+++env = Env {+    envAction = return (),+    envVerbose = 0,+    envConfig = Nothing,+    envJustArgs = False,+    envNoPufflog = False,+    envNoWritePufflog = False,+    envErrorLog = Nothing+}+++options :: [OptDescr (Env -> Env)]+options = [+    Option ['v']  ["verbose"] (NoArg (\e->e{envVerbose = envVerbose e + 1})) "increase verbosity output to errorlog.",+    Option ['V']  ["version"] (NoArg (doJust (putStrLn fullName))) "print version information",+    --	Option ['c']  ["config"] (ReqArg (\x e->e{envConfig = (Just x)}) "FILE") "use this configuration file",+    Option ['s']  ["sample-config"] (NoArg (doJust (putStr exampleConf))) "print sample configuration file to stdout",+    Option ['m']  ["man"] (NoArg (doJust doMan)) "print all internal help screens to stdout",+    Option ['e']  ["justargs"] (NoArg (\e->e{envJustArgs = True})) "only subscribe to command line arguments",+    Option ['P']  [] (NoArg (\e->e{envNoWritePufflog = True})) "do not write to pufflog",+    Option []  ["help"] (NoArg $ doJust (putStrLn usage)) "show this help screen",+    Option []  ["nopufflog"] (NoArg (\e->e{envNoPufflog = True})) "do not read or write pufflog",+    Option []  ["errorlog"] (ReqArg (\x e->e{envErrorLog = Just x}) "FILE") "log errors to file",+    Option []  ["dumpkey"] (ReqArg (\x -> doJust (dumpKey x)) "KEYFILE") "print info for keyfile",+    Option []  ["checkconfig"] (NoArg (doAction doCheckConfig)) "check and print out configuration"+    ]++privateOptions = [+    Option []  ["testcurses"] (NoArg (doJust cursesTest)) "print curses diagnostics",+    Option []  ["showOptions"] (NoArg (doJust showOptions)) "show options",+    Option []  ["showKeys"] (NoArg (doJust (getKeyHelpTable (0,0) >>= putStr))) ""+    ]+++{-# NOINLINE ginsuOpts #-}+ginsuOpts :: IO (Env,[String])+ginsuOpts = do+    args <- getArgs+    r@(env,_) <- case (getOpt Permute (options ++ privateOptions) args) of+	   (as,n,[]) -> return (foldr ($) env as ,n)+    	   (_,_,errs) -> putErrDie (concat errs ++ usage)+    case (envVerbose env) of+	1 -> do+	    setLogLevel LogInfo+	    putLog LogNotice $ "Verbosity Level: Info"+	n | n > 1 -> do+	    setLogLevel LogDebug+	    putLog LogNotice $ "Verbosity Level: Debug"+	_ -> return ()+    envAction env+    return r++doMan = getHelpTable >>= putStrLn++usage = usageInfo usageHeader options ++ usageTrailer++doAction :: IO a -> (Env -> Env)+doAction a = \e -> e {envAction = a >> envAction e}++doJust action = doAction (action >> exitSuccess)++showOptions = putStr $ "|||| Available Options ||\n" ++ concatMap f options where+    f (Option so los as hm) = "|| " ++ concatInter ", " (map ga (so' ++ los')) ++ " || "  ++ hm ++ "||\n" where+        so' = map (\c -> '-':[c]) so+        los' = map (\cs -> '-':'-':cs) los+        ga = case as of+            ReqArg _ a  -> (++ (" <i>&lt;" ++ a ++ "&gt;</i>"))+            _ -> id++
+ PackedString.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.PackedString+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- An efficient implementation of strings.+--+-----------------------------------------------------------------------------+++-- Original GHC implementation by Bryan O\'Sullivan,+-- rewritten to use UArray by Simon Marlow.+-- modified by John Meacham for use in ginsu+-- changed to a trivial wrapper for Data.ByteString.UTF8 by Dylan Simon++module PackedString (+	-- * The @PackedString@ type+        PackedString,      -- abstract, instances: Eq, Ord, Show, Typeable++         -- * Converting to and from @PackedString@s+	packString,  -- :: String -> PackedString+	unpackPS,    -- :: PackedString -> String+        showsPS,+        -- toString,+--        lengthPS,+--        utfLengthPS,++	joinPS,      -- :: PackedString -> [PackedString] -> PackedString+	-- * List-like manipulation functions+	nilPS,       -- :: PackedString+	consPS,      -- :: Char -> PackedString -> PackedString+	nullPS,      -- :: PackedString -> Bool+	appendPS,    -- :: PackedString -> PackedString -> PackedString+--        foldrPS,+        hashPS,+--        filterPS,+--        foldlPS,+--        headPS,+	concatPS    -- :: [PackedString] -> PackedString++++    ) where++import Data.Typeable+import Data.Int+import Data.Binary+import qualified Data.ByteString as BS+import qualified Data.ByteString.UTF8 as U+import qualified Data.String.UTF8 as US+import Data.Bits+import Data.Monoid++instance Monoid PackedString where+    mempty = nilPS+    mappend x y = appendPS x y+    mconcat xs = concatPS xs++-- -----------------------------------------------------------------------------+-- PackedString type declaration++-- | A space-efficient representation of a 'String', which supports various+-- efficient operations.  A 'PackedString' contains full Unicode 'Char's.+-- much like UTF8 ByteString+newtype PackedString = PS { unPS :: U.ByteString }+    deriving(Typeable,Binary,Eq,Ord)+++instance Show PackedString where+    showsPrec p (PS ps) = showsPrec p (US.fromRep ps)+++-- -----------------------------------------------------------------------------+-- Constructor functions++-- | The 'nilPS' value is the empty string.+nilPS :: PackedString+nilPS = PS BS.empty++-- | The 'consPS' function prepends the given character to the+-- given string.+consPS :: Char -> PackedString -> PackedString+consPS c (PS cs) = PS $ BS.append (U.fromString [c]) cs++-- | Convert a 'String' into a 'PackedString'+packString :: String -> PackedString+packString = PS . U.fromString+++-- -----------------------------------------------------------------------------+-- Destructor functions (taking PackedStrings apart)+++unpackPS :: PackedString -> String+unpackPS = U.toString . unPS++showsPS :: PackedString -> String -> String+showsPS ps = (unpackPS ps ++)+++-- | The 'nullPS' function returns True iff the argument is null.+nullPS :: PackedString -> Bool+nullPS = BS.null . unPS++-- | The 'appendPS' function appends the second string onto the first.+appendPS :: PackedString -> PackedString -> PackedString+appendPS (PS xs) (PS ys) = PS $ BS.append xs ys+++hashPS :: PackedString -> Int32+hashPS (PS arr) = f 5381 (BS.unpack arr) where+    f x [] = x+    f m (c:cs) = n `seq` f n cs where+        n = ((m `shiftL` 5) + m ) `xor` fromIntegral c++-- | The 'concatPS' function concatenates a list of 'PackedString's.+concatPS :: [PackedString] -> PackedString+concatPS = PS . BS.concat . map unPS++------------------------------------------------------------++-- | The 'joinPS' function takes a 'PackedString' and a list of 'PackedString's+-- and concatenates the list after interspersing the first argument between+-- each element of the list.+joinPS :: PackedString -> [PackedString] -> PackedString+joinPS filler pss = concatPS (splice pss)+ where+  splice []  = []+  splice [x] = [x]+  splice (x:y:xs) = x:filler:splice (y:xs)++-- ToDo: the obvious generalisation+{-+  Some properties that hold:++  * splitPS x ls = ls'+      where False = any (map (x `elemPS`) ls')++  * joinPS (packString [x]) (splitPS x ls) = ls+-}+
+ RSA.hsc view
@@ -0,0 +1,278 @@+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}+module RSA(+    EvpPkey,+    decryptAll,+    encryptAll,+    signAll,+    createPkey,+    sha1,+    bsToHex,+    RSAElems(..)+    ) where++#include "my_rsa.h"++import CForeign+import Control.Exception as E+import ErrorLog+import Foreign+import Numeric(showHex)++import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS++data RSAStruct+data EVP_PKEY+data EVP_CIPHER+data EVP_CIPHER_CTX+data EVP_MD_CTX+data EVP_MD+data BIGNUM++type RSA = Ptr RSAStruct++type EvpPkey = ForeignPtr EVP_PKEY++fi x = fromIntegral x++------------------------+-- marshalling utilities+------------------------++throwZero_ s = throwIf_ (== 0) (const s)+++withData :: BS.ByteString -> (Ptr CUChar -> CInt -> IO a) -> IO a+withData xs f = BS.unsafeUseAsCStringLen xs (\ (cp,cl) -> f (castPtr cp) (fromIntegral cl))++returnData :: Int -> (Ptr CUChar -> Ptr CInt -> IO z) -> IO BS.ByteString+returnData sz f = do+	alloca $ \bp ->+            allocaArray sz $ \m -> do+                f m bp+                s <- peek bp+                BS.packCStringLen (castPtr m, fromIntegral s)++---------------+-- RSA routines+---------------+++foreign import ccall unsafe "my_rsa.h RSA_new" rsaNew :: IO RSA+-- foreign import ccall unsafe "my_rsa.h RSA_free" rsaFree :: RSA -> IO ()++foreign import ccall unsafe "my_rsa.h RSA_check_key" rsa_check_key :: RSA -> IO CInt++rsaCheckKey :: RSA -> IO ()+rsaCheckKey rsa = throwZero_ "RSA_check_key" $ rsa_check_key rsa++data RSAElems a = RSAElemsPrivate {+    rsaN :: a,+    rsaE :: a,+    rsaD :: a,+    rsaIQMP :: a,+    rsaP :: a,+    rsaQ :: a,+    rsaDMP1 :: a,+    rsaDMQ1 :: a+    } |  RSAElemsPublic { rsaN :: a, rsaE :: a }+    deriving(Show)++++----------------------+-- Envelope Encryption+----------------------++foreign import ccall unsafe "openssl/evp.h EVP_DigestInit" evpSignInit :: Ptr EVP_MD_CTX -> Ptr EVP_MD -> IO ()+foreign import ccall unsafe "openssl/evp.h EVP_DigestUpdate" evpSignUpdate :: Ptr EVP_MD_CTX -> Ptr CUChar -> CInt -> IO ()+foreign import ccall unsafe "openssl/evp.h EVP_SignFinal" evpSignFinal :: Ptr EVP_MD_CTX -> Ptr CUChar -> Ptr CInt -> Ptr EVP_PKEY -> IO CInt++foreign import ccall unsafe "openssl/evp.h EVP_OpenInit" evpOpenInit :: Ptr EVP_CIPHER_CTX -> Ptr EVP_CIPHER -> Ptr CUChar -> CInt -> Ptr CUChar -> Ptr EVP_PKEY -> IO CInt+foreign import ccall unsafe "openssl/evp.h EVP_DecryptUpdate" evpOpenUpdate :: Ptr EVP_CIPHER_CTX -> Ptr CUChar -> Ptr CInt -> Ptr CUChar -> CInt -> IO CInt+foreign import ccall unsafe "openssl/evp.h EVP_OpenFinal" evpOpenFinal :: Ptr EVP_CIPHER_CTX -> Ptr CUChar -> Ptr CInt -> IO CInt+++foreign import ccall unsafe "openssl/evp.h EVP_SealInit" evpSealInit :: Ptr EVP_CIPHER_CTX -> Ptr EVP_CIPHER -> Ptr (Ptr CUChar) -> Ptr CInt -> Ptr CUChar -> Ptr (Ptr EVP_PKEY) -> CInt -> IO CInt+foreign import ccall unsafe "openssl/evp.h EVP_EncryptUpdate" evpSealUpdate :: Ptr EVP_CIPHER_CTX -> Ptr CUChar -> Ptr CInt -> Ptr CUChar -> CInt -> IO CInt+foreign import ccall unsafe "openssl/evp.h EVP_SealFinal" evpSealFinal :: Ptr EVP_CIPHER_CTX -> Ptr CUChar -> Ptr CInt -> IO CInt++foreign import ccall unsafe "openssl/evp.h EVP_des_ede3_cbc" evpDesEde3Cbc :: IO (Ptr EVP_CIPHER)+foreign import ccall unsafe "openssl/evp.h EVP_md5" evpMD5 :: IO (Ptr EVP_MD)+++foreign import ccall unsafe evpCipherContextBlockSize :: Ptr EVP_CIPHER_CTX -> IO Int+++evp_OpenUpdate :: Ptr EVP_CIPHER_CTX -> BS.ByteString -> IO BS.ByteString+evp_OpenUpdate cctx ind = do+    bsz <- evpCipherContextBlockSize cctx+    let sz = BS.length ind + bsz+    withData ind (\ina inl -> returnData sz (\outa outl -> throwZero_ "EVP_OpenUpdate" (evpOpenUpdate cctx outa outl ina inl)))++evp_OpenFinal ::  Ptr EVP_CIPHER_CTX -> IO BS.ByteString+evp_OpenFinal cctx = do+    bsz <- evpCipherContextBlockSize cctx+    d <- returnData bsz (\outa outl -> throwZero_ "EVP_OpenFinal" (evpOpenFinal cctx outa outl))+    return d++++foreign import ccall unsafe "EVP_PKEY_size" evpPKEYSize :: Ptr EVP_PKEY -> IO CInt++foreign import ccall unsafe "EVP_CIPHER_CTX_init" evpCipherCtxInit :: Ptr EVP_CIPHER_CTX -> IO ()+-- some implementations have this return int, but not all so we must ignore the return value.+foreign import ccall unsafe "EVP_CIPHER_CTX_cleanup" evpCipherCtxCleanup :: Ptr EVP_CIPHER_CTX -> IO ()++withCipherCtx :: (Ptr EVP_CIPHER_CTX -> IO a) -> IO a+withCipherCtx action = allocaBytes (#const sizeof(EVP_CIPHER_CTX)) $ \cctx ->+	    E.bracket_ (evpCipherCtxInit cctx)+		(evpCipherCtxCleanup cctx)+		    (action cctx)++withMdCtx :: (Ptr EVP_MD_CTX -> IO a) -> IO a+withMdCtx = allocaBytes (#const sizeof(EVP_MD_CTX))+++decryptAll :: BS.ByteString -> BS.ByteString -> EvpPkey -> BS.ByteString -> IO BS.ByteString+decryptAll keydata iv pkey xs = withCipherCtx $ \cctx -> do+    withData keydata $ \a b -> BS.useAsCStringLen iv $ \ (iv,_) -> do+    withForeignPtr pkey $ \pkey -> do+    throwZero_ "EVP_OpenInit" $ evpOpenInit cctx cipher a b (castPtr iv) pkey+    d <- evp_OpenUpdate cctx xs+    dr <- evp_OpenFinal cctx+    return $ d `BS.append` dr++cipher = unsafePerformIO evpDesEde3Cbc+md5 = unsafePerformIO evpMD5+++signAll :: EvpPkey -> BS.ByteString -> IO BS.ByteString+signAll  pkey xs = withMdCtx $ \cctx -> do+    evpSignInit cctx md5+    withData xs $ \a b -> (evpSignUpdate cctx a b)+    withForeignPtr pkey $ \pkey -> do+    bsz <- fmap fromIntegral $ evpPKEYSize pkey+    d <- returnData bsz (\outa outl -> throwZero_ "EVP_SignFinal" (evpSignFinal cctx outa outl pkey))+    return d+++withForeignPtrs :: [ForeignPtr a] -> ([Ptr a] -> IO b) -> IO b+withForeignPtrs ps action = fp' ps []   where+    fp' [] xs = action (reverse xs)+    fp' (p:ps) xs = withForeignPtr p (\x -> fp' ps (x:xs))++encryptAll :: [EvpPkey] -> BS.ByteString -> IO (BS.ByteString, [BS.ByteString], BS.ByteString)+encryptAll [] _ = error "encryptAll: no keys"+encryptAll  keys xs = doit' where+    doit' = do+            putLog LogDebug $ "encryptAll: " ++ show keys+            doit+    doit = do+        withCipherCtx $ \cctx -> do+        allocaArray n $ \ek -> do+        allocaArray n $ \ekl -> do+        allocaBytes ivs $ \iv -> do+        withForeignPtrs keys $ \keys -> do+        withArray keys $ \pubk -> do+            putLog LogDebug $ "encryptAll: " ++ show keys+            mapM_ (\n -> peekElemOff ek n >>= \v -> putLog LogDebug $ "ea: " ++ show (n,v)) [0 .. n - 1]+            bsz <- fmap (fi . maximum) $ mapM  ( evpPKEYSize) (keys)+            putLog LogDebug $ "encryptAll: bsz " ++ show bsz+            foldr (\n r -> allocaBytes bsz (\x -> pokeElemOff ek n x >> r)) (rest cctx ek ekl iv pubk) [0 .. n - 1]+    rest cctx ek ekl iv pubk = do+        mapM_ (\n -> peekElemOff ek n >>= \v -> putLog LogDebug $ "ea: " ++ show (n,v)) [0 .. n - 1]+        ---withForeignPtr pubk $ \pubk -> do+        throwZero_ "EVPSealInit" $ evpSealInit cctx cipher ek ekl iv pubk (fi n)+        bsize <- evpCipherContextBlockSize cctx+        putLog LogDebug $ "encryptAll: bsize " ++ show bsize+        rd <- returnData (dsize + bsize) $ \ra rb ->  withData xs $ \a b -> (throwZero_ "EVP_SealUpdate" $ evpSealUpdate cctx ra rb a b)+        d <- returnData bsize (\outa outl -> throwZero_ "EVP_SealFinal" (evpSealFinal cctx outa outl))+        iva <- BS.packCStringLen (castPtr iv, fi ivs) -- peekArray ivs (castPtr iv)+        ks <- mapM (pa ek ekl) [0 .. n - 1]+        return (rd `BS.append` d,ks,iva)+    pa ek ekl n = do+        l <- peekElemOff ekl n+        p <- peekElemOff ek n+        BS.packCStringLen (castPtr p,fi l) -- (fi l) (castPtr p)+    n = length keys+    ivs = 8+    dsize = BS.length xs+--    bsize = 64++++--------------------+-- BigNum routines+--------------------++--bn_bin2bn :: [Word8] -> IO (Ptr BIGNUM)+--bn_bin2bn xs = throwIfNull "BN_bin2bn" $ withData xs (\a b -> bnBin2Bn a b nullPtr)++foreign import ccall unsafe "BN_bin2bn" bnBin2Bn :: Ptr CUChar -> CInt -> Ptr BIGNUM -> IO (Ptr BIGNUM)++newtype SHA_CTX = SHA_CTX (Ptr SHA_CTX)   ++foreign import ccall unsafe "SHA1_Init" sha1Init :: SHA_CTX -> IO () +foreign import ccall unsafe "SHA1_Update" sha1Update :: SHA_CTX -> Ptr a -> CULong -> IO () +foreign import ccall unsafe "SHA1_Final" sha1Final :: Ptr CChar -> SHA_CTX -> IO ()+++sha1 :: LBS.ByteString -> BS.ByteString+sha1 lbs = unsafePerformIO $ withSHA_CTX $ \sctx -> do+    let supdate bs = BS.unsafeUseAsCStringLen bs $ \ (p,l) -> sha1Update sctx p (fromIntegral l)+    mapM_ supdate (LBS.toChunks lbs)+    allocaBytes (#const SHA_DIGEST_LENGTH) $ \pp -> do+        sha1Final pp sctx+        BS.packCStringLen (pp,(#const SHA_DIGEST_LENGTH))++bsToHex :: BS.ByteString -> String+bsToHex bs = BS.foldr f [] bs where+    f w = showHex x . showHex y where+        (x,y) = divMod w 16+        ++withSHA_CTX :: (SHA_CTX -> IO a) -> IO a+withSHA_CTX action = allocaBytes (#const sizeof(SHA_CTX)) $ \cctx ->+    sha1Init (SHA_CTX cctx) >> action (SHA_CTX cctx)++type NEvpPkey = ForeignPtr EVP_PKEY++foreign import ccall unsafe pkeyNewRSA :: RSA -> IO (Ptr EVP_PKEY)++-- foreign import ccall "&EVP_PKEY_free" evpPkeyFreePtr :: FunPtr (Ptr EVP_PKEY -> IO ())+foreign import ccall "get_KEY" evpPkeyFreePtr :: FunPtr (Ptr EVP_PKEY -> IO ())++createPkey :: RSAElems BS.ByteString -> IO NEvpPkey+createPkey re =  create_rsa re >>= create_pkey where+    setBn pb d = do+        np <- peek pb+        n <- withData d (\a b -> bnBin2Bn a b np)+        poke pb n+    create_private _ RSAElemsPublic {} = return ()+    create_private rsa re = do+        setBn ((#ptr RSA, d) rsa) (rsaD re)+        setBn ((#ptr RSA, iqmp) rsa) (rsaIQMP re)+        setBn ((#ptr RSA, p) rsa) (rsaP re)+        setBn ((#ptr RSA, q) rsa) (rsaQ re)+        setBn ((#ptr RSA, dmp1) rsa) (rsaDMP1 re)+        setBn ((#ptr RSA, dmq1) rsa) (rsaDMQ1 re)+        rsaCheckKey rsa+    create_rsa re = do+        let n = rsaN re+            e = rsaE re+        rsa <- rsaNew+        np <- (#peek RSA, n) rsa+        n <- withData n (\a b -> bnBin2Bn a b np)+        (#poke RSA, n) rsa n+        ep <- (#peek RSA, e) rsa+        e <- withData e (\a b -> bnBin2Bn a b ep)+        (#poke RSA, e) rsa e+        create_private rsa re+        return rsa+    create_pkey rsa = do+        pkey <- pkeyNewRSA rsa+        newForeignPtr evpPkeyFreePtr pkey++
+ Regex.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE PatternGuards #-}+module Regex where++import Char+import ConfigFile+import Exception+import GenUtil+import Maybe+import Monad+import PackedString+import System.IO.Unsafe+import Text.Regex.Posix+import Text.Regex.Posix.String++subst :: String -> [String] -> String+subst "" _ = ""+subst ('$':'$':cs) xs  = '$':subst cs xs+subst ('$':c:cs) xs | isDigit c = f xs (ord c - ord '0') ++ subst cs xs where+    f (x:_) 0 = x+    f (_:xs) n = f xs (n - 1)+    f _ _ = ""+subst (c:cs) xs = c:subst cs xs+++matches :: Regex -> String -> [[String]]+matches rx s = case unsafePerformIO (regexec rx s >>= fromWrapError) of+    Nothing -> []+    Just (_,v,r,xs) -> (v:xs):matches rx r+++matchWords :: [(Regex,String,String)] -> String -> [(String,String)]+matchWords ((rx,a,b):rs) s = (map f $ matches rx s) ++ matchWords rs s where+    f xs = (subst a xs, subst b xs)+matchWords [] _ = []+++buildMatchTable :: IO [(Regex,String,String)]+buildMatchTable = do+    hs <- configLookupList "apphook"+    let zs = catMaybes $ snds $ snubFst $ concatMap (f . simpleUnquote) (hs)+        f [n] = [(n,Nothing)]+        f [n,re,e] | Just rx <- compileRx re = [(n,Just (rxRegex rx, e, "$0"))]+        f [n,re,e,p] | Just rx <- compileRx re = [(n,Just (rxRegex rx, e, p))]+        f _ = []+    return zs+++fromWrapError (Left r) = fail (show r)+fromWrapError (Right x) = return x++data Rx = Rx { rxString :: String, rxRegex :: Regex }++compileRx :: Monad m => String -> m Rx+compileRx re = liftM (Rx re) $ unsafePerformIO ( handle (\e -> return (fail $ show e)) (compile flags execBlank re' >>= fromWrapError >>= (return . return))) where+    flags = compExtended + ci + ml+    ci = if 'i' `elem` fl then compIgnoreCase else 0+    ml = if 'm' `elem` fl then compNewline else 0+    (fl,re') = ef re+    ef ('(':'?':cs) = let (a,b) = span (/= ')') cs in (a,drop 1 b)+    ef xs = ("",xs)+++instance Show Rx where+    show (Rx s _) = s++matchRx re body = isJust (unsafePerformIO (regexec (rxRegex re) (unpackPS body) >>= fromWrapError))+
+ Screen.hs view
@@ -0,0 +1,473 @@+{-# LANGUAGE OverlappingInstances #-}+module Screen(+    Packing(..),+    Attribute(..),+    Widget(..),+    Canvas(..),+    doRender,+    Key(..),+    RenderContext,+    newRenderContext,+    setRenderContext,+    tryDrawRenderContext,+    resizeRenderContext,+    setRenderWidget,+    keyRenderContext,+    keyCatcherWidget,+    newSVarWidget,+    dynamicWidget,+    widgetAttr,+    widgetCenter,+    widgetEmpty,+    widgetHorizontalBox,+    widgetScroll,+    widgetSimpleFrame,+    widgetText,+    widgetVerticalBox,+    stackedWidgets++    ) where++import Control.Concurrent+import Exception as E+import Data.Bits+import Monad++import CacheIO+import Curses+import ErrorLog+import Format+import GenUtil+import Doc.Chars+import Doc.DocLike()+++data Canvas = Canvas {window :: !Window, origin :: !(Int,Int), widgetOrigin :: !(Int,Int), bounds :: !(Int,Int)  }++data Widget = Widget {+    render :: Canvas -> IO (),+    getBounds :: IO (Int,Int),+    processKey :: Key -> IO Bool+    }+++data Packing = NoExpand | Expand | ExpandFill+    deriving(Show,Eq,Enum)+data Attribute = AttrBold | AttrBlink | AttrDim | AttrReverse | AttrUnderline | AttrColor String String+    deriving(Show,Eq)++instance Show Canvas where+    show c = fmtSs "<canvas:origin=%s,bounds=%s>" [show (origin c), show (bounds c)]++widgetEmpty = emptyWidget+--widgetEmptySized x y = emptySizedWidget (floor (x + 0.5)) (floor (y + 0.5))+widgetCenter w = centerWidget w+widgetSimpleFrame w = boxWidget w+widgetVerticalBox True ws = homVerticalBox ws+widgetVerticalBox False ws = verticalBox ws []+widgetHorizontalBox True ws = homHorizontalBox ws+widgetHorizontalBox False ws = horizontalBox ws []+widgetText s = staticText s+widgetAttr al w = attrWidget (foldl (flip ($)) attr0 (map ma al)) w where+    ma AttrBlink a = a `setBlink` True+    ma AttrBold a = a  `setBold` True+    ma AttrDim a = a  `setDim` True+    ma AttrReverse a = a  `setReverse` True+    ma AttrUnderline a = a `setUnderline` True+    ma _ a = a+widgetScroll = newScrollWidget+++isExpand NoExpand = False+isExpand _ = True++isFill ExpandFill = True+isFill _ = False++{-+data Attribute = Attribute [String] String String+parseAttr :: String -> Attribute+parseAttr s = Attribute as fg bg where+    rs = filter (not . f . head) $ groupBy (\x y -> f x && f y) (map toLower s)+    as = filter (`elem` attributes) rs+    col x = if isJust (color x) then return x else Nothing+    fg = fromJust $ msum (map (cGet "fg") rs)  `mplus` msum (map col rs) `mplus` return "default"+    bg = fromJust $ msum (map (cGet "bg") rs) `mplus` return "default"+    f ',' = True+    f c | isSpace c = True+    f _ = False+    cGet p r | (p ++ ":") `isPrefixOf` r = col (drop (length p + 1) r)+    cGet _ _ = Nothing+    attributes = ["normal", "bold", "blink", "dim", "reverse", "underline" ]+-}++data RenderContext = RenderContext {+    needsResize :: MVar Bool,+    drawingStuff :: MVar (IO (), Key -> IO Bool, IO ())+    }++newRenderContext = do+    y <- newMVar False+    z <- newMVar (return (), \_ -> return False, return ())+    return RenderContext {needsResize = y, drawingStuff = z }+++resizeRenderContext rc action = swapMVar (needsResize rc) True >>= \x -> unless x action >> return ()++tryDrawRenderContext rc = do+    y <- swapMVar (needsResize rc) False+    withMVar (drawingStuff rc) $ \(z,_,_) -> when (True) $ do+	erase+	when y (attempt endWin >> refresh)+	z+	refresh++setRenderContext rc dr = do+    modifyMVar_ (drawingStuff rc)  $ \(_,_,final) -> do+    final+    --touchRenderContext rc+    return (dr,\_ -> return False, return ())++setRenderWidget rc w = do+    modifyMVar_ (drawingStuff rc)  $ \(_,_,final) -> do+    final+    --touchRenderContext rc+    return (wdr, processKey w, return (){-, nf-}) where+	wdr = do+	    c <- newCanvas+	    eannM ("doRender " ++ show c) $ render w c++keyRenderContext :: RenderContext -> Key -> IO Bool+keyRenderContext _ KeyResize = return True+keyRenderContext rc k = do+    (_,pks,_) <- readMVar (drawingStuff rc)+    pks k++doRender w = do+    erase+    c <- newCanvas+    eannM ("doRender " ++ show c) $ render w c+    refresh++newCanvas = do+    (ys,xs) <- scrSize+    return $  (Canvas {window = stdScr, origin = (0,0), widgetOrigin = (0,0), bounds = (xs,ys)})+++++-------------------+-- Drawing Routines+-------------------++canvasTranslate :: Canvas -> (Int,Int) -> Canvas+-- canvasTranslate canvas@(Canvas {origin = (x,y), bounds = (xb,yb)}) (xt,yt) = assert (xt > 0 && yt > 0) $ canvas {origin = (x + xt, y + yt), bounds = (max (xb - xt) 0, max (yb - yt) 0)}+canvasTranslate canvas@(Canvas {origin = (x,y), bounds = (xb,yb), widgetOrigin = (wx,wy)}) (xt,yt) = canvas {origin = (x + xt, y + yt), widgetOrigin = (wx, wy), bounds = (max (xb - xt) 0, max (yb - yt) 0)}+++canvasWTranslate :: Canvas -> (Int,Int) -> Canvas+canvasWTranslate canvas@(Canvas {widgetOrigin = (x,y)}) (xt,yt) = canvas {widgetOrigin = (x + xt, y + yt)}++withAttr :: Canvas -> Attr -> IO a -> IO a+withAttr canvas attr action = E.bracket (wAttrGet w) (wAttrSet w) f where+    f (a,p) = wAttrSet w (a .|. attr,p) >> action+    w = window canvas+++drawString :: Canvas -> String -> IO ()+drawString canvas s = eannM (fmtSs "drawString %s %s" [(show canvas), s]) $ ds ml yb (origin canvas) where+	ds (s:ls) yb (x,y) | yb > 0 = E.try (mvWAddStr (window canvas) y x (take xb s)) >> ds ls (yb - 1) (x,y + 1)+	ds _ _ _ = return ()+	(xb,yb) = bounds canvas+	ls = lines s+	(wx,wy) = widgetOrigin canvas+	ml = map (mv ' ' wx) (mv "" wy ls)+	mv _ 0 ss = ss+	mv _ n ss | n > 0 = drop n ss+	mv ec n ss = replicate (0 - n) ec ++ ss+++boundCanvas :: Maybe Int -> Maybe Int -> Canvas -> Canvas+boundCanvas mx my canvas = (canvas {bounds = (nx,ny)}) where+    (cx,cy) = bounds canvas+    nx = maybe cx (min cx) mx+    ny = maybe cy (min cy) my+++-- rendering routines++renderCentered :: Widget -> Canvas -> IO ()+renderCentered w canvas = do+	(xs,ys) <- getBounds w+	let (xs',ys') =  bounds canvas+	    f cs ws | ws >= cs = 0+	    f cs ws = (cs - ws) `div` 2+	    nc = (canvasTranslate canvas (f xs' xs,f ys' ys))+	renderChild w nc {bounds=(min xs $ fst $ bounds nc ,min ys $ snd $ bounds nc)}+++renderChild :: Widget -> Canvas -> IO ()+renderChild _ (Canvas {bounds = (xb,yb)}) | xb == 0 || yb == 0 = return ()+renderChild w c = render w c++----------+-- Widgets+----------++++emptyWidget = Widget {+    render = const (return ()),+    getBounds = return (0,0),+    processKey = \_ -> return False+    }+++childrenWidget ws = emptyWidget {processKey = pk} where+    pk k = tk ws k+    tk [] _ = return False+    tk (w:ws) k = do+	b <- processKey w k+	if b then return True else tk ws k+-- layout widgets++-- | centers child widget, causes child to not use any extra space.+centerWidget :: Widget -> Widget+centerWidget w = w {render = rst} where+    rst canvas = do+	(xs,ys) <- getBounds w+	let (xs',ys') =  bounds canvas+	renderChild w (canvasTranslate canvas (f xs' xs,f ys' ys)) {bounds=(min xs $ fst $ bounds canvas ,min ys $ snd $ bounds canvas)} where+	    f cs ws | ws >= cs = 0+	    f cs ws = (cs - ws) `div` 2+++-- General Widgets+++newScrollWidget :: Widget -> IO Widget+newScrollWidget w = do+    yr <- newMVar 0+    let rst canvas = do+	    y <- readMVar yr+	    renderChild w (canvasWTranslate canvas (0,y))+	pk (KeyChar 'j') = modifyMVar_ yr (\x -> return $ x + 1) >> keyDone+	pk KeyDown = modifyMVar_ yr (\x -> return $ x + 1) >> keyDone+	pk (KeyChar 'k') = modifyMVar_ yr (\x -> return $ x - 1) >> keyDone+	pk KeyUp = modifyMVar_ yr (\x -> return $ x - 1) >> keyDone+	pk KeyHome = swapMVar yr 0 >> keyDone+	pk (KeyChar 'g') = swapMVar yr 0 >> keyDone+	pk KeyNPage = modifyMVar_ yr (\x -> return $ x + 25) >> keyDone+	pk KeyPPage = modifyMVar_ yr (\x -> return $ x - 25) >> keyDone+	pk k = processKey w k+	keyDone = modifyMVar_ yr (\x -> return  (max 0 x)) >> return True+    return w {processKey = pk, render = rst}+++-- | draw box around child widget+boxWidget :: Widget -> Widget+boxWidget w = w {render = rst, getBounds = gb} where+    gb = getBounds w >>= \(x,y) -> return (x + 2, y + 2)+    rst canvas@(Canvas {bounds = (xb,yb)}) = do+	-- let tb = '+' : (replicate (xb - 2) '-' ++ "+")+	let tb = ulCorner ++ (replicate (xb - 2) hLine ++ urCorner)+	    bb = llCorner ++ (replicate (xb - 2) hLine ++ lrCorner)+	    bc c@(Canvas {bounds = (xb,yb)}) = c {bounds = (max (xb - 1) 0, max (yb - 1) 0)}+	renderChild w (canvasTranslate (bc canvas) (1,1))	+	drawString canvas tb+	drawString (canvasTranslate canvas (0,yb - 1)) bb+	sequence_ [drawString (canvasTranslate canvas (xt,yt)) (vLine :: String) | yt <- [1..yb - 2], xt <- [0,xb - 1]]+++{-+widgetMinBBox :: Maybe Int -> Maybe Int -> Widget -> Widget+widgetMaxBBox :: Maybe Int -> Maybe Int -> Widget -> Widget+widgetExactBBox :: Maybe Int -> Maybe Int -> Widget -> Widget+-}++staticText s = emptyWidget {render = rst, getBounds = return bounds } where+    bounds = (maximum (0:map length ls),length ls)+    ls = lines s+    rst canvas = drawString canvas s+++	+++verticalBox :: [(Packing,Widget)] -> [(Packing,Widget)] -> Widget+verticalBox starts ends = (childrenWidget aw) {render = rd, getBounds = gb} where+    awpb = starts ++ ends+    awp = if any isExpand $ fsts awpb then awpb else starts ++ [(Expand,emptyWidget)] ++ ends+    aw = snds awp+    gb = do+	(xs,ys) <- fmap unzip $ mapM getBounds aw+	return (maximum xs, sum ys)+    rd canvas = do+	let (_,yb) = bounds canvas+        --let ywo = snd $ widgetOrigin $ canvas+	(_,ys) <- gb+	let ne = length (filter isExpand $ fsts awp)+	    el = if yb > ys then splitSpace (yb - ys) ne else replicate ne 0+	    f ((e:es),canvas) (ps,w) | isExpand ps = do+		(_,wby) <- getBounds w+		if isFill ps then+		    renderChild w (boundCanvas Nothing (Just (wby + e)) canvas)+			else renderCentered w (boundCanvas Nothing (Just (wby + e)) canvas)+		return (es,canvasTranslate canvas (0,wby + e))+	    f (es,canvas) (_,w) = do+		(_,wby) <- getBounds w+		--renderCentered w (boundCanvas Nothing (Just wby) canvas)+		renderChild w (boundCanvas Nothing (Just wby) canvas)+		return (es,canvasTranslate canvas (0,wby))+	foldlM_ f (el,canvas) awp+++horizontalBox :: [(Packing,Widget)] -> [(Packing,Widget)] -> Widget+horizontalBox starts ends = (childrenWidget aw) {render = rd, getBounds = gb } where+    awpb = starts ++ ends+    awp = if any isExpand $ fsts awpb then awpb else starts ++ [(Expand,emptyWidget)] ++ ends+    aw = snds awp+    gb = do+	(xs,ys) <- fmap unzip $ mapM getBounds aw+	return (sum xs, maximum ys)+    rd canvas = do+	let (xb,_) = bounds canvas+	(xs,_) <- gb+	let ne = length (filter isExpand $ fsts awp)+	    el = if xb > xs then splitSpace (xb - xs) ne else replicate ne 0+	    f ((e:es),canvas) (ps,w) | isExpand ps = do+		(wbx,_) <- getBounds w+		if isFill ps then+		    renderChild w (boundCanvas (Just (wbx + e)) Nothing canvas)+			else renderCentered w (boundCanvas (Just (wbx + e)) Nothing canvas)+		return (es,canvasTranslate canvas (wbx + e,0))+	    f (es,canvas) (_,w) = do+		(wbx,_) <- getBounds w+		--renderCentered w (boundCanvas (Just wbx) Nothing canvas)+		renderChild w (boundCanvas (Just wbx) Nothing canvas)+		return (es,canvasTranslate canvas (wbx,0))+	foldlM_ f (el,canvas) awp++homVerticalBox :: [(Packing,Widget)] -> Widget+homVerticalBox awp = (childrenWidget aw) {render = rd, getBounds = gb } where+    aw = snds awp+    gb = do+	(xs,ys) <- fmap unzip $ mapM getBounds aw+	return (maximum xs, (maximum ys) * length aw)+    rd canvas = do+	let (_,yb) = bounds canvas+	    el = splitSpace yb (length aw)+	    f ([],_) _ = error "no space to split"+	    f ((e:es),canvas) (ps,w)  = do+		if isFill ps then+		    renderChild w (boundCanvas Nothing (Just e) canvas)+			else renderCentered w (boundCanvas Nothing (Just e) canvas)+		return (es,canvasTranslate canvas (0,e))+	foldlM_ f (el,canvas) awp+++homHorizontalBox :: [(Packing,Widget)] -> Widget+homHorizontalBox awp = (childrenWidget aw) {render = rd, getBounds = gb } where+    aw = snds awp+    gb = do+	(xs,ys) <- fmap unzip $ mapM getBounds aw+	return (maximum xs * length aw, maximum ys)+    rd canvas = do+	let (xb,_) = bounds canvas+	    el = splitSpace xb (length aw)+	    f ([],_) _ = error "no space to split"+	    f ((e:es),canvas) (ps,w)  = do+		if isFill ps then+		    renderChild w (boundCanvas (Just e) Nothing canvas)+			else renderCentered w (boundCanvas (Just e) Nothing canvas)+		return (es,canvasTranslate canvas (e,0))+	foldlM_ f (el,canvas) awp++splitSpace m n = f (m `mod` n) $ replicate n (m `div` n) where+    f 0 xs = xs+    f n (x:xs) = (x + 1) : f (n - 1) xs+    f n' [] = errorf "splitSpace %i %i (f %i []): this can't happen." [fi m, fi n, fi n']+++	+newSVarWidget :: (Readable c ) => c a -> (a -> Widget) -> Widget+newSVarWidget sv f = emptyWidget {render = rw, getBounds = gb} where+    rw canvas = do+	v <- readVal sv+	render (f v) canvas+    gb = do+	v <- readVal sv+	getBounds (f v)++dynamicWidget :: IO Widget -> Widget+dynamicWidget w = emptyWidget {render = rw, getBounds = gb, processKey = pk {- , processEvent = pe -} } where+    rw canvas = do+	v <- w+	render v canvas+    gb = w >>= getBounds+    pk k = w >>= \x -> processKey x k+--    pe a b = w >>= \x -> processEvent x a b++++stackedWidgets :: [Widget] -> Widget+stackedWidgets [] = widgetEmpty+stackedWidgets ws@(w:_) = widgetEmpty { render = rnd, processKey = \k -> processKey w k, getBounds = gb  } where+    rnd canvas = mapM_ (flip render canvas) (reverse ws)+    gb = do+	bs <- mapM getBounds ws+	return $ (liftT2 (maximum, maximum)) (unzip bs)++{-+newAlternate :: Widget -> IO (Widget, Alternate)+newAlternate w = do+    sig <- newSignal+    final <- connect (changedSignal w) (\() -> signal sig ())+    r <- newMVar (w,final)+    let w = emptyWidget {render = rw, getBounds = gb, processKey = pk }+	rw canvas = do+	    (w,_) <- readMVar r+	    renderChild w canvas+	gb = do+	    (w,_) <- readMVar r+	    getBounds w+	pk k = do+	    (w,_) <- readMVar r+	    processKey w k+    return (w,Alternate r sig)+++switchAlternate :: Alternate -> Widget -> IO ()+switchAlternate (Alternate mv sig) w = (modifyMVar_ mv $ \(_,final) ->+	(final >> connect (changedSignal w) (\() -> signal sig ()) >>= \nf -> return (w,nf)))+	    >> signal sig ()+-}++keyCatcherWidget :: (Curses.Key -> IO Bool) -> Widget -> Widget+keyCatcherWidget kr w = w {processKey = kr'} where+    kr' k = do+	b <- processKey w k+	if b then return True else (kr k)++attrWidget :: Attr -> Widget -> Widget+attrWidget a w = w {render = nr} where+    nr canvas = Screen.withAttr canvas a (renderChild w  canvas)++{-+-- data Event = KeyEvent Key | MouseEvent MouseEvent++--data Justification = Justified | LeftJustified | RightJustified+++data InlineBox = InlineBoxText String | InlineBoxAttr [Attr] [InlineBox] | InlineBoxChoice InlineBox InlineBox |+    InlineBoxLB | InlineBoxRight [InlineBox] -- | InlineBoxAction (Event -> IO Bool) [InlineBox]+++++inlineBoxWidget :: [InlineBox] -> Widget+inlineBoxWidget xs = emptyWidget {render = rnd, getBounds = gb } where+    rnd canvas = undefined+    gb = return (0,0)++-}
+ Setup.hs view
@@ -0,0 +1,27 @@+import Control.Exception (bracketOnError)+import Control.Monad+import Distribution.Simple+import Distribution.Simple.PreProcess+import Distribution.Simple.Utils+import System.Directory+import System.Exit+import System.IO+import System.Process++genPP :: PPSuffixHandler+genPP = ("hsgen", \_ _ -> PreProcessor True $ mkSimplePreProcessor ppf) where+  ppf inf outf verb = do+    x <- executable `liftM` getPermissions inf+    cmd <- if x+      then (`proc` []) `liftM` canonicalizePath inf+      else shell `liftM` readFile inf+    bracketOnError (return outf) removeFile $ \f ->+      withFile f WriteMode $ \out -> do+      info verb $ scs (cmdspec cmd) ++ " > " ++ outf+      (_,_,_,pid) <- createProcess cmd { std_out = UseHandle out }+      r <- waitForProcess pid+      when (r /= ExitSuccess) $ die $ scs (cmdspec cmd) ++ ": " ++ show r+  scs (ShellCommand s) = s+  scs (RawCommand c a) = unwords (c:a)++main = defaultMainWithHooks autoconfUserHooks { hookedPreProcessors = genPP : hookedPreProcessors autoconfUserHooks }
+ SimpleParser.hs view
@@ -0,0 +1,158 @@+-- Copyright (c) 2002 John Meacham (john@foo.net)+--+-- Permission is hereby granted, free of charge, to any person obtaining a+-- copy of this software and associated documentation files (the+-- "Software"), to deal in the Software without restriction, including+-- without limitation the rights to use, copy, modify, merge, publish,+-- distribute, sublicense, and/or sell copies of the Software, and to+-- permit persons to whom the Software is furnished to do so, subject to+-- the following conditions:+--+-- The above copyright notice and this permission notice shall be included+-- in all copies or substantial portions of the Software.+--+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS+-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+-- IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+-- TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+-- SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.++module SimpleParser where++import Char+import Monad+import List++infixr 1 <|>++-- very simple parser combinators with failure but limited non-determinism.+-- designed for parsing single lines or simple expressions.+-- advantages: pure haskell 98, simple.+++newtype GenParser c a = MkP ([c] -> Maybe (a,[c]))+type Parser a = GenParser Char a++++instance Monad (GenParser c) where+    return a = MkP (\s -> (Just (a,s)))+    (MkP p) >>= q = MkP $ \s ->  (maybe Nothing (\(v,s') -> app (q v) s') (p s))+    fail _ = MkP $ \_ ->  Nothing++instance Functor (GenParser c) where+    fmap = liftM+++instance MonadPlus (GenParser c) where+    mzero = MkP (\_ -> Nothing)+    mplus = (<|>)+++app (MkP fn) s = fn s++char :: Char -> Parser Char+char c = sat (== c)++eof :: GenParser c ()+eof = MkP eof' where+    eof' [] = Just ((),[])+    eof' _ = Nothing++oneOf cs = sat (`elem` cs)+noneOf cs = sat (`notElem` cs)++between o c p = o >> p >>= \v -> c >> return v++{-# SPECIALIZE parseSome :: Int -> GenParser c [c] #-}+parseSome :: Integral a => a -> GenParser c [c]+parseSome count = MkP f where+    f xs | length xs >= (fromIntegral count) = Just (splitAt (fromIntegral count) xs)+    f _ = Nothing++{-# SPECIALIZE parseExact :: String -> GenParser Char () #-}+parseExact :: Eq c => [c] -> GenParser c ()+parseExact x = MkP f where+    f xs | x `isPrefixOf` xs = Just ((),drop (length x) xs)+    f _ = Nothing++parseRest = MkP (\xs -> Just (xs,[]))++option x p = p <|> return x+skipOption p = option () $ liftM (const ()) p+choice ps = foldl (<|>) mzero ps++anyChar = satisfy (const True)++upper = satisfy isUpper+lower = satisfy isLower+alphaNum = satisfy isAlphaNum+digit = satisfy isDigit+newline = char '\n'+space = satisfy isSpace+spaces = skipMany space+++sat p = MkP f where+    f (x:xs) | p x = Just (x,xs)+    f _ = Nothing++satisfy = sat++p <|> q = MkP $ \s -> maybe (app q s) Just (app p s)++many :: GenParser c a -> GenParser c [a]+many p = (p >>= \x -> many p >>= \xs -> return (x:xs)) <|> return []++many1 :: GenParser c a -> GenParser c [a]+many1 p = p >>= \x -> many p >>= \xs -> return (x:xs)++whitespace = skipMany (sat isSpace)++token p = p >>= \x -> whitespace >> return x++skipMany p = (p >> skipMany p) <|> return ()++number :: Parser Int+number = token (liftM read $ many1 (sat isDigit))++word :: Parser String+word = token $ (many1 (sat isAlpha))++exactWord s = do+    w <- word+    if w == s then return w else mzero++{-# SPECIALIZE parser :: GenParser c a -> [c] -> Maybe a #-}+{-# SPECIALIZE parser :: GenParser c a -> [c] -> IO a #-}+{-# SPECIALIZE parser :: GenParser Char a -> String -> Maybe a #-}+{-# SPECIALIZE parser :: GenParser Char a -> String -> IO a #-}++parser :: Monad m => GenParser c a -> [c] -> m a+parser (MkP fn) s = case fn s of+    Just (v,[]) -> return v+    _ -> fail "parser failed"++{-+parseIO p xs = case parser p xs of+    Just v -> return v+    Nothing -> ioError $ userError "parse error"+-}+++{-+parse_file = do+    whitespace+    u <- number+    v <- number+    exactWord "done"+    return (u,v)++main = do+    c <- getContents+    let v =  parser parse_file c+    print v++-}
+ Status.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE OverlappingInstances #-}++module Status(+    set,+    setS,+    clear,+    Status.get,+    setF,+    setFS,+    getStatus,+    Status.log,+    getLog+    ) where+++import Char(chr)+import CircularBuffer as CB+import Data.IORef+import Data.Tree+import Doc.Chars+import GenUtil+import List(intersperse,groupBy)+import qualified Data.Map as Map+import System.IO.Unsafe+++{-# NOINLINE status_var #-}+status_var :: IORef (Map.Map String (IO String))+status_var  = unsafePerformIO $ newIORef Map.empty++{-# NOINLINE log_var #-}+log_var :: CB.CircularBuffer String+log_var = unsafePerformIO $ CB.new 10++log :: String -> IO ()+log s = CB.append log_var [s]++getLog :: IO [String]+getLog = CB.toList log_var++++modify r f = atomicModifyIORef r (\x -> (f x,()))++setS :: Show a => String -> a -> IO ()+setS w v = set w (show v)++set :: String -> String -> IO ()+set w v = modify status_var (\fm -> Map.insert w (return v) fm)++setF :: String -> IO String -> IO ()+setF w v = modify status_var (\fm -> Map.insert w v fm)++setFS :: Show a => String -> IO a -> IO ()+setFS w v = modify status_var (\fm -> Map.insert w (fmap show v) fm)+++get :: String -> IO (IO String)+get k = do+    fm <- readIORef status_var+    case Map.lookup k fm of+        Just x -> return x+        Nothing -> return (return "")++++clear :: String -> IO ()+clear k =  modify status_var (\fm -> Map.delete k fm)+++getall = do+    fm <- readIORef status_var+    return $ Map.toList fm++getTree :: IO (Forest (String,String))+getTree = do+    xs <- getall+    let f (a,b) = do b <- b; return (split (== '.') a,b)+    xs <- mapM f xs+    return $ createForest  xs++createForest  xs = map f gs where+    --[Node (concat $ intersperse "." (xs),y) [] | (xs,y) <- xs]+    f [(xs,ys)] =  Node (concat $ intersperse "." (xs),ys) []+    f xs@((x:_,_):_) = Node (x,"") (createForest [ (xs,ys) | (_:xs,ys)<- xs])+    f _ = error "createForest: should not happen."+    gs = groupBy (\(x:_,_) (y:_,_) -> x == y) xs+--createForest  xs = Node ("","") [ createTree [(xs,y)] | (xs,y) <- xs]++draw :: Tree String -> [String]+draw (Node x ts0) = x : drawSubTrees ts0+  where drawSubTrees [] = []+        drawSubTrees [t] =+                {-[vLine] :-} shift [chr 0x2570, chr 0x2574] "  " (draw t)+        drawSubTrees (t:ts) =+                {-[vLine] :-} shift (lTee ++ [chr 0x2574]) (vLine ++  " ") (draw t) ++ drawSubTrees ts++        shift first other = zipWith (++) (first : repeat other)+        --vLine = chr 0x254F++getStatus :: IO String+getStatus = do+    t <- getTree+    let f (xs,"") = xs+        f (xs,ys) = xs ++ ": "  ++ ys+    return $ unlines (concatMap (draw . fmap f) t)++++
+ Text/ParserCombinators/ReadP/ByteString.hs view
@@ -0,0 +1,425 @@+{-# LANGUAGE CPP, NoImplicitPrelude, TypeOperators, ExistentialQuantification, PolymorphicComponents #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.ParserCombinators.ReadP.ByteString+-- Copyright   :  (c) The University of Glasgow 2002+--             :  (c) Gracjan Polak 2007+-- License     :  BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer  :  gracjanpolak@gmail.com+-- Stability   :  provisional+-- Portability :  non-portable (local universal quantification)+--+-- This is a library of parser combinators, originally written by Koen Claessen.+-- It parses all alternatives in parallel, so it never keeps hold of+-- the beginning of the input string, a common source of space leaks with+-- other parsers.  The '('+++')' choice combinator is genuinely commutative;+-- it makes no difference which branch is \"shorter\".+--+-- Adapted to use 'Data.ByteString' by Gracjan Polak. Designed as a drop-in+-- replacement for 'Text.ParserCombinators.ReadP'.+--+-- minor modifications by John Meacham for use in ginsu+--+-----------------------------------------------------------------------------++module Text.ParserCombinators.ReadP.ByteString+  (+  -- * The 'ReadP' type+  ReadP,      -- :: * -> *; instance Functor, Monad, MonadPlus++  -- * Primitive operations+  skip,       -- :: Int -> ReadP Word8+  look,       -- :: ReadP ByteString+  (+++),      -- :: ReadP a -> ReadP a -> ReadP a+  (<++),      -- :: ReadP a -> ReadP a -> ReadP a+  countsym,   -- :: ReadP a -> ReadP (Int, a)++  -- * Other operations+  get,        -- :: ReadP Word8+  pfail,      -- :: ReadP a+  satisfy,    -- :: (Word8 -> Bool) -> ReadP Word8+  char,       -- :: Word8 -> ReadP Word8+  string,     -- :: ByteString -> ReadP ByteString+  gather,     -- :: ReadP a -> ReadP (ByteString, a)+  munch,      -- :: (Word8 -> Bool) -> ReadP ByteString+  munch1,     -- :: (Word8 -> Bool) -> ReadP ByteString+  skipSpaces, -- :: ReadP ()+  choice,     -- :: [ReadP a] -> ReadP a+  count,      -- :: Int -> ReadP a -> ReadP [a]+  between,    -- :: ReadP open -> ReadP close -> ReadP a -> ReadP a+  option,     -- :: a -> ReadP a -> ReadP a+  optional,   -- :: ReadP a -> ReadP ()+  many,       -- :: ReadP a -> ReadP [a]+  many1,      -- :: ReadP a -> ReadP [a]+  skipMany,   -- :: ReadP a -> ReadP ()+  skipMany1,  -- :: ReadP a -> ReadP ()+  sepBy,      -- :: ReadP a -> ReadP sep -> ReadP [a]+  sepBy1,     -- :: ReadP a -> ReadP sep -> ReadP [a]+  endBy,      -- :: ReadP a -> ReadP sep -> ReadP [a]+  endBy1,     -- :: ReadP a -> ReadP sep -> ReadP [a]+  chainr,     -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a+  chainl,     -- :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a+  chainl1,    -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a+  chainr1,    -- :: ReadP a -> ReadP (a -> a -> a) -> ReadP a+  manyTill,   -- :: ReadP a -> ReadP end -> ReadP [a]++  -- * Running a parser+  ReadS,      -- :: *; = ByteString -> [(a,ByteString)]+  readP_to_S, -- :: ReadP a -> ReadS a+  readS_to_P, -- :: ReadS a -> ReadP a+  )+ where++import Control.Monad ( MonadPlus(..), liftM2, Monad, (>>), (>>=),+                       return, fail, Functor, fmap, replicateM )+import Prelude ( (+), (-), (++), Int, Bool(..), (==), error,+                 fromInteger, (.), (>=), compare, Ordering(..) )+import Data.Word (Word8)+import Data.ByteString (ByteString,length,take,takeWhile,null)++#ifdef BYTESTRING_BASE_ONLY+import Data.ByteString.Base (unsafeDrop,unsafeHead,isSpaceWord8)+#else+import Data.ByteString.Unsafe (unsafeTake,unsafeDrop,unsafeHead)+import Data.ByteString.Internal (isSpaceWord8)+#endif++infixr 5 +++, <++++------------------------------------------------------------------------+-- ReadS++-- | A parser for a type @a@, represented as a function that takes a+-- 'ByteString' and returns a list of possible parses as @(a,'ByteString')@ pairs.+--+-- Note that this kind of backtracking parser is very inefficient;+-- reading a large structure may be quite slow (cf 'ReadP').+type ReadS a = ByteString -> [(a,ByteString)]++-- ---------------------------------------------------------------------------+-- The P type+-- is representation type -- should be kept abstract++data P a+  = Skip {-# UNPACK #-} !Int (P a)+  | Look (ByteString -> P a)+  | Fail+  | Result a (P a)+  | Final [(a,ByteString)] -- invariant: list is non-empty!++-- Monad, MonadPlus++instance Monad (P) where+  return x = Result x Fail++  (Skip n f)   >>= k = Skip n (f >>= k)+  (Look f)     >>= k = Look (\s -> f s >>= k)+  Fail         >>= _ = Fail+  (Result x p) >>= k = k x `mplus` (p >>= k)+  (Final r)    >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]++  fail _ = Fail++instance MonadPlus (P) where+  mzero = Fail++  -- most common case: two skips are combined+  Skip n1 f1 `mplus` Skip n2 f2 =+      case compare n1 n2 of+          LT -> Skip n1 (f1 `mplus` Skip (n2-n1) f2)+          EQ -> Skip n1 (f1 `mplus` f2)+          GT -> Skip n2 (Skip (n1-n2) f1 `mplus` f2)++  -- results are delivered as soon as possible+  Result x p `mplus` q          = Result x (p `mplus` q)+  p          `mplus` Result x q = Result x (p `mplus` q)++  -- fail disappears+  Fail       `mplus` p          = p+  p          `mplus` Fail       = p++  -- two finals are combined+  -- final + look becomes one look and one final (=optimization)+  -- final + sthg else becomes one look and one final+  Final r    `mplus` Final t    = Final (r ++ t)+  Final r    `mplus` Look f     = Look (\s -> Final (r ++ run (f s) s))+  Final r    `mplus` p          = Look (\s -> Final (r ++ run p s))+  Look f     `mplus` Final r    = Look (\s -> Final (run (f s) s ++ r))+  p          `mplus` Final r    = Look (\s -> Final (run p s ++ r))++  -- two looks are combined (=optimization)+  -- look + sthg else floats upwards+  Look f     `mplus` Look g     = Look (\s -> f s `mplus` g s)+  Look f     `mplus` p          = Look (\s -> f s `mplus` p)+  p          `mplus` Look f     = Look (\s -> p `mplus` f s)++-- ---------------------------------------------------------------------------+-- The ReadP type++newtype ReadP a = R (forall b . (a -> P b) -> P b)++-- Functor, Monad, MonadPlus++instance Functor (ReadP) where+  fmap h (R f) = R (\k -> f (k . h))++instance Monad (ReadP) where+  return x  = R (\k -> k x)+  fail _    = R (\_ -> Fail)+  R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))++instance MonadPlus (ReadP) where+  mzero = pfail+  mplus = (+++)++-- ---------------------------------------------------------------------------+-- Operations over P++final :: [(a,ByteString)] -> P a+-- Maintains invariant for Final constructor+final [] = Fail+final r  = Final r++run :: P a -> ReadS a+run (Skip n f)  cs | length cs >=n =+         run f (unsafeDrop n cs)+run (Look f)     s     = run (f s) s+run (Result x p) s     = (x,s) : run p s+run (Final r)    _     = r+run _            _     = []++-- ---------------------------------------------------------------------------+-- Operations over ReadP+++skip :: Int -> ReadP ()+skip 0 = R (\f -> f ())+skip n = R (\f -> Skip n (f ()))++get :: ReadP Word8+-- ^ Consumes and returns the next character.+--   Fails if there is no input left.+get = do+    s <- look+    skip 1+    return (unsafeHead s)++look :: ReadP ByteString+-- ^ Look-ahead: returns the part of the input that is left, without+--   consuming it.+look = R Look++pfail :: ReadP a+-- ^ Always fails.+pfail = R (\_ -> Fail)++(+++) :: ReadP a -> ReadP a -> ReadP a+-- ^ Symmetric choice.+R f1 +++ R f2 = R (\k -> f1 k `mplus` f2 k)++(<++) :: ReadP a -> ReadP a -> ReadP a+-- ^ Local, exclusive, left-biased choice: If left parser+--   locally produces any result at all, then right parser is+--   not used.+R f <++ q =+  do s <- look+     probe (f return) s 0+ where+  probe (Skip m f)     cs    n  | length cs >= m = probe f (unsafeDrop m cs) (n+m)+  probe (Look f)       s     n = probe (f s) s n+  probe p@(Result _ _) _     n = skip n >> R (p >>=)+  probe (Final r)      _     _ = R (Final r >>=)+  probe _              _     _ = q++gather :: ReadP a -> ReadP (ByteString, a)+-- ^ Transforms a parser into one that does the same, but+--   in addition returns the exact characters read.+--   IMPORTANT NOTE: 'gather' gives a runtime error if its first argument+--   is built using any occurrences of readS_to_P.+gather p = do+    s <- look+    (l,r) <- countsym p+    return (unsafeTake l s,r)+--    return (unsafeDrop l s,r)++countsym :: ReadP a -> ReadP (Int, a)+-- ^ Transforms a parser into one that does the same, but+--   in addition returns the exact number of characters read.+--   IMPORTANT NOTE: 'countsym' gives a runtime error if its first argument+--   is built using any occurrences of readS_to_P.+countsym (R m) =+  R (\k -> gath 0 (m (\a -> return (\s -> k (s,a)))))+ where+  gath 0 _   | False  = Fail+  gath l (Skip n f)   = Skip n (gath (l+n) f)+  gath _ Fail         = Fail+  gath l (Look f)     = Look (\s -> gath l (f s))+  gath l (Result k p) = k (l) `mplus` gath l p+  gath _ (Final _)    = error "do not use readS_to_P in gather or countsym!"++-- ---------------------------------------------------------------------------+-- Derived operations++satisfy :: (Word8 -> Bool) -> ReadP Word8+-- ^ Consumes and returns the next character, if it satisfies the+--   specified predicate.+satisfy p = do+    c <- get+    if p c+        then return c+        else pfail++char :: Word8 -> ReadP Word8+-- ^ Parses and returns the specified character.+char c = satisfy (c ==)++string :: ByteString -> ReadP ByteString+-- ^ Parses and returns the specified string.+string this = do+    s <- look+    let l = length this+    let w = take l s+    if this == w+        then skip (length this) >> return this+        else pfail++munch :: (Word8 -> Bool) -> ReadP ByteString+-- ^ Parses the first zero or more characters satisfying the predicate.+munch p =+  do s <- look+     let k = takeWhile p s+     skip (length k)+     return k++munch1 :: (Word8 -> Bool) -> ReadP ByteString+-- ^ Parses the first one or more characters satisfying the predicate.+munch1 p =+  do s <- look+     let k = takeWhile p s+     if null k+         then pfail+         else skip (length k) >> return k++choice :: [ReadP a] -> ReadP a+-- ^ Combines all parsers in the specified list.+choice []     = pfail+choice [p]    = p+choice (p:ps) = p +++ choice ps++skipSpaces :: ReadP ()+-- ^ Skips all whitespace.+skipSpaces = munch isSpaceWord8 >> return ()++count :: Int -> ReadP a -> ReadP [a]+-- ^ @count n p@ parses @n@ occurrences of @p@ in sequence. A list of+--   results is returned.+count n p = replicateM n p++between :: ReadP open -> ReadP close -> ReadP a -> ReadP a+-- ^ @between open close p@ parses @open@, followed by @p@ and finally+--   @close@. Only the value of @p@ is returned.+between open close p = do open+                          x <- p+                          close+                          return x++option :: a -> ReadP a -> ReadP a+-- ^ @option x p@ will either parse @p@ or return @x@ without consuming+--   any input.+option x p = p +++ return x++optional :: ReadP a -> ReadP ()+-- ^ @optional p@ optionally parses @p@ and always returns @()@.+optional p = (p >> return ()) +++ return ()++many :: ReadP a -> ReadP [a]+-- ^ Parses zero or more occurrences of the given parser.+many p = return [] +++ many1 p++many1 :: ReadP a -> ReadP [a]+-- ^ Parses one or more occurrences of the given parser.+many1 p = liftM2 (:) p (many p)++skipMany :: ReadP a -> ReadP ()+-- ^ Like 'many', but discards the result.+skipMany p = many p >> return ()++skipMany1 :: ReadP a -> ReadP ()+-- ^ Like 'many1', but discards the result.+skipMany1 p = p >> skipMany p++sepBy :: ReadP a -> ReadP sep -> ReadP [a]+-- ^ @sepBy p sep@ parses zero or more occurrences of @p@, separated by @sep@.+--   Returns a list of values returned by @p@.+sepBy p sep = sepBy1 p sep +++ return []++sepBy1 :: ReadP a -> ReadP sep -> ReadP [a]+-- ^ @sepBy1 p sep@ parses one or more occurrences of @p@, separated by @sep@.+--   Returns a list of values returned by @p@.+sepBy1 p sep = liftM2 (:) p (many (sep >> p))++endBy :: ReadP a -> ReadP sep -> ReadP [a]+-- ^ @endBy p sep@ parses zero or more occurrences of @p@, separated and ended+--   by @sep@.+endBy p sep = many (do x <- p ; sep ; return x)++endBy1 :: ReadP a -> ReadP sep -> ReadP [a]+-- ^ @endBy p sep@ parses one or more occurrences of @p@, separated and ended+--   by @sep@.+endBy1 p sep = many1 (do x <- p ; sep ; return x)++chainr :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a+-- ^ @chainr p op x@ parses zero or more occurrences of @p@, separated by @op@.+--   Returns a value produced by a /right/ associative application of all+--   functions returned by @op@. If there are no occurrences of @p@, @x@ is+--   returned.+chainr p op x = chainr1 p op +++ return x++chainl :: ReadP a -> ReadP (a -> a -> a) -> a -> ReadP a+-- ^ @chainl p op x@ parses zero or more occurrences of @p@, separated by @op@.+--   Returns a value produced by a /left/ associative application of all+--   functions returned by @op@. If there are no occurrences of @p@, @x@ is+--   returned.+chainl p op x = chainl1 p op +++ return x++chainr1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a+-- ^ Like 'chainr', but parses one or more occurrences of @p@.+chainr1 p op = scan+  where scan   = p >>= rest+        rest x = do f <- op+                    y <- scan+                    return (f x y)+                 +++ return x++chainl1 :: ReadP a -> ReadP (a -> a -> a) -> ReadP a+-- ^ Like 'chainl', but parses one or more occurrences of @p@.+chainl1 p op = p >>= rest+  where rest x = do f <- op+                    y <- p+                    rest (f x y)+                 +++ return x++manyTill :: ReadP a -> ReadP end -> ReadP [a]+-- ^ @manyTill p end@ parses zero or more occurrences of @p@, until @end@+--   succeeds. Returns a list of values returned by @p@.+manyTill p end = scan+  where scan = (end >> return []) <++ (liftM2 (:) p scan)++-- ---------------------------------------------------------------------------+-- Converting between ReadP and Read++readP_to_S :: ReadP a -> ReadS a+-- ^ Converts a parser into a Haskell ReadS-style function.+--   This is the main way in which you can \"run\" a 'ReadP' parser:+--   the expanded type is+-- @ readP_to_S :: ReadP a -> ByteString -> [(a,ByteString)] @+readP_to_S (R f) = run (f return)++readS_to_P :: ReadS a -> ReadP a+-- ^ Converts a Haskell ReadS-style function into a parser.+--   Warning: This introduces local backtracking in the resulting+--   parser, and therefore a possible inefficiency.+readS_to_P r =+  R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s']))+
+ Version.hs view
@@ -0,0 +1,13 @@+module Version(package, version, fullName) where++import qualified Paths_ginsu as Paths+import Data.Version++package :: String+package = "ginsu"++version :: String+version = showVersion Paths.version++fullName :: String+fullName = package ++ '-' : version
+ actions.def view
@@ -0,0 +1,56 @@+@Main Screens+show_help_screen  Show help screen+show_presence_status+show_puff_details+show_status_screen++@Puff Movement+next_puff     Goto the next puff+previous_puff  Goto the previous puff+first_puff  Goto the first puff+last_puff   Goto the last puff+next_line      Scroll one line down+previous_line  Scroll one line up+next_page      Scroll one page down+previous_page  Scroll one page up+forward_half_page  Scroll a half page down+backward_half_page Scroll a half page up++@Filter Manipulation+prompt_new_filter+prompt_new_filter_slash+prompt_new_filter_twiddle+pop_one_filter+pop_all_filters+invert_filter+filter_current_thread+swap_filters+filter_current_author++@Puff Body Filtering+toggle_rot13    toggle Rot13 filter++@Mark/Workspace Manipulation+set_mark     save current position at a given mark.+recall_mark  goto position saved at mark+set_filter_mark save current filter stack at given mark.+recall_filter_mark Recall filter stack at mark+recall_combine_mark  Recall filter stack at mark and combine it with the current filter stack.+%recall_workspace [1-9] Recall given numbered workspace and set it as current workspace, these follow marks [1-9]++@Composing Puffs+new_puff        compose a new puff+follow_up       follow up to the same category as the current puff+reply_to_author reply to the author of the current puff privatly+group_reply     reply to the union of the sender and categories of the current puff+resend_puff++@Miscellaneous+goto_match visit link in current puff+modify_presence_string+reconnect_to_servers+edit_config_file Edit the configuration file and reload its settings+ask_quit         quit ginsu+fast_quit        quit ginsu without asking first+redraw_screen+
+ config.h.in view
@@ -0,0 +1,61 @@+/* config.h.in.  Generated from configure.ac by autoheader.  */++/* Define to 1 if you have the <curses.h> header file. */+#undef HAVE_CURSES_H++/* Define to 1 if you have the <inttypes.h> header file. */+#undef HAVE_INTTYPES_H++/* Define to 1 if you have the <memory.h> header file. */+#undef HAVE_MEMORY_H++/* Define to 1 if you have the <ncursesw/ncurses.h> header file. */+#undef HAVE_NCURSESW_NCURSES_H++/* Define to 1 if you have the <ncurses.h> header file. */+#undef HAVE_NCURSES_H++/* Define to 1 if you have the <ncurses/ncurses.h> header file. */+#undef HAVE_NCURSES_NCURSES_H++/* Define to 1 if you have the <stdint.h> header file. */+#undef HAVE_STDINT_H++/* Define to 1 if you have the <stdlib.h> header file. */+#undef HAVE_STDLIB_H++/* Define to 1 if you have the <strings.h> header file. */+#undef HAVE_STRINGS_H++/* Define to 1 if you have the <string.h> header file. */+#undef HAVE_STRING_H++/* Define to 1 if you have the <sys/stat.h> header file. */+#undef HAVE_SYS_STAT_H++/* Define to 1 if you have the <sys/types.h> header file. */+#undef HAVE_SYS_TYPES_H++/* Define to 1 if you have the <unistd.h> header file. */+#undef HAVE_UNISTD_H++/* Define to the address where bug reports for this package should be sent. */+#undef PACKAGE_BUGREPORT++/* Define to the full name of this package. */+#undef PACKAGE_NAME++/* Define to the full name and version of this package. */+#undef PACKAGE_STRING++/* Define to the one symbol short name of this package. */+#undef PACKAGE_TARNAME++/* Define to the home page for this package. */+#undef PACKAGE_URL++/* Define to the version of this package. */+#undef PACKAGE_VERSION++/* Define to 1 if you have the ANSI C header files. */+#undef STDC_HEADERS
+ configure view
@@ -0,0 +1,4629 @@+#! /bin/sh+# Guess values for system-dependent variables and create Makefiles.+# Generated by GNU Autoconf 2.68 for ginsu 0.8.0.+#+#+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,+# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software+# Foundation, Inc.+#+#+# This configure script is free software; the Free Software Foundation+# gives unlimited permission to copy, distribute and modify it.+## -------------------- ##+## M4sh Initialization. ##+## -------------------- ##++# Be more Bourne compatible+DUALCASE=1; export DUALCASE # for MKS sh+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :+  emulate sh+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which+  # is contrary to our usage.  Disable this feature.+  alias -g '${1+"$@"}'='"$@"'+  setopt NO_GLOB_SUBST+else+  case `(set -o) 2>/dev/null` in #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac+fi+++as_nl='+'+export as_nl+# Printing a long string crashes Solaris 7 /usr/bin/printf.+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo+# Prefer a ksh shell builtin over an external printf program on Solaris,+# but without wasting forks for bash or zsh.+if test -z "$BASH_VERSION$ZSH_VERSION" \+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then+  as_echo='print -r --'+  as_echo_n='print -rn --'+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then+  as_echo='printf %s\n'+  as_echo_n='printf %s'+else+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'+    as_echo_n='/usr/ucb/echo -n'+  else+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'+    as_echo_n_body='eval+      arg=$1;+      case $arg in #(+      *"$as_nl"*)+	expr "X$arg" : "X\\(.*\\)$as_nl";+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;+      esac;+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"+    '+    export as_echo_n_body+    as_echo_n='sh -c $as_echo_n_body as_echo'+  fi+  export as_echo_body+  as_echo='sh -c $as_echo_body as_echo'+fi++# The user is always right.+if test "${PATH_SEPARATOR+set}" != set; then+  PATH_SEPARATOR=:+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||+      PATH_SEPARATOR=';'+  }+fi+++# IFS+# We need space, tab and new line, in precisely that order.  Quoting is+# there to prevent editors from complaining about space-tab.+# (If _AS_PATH_WALK were called with IFS unset, it would disable word+# splitting by setting IFS to empty value.)+IFS=" ""	$as_nl"++# Find who we are.  Look in the path if we contain no directory separator.+as_myself=+case $0 in #((+  *[\\/]* ) as_myself=$0 ;;+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break+  done+IFS=$as_save_IFS++     ;;+esac+# We did not find ourselves, most probably we were run as `sh COMMAND'+# in which case we are not to be found in the path.+if test "x$as_myself" = x; then+  as_myself=$0+fi+if test ! -f "$as_myself"; then+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2+  exit 1+fi++# Unset variables that we do not need and which cause bugs (e.g. in+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"+# suppresses any "Segmentation fault" message there.  '((' could+# trigger a bug in pdksh 5.2.14.+for as_var in BASH_ENV ENV MAIL MAILPATH+do eval test x\${$as_var+set} = xset \+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :+done+PS1='$ '+PS2='> '+PS4='+ '++# NLS nuisances.+LC_ALL=C+export LC_ALL+LANGUAGE=C+export LANGUAGE++# CDPATH.+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH++if test "x$CONFIG_SHELL" = x; then+  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :+  emulate sh+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which+  # is contrary to our usage.  Disable this feature.+  alias -g '\${1+\"\$@\"}'='\"\$@\"'+  setopt NO_GLOB_SUBST+else+  case \`(set -o) 2>/dev/null\` in #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac+fi+"+  as_required="as_fn_return () { (exit \$1); }+as_fn_success () { as_fn_return 0; }+as_fn_failure () { as_fn_return 1; }+as_fn_ret_success () { return 0; }+as_fn_ret_failure () { return 1; }++exitcode=0+as_fn_success || { exitcode=1; echo as_fn_success failed.; }+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }+if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :++else+  exitcode=1; echo positional parameters were not saved.+fi+test x\$exitcode = x0 || exit 1"+  as_suggested="  as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO+  as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO+  eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&+  test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1+test \$(( 1 + 1 )) = 2 || exit 1"+  if (eval "$as_required") 2>/dev/null; then :+  as_have_required=yes+else+  as_have_required=no+fi+  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :++else+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+as_found=false+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  as_found=:+  case $as_dir in #(+	 /*)+	   for as_base in sh bash ksh sh5; do+	     # Try only shells that exist, to save several forks.+	     as_shell=$as_dir/$as_base+	     if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&+		    { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :+  CONFIG_SHELL=$as_shell as_have_required=yes+		   if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :+  break 2+fi+fi+	   done;;+       esac+  as_found=false+done+$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&+	      { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :+  CONFIG_SHELL=$SHELL as_have_required=yes+fi; }+IFS=$as_save_IFS+++      if test "x$CONFIG_SHELL" != x; then :+  # We cannot yet assume a decent shell, so we have to provide a+	# neutralization value for shells without unset; and this also+	# works around shells that cannot unset nonexistent variables.+	# Preserve -v and -x to the replacement shell.+	BASH_ENV=/dev/null+	ENV=/dev/null+	(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV+	export CONFIG_SHELL+	case $- in # ((((+	  *v*x* | *x*v* ) as_opts=-vx ;;+	  *v* ) as_opts=-v ;;+	  *x* ) as_opts=-x ;;+	  * ) as_opts= ;;+	esac+	exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"}+fi++    if test x$as_have_required = xno; then :+  $as_echo "$0: This script requires a shell more modern than all"+  $as_echo "$0: the shells that I found on your system."+  if test x${ZSH_VERSION+set} = xset ; then+    $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"+    $as_echo "$0: be upgraded to zsh 4.3.4 or later."+  else+    $as_echo "$0: Please tell bug-autoconf@gnu.org about your system,+$0: including any error possibly output before this+$0: message. Then install a modern shell, or manually run+$0: the script under such a shell if you do have one."+  fi+  exit 1+fi+fi+fi+SHELL=${CONFIG_SHELL-/bin/sh}+export SHELL+# Unset more variables known to interfere with behavior of common tools.+CLICOLOR_FORCE= GREP_OPTIONS=+unset CLICOLOR_FORCE GREP_OPTIONS++## --------------------- ##+## M4sh Shell Functions. ##+## --------------------- ##+# as_fn_unset VAR+# ---------------+# Portably unset VAR.+as_fn_unset ()+{+  { eval $1=; unset $1;}+}+as_unset=as_fn_unset++# as_fn_set_status STATUS+# -----------------------+# Set $? to STATUS, without forking.+as_fn_set_status ()+{+  return $1+} # as_fn_set_status++# as_fn_exit STATUS+# -----------------+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.+as_fn_exit ()+{+  set +e+  as_fn_set_status $1+  exit $1+} # as_fn_exit++# as_fn_mkdir_p+# -------------+# Create "$as_dir" as a directory, including parents if necessary.+as_fn_mkdir_p ()+{++  case $as_dir in #(+  -*) as_dir=./$as_dir;;+  esac+  test -d "$as_dir" || eval $as_mkdir_p || {+    as_dirs=+    while :; do+      case $as_dir in #(+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(+      *) as_qdir=$as_dir;;+      esac+      as_dirs="'$as_qdir' $as_dirs"+      as_dir=`$as_dirname -- "$as_dir" ||+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_dir" : 'X\(//\)[^/]' \| \+	 X"$as_dir" : 'X\(//\)$' \| \+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$as_dir" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+      test -d "$as_dir" && break+    done+    test -z "$as_dirs" || eval "mkdir $as_dirs"+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"+++} # as_fn_mkdir_p+# as_fn_append VAR VALUE+# ----------------------+# Append the text in VALUE to the end of the definition contained in VAR. Take+# advantage of any shell optimizations that allow amortized linear growth over+# repeated appends, instead of the typical quadratic growth present in naive+# implementations.+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :+  eval 'as_fn_append ()+  {+    eval $1+=\$2+  }'+else+  as_fn_append ()+  {+    eval $1=\$$1\$2+  }+fi # as_fn_append++# as_fn_arith ARG...+# ------------------+# Perform arithmetic evaluation on the ARGs, and store the result in the+# global $as_val. Take advantage of shells that can avoid forks. The arguments+# must be portable across $(()) and expr.+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :+  eval 'as_fn_arith ()+  {+    as_val=$(( $* ))+  }'+else+  as_fn_arith ()+  {+    as_val=`expr "$@" || test $? -eq 1`+  }+fi # as_fn_arith+++# as_fn_error STATUS ERROR [LINENO LOG_FD]+# ----------------------------------------+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the+# script with STATUS, using 1 if that was 0.+as_fn_error ()+{+  as_status=$1; test $as_status -eq 0 && as_status=1+  if test "$4"; then+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4+  fi+  $as_echo "$as_me: error: $2" >&2+  as_fn_exit $as_status+} # as_fn_error++if expr a : '\(a\)' >/dev/null 2>&1 &&+   test "X`expr 00001 : '.*\(...\)'`" = X001; then+  as_expr=expr+else+  as_expr=false+fi++if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then+  as_basename=basename+else+  as_basename=false+fi++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then+  as_dirname=dirname+else+  as_dirname=false+fi++as_me=`$as_basename -- "$0" ||+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \+	 X"$0" : 'X\(//\)$' \| \+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X/"$0" |+    sed '/^.*\/\([^/][^/]*\)\/*$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`++# Avoid depending upon Character Ranges.+as_cr_letters='abcdefghijklmnopqrstuvwxyz'+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'+as_cr_Letters=$as_cr_letters$as_cr_LETTERS+as_cr_digits='0123456789'+as_cr_alnum=$as_cr_Letters$as_cr_digits+++  as_lineno_1=$LINENO as_lineno_1a=$LINENO+  as_lineno_2=$LINENO as_lineno_2a=$LINENO+  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&+  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {+  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)+  sed -n '+    p+    /[$]LINENO/=+  ' <$as_myself |+    sed '+      s/[$]LINENO.*/&-/+      t lineno+      b+      :lineno+      N+      :loop+      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/+      t loop+      s/-\n.*//+    ' >$as_me.lineno &&+  chmod +x "$as_me.lineno" ||+    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }++  # Don't try to exec as it changes $[0], causing all sort of problems+  # (the dirname of $[0] is not the place where we might find the+  # original and so on.  Autoconf is especially sensitive to this).+  . "./$as_me.lineno"+  # Exit status is that of the last command.+  exit+}++ECHO_C= ECHO_N= ECHO_T=+case `echo -n x` in #(((((+-n*)+  case `echo 'xy\c'` in+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.+  xy)  ECHO_C='\c';;+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null+       ECHO_T='	';;+  esac;;+*)+  ECHO_N='-n';;+esac++rm -f conf$$ conf$$.exe conf$$.file+if test -d conf$$.dir; then+  rm -f conf$$.dir/conf$$.file+else+  rm -f conf$$.dir+  mkdir conf$$.dir 2>/dev/null+fi+if (echo >conf$$.file) 2>/dev/null; then+  if ln -s conf$$.file conf$$ 2>/dev/null; then+    as_ln_s='ln -s'+    # ... but there are two gotchas:+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.+    # In both cases, we have to default to `cp -p'.+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||+      as_ln_s='cp -p'+  elif ln conf$$.file conf$$ 2>/dev/null; then+    as_ln_s=ln+  else+    as_ln_s='cp -p'+  fi+else+  as_ln_s='cp -p'+fi+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file+rmdir conf$$.dir 2>/dev/null++if mkdir -p . 2>/dev/null; then+  as_mkdir_p='mkdir -p "$as_dir"'+else+  test -d ./-p && rmdir ./-p+  as_mkdir_p=false+fi++if test -x / >/dev/null 2>&1; then+  as_test_x='test -x'+else+  if ls -dL / >/dev/null 2>&1; then+    as_ls_L_option=L+  else+    as_ls_L_option=+  fi+  as_test_x='+    eval sh -c '\''+      if test -d "$1"; then+	test -d "$1/.";+      else+	case $1 in #(+	-*)set "./$1";;+	esac;+	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((+	???[sx]*):;;*)false;;esac;fi+    '\'' sh+  '+fi+as_executable_p=$as_test_x++# Sed expression to map a string onto a valid CPP name.+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"++# Sed expression to map a string onto a valid variable name.+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+++test -n "$DJDIR" || exec 7<&0 </dev/null+exec 6>&1++# Name of the host.+# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,+# so uname gets run too.+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`++#+# Initializations.+#+ac_default_prefix=/usr/local+ac_clean_files=+ac_config_libobj_dir=.+LIBOBJS=+cross_compiling=no+subdirs=+MFLAGS=+MAKEFLAGS=++# Identity of this package.+PACKAGE_NAME='ginsu'+PACKAGE_TARNAME='ginsu'+PACKAGE_VERSION='0.8.0'+PACKAGE_STRING='ginsu 0.8.0'+PACKAGE_BUGREPORT=''+PACKAGE_URL=''++ac_unique_file="Main.hs"+# Factoring default headers for most tests.+ac_includes_default="\+#include <stdio.h>+#ifdef HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif+#ifdef HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif+#ifdef STDC_HEADERS+# include <stdlib.h>+# include <stddef.h>+#else+# ifdef HAVE_STDLIB_H+#  include <stdlib.h>+# endif+#endif+#ifdef HAVE_STRING_H+# if !defined STDC_HEADERS && defined HAVE_MEMORY_H+#  include <memory.h>+# endif+# include <string.h>+#endif+#ifdef HAVE_STRINGS_H+# include <strings.h>+#endif+#ifdef HAVE_INTTYPES_H+# include <inttypes.h>+#endif+#ifdef HAVE_STDINT_H+# include <stdint.h>+#endif+#ifdef HAVE_UNISTD_H+# include <unistd.h>+#endif"++ac_subst_vars='LTLIBOBJS+LIBOBJS+CURSES_LIB+EGREP+GREP+CPP+OBJEXT+EXEEXT+ac_ct_CC+CPPFLAGS+LDFLAGS+CFLAGS+CC+target_alias+host_alias+build_alias+LIBS+ECHO_T+ECHO_N+ECHO_C+DEFS+mandir+localedir+libdir+psdir+pdfdir+dvidir+htmldir+infodir+docdir+oldincludedir+includedir+localstatedir+sharedstatedir+sysconfdir+datadir+datarootdir+libexecdir+sbindir+bindir+program_transform_name+prefix+exec_prefix+PACKAGE_URL+PACKAGE_BUGREPORT+PACKAGE_STRING+PACKAGE_VERSION+PACKAGE_TARNAME+PACKAGE_NAME+PATH_SEPARATOR+SHELL'+ac_subst_files=''+ac_user_opts='+enable_option_checking+with_compiler+with_gcc+'+      ac_precious_vars='build_alias+host_alias+target_alias+CC+CFLAGS+LDFLAGS+LIBS+CPPFLAGS+CPP'+++# Initialize some variables set by options.+ac_init_help=+ac_init_version=false+ac_unrecognized_opts=+ac_unrecognized_sep=+# The variables have the same names as the options, with+# dashes changed to underlines.+cache_file=/dev/null+exec_prefix=NONE+no_create=+no_recursion=+prefix=NONE+program_prefix=NONE+program_suffix=NONE+program_transform_name=s,x,x,+silent=+site=+srcdir=+verbose=+x_includes=NONE+x_libraries=NONE++# Installation directory options.+# These are left unexpanded so users can "make install exec_prefix=/foo"+# and all the variables that are supposed to be based on exec_prefix+# by default will actually change.+# Use braces instead of parens because sh, perl, etc. also accept them.+# (The list follows the same order as the GNU Coding Standards.)+bindir='${exec_prefix}/bin'+sbindir='${exec_prefix}/sbin'+libexecdir='${exec_prefix}/libexec'+datarootdir='${prefix}/share'+datadir='${datarootdir}'+sysconfdir='${prefix}/etc'+sharedstatedir='${prefix}/com'+localstatedir='${prefix}/var'+includedir='${prefix}/include'+oldincludedir='/usr/include'+docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'+infodir='${datarootdir}/info'+htmldir='${docdir}'+dvidir='${docdir}'+pdfdir='${docdir}'+psdir='${docdir}'+libdir='${exec_prefix}/lib'+localedir='${datarootdir}/locale'+mandir='${datarootdir}/man'++ac_prev=+ac_dashdash=+for ac_option+do+  # If the previous option needs an argument, assign it.+  if test -n "$ac_prev"; then+    eval $ac_prev=\$ac_option+    ac_prev=+    continue+  fi++  case $ac_option in+  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;+  *=)   ac_optarg= ;;+  *)    ac_optarg=yes ;;+  esac++  # Accept the important Cygnus configure options, so we can diagnose typos.++  case $ac_dashdash$ac_option in+  --)+    ac_dashdash=yes ;;++  -bindir | --bindir | --bindi | --bind | --bin | --bi)+    ac_prev=bindir ;;+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)+    bindir=$ac_optarg ;;++  -build | --build | --buil | --bui | --bu)+    ac_prev=build_alias ;;+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)+    build_alias=$ac_optarg ;;++  -cache-file | --cache-file | --cache-fil | --cache-fi \+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)+    ac_prev=cache_file ;;+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)+    cache_file=$ac_optarg ;;++  --config-cache | -C)+    cache_file=config.cache ;;++  -datadir | --datadir | --datadi | --datad)+    ac_prev=datadir ;;+  -datadir=* | --datadir=* | --datadi=* | --datad=*)+    datadir=$ac_optarg ;;++  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \+  | --dataroo | --dataro | --datar)+    ac_prev=datarootdir ;;+  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \+  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)+    datarootdir=$ac_optarg ;;++  -disable-* | --disable-*)+    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid feature name: $ac_useropt"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"enable_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval enable_$ac_useropt=no ;;++  -docdir | --docdir | --docdi | --doc | --do)+    ac_prev=docdir ;;+  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)+    docdir=$ac_optarg ;;++  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)+    ac_prev=dvidir ;;+  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)+    dvidir=$ac_optarg ;;++  -enable-* | --enable-*)+    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid feature name: $ac_useropt"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"enable_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval enable_$ac_useropt=\$ac_optarg ;;++  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \+  | --exec | --exe | --ex)+    ac_prev=exec_prefix ;;+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \+  | --exec=* | --exe=* | --ex=*)+    exec_prefix=$ac_optarg ;;++  -gas | --gas | --ga | --g)+    # Obsolete; use --with-gas.+    with_gas=yes ;;++  -help | --help | --hel | --he | -h)+    ac_init_help=long ;;+  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)+    ac_init_help=recursive ;;+  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)+    ac_init_help=short ;;++  -host | --host | --hos | --ho)+    ac_prev=host_alias ;;+  -host=* | --host=* | --hos=* | --ho=*)+    host_alias=$ac_optarg ;;++  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)+    ac_prev=htmldir ;;+  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \+  | --ht=*)+    htmldir=$ac_optarg ;;++  -includedir | --includedir | --includedi | --included | --include \+  | --includ | --inclu | --incl | --inc)+    ac_prev=includedir ;;+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \+  | --includ=* | --inclu=* | --incl=* | --inc=*)+    includedir=$ac_optarg ;;++  -infodir | --infodir | --infodi | --infod | --info | --inf)+    ac_prev=infodir ;;+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)+    infodir=$ac_optarg ;;++  -libdir | --libdir | --libdi | --libd)+    ac_prev=libdir ;;+  -libdir=* | --libdir=* | --libdi=* | --libd=*)+    libdir=$ac_optarg ;;++  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \+  | --libexe | --libex | --libe)+    ac_prev=libexecdir ;;+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \+  | --libexe=* | --libex=* | --libe=*)+    libexecdir=$ac_optarg ;;++  -localedir | --localedir | --localedi | --localed | --locale)+    ac_prev=localedir ;;+  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)+    localedir=$ac_optarg ;;++  -localstatedir | --localstatedir | --localstatedi | --localstated \+  | --localstate | --localstat | --localsta | --localst | --locals)+    ac_prev=localstatedir ;;+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \+  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)+    localstatedir=$ac_optarg ;;++  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)+    ac_prev=mandir ;;+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)+    mandir=$ac_optarg ;;++  -nfp | --nfp | --nf)+    # Obsolete; use --without-fp.+    with_fp=no ;;++  -no-create | --no-create | --no-creat | --no-crea | --no-cre \+  | --no-cr | --no-c | -n)+    no_create=yes ;;++  -no-recursion | --no-recursion | --no-recursio | --no-recursi \+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)+    no_recursion=yes ;;++  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \+  | --oldin | --oldi | --old | --ol | --o)+    ac_prev=oldincludedir ;;+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)+    oldincludedir=$ac_optarg ;;++  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)+    ac_prev=prefix ;;+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)+    prefix=$ac_optarg ;;++  -program-prefix | --program-prefix | --program-prefi | --program-pref \+  | --program-pre | --program-pr | --program-p)+    ac_prev=program_prefix ;;+  -program-prefix=* | --program-prefix=* | --program-prefi=* \+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)+    program_prefix=$ac_optarg ;;++  -program-suffix | --program-suffix | --program-suffi | --program-suff \+  | --program-suf | --program-su | --program-s)+    ac_prev=program_suffix ;;+  -program-suffix=* | --program-suffix=* | --program-suffi=* \+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)+    program_suffix=$ac_optarg ;;++  -program-transform-name | --program-transform-name \+  | --program-transform-nam | --program-transform-na \+  | --program-transform-n | --program-transform- \+  | --program-transform | --program-transfor \+  | --program-transfo | --program-transf \+  | --program-trans | --program-tran \+  | --progr-tra | --program-tr | --program-t)+    ac_prev=program_transform_name ;;+  -program-transform-name=* | --program-transform-name=* \+  | --program-transform-nam=* | --program-transform-na=* \+  | --program-transform-n=* | --program-transform-=* \+  | --program-transform=* | --program-transfor=* \+  | --program-transfo=* | --program-transf=* \+  | --program-trans=* | --program-tran=* \+  | --progr-tra=* | --program-tr=* | --program-t=*)+    program_transform_name=$ac_optarg ;;++  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)+    ac_prev=pdfdir ;;+  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)+    pdfdir=$ac_optarg ;;++  -psdir | --psdir | --psdi | --psd | --ps)+    ac_prev=psdir ;;+  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)+    psdir=$ac_optarg ;;++  -q | -quiet | --quiet | --quie | --qui | --qu | --q \+  | -silent | --silent | --silen | --sile | --sil)+    silent=yes ;;++  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)+    ac_prev=sbindir ;;+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \+  | --sbi=* | --sb=*)+    sbindir=$ac_optarg ;;++  -sharedstatedir | --sharedstatedir | --sharedstatedi \+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \+  | --sharedst | --shareds | --shared | --share | --shar \+  | --sha | --sh)+    ac_prev=sharedstatedir ;;+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \+  | --sha=* | --sh=*)+    sharedstatedir=$ac_optarg ;;++  -site | --site | --sit)+    ac_prev=site ;;+  -site=* | --site=* | --sit=*)+    site=$ac_optarg ;;++  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)+    ac_prev=srcdir ;;+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)+    srcdir=$ac_optarg ;;++  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \+  | --syscon | --sysco | --sysc | --sys | --sy)+    ac_prev=sysconfdir ;;+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)+    sysconfdir=$ac_optarg ;;++  -target | --target | --targe | --targ | --tar | --ta | --t)+    ac_prev=target_alias ;;+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)+    target_alias=$ac_optarg ;;++  -v | -verbose | --verbose | --verbos | --verbo | --verb)+    verbose=yes ;;++  -version | --version | --versio | --versi | --vers | -V)+    ac_init_version=: ;;++  -with-* | --with-*)+    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid package name: $ac_useropt"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"with_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval with_$ac_useropt=\$ac_optarg ;;++  -without-* | --without-*)+    ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid package name: $ac_useropt"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"with_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval with_$ac_useropt=no ;;++  --x)+    # Obsolete; use --with-x.+    with_x=yes ;;++  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \+  | --x-incl | --x-inc | --x-in | --x-i)+    ac_prev=x_includes ;;+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)+    x_includes=$ac_optarg ;;++  -x-libraries | --x-libraries | --x-librarie | --x-librari \+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)+    ac_prev=x_libraries ;;+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)+    x_libraries=$ac_optarg ;;++  -*) as_fn_error $? "unrecognized option: \`$ac_option'+Try \`$0 --help' for more information"+    ;;++  *=*)+    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`+    # Reject names that are not valid shell variable names.+    case $ac_envvar in #(+      '' | [0-9]* | *[!_$as_cr_alnum]* )+      as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;+    esac+    eval $ac_envvar=\$ac_optarg+    export $ac_envvar ;;++  *)+    # FIXME: should be removed in autoconf 3.0.+    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2+    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&+      $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2+    : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"+    ;;++  esac+done++if test -n "$ac_prev"; then+  ac_option=--`echo $ac_prev | sed 's/_/-/g'`+  as_fn_error $? "missing argument to $ac_option"+fi++if test -n "$ac_unrecognized_opts"; then+  case $enable_option_checking in+    no) ;;+    fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;+    *)     $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;+  esac+fi++# Check all directory arguments for consistency.+for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \+		datadir sysconfdir sharedstatedir localstatedir includedir \+		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \+		libdir localedir mandir+do+  eval ac_val=\$$ac_var+  # Remove trailing slashes.+  case $ac_val in+    */ )+      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`+      eval $ac_var=\$ac_val;;+  esac+  # Be sure to have absolute directory names.+  case $ac_val in+    [\\/$]* | ?:[\\/]* )  continue;;+    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;+  esac+  as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"+done++# There might be people who depend on the old broken behavior: `$host'+# used to hold the argument of --host etc.+# FIXME: To remove some day.+build=$build_alias+host=$host_alias+target=$target_alias++# FIXME: To remove some day.+if test "x$host_alias" != x; then+  if test "x$build_alias" = x; then+    cross_compiling=maybe+    $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host.+    If a cross compiler is detected then cross compile mode will be used" >&2+  elif test "x$build_alias" != "x$host_alias"; then+    cross_compiling=yes+  fi+fi++ac_tool_prefix=+test -n "$host_alias" && ac_tool_prefix=$host_alias-++test "$silent" = yes && exec 6>/dev/null+++ac_pwd=`pwd` && test -n "$ac_pwd" &&+ac_ls_di=`ls -di .` &&+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||+  as_fn_error $? "working directory cannot be determined"+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||+  as_fn_error $? "pwd does not report name of working directory"+++# Find the source files, if location was not specified.+if test -z "$srcdir"; then+  ac_srcdir_defaulted=yes+  # Try the directory containing this script, then the parent directory.+  ac_confdir=`$as_dirname -- "$as_myself" ||+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_myself" : 'X\(//\)[^/]' \| \+	 X"$as_myself" : 'X\(//\)$' \| \+	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$as_myself" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+  srcdir=$ac_confdir+  if test ! -r "$srcdir/$ac_unique_file"; then+    srcdir=..+  fi+else+  ac_srcdir_defaulted=no+fi+if test ! -r "$srcdir/$ac_unique_file"; then+  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."+  as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"+fi+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"+ac_abs_confdir=`(+	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"+	pwd)`+# When building in place, set srcdir=.+if test "$ac_abs_confdir" = "$ac_pwd"; then+  srcdir=.+fi+# Remove unnecessary trailing slashes from srcdir.+# Double slashes in file names in object file debugging info+# mess up M-x gdb in Emacs.+case $srcdir in+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;+esac+for ac_var in $ac_precious_vars; do+  eval ac_env_${ac_var}_set=\${${ac_var}+set}+  eval ac_env_${ac_var}_value=\$${ac_var}+  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}+  eval ac_cv_env_${ac_var}_value=\$${ac_var}+done++#+# Report the --help message.+#+if test "$ac_init_help" = "long"; then+  # Omit some internal or obsolete options to make the list less imposing.+  # This message is too long to be a string in the A/UX 3.1 sh.+  cat <<_ACEOF+\`configure' configures ginsu 0.8.0 to adapt to many kinds of systems.++Usage: $0 [OPTION]... [VAR=VALUE]...++To assign environment variables (e.g., CC, CFLAGS...), specify them as+VAR=VALUE.  See below for descriptions of some of the useful variables.++Defaults for the options are specified in brackets.++Configuration:+  -h, --help              display this help and exit+      --help=short        display options specific to this package+      --help=recursive    display the short help of all the included packages+  -V, --version           display version information and exit+  -q, --quiet, --silent   do not print \`checking ...' messages+      --cache-file=FILE   cache test results in FILE [disabled]+  -C, --config-cache      alias for \`--cache-file=config.cache'+  -n, --no-create         do not create output files+      --srcdir=DIR        find the sources in DIR [configure dir or \`..']++Installation directories:+  --prefix=PREFIX         install architecture-independent files in PREFIX+                          [$ac_default_prefix]+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX+                          [PREFIX]++By default, \`make install' will install all the files in+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify+an installation prefix other than \`$ac_default_prefix' using \`--prefix',+for instance \`--prefix=\$HOME'.++For better control, use the options below.++Fine tuning of the installation directories:+  --bindir=DIR            user executables [EPREFIX/bin]+  --sbindir=DIR           system admin executables [EPREFIX/sbin]+  --libexecdir=DIR        program executables [EPREFIX/libexec]+  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]+  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]+  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]+  --libdir=DIR            object code libraries [EPREFIX/lib]+  --includedir=DIR        C header files [PREFIX/include]+  --oldincludedir=DIR     C header files for non-gcc [/usr/include]+  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]+  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]+  --infodir=DIR           info documentation [DATAROOTDIR/info]+  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]+  --mandir=DIR            man documentation [DATAROOTDIR/man]+  --docdir=DIR            documentation root [DATAROOTDIR/doc/ginsu]+  --htmldir=DIR           html documentation [DOCDIR]+  --dvidir=DIR            dvi documentation [DOCDIR]+  --pdfdir=DIR            pdf documentation [DOCDIR]+  --psdir=DIR             ps documentation [DOCDIR]+_ACEOF++  cat <<\_ACEOF+_ACEOF+fi++if test -n "$ac_init_help"; then+  case $ac_init_help in+     short | recursive ) echo "Configuration of ginsu 0.8.0:";;+   esac+  cat <<\_ACEOF++Optional Packages:+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)+  --with-compiler=HC      use specified haskell compiler (ignored)+  --with-gcc=CC           use specified C compiler (ignored)++Some influential environment variables:+  CC          C compiler command+  CFLAGS      C compiler flags+  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a+              nonstandard directory <lib dir>+  LIBS        libraries to pass to the linker, e.g. -l<library>+  CPPFLAGS    (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if+              you have headers in a nonstandard directory <include dir>+  CPP         C preprocessor++Use these variables to override the choices made by `configure' or to help+it to find libraries and programs with nonstandard names/locations.++Report bugs to the package provider.+_ACEOF+ac_status=$?+fi++if test "$ac_init_help" = "recursive"; then+  # If there are subdirs, report their specific --help.+  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue+    test -d "$ac_dir" ||+      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||+      continue+    ac_builddir=.++case "$ac_dir" in+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;+*)+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`+  # A ".." for each directory in $ac_dir_suffix.+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`+  case $ac_top_builddir_sub in+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;+  esac ;;+esac+ac_abs_top_builddir=$ac_pwd+ac_abs_builddir=$ac_pwd$ac_dir_suffix+# for backward compatibility:+ac_top_builddir=$ac_top_build_prefix++case $srcdir in+  .)  # We are building in place.+    ac_srcdir=.+    ac_top_srcdir=$ac_top_builddir_sub+    ac_abs_top_srcdir=$ac_pwd ;;+  [\\/]* | ?:[\\/]* )  # Absolute name.+    ac_srcdir=$srcdir$ac_dir_suffix;+    ac_top_srcdir=$srcdir+    ac_abs_top_srcdir=$srcdir ;;+  *) # Relative name.+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix+    ac_top_srcdir=$ac_top_build_prefix$srcdir+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;+esac+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix++    cd "$ac_dir" || { ac_status=$?; continue; }+    # Check for guested configure.+    if test -f "$ac_srcdir/configure.gnu"; then+      echo &&+      $SHELL "$ac_srcdir/configure.gnu" --help=recursive+    elif test -f "$ac_srcdir/configure"; then+      echo &&+      $SHELL "$ac_srcdir/configure" --help=recursive+    else+      $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2+    fi || ac_status=$?+    cd "$ac_pwd" || { ac_status=$?; break; }+  done+fi++test -n "$ac_init_help" && exit $ac_status+if $ac_init_version; then+  cat <<\_ACEOF+ginsu configure 0.8.0+generated by GNU Autoconf 2.68++Copyright (C) 2010 Free Software Foundation, Inc.+This configure script is free software; the Free Software Foundation+gives unlimited permission to copy, distribute and modify it.+_ACEOF+  exit+fi++## ------------------------ ##+## Autoconf initialization. ##+## ------------------------ ##++# ac_fn_c_try_compile LINENO+# --------------------------+# Try to compile conftest.$ac_ext, and return whether this succeeded.+ac_fn_c_try_compile ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  rm -f conftest.$ac_objext+  if { { ac_try="$ac_compile"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_compile") 2>conftest.err+  ac_status=$?+  if test -s conftest.err; then+    grep -v '^ *+' conftest.err >conftest.er1+    cat conftest.er1 >&5+    mv -f conftest.er1 conftest.err+  fi+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest.$ac_objext; then :+  ac_retval=0+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	ac_retval=1+fi+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno+  as_fn_set_status $ac_retval++} # ac_fn_c_try_compile++# ac_fn_c_try_link LINENO+# -----------------------+# Try to link conftest.$ac_ext, and return whether this succeeded.+ac_fn_c_try_link ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  rm -f conftest.$ac_objext conftest$ac_exeext+  if { { ac_try="$ac_link"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_link") 2>conftest.err+  ac_status=$?+  if test -s conftest.err; then+    grep -v '^ *+' conftest.err >conftest.er1+    cat conftest.er1 >&5+    mv -f conftest.er1 conftest.err+  fi+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 $as_test_x conftest$ac_exeext+       }; then :+  ac_retval=0+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	ac_retval=1+fi+  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information+  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would+  # interfere with the next link command; also delete a directory that is+  # left behind by Apple's compiler.  We do this before executing the actions.+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno+  as_fn_set_status $ac_retval++} # ac_fn_c_try_link++# ac_fn_c_try_cpp LINENO+# ----------------------+# Try to preprocess conftest.$ac_ext, and return whether this succeeded.+ac_fn_c_try_cpp ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  if { { ac_try="$ac_cpp conftest.$ac_ext"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err+  ac_status=$?+  if test -s conftest.err; then+    grep -v '^ *+' conftest.err >conftest.er1+    cat conftest.er1 >&5+    mv -f conftest.er1 conftest.err+  fi+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; } > conftest.i && {+	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||+	 test ! -s conftest.err+       }; then :+  ac_retval=0+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++    ac_retval=1+fi+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno+  as_fn_set_status $ac_retval++} # ac_fn_c_try_cpp++# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES+# -------------------------------------------------------+# Tests whether HEADER exists, giving a warning if it cannot be compiled using+# the include files in INCLUDES and setting the cache variable VAR+# accordingly.+ac_fn_c_check_header_mongrel ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  if eval \${$3+:} false; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5+$as_echo_n "checking for $2... " >&6; }+if eval \${$3+:} false; then :+  $as_echo_n "(cached) " >&6+fi+eval ac_res=\$$3+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+else+  # Is the header compilable?+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5+$as_echo_n "checking $2 usability... " >&6; }+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+$4+#include <$2>+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  ac_header_compiler=yes+else+  ac_header_compiler=no+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5+$as_echo "$ac_header_compiler" >&6; }++# Is the header present?+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5+$as_echo_n "checking $2 presence... " >&6; }+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <$2>+_ACEOF+if ac_fn_c_try_cpp "$LINENO"; then :+  ac_header_preproc=yes+else+  ac_header_preproc=no+fi+rm -f conftest.err conftest.i conftest.$ac_ext+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5+$as_echo "$ac_header_preproc" >&6; }++# So?  What about this header?+case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #((+  yes:no: )+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5+$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;}+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5+$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}+    ;;+  no:yes:* )+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5+$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;}+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     check for missing prerequisite headers?" >&5+$as_echo "$as_me: WARNING: $2:     check for missing prerequisite headers?" >&2;}+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5+$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;}+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&5+$as_echo "$as_me: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&2;}+    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5+$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}+    ;;+esac+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5+$as_echo_n "checking for $2... " >&6; }+if eval \${$3+:} false; then :+  $as_echo_n "(cached) " >&6+else+  eval "$3=\$ac_header_compiler"+fi+eval ac_res=\$$3+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+fi+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno++} # ac_fn_c_check_header_mongrel++# ac_fn_c_try_run LINENO+# ----------------------+# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes+# that executables *can* be run.+ac_fn_c_try_run ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  if { { ac_try="$ac_link"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_link") 2>&5+  ac_status=$?+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'+  { { case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_try") 2>&5+  ac_status=$?+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }; }; then :+  ac_retval=0+else+  $as_echo "$as_me: program exited with status $ac_status" >&5+       $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++       ac_retval=$ac_status+fi+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno+  as_fn_set_status $ac_retval++} # ac_fn_c_try_run++# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES+# -------------------------------------------------------+# Tests whether HEADER exists and can be compiled using the include files in+# INCLUDES, setting the cache variable VAR accordingly.+ac_fn_c_check_header_compile ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5+$as_echo_n "checking for $2... " >&6; }+if eval \${$3+:} false; then :+  $as_echo_n "(cached) " >&6+else+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+$4+#include <$2>+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  eval "$3=yes"+else+  eval "$3=no"+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+fi+eval ac_res=\$$3+	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5+$as_echo "$ac_res" >&6; }+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno++} # ac_fn_c_check_header_compile+cat >config.log <<_ACEOF+This file contains any messages produced by compilers while+running configure, to aid debugging if configure makes a mistake.++It was created by ginsu $as_me 0.8.0, which was+generated by GNU Autoconf 2.68.  Invocation command line was++  $ $0 $@++_ACEOF+exec 5>>config.log+{+cat <<_ASUNAME+## --------- ##+## Platform. ##+## --------- ##++hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`+uname -m = `(uname -m) 2>/dev/null || echo unknown`+uname -r = `(uname -r) 2>/dev/null || echo unknown`+uname -s = `(uname -s) 2>/dev/null || echo unknown`+uname -v = `(uname -v) 2>/dev/null || echo unknown`++/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`++/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`+/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`+/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`+/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`++_ASUNAME++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    $as_echo "PATH: $as_dir"+  done+IFS=$as_save_IFS++} >&5++cat >&5 <<_ACEOF+++## ----------- ##+## Core tests. ##+## ----------- ##++_ACEOF+++# Keep a trace of the command line.+# Strip out --no-create and --no-recursion so they do not pile up.+# Strip out --silent because we don't want to record it for future runs.+# Also quote any args containing shell meta-characters.+# Make two passes to allow for proper duplicate-argument suppression.+ac_configure_args=+ac_configure_args0=+ac_configure_args1=+ac_must_keep_next=false+for ac_pass in 1 2+do+  for ac_arg+  do+    case $ac_arg in+    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;+    -q | -quiet | --quiet | --quie | --qui | --qu | --q \+    | -silent | --silent | --silen | --sile | --sil)+      continue ;;+    *\'*)+      ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;+    esac+    case $ac_pass in+    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;+    2)+      as_fn_append ac_configure_args1 " '$ac_arg'"+      if test $ac_must_keep_next = true; then+	ac_must_keep_next=false # Got value, back to normal.+      else+	case $ac_arg in+	  *=* | --config-cache | -C | -disable-* | --disable-* \+	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \+	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \+	  | -with-* | --with-* | -without-* | --without-* | --x)+	    case "$ac_configure_args0 " in+	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;+	    esac+	    ;;+	  -* ) ac_must_keep_next=true ;;+	esac+      fi+      as_fn_append ac_configure_args " '$ac_arg'"+      ;;+    esac+  done+done+{ ac_configure_args0=; unset ac_configure_args0;}+{ ac_configure_args1=; unset ac_configure_args1;}++# When interrupted or exit'd, cleanup temporary files, and complete+# config.log.  We remove comments because anyway the quotes in there+# would cause problems or look ugly.+# WARNING: Use '\'' to represent an apostrophe within the trap.+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.+trap 'exit_status=$?+  # Save into config.log some information that might help in debugging.+  {+    echo++    $as_echo "## ---------------- ##+## Cache variables. ##+## ---------------- ##"+    echo+    # The following way of writing the cache mishandles newlines in values,+(+  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do+    eval ac_val=\$$ac_var+    case $ac_val in #(+    *${as_nl}*)+      case $ac_var in #(+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;+      esac+      case $ac_var in #(+      _ | IFS | as_nl) ;; #(+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(+      *) { eval $ac_var=; unset $ac_var;} ;;+      esac ;;+    esac+  done+  (set) 2>&1 |+    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(+    *${as_nl}ac_space=\ *)+      sed -n \+	"s/'\''/'\''\\\\'\'''\''/g;+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"+      ;; #(+    *)+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"+      ;;+    esac |+    sort+)+    echo++    $as_echo "## ----------------- ##+## Output variables. ##+## ----------------- ##"+    echo+    for ac_var in $ac_subst_vars+    do+      eval ac_val=\$$ac_var+      case $ac_val in+      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;+      esac+      $as_echo "$ac_var='\''$ac_val'\''"+    done | sort+    echo++    if test -n "$ac_subst_files"; then+      $as_echo "## ------------------- ##+## File substitutions. ##+## ------------------- ##"+      echo+      for ac_var in $ac_subst_files+      do+	eval ac_val=\$$ac_var+	case $ac_val in+	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;+	esac+	$as_echo "$ac_var='\''$ac_val'\''"+      done | sort+      echo+    fi++    if test -s confdefs.h; then+      $as_echo "## ----------- ##+## confdefs.h. ##+## ----------- ##"+      echo+      cat confdefs.h+      echo+    fi+    test "$ac_signal" != 0 &&+      $as_echo "$as_me: caught signal $ac_signal"+    $as_echo "$as_me: exit $exit_status"+  } >&5+  rm -f core *.core core.conftest.* &&+    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&+    exit $exit_status+' 0+for ac_signal in 1 2 13 15; do+  trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal+done+ac_signal=0++# confdefs.h avoids OS command line length limits that DEFS can exceed.+rm -f -r conftest* confdefs.h++$as_echo "/* confdefs.h */" > confdefs.h++# Predefined preprocessor variables.++cat >>confdefs.h <<_ACEOF+#define PACKAGE_NAME "$PACKAGE_NAME"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_VERSION "$PACKAGE_VERSION"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_STRING "$PACKAGE_STRING"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"+_ACEOF++cat >>confdefs.h <<_ACEOF+#define PACKAGE_URL "$PACKAGE_URL"+_ACEOF+++# Let the site file select an alternate cache file if it wants to.+# Prefer an explicitly selected file to automatically selected ones.+ac_site_file1=NONE+ac_site_file2=NONE+if test -n "$CONFIG_SITE"; then+  # We do not want a PATH search for config.site.+  case $CONFIG_SITE in #((+    -*)  ac_site_file1=./$CONFIG_SITE;;+    */*) ac_site_file1=$CONFIG_SITE;;+    *)   ac_site_file1=./$CONFIG_SITE;;+  esac+elif test "x$prefix" != xNONE; then+  ac_site_file1=$prefix/share/config.site+  ac_site_file2=$prefix/etc/config.site+else+  ac_site_file1=$ac_default_prefix/share/config.site+  ac_site_file2=$ac_default_prefix/etc/config.site+fi+for ac_site_file in "$ac_site_file1" "$ac_site_file2"+do+  test "x$ac_site_file" = xNONE && continue+  if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5+$as_echo "$as_me: loading site script $ac_site_file" >&6;}+    sed 's/^/| /' "$ac_site_file" >&5+    . "$ac_site_file" \+      || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "failed to load site script $ac_site_file+See \`config.log' for more details" "$LINENO" 5; }+  fi+done++if test -r "$cache_file"; then+  # Some versions of bash will fail to source /dev/null (special files+  # actually), so we avoid doing that.  DJGPP emulates it as a regular file.+  if test /dev/null != "$cache_file" && test -f "$cache_file"; then+    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5+$as_echo "$as_me: loading cache $cache_file" >&6;}+    case $cache_file in+      [\\/]* | ?:[\\/]* ) . "$cache_file";;+      *)                      . "./$cache_file";;+    esac+  fi+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5+$as_echo "$as_me: creating cache $cache_file" >&6;}+  >$cache_file+fi++# Check that the precious variables saved in the cache have kept the same+# value.+ac_cache_corrupted=false+for ac_var in $ac_precious_vars; do+  eval ac_old_set=\$ac_cv_env_${ac_var}_set+  eval ac_new_set=\$ac_env_${ac_var}_set+  eval ac_old_val=\$ac_cv_env_${ac_var}_value+  eval ac_new_val=\$ac_env_${ac_var}_value+  case $ac_old_set,$ac_new_set in+    set,)+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5+$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}+      ac_cache_corrupted=: ;;+    ,set)+      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5+$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}+      ac_cache_corrupted=: ;;+    ,);;+    *)+      if test "x$ac_old_val" != "x$ac_new_val"; then+	# differences in whitespace do not lead to failure.+	ac_old_val_w=`echo x $ac_old_val`+	ac_new_val_w=`echo x $ac_new_val`+	if test "$ac_old_val_w" != "$ac_new_val_w"; then+	  { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5+$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}+	  ac_cache_corrupted=:+	else+	  { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5+$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}+	  eval $ac_var=\$ac_old_val+	fi+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5+$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}+	{ $as_echo "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5+$as_echo "$as_me:   current value: \`$ac_new_val'" >&2;}+      fi;;+  esac+  # Pass precious variables to config.status.+  if test "$ac_new_set" = set; then+    case $ac_new_val in+    *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;+    *) ac_arg=$ac_var=$ac_new_val ;;+    esac+    case " $ac_configure_args " in+      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.+      *) as_fn_append ac_configure_args " '$ac_arg'" ;;+    esac+  fi+done+if $ac_cache_corrupted; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+  { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5+$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}+  as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5+fi+## -------------------- ##+## Main body of script. ##+## -------------------- ##++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu++++++# Check whether --with-compiler was given.+if test "${with_compiler+set}" = set; then :+  withval=$with_compiler;+fi+++# Check whether --with-gcc was given.+if test "${with_gcc+set}" = set; then :+  withval=$with_gcc;+fi+++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu+if test -n "$ac_tool_prefix"; then+  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.+set dummy ${ac_tool_prefix}gcc; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_CC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_CC="${ac_tool_prefix}gcc"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+$as_echo "$CC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++fi+if test -z "$ac_cv_prog_CC"; then+  ac_ct_CC=$CC+  # Extract the first word of "gcc", so it can be a program name with args.+set dummy gcc; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_ac_ct_CC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$ac_ct_CC"; then+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_ac_ct_CC="gcc"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+ac_ct_CC=$ac_cv_prog_ac_ct_CC+if test -n "$ac_ct_CC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5+$as_echo "$ac_ct_CC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi++  if test "x$ac_ct_CC" = x; then+    CC=""+  else+    case $cross_compiling:$ac_tool_warned in+yes:)+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}+ac_tool_warned=yes ;;+esac+    CC=$ac_ct_CC+  fi+else+  CC="$ac_cv_prog_CC"+fi++if test -z "$CC"; then+          if test -n "$ac_tool_prefix"; then+    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.+set dummy ${ac_tool_prefix}cc; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_CC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_CC="${ac_tool_prefix}cc"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+$as_echo "$CC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++  fi+fi+if test -z "$CC"; then+  # Extract the first word of "cc", so it can be a program name with args.+set dummy cc; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_CC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+  ac_prog_rejected=no+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then+       ac_prog_rejected=yes+       continue+     fi+    ac_cv_prog_CC="cc"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++if test $ac_prog_rejected = yes; then+  # We found a bogon in the path, so make sure we never use it.+  set dummy $ac_cv_prog_CC+  shift+  if test $# != 0; then+    # We chose a different compiler from the bogus one.+    # However, it has the same basename, so the bogon will be chosen+    # first if we set CC to just the basename; use the full file name.+    shift+    ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"+  fi+fi+fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+$as_echo "$CC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++fi+if test -z "$CC"; then+  if test -n "$ac_tool_prefix"; then+  for ac_prog in cl.exe+  do+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.+set dummy $ac_tool_prefix$ac_prog; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_CC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+$as_echo "$CC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++    test -n "$CC" && break+  done+fi+if test -z "$CC"; then+  ac_ct_CC=$CC+  for ac_prog in cl.exe+do+  # Extract the first word of "$ac_prog", so it can be a program name with args.+set dummy $ac_prog; ac_word=$2+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+$as_echo_n "checking for $ac_word... " >&6; }+if ${ac_cv_prog_ac_ct_CC+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -n "$ac_ct_CC"; then+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_exec_ext in '' $ac_executable_extensions; do+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then+    ac_cv_prog_ac_ct_CC="$ac_prog"+    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+ac_ct_CC=$ac_cv_prog_ac_ct_CC+if test -n "$ac_ct_CC"; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5+$as_echo "$ac_ct_CC" >&6; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+fi+++  test -n "$ac_ct_CC" && break+done++  if test "x$ac_ct_CC" = x; then+    CC=""+  else+    case $cross_compiling:$ac_tool_warned in+yes:)+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}+ac_tool_warned=yes ;;+esac+    CC=$ac_ct_CC+  fi+fi++fi+++test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "no acceptable C compiler found in \$PATH+See \`config.log' for more details" "$LINENO" 5; }++# Provide some information about the compiler.+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5+set X $ac_compile+ac_compiler=$2+for ac_option in --version -v -V -qversion; do+  { { ac_try="$ac_compiler $ac_option >&5"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_compiler $ac_option >&5") 2>conftest.err+  ac_status=$?+  if test -s conftest.err; then+    sed '10a\+... rest of stderr output deleted ...+         10q' conftest.err >conftest.er1+    cat conftest.er1 >&5+  fi+  rm -f conftest.er1 conftest.err+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }+done++cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+ac_clean_files_save=$ac_clean_files+ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"+# Try to create an executable without -o first, disregard a.out.+# It will help us diagnose broken compilers, and finding out an intuition+# of exeext.+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5+$as_echo_n "checking whether the C compiler works... " >&6; }+ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`++# The possible output files:+ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"++ac_rmfiles=+for ac_file in $ac_files+do+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;+    * ) ac_rmfiles="$ac_rmfiles $ac_file";;+  esac+done+rm -f $ac_rmfiles++if { { ac_try="$ac_link_default"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_link_default") 2>&5+  ac_status=$?+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }; then :+  # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.+# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'+# in a Makefile.  We should not override ac_cv_exeext if it was cached,+# so that the user can short-circuit this test for compilers unknown to+# Autoconf.+for ac_file in $ac_files ''+do+  test -f "$ac_file" || continue+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )+	;;+    [ab].out )+	# We found the default executable, but exeext='' is most+	# certainly right.+	break;;+    *.* )+	if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;+	then :; else+	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`+	fi+	# We set ac_cv_exeext here because the later test for it is not+	# safe: cross compilers may not add the suffix if given an `-o'+	# argument, so we may need to know it at that point already.+	# Even if this section looks crufty: it has the advantage of+	# actually working.+	break;;+    * )+	break;;+  esac+done+test "$ac_cv_exeext" = no && ac_cv_exeext=++else+  ac_file=''+fi+if test -z "$ac_file"; then :+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5+$as_echo "no" >&6; }+$as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error 77 "C compiler cannot create executables+See \`config.log' for more details" "$LINENO" 5; }+else+  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5+$as_echo "yes" >&6; }+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5+$as_echo_n "checking for C compiler default output file name... " >&6; }+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5+$as_echo "$ac_file" >&6; }+ac_exeext=$ac_cv_exeext++rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out+ac_clean_files=$ac_clean_files_save+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5+$as_echo_n "checking for suffix of executables... " >&6; }+if { { ac_try="$ac_link"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_link") 2>&5+  ac_status=$?+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }; then :+  # If both `conftest.exe' and `conftest' are `present' (well, observable)+# catch `conftest.exe'.  For instance with Cygwin, `ls conftest' will+# work properly (i.e., refer to `conftest.exe'), while it won't with+# `rm'.+for ac_file in conftest.exe conftest conftest.*; do+  test -f "$ac_file" || continue+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;+    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`+	  break;;+    * ) break;;+  esac+done+else+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "cannot compute suffix of executables: cannot compile and link+See \`config.log' for more details" "$LINENO" 5; }+fi+rm -f conftest conftest$ac_cv_exeext+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5+$as_echo "$ac_cv_exeext" >&6; }++rm -f conftest.$ac_ext+EXEEXT=$ac_cv_exeext+ac_exeext=$EXEEXT+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <stdio.h>+int+main ()+{+FILE *f = fopen ("conftest.out", "w");+ return ferror (f) || fclose (f) != 0;++  ;+  return 0;+}+_ACEOF+ac_clean_files="$ac_clean_files conftest.out"+# Check that the compiler produces executables we can run.  If not, either+# the compiler is broken, or we cross compile.+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5+$as_echo_n "checking whether we are cross compiling... " >&6; }+if test "$cross_compiling" != yes; then+  { { ac_try="$ac_link"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_link") 2>&5+  ac_status=$?+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }+  if { ac_try='./conftest$ac_cv_exeext'+  { { case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_try") 2>&5+  ac_status=$?+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }; }; then+    cross_compiling=no+  else+    if test "$cross_compiling" = maybe; then+	cross_compiling=yes+    else+	{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "cannot run C compiled programs.+If you meant to cross compile, use \`--host'.+See \`config.log' for more details" "$LINENO" 5; }+    fi+  fi+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5+$as_echo "$cross_compiling" >&6; }++rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out+ac_clean_files=$ac_clean_files_save+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5+$as_echo_n "checking for suffix of object files... " >&6; }+if ${ac_cv_objext+:} false; then :+  $as_echo_n "(cached) " >&6+else+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+rm -f conftest.o conftest.obj+if { { ac_try="$ac_compile"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+$as_echo "$ac_try_echo"; } >&5+  (eval "$ac_compile") 2>&5+  ac_status=$?+  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }; then :+  for ac_file in conftest.o conftest.obj conftest.*; do+  test -f "$ac_file" || continue;+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;+    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`+       break;;+  esac+done+else+  $as_echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "cannot compute suffix of object files: cannot compile+See \`config.log' for more details" "$LINENO" 5; }+fi+rm -f conftest.$ac_cv_objext conftest.$ac_ext+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5+$as_echo "$ac_cv_objext" >&6; }+OBJEXT=$ac_cv_objext+ac_objext=$OBJEXT+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5+$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }+if ${ac_cv_c_compiler_gnu+:} false; then :+  $as_echo_n "(cached) " >&6+else+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main ()+{+#ifndef __GNUC__+       choke me+#endif++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  ac_compiler_gnu=yes+else+  ac_compiler_gnu=no+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+ac_cv_c_compiler_gnu=$ac_compiler_gnu++fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5+$as_echo "$ac_cv_c_compiler_gnu" >&6; }+if test $ac_compiler_gnu = yes; then+  GCC=yes+else+  GCC=+fi+ac_test_CFLAGS=${CFLAGS+set}+ac_save_CFLAGS=$CFLAGS+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5+$as_echo_n "checking whether $CC accepts -g... " >&6; }+if ${ac_cv_prog_cc_g+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_save_c_werror_flag=$ac_c_werror_flag+   ac_c_werror_flag=yes+   ac_cv_prog_cc_g=no+   CFLAGS="-g"+   cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  ac_cv_prog_cc_g=yes+else+  CFLAGS=""+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :++else+  ac_c_werror_flag=$ac_save_c_werror_flag+	 CFLAGS="-g"+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  ac_cv_prog_cc_g=yes+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext+   ac_c_werror_flag=$ac_save_c_werror_flag+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5+$as_echo "$ac_cv_prog_cc_g" >&6; }+if test "$ac_test_CFLAGS" = set; then+  CFLAGS=$ac_save_CFLAGS+elif test $ac_cv_prog_cc_g = yes; then+  if test "$GCC" = yes; then+    CFLAGS="-g -O2"+  else+    CFLAGS="-g"+  fi+else+  if test "$GCC" = yes; then+    CFLAGS="-O2"+  else+    CFLAGS=+  fi+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5+$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }+if ${ac_cv_prog_cc_c89+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_cv_prog_cc_c89=no+ac_save_CC=$CC+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <stdarg.h>+#include <stdio.h>+#include <sys/types.h>+#include <sys/stat.h>+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */+struct buf { int x; };+FILE * (*rcsopen) (struct buf *, struct stat *, int);+static char *e (p, i)+     char **p;+     int i;+{+  return p[i];+}+static char *f (char * (*g) (char **, int), char **p, ...)+{+  char *s;+  va_list v;+  va_start (v,p);+  s = g (p, va_arg (v,int));+  va_end (v);+  return s;+}++/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has+   function prototypes and stuff, but not '\xHH' hex character constants.+   These don't provoke an error unfortunately, instead are silently treated+   as 'x'.  The following induces an error, until -std is added to get+   proper ANSI mode.  Curiously '\x00'!='x' always comes out true, for an+   array size at least.  It's necessary to write '\x00'==0 to get something+   that's true only with -std.  */+int osf4_cc_array ['\x00' == 0 ? 1 : -1];++/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters+   inside strings and character constants.  */+#define FOO(x) 'x'+int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];++int test (int i, double x);+struct s1 {int (*f) (int a);};+struct s2 {int (*f) (double a);};+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);+int argc;+char **argv;+int+main ()+{+return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];+  ;+  return 0;+}+_ACEOF+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \+	-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"+do+  CC="$ac_save_CC $ac_arg"+  if ac_fn_c_try_compile "$LINENO"; then :+  ac_cv_prog_cc_c89=$ac_arg+fi+rm -f core conftest.err conftest.$ac_objext+  test "x$ac_cv_prog_cc_c89" != "xno" && break+done+rm -f conftest.$ac_ext+CC=$ac_save_CC++fi+# AC_CACHE_VAL+case "x$ac_cv_prog_cc_c89" in+  x)+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5+$as_echo "none needed" >&6; } ;;+  xno)+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5+$as_echo "unsupported" >&6; } ;;+  *)+    CC="$CC $ac_cv_prog_cc_c89"+    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5+$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;+esac+if test "x$ac_cv_prog_cc_c89" != xno; then :++fi++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu+++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for addnstr in -lcurses" >&5+$as_echo_n "checking for addnstr in -lcurses... " >&6; }+if ${ac_cv_lib_curses_addnstr+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lcurses  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char addnstr ();+int+main ()+{+return addnstr ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_curses_addnstr=yes+else+  ac_cv_lib_curses_addnstr=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_curses_addnstr" >&5+$as_echo "$ac_cv_lib_curses_addnstr" >&6; }+if test "x$ac_cv_lib_curses_addnstr" = xyes; then :+  CURSES_LIB=curses+fi++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for addnstr in -lncurses" >&5+$as_echo_n "checking for addnstr in -lncurses... " >&6; }+if ${ac_cv_lib_ncurses_addnstr+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lncurses  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char addnstr ();+int+main ()+{+return addnstr ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_ncurses_addnstr=yes+else+  ac_cv_lib_ncurses_addnstr=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ncurses_addnstr" >&5+$as_echo "$ac_cv_lib_ncurses_addnstr" >&6; }+if test "x$ac_cv_lib_ncurses_addnstr" = xyes; then :+  CURSES_LIB=ncurses+fi++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for waddnwstr in -lncursesw" >&5+$as_echo_n "checking for waddnwstr in -lncursesw... " >&6; }+if ${ac_cv_lib_ncursesw_waddnwstr+:} false; then :+  $as_echo_n "(cached) " >&6+else+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lncursesw  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char waddnwstr ();+int+main ()+{+return waddnwstr ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"; then :+  ac_cv_lib_ncursesw_waddnwstr=yes+else+  ac_cv_lib_ncursesw_waddnwstr=no+fi+rm -f core conftest.err conftest.$ac_objext \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ncursesw_waddnwstr" >&5+$as_echo "$ac_cv_lib_ncursesw_waddnwstr" >&6; }+if test "x$ac_cv_lib_ncursesw_waddnwstr" = xyes; then :+  CURSES_LIB=ncursesw+fi+++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5+$as_echo_n "checking how to run the C preprocessor... " >&6; }+# On Suns, sometimes $CPP names a directory.+if test -n "$CPP" && test -d "$CPP"; then+  CPP=+fi+if test -z "$CPP"; then+  if ${ac_cv_prog_CPP+:} false; then :+  $as_echo_n "(cached) " >&6+else+      # Double quotes because CPP needs to be expanded+    for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"+    do+      ac_preproc_ok=false+for ac_c_preproc_warn_flag in '' yes+do+  # Use a header file that comes with gcc, so configuring glibc+  # with a fresh cross-compiler works.+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since+  # <limits.h> exists even on freestanding compilers.+  # On the NeXT, cc -E runs the code through the compiler's parser,+  # not just through cpp. "Syntax error" is here to catch this case.+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#ifdef __STDC__+# include <limits.h>+#else+# include <assert.h>+#endif+		     Syntax error+_ACEOF+if ac_fn_c_try_cpp "$LINENO"; then :++else+  # Broken: fails on valid input.+continue+fi+rm -f conftest.err conftest.i conftest.$ac_ext++  # OK, works on sane cases.  Now check whether nonexistent headers+  # can be detected and how.+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <ac_nonexistent.h>+_ACEOF+if ac_fn_c_try_cpp "$LINENO"; then :+  # Broken: success on invalid input.+continue+else+  # Passes both tests.+ac_preproc_ok=:+break+fi+rm -f conftest.err conftest.i conftest.$ac_ext++done+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.+rm -f conftest.i conftest.err conftest.$ac_ext+if $ac_preproc_ok; then :+  break+fi++    done+    ac_cv_prog_CPP=$CPP++fi+  CPP=$ac_cv_prog_CPP+else+  ac_cv_prog_CPP=$CPP+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5+$as_echo "$CPP" >&6; }+ac_preproc_ok=false+for ac_c_preproc_warn_flag in '' yes+do+  # Use a header file that comes with gcc, so configuring glibc+  # with a fresh cross-compiler works.+  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since+  # <limits.h> exists even on freestanding compilers.+  # On the NeXT, cc -E runs the code through the compiler's parser,+  # not just through cpp. "Syntax error" is here to catch this case.+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#ifdef __STDC__+# include <limits.h>+#else+# include <assert.h>+#endif+		     Syntax error+_ACEOF+if ac_fn_c_try_cpp "$LINENO"; then :++else+  # Broken: fails on valid input.+continue+fi+rm -f conftest.err conftest.i conftest.$ac_ext++  # OK, works on sane cases.  Now check whether nonexistent headers+  # can be detected and how.+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <ac_nonexistent.h>+_ACEOF+if ac_fn_c_try_cpp "$LINENO"; then :+  # Broken: success on invalid input.+continue+else+  # Passes both tests.+ac_preproc_ok=:+break+fi+rm -f conftest.err conftest.i conftest.$ac_ext++done+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.+rm -f conftest.i conftest.err conftest.$ac_ext+if $ac_preproc_ok; then :++else+  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}+as_fn_error $? "C preprocessor \"$CPP\" fails sanity check+See \`config.log' for more details" "$LINENO" 5; }+fi++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu+++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5+$as_echo_n "checking for grep that handles long lines and -e... " >&6; }+if ${ac_cv_path_GREP+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if test -z "$GREP"; then+  ac_path_GREP_found=false+  # Loop through the user's path and test for each of PROGNAME-LIST+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_prog in grep ggrep; do+    for ac_exec_ext in '' $ac_executable_extensions; do+      ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"+      { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue+# Check for GNU ac_path_GREP and select it if it is found.+  # Check for GNU $ac_path_GREP+case `"$ac_path_GREP" --version 2>&1` in+*GNU*)+  ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;+*)+  ac_count=0+  $as_echo_n 0123456789 >"conftest.in"+  while :+  do+    cat "conftest.in" "conftest.in" >"conftest.tmp"+    mv "conftest.tmp" "conftest.in"+    cp "conftest.in" "conftest.nl"+    $as_echo 'GREP' >> "conftest.nl"+    "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break+    as_fn_arith $ac_count + 1 && ac_count=$as_val+    if test $ac_count -gt ${ac_path_GREP_max-0}; then+      # Best one so far, save it but keep looking for a better one+      ac_cv_path_GREP="$ac_path_GREP"+      ac_path_GREP_max=$ac_count+    fi+    # 10*(2^10) chars as input seems more than enough+    test $ac_count -gt 10 && break+  done+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;+esac++      $ac_path_GREP_found && break 3+    done+  done+  done+IFS=$as_save_IFS+  if test -z "$ac_cv_path_GREP"; then+    as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5+  fi+else+  ac_cv_path_GREP=$GREP+fi++fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5+$as_echo "$ac_cv_path_GREP" >&6; }+ GREP="$ac_cv_path_GREP"+++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5+$as_echo_n "checking for egrep... " >&6; }+if ${ac_cv_path_EGREP+:} false; then :+  $as_echo_n "(cached) " >&6+else+  if echo a | $GREP -E '(a|b)' >/dev/null 2>&1+   then ac_cv_path_EGREP="$GREP -E"+   else+     if test -z "$EGREP"; then+  ac_path_EGREP_found=false+  # Loop through the user's path and test for each of PROGNAME-LIST+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    for ac_prog in egrep; do+    for ac_exec_ext in '' $ac_executable_extensions; do+      ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"+      { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue+# Check for GNU ac_path_EGREP and select it if it is found.+  # Check for GNU $ac_path_EGREP+case `"$ac_path_EGREP" --version 2>&1` in+*GNU*)+  ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;+*)+  ac_count=0+  $as_echo_n 0123456789 >"conftest.in"+  while :+  do+    cat "conftest.in" "conftest.in" >"conftest.tmp"+    mv "conftest.tmp" "conftest.in"+    cp "conftest.in" "conftest.nl"+    $as_echo 'EGREP' >> "conftest.nl"+    "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break+    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break+    as_fn_arith $ac_count + 1 && ac_count=$as_val+    if test $ac_count -gt ${ac_path_EGREP_max-0}; then+      # Best one so far, save it but keep looking for a better one+      ac_cv_path_EGREP="$ac_path_EGREP"+      ac_path_EGREP_max=$ac_count+    fi+    # 10*(2^10) chars as input seems more than enough+    test $ac_count -gt 10 && break+  done+  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;+esac++      $ac_path_EGREP_found && break 3+    done+  done+  done+IFS=$as_save_IFS+  if test -z "$ac_cv_path_EGREP"; then+    as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5+  fi+else+  ac_cv_path_EGREP=$EGREP+fi++   fi+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5+$as_echo "$ac_cv_path_EGREP" >&6; }+ EGREP="$ac_cv_path_EGREP"+++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5+$as_echo_n "checking for ANSI C header files... " >&6; }+if ${ac_cv_header_stdc+:} false; then :+  $as_echo_n "(cached) " >&6+else+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <stdlib.h>+#include <stdarg.h>+#include <string.h>+#include <float.h>++int+main ()+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"; then :+  ac_cv_header_stdc=yes+else+  ac_cv_header_stdc=no+fi+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext++if test $ac_cv_header_stdc = yes; then+  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <string.h>++_ACEOF+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |+  $EGREP "memchr" >/dev/null 2>&1; then :++else+  ac_cv_header_stdc=no+fi+rm -f conftest*++fi++if test $ac_cv_header_stdc = yes; then+  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <stdlib.h>++_ACEOF+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |+  $EGREP "free" >/dev/null 2>&1; then :++else+  ac_cv_header_stdc=no+fi+rm -f conftest*++fi++if test $ac_cv_header_stdc = yes; then+  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.+  if test "$cross_compiling" = yes; then :+  :+else+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <ctype.h>+#include <stdlib.h>+#if ((' ' & 0x0FF) == 0x020)+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))+#else+# define ISLOWER(c) \+		   (('a' <= (c) && (c) <= 'i') \+		     || ('j' <= (c) && (c) <= 'r') \+		     || ('s' <= (c) && (c) <= 'z'))+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))+#endif++#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))+int+main ()+{+  int i;+  for (i = 0; i < 256; i++)+    if (XOR (islower (i), ISLOWER (i))+	|| toupper (i) != TOUPPER (i))+      return 2;+  return 0;+}+_ACEOF+if ac_fn_c_try_run "$LINENO"; then :++else+  ac_cv_header_stdc=no+fi+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \+  conftest.$ac_objext conftest.beam conftest.$ac_ext+fi++fi+fi+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5+$as_echo "$ac_cv_header_stdc" >&6; }+if test $ac_cv_header_stdc = yes; then++$as_echo "#define STDC_HEADERS 1" >>confdefs.h++fi++# On IRIX 5.3, sys/types and inttypes.h are conflicting.+for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \+		  inttypes.h stdint.h unistd.h+do :+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`+ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default+"+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :+  cat >>confdefs.h <<_ACEOF+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1+_ACEOF++fi++done+++for ac_header in curses.h ncurses.h ncurses/ncurses.h ncursesw/ncurses.h+do :+  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`+ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :+  cat >>confdefs.h <<_ACEOF+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1+_ACEOF++fi++done+++ac_config_headers="$ac_config_headers config.h"+++ac_config_files="$ac_config_files ginsu.buildinfo"++cat >confcache <<\_ACEOF+# This file is a shell script that caches the results of configure+# tests run on this system so they can be shared between configure+# scripts and configure runs, see configure's option --config-cache.+# It is not useful on other systems.  If it contains results you don't+# want to keep, you may remove or edit it.+#+# config.status only pays attention to the cache file if you give it+# the --recheck option to rerun configure.+#+# `ac_cv_env_foo' variables (set or unset) will be overridden when+# loading this file, other *unset* `ac_cv_foo' will be assigned the+# following values.++_ACEOF++# The following way of writing the cache mishandles newlines in values,+# but we know of no workaround that is simple, portable, and efficient.+# So, we kill variables containing newlines.+# Ultrix sh set writes to stderr and can't be redirected directly,+# and sets the high bit in the cache file unless we assign to the vars.+(+  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do+    eval ac_val=\$$ac_var+    case $ac_val in #(+    *${as_nl}*)+      case $ac_var in #(+      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;+      esac+      case $ac_var in #(+      _ | IFS | as_nl) ;; #(+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(+      *) { eval $ac_var=; unset $ac_var;} ;;+      esac ;;+    esac+  done++  (set) 2>&1 |+    case $as_nl`(ac_space=' '; set) 2>&1` in #(+    *${as_nl}ac_space=\ *)+      # `set' does not quote correctly, so add quotes: double-quote+      # substitution turns \\\\ into \\, and sed turns \\ into \.+      sed -n \+	"s/'/'\\\\''/g;+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"+      ;; #(+    *)+      # `set' quotes correctly as required by POSIX, so do not add quotes.+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"+      ;;+    esac |+    sort+) |+  sed '+     /^ac_cv_env_/b end+     t clear+     :clear+     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/+     t end+     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/+     :end' >>confcache+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else+  if test -w "$cache_file"; then+    if test "x$cache_file" != "x/dev/null"; then+      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5+$as_echo "$as_me: updating cache $cache_file" >&6;}+      if test ! -f "$cache_file" || test -h "$cache_file"; then+	cat confcache >"$cache_file"+      else+        case $cache_file in #(+        */* | ?:*)+	  mv -f confcache "$cache_file"$$ &&+	  mv -f "$cache_file"$$ "$cache_file" ;; #(+        *)+	  mv -f confcache "$cache_file" ;;+	esac+      fi+    fi+  else+    { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5+$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}+  fi+fi+rm -f confcache++test "x$prefix" = xNONE && prefix=$ac_default_prefix+# Let make expand exec_prefix.+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'++DEFS=-DHAVE_CONFIG_H++ac_libobjs=+ac_ltlibobjs=+U=+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue+  # 1. Remove the extension, and $U if already installed.+  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'+  ac_i=`$as_echo "$ac_i" | sed "$ac_script"`+  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR+  #    will be set to the directory where LIBOBJS objects are built.+  as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"+  as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'+done+LIBOBJS=$ac_libobjs++LTLIBOBJS=$ac_ltlibobjs++++: "${CONFIG_STATUS=./config.status}"+ac_write_fail=0+ac_clean_files_save=$ac_clean_files+ac_clean_files="$ac_clean_files $CONFIG_STATUS"+{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5+$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}+as_write_fail=0+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1+#! $SHELL+# Generated by $as_me.+# Run this file to recreate the current configuration.+# Compiler output produced by configure, useful for debugging+# configure, is in config.log if it exists.++debug=false+ac_cs_recheck=false+ac_cs_silent=false++SHELL=\${CONFIG_SHELL-$SHELL}+export SHELL+_ASEOF+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1+## -------------------- ##+## M4sh Initialization. ##+## -------------------- ##++# Be more Bourne compatible+DUALCASE=1; export DUALCASE # for MKS sh+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :+  emulate sh+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which+  # is contrary to our usage.  Disable this feature.+  alias -g '${1+"$@"}'='"$@"'+  setopt NO_GLOB_SUBST+else+  case `(set -o) 2>/dev/null` in #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac+fi+++as_nl='+'+export as_nl+# Printing a long string crashes Solaris 7 /usr/bin/printf.+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo+# Prefer a ksh shell builtin over an external printf program on Solaris,+# but without wasting forks for bash or zsh.+if test -z "$BASH_VERSION$ZSH_VERSION" \+    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then+  as_echo='print -r --'+  as_echo_n='print -rn --'+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then+  as_echo='printf %s\n'+  as_echo_n='printf %s'+else+  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then+    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'+    as_echo_n='/usr/ucb/echo -n'+  else+    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'+    as_echo_n_body='eval+      arg=$1;+      case $arg in #(+      *"$as_nl"*)+	expr "X$arg" : "X\\(.*\\)$as_nl";+	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;+      esac;+      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"+    '+    export as_echo_n_body+    as_echo_n='sh -c $as_echo_n_body as_echo'+  fi+  export as_echo_body+  as_echo='sh -c $as_echo_body as_echo'+fi++# The user is always right.+if test "${PATH_SEPARATOR+set}" != set; then+  PATH_SEPARATOR=:+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||+      PATH_SEPARATOR=';'+  }+fi+++# IFS+# We need space, tab and new line, in precisely that order.  Quoting is+# there to prevent editors from complaining about space-tab.+# (If _AS_PATH_WALK were called with IFS unset, it would disable word+# splitting by setting IFS to empty value.)+IFS=" ""	$as_nl"++# Find who we are.  Look in the path if we contain no directory separator.+as_myself=+case $0 in #((+  *[\\/]* ) as_myself=$0 ;;+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break+  done+IFS=$as_save_IFS++     ;;+esac+# We did not find ourselves, most probably we were run as `sh COMMAND'+# in which case we are not to be found in the path.+if test "x$as_myself" = x; then+  as_myself=$0+fi+if test ! -f "$as_myself"; then+  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2+  exit 1+fi++# Unset variables that we do not need and which cause bugs (e.g. in+# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"+# suppresses any "Segmentation fault" message there.  '((' could+# trigger a bug in pdksh 5.2.14.+for as_var in BASH_ENV ENV MAIL MAILPATH+do eval test x\${$as_var+set} = xset \+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :+done+PS1='$ '+PS2='> '+PS4='+ '++# NLS nuisances.+LC_ALL=C+export LC_ALL+LANGUAGE=C+export LANGUAGE++# CDPATH.+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH+++# as_fn_error STATUS ERROR [LINENO LOG_FD]+# ----------------------------------------+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the+# script with STATUS, using 1 if that was 0.+as_fn_error ()+{+  as_status=$1; test $as_status -eq 0 && as_status=1+  if test "$4"; then+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4+  fi+  $as_echo "$as_me: error: $2" >&2+  as_fn_exit $as_status+} # as_fn_error+++# as_fn_set_status STATUS+# -----------------------+# Set $? to STATUS, without forking.+as_fn_set_status ()+{+  return $1+} # as_fn_set_status++# as_fn_exit STATUS+# -----------------+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.+as_fn_exit ()+{+  set +e+  as_fn_set_status $1+  exit $1+} # as_fn_exit++# as_fn_unset VAR+# ---------------+# Portably unset VAR.+as_fn_unset ()+{+  { eval $1=; unset $1;}+}+as_unset=as_fn_unset+# as_fn_append VAR VALUE+# ----------------------+# Append the text in VALUE to the end of the definition contained in VAR. Take+# advantage of any shell optimizations that allow amortized linear growth over+# repeated appends, instead of the typical quadratic growth present in naive+# implementations.+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :+  eval 'as_fn_append ()+  {+    eval $1+=\$2+  }'+else+  as_fn_append ()+  {+    eval $1=\$$1\$2+  }+fi # as_fn_append++# as_fn_arith ARG...+# ------------------+# Perform arithmetic evaluation on the ARGs, and store the result in the+# global $as_val. Take advantage of shells that can avoid forks. The arguments+# must be portable across $(()) and expr.+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :+  eval 'as_fn_arith ()+  {+    as_val=$(( $* ))+  }'+else+  as_fn_arith ()+  {+    as_val=`expr "$@" || test $? -eq 1`+  }+fi # as_fn_arith+++if expr a : '\(a\)' >/dev/null 2>&1 &&+   test "X`expr 00001 : '.*\(...\)'`" = X001; then+  as_expr=expr+else+  as_expr=false+fi++if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then+  as_basename=basename+else+  as_basename=false+fi++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then+  as_dirname=dirname+else+  as_dirname=false+fi++as_me=`$as_basename -- "$0" ||+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \+	 X"$0" : 'X\(//\)$' \| \+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X/"$0" |+    sed '/^.*\/\([^/][^/]*\)\/*$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`++# Avoid depending upon Character Ranges.+as_cr_letters='abcdefghijklmnopqrstuvwxyz'+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'+as_cr_Letters=$as_cr_letters$as_cr_LETTERS+as_cr_digits='0123456789'+as_cr_alnum=$as_cr_Letters$as_cr_digits++ECHO_C= ECHO_N= ECHO_T=+case `echo -n x` in #(((((+-n*)+  case `echo 'xy\c'` in+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.+  xy)  ECHO_C='\c';;+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null+       ECHO_T='	';;+  esac;;+*)+  ECHO_N='-n';;+esac++rm -f conf$$ conf$$.exe conf$$.file+if test -d conf$$.dir; then+  rm -f conf$$.dir/conf$$.file+else+  rm -f conf$$.dir+  mkdir conf$$.dir 2>/dev/null+fi+if (echo >conf$$.file) 2>/dev/null; then+  if ln -s conf$$.file conf$$ 2>/dev/null; then+    as_ln_s='ln -s'+    # ... but there are two gotchas:+    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.+    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.+    # In both cases, we have to default to `cp -p'.+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||+      as_ln_s='cp -p'+  elif ln conf$$.file conf$$ 2>/dev/null; then+    as_ln_s=ln+  else+    as_ln_s='cp -p'+  fi+else+  as_ln_s='cp -p'+fi+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file+rmdir conf$$.dir 2>/dev/null+++# as_fn_mkdir_p+# -------------+# Create "$as_dir" as a directory, including parents if necessary.+as_fn_mkdir_p ()+{++  case $as_dir in #(+  -*) as_dir=./$as_dir;;+  esac+  test -d "$as_dir" || eval $as_mkdir_p || {+    as_dirs=+    while :; do+      case $as_dir in #(+      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(+      *) as_qdir=$as_dir;;+      esac+      as_dirs="'$as_qdir' $as_dirs"+      as_dir=`$as_dirname -- "$as_dir" ||+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_dir" : 'X\(//\)[^/]' \| \+	 X"$as_dir" : 'X\(//\)$' \| \+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$as_dir" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+      test -d "$as_dir" && break+    done+    test -z "$as_dirs" || eval "mkdir $as_dirs"+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"+++} # as_fn_mkdir_p+if mkdir -p . 2>/dev/null; then+  as_mkdir_p='mkdir -p "$as_dir"'+else+  test -d ./-p && rmdir ./-p+  as_mkdir_p=false+fi++if test -x / >/dev/null 2>&1; then+  as_test_x='test -x'+else+  if ls -dL / >/dev/null 2>&1; then+    as_ls_L_option=L+  else+    as_ls_L_option=+  fi+  as_test_x='+    eval sh -c '\''+      if test -d "$1"; then+	test -d "$1/.";+      else+	case $1 in #(+	-*)set "./$1";;+	esac;+	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((+	???[sx]*):;;*)false;;esac;fi+    '\'' sh+  '+fi+as_executable_p=$as_test_x++# Sed expression to map a string onto a valid CPP name.+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"++# Sed expression to map a string onto a valid variable name.+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+++exec 6>&1+## ----------------------------------- ##+## Main body of $CONFIG_STATUS script. ##+## ----------------------------------- ##+_ASEOF+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# Save the log message, to keep $0 and so on meaningful, and to+# report actual input values of CONFIG_FILES etc. instead of their+# values after options handling.+ac_log="+This file was extended by ginsu $as_me 0.8.0, which was+generated by GNU Autoconf 2.68.  Invocation command line was++  CONFIG_FILES    = $CONFIG_FILES+  CONFIG_HEADERS  = $CONFIG_HEADERS+  CONFIG_LINKS    = $CONFIG_LINKS+  CONFIG_COMMANDS = $CONFIG_COMMANDS+  $ $0 $@++on `(hostname || uname -n) 2>/dev/null | sed 1q`+"++_ACEOF++case $ac_config_files in *"+"*) set x $ac_config_files; shift; ac_config_files=$*;;+esac++case $ac_config_headers in *"+"*) set x $ac_config_headers; shift; ac_config_headers=$*;;+esac+++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+# Files that config.status was made for.+config_files="$ac_config_files"+config_headers="$ac_config_headers"++_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+ac_cs_usage="\+\`$as_me' instantiates files and other configuration actions+from templates according to the current configuration.  Unless the files+and actions are specified as TAGs, all are instantiated by default.++Usage: $0 [OPTION]... [TAG]...++  -h, --help       print this help, then exit+  -V, --version    print version number and configuration settings, then exit+      --config     print configuration, then exit+  -q, --quiet, --silent+                   do not print progress messages+  -d, --debug      don't remove temporary files+      --recheck    update $as_me by reconfiguring in the same conditions+      --file=FILE[:TEMPLATE]+                   instantiate the configuration file FILE+      --header=FILE[:TEMPLATE]+                   instantiate the configuration header FILE++Configuration files:+$config_files++Configuration headers:+$config_headers++Report bugs to the package provider."++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"+ac_cs_version="\\+ginsu config.status 0.8.0+configured by $0, generated by GNU Autoconf 2.68,+  with options \\"\$ac_cs_config\\"++Copyright (C) 2010 Free Software Foundation, Inc.+This config.status script is free software; the Free Software Foundation+gives unlimited permission to copy, distribute and modify it."++ac_pwd='$ac_pwd'+srcdir='$srcdir'+test -n "\$AWK" || AWK=awk+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# The default lists apply if the user does not specify any file.+ac_need_defaults=:+while test $# != 0+do+  case $1 in+  --*=?*)+    ac_option=`expr "X$1" : 'X\([^=]*\)='`+    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`+    ac_shift=:+    ;;+  --*=)+    ac_option=`expr "X$1" : 'X\([^=]*\)='`+    ac_optarg=+    ac_shift=:+    ;;+  *)+    ac_option=$1+    ac_optarg=$2+    ac_shift=shift+    ;;+  esac++  case $ac_option in+  # Handling of the options.+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)+    ac_cs_recheck=: ;;+  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )+    $as_echo "$ac_cs_version"; exit ;;+  --config | --confi | --conf | --con | --co | --c )+    $as_echo "$ac_cs_config"; exit ;;+  --debug | --debu | --deb | --de | --d | -d )+    debug=: ;;+  --file | --fil | --fi | --f )+    $ac_shift+    case $ac_optarg in+    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;+    '') as_fn_error $? "missing file argument" ;;+    esac+    as_fn_append CONFIG_FILES " '$ac_optarg'"+    ac_need_defaults=false;;+  --header | --heade | --head | --hea )+    $ac_shift+    case $ac_optarg in+    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;+    esac+    as_fn_append CONFIG_HEADERS " '$ac_optarg'"+    ac_need_defaults=false;;+  --he | --h)+    # Conflict between --help and --header+    as_fn_error $? "ambiguous option: \`$1'+Try \`$0 --help' for more information.";;+  --help | --hel | -h )+    $as_echo "$ac_cs_usage"; exit ;;+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \+  | -silent | --silent | --silen | --sile | --sil | --si | --s)+    ac_cs_silent=: ;;++  # This is an error.+  -*) as_fn_error $? "unrecognized option: \`$1'+Try \`$0 --help' for more information." ;;++  *) as_fn_append ac_config_targets " $1"+     ac_need_defaults=false ;;++  esac+  shift+done++ac_configure_extra_args=++if $ac_cs_silent; then+  exec 6>/dev/null+  ac_configure_extra_args="$ac_configure_extra_args --silent"+fi++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+if \$ac_cs_recheck; then+  set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion+  shift+  \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6+  CONFIG_SHELL='$SHELL'+  export CONFIG_SHELL+  exec "\$@"+fi++_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+exec 5>>config.log+{+  echo+  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX+## Running $as_me. ##+_ASBOX+  $as_echo "$ac_log"+} >&5++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1++# Handling of arguments.+for ac_config_target in $ac_config_targets+do+  case $ac_config_target in+    "config.h") CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;;+    "ginsu.buildinfo") CONFIG_FILES="$CONFIG_FILES ginsu.buildinfo" ;;++  *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;+  esac+done+++# If the user did not use the arguments to specify the items to instantiate,+# then the envvar interface is used.  Set only those that are not.+# We use the long form for the default assignment because of an extremely+# bizarre bug on SunOS 4.1.3.+if $ac_need_defaults; then+  test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files+  test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers+fi++# Have a temporary directory for convenience.  Make it in the build tree+# simply because there is no reason against having it here, and in addition,+# creating and moving files from /tmp can sometimes cause problems.+# Hook for its removal unless debugging.+# Note that there is a small window in which the directory will not be cleaned:+# after its creation but before its name has been assigned to `$tmp'.+$debug ||+{+  tmp= ac_tmp=+  trap 'exit_status=$?+  : "${ac_tmp:=$tmp}"+  { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status+' 0+  trap 'as_fn_exit 1' 1 2 13 15+}+# Create a (secure) tmp directory for tmp files.++{+  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&+  test -d "$tmp"+}  ||+{+  tmp=./conf$$-$RANDOM+  (umask 077 && mkdir "$tmp")+} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5+ac_tmp=$tmp++# Set up the scripts for CONFIG_FILES section.+# No need to generate them if there are no CONFIG_FILES.+# This happens for instance with `./config.status config.h'.+if test -n "$CONFIG_FILES"; then+++ac_cr=`echo X | tr X '\015'`+# On cygwin, bash can eat \r inside `` if the user requested igncr.+# But we know of no other shell where ac_cr would be empty at this+# point, so we can use a bashism as a fallback.+if test "x$ac_cr" = x; then+  eval ac_cr=\$\'\\r\'+fi+ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`+if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then+  ac_cs_awk_cr='\\r'+else+  ac_cs_awk_cr=$ac_cr+fi++echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&+_ACEOF+++{+  echo "cat >conf$$subs.awk <<_ACEOF" &&+  echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&+  echo "_ACEOF"+} >conf$$subs.sh ||+  as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5+ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`+ac_delim='%!_!# '+for ac_last_try in false false false false false :; do+  . ./conf$$subs.sh ||+    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5++  ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`+  if test $ac_delim_n = $ac_delim_num; then+    break+  elif $ac_last_try; then+    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5+  else+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "+  fi+done+rm -f conf$$subs.sh++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&+_ACEOF+sed -n '+h+s/^/S["/; s/!.*/"]=/+p+g+s/^[^!]*!//+:repl+t repl+s/'"$ac_delim"'$//+t delim+:nl+h+s/\(.\{148\}\)..*/\1/+t more1+s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/+p+n+b repl+:more1+s/["\\]/\\&/g; s/^/"/; s/$/"\\/+p+g+s/.\{148\}//+t nl+:delim+h+s/\(.\{148\}\)..*/\1/+t more2+s/["\\]/\\&/g; s/^/"/; s/$/"/+p+b+:more2+s/["\\]/\\&/g; s/^/"/; s/$/"\\/+p+g+s/.\{148\}//+t delim+' <conf$$subs.awk | sed '+/^[^""]/{+  N+  s/\n//+}+' >>$CONFIG_STATUS || ac_write_fail=1+rm -f conf$$subs.awk+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+_ACAWK+cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&+  for (key in S) S_is_set[key] = 1+  FS = ""++}+{+  line = $ 0+  nfields = split(line, field, "@")+  substed = 0+  len = length(field[1])+  for (i = 2; i < nfields; i++) {+    key = field[i]+    keylen = length(key)+    if (S_is_set[key]) {+      value = S[key]+      line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)+      len += length(value) + length(field[++i])+      substed = 1+    } else+      len += 1 + keylen+  }++  print line+}++_ACAWK+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then+  sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"+else+  cat+fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \+  || as_fn_error $? "could not setup config files machinery" "$LINENO" 5+_ACEOF++# VPATH may cause trouble with some makes, so we remove sole $(srcdir),+# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and+# trailing colons and then remove the whole line if VPATH becomes empty+# (actually we leave an empty line to preserve line numbers).+if test "x$srcdir" = x.; then+  ac_vpsub='/^[	 ]*VPATH[	 ]*=[	 ]*/{+h+s///+s/^/:/+s/[	 ]*$/:/+s/:\$(srcdir):/:/g+s/:\${srcdir}:/:/g+s/:@srcdir@:/:/g+s/^:*//+s/:*$//+x+s/\(=[	 ]*\).*/\1/+G+s/\n//+s/^[^=]*=[	 ]*$//+}'+fi++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+fi # test -n "$CONFIG_FILES"++# Set up the scripts for CONFIG_HEADERS section.+# No need to generate them if there are no CONFIG_HEADERS.+# This happens for instance with `./config.status Makefile'.+if test -n "$CONFIG_HEADERS"; then+cat >"$ac_tmp/defines.awk" <<\_ACAWK ||+BEGIN {+_ACEOF++# Transform confdefs.h into an awk script `defines.awk', embedded as+# here-document in config.status, that substitutes the proper values into+# config.h.in to produce config.h.++# Create a delimiter string that does not exist in confdefs.h, to ease+# handling of long lines.+ac_delim='%!_!# '+for ac_last_try in false false :; do+  ac_tt=`sed -n "/$ac_delim/p" confdefs.h`+  if test -z "$ac_tt"; then+    break+  elif $ac_last_try; then+    as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5+  else+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "+  fi+done++# For the awk script, D is an array of macro values keyed by name,+# likewise P contains macro parameters if any.  Preserve backslash+# newline sequences.++ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]*+sed -n '+s/.\{148\}/&'"$ac_delim"'/g+t rset+:rset+s/^[	 ]*#[	 ]*define[	 ][	 ]*/ /+t def+d+:def+s/\\$//+t bsnl+s/["\\]/\\&/g+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\+D["\1"]=" \3"/p+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2"/p+d+:bsnl+s/["\\]/\\&/g+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\+D["\1"]=" \3\\\\\\n"\\/p+t cont+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p+t cont+d+:cont+n+s/.\{148\}/&'"$ac_delim"'/g+t clear+:clear+s/\\$//+t bsnlc+s/["\\]/\\&/g; s/^/"/; s/$/"/p+d+:bsnlc+s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p+b cont+' <confdefs.h | sed '+s/'"$ac_delim"'/"\\\+"/g' >>$CONFIG_STATUS || ac_write_fail=1++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+  for (key in D) D_is_set[key] = 1+  FS = ""+}+/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ {+  line = \$ 0+  split(line, arg, " ")+  if (arg[1] == "#") {+    defundef = arg[2]+    mac1 = arg[3]+  } else {+    defundef = substr(arg[1], 2)+    mac1 = arg[2]+  }+  split(mac1, mac2, "(") #)+  macro = mac2[1]+  prefix = substr(line, 1, index(line, defundef) - 1)+  if (D_is_set[macro]) {+    # Preserve the white space surrounding the "#".+    print prefix "define", macro P[macro] D[macro]+    next+  } else {+    # Replace #undef with comments.  This is necessary, for example,+    # in the case of _POSIX_SOURCE, which is predefined and required+    # on some systems where configure will not decide to define it.+    if (defundef == "undef") {+      print "/*", prefix defundef, macro, "*/"+      next+    }+  }+}+{ print }+_ACAWK+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+  as_fn_error $? "could not setup config headers machinery" "$LINENO" 5+fi # test -n "$CONFIG_HEADERS"+++eval set X "  :F $CONFIG_FILES  :H $CONFIG_HEADERS    "+shift+for ac_tag+do+  case $ac_tag in+  :[FHLC]) ac_mode=$ac_tag; continue;;+  esac+  case $ac_mode$ac_tag in+  :[FHL]*:*);;+  :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;+  :[FH]-) ac_tag=-:-;;+  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;+  esac+  ac_save_IFS=$IFS+  IFS=:+  set x $ac_tag+  IFS=$ac_save_IFS+  shift+  ac_file=$1+  shift++  case $ac_mode in+  :L) ac_source=$1;;+  :[FH])+    ac_file_inputs=+    for ac_f+    do+      case $ac_f in+      -) ac_f="$ac_tmp/stdin";;+      *) # Look for the file first in the build tree, then in the source tree+	 # (if the path is not absolute).  The absolute path cannot be DOS-style,+	 # because $ac_f cannot contain `:'.+	 test -f "$ac_f" ||+	   case $ac_f in+	   [\\/$]*) false;;+	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;+	   esac ||+	   as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;+      esac+      case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac+      as_fn_append ac_file_inputs " '$ac_f'"+    done++    # Let's still pretend it is `configure' which instantiates (i.e., don't+    # use $as_me), people would be surprised to read:+    #    /* config.h.  Generated by config.status.  */+    configure_input='Generated from '`+	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'+	`' by configure.'+    if test x"$ac_file" != x-; then+      configure_input="$ac_file.  $configure_input"+      { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5+$as_echo "$as_me: creating $ac_file" >&6;}+    fi+    # Neutralize special characters interpreted by sed in replacement strings.+    case $configure_input in #(+    *\&* | *\|* | *\\* )+       ac_sed_conf_input=`$as_echo "$configure_input" |+       sed 's/[\\\\&|]/\\\\&/g'`;; #(+    *) ac_sed_conf_input=$configure_input;;+    esac++    case $ac_tag in+    *:-:* | *:-) cat >"$ac_tmp/stdin" \+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;+    esac+    ;;+  esac++  ac_dir=`$as_dirname -- "$ac_file" ||+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$ac_file" : 'X\(//\)[^/]' \| \+	 X"$ac_file" : 'X\(//\)$' \| \+	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||+$as_echo X"$ac_file" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+  as_dir="$ac_dir"; as_fn_mkdir_p+  ac_builddir=.++case "$ac_dir" in+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;+*)+  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`+  # A ".." for each directory in $ac_dir_suffix.+  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`+  case $ac_top_builddir_sub in+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;+  esac ;;+esac+ac_abs_top_builddir=$ac_pwd+ac_abs_builddir=$ac_pwd$ac_dir_suffix+# for backward compatibility:+ac_top_builddir=$ac_top_build_prefix++case $srcdir in+  .)  # We are building in place.+    ac_srcdir=.+    ac_top_srcdir=$ac_top_builddir_sub+    ac_abs_top_srcdir=$ac_pwd ;;+  [\\/]* | ?:[\\/]* )  # Absolute name.+    ac_srcdir=$srcdir$ac_dir_suffix;+    ac_top_srcdir=$srcdir+    ac_abs_top_srcdir=$srcdir ;;+  *) # Relative name.+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix+    ac_top_srcdir=$ac_top_build_prefix$srcdir+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;+esac+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix+++  case $ac_mode in+  :F)+  #+  # CONFIG_FILE+  #++_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# If the template does not know about datarootdir, expand it.+# FIXME: This hack should be removed a few years after 2.60.+ac_datarootdir_hack=; ac_datarootdir_seen=+ac_sed_dataroot='+/datarootdir/ {+  p+  q+}+/@datadir@/p+/@docdir@/p+/@infodir@/p+/@localedir@/p+/@mandir@/p'+case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in+*datarootdir*) ac_datarootdir_seen=yes;;+*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5+$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}+_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+  ac_datarootdir_hack='+  s&@datadir@&$datadir&g+  s&@docdir@&$docdir&g+  s&@infodir@&$infodir&g+  s&@localedir@&$localedir&g+  s&@mandir@&$mandir&g+  s&\\\${datarootdir}&$datarootdir&g' ;;+esac+_ACEOF++# Neutralize VPATH when `$srcdir' = `.'.+# Shell code in configure.ac might set extrasub.+# FIXME: do we really want to maintain this feature?+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+ac_sed_extra="$ac_vpsub+$extrasub+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+:t+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b+s|@configure_input@|$ac_sed_conf_input|;t t+s&@top_builddir@&$ac_top_builddir_sub&;t t+s&@top_build_prefix@&$ac_top_build_prefix&;t t+s&@srcdir@&$ac_srcdir&;t t+s&@abs_srcdir@&$ac_abs_srcdir&;t t+s&@top_srcdir@&$ac_top_srcdir&;t t+s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t+s&@builddir@&$ac_builddir&;t t+s&@abs_builddir@&$ac_abs_builddir&;t t+s&@abs_top_builddir@&$ac_abs_top_builddir&;t t+$ac_datarootdir_hack+"+eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \+  >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5++test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&+  { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&+  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' \+      "$ac_tmp/out"`; test -z "$ac_out"; } &&+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'+which seems to be undefined.  Please make sure it is defined" >&5+$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'+which seems to be undefined.  Please make sure it is defined" >&2;}++  rm -f "$ac_tmp/stdin"+  case $ac_file in+  -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;+  *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;+  esac \+  || as_fn_error $? "could not create $ac_file" "$LINENO" 5+ ;;+  :H)+  #+  # CONFIG_HEADER+  #+  if test x"$ac_file" != x-; then+    {+      $as_echo "/* $configure_input  */" \+      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs"+    } >"$ac_tmp/config.h" \+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5+    if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then+      { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5+$as_echo "$as_me: $ac_file is unchanged" >&6;}+    else+      rm -f "$ac_file"+      mv "$ac_tmp/config.h" "$ac_file" \+	|| as_fn_error $? "could not create $ac_file" "$LINENO" 5+    fi+  else+    $as_echo "/* $configure_input  */" \+      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \+      || as_fn_error $? "could not create -" "$LINENO" 5+  fi+ ;;+++  esac++done # for ac_tag+++as_fn_exit 0+_ACEOF+ac_clean_files=$ac_clean_files_save++test $ac_write_fail = 0 ||+  as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5+++# configure is writing to config.log, and then calls config.status.+# config.status does its own redirection, appending to config.log.+# Unfortunately, on DOS this fails, as config.log is still kept open+# by configure, so config.status won't be able to write to it; its+# output is simply discarded.  So we exec the FD to /dev/null,+# effectively closing config.log, so it can be properly (re)opened and+# appended to by config.status.  When coming back to configure, we+# need to make the FD available again.+if test "$no_create" != yes; then+  ac_cs_success=:+  ac_config_status_args=+  test "$silent" = yes &&+    ac_config_status_args="$ac_config_status_args --quiet"+  exec 5>/dev/null+  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false+  exec 5>>config.log+  # Use ||, not &&, to avoid exiting from the if with $? = 1, which+  # would make configure fail if this is the last instruction.+  $ac_cs_success || as_fn_exit 1+fi+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then+  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5+$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}+fi+
+ dist/build/ginsu/ginsu-tmp/ExampleConf.hs view
@@ -0,0 +1,176 @@+module ExampleConf(exampleConf, exampleConfFile) where+import Paths_ginsu+exampleConfFile :: IO FilePath+exampleConfFile = getDataFileName "ginsu.config.sample"+{-# NOINLINE exampleConf #-}+exampleConf :: String+exampleConf = unlines [+    "#---------------------------------------------------",+    "# this file should be placed in ~/.gale/ginsu.config",+    "#---------------------------------------------------",+    "",+    "#the setting in this sample file coorespond to the defaults",+    "",+    "######################",+    "# Definately set these",+    "######################",+    "",+    "# set to your gale domain (usually taken from enviornment, MUST be set somewhere)",+    "#GALE_DOMAIN gale.org",+    "",+    "",+    "# GALE_SUBSCRIBE is a list of all categories you wish to subscribe too.",+    "# the default is some common public categories and your private puffs.",+    "",+    "GALE_SUBSCRIBE pub@ofb.net local@ofb.net test.ginsu@ofb.net $GALE_ID",+    "",+    "# GALE_NAME should be set to your real name.",+    "GALE_NAME Ginsu User $LOGNAME",+    "",+    "PUFF_DATE_FORMAT %a %H:%M:%S",+    "",+    "###################",+    "# perhaps set these",+    "###################",+    "",+    "#GALE_ID should be set to your GALE_ID. the default is to append your login to your GALE_DOMAIN.",+    "#GALE_ID user@gale.org",+    "",+    "",+    "# editor to use for puff composition (else $VISUAL then $EDITOR used)",+    "#EDITOR vim",+    "",+    "# when editing a puff, run the editor in the background, so you can still",+    "# interact with ginsu while editing",+    "#BACKGROUND_EDIT true",+    "",+    "# if BACKGROUND_EDIT is enabled, prefix commands with this (something like",+    "# \"xterm -e\"; if your editor is graphical, don't specify it)",+    "#BACKGROUND_COMMAND urxvt -e",+    "",+    "# GALE_PROXY",+    "#  gale server to use in preference to all others, you should not need to set",+    "#  this unless you are behind a firewall or your own GALE_DOMAIN servers are not",+    "#  suitable for some reason.",+    "#GALE_PROXY gale.org",+    "",+    "",+    "# MARK_[123..] sets the initial filter for a given marked screen. use the",+    "# number keys to quickly switch to a mark.",+    "#",+    "# the default has '7' show puffs to or from you, ",+    "# '8' shows traffic about gale and '9' filters spoilers away.",+    "",+    "MARK_7 ~c:$GALE_ID ; ~a:$GALE_ID",+    "MARK_8 ~c:pub.gale@ofb.net ; ~c:pub.rfc",+    "MARK_9 !~k:spoil",+    "",+    "",+    "# beep on any puffs matching the following filters",+    "BEEP ~c:$GALE_ID   ",+    "",+    "",+    "# number of puffs to store in pufflog on exit.",+    "PUFFLOG_SIZE 500",+    "",+    "# maximum number of puffs to keep in memory",+    "SCROLLBACK_SIZE 0",+    "",+    "# charset, one of utf8, latin1, or ascii. if not set, will try to determine it from $LANG",+    "# this only affects what format it assumes you are editing puffs in. locale settings are ",+    "# always used for the UI",+    "#CHARSET latin1",+    "",+    "# when replying to a puff, keep these keywords",+    "PRESERVED_KEYWORDS ketchup catchup tangent spoiler spoilers nolog",+    "",+    "# on startup, run this macro",+    "ON_STARTUP <End>",+    "",+    "# uncomment this if you are having trouble with terminal resizing.",+    "#DISABLE_SIGWINCH True",+    "",+    "#dispose of blank lines at the begining or end of puffs",+    "TRIM_BLANKLINES true",+    "",+    "BROWSER links",+    "",+    "apphook WikiWord ",+    "        '([[:space:]]|^)(([[:upper:]][[:lower:]]+){2,})([[:space:]]|$)' ",+    "        '$BROWSER http://wiki.ofb.net/?$2'",+    "        '$2'",+    "",+    "apphook Url",+    "        '(http|ftp)s?://(%[[:digit:]A-Fa-f][[:digit:]A-Fa-f]|[-_.!~*'';/?:@&=+$,[:alnum:]])+'",+    "        '$BROWSER ''$0'''",+    "",+    "#default key bindings",+    "",+    "bind <F1> show_help_screen ",+    "bind ? show_help_screen",+    "#bind <F2> show_main_index ",+    "bind <F3> show_presence_status ",+    "",+    "bind j next_puff",+    "bind k previous_puff",+    "bind <Down> next_puff",+    "bind <Up> previous_puff",+    "",+    "bind <Home> first_puff",+    "bind <End> last_puff",+    "bind G last_puff",+    "",+    "bind <Enter> next_line",+    "bind <C-E> next_line",+    "",+    "bind <BackSpace> previous_line",+    "bind <C-Y> previous_line",+    "",+    "bind <C-F> next_page",+    "bind <PageDown> next_page",+    "bind <C-B> previous_page",+    "bind <PageUp> previous_page",+    "",+    "bind <C-D> forward_half_page",+    "bind <C-U> backward_half_page",+    "",+    "bind d show_puff_details",+    "",+    "bind c prompt_new_filter",+    "bind / prompt_new_filter_slash",+    "bind ~ prompt_new_filter_twiddle",+    "bind u pop_one_filter",+    "bind U pop_all_filters",+    "bind ! invert_filter",+    "bind x swap_filters",+    "",+    "bind a filter_current_author",+    "bind t filter_current_thread",+    "bind T filter_current_thread",+    "",+    "bind <C-o> toggle_rot13",+    "",+    "# marks",+    "bind m set_mark",+    "bind <SingleQuote> recall_mark",+    "bind M set_filter_mark",+    "bind <DoubleQuote> recall_filter_mark",+    "bind C recall_combine_mark",+    "",+    "bind f follow_up",+    "bind p new_puff",+    "bind r reply_to_author",+    "bind g group_reply",+    "bind R resend_puff",+    "",+    "bind N modify_presence_string",+    "",+    "bind <C-r> reconnect_to_servers",+    "bind E edit_config_file",+    "bind q ask_quit",+    "bind Q fast_quit",+    "bind <C-l> redraw_screen",+    "bind v goto_match",+    "bind S show_status_screen",+    " ",+  ""]
+ dist/build/ginsu/ginsu-tmp/KeyHelpTable.hs view
@@ -0,0 +1,53 @@+module KeyHelpTable(keyHelpTable) where++keyHelpTable gk = [+	 Left "Main Screens"+	,Right (gk "show_help_screen", "Show help screen")+	,Right (gk "show_presence_status", "show presence status")+	,Right (gk "show_puff_details", "show puff details")+	,Right (gk "show_status_screen", "show status screen")+	,Left "Puff Movement"+	,Right (gk "next_puff", "Goto the next puff")+	,Right (gk "previous_puff", "Goto the previous puff")+	,Right (gk "first_puff", "Goto the first puff")+	,Right (gk "last_puff", "Goto the last puff")+	,Right (gk "next_line", "Scroll one line down")+	,Right (gk "previous_line", "Scroll one line up")+	,Right (gk "next_page", "Scroll one page down")+	,Right (gk "previous_page", "Scroll one page up")+	,Right (gk "forward_half_page", "Scroll a half page down")+	,Right (gk "backward_half_page", "Scroll a half page up")+	,Left "Filter Manipulation"+	,Right (gk "prompt_new_filter", "prompt new filter")+	,Right (gk "prompt_new_filter_slash", "prompt new filter slash")+	,Right (gk "prompt_new_filter_twiddle", "prompt new filter twiddle")+	,Right (gk "pop_one_filter", "pop one filter")+	,Right (gk "pop_all_filters", "pop all filters")+	,Right (gk "invert_filter", "invert filter")+	,Right (gk "filter_current_thread", "filter current thread")+	,Right (gk "swap_filters", "swap filters")+	,Right (gk "filter_current_author", "filter current author")+	,Left "Puff Body Filtering"+	,Right (gk "toggle_rot13", "toggle Rot13 filter")+	,Left "Mark/Workspace Manipulation"+	,Right (gk "set_mark", "save current position at a given mark.")+	,Right (gk "recall_mark", "goto position saved at mark")+	,Right (gk "set_filter_mark", "save current filter stack at given mark.")+	,Right (gk "recall_filter_mark", "Recall filter stack at mark")+	,Right (gk "recall_combine_mark", "Recall filter stack at mark and combine it with the current filter stack.")+	,Right ("[1-9]", "Recall given numbered workspace and set it as current workspace, these follow marks [1-9]")+	,Left "Composing Puffs"+	,Right (gk "new_puff", "compose a new puff")+	,Right (gk "follow_up", "follow up to the same category as the current puff")+	,Right (gk "reply_to_author", "reply to the author of the current puff privatly")+	,Right (gk "group_reply", "reply to the union of the sender and categories of the current puff")+	,Right (gk "resend_puff", "resend puff")+	,Left "Miscellaneous"+	,Right (gk "goto_match", "visit link in current puff")+	,Right (gk "modify_presence_string", "modify presence string")+	,Right (gk "reconnect_to_servers", "reconnect to servers")+	,Right (gk "edit_config_file", "Edit the configuration file and reload its settings")+	,Right (gk "ask_quit", "quit ginsu")+	,Right (gk "fast_quit", "quit ginsu without asking first")+	,Right (gk "redraw_screen", "redraw screen")+	]
+ docs/Changelog.old view
@@ -0,0 +1,978 @@++# switched to darcs after this point.++2005-04-12 02:50:41 GMT	John Meacham <john@repetae.net>	patch-45++    Summary:+      make compatable with ghc 6.4+    Revision:+      ginsu--main--0.6--patch-45++    +    ++    modified files:+     .arch-inventory CWString.hsc Changelog Charset.hs Curses.hsc+     EIO.hs ErrorLog.hs Gale.hs GinsuConfig.hs Main.hs Makefile.am+     MyLocale.hsc PackedString.hs RSA.hsc++    renamed files:+     Locale.hsc+       ==> MyLocale.hsc+++2004-09-21 04:22:51 GMT	John Meacham <john@repetae.net>	patch-44++    Summary:+      fix makefile. 0.6.7 release.+    Revision:+      ginsu--main--0.6--patch-44++    +    ++    modified files:+     Changelog Makefile.am+++2004-09-09 06:12:14 GMT	John Meacham <john@repetae.net>	patch-43++    Summary:+      Filter rewriting, color support+    Revision:+      ginsu--main--0.6--patch-43++    Color support +    major filter changes, based on boolean library now.+    +    +    ++    new files:+     Boolean/.arch-ids/=id Boolean/Algebra.hs unicode_map.txt++    modified files:+     .arch-inventory Boolean/Boolean.hs Changelog Curses.hsc+     Filter.hs Main.hs Makefile.am Screen.hs configure.in reconf+     {arch}/=tagging-method++    renamed files:+     Boolean.hs+       ==> Boolean/Boolean.hs++    new directories:+     Boolean Boolean/.arch-ids+++2004-08-12 06:06:27 GMT	John Meacham <john@repetae.net>	patch-42++    Summary:+      +    Revision:+      ginsu--main--0.6--patch-42++    made error messages modal, instead of using status line+    switched to parsec for parsing filters, better error messages+    added general status screen on 'S'+    added ?encrypted and ?signed +    added /foo to search everything for foo+    added log buffer on status screen++    new files:+     Boolean.hs CircularBuffer.hs Status.hs UnicodeConsts.hs++    modified files:+     Atom.hs Binary.hs Changelog Filter.hs Gale.hs GenUtil.hs+     Help.hs KeyCache.hs Main.hs Makefile.am PackedString.hs+     Puff.hs actions.def configure.in docs/ginsu-manual.txt+     ginsu.config.sample+++2004-07-21 23:58:36 GMT	John Meacham <john@repetae.net>	patch-41++    Summary:+      0.6.6+    Revision:+      ginsu--main--0.6--patch-41+++    modified files:+     Changelog configure.in+++2004-07-21 23:50:12 GMT	John Meacham <john@repetae.net>	patch-40++    Summary:+      fix puff parsing bug +    Revision:+      ginsu--main--0.6--patch-40++    parse top level text fragments properly+    create better error messages on malformed puff+    don't try to reconnect to server because of malformed puff+    ++    modified files:+     Atom.hs Changelog Gale.hs UArrayParser.hs+++2004-07-18 03:46:10 GMT	John Meacham <john@repetae.net>	patch-39++    Summary:+      0.6.5+    Revision:+      ginsu--main--0.6--patch-39+++    modified files:+     Changelog+++2004-07-18 02:42:24 GMT	John Meacham <john@repetae.net>	patch-38++    Summary:+      small fix+    Revision:+      ginsu--main--0.6--patch-38++    +    ++    modified files:+     .arch-inventory Changelog+++2004-07-18 02:28:38 GMT	John Meacham <john@repetae.net>	patch-37++    Summary:+      optimizations+    Revision:+      ginsu--main--0.6--patch-37++    no longer cache word-wrapped text. +    much more efficient utf8 decoding.+    hash function for atoms better.+    ++    modified files:+     Atom.hs Changelog Filter.hs Main.hs PackedString.hs+     configure.in+++2004-07-17 03:28:34 GMT	John Meacham <john@repetae.net>	patch-36++    Summary:+      space usage omnipatch+    Revision:+      ginsu--main--0.6--patch-36++    made PackedString store stuff in utf8+    uses hashconsed atoms for fragment names+    use weak pointers to store keys++    new files:+     ArrayLib.hs Atom.hs UArrayParser.hs++    modified files:+     Binary.hs Changelog Filter.hs Gale.hs GaleProto.hs KeyCache.hs+     Main.hs Makefile.am PackedString.hs Puff.hs configure.in+++2004-07-15 01:03:43 GMT	John Meacham <john@repetae.net>	patch-35++    Summary:+      unboxed -> unpack+    Revision:+      ginsu--main--0.6--patch-35+++    modified files:+     Changelog SHA1.hs+++2004-07-15 01:01:59 GMT	John Meacham <john@repetae.net>	patch-34++    Summary:+      unbox everything+    Revision:+      ginsu--main--0.6--patch-34+++    modified files:+     Changelog SHA1.hs+++2004-07-15 00:10:26 GMT	John Meacham <john@repetae.net>	patch-33++    Summary:+      updated genutil, cleanups, MutInt fix+    Revision:+      ginsu--main--0.6--patch-33+++    modified files:+     .arch-inventory Changelog FastMutInt.hs GenUtil.hs+++2004-07-02 21:12:39 GMT	John Meacham <john@repetae.net>	patch-32++    Summary:+      added azz patches, fix static build +    Revision:+      ginsu--main--0.6--patch-32++    +    +    Patches applied:+    +     * azz@offog.org--2004/ginsu--azz--0.1--base-0+       tag of john@repetae.net--2004/ginsu--main--0.6--patch-31+    +     * azz@offog.org--2004/ginsu--azz--0.1--patch-1+       don't hide last line when using filters+    ++    modified files:+     Changelog Main.hs Makefile.am++    new patches:+     azz@offog.org--2004/ginsu--azz--0.1--base-0+     azz@offog.org--2004/ginsu--azz--0.1--patch-1+++2004-05-26 02:40:20 GMT	John Meacham <john@repetae.net>	patch-31++    Summary:+      0.6.4+    Revision:+      ginsu--main--0.6--patch-31+++    modified files:+     Changelog configure.in+++2004-05-26 02:24:49 GMT	John Meacham <john@repetae.net>	patch-30++    Summary:+      fixed major segfault bug on incomming private puffs+    Revision:+      ginsu--main--0.6--patch-30+++    modified files:+     Changelog Gale.hs KeyCache.hs Puff.hs RSA.hsc+++2004-04-24 02:33:34 GMT	John Meacham <john@repetae.net>	patch-29++    Summary:+      changed default workspace to 1+    Revision:+      ginsu--main--0.6--patch-29+++    modified files:+     Changelog Main.hs+++2004-04-23 08:24:22 GMT	John Meacham <john@repetae.net>	patch-28++    Summary:+      0.6.3+    Revision:+      ginsu--main--0.6--patch-28+++    modified files:+     Changelog+++2004-04-23 01:20:01 GMT	John Meacham <john@repetae.net>	patch-27++    Summary:+      ignore log file+    Revision:+      ginsu--main--0.6--patch-27+++    modified files:+     .arch-inventory Changelog+++2004-04-23 00:14:58 GMT	John Meacham <john@repetae.net>	patch-26++    Summary:+      AKD wrapup. dates +    Revision:+      ginsu--main--0.6--patch-26++    PUFF_DATE_FORMAT string similar to 'date' command for how you want the date to+    be displayed in your puff window+    +    participates in AKD semi-properly. populates .gale/auth/cache on its own++    modified files:+     Changelog EIO.hs Gale.hs GinsuConfig.hs KeyCache.hs Main.hs+     Options.hs Puff.hs docs/ginsu-manual.txt ginsu.config.sample+++2004-04-22 04:44:10 GMT	John Meacham <john@repetae.net>	patch-25++    Summary:+      various fixes+    Revision:+      ginsu--main--0.6--patch-25++    added raw SHA1 output+    print hash of data fragments+    use ACS macros even if we have wide character support+    made sure it compiles without ncursesw+    ++    modified files:+     Changelog Curses.hsc KeyCache.hs Puff.hs SHA1.hs configure.in+     my_curses.h+++2004-04-22 02:52:53 GMT	John Meacham <john@repetae.net>	patch-24++    Summary:+      curses and encryption updates+    Revision:+      ginsu--main--0.6--patch-24++    made encryption algorithm search for * keys as well.+    made it use ncursesw if it exists+    uses line drawing characters in display now+    fixed problems with long utf8 lines when ncursesw is installed+    +    ++    new files:+     ac-macros/.arch-ids/curslib.m4.id+     ac-macros/.arch-ids/funcdecl.m4.id ac-macros/curslib.m4+     ac-macros/funcdecl.m4++    modified files:+     Changelog Curses.hsc Gale.hs GinsuConfig.hs KeyCache.hs+     Main.hs Puff.hs Screen.hs configure.in my_curses.h+++2004-04-19 08:31:30 GMT	John Meacham <john@repetae.net>	patch-23++    Summary:+      uses nl_langinfo for charset+    Revision:+      ginsu--main--0.6--patch-23+++    modified files:+     Changelog Charset.hs Locale.hsc Main.hs+++2004-04-19 08:06:39 GMT	John Meacham <john@repetae.net>	patch-22++    Summary:+      fixed leaking file descriptors+    Revision:+      ginsu--main--0.6--patch-22++    ++    modified files:+     Changelog GinsuConfig.hs RSA.hsc+++2004-04-08 02:40:48 GMT	John Meacham <john@repetae.net>	patch-21++    Summary:+      major encryption overhaul+    Revision:+      ginsu--main--0.6--patch-21++    seperated out GaleProto and KeyCache from Gale.hs+    made puff encryption work+    got rid of spurious curses error messages in log++    new files:+     GaleProto.hs KeyCache.hs++    modified files:+     CWString.hsc Changelog ErrorLog.hs Gale.hs Locale.hsc Main.hs+     Makefile.am Options.hs Puff.hs RSA.hsc Screen.hs Version.hs.in+++2004-03-29 09:14:53 GMT	John Meacham <john@repetae.net>	patch-20++    Summary:+      swaped left and right+    Revision:+      ginsu--main--0.6--patch-20+++    modified files:+     Changelog Curses.hsc+++2004-03-29 09:07:42 GMT	John Meacham <john@repetae.net>	patch-19++    Summary:+      fixed shifted arrow keys+    Revision:+      ginsu--main--0.6--patch-19+++    modified files:+     Changelog Curses.hsc+++2004-03-28 19:14:09 GMT	John Meacham <john@repetae.net>	patch-18++    Summary:+      0.6.2 release+    Revision:+      ginsu--main--0.6--patch-18+++    modified files:+     Changelog+++2004-03-28 18:49:20 GMT	John Meacham <john@repetae.net>	patch-17++    Summary:+      added USE_DEFAULT_COLORS option+    Revision:+      ginsu--main--0.6--patch-17+++    modified files:+     Changelog Curses.hsc Main.hs configure.in+     docs/ginsu-manual.txt+++2004-03-28 16:53:15 GMT	John Meacham <john@repetae.net>	patch-16++    Summary:+      changed status line to show workspaces, current viewable puffs+    Revision:+      ginsu--main--0.6--patch-16+++    modified files:+     Changelog Main.hs+++2004-03-28 16:23:31 GMT	John Meacham <john@repetae.net>	patch-15++    Summary:+      added Workspaces+    Revision:+      ginsu--main--0.6--patch-15++    Completly revamped the mark system. now you can set position and filter marks independently+    Workspaces are built on top of the marks.+    ++    new files:+     DocLike.hs++    modified files:+     Changelog EIO.hs FastMutInt.hs KeyName.hs Main.hs Makefile.am+     actions.def ginsu.config.sample+++2004-03-28 12:54:59 GMT	John Meacham <john@repetae.net>	patch-14++    Summary:+      rcs checkin+    Revision:+      ginsu--main--0.6--patch-14++    +    ++    modified files:+     Changelog ErrorLog.hs+++2004-03-22 04:00:15 GMT	John Meacham <john@repetae.net>	patch-13++    Summary:+      docmentation publishing fixes+    Revision:+      ginsu--main--0.6--patch-13+++    modified files:+     Changelog Makefile.am+++2004-03-22 03:53:50 GMT	John Meacham <john@repetae.net>	patch-12++    Summary:+      preciousize builds+    Revision:+      ginsu--main--0.6--patch-12+++    modified files:+     .arch-inventory Changelog+++2004-03-22 03:52:48 GMT	John Meacham <john@repetae.net>	patch-11++    Summary:+      added goto_match to help+    Revision:+      ginsu--main--0.6--patch-11+++    modified files:+     Changelog actions.def+++2004-03-16 06:20:47 GMT	John Meacham <john@repetae.net>	patch-10++    Summary:+      0.6.1+    Revision:+      ginsu--main--0.6--patch-10+++    modified files:+     Changelog+++2004-03-16 05:31:40 GMT	John Meacham <john@repetae.net>	patch-9++    Summary:+      Key mapping +    Revision:+      ginsu--main--0.6--patch-9++    fixed pageup and down in standard config+    added keymapping section to manual+    changed help screen+    help screen now dynmaicly shows current keybindings++    new files:+     gen_keyhelp.prl++    modified files:+     .arch-inventory Changelog GenUtil.hs Help.hs KeyName.hs+     Main.hs Makefile.am Options.hs actions.def configure.in+     docs/ginsu-manual.txt ginsu.config.sample+++2004-03-16 00:59:42 GMT	John Meacham <john@repetae.net>	patch-8++    Summary:+      +    Revision:+      ginsu--main--0.6--patch-8++    added ginsu-mdk to binary distribution+    cleaned up options+    included autogenerated options table in ginsu-manual++    modified files:+     Changelog Makefile.am Options.hs docs/ginsu-manual.txt+++2004-03-05 08:09:20 GMT	John Meacham <john@repetae.net>	patch-7++    Summary:+      small fix for rpm+    Revision:+      ginsu--main--0.6--patch-7+++    modified files:+     Changelog ginsu.spec.in+++2004-03-05 07:35:50 GMT	John Meacham <john@repetae.net>	patch-6++    Summary:+      0.6.0 release, makefile fixes+    Revision:+      ginsu--main--0.6--patch-6+++    modified files:+     Changelog Help.hs Makefile.am configure.in docs/wiki.css+     ginsu-mdk reconf+++2004-03-05 02:03:14 GMT	John Meacham <john@repetae.net>	patch-5++    Summary:+      added manual, Mandrake client+    Revision:+      ginsu--main--0.6--patch-5++    Added manual in docs/ directory.+    included jtr's mandrake client as ginsu-mdk.++    new files:+     docs/.arch-ids/=id docs/.arch-inventory docs/ginsu-manual.txt+     docs/wiki.css ginsu-mdk++    modified files:+     Changelog Makefile.am++    renamed files:+     .arch-ids/Changelog.old.id+       ==> docs/.arch-ids/Changelog.old.id+     Changelog.old+       ==> docs/Changelog.old++    new directories:+     docs docs/.arch-ids+++2004-03-04 08:04:09 GMT	John Meacham <john@repetae.net>	patch-4++    Summary:+      added goto_match+    Revision:+      ginsu--main--0.6--patch-4++    goto_match ('v' by default) will extract urls or WikiWords and let you access+    them with a web browser. The mechanism is generic and may extract arbitrary+    regular expressions and run arbitrary programs on them. ++    new files:+     Regex.hs++    modified files:+     Changelog ConfigFile.hs Filter.hs Main.hs Makefile.am+     ginsu.config.sample+++2004-03-04 03:49:59 GMT	John Meacham <john@repetae.net>	patch-3++    Summary:+      Cleanups +    Revision:+      ginsu--main--0.6--patch-3++    added preciousness to a lot of files+    renamed GMain finally.+    fixed empty depend.make problem.+    began WikiWord support.++    new files:+     .arch-inventory++    modified files:+     Changelog Makefile.am configure.in ginsu.config.sample reconf++    renamed files:+     GMain.hs+       ==> Main.hs+++2004-03-02 01:11:09 GMT	John Meacham <john@repetae.net>	patch-2++    Summary:+      Regular Expression based filters+    Revision:+      ginsu--main--0.6--patch-2++    fixed filters to use regular expressions. simplified code in several ways.+    +    ++    modified files:+     Changelog Filter.hs Puff.hs+++2004-02-28 05:36:21 GMT	John Meacham <john@repetae.net>	patch-1++    Summary:+      Makefile fixes+    Revision:+      ginsu--main--0.6--patch-1+++    modified files:+     Changelog Makefile.am+++2004-02-28 05:00:57 GMT	John Meacham <john@repetae.net>	base-0++    Summary:+      initial import+    Revision:+      ginsu--main--0.6--base-0++    +    (automatically generated log message)++    new files:+     Binary.hs CWString.hsc CacheIO.hs Changelog Changelog.old+     Charset.hs ConfigFile.hs Curses.hsc EIO.hs ErrorLog.hs+     FastMutInt.hs Filter.hs Format.hs GMain.hs Gale.hs GenUtil.hs+     GinsuConfig.hs Help.hs KeyName.hs LICENSE Locale.hsc+     Makefile.am Options.hs PackedString.hs Puff.hs RSA.hsc SHA1.hs+     Screen.hs SimpleParser.hs UTF8.hs Version.hs.in+     ac-macros/ac_caolan_check_package.m4+     ac-macros/acincludepackage.m4 ac-macros/check_ssl.m4+     ac-macros/check_zlib.m4 ac-macros/curses.m4+     ac-macros/mp_with_curses.m4 actions.def collect_deps.prl+     configure.in ginsu.1 ginsu.config.sample ginsu.spec.in+     hs_include.h my_curses.h my_rsa.h reconf++++0.5.3+        changed id/class to use '/' convention+        rebindable keys via 'bind' in config file+        can derive GALE_DOMAIN from GALE_ID if necessary +        added '?' as extra help key+        fixed problem with generated C code.++0.5.2+        new pufflog format. +        fixed some memory leaks.+        fixed '-e' thanks to Adam Sampson+        builds cleanly with ghc 6.2 now.++0.5.1+        line editing for entering filters now works. supported are arrow keys,+                backspace, home,end, ^K to delete to end of line+        added EDITOR_NEWPUFF_OPTION for options to be passed to the editor+                when puffing to no categories +        added NO_PRESENCE_NOTIFY to stop presence status puffs from being+                generated.+        changed checkconfig output for GALE_SUBSCRIBE+        made selected puff much more visible++0.5.0+        uses a single TCP connection for all gale traffic now.+        better handling of network errors+        proper word-wrapping in puff display, puff preview and details display+        better external editor handling.+        more secure message ids+        'R' will resend a previously sent or recieved puff+        completly removed old polling and callback code, more responsivity and efficiency results+        matches return reciepts to puffs. use 'd' to see who recieved your puff+        requests return reciepts on private and /ping puffs automatically now++0.4.8+        now looks for GINSU_* varibales everywhere+        Makefile cleanups+        requires ghc 6.0+        Fixed terminal cooruption caused by nonprintable characters in puffs+        now uses ISO C90 charset conversion routines. +        fixed some problems with charset detection+        much much improved autoconf/automake setup+        scrolls to bottom of screen on incoming puff when already at bottom only+        added 'g' for group-reply++0.4.7+        trims blank lines at beginning and end of puff text. use+         TRIM_BLANKLINES to change this behavior+        added the ability to expand $VALUE in config files+        modified default setup in various ways+        now uses new config method, will read ~/.gale/conf+        should work anywhere gsub/gsend does+        fixes permissions on files in /tmp (bug 226)+        cleans up after itself better. (bug 226)+        default config file changes+        ability to compose marked filters (bug 227)+        fixed building from read-only directory+++0.4.6+	switched to -O2 for performance+	better locale support.+	added quit confirmation (shift-Q to quit immediatly)+	added filter documentation to help screen+	fixed docs for key notation consistancy+	added --enable-unopt for unoptimized builds+	added EDITOR_OPTION to pass arguments to your puff editor+	added puff sending confirmation screen this lets you+	    - set return receipts manually+	    - send anonymous puffs+	    - reedit puffs +	    - abort puffs+	expanded dialogs+	+0.4.5+	changed key notation to angle notation <C-x><space> etc..+	ON_INCOMING_PUFF works as expected now+	angle notation can be used in config file.+	popup informational windows for certain modal actions added+	scrolling window responds to <PageUp> and <PageDown>+	cursor handling much more robust/consistant+	numerous internal changes+	now compiles via-c for better optimization and profiling+	'./configure --enable-profile' will enable profiling support.+	sends \r\n instead of \n because some clients get confused otherwise.+	ignores SIGPIPE, just in case.+	fixed space leak on reading pufflog.++0.4.4+	implemented full server side of IdleTimeProtocol (by popular request)+	prettier printing of aliases+	added --checkconfig to verify configuration. if you are having+	  trouble, use this.+	updated man page.+	doesnt display all whitespace puffs from _gale.* ++0.4.3+	added presence screen via 'F3', lists all users and their status.+	answers return reciepts now.+	notice/presence returns idle time.+	requests return reciepts on 'private' puffs+	outgoing 'private' puffs placed in incoming puff queue.+	'Will' a puff to reset presence when ginsu dies.+	uses GALE_PRESENCE if set.+	changed configuration file syntax to match that of .gale/conf+	added ~i for case insensitive search.+	updated internal docs+	outputs error message if it can't parse the MARK_ statements.+	filter parser now parses () and ; properly.+	looks for .gpri files+	uses $GALE_DIR if available.+	prints out useful preferences to errorlog+	puff details screen available via 'd'++0.4.2+	handles fragments around security/encryption fragments properly (oops)+	adds _ginsu.timestamp and _ginsu.spumbuster to incoming puffs now.+	most errorlog messages supressed unless '-v' (info) or '-vv' (debug)+	  are specified on the command line.+	seperated pufflog command line options to allow just not writing to+	  pufflog (but still read it on startup)+	tweaked fragment printing in logs to keep them pretty.+	sanified puff numbering+	UI much less redraw-crazy. should improve responsiveness.+	resizing much smarter. still flickers, but not as much.+	uses $LOGNAME and $USER in preference to getlogin(3)+	scrollable help screen for small terminals.+	filters appear on own line when needed.+	message string used for puff author+	uses _ginsu.timestamp if no id/time available.+	added '/' to substring match puffs+	hides cursor if editor leaves it unhidden.++0.4.1+	SIGWINCH now caught to resize terminal screen (bug 194) +	    DISABLE_SIGWINCH is a config option if this is causing trouble+	now expands to GALE_DOMAIN if no alias matches (bug 200)+	fix for different versions of OpenSSL (bug 195)+	.spec file added for building RPMS+	hsc2hs rebuilds files for all source builds. probably what is wanted.+	redid Puff deconstruction, now works for more unusual but technically+	   valid types of puff.+	added id/instance fragment to satisfy certain loggers+	made printing of fragment lists cosmetically prettier.+	added --testCurses to print out some curses debugging info.+	added --dumpKey to print info about a keyfile.+	added --errorlog to choose file to output errors too.+	doesnt get confused by jgaled tracking fragments+	^L does an endwin >> refresh.++0.4.0 +	*** NOW is stand alone. can send signed puffs natively! wing-go! ***+	reads ~/.gale/aliases/ for aliases+	uses GALE_DOMAIN, GALE_ID, GALE_NAME as appropriate.+	simplified Curses interface to take advantage of newer FFI features+	added simple man page "ginsu (1)"+	robustified key parsing code. should work with all known styles of key+	cleaned up location of many routines+	made it compile when ghc is installed in wierd places+	added displays to let user know what is happening during delays+	added -P to stop loading and saving of pufflog.+	unified private key caching for sending and recieving puffs.+	key cacheing no longer uses tricky tricks.+	Sending Puffs is done in background thread in case it takes a while.+	smarter error handling and retrying. better errorlog format.+	SIGINT now caught, kills app nicely.+	added ON_INCOMING_PUFF which is a macro run whenever a puff arrives. *EXP*++0.3.9+	added PRESERVED_KEYWORDS which is a list of keywords which should be carried+	    over when replying to or following up on a puff.+	BEEP functionality now works when terminal supports it.+	ON_STARTUP added which is a macro that is run at startup+	fixed sender vs. author sillyness+	~t means ~c until category closure code is finished+	quoting fixed when sending things to the shell.++0.3.8+	now utilizes GALE_PROXY if set, otherwise it will only connect to one server+	all configuration varibles may be set in the enviornment now+	added locks around errorlog to keep long entries from getting mangled+	used MVar for reading new config file, potential obscure bug fix.+	pufflog now atomically replaces pufflog file via renaming, MVars used in BitHandle+	pufflog is updated every 30 seconds if new puffs have been recieved.+	** fixed major bug in openssl layer. cleaned up layer and memory usage considerably+	BitHandle speedups, uses strict fields++0.3.7+	fixed some potential problems when compiling with optimization+	now ~ implicity starts filter addition+	now compiles with -O -fasm+	got rid of mySystem wackyness+	seperated Message out of Puffs (note: add Messages somewhere else)+	made calling out to external programs more robust+	pufflog now 'packed'. saves factor of 8+	code cleanups, moved out Puff and EIO functionality++0.3.6+	compose with nothing selected works now+	added /usr/local as alternate for ghc install+	added URL's to help screen.+	changed puff sending keys to p,r,f to match newsreader convention+	now you add filters with 'c'+	added PUFFLOG_SIZE config option+	added EDITOR, GSEND configuration option+	added -t id/class=ginsu to gsend (doesn't seem to work.)+	UNICODE support! add a 'CHARSET utf8|latin1|ascii' line to your ginsu.config+	 make sure your terminal supports the given charset.++0.3.5+	included sample config in binary distribution+	added ^E ^Y ^F ^B ^U ^D +	added 'a' to documentation+	added emptyPuff thread to help keep gale connections alive. (needs work)+	added pagedown/pageup with the obvious meaning+	added 'E' to edit and reload configuration file+	improved filter parser+	disposed of unnecisary redraw thread+	added r,e,c to compose puffs, 'gsend' is needed for sending and $EDITOR+	   is used for editing the puff.++0.3.4+	added '\b' as alias for backspace+	added '@' and '/' in cat and keyword displays+	fixed curs_set problem on some terminals+	added ESC as alternate for help key+	greatly increased pufflog reading and writing effeciency. (still space inefficient)+	improved unexpected error handling in some cases.+	basic cryptography! ginsu will decrypt puffs for which a key can be found in+	    ~/.gale/auth/private+	made parsers much more robust against malformed data+	now writes errors to log file ~/.gale/ginsu.errorlog++0.3.3+	made gale code more robust against network errors+	finished puff persistance (stored in ~/.gale/ginsu.pufflog)++0.3.2+	added changelog+	recenter screen on filter change.+	added R to reconnect to server+	added 'f' to add to filter stack+	started work on s,S+	add string entry routines (cheezy, needs work)+	began work on puff persistance+	+0.3.1+	initial release
+ docs/ginsu-manual.html view
@@ -0,0 +1,35 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">+<html><head><title>Ginsu Manual</title><link type="text/css" rel="stylesheet" href="wiki.css"><meta http-equiv="Content-Type" content="text/html; charset=utf-8"></head><body class="http://localhost/home/john/bin/share/mup.prl"><h1>Ginsu Manual</h1><p>Ginsu is a client for the gale chat system. It is designed to be powerful and above all stable, as well as having a quick learning curve.<p><h2>Using Ginsu</h2><h3>Keys</h3><p>These are the default keybindings. You may use the action name to rebind a key. See below for details.<p><table class="user"><tr><td><b>Action Name</b></td><td><b>Default Key</b></td><td><b>Description</b></td></tr><tr><td colspan="3"><b><i>Main Screens</i></b></td></tr><tr><td>show_help_screen</td><td>&lt;F1&gt;, ?</td><td>Show help screen</td></tr><tr><td>show_presence_status</td><td>&lt;F3&gt;</td><td>show presence status</td></tr><tr><td>show_puff_details</td><td>d</td><td>show puff details</td></tr><tr><td>show_status_screen</td><td>S</td><td>show status screen</td></tr><tr><td colspan="3"><b><i>Puff Movement</i></b></td></tr><tr><td>next_puff</td><td>j, &lt;Down&gt;</td><td>Goto the next puff</td></tr><tr><td>previous_puff</td><td>k, &lt;Up&gt;</td><td>Goto the previous puff</td></tr><tr><td>first_puff</td><td>&lt;Home&gt;</td><td>Goto the first puff</td></tr><tr><td>last_puff</td><td>&lt;End&gt;, G</td><td>Goto the last puff</td></tr><tr><td>next_line</td><td>&lt;Enter&gt;, &lt;C-E&gt;</td><td>Scroll one line down</td></tr><tr><td>previous_line</td><td>&lt;BackSpace&gt;, &lt;C-Y&gt;</td><td>Scroll one line up</td></tr><tr><td>next_page</td><td>&lt;C-F&gt;, &lt;PageDown&gt;</td><td>Scroll one page down</td></tr><tr><td>previous_page</td><td>&lt;C-B&gt;, &lt;PageUp&gt;</td><td>Scroll one page up</td></tr><tr><td>forward_half_page</td><td>&lt;C-D&gt;</td><td>Scroll a half page down</td></tr><tr><td>backward_half_page</td><td>&lt;C-U&gt;</td><td>Scroll a half page up</td></tr><tr><td colspan="3"><b><i>Filter Manipulation</i></b></td></tr><tr><td>prompt_new_filter</td><td>c</td><td>prompt new filter</td></tr><tr><td>prompt_new_filter_slash</td><td>/</td><td>prompt new filter slash</td></tr><tr><td>prompt_new_filter_twiddle</td><td>~</td><td>prompt new filter twiddle</td></tr><tr><td>pop_one_filter</td><td>u</td><td>pop one filter</td></tr><tr><td>pop_all_filters</td><td>U</td><td>pop all filters</td></tr><tr><td>invert_filter</td><td>!</td><td>invert filter</td></tr><tr><td>filter_current_thread</td><td>t, T</td><td>filter current thread</td></tr><tr><td>swap_filters</td><td>x</td><td>swap filters</td></tr><tr><td>filter_current_author</td><td>a</td><td>filter current author</td></tr><tr><td colspan="3"><b><i>Puff Body Filtering</i></b></td></tr><tr><td>toggle_rot13</td><td>&lt;C-o&gt;</td><td>toggle Rot13 filter</td></tr><tr><td colspan="3"><b><i>Mark/Workspace Manipulation</i></b></td></tr><tr><td>set_mark</td><td>m</td><td>save current position at a given mark.</td></tr><tr><td>recall_mark</td><td>&lt;SingleQuote&gt;</td><td>goto position saved at mark</td></tr><tr><td>set_filter_mark</td><td>M</td><td>save current filter stack at given mark.</td></tr><tr><td>recall_filter_mark</td><td>&lt;DoubleQuote&gt;</td><td>Recall filter stack at mark</td></tr><tr><td>recall_combine_mark</td><td>C</td><td>Recall filter stack at mark and combine it with the current filter stack.</td></tr><tr><td>recall_workspace</td><td>[1-9]</td><td>Recall given numbered workspace and set it as current workspace, these follow marks [1-9]</td></tr><tr><td colspan="3"><b><i>Composing Puffs</i></b></td></tr><tr><td>new_puff</td><td>p</td><td>compose a new puff</td></tr><tr><td>follow_up</td><td>f</td><td>follow up to the same category as the current puff</td></tr><tr><td>reply_to_author</td><td>r</td><td>reply to the author of the current puff privatly</td></tr><tr><td>group_reply</td><td>g</td><td>reply to the union of the sender and categories of the current puff</td></tr><tr><td>resend_puff</td><td>R</td><td>resend puff</td></tr><tr><td colspan="3"><b><i>Miscellaneous</i></b></td></tr><tr><td>goto_match</td><td>v</td><td>visit link in current puff</td></tr><tr><td>modify_presence_string</td><td>N</td><td>modify presence string</td></tr><tr><td>reconnect_to_servers</td><td>&lt;C-r&gt;</td><td>reconnect to servers</td></tr><tr><td>edit_config_file</td><td>E</td><td>Edit the configuration file and reload its settings</td></tr><tr><td>ask_quit</td><td>q</td><td>quit ginsu</td></tr><tr><td>fast_quit</td><td>Q</td><td>quit ginsu without asking first</td></tr><tr><td>redraw_screen</td><td>&lt;C-l&gt;</td><td>redraw screen</td></tr></table> <h3>Options</h3><p><pre class="real">ginsu [OPTIONS]...  [categories]...+</pre><p><table class="user"><tr><td colspan="2">Available Options</td></tr><tr><td>-v, --verbose</td><td>increase verbosity output to errorlog.</td></tr><tr><td>-V, --version</td><td>print version information</td></tr><tr><td>-s, --sample-config</td><td>print sample configuration file to stdout</td></tr><tr><td>-m, --man</td><td>print all internal help screens to stdout</td></tr><tr><td>-e, --justargs</td><td>only subscribe to command line arguments</td></tr><tr><td>-P</td><td>do not write to pufflog</td></tr><tr><td>--help</td><td>show this help screen</td></tr><tr><td>--nopufflog</td><td>do not read or write pufflog</td></tr><tr><td>--errorlog <i>&lt;FILE&gt;</i></td><td>log errors to file</td></tr><tr><td>--dumpkey <i>&lt;KEYFILE&gt;</i></td><td>print info for keyfile</td></tr><tr><td>--checkconfig</td><td>check and print out configuration</td></tr></table> <h3>Filters</h3><p>Filters are used throughout ginsu. A filter is an expression which selects puffs which match it.<p>Filters are built up from primitives via conjunctions, disjunctions and grouping, allowing complex filters to be created.<p><pre class="real">a ; b - semicolons are used to mean OR. this matches if a OR b matches+a b - a space means AND. this matches if a AND b both match+(a b) ; c - filters may be grouped with parenthesis+!a - NOT. this matches if a does not match+</pre><p>primitive filters are regular expressions which are matched against the body of the puff, or a variety of special forms beginning with a ~ then a single character, then a colon, then the rest of the special form. If the text following the colon begins with a letter, the colon may be omitted. Arbitrary text may be used in filters by quoting it with single quotes.<p><table class="user"><tr><td colspan="2">Special Forms</td></tr><tr><td>~a:&lt;gale-id&gt;</td><td>author of puff</td></tr><tr><td>~c:&lt;category&gt;</td><td>category puff was sent too</td></tr><tr><td>~k:&lt;regex&gt;</td><td>regex match against keywords</td></tr><tr><td>~s:&lt;regex&gt;</td><td>regex match against senders real name</td></tr><tr><td>~b:&lt;regex&gt;</td><td>regex match against message body</td></tr><tr><td>/&lt;regex&gt;</td><td>search everything visible for regex</td></tr><tr><td>?true</td><td>always succeed</td></tr><tr><td>?false</td><td>always fail</td></tr><tr><td>?signed</td><td>puff is signed</td></tr><tr><td>?encrypted</td><td>puff is encrypted</td></tr></table><p>Examples of Filters:<p><pre class="real"> (~a:john@ugcs.caltech.edu) - all puffs by me+ (~c:pub.tv.buffy ~a:jtr@ofb.net) - puffs from jtr and to pub.tv.buffy+ ( /[gG]insu ; ~c:pub.gale.ginsu) - puffs containing the word ginsu or directed to pub.comp.ginsu+ ( /'(?i)john +meacham' ) - puffs with my name in them+ (!~k:^spoil) - no spoilers+ (~c:pub.tv.buffy !~c:pub.meow) - puffs to buffy which are not about cats+</pre><h3>The Filter Stack</h3><p>There is always a current filter stack, which is a set of filters that determines which puffs are currently visible. there are a variety of keystrokes to modify the filter stack. If non-empty, the current filter stack is displayed on the bottom line of the main screen.<p><h2>Environment Variables</h2><dl><dt>BROWSER </dt><dd> which web browser to use in the default application hooks. </dd><dt>EDITOR </dt><dd> used if $VISUAL is not set. </dd><dt>GALE_CONF </dt><dd> name of alternate Gale configuration file to read. This does not change the name of the ginsu specific configuration file. </dd><dt>GALE_DIR </dt><dd> alternate location for user's gale directory. ~/.gale/ by default. </dd><dt>VISUAL </dt><dd> editor to use for composing puffs.</dd></dl><p>If any of these exist in the environment prefixed with GINSU_, they are preferred over the bare versions.<p><h2>Configuration Options</h2><h3>Standard Gale Options Honored by Ginsu</h3><dl><dt>GALE_DOMAIN </dt><dd> The current gale domain. </dd><dt>GALE_ID </dt><dd> Your gale id. default is $LOGNAME@$GALE_DOMAIN </dd><dt>GALE_NAME </dt><dd> Your real name used in puffs sent. </dd><dt>GALE_PRESENCE </dt><dd> default presence string to send out. </dd><dt>GALE_PROXY </dt><dd> This can be used to override which gale server to connect to. </dd><dt>GALE_SUBSCRIBE </dt><dd> List of categories to subscribe to. The default is some common public categories and your private address.</dd></dl><p>see also: <a href="http://gale.org/users/vars">http://gale.org/users/vars</a><p><h3>Ginsu Specific Options</h3><dl><dt>BEEP </dt><dd> beep on incoming puffs which match this filter. </dd><dt>BROWSER </dt><dd> set the web browser. This overrides the environment. This is only used by the default 'apphook' declarations. see below. </dd><dt>CHARSET </dt><dd> character set to assume files are in. This will become obsolete at some point. </dd><dt>DISABLE_SIGWINCH </dt><dd> do not install sigwinch handler. ignore if you don't know what this means. </dd><dt>EDITOR_NEWPUFF_OPTION </dt><dd> options passed to editor when beginning a new puff. </dd><dt>EDITOR_OPTION </dt><dd> options passed to editor when replying to a puff. </dd><dt>MARK_[1-9] </dt><dd> these should be set to filters which are activated by the corresponding number key. </dd><dt>NO_PRESENCE_NOTIFY </dt><dd> disable presence notifications. </dd><dt>ON_INCOMING_PUFF </dt><dd> macro to run when new puff is received. </dd><dt>ON_STARTUP </dt><dd> on startup, run this macro. </dd><dt>PRESERVED_KEYWORDS </dt><dd> when replying to a puff, keep these keywords intact. </dd><dt>PUFFLOG_SIZE </dt><dd> number of puffs to store in the pufflog. </dd><dt>SCROLLBACK_SIZE </dt><dd> maximum number of puffs to keep in memory (or 0 for no limit). </dd><dt>TRIM_BLANKLINES </dt><dd> before sending a puff, get rid of leading and trailing blank lines. </dd><dt>VISUAL </dt><dd> set the editor. This overrides the environment. </dd><dt>USE_DEFAULT_COLORS </dt><dd> use the default colors of your terminal if possible. </dd><dt>PUFF_DATE_FORMAT </dt><dd> format string to use in puff display</dd></dl><p><h3>Changing Keybindings</h3><p>keys may be rebound with the 'bind' keyword in the configuration file. the syntax is <pre class="real">bind &lt;key&gt; &lt;command&gt;+</pre><p>here are some examples: <pre class="real">bind &lt;C-r&gt; reconnect_to_servers+bind c prompt_new_filter+bind v goto_match+</pre><h3>Changing Application Hooks</h3><p>When puff bodies match regular expressions, the user may choose to run arbitrary commands based on them. This can be used to follow web links in puffs for instance. The 'apphook' mechanism is fully configurable via using 'apphook' lines in your <tt>ginsu.config</tt> file.<p>The general form is: <pre class="real">apphook &lt;name&gt;+        &lt;regular expression&gt;+        &lt;command to run&gt;+        [string user sees in menu ("$0" by default)]+</pre>in the command and menu string, <tt>$0</tt> is replaced by the whole regex match and <tt>$1, $2, .. $9</tt> are replaced by the substrings captured by parenthesis in the regular expression.<p><pre class="real">apphook WikiWord+        '([[:space:]]|^)(([[:upper:]][[:lower:]]+){2,})([[:space:]]|$)'+        '$BROWSER ''http://wiki.ofb.net/?$2'''+        '$2'++apphook URL+        '(http|ftp)s?://(%[[:digit:]A-Fa-f][[:digit:]A-Fa-f]|[-_.!~*'';/?:@&amp;=+$,[:alnum:]])+'+        '$BROWSER ''$0'''+</pre><h3>Category Aliases</h3><p>Ginsu uses the same alias mechanism as 'gsend'. Aliases take the form of symbolic links in the aliases directory in the gale directory.<p>Here is an example of how to create new aliases.<p><pre class="real">mkdir ~/.gale/aliases  # only if it does not already exist+cd ~/.gale/aliases+ln -s pub pub@ofb.net+ln -s ugcs ugcs@ugcs.caltech.edu+</pre><h2>Files ginsu uses</h2><p>$GALE_DIR is ~/.gale/ by default.<p><dl><dt><tt>$GALE_DIR/ginsu.config</tt> </dt><dd> main configuration file. </dd><dt><tt>$GALE_DIR/ginsu.<i>n</i>.pufflog</tt> </dt><dd> pufflog version <i>n</i> </dd><dt><tt>$GALE_DIR/ginsu.errorlog</tt> </dt><dd> main configuration file. </dd><dt><tt>$GALE_DIR/auth/private/*</tt> </dt><dd> This is where ginsu looks for private keys for decoding incoming encrypted puffs. </dd><dt><tt>$GALE_DIR/auth/cache/*</tt> </dt><dd> This is where ginsu looks for and stores public keys.</dd></dl><p><h2>Other ginsu resources</h2><ul><li><a href="http://repetae.net/john/computer/ginsu/">http://repetae.net/john/computer/ginsu/</a> - the project homepage </li><li><a href="http://wiki.ofb.net/?GinsuFaq">http://wiki.ofb.net/?GinsuFaq</a> - the ginsu FAQ and wiki </li><li><a href="http://gale.org/">http://gale.org/</a> - gale homepage </li><li><a href="http://bugs.ofb.net/cgi-bin/bugzilla/enter_bug.cgi?product=Ginsu">http://bugs.ofb.net/cgi-bin/bugzilla/enter_bug.cgi?product=Ginsu</a> - report bugs here. </li><li><a href="http://repetae.net/john/">http://repetae.net/john/</a> - author's homepage.</li></ul><p>There is also a public arch repository for ginsu at <a href="http://repetae.net/john/arch/2004/">http://repetae.net/john/arch/2004/</a><p>+</body>+</html>
+ docs/ginsu-manual.txt view
@@ -0,0 +1,207 @@+= Ginsu Manual =++Ginsu is a client for the gale chat system. It is designed to be powerful and+above all stable, as well as having a quick learning curve.+++== Using Ginsu ==+++=== Keys ===++These are the default keybindings. You may use the action name to rebind a key. See below for details.++<include `perl ../gen_keyhelp.prl -c ../ginsu.config.sample ../actions.def`>++=== Options ===++<pre>+ginsu [OPTIONS]...  [categories]...+</pre>++<include `../ginsu --showOptions`>++=== Filters ===++Filters are used throughout ginsu. A filter is an expression which selects+puffs which match it.++Filters are built up from primitives via conjunctions, disjunctions and+grouping, allowing complex filters to be created.++<pre>+a ; b - semicolons are used to mean OR. this matches if a OR b matches+a b - a space means AND. this matches if a AND b both match+(a b) ; c - filters may be grouped with parenthesis+!a - NOT. this matches if a does not match+</pre>++primitive filters are regular expressions which are matched against the body+of the puff, or a variety of special forms beginning with a ~ then a single+character, then a colon, then the rest of the special form. If the text+following the colon begins with a letter, the colon may be omitted. Arbitrary+text may be used in filters by quoting it with single quotes.+++||||  Special Forms  ||+|| ~a:<gale-id>||author of puff ||+|| ~c:<category>||category puff was sent too ||+|| ~k:<regex>||regex match against keywords ||+|| ~s:<regex>||regex match against senders real name ||+|| ~b:<regex>||regex match against message body ||+|| /<regex>|| search everything visible for regex ||+|| ?true || always succeed ||+|| ?false || always fail ||+|| ?signed || puff is signed ||+|| ?encrypted || puff is encrypted ||++Examples of Filters:++<pre>+ (~a:john@ugcs.caltech.edu) - all puffs by me+ (~c:pub.tv.buffy ~a:jtr@ofb.net) - puffs from jtr and to pub.tv.buffy+ ( /[gG]insu ; ~c:pub.gale.ginsu) - puffs containing the word ginsu or directed to pub.comp.ginsu+ ( /'(?i)john +meacham' ) - puffs with my name in them+ (!~k:^spoil) - no spoilers+ (~c:pub.tv.buffy !~c:pub.meow) - puffs to buffy which are not about cats+</pre>+++=== The Filter Stack ===++There is always a current filter stack, which is a set of filters that+determines which puffs are currently visible. there are a variety of+keystrokes to modify the filter stack. If non-empty, the current filter stack+is displayed on the bottom line of the main screen.+++== Environment Variables ==++; BROWSER : which web browser to use in the default application hooks.+; EDITOR : used if $VISUAL is not set.+; GALE_CONF : name of alternate Gale configuration file to read. This does not change the name of the ginsu specific configuration file.+; GALE_DIR  : alternate location for user's gale directory. ~/.gale/ by default.+; VISUAL : editor to use for composing puffs.++If any of these exist in the environment prefixed with GINSU_, they are+preferred over the bare versions.+++== Configuration Options ==+++=== Standard Gale Options Honored by Ginsu ===++; GALE_DOMAIN : The current gale domain.+; GALE_ID : Your gale id. default is $LOGNAME@$GALE_DOMAIN+; GALE_NAME : Your real name used in puffs sent.+; GALE_PRESENCE : default presence string to send out.+; GALE_PROXY : This can be used to override which gale server to connect to.+; GALE_SUBSCRIBE : List of categories to subscribe to. The default is some common public categories and your private address.++see also:  http://gale.org/users/vars++=== Ginsu Specific Options ===++; BEEP : beep on incoming puffs which match this filter.+; BROWSER : set the web browser. This overrides the environment. This is only used by the default 'apphook' declarations. see below.+; CHARSET : character set to assume files are in. This will become obsolete at some point.+; DISABLE_SIGWINCH : do not install sigwinch handler. ignore if you don't know what this means.+; EDITOR_NEWPUFF_OPTION : options passed to editor when beginning a new puff.+; EDITOR_OPTION : options passed to editor when replying to a puff.+; MARK_[1-9] : these should be set to filters which are activated by the corresponding number key.+; NO_PRESENCE_NOTIFY : disable presence notifications.+; ON_INCOMING_PUFF : macro to run when new puff is received.+; ON_STARTUP : on startup, run this macro.+; PRESERVED_KEYWORDS : when replying to a puff, keep these keywords intact.+; PUFFLOG_SIZE : number of puffs to store in the pufflog.+; SCROLLBACK_SIZE : maximum number of puffs to keep in memory (or 0 for no limit).+; TRIM_BLANKLINES : before sending a puff, get rid of leading and trailing blank lines.+; VISUAL : set the editor. This overrides the environment.+; USE_DEFAULT_COLORS : use the default colors of your terminal if possible.+; PUFF_DATE_FORMAT : format string to use in puff display++++=== Changing Keybindings ===++keys may be rebound with the 'bind' keyword in the configuration file. the syntax is+<pre>+bind <key> <command>+</pre>++here are some examples:+<pre>+bind <C-r> reconnect_to_servers+bind c prompt_new_filter+bind v goto_match+</pre>+++=== Changing Application Hooks ===++When puff bodies match regular expressions, the user may choose to run+arbitrary commands based on them. This can be used to follow web links in+puffs for instance. The 'apphook' mechanism is fully configurable via using+'apphook' lines in your <tt>ginsu.config</tt> file.++The general form is:+<pre>+apphook <name>+        <regular expression>+        <command to run>+        [string user sees in menu ("$0" by default)]+</pre>+in the command and menu string, <tt>$0</tt> is replaced by the whole regex match and+<tt>$1, $2, .. $9</tt> are replaced by the substrings captured by parenthesis+in the regular expression.++++<pre>+apphook WikiWord+        '([[:space:]]|^)(([[:upper:]][[:lower:]]+){2,})([[:space:]]|$)'+        '$BROWSER ''http://wiki.ofb.net/?$2'''+        '$2'++apphook URL+        '(http|ftp)s?://(%[[:digit:]A-Fa-f][[:digit:]A-Fa-f]|[-_.!~*'';/?:@&=+$,[:alnum:]])+'+        '$BROWSER ''$0'''+</pre>++=== Category Aliases ===++Ginsu uses the same alias mechanism as 'gsend'. Aliases take the form of+symbolic links in the aliases directory in the gale directory.++Here is an example of how to create new aliases.++<pre>+mkdir ~/.gale/aliases  # only if it does not already exist+cd ~/.gale/aliases+ln -s pub pub@ofb.net+ln -s ugcs ugcs@ugcs.caltech.edu+</pre>++== Files ginsu uses ==++$GALE_DIR is ~/.gale/ by default.++; <tt>$GALE_DIR/ginsu.config</tt> : main configuration file.+; <tt>$GALE_DIR/ginsu.<i>n</i>.pufflog</tt> : pufflog version <i>n</i>+; <tt>$GALE_DIR/ginsu.errorlog</tt> : main configuration file.+; <tt>$GALE_DIR/auth/private/*</tt> : This is where ginsu looks for private keys for decoding incoming encrypted puffs.+; <tt>$GALE_DIR/auth/cache/*</tt> : This is where ginsu looks for and stores public keys.++== Other ginsu resources ==++* http://repetae.net/john/computer/ginsu/ - the project homepage+* http://wiki.ofb.net/?GinsuFaq - the ginsu FAQ and wiki+* http://gale.org/ - gale homepage+* http://bugs.ofb.net/cgi-bin/bugzilla/enter_bug.cgi?product=Ginsu - report bugs here.+* http://repetae.net/john/ - author's homepage.++There is also a public arch repository for ginsu at http://repetae.net/john/arch/2004/++<html>+</html>
+ docs/ginsu.1 view
@@ -0,0 +1,147 @@+.TH ginsu 1 "" "" "Gale Chat Client"+.SH NAME+ginsu \- gale chat system client+.SH SYNOPSIS++Usage: ginsu [OPTION...] categories...+  -v  --verbose          verbose output to errorlog, -vv for debugging info too.+  -V  --version          print version information+  -s  --sample           print sample configuration file to stdout+  -m  --man              print all internal help screens to stdout+  -e  --justargs         only subscribe to command line arguments+  -P                     do not write to pufflog+      --help             show this help screen+      --nopufflog        do not read or write pufflog+      --errorlog=FILE    log errors to file+      --testCurses       print curses diagnostics+      --dumpKey=KEYFILE  print info for keyfile+      --checkconfig      check and print out configuration++To get started, generate a configuration file using the following command:+   mkdir ~/.gale ; ginsu -s > ~/.gale/ginsu.config+Edit the configuration file and run ginsu!++The homepage is at: <http://repetae.net/john/computer/ginsu/>+++.SH DESCRIPTION+.BR "ginsu"+is a client for the +.BR "gale chat system"+which can be learned about at +.BR "<http://gale.org/>"++To get started, generate a configuration file using the following command:++.BR "mkdir ~/.gale ; ginsu -s > ~/.gale/ginsu.config"++Edit the configuration file and run ginsu. You may use F1 for help while running ginsu.++If you have problems, ginsu --checkconfig will print out ginsu's current configuration settings.+.SH USING GINSU+++            Keys:    +             <F1>    Help Screen+             <F2>    Main Screen+             <F3>    Presence Status Screen+                     +                j    next puff+                k    previous puff+           <Home>    first puff+            <End>    last puff+    <Enter> <C-E>    forward one line+<BackSpace> <C-Y>    back one line+   <C-F> <PgDown>    forward one page+     <C-B> <PgUp>    back one page+            <C-D>    forward one half-page+            <C-U>    back one half-page+                     +                d    Show puff details+                     +              c ~    add new filter+                u    pop one filter+                U    pop all filters+                !    invert filter at top of stack+                x    swap top two filters on stack+                a    filter to current author+                t    filter to current thread+                T    filter to strict thread+           m[1-9]    set mark - save current filter stack at given key+            [1-9]    recall filter stack saved here with 'm'+           C[1-9]    recall filter stack and add it to current filter stack+                     +            <C-O>    toggle Rot13 body filter+                     +                f    follow-up to category+                p    compose new puff+                r    reply to author+                g    group reply, sends to recipients and author of puff+                N    modify public presence string+                     +            <C-R>    reconnect to all servers+                E    edit and reload configuration file+              q Q    quit program+            <C-L>    redraw screen++Filters:+    Filters are implemented as Boolean expressions. The building blocks+    are primitives which usually begin with ~ and are combined with+    semicolon for disjunction, space for conjunction, exclamation point+    for negation and parenthesis for grouping. The current filter stack+    is displayed on the bottom line of the screen when it is nonempty,+    the filters on the stack are conjoined together to determine which+    puffs are visible++Primitive Filters:    +                ~a    author+                ~c    category+                ~i    case insensitive substring search+                ~k    keyword+                ~s    puffers real name+         (default)    substring search++Filter Examples:+    (~a:john@ugcs.caltech.edu) - all puffs by john@ugcs+    (~c:pub.tv.buffy ~a:jtr@ofb.net) - puffs from jtr and to pub.tv.buffy+    (ginsu ; ~c:pub.gale.ginsu) - puffs containing the word ginsu or directed to pub.gale.ginsu+    (!~k:spoil) - no spoilers+    (~c:pub.tv.buffy !~c:pub.meow) - puffs to buffy which are not about cats+++.SH ENVIRONMENT+configuration variables are first looked for in the environment. In general, for+configuration variable FOO, the following places will be checked in order:+ GINSU_FOO in the environment+ FOO in the config file+ FOO in the environment+ +.SH FILES+.TP+.BR "~/.gale/ginsu.config"+this is the main configuration file+.TP+.BR "~/.gale/ginsu.pufflog"+where puffs are stored between invocations+.TP+.BR "~/.gale/ginsu.errorlog"+errors are logged here, useful when submitting a bug report+.TP+.BR "~/.gale/auth/private/*"+this is where ginsu looks for your private key for decoding incoming encrypted messages.+.SH BUGS+To report a bug go to +.BR "<http://bugs.ofb.net/cgi-bin/bugzilla/enter_bug.cgi?product=Ginsu>"+When reporting a bug, include the last few lines of +.BR "~/.gale/ginsu.errorlog"+if it seems appropriate as well as the output from+.BR "ginsu --checkconfig"++.SH AUTHOR+ginsu was written by John Meacham. +The homepage is at +.BR "<http://repetae.net/john/computer/ginsu/>"+++.SH "SEE ALSO"+.BR "<http://gale.org/>"
+ docs/wiki.css view
@@ -0,0 +1,106 @@+div.diff { padding-left:5%; padding-right:5% }+div.old { background-color:#FFFFAF }+div.new { background-color:#CFFFCF}+div.refer { padding-left:5%; padding-right:5%; font-size:smaller; }+table.history { border-style:none; }+td.history { border-style:none; }+table.user { border-style:solid; border-width:thin; margin-left:5%; }+table.user tr td { border-style:solid; border-width:thin; padding:5px; }+img.logo {+    float: right;+    clear: right;+    border-style:none;+    background-color:#fff;+}+img {+    border: #777777 1px solid;+    padding: 0.5em;+    margin-left: 1em;+    margin-right: 2em;+    background-color: #e6e6e6;+    color: black;+}+img.smiley {+    border:none;+    padding:0;+    margin:0;+    background:#fff;+    color:#000;+}    ++div.header img, div.footer img { border:0; padding:0; margin:0; }++span.author {+    color: #501;+}++@media print {+    span.gotobar { display:none; }+    div.refer { display:none; }+    div.footer { display:none; }+}++body {+    background:#fff;+    padding:2% 5%;+    margin:0;+}++a {+    text-decoration:none;+    font-weight:bold;+    color:#c00;+}++a:visited { color:#c55; }++a:hover {+    background:#000000;+    color:#FFFFFF;+}++p a.definition {+    color:#666;+    padding: 2px;+    margin-top: 5px;+    border-bottom: 2px solid #000000;+    text-decoration:none;+    display:block; +}++p a.definition:hover {+    background:#000000;+    color:#FFFFFF;+}++h1, h2, h3, h4, h1 a, h2 a, h3 a, h4 a { color:#666; }+h1, h2, h3, h4 { font-size:medium; margin:4ex 0 1ex 0; padding:0; }+h1, h2 { border-bottom: 2px solid #000; }+h3 { border-bottom: 1px dashed #000; }+h1 { font-size:large; border-bottom: 3px solid #000; margin:4ex 0 1ex 0; padding:0;}++div.header h1 {+    font-size:xx-large; margin-top:1ex;+    border-bottom: 5px solid #000;+}++hr {+    border:none;+    color:black;+    background-color:#000;+    height:2px; +    margin-top:2ex;+}+div.footer hr { height:4px; }++pre {+    border: #777777 1px solid;+    padding: 0.5em;+    margin-left: 1em;+    margin-right: 2em;+    white-space: pre;+    background-color: #e6e6e6;+    color: black;+}++body.magenta a { color:#639; }
+ gen_keyhelp.prl view
@@ -0,0 +1,72 @@+#!/usr/bin/perl -w++use strict;+use Getopt::Std;+use IO::File;+use Data::Dumper;++my %o;+my %cm;+my @hs;+getopts('hc:',\%o) || die "bad options";++$o{c} ||= "ginsu.config.sample";++sub newsection ($) {+    if ($o{h}) {+        push @hs, "Left \"$_[0]\"";+    } else {+        print "|||||| <b><i>$_[0]</i></b> ||\n";+    }+}++sub key ($$) {+    my $d = $_[1] || $_[0];+    $d =~ tr/_/ /;+    if ($o{h}) {+        push @hs, "Right (gk \"$_[0]\", \"$d\")"+    } else {+        my $dk = join ", ", @{$cm{$_[0]}};+        print "||$_[0]|| $dk ||$d||\n";+    }+}++sub spkey ($$$) {+    my $d = $_[2] || $_[0];+    $d =~ tr/_/ /;+    my $dk = $_[1];+    if ($o{h}) {+        push @hs, "Right (\"$_[1]\", \"$d\")"+    } else {+        print "||$_[0]|| $dk ||$d||\n";+    }+}++if (!$o{h}) {++    my $cfd = new IO::File "<$o{c}" || die "open: $!";++    while (<$cfd>) {+        next unless /^bind\s+(\S+)\s+(\w+)\s*$/;+        push @{$cm{$2}}, $1;   +    } ++}++++print "|| <b>Action Name</b> || <b>Default Key</b> || <b>Description</b> ||\n" unless $o{h};++print "module KeyHelpTable(keyHelpTable) where\n\n" if $o{h};+print "keyHelpTable gk = [\n" if $o{h};                            ++while (<>) {+    next if /^\s*(\#.*)?\s*$/;+    newsection($1),next if /^\@(.*?)\s*$/;+    spkey($1, $2, $3),next if /^\%(\w*)\s+(\S+)\s*(.+?)?\s*$/;+    key($1, $2),next if /^(\w*)\s*(.+?)?\s*$/;+}++print "\t ", join("\n\t,", @hs), "\n";++print "\t]\n" if $o{h};
+ ginsu-mdk view
@@ -0,0 +1,286 @@+#!/usr/bin/env python2++import xmlrpclib, sys, getopt, os, getpass, string+++defaultserver= 'https://yammer.net:1115/mdk.psp'++def usage():+  print """usage:++    Normal usage:+    %(cmd)s [-m URI]+      interactive dialog to issue and write a key++    More fine-grained commands:+    %(cmd)s [-m URI] ls+      list available domains+    %(cmd)s [-m URI] gen USER@DOM.AIN [-r PR] [-u PU] -e EM /FN+      generate key+    %(cmd)s [-m URI] get USER@DOM.AIN [-r PR] [-u PU]+      issue a key (you must have the account password)+    %(cmd)s [-m URI] regen USER@DOM.AIN [-r PR] [-u PU]+      reissue a key (you must have the account password)+    %(cmd)s [-m URI] revoke USER@DOM.AIN+      revoke a key (you must have the account password)+    %(cmd)s [-m URI] change-password USER@DOM.AIN+      change the account password for a key+    %(cmd)s [-m URI] reset-password USER@DOM.AIN+      reset the account password for a key and email it to the key's owner++    -m URI   the Marmaduke server URI (default: %(defaultserver)s)+    -r PR    write the pRivate key to file PR instead of key directory+    -u PU    write the pUblic key to file PU instead of key directory+    -e EM    email address; passwords are sent to this address+    /FN      full name of user, preceded by a slash++    Marmaduke command line client version 1.0pre.2161,+    generated on Yammer.+    """ % {'cmd': sys.argv[0], 'defaultserver': defaultserver}++def handleLs(server, args):+  domains= server.listDomains()+  print string.join(domains)++def handleGen(server, args):+  requiredArguments('key email fullname'.split(), args)+  privPath= '%(galedir)s/%(key)s.gpri' % args+  if args.has_key('priv') and args['priv'] is not None:+    privPath= priv+  pubPath= '%(galedir)s/%(key)s.gpub' % args+  if args.has_key('pub') and args['pub'] is not None:+    pubPath= pub+  keys= server.generateKey(args['key'], args['fullname'], args['email'])+  saveKeys(keys, privPath, pubPath)+  kgenMsg()++def handleGet(server, args):+  requiredArguments('key'.split(), args)+  privPath= '%(galedir)s/%(key)s.gpri' % args+  if args.has_key('priv') and args['priv'] is not None:+    privPath= priv+  pubPath= '%(galedir)s/%(key)s.gpub' % args+  if args.has_key('pub') and args['pub'] is not None:+    pubPath= pub+  passwd= getPassword()+  keys= server.issue(args['key'], passwd)+  saveKeys(keys, privPath, pubPath)++def handleRegen(server, args):+  requiredArguments('key'.split(), args)+  privPath= '%(galedir)s/%(key)s.gpri' % args+  if args.has_key('priv') and args['priv'] is not None:+    privPath= priv+  pubPath= '%(galedir)s/%(key)s.gpub' % args+  if args.has_key('pub') and args['pub'] is not None:+    pubPath= pub+  passwd= getPassword()+  keys= server.reissue(args['key'], passwd)+  saveKeys(keys, privPath, pubPath)++def handleRevoke(server, args):+  requiredArguments('key'.split(), args)+  privPath= '%(galedir)s/%(key)s.gpri' % args+  pubPath= '%(galedir)s/%(key)s.gpub' % args+  passwd= getPassword()+  keys= server.revoke(args['key'], passwd)+  eraseKeys(privPath, pubPath)++def handleChPwd(server, args):+  requiredArguments('key'.split(), args)+  repeat= 1+  while repeat:+    oldpasswd= getPassword('Current password: ')+    newpasswd1= getPassword('New password: ')+    newpasswd2= getPassword('Re-enter new password: ')+    if newpasswd1 != newpasswd2:+      sys.stderr.write('new passwords do not match\n')+    else:+      repeat= 0+  server.changePassword(args['key'], oldpasswd, newpasswd1)+  sys.stderr.write('password changed\n')++def handleRePwd(server, args):+  requiredArguments('key'.split(), args)+  repeat= 1+  server.forgotPassword(args['key'])+  sys.stderr.write('password reset and emailed to user\n')++def handleWizard(server, args):+  domains= server.listDomains()+  print 'Available domains: ' + string.join(domains)+  print+  repeat= 1+  user, fullname, email= None, None, None+  while repeat:+    print '\nWhat username do you want?  Include the domain (example, ' + \+      'user@whatever.com).'+    user= readLine()+    if user.find('@') < 1:+      user= user + '@' + domains[0]+      print 'Adding default domain -> ' + user+    args['user']= user+    print '\nWhat is your full name?'+    if fullname is not None:+      print '[hit enter to use "%s"]' % fullname+    fullname= readLine(fullname)+    print '\nWhat is your email address?'+    if email is not None:+      print '[hit enter to use "%s"]' % email+    email= readLine(email)+    try:+      keys= server.generateKey(user, fullname, email)+      print+      saveKeys(keys, '%(galedir)s/%(user)s.gpri' % args,+        '%(galedir)s/%(user)s.gpub' % args)+      kgenMsg()+      repeat= 0+    except xmlrpclib.Fault, fault:+      handleFault(fault)+      if fault.faultCode == 111:+        print 'If you have the password for %s, enter it now.' % user+        print 'Otherwise, just hit enter.'+        if regenWizard(server, user, args['galedir']):+          return+        print++def regenWizard(server, keyid, galedir):+  repeat= 1+  while repeat:+    password= getPassword('password for %s: ' % keyid)+    if len(password) == 0:+      return 0+    try:+      keys= server.reissue(keyid, password)+      print+      saveKeys(keys, '%(galedir)s/%(keyid)s.gpri' % locals(),+        '%(galedir)s/%(keyid)s.gpub' % locals())+      repeat= 0+      return 1+    except xmlrpclib.Fault, fault:+      handleFault(fault)+++++def kgenMsg():+  sys.stderr.write('\nKey generated.  Watch your mailbox for an account ' + \+    'password;\nthis will be needed if you want to reissue or revoke\n' + \+    'your key, and can also be used to log in to the appropriate instance\n' + \+    'of Yammer.\n')++++def eraseKeys(privPath, pubPath):+  sys.stderr.write('\n')+  if os.path.exists(privPath):+    sys.stderr.write('erasing private key %s\n' % privPath)+    os.unlink(privPath)+  if os.path.exists(pubPath):+    sys.stderr.write('erasing public key %s\n' % pubPath)+    os.unlink(pubPath)++def saveKeys(keys, privPath=None, pubPath=None):+  sys.stderr.write('writing private key to %s\n' % privPath)+  mkdirDashP(privPath)+  p= open(privPath, 'w')+  p.write(keys['private'].data)+  p.close()+  mkdirDashP(pubPath)+  sys.stderr.write('writing public key to %s\n' % pubPath)+  p= open(pubPath, 'w')+  p.write(keys['public'].data)+  p.close()++def mkdirDashP(filename):+  path= os.path.dirname(filename)+  if not os.path.exists(path):+    os.makedirs(path)++def requiredArguments(reqs, args):+  a= [x for x in reqs if x not in args or args[x] is None]+  if len(a) > 0:+    print 'missing argument(s): ' + string.join(a)+    usage()+    sys.exit(1)++def getPassword(prompt= None):+  if prompt is None:+    prompt= 'Password: '+  return getpass.getpass(prompt)++def readLine(default= None):+  a= sys.stdin.readline().strip()+  if len(a) == 0 and default is not None:+    return default+  return a++def getGaleDir():+  return os.environ['HOME'] + '/.gale/auth/private'++def getServer(mdkuri):+  return xmlrpclib.ServerProxy(mdkuri)+++def handleFault(fault):+  sys.stderr.write('\n%s\n\n' %+    (fault.faultString))+++commands= {'ls': handleLs, 'gen': handleGen, 'regen': handleRegen,+           'get': handleGet, 'revoke': handleRevoke,+           'change-password': handleChPwd, 'reset-password': handleRePwd}++argu= sys.argv[1:]+dashes, squares= [], []+i= 0+while i < len(argu):+  if argu[i].startswith('-'):+    dashes.append(argu[i])+    if argu[i][1] != 'h':+      dashes.append(argu[i+1])+      i= i + 1+    i= i + 1+  else:+    squares.append(argu[i])+    i= i + 1+opts, args= getopt.getopt(dashes + squares, 'm:r:u:e:h')+mdkserver, priv, pub, email= defaultserver, None, None, None+for opt, value in opts:+  if opt == '-m':+    mdkserver= value+  if opt == '-r':+    priv= value+  if opt == '-u':+    pub= value+  if opt == '-e':+    email= value+  if opt == '-h':+    usage()+    sys.exit(1)++cmd= None+if len(args) > 0:+  cmd= args[0]+fullname= [x[1:] for x in args if x.startswith('/')]+if len(fullname) > 0:+  fullname= fullname[0]+else:+  fullname= None+key= [x for x in args if not x.startswith('/') and x.find('@') > 0]+if len(key) > 0:+  key= key[0]+else:+  key= None++try:+  server= getServer(mdkserver)+  galedir= getGaleDir()+  if cmd is not None and commands.has_key(cmd):+    commands[cmd](server, locals())+  else:+    handleWizard(server, locals())+except xmlrpclib.Fault, fault:+  handleFault(fault)+  sys.exit(fault.faultCode)+
+ ginsu.buildinfo.in view
@@ -0,0 +1,2 @@+executable: ginsu+extra-libraries: @CURSES_LIB@
+ ginsu.cabal view
@@ -0,0 +1,99 @@+Name:		ginsu+Version:	0.8.0+Copyright:	2002-2009 John Meacham <john@repetae.net>+		2011 Dylan Simon <dylan@dylex.net>+Author:		John Meacham <john@foo.net>+		Dylan Simon <dylan@dylex.net>+Maintainer:     dylan@dylex.net+License:	MIT+License-File:	LICENSE+Synopsis:	Ginsu Gale Client+Description:	Ginsu is a client for the gale chat system. It is designed to be powerful and above all stable, as well as having a quick learning curve.+Homepage:	http://repetae.net/computer/ginsu/+Category:	Network,Console+Build-Type:	Simple+Cabal-Version:	>= 1.6+tested-with:    GHC == 6.12.3, GHC == 7.0.2+extra-source-files: +                configure+                ginsu.buildinfo.in+                config.h.in+		gen_keyhelp.prl+		actions.def+		ginsu-mdk +		my_curses.h+		my_rsa.h+		Boolean/README+		docs/Changelog.old+		docs/ginsu-manual.html+		docs/wiki.css+		docs/ginsu-manual.txt+		docs/ginsu.1+data-files:     ginsu.config.sample++Source-Repository head+    Type:	darcs+    Location:	https://dylex.net:9947/src/ginsu++Executable ginsu+    Main-is:	Main.hs+    Other-Modules:+                Atom+                Boolean.Algebra+                Boolean.Boolean+                CacheIO+                Charset+                CircularBuffer+                ConfigFile+                Curses+                Doc.Chars+                Doc.DocLike+                EIO+                ErrorLog+                ExampleConf+                Exception+                Filter+                Format+                Gale.Gale+                Gale.KeyCache+                Gale.Proto+                Gale.Puff+                GenUtil+                GinsuConfig+                Help+                KeyHelpTable+                KeyName+                MyLocale+                Options+                PackedString+                Paths_ginsu+                RSA+                Regex+                Screen+                SimpleParser+                Status+                Text.ParserCombinators.ReadP.ByteString+                Version+    C-Sources:+                my_curses.c+                my_rsa.c+    Include-Dirs: .+    Build-Depends:	+                base >= 3 && < 5,+                bytestring,+                old-locale,+                containers,+                haskell98,+                pretty,+                mtl,+                array,+                unix,+                regex-posix,+                utf8-string >= 0.3.1,+                ghc-binary,+                old-time,+                syb,+                network,+                parsec,+                process+    Extra-Libraries: ssl crypto
+ ginsu.config.sample view
@@ -0,0 +1,168 @@+#---------------------------------------------------+# this file should be placed in ~/.gale/ginsu.config+#---------------------------------------------------++#the setting in this sample file coorespond to the defaults++######################+# Definately set these+######################++# set to your gale domain (usually taken from enviornment, MUST be set somewhere)+#GALE_DOMAIN gale.org+++# GALE_SUBSCRIBE is a list of all categories you wish to subscribe too.+# the default is some common public categories and your private puffs.++GALE_SUBSCRIBE pub@ofb.net local@ofb.net test.ginsu@ofb.net $GALE_ID++# GALE_NAME should be set to your real name.+GALE_NAME Ginsu User $LOGNAME++PUFF_DATE_FORMAT %a %H:%M:%S++###################+# perhaps set these+###################++#GALE_ID should be set to your GALE_ID. the default is to append your login to your GALE_DOMAIN.+#GALE_ID user@gale.org+++# editor to use for puff composition (else $VISUAL then $EDITOR used)+#EDITOR vim++# when editing a puff, run the editor in the background, so you can still+# interact with ginsu while editing+#BACKGROUND_EDIT true++# if BACKGROUND_EDIT is enabled, prefix commands with this (something like+# "xterm -e"; if your editor is graphical, don't specify it)+#BACKGROUND_COMMAND urxvt -e++# GALE_PROXY+#  gale server to use in preference to all others, you should not need to set+#  this unless you are behind a firewall or your own GALE_DOMAIN servers are not+#  suitable for some reason.+#GALE_PROXY gale.org+++# MARK_[123..] sets the initial filter for a given marked screen. use the+# number keys to quickly switch to a mark.+#+# the default has '7' show puffs to or from you, +# '8' shows traffic about gale and '9' filters spoilers away.++MARK_7 ~c:$GALE_ID ; ~a:$GALE_ID+MARK_8 ~c:pub.gale@ofb.net ; ~c:pub.rfc+MARK_9 !~k:spoil+++# beep on any puffs matching the following filters+BEEP ~c:$GALE_ID   +++# number of puffs to store in pufflog on exit.+PUFFLOG_SIZE 500++# maximum number of puffs to keep in memory+SCROLLBACK_SIZE 0++# charset, one of utf8, latin1, or ascii. if not set, will try to determine it from $LANG+# this only affects what format it assumes you are editing puffs in. locale settings are +# always used for the UI+#CHARSET latin1++# when replying to a puff, keep these keywords+PRESERVED_KEYWORDS ketchup catchup tangent spoiler spoilers nolog++# on startup, run this macro+ON_STARTUP <End>++# uncomment this if you are having trouble with terminal resizing.+#DISABLE_SIGWINCH True++#dispose of blank lines at the begining or end of puffs+TRIM_BLANKLINES true++BROWSER links++apphook WikiWord +        '([[:space:]]|^)(([[:upper:]][[:lower:]]+){2,})([[:space:]]|$)' +        '$BROWSER http://wiki.ofb.net/?$2'+        '$2'++apphook Url+        '(http|ftp)s?://(%[[:digit:]A-Fa-f][[:digit:]A-Fa-f]|[-_.!~*'';/?:@&=+$,[:alnum:]])+'+        '$BROWSER ''$0'''++#default key bindings++bind <F1> show_help_screen +bind ? show_help_screen+#bind <F2> show_main_index +bind <F3> show_presence_status ++bind j next_puff+bind k previous_puff+bind <Down> next_puff+bind <Up> previous_puff++bind <Home> first_puff+bind <End> last_puff+bind G last_puff++bind <Enter> next_line+bind <C-E> next_line++bind <BackSpace> previous_line+bind <C-Y> previous_line++bind <C-F> next_page+bind <PageDown> next_page+bind <C-B> previous_page+bind <PageUp> previous_page++bind <C-D> forward_half_page+bind <C-U> backward_half_page++bind d show_puff_details++bind c prompt_new_filter+bind / prompt_new_filter_slash+bind ~ prompt_new_filter_twiddle+bind u pop_one_filter+bind U pop_all_filters+bind ! invert_filter+bind x swap_filters++bind a filter_current_author+bind t filter_current_thread+bind T filter_current_thread++bind <C-o> toggle_rot13++# marks+bind m set_mark+bind <SingleQuote> recall_mark+bind M set_filter_mark+bind <DoubleQuote> recall_filter_mark+bind C recall_combine_mark++bind f follow_up+bind p new_puff+bind r reply_to_author+bind g group_reply+bind R resend_puff++bind N modify_presence_string++bind <C-r> reconnect_to_servers+bind E edit_config_file+bind q ask_quit+bind Q fast_quit+bind <C-l> redraw_screen+bind v goto_match+bind S show_status_screen+
+ my_curses.c view
@@ -0,0 +1,42 @@+#include "my_curses.h"+#include <HsFFI.h>+WINDOW ** get_stdscr (void) {return &stdscr;}+int * get_LINES (void) {return &LINES;}+int * get_COLS (void) {return &COLS;}+int * get_COLOR_PAIRS (void) {return &COLOR_PAIRS;}+int * get_COLORS (void) {return &COLORS;}+chtype hs_curses_color_pair (HsInt pair) {return COLOR_PAIR (pair);}+chtype hs_curses_acs_ulcorner (void) {return ACS_ULCORNER;}+chtype hs_curses_acs_llcorner (void) {return ACS_LLCORNER;}+chtype hs_curses_acs_urcorner (void) {return ACS_URCORNER;}+chtype hs_curses_acs_lrcorner (void) {return ACS_LRCORNER;}+chtype hs_curses_acs_rtee     (void) {return ACS_RTEE;}+chtype hs_curses_acs_ltee     (void) {return ACS_LTEE;}+chtype hs_curses_acs_btee     (void) {return ACS_BTEE;}+chtype hs_curses_acs_ttee     (void) {return ACS_TTEE;}+chtype hs_curses_acs_hline    (void) {return ACS_HLINE;}+chtype hs_curses_acs_vline    (void) {return ACS_VLINE;}+chtype hs_curses_acs_plus     (void) {return ACS_PLUS;}+chtype hs_curses_acs_s1       (void) {return ACS_S1;}+chtype hs_curses_acs_s9       (void) {return ACS_S9;}+chtype hs_curses_acs_diamond  (void) {return ACS_DIAMOND;}+chtype hs_curses_acs_ckboard  (void) {return ACS_CKBOARD;}+chtype hs_curses_acs_degree   (void) {return ACS_DEGREE;}+chtype hs_curses_acs_plminus  (void) {return ACS_PLMINUS;}+chtype hs_curses_acs_bullet   (void) {return ACS_BULLET;}+chtype hs_curses_acs_larrow   (void) {return ACS_LARROW;}+chtype hs_curses_acs_rarrow   (void) {return ACS_RARROW;}+chtype hs_curses_acs_darrow   (void) {return ACS_DARROW;}+chtype hs_curses_acs_uarrow   (void) {return ACS_UARROW;}+chtype hs_curses_acs_board    (void) {return ACS_BOARD;}+chtype hs_curses_acs_lantern  (void) {return ACS_LANTERN;}+chtype hs_curses_acs_block    (void) {return ACS_BLOCK;}+#  ifdef ACS_S3+chtype hs_curses_acs_s3       (void) {return ACS_S3;}+chtype hs_curses_acs_s7       (void) {return ACS_S7;}+chtype hs_curses_acs_lequal   (void) {return ACS_LEQUAL;}+chtype hs_curses_acs_gequal   (void) {return ACS_GEQUAL;}+chtype hs_curses_acs_pi       (void) {return ACS_PI;}+chtype hs_curses_acs_nequal   (void) {return ACS_NEQUAL;}+chtype hs_curses_acs_sterling (void) {return ACS_STERLING;}+#  endif
+ my_curses.h view
@@ -0,0 +1,59 @@+#ifndef MY_CURSES_H+#define MY_CURSES_H++#ifndef CONFIG_INCLUDED+#define CONFIG_INCLUDED+#undef PACKAGE_NAME+#undef PACKAGE_STRING+#undef PACKAGE_TARNAME+#undef PACKAGE_VERSION+#include "config.h"+#endif++#if HAVE_NCURSESW_NCURSES_H +#include <ncursesw/ncurses.h>+#elif HAVE_NCURSES_NCURSES_H+#include <ncurses/ncurses.h>+#elif HAVE_NCURSES_H+#include <ncurses.h>+#else+#include <curses.h>+#endif+++#include <signal.h>++#if defined(initscr)+#undef initscr+#endif++#if defined(cbreak)+#undef cbreak+#endif++#if defined(clrtoeol)+#undef clrtoeol+#endif++#if defined(touchwin)+#undef touchwin+#endif++#if defined(beep)+#undef beep+#endif++#if defined(flash)+#undef flash+#endif++#if defined(wattr_set)+#undef wattr_set+#endif++#if defined(wattr_get)+#undef wattr_get+#endif+++#endif
+ my_rsa.c view
@@ -0,0 +1,5 @@+#include "my_rsa.h"+#include <HsFFI.h>+HsInt evpCipherContextBlockSize(EVP_CIPHER_CTX *e) {return EVP_CIPHER_block_size(EVP_CIPHER_CTX_cipher(e));}+EVP_PKEY *pkeyNewRSA(RSA *rsa) {EVP_PKEY *pk; pk = EVP_PKEY_new(); EVP_PKEY_assign_RSA(pk, rsa); return pk;}+HsFunPtr  get_KEY (void) {return (HsFunPtr)&EVP_PKEY_free;}
+ my_rsa.h view
@@ -0,0 +1,19 @@+#ifndef MY_RSA_H+#define MY_RSA_H++#ifndef CONFIG_INCLUDED+#define CONFIG_INCLUDED+#undef PACKAGE_NAME+#undef PACKAGE_STRING+#undef PACKAGE_TARNAME+#undef PACKAGE_VERSION+#include "config.h"+#endif++#include <openssl/rsa.h>+#include <openssl/bn.h>+#include <openssl/evp.h>+#include <openssl/sha.h>+#include <limits.h>++#endif