sindre 0.4 → 0.6
raw patch · 27 files changed
+137/−1205 lines, 27 filesdep ~X11setup-changed
Dependency ranges changed: X11
Files
- .gitignore +0/−3
- Graphics/X11/Xft.hsc +1/−1
- README +0/−25
- Setup.hs +0/−55
- Sindre/ANSI.hs +0/−151
- Sindre/Compiler.hs +7/−7
- Sindre/Main.hs +1/−2
- Sindre/Runtime.hs +18/−18
- Sindre/Sindre.hs +5/−8
- Sindre/Util.hs +11/−0
- Sindre/Widgets.hs +4/−3
- Sindre/X11.hs +78/−13
- examples/askpass +0/−15
- examples/dial +0/−14
- examples/dials.sindre +0/−26
- examples/dock +0/−16
- examples/fan +0/−21
- examples/filesel +0/−73
- examples/sinmenu_patches/README +0/−2
- examples/sinmenu_patches/sinmenu_incremental +0/−3
- examples/sinmenu_patches/sinmenu_multiselect +0/−15
- examples/suggest +0/−41
- sindre.1 +0/−397
- sindre.cabal +12/−9
- sinmenu +0/−60
- sinmenu.1 +0/−75
- tests/Properties.hs +0/−152
− .gitignore
@@ -1,3 +0,0 @@-dist-*.hi-*.o
Graphics/X11/Xft.hsc view
@@ -91,6 +91,7 @@ where import qualified Graphics.X11 as X11+import qualified Graphics.X11.Xlib.Types as X11 import Codec.Binary.UTF8.String as UTF8 @@ -109,7 +110,6 @@ import Data.Int import Data.Word -import System.IO import System.IO.Unsafe import System.Mem.Weak
− README
@@ -1,25 +0,0 @@-Sindre - programming language for writing simple GUIs-===--Sindre is a programming language inspired by Awk that makes it easy to-write simple graphical programs in the spirit of dzen, dmenu, xmobar,-gsmenu and the like.--Requirements------A relatively modern (GHC >= 7.x) Haskell setup and a number of-libraries available on Hackage. See 'sindre.cabal' for specifics.-Sindre is developed with POSIX systems in mind and may not run (or be-useful) anywhere else.--Installation------Just run 'cabal install' and Cabal should build and install Sindre.--Documentation------Nothing yet, unfortunately, but check the examples/ directory for-sample code.
− Setup.hs
@@ -1,55 +0,0 @@-#!/usr/bin/env runhaskell--import Distribution.Simple.Setup (CopyDest(..),ConfigFlags(..),BuildFlags(..),- CopyFlags(..),RegisterFlags(..),InstallFlags(..),- defaultRegisterFlags,fromFlagOrDefault,Flag(..),- defaultCopyFlags)-import Distribution.Simple-import Distribution.Simple.LocalBuildInfo (absoluteInstallDirs)-import Distribution.PackageDescription (PackageDescription(..))-import Distribution.Simple.InstallDirs- (InstallDirs(..))-import Distribution.Simple.Utils-import Distribution.Verbosity-import Data.List (isPrefixOf)-import Data.Version-import Control.Monad (unless)-import System.Posix-import System.Directory-import System.Info (os)-import System.FilePath--main = defaultMainWithHooks sindreHooks-sindreHooks = simpleUserHooks { postInst = sindrePostInst- , postCopy = sindrePostCopy }--sindre = "sindre"--isWindows :: Bool-isWindows = os == "mingw" -- XXX--subst :: String -> String -> String -> String-subst t r [] = []-subst t r s@(c:s')- | t `isPrefixOf` s = r ++ subst t r (drop (length t) s)- | otherwise = c : subst t r s'--sindrePostInst a (InstallFlags { installPackageDB = db, installVerbosity = v }) =- sindrePostCopy a (defaultCopyFlags { copyDest = Flag NoCopyDest, copyVerbosity = v })--sindrePostCopy a (CopyFlags { copyDest = cdf, copyVerbosity = vf }) pd lbi =- do let v = fromFlagOrDefault normal vf- cd = fromFlagOrDefault NoCopyDest cdf- dirs = absoluteInstallDirs pd lbi cd- bin = combine (bindir dirs)- substVersion = subst "VERSION" $ showVersion $ packageVersion $ package pd- unless isWindows $ do- copyFileVerbose v "sinmenu" (bin "sinmenu")- fs <- getFileStatus (bin "sindre")- setFileMode (bin "sinmenu") $ fileMode fs- putStrLn $ "Installing manpage in " ++ mandir dirs- createDirectoryIfMissing True $ mandir dirs `combine` "man1"- withFileContents "sindre.1" $- writeFileAtomic (mandir dirs `combine` "man1" `combine` "sindre.1") . substVersion- withFileContents "sinmenu.1" $- writeFileAtomic (mandir dirs `combine` "man1" `combine` "sinmenu.1") . substVersion
− Sindre/ANSI.hs
@@ -1,151 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}--------------------------------------------------------------------------------- |--- Module : Sindre.ANSI--- License : MIT-style (see LICENSE)------ Stability : provisional--- Portability : unportable------ ANSI backend for Sindre.----------------------------------------------------------------------------------module Sindre.ANSI( SindreANSIM- , sindreANSI- )- where--import Sindre.Sindre-import Sindre.Compiler-import Sindre.Lib-import Sindre.Runtime-import Sindre.Util-import Sindre.Widgets--import System.Console.ANSI--import System.Environment-import System.Exit-import System.IO-import System.Posix.Types--import Control.Arrow(first,second)-import Control.Concurrent-import Control.Applicative-import Control.Exception-import Control.Monad.Reader-import Control.Monad.State-import Data.Bits-import Data.Char hiding (Control)-import Data.Maybe-import Data.List-import qualified Data.ByteString as B-import qualified Data.Map as M-import Data.Monoid-import Data.Ord-import qualified Data.Set as S-import qualified Data.Text as T-import qualified Data.Text.Encoding as E--import Prelude hiding (catch)----- | The read-only configuration of the ANSI backend, created during--- backend initialisation.-data SindreANSIConf = SindreANSIConf {- sindreTerminal :: Handle -- ^ Where we're being displayed.- , sindreVisualOpts :: VisualOpts- -- ^ The default visual options used if no others are specified for- -- a widget.- , sindreEvtVar :: MVar Event- -- ^ Channel through which events are sent by other threads to the- -- Sindre command loop.- }---- | Sindre backend using ANSI.-newtype SindreANSIM a = SindreANSIM (ReaderT SindreANSIConf (StateT Rectangle IO) a)- deriving ( Functor, Monad, MonadIO, MonadReader SindreANSIConf- , MonadState Rectangle, Applicative)--runSindreANSI :: SindreANSIM a -> SindreANSIConf -> Rectangle -> IO a-runSindreANSI (SindreANSIM m) = evalStateT . runReaderT m--instance MonadBackend SindreANSIM where- type BackEvent SindreANSIM = Char- type RootPosition SindreANSIM = ()-- redrawRoot = do- (orient, rootwr) <- gets rootWidget- reqs <- compose rootwr- winsize <- back get- let orient' = fromMaybe () orient- rect = fitRect winsize reqs- draw rootwr $ Just rect- return ()-- redrawRegion _ = return ()- - waitForBackEvent = do- evvar <- back $ asks sindreEvtVar- io $ takeMVar evvar- - getBackEvent = do- io yield- back (io . tryTakeMVar =<< asks sindreEvtVar)-- printVal s = io $ putStr s *> hFlush stdout--setupTerminal :: IO Handle-setupTerminal = do h <- openFile "/dev/tty" ReadWriteMode- hSetBuffering h NoBuffering- hSetEcho h False- return h--getKeypress :: Handle -> IO Chord-getKeypress h = (S.empty,) <$> CharKey <$> hGetChar h--eventReader :: Handle -> MVar Event -> IO ()-eventReader h evvar = forever $ (putMVar evvar . KeyPress) =<< getKeypress h--sindreANSICfg :: IO SindreANSIConf-sindreANSICfg = do- h <- setupTerminal- visopts <- defVisualOpts- evvar <- newEmptyMVar- xlock <- newMVar ()- _ <- forkIO $ eventReader h evvar- return SindreANSIConf { sindreTerminal = h- , sindreVisualOpts = visopts- , sindreEvtVar = evvar }---- | Options regarding visual appearance of widgets (colours and--- fonts).-data VisualOpts = VisualOpts {- foreground :: Color- , background :: Color- , focusForeground :: Color- , focusBackground :: Color- }--defVisualOpts :: IO VisualOpts-defVisualOpts = pure $ VisualOpts Black White White Blue---- | Execute Sindre in the ANSI backend.-sindreANSI :: SindreANSIM ExitCode- -- ^ The function returned by- -- 'Sindre.Compiler.compileSindre' after command line- -- options have been given- -> IO ExitCode-sindreANSI start = do- cfg <- sindreANSICfg- rows <- read <$> getEnv "LINES"- cols <- read <$> getEnv "COLUMNS"- runSindreANSI start cfg $ Rectangle 0 0 rows cols
Sindre/Compiler.hs view
@@ -53,7 +53,7 @@ import Data.Fixed import Data.List import Data.Maybe-import Data.Traversable(traverse)+import Data.Traversable (for, traverse) import qualified Data.IntMap as IM import qualified Data.Map as M import qualified Data.Text as T@@ -127,7 +127,7 @@ compileError s = do pos <- position <$> asks currentPos error $ pos ++ s -runtimeError :: Compiler m (String -> Execution m a)+runtimeError :: MonadFail m => Compiler m (String -> Execution m a) runtimeError = do pos <- position <$> asks currentPos return $ \s -> fail $ pos ++ s @@ -268,7 +268,7 @@ "Redefinition of built-in function '"++k++"'" _ -> do f' <- compileFunction f return (k, f')- fm' <- flip traverse fm $ \e -> do+ fm' <- for fm $ \e -> do e' <- e return $ sindre . e' =<< IM.elems <$> sindre (gets execFrame) begin <- mapM (descend compileStmt) $ programBegin prog@@ -323,7 +323,7 @@ where f wr (NamedEvent evn2 vs (FieldSrc wr2 fn2)) | wr == wr2, evn2 == evn, fn2 `fcmp` fn = return $ Just vs f wr (NamedEvent evn2 vs (ObjectSrc wr2))- | wr == wr2, evn2 == evn, fn == Nothing = return $ Just vs+ | wr == wr2, evn2 == evn, Nothing <- fn = return $ Just vs f _ _ = return Nothing compilePattern (SourcedPattern (GenericSource cn wn fn) evn args) = return (f, wn:args)@@ -331,7 +331,7 @@ | cn==cn2, evn2 == evn, fn2 `fcmp` fn = return $ Just $ Reference wr2 : vs f (NamedEvent evn2 vs (ObjectSrc wr2@(_,cn2,_)))- | cn==cn2, evn2 == evn, fn == Nothing =+ | cn==cn2, evn2 == evn, Nothing <- fn = return $ Just $ Reference wr2 : vs f _ = return Nothing @@ -378,7 +378,7 @@ Nothing -> bad "Exit code must be an integer" compileStmt (Expr e) = do e' <- descend compileExpr e- return $ e' >> return ()+ return $ void e' compileStmt (Return (Just e)) = do e' <- descend compileExpr e return $ doReturn =<< e'@@ -628,7 +628,7 @@ a) deriving ( MonadState (M.Map Identifier Value) , MonadError ParamError- , Monad, Functor, Applicative)+ , Monad, MonadFail, Functor, Applicative) -- | @noParam k@ signals that parameter @k@ is missing. noParam :: String -> ConstructorM m a
Sindre/Main.hs view
@@ -47,8 +47,6 @@ import qualified Data.Traversable as T import Data.Version (showVersion) -import Prelude hiding (catch)- setupLocale :: IO () setupLocale = do ret <- setLocale LC_ALL Nothing@@ -184,6 +182,7 @@ , ("Input", mkTextField) , ("HList", mkHList) , ("VList", mkVList)+ , ("Graph", mkGraph) , ("", mkUndef) ]
Sindre/Runtime.hs view
@@ -4,9 +4,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : Sindre.Runtime@@ -118,9 +116,9 @@ -- | Turn a Haskell-typed high-level field description into a -- 'Value'-typed field.-field :: Mold v => FieldDesc s im v -> Field s im+field :: (MonadFail im, Mold v) => FieldDesc s im v -> Field s im field (ReadOnlyField name bgetter) = Field name (unmold <$> bgetter) problem- where problem = fail "Field is read-only"+ where problem = const $ fail "Field is read-only" field (ReadWriteField name bgetter bsetter) = Field name (unmold <$> bgetter) setter where setter v = maybe problem bsetter $ mold v@@ -181,17 +179,17 @@ instObject :: NewObject im -> DataSlot im instObject (NewObject o) = ObjectSlot o -callMethodI :: Identifier -> [Value] -> ObjectRef -> Object s im -> Sindre im (Value, s)+callMethodI :: MonadFail im => Identifier -> [Value] -> ObjectRef -> Object s im -> Sindre im (Value, s) callMethodI m vs k s = case M.lookup m $ objectMethods s of Nothing -> fail "No such method" Just m' -> runObjectM (m' vs) k $ objectState s -getFieldI :: Identifier -> ObjectRef -> Object s im -> Sindre im (Value, s)+getFieldI :: MonadFail im => Identifier -> ObjectRef -> Object s im -> Sindre im (Value, s) getFieldI f k s = case M.lookup f $ objectFields s of Nothing -> fail "No such field" Just f' -> runObjectM (fieldGetter f') k $ objectState s -setFieldI :: Identifier -> Value -> ObjectRef -> Object s im -> Sindre im (Value, s)+setFieldI :: MonadFail im => Identifier -> Value -> ObjectRef -> Object s im -> Sindre im (Value, s) setFieldI f v k s = case M.lookup f $ objectFields s of Nothing -> fail "No such field" Just f' -> runObjectM (setget f') k $ objectState s@@ -234,7 +232,7 @@ } -- | A monad that can be used as the layer beneath 'Sindre'.-class (MonadIO m, Functor m, Applicative m, Mold (RootPosition m)) => MonadBackend m where+class (MonadIO m, MonadFail m, Mold (RootPosition m)) => MonadBackend m where type BackEvent m :: * type RootPosition m :: * redrawRoot :: Sindre m ()@@ -252,7 +250,7 @@ (StateT (SindreEnv m) (ContT ExitCode m)) a)- deriving (Functor, Monad, Applicative, MonadCont,+ deriving (Functor, Monad, Applicative, MonadFail, MonadCont, MonadState (SindreEnv m), MonadReader (QuitFun m)) instance MonadTrans Sindre where@@ -263,9 +261,11 @@ instance Monoid (Sindre m ()) where mempty = return ()- mappend = (>>) mconcat = sequence_ +instance Semigroup (Sindre m ()) where+ (<>) = (>>)+ -- | @execSindre e m@ executes the action @m@ in environment @e@, -- returning the exit code of @m@. execSindre :: MonadBackend m => SindreEnv m -> Sindre m a -> m ExitCode@@ -284,7 +284,7 @@ -- | @MonadSindre im m@ is the class of monads @m@ that run on top of -- 'Sindre' with backend @im@, and can thus access Sindre -- functionality.-class (MonadBackend im, Monad (m im)) => MonadSindre im m where+class (MonadBackend im, MonadFail (m im), MonadFail im) => MonadSindre im m where -- | Lift a 'Sindre' operation into this monad. sindre :: Sindre im a -> m im a -- | Lift a backend operation into this monad.@@ -295,7 +295,7 @@ sindre = id newtype ObjectM s im a = ObjectM (ReaderT ObjectRef (StateT s (Sindre im)) a)- deriving (Functor, Monad, Applicative, MonadState s, MonadReader ObjectRef)+ deriving (Functor, Monad, MonadFail, Applicative, MonadState s, MonadReader ObjectRef) instance MonadBackend im => MonadSindre im (ObjectM o) where sindre = ObjectM . lift . lift@@ -410,20 +410,20 @@ doCont = doJump execCont () newtype Execution m a = Execution (ReaderT (ExecutionEnv m) (Sindre m) a)- deriving (Functor, Monad, Applicative, MonadReader (ExecutionEnv m), MonadCont)+ deriving (Functor, Monad, MonadFail, Applicative, MonadReader (ExecutionEnv m), MonadCont) execute :: MonadBackend m => Execution m Value -> Sindre m Value execute m = runReaderT m' env where env = ExecutionEnv {- execReturn = fail "Nowhere to return to"- , execNext = fail "Nowhere to go next"- , execBreak = fail "Not in a loop"- , execCont = fail "Not in a loop"+ execReturn = const $ fail "Nowhere to return to"+ , execNext = const $ fail "Nowhere to go next"+ , execBreak = const $ fail "Not in a loop"+ , execCont = const $ fail "Not in a loop" } Execution m' = returnHere m execute_ :: MonadBackend m => Execution m a -> Sindre m ()-execute_ m = execute (m *> return (Number 0)) >> return ()+execute_ m = void $ execute (m *> return (Number 0)) instance MonadBackend im => MonadSindre im Execution where sindre = Execution . lift
Sindre/Sindre.hs view
@@ -66,12 +66,11 @@ ) where -import System.Console.GetOpt+import Sindre.Util -import Control.Applicative+import System.Console.GetOpt import Data.List import qualified Data.Map as M-import Data.Monoid import qualified Data.Set as S import qualified Data.Text as T @@ -88,7 +87,9 @@ instance Monoid Rectangle where mempty = Rectangle 0 0 (-1) (-1)- mappend r1@(Rectangle x1 y1 w1 h1) r2@(Rectangle x2 y2 w2 h2)++instance Semigroup Rectangle where+ r1@(Rectangle x1 y1 w1 h1) <> r2@(Rectangle x2 y2 w2 h2) | r1 == mempty = r2 | r2 == mempty = r1 | otherwise = Rectangle x' y' (max (x1+w1-x') (x2+w2-x'))@@ -106,10 +107,6 @@ where zipper' a (x:xs) = let (a', x', xs') = f (a, x, xs) in zipper' (x':a') xs' zipper' a [] = reverse a--divide :: Integral a => a -> a -> [a]-divide total n = map (const c) [0..n-2] ++ [c+r]- where (c,r) = total `quotRem` n -- | @splitHoriz rect dims@ splits @rect@ horizontally into a number -- of non-overlapping equal-width rectangles stacked on top of each
Sindre/Util.hs view
@@ -21,6 +21,7 @@ , clamp , mapAccumLM , ifM+ , divide ) where import Control.Monad.Trans@@ -96,3 +97,13 @@ ifM :: Monad m => m Bool -> m a -> m a -> m a ifM p t e = do b <- p if b then t else e++-- | @x `divide` n@ splits the interval @[0..x]@ into @n@+-- non-overlapping chunks that together form the entire interval.+-- For example:+-- +-- >>> 10 `divide` 3+-- [3,3,4]+divide :: Integral a => a -> a -> [a]+divide total n = map (const c) [0..n-2] ++ [c+r]+ where (c,r) = total `quotRem` n
Sindre/Widgets.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-}@@ -98,7 +99,7 @@ -- | @changeField field m@ applies @m@ to the current value of the -- field @field@, updates @field@ with the value returned by @m@, and -- returns the new value.-changeField :: FieldDesc s im v -> (v -> ObjectM s im v) -> ObjectM s im v+changeField :: MonadFail im => FieldDesc s im v -> (v -> ObjectM s im v) -> ObjectM s im v changeField (ReadWriteField _ getter setter) m = do v' <- m =<< getter setter v'@@ -106,8 +107,8 @@ changeField (ReadOnlyField _ _) _ = fail "Field is read-only" -- | Like 'changeField', but without a return value.-changeField_ :: FieldDesc s im v -> (v -> ObjectM s im v) -> ObjectM s im ()-changeField_ f m = changeField f m >> return ()+changeField_ :: MonadFail im => FieldDesc s im v -> (v -> ObjectM s im v) -> ObjectM s im ()+changeField_ f m = void $ changeField f m -- | @changingFields fields m@ evaluates @m@, then emits field change -- events for those fields whose names are in @fields@ that changed
Sindre/X11.hs view
@@ -45,6 +45,7 @@ , mkInStream , mkHList , mkVList+ , mkGraph ) where @@ -99,8 +100,6 @@ import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding.Error as E -import Prelude hiding (catch)- fromXRect :: X.Rectangle -> Rectangle fromXRect r = Rectangle { rectX = fi $ rect_x r@@ -191,7 +190,7 @@ -- | Sindre backend using Xlib. newtype SindreX11M a = SindreX11M (ReaderT SindreX11Conf (StateT Surface IO) a)- deriving ( Functor, Monad, MonadIO+ deriving ( Functor, Monad, MonadIO, MonadFail , MonadReader SindreX11Conf, MonadState Surface, Applicative) runSindreX11 :: SindreX11M a -> SindreX11Conf -> Surface -> IO a@@ -217,7 +216,7 @@ SindreX11Conf{ sindreDisplay=dpy } <- ask sur <- get io $ copySurface dpy sur rects >> sync dpy False- + waitForBackEvent = do back unlockX evvar <- back $ asks sindreEvtVar@@ -225,8 +224,8 @@ ev <- evm back lockX maybe waitForBackEvent return ev- - getBackEvent = do++ getBackEvent = back (io . tryTakeMVar =<< asks sindreEvtVar) >>= fromMaybe (return Nothing) @@ -308,7 +307,11 @@ fi (rect_width rect) + rect_x rect > fi x && fi y >= rect_y rect && fi (rect_height rect) + rect_y rect > fi y- fromJust <$> find contains <$> getScreenInfo dpy+ sinfo <- getScreenInfo dpy+ case (find contains sinfo, sinfo) of+ (Just r, _) -> return r+ (Nothing, r:_) -> return r -- When does this happen?+ (Nothing, []) -> error "Cannot find any screens" where windowWithPointer = do (_, _, _, x, y, _, _, _) <- queryPointer dpy rootw return (x,y)@@ -382,10 +385,10 @@ , ev_width = w, ev_height = h }) = do back $ do onsurface <- (==win) <$> gets surfaceWindow when onsurface $ do- sur <- (pure resizeSurface- <*> asks sindreDisplay- <*> asks sindreXftMgr <*> get- <*> pure (Rectangle 0 0 (fi w) (fi h)))+ sur <- pure resizeSurface+ <*> asks sindreDisplay+ <*> asks sindreXftMgr <*> get+ <*> pure (Rectangle 0 0 (fi w) (fi h)) put =<< io sur redrawRoot >> return Nothing processX11Event (_, _, AnyEvent { ev_event_type = t })@@ -416,12 +419,12 @@ -- | Get the value for a named color if it exists maybeAllocColor :: Xft.XftMgr -> String -> IO (Maybe Xft.Color)-maybeAllocColor mgr c = Xft.openColorName mgr vis colormap c+maybeAllocColor mgr = Xft.openColorName mgr vis colormap where colormap = defaultColormap dpy $ defaultScreen dpy dpy = Xft.mgrDisplay mgr vis = defaultVisualOfScreen $ defaultScreenOfDisplay dpy -allocColor :: MonadIO m => Xft.XftMgr -> String -> m Xft.Color+allocColor :: (MonadIO m, MonadFail m) => Xft.XftMgr -> String -> m Xft.Color allocColor dpy c = io (maybeAllocColor dpy c) >>= maybe (fail $ "Unknown color '"++c++"'") return @@ -1182,3 +1185,65 @@ y'' <- drawElem fd y' cur foldM_ (drawElem d) y'' aft Nothing -> return ()+++data Graph = Graph { graphHistory :: [Integer]+ , graphBot :: Integer+ , graphTop :: Integer+ }++-- | A visual horisontal bar graph. Each data point is represented as+-- a vertical bar. Accepts the following parameters:+--+-- [@size@] The number of data points to remember (defaults to 10)+--+-- [@barWidth@] The width (in pixels) of a single bar (defaults to 2).+--+-- [@bot@] The lower bound of data points as an integer. If a point+-- has this value (or below), it will be an empty bar.+--+-- [@bot@] The upper bound of data points as an integer. If a point+-- has this value (or above), it will be a full bar.+--+-- The following methods are supported:+--+-- [@insert(string)@] Split @string@ into lines and add each line as+-- a data point. Each line must be an integer.+mkGraph :: Constructor SindreX11M+mkGraph r [] = do+ gsize <- param "size" <|> return 10+ bwidth <- param "barWidth" <|> return 2+ bot <- param "bot" <|> return 0+ top <- param "top" <|> return 100+ visual <- visualOpts r+ sindre $ return $ newWidget (Graph [] bot top)+ (methods gsize) []+ recvEventI (composeI gsize bwidth) (drawI visual gsize bwidth)+ where composeI gsize bwidth = return (Exact $ fi $ bwidth*gsize+2*padding, Unlimited)+ methods gsize = M.fromList [ ("insert", function $ mInsert gsize) ]+ mInsert :: Integer -> T.Text -> ObjectM Graph SindreX11M ()+ mInsert gsize vs = do+ let elems = mapM (mold . StringV) $ T.lines vs+ case elems of+ Nothing -> fail "Not a number"+ Just elems' -> forM_ elems' $ \x -> do+ modify $ \s -> s { graphHistory =+ genericTake gsize $ x:graphHistory s }+ fullRedraw+ recvEventI _ = return ()+ drawI visual gsize bwidth = drawing' visual $ \Rectangle{..} d _ -> do+ let numpoints = fi $ max 1 (min ((rectWidth - 2*padding) `div` fi bwidth) gsize)+ points <- take numpoints <$> gets graphHistory+ bot <- gets graphBot+ top <- gets graphTop+ let dist = top - bot+ hspace = fi rectHeight - 2 * padding+ point (i, p) = do+ let asc :: Double+ asc = max 0 $ fi (p-bot)+ h = round $ asc / fi dist * fi hspace+ fg d fillRectangle (padding + fi rectX + i * fi bwidth)+ (fi rectY + padding + hspace - h)+ (fi bwidth) (fi h)+ io $ mapM_ point (zip [0..] points)+mkGraph _ _ = error "Graphs do not have children"
− examples/askpass
@@ -1,15 +0,0 @@-#!/bin/bash-code=$(cat <<EOF-GUI { Horizontally { Blank;- label=Label(highlight=1);- visible=Label(minwidth=100);- real=Input(maxwidth=0);- Blank } }-option prompt (-p,--prompt,"Set the input prompt", "STRING", "")-<Escape> || <C-g> { exit 1; }-<Return> { print real.value; exit 0; }-real.value->changed(from, to) { visible.label = gsub(".", "*", to) }-BEGIN { focus real; label.label = prompt; }-EOF-)-exec -a askpass sindre -e "$code" "$@"
− examples/dial
@@ -1,14 +0,0 @@-#!/bin/bash-code=$(cat <<EOF-GUI { Vertically { dial=Dial(max=physmax);- label=Label(label=labelstring) } }-option min (,--min,"Minimum value of the dial", "INTEGER", 0)-option max (,--max,"Maximum value of the dial", "INTEGER", 12)-option labelstring(,--label,"Text of label below the dial", "STRING", "")-physmax=max-min;-stdin->lines(lines) { dial.value = lines; }-<Escape> || <Enter> || <C-g> { exit 0; }-BEGIN { focus dial; }-EOF-)-exec -a dial sindre -e "$code" "$@"
− examples/dials.sindre
@@ -1,26 +0,0 @@-GUI {- Horizontally@"mid" {- Vertically {- Horizontally {- Vertically { left=Dial(max=12); Label(label="Left") }- Vertically {- Vertically { master=Dial(max=12); Label(label="Master") }- Vertically { pcm=Dial(max=12); Label(label="PCM") }- }- Vertically { right=Dial(max=12); Label(label="Right") }- }- Vertically { mic=Dial(max=12); Label(label="Mic") }- }- }-}-/*stdin.data(data) { master.value = data.line(0);- pcm.value = data.line(1);- mic.value = data.line(1); }*/-BEGIN { focus master; }-<q> { focus left }-<w> { focus master }-<e> { focus pcm }-<r> { focus right }-<t> { focus mic }-$Dial(dial)->changed(from,to) { print dial, to; }-<Escape> || <Enter> || <C-g> { exit 0 }
− examples/dock
@@ -1,16 +0,0 @@-#!/bin/sh--gui=$(cat <<EOF-GUI { Horizontally@"bot" {- log=Label(bg="grey",fg="black");- Blank(bg="grey")- date=Label(bg="#999",fg="white");-} }-datestream->lines(lines) { date.label = gsub("\n", "", lines); }-logstream->lines(lines) { log.label = gsub(".*\n", "", gsub("\n$", "", lines)) }-EOF-)--cat |\-(while true; do date; sleep 1; done |\-sindre --wmmode dock -e "$gui" --fd=datestream=3 --fd=logstream=4 "$@" 3<&0 0<&-) 4<&0 0<&-
− examples/fan
@@ -1,21 +0,0 @@-#!/bin/sh-gui() {- code=$(cat <<EOF-dial->changed(from, to) { gomanual() }-stdin->line(line) { gotlevel = 1; }-stdin->eof() { if (gotlevel) { gomanual() } else { goauto() } }-function gomanual() { print "level", dial.value; label.label = "Fan strength"; auto = 0; }-function goauto() { print "level auto"; label.label = "Automatic"; auto = 1; }-<Space> { if (auto) { gomanual() } else { goauto() } }-EOF-)- $(dirname "$0")/dial --max 7 -e "$code"-}-if ! [ -w /proc/acpi/ibm/fan ]; then- echo "Cannot write to /proc/acpi/ibm/fan - check that you have write permissions (and that this is a ThinkPad)."- exit 1-fi-cat /proc/acpi/ibm/fan | grep '^level:.*[0-7]' | sed 's/level:[^0-9]*//' | gui \-| while read line; do- echo $line > /proc/acpi/ibm/fan-done
− examples/filesel
@@ -1,73 +0,0 @@-#!/bin/sh--history=${XDG_CACHE_HOME:-~/.cache}/filesel/history--mkdir -p $(dirname historyfile)--history() {- tac $history |\-awk '{gsub("\"", "\"\""); print "value=\""$0"\" show=\"^fg(white)(History) ^fg()"$0"\""; fflush(); }' |\-head -n 5-}--updatehistory() {- (rm "$history" && awk '$0!=SEL' "SEL=$1" > "$history") < "$history"- echo "$1" >> "$history"-}--entry() {- awk '{gsub("\"", "\"\""); print "value=\""$0"\" show=\""substr($0, match($0, "/[^/]*/?$")+1)"\""; fflush(); }'-}--files() {- ls -A -F "$1" | awk '{print DIR $0}' "DIR=$1"-}--gui() {- code=$(cat <<EOF-input->changed(from, to) {- if (to == "") {- input.value = "/";- next;- }- list.clear();- insertfile();- print folder(to);-}-function complete() {- if (list.selected) {- if (match(list.selected, "^/")) {- input.value = list.selected- } else {- input.value = folder(input.value) list.selected- }- }-}-function folder(str) { return substr(str, 0, match(str, "/[^/]*$")) }-function file(str) { return substr(str, match(input.value, "[^/]*$"), RLENGTH); }-function insertfile() {- if (filename) { filename = gsub("\"", "\"\"", filename);- list.insert("value=\"" filename "\" show=\"^fg(white)" filename "\"" ) }-}-BEGIN { insertfile(); }-function filter() { list.filter(file(input.value)); }-function quit() { print; exit }-option filename(,--filename,"Default filename if a directory is selected", "filename");-EOF- )- dir=$(mktemp -p "${TMPDIR:-/tmp}" -d dir-XXXXXX) || exit 1- fifo=$dir/fifo- mkfifo "$fifo" || { rmdir "$dir"; exit 1; }- sinmenu -l 10 -e "$code" -p File: -c $PWD/ "$@" < $fifo |\-while read line; do- echo $line 1>&3- history "$line"- files "$line" 2>/dev/null | sed 's/\*$//' | entry- done 3>&1 1>$fifo | tail -n 1 | sed '/^$/d'- rm $fifo- rmdir $dir-}--ret=$(gui "$@")--[ -z "$ret" ] && exit 1 || (updatehistory "$(dirname "$ret")/"; echo "$ret")
@@ -1,2 +0,0 @@-This directory contains a number of examples on how to extend sinmenu-with usage-specific functionality.
@@ -1,3 +0,0 @@-#!/bin/sh--sinmenu -e 'input->changed(from,to) { if (from!=to) { print to } }' "$@"
@@ -1,15 +0,0 @@-#!/bin/sh--actions=$(cat <<EOF-function select() { print input.value }-<C-Return> {- elems=list.elements;- while (i++<length(elems)) {- print elems[i];- }- exit-}-EOF-)--sinmenu -e "$actions" "$@"
− examples/suggest
@@ -1,41 +0,0 @@-#!/bin/sh-# Interface to Google Suggest - not very useful, but a nice demo of-# how to combine Sindre with other programs through shell script.--code=$(cat <<EOF-stdin->lines(lines) { if (clear) { list.clear(); clear = 0; } }-input->changed(from, to) { clear=1; print to; next; }-function quit() { print; exit }-EOF-)-dir=$(mktemp -p "${TMPDIR:-/tmp}" -d dir-XXXX) || exit 1-fifo=$dir/fifo-mkfifo "$fifo" || { rmdir "$dir"; exit 1; }--googlesuggest() {- python - "$@" <<EOF-import sys, string-import urllib--URI = "http://www.google.com/complete/search?hl=en&js=true&qu="--def suggest(term):- # Pull the results as Javascript, then munge them a bit and- # evaluate them as Python, yielding a dictionary.- text = urllib.urlopen(URI + urllib.quote(term)).read() \- .replace("window.google.ac.h(","").replace(",{}])", "]")- for res in (eval(text)[1]):- print res[0]--suggest(string.join(sys.argv[1:], ' '))-EOF-}--cat $fifo | $(dirname "$0")/dmenu -l 10 -e "$code" -p Search |\-while read line; do- echo $line 1>&3- # Due to Python nonsense, we have to reencode the output.- googlesuggest "$line" | iconv -f latin1 -t utf8 &-done 3>&1 1>$fifo | tail -n 1 | sed '/^$/d'-rm $fifo-rmdir $dir
− sindre.1
@@ -1,397 +0,0 @@-.TH SINDRE 1 sindre\-VERSION-.SH NAME-sindre \- GUI programming language-.SH SYNOPSIS-.nh-sindre-[\fB\-f \fIprogram-file\fR]-[\fB\-e \fIprogram-text\fR]-.SH DESCRIPTION-Sindre is a programming language inspired by Awk that makes it easy to-write simple graphical programs in the spirit of dzen, dmenu, xmobar,-gsmenu and the like.-.SH OPTIONS-.TP-.PD 0-.BI \-f " program-file"-.TP-.PD-.BI \-\^\-file " program-file"-Read a program fragment from the file-.IR program-file .-Multiple-.B \-f-options may be used, and may be interleaved with-.B \-e-options. See the section on-.B Multiple Fragments-below.-.TP-.PD 0-.BI \-e " program-text"-.TP-.PD-.BI \-\^\-expression " program-text"-Read program fragment from the argument-.IR program-text .-Multiple-.B \-e-options may be used, and may be interleaved with-.B \-f-options. See the section on-.B Code Substitution-below.-.TP-.PD 0-.BI \-\^\-fd " NAME=FD"-Create an input stream with the given name that reads from the given-file descriptor. The file descriptor should be created by the script-invoking Sindre, for example-.ft B-sindre --fd foostream=3 3<~/.xsession-errors.-.ft R-You should never create more than one stream per file descriptor. The-standard input stream is automatically available as the-stream 'stdin'. If multiple-.B \-\^\-fd-options are given that define the same stream name, the last one will-take priority.-.TP-.PD 0-.BI \-\^\-wmmode " normal|dock|override" " (defaults to override)"-If-.IR normal ,-put the program under the management of the window manager as a normal-client. If-.IR dock ,-run as a dock/panel, assuming window manager support. If-.IR override-(the default), grab control of the display and stay on top until the-program terminates.--.SH USAGE--.SS Lexical conventions-Identifiers start with a letter and consist of alphanumerics or-underscores. Class names start with a capital letter, while object-and variable names start with lowercase. Line-comments are supported-with // and block comments with /* ... */. Semicolons are used to-separate statements and declarations, although they are optional when-not needed to resolve ambiguity.--.SS Overview-The Sindre language is extremely similar to Awk in syntax and-semantics, although there are subtle differences as well. A program-primarily consists of action declarations that have the form--.TP-.IB pattern " { " statements " } "--.P-When an event arrives, each declaration is checked in order, and those-whose pattern matches have their statements executed. Some patterns-also bind variables while executing the statements, like a function-call. The statement-.B next-can be used to immediately stop further processing of an event.-Additionally there are a few special declarations. A GUI declaration-defines a tree of possibly named widgets, and looks like--.TP-.BI "GUI { " name "=" class "(" parameters ") { " children " } }"--.P-where both name (including the equal sign), parameters (including the-parentheses) and children (including the braces) are optional. Each-child follows the same syntax as the body (the text between the-braces) of a GUI declaration, and should be separated by semicolons.-Widget parameters are of the form--.P-.IB param1 " = " exp1 ", " param2 " = " exp2 ", ... , " paramN " = " expN--.P-and are evaluated left-to-right. A parameter whose value is-considered false (see section-.BR VALUES )-will be ignored if its value is otherwise not valid for the parameter.-Otherwise, an error will occur if the value is not what the widget-expects (for example, the string "foo" passed as the widget height).-.P-A global variable declaration looks like--.TP-.IB name = exp--.P-Global variables are initialised before the GUI is created, so they-can be used in widget parameters. On the other hand, they cannot-refer to widgets. If you need to perform work after the GUI has been-created, use a BEGIN declaration.-.P-Function are defined as in Awk, and recursion is supported:--.P-.BI "function " name "(" arg1 ", " arg2 ", ..., " argN ") { " statements " }"--.P-Arguments are lexically scoped within the function. If a function is-called with fewer arguments than given in its declaration, the-leftovers are given a false value. This is the only way to emulate-local variables.--.SS Patterns-.TP-.B BEGIN-At program startup, after the GUI has been created.-.TP-.BI < key >-When the given key is pressed. The syntax for keys is taken from GNU-Emacs and consists of an optional set of modifiers (C- (Control), M--(Meta/Alt), Shift, S- (Super) or H- (Hyper)) followed by a key name.-The Shift modifier is stripped from keypresses that are characters. For example,-.B <C-a>-means a press of "a" while the Control key is held down, and-.B <C-A>-is with a capital "A". Modifiers can be chained, so you can match-.B <C-M-Shift-S-H-BackSpace>-if you really want to. The names for control characters, such as-BackSpace above, are taken from X11 keynames. You can use-.BR xev (1)-to figure out the names to a given key.-.TP-.IB object -> event ( name1 ", " name2 ", ..., " nameN )-Matches when the named object sends the named event. The names will-be bound to the value payload of the event, in the same way as with a-function call.-.TP-.BI $ class ( name ")->" event ( name1 ", " name2 ", ..., " nameN )-As above, but matches when any widget of the given class sends the-named event.-.I name-will be bound to the widget that emitted the event.-.TP-.IB pat1 " || " ... " || " patN-Matches if any of the patterns, checked left-to-right, match.--.SS Statements-If-conditions, while-loops and for-loops are supported with the same-syntax as in Awk, except that braces are always mandatory. All-variables, except for function parameters, are global and initialised-to false at program startup. A loop can be stopped with-.B continue-or-.BR break ,-with usual C semantics, and-.B return-can be used to exit early from a function.--.SS Expressions and Values-All values, except for objects, are always passed by value in-arguments and return values. Sindre supports numbers (integers and-decimal syntax), dictionaries, strings and objects. Boolean values-are canonically represented as integers, with the number 0 being false-and any other value considered true. Strings follow the Haskell-literal syntax (which is essentially identical to that of C). Objects-can be used as event sources, as mentioned above, and have methods and-fields. A method call has the syntax object.method(args) and a field-is object.field, and can be used as an lvalue. Dictionaries differ-significantly from those in Awk, as they have no special syntactical-treatment. An empty dictionary is written as-.B []-and elements can be added/changed by using the usual Awk-like syntax-.BR foo["bar"]=4 ,-although the variable must already contain a dictionary or you will-get an error (so use-.B foo=[]-to initialise). Keys and values can have any type.-Multidimensional dictionaries are only supported by making the values-dictionaries themselves, and has no special syntax, and arrays are-merely dictionaries with integral keys.--.SS Multiple Fragments-When multiple-.B \-f-and-.B \-e-options are used, Sindre conceptually concatenates the given program-text fragments in the order of the options. There are two differences-from plain concatenation, however:--.TP-.B Duplicate definitions-A program fragment is normally not allowed to define two global-variables or functions with the same name, nor to contain two GUI-declarations. When the above options are used, redefinitions of previous-definitions appearing in later fragments take precedence.--.TP-.B Event handling priority-Event handlers are run from top to bottom in terms of the program-text, but event handlers in later fragments are run first. Thus,--.ft B- sindre -e 'obj->ev() { print "foo" }- obj->ev() { print "bar" }'- -e 'obj->ev() { print "baz" }'-.ft R--will print "baz foo bar" whenever the event-.B obj->ev()-happens. BEGIN declarations are similarly executed in reverse order.--.ft B- sindre -e 'BEGIN { print "I go last" }'- -e 'BEGIN { print "I go first" }'-.ft R-.SS Special Variables-.TP "\w'ENVIRON'u+1n"-.B RSTART-After regular expression matching, this variable will be set to the-index (1-based) of the match.-.TP-.B RLENGTH-The length of the most recent regular expression match.-.TP-.B ENVIRON-A dictionary containing the environment variables of the Sindre-process. Note that changing this dictionary currently has no effect-on the environment.-.TP-.B EXITVAL-Whenever an external program has been run, this variable will contain-its exit value.--.SS Numeric functions-.TP "\w'atan2(x, y)'u+1n"-.BI abs( n )-The numeric value of-.IR n .-.TP-.BI atan2( x , " y" )-Arctangent of-.I x/y-in radians.-.TP-.BI cos( x )-Cosine of-.IR x ,-in radians.-.TP-.BI sin( x )-Sine of-.IR x ,-in radians.-.TP-.BI exp( x )-Natural exponent of-.IR x .-.TP-.BI log( x )-Natural logarithm of-.IR x .-.TP-.BI int( x )-.I x-truncated to an integer.-.TP-.TP-.BI sqrt( x )-The square root of-.IR x .--.SS String Functions-.PP-Note that indexes are 1-based.-.PP-.TP "\w'substr(s, m, n)'u+1n"-.BI length( s )-Returns the number of characters in-.I s-.TP-.BI substr( s , " m" , " n" )-Return-.I n-characters of-.IR s ,-starting from character number-.IR m .-If either-.IR n or m-is out of bounds, the resulting string may be less than-.I n-characters.-.TP-.BI index( s , " t" )-Return the index at which-.I t-is found in-.IR s ,-or 0 if-.I t-is not present.-.TP-.BI match( s , " r" )-Match the regular expression-.I r-against-.IR t ,-returning the index of the first match, as well as setting-.B RMATCH-and-.BR RLENGTH .-.TP-.BI gsub( r , " t" , " s" )-For each match of the regular expression-.I r-in-.IR s ,-return a new string where each of those matches is replaced with-.IR t .-.TP-.BI sub( r , " t" , " S" )-Like-.IR sub ,-but only the first match is replaced.-.TP-.BI tolower( s )-Return an all-lowercase version of-.IR s .-.TP-.BI toupper( s )-Return an all-uppercase version of-.IR s .--.SS System Functions-.TP "\w'osystem(s)'u+1n"-.BI osystem( s )-Run-.I s-as a shell command and return its output.-.TP-.BI system( s )-Run-.I s-as a shell command and return its exit value.--.SH EXIT STATUS-Sindre returns a-.B 0-exit status on success, and-.B 1-if there was an internal problem.--.SH EXAMPLES-See the examples/ subdirectory of the Sindre source tree.--.SH SEE ALSO-.BR dmenu (1),-.BR awk (1),-.BR sinmenu (1)--.SH BUGS-The syntax and semantics for local variables are inherited from Awk,-and are rather ugly. It is possible to write programs that have no-way of exiting, short of killing the process manually. Actions are-executed atomically and synchronously, so an infinite loop can freeze-the program, requiring the user to kill it manually.
sindre.cabal view
@@ -1,17 +1,16 @@+cabal-version: 2.4 name: sindre-version: 0.4+version: 0.6 homepage: http://sigkill.dk/programs/sindre synopsis: A programming language for simple GUIs description: Sindre is a language inspired by Awk, meant for creating very simple graphical user interfaces. category: GUI-license: BSD3+license: BSD-3-Clause license-file: LICENSE author: Troels Henriksen maintainer: athas@sigkill.dk-cabal-version: >= 1.10-build-type: Custom source-repository head type: git@@ -31,8 +30,10 @@ Sindre.KeyVal Sindre.Main Graphics.X11.Xft+ Paths_sindre+ autogen-modules: Paths_sindre - build-depends: X11>=1.5.0.0 && < 1.6, X11-xshape>=0.1.1, X11-rm>=0.2,+ build-depends: X11, X11-xshape>=0.1.1, X11-rm>=0.2, mtl, base >= 4.3 && < 5, containers, parsec>=3.1, array>=0.3, x11-xim>=0.0.6, setlocale, regex-pcre, process, text, bytestring, unix, attoparsec>=0.10,@@ -40,8 +41,8 @@ ghc-options: -Wall - ghc-prof-options: -prof -auto-all -rtsopts- pkgconfig-depends: xft+ ghc-prof-options: -rtsopts+ pkgconfig-depends: xft, xext default-language: Haskell2010 library@@ -59,11 +60,13 @@ Graphics.X11.Xft other-modules: Paths_sindre+ autogen-modules: Paths_sindre - build-depends: X11>=1.5.0.0 && < 1.6, X11-xshape>=0.1.1, X11-rm,++ build-depends: X11>=1.5.0.0, X11-xshape>=0.1.1, X11-rm, mtl, base >= 4.3 && < 5, containers, parsec>=3.1, array>=0.3, x11-xim>=0.0.5, setlocale, regex-pcre, process, text, bytestring, unix, attoparsec>=0.10.1.0, permute, utf8-string>=0.3- pkgconfig-depends: xft+ pkgconfig-depends: xft, xext default-language: Haskell2010
@@ -1,60 +0,0 @@-#!/bin/sh-gui=$(cat <<EOF-GUI {-Horizontally@bottom?"bot":"top" {- prompt=Label(label=pstring,highlight=1, fg=ffg, bg=fbg);- input=Input(minwidth=200, font=font, fg=fg, bg=bg, ffg=ffg, fbg=fbg);- list=HList(font=font, fg=fg, bg=bg, ffg=ffg, fbg=fbg);- }-}-EOF-)-for arg in "$@"; do- if [ "$arg" = '-l' ]; then- gui=$(cat <<EOF-GUI {-Horizontally@bottom?"bot":"top" {- Vertically {- prompt=Label(label=pstring,highlight=1, fg=ffg, bg=fbg);- Blank(fg=fg, bg=bg, ffg=ffg, fbg=fbg);- }- Vertically {- input=Input(minwidth=0, font=font, fg=fg, bg=bg, ffg=ffg, fbg=fbg);- list=VList(lines=lines, font=font, fg=fg, bg=bg, ffg=ffg, fbg=fbg);- }-}-}-option lines (-l,,"List items vertically, with the given number of lines.", "INTEGER", 10)-EOF- )- fi-done-code=$(cat <<EOF-BEGIN { input.value = contents }-option pstring (-p,--prompt,"Set the input prompt", "prompt", "")-option bottom (-b,,"Appear at bottom of screen")-option contents(-c,,"Starting contents of buffer", "text", "")-option font(,--font,"Font used for text", "font")-option fg(,--nf,"Normal foreground colour", "colour")-option bg(,--nb,"Normal background colour", "colour")-option ffg(,--sf,"Selected element foreground colour", "colour")-option fbg(,--sb,"Selected element background colour", "colour")-function complete() { if (list.selected) { input.value = list.selected } }-function filter() { list.filter(input.value) }-function select() { print input.value; exit }-function quit() { exit 1 }-stdin->lines(lines) { list.insert(lines) }-BEGIN { focus input }-<C-g> || <Escape> || <C-c> { quit() }-<Up> || <C-p> || <C-r> { list.prev() }-<Down> || <C-n> || <C-s> { list.next() }-<Return> || <C-j> { complete(); select(); }-<Shift-Return> || <C-J> { select(); }-<C-i> || <Tab> { complete() }-<C-y> { input.value = sub("\n.*", "", osystem("sselp")) }-<C-e> { list.last() }-<C-a> { list.first() }-input.value->changed(from, to) { filter() }-EOF-)-sindre -e "$gui" -e "$code" "$@"
@@ -1,75 +0,0 @@-.TH SINMENU 1 sinmenu\-VERSION-.SH NAME-sinmenu \- slower dmenu that uses more memory-.SH SYNOPSIS-.B sinmenu-[\fB\-b\fR]-[\fB\-i\fR]-[\fB\-l\fI lines\fR]-[\fB\-p\fI prompt\fR]-[\fISindre options...\fR]-.SH DESCRIPTION-.B sinmenu-is a dynamic menu for X, a clone of-.BR dmenu (1)-written in Sindre. It manages large numbers of user\-defined menu-items efficiently.-.P-sinmenu reads a list of newline\-separated items from standard input-and creates a menu. When the user selects an item or enters any text-and presses Return, their choice is printed to standard output and-sinmenu terminates.-.P-.SH OPTIONS-.TP-.B \-b-Appear at bottom of screen.-.TP-.B \-i-Match menu items case insensitively.-.TP-.BI \-l " lines"-List items vertically, with the given number of lines.-.TP-.BI \-p " prompt"-The prompt to be displayed to the left of the input field.-.TP-.BI \-\-font " font"-The font or font set used.-.TP-.BI \-\-nb " color"-The normal background color.-.IR #RGB ,-.IR #RRGGBB ,-and X color names are supported.-.TP-.BI \-\-nf " color"-Normal foreground color.-.TP-.BI \-\-sb " color"-Background color of prompt and selected element.-.TP-.BI \-\-sf " color"-Foreground color of prompt and selected element.-.SH USAGE-sinmenu is controlled by the keyboard via an eclectic mix of Emacs,-Unix and dmenu conventions.-.TP-.B Tab (C\-i)-Copy the selected item to the input field.-.TP-.B Return (C\-j)-Confirm selection. Prints the selected item to stdout and exits, returning-success.-.TP-.B Shift\-Return (C\-J)-Confirm input. Prints the input text to stdout and exits, returning success.-.TP-.B Escape (C\-c) or C\-g-Exit without selecting an item, returning failure.-.TP-.B C\-y-Paste the current X solution to the input field, using-.BR sselp (1).-.SH SEE ALSO-.BR sindre "(1), " dmenu "(1), " sselp (1)
− tests/Properties.hs
@@ -1,152 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-module Properties where--import Sindre.Sindre--import Test.QuickCheck-import Text.Printf--import Control.Applicative-import Control.Monad-import Data.Monoid--main :: IO ()-main = mapM_ (\(s,a) -> putStr (s++": ") >> a) tests--instance Arbitrary Rectangle where- arbitrary = pure Rectangle- <*> choose (0,1000) <*> choose (0,1000)- <*> choose (0,1000) <*> choose (0,1000)---- Transposing a rectangle twice is the same as identity.-prop_transposetranspose :: Rectangle -> Bool-prop_transposetranspose r =- (rectTranspose . rectTranspose) r == r--prop_rectangle_mempty :: Rectangle -> Bool-prop_rectangle_mempty r =- r `mappend` mempty == r && mempty `mappend` r == r--prop_rectangle_mappend_associative :: Rectangle -> Rectangle -> Rectangle -> Bool-prop_rectangle_mappend_associative r1 r2 r3 =- r1 `mappend` (r2 `mappend` r3) == (r1 `mappend` r2) `mappend` r3--prop_rectangle_mappend_idempotent :: Rectangle -> Rectangle -> Bool-prop_rectangle_mappend_idempotent r1 r2 =- r1 `mappend` r2 `mappend` r2 == r1 `mappend` r2 &&- r1 `mappend` r2 `mappend` r1 == r1 `mappend` r2 &&- r2 `mappend` r1 `mappend` r1 == r1 `mappend` r2 &&- r2 `mappend` r1 `mappend` r2 == r1 `mappend` r2--instance Arbitrary DimNeed where- arbitrary = oneof [ liftM Min (choose (0,100))- , liftM Max (choose (0,100))- , return Unlimited- , liftM Exact (choose (0,100)) ]--newtype BigEnoughDim = BigEnoughDim ([DimNeed], Integer)- deriving (Show)---- The dimension is guaranteed to be able to satisfy the requirements.-instance Arbitrary BigEnoughDim where- arbitrary = do needs <- arbitrary- let (x1,x2) = foldl (\(x1,y1) (x2,y2) -> (x1+x2,y1+y2)) (0,0)- $ map range needs- dim <- choose (x1, x2)- return $ BigEnoughDim (needs, dim)- where range (Min x) = (x,2*x)- range (Max x) = (0,x)- range (Exact x) = (x,x)- range Unlimited = (0,100)--satisfied :: DimNeed -> Integer -> Bool-satisfied (Min x) y = x <= y-satisfied (Max x) y = x >= y-satisfied (Exact x) y = x == y-satisfied Unlimited _ = True--prop_hsplit_satisfies :: BigEnoughDim -> Bool-prop_hsplit_satisfies (BigEnoughDim (needs, dim)) =- length needs == length rs &&- all (uncurry satisfied) (zip needs $ map rectHeight rs)- where rs = splitHoriz (Rectangle 0 0 10 dim) needs--prop_hsplit_union :: [DimNeed] -> Rectangle -> Bool-prop_hsplit_union needs r =- length needs == length rs && (null needs || mconcat rs == r)- where rs = splitHoriz r needs--prop_vsplit_satisfies :: BigEnoughDim -> Bool-prop_vsplit_satisfies (BigEnoughDim (needs, dim)) =- length needs == length rs &&- all (uncurry satisfied) (zip needs $ map rectWidth rs)- where rs = splitVert (Rectangle 0 0 dim 10) needs--prop_vsplit_union :: [DimNeed] -> Rectangle -> Bool-prop_vsplit_union needs r =- length needs == length rs && (null needs || mconcat rs == r)- where rs = splitVert r needs--prop_constrains_idempotent :: SpaceNeed -> Constraints -> Bool-prop_constrains_idempotent s c =- constrainNeed (constrainNeed s c) c == constrainNeed s c--prop_fitRect_idempotent :: Rectangle -> SpaceNeed -> Bool-prop_fitRect_idempotent r s =- fitRect (fitRect r s) s == fitRect r s--prop_fitRect_subrect :: Rectangle -> SpaceNeed -> Bool-prop_fitRect_subrect r s =- fitRect r s `mappend` r == r--prop_fitRect_fits :: Rectangle -> SpaceNeed -> Bool-prop_fitRect_fits r s = check rectWidth (fst s) && check rectHeight (snd s)- where check f (Exact x) | x <= f r = f (fitRect r s) == x- | otherwise = f (fitRect r s) == f r- check f (Min x) | x <= f r = f (fitRect r s) >= x- | otherwise = f (fitRect r s) == f r- check f (Max x) = f (fitRect r s) <= x- check _ Unlimited = True--instance Arbitrary Align where- arbitrary = elements [AlignCenter, AlignNeg, AlignPos]--prop_align_fits :: Align -> Property-prop_align_fits a = do- minp <- arbitrary `suchThat` (>=(0::Integer))- d <- arbitrary `suchThat` (>=0)- maxp <- arbitrary `suchThat` (>=d+minp)- let d' = align a minp d maxp- d' >= minp .&. d' <= maxp .&. d'+d <= maxp .&.- case a of AlignCenter -> abs ((d'-minp)-(maxp-d'-d)) <= 1- AlignNeg -> d'==minp- AlignPos -> d'==maxp-d--tests :: [(String, IO ())]-tests = [ ( "Transposing twice is identity"- , quickCheck prop_transposetranspose)- , ( "Rectangle mempty is identity"- , quickCheck prop_rectangle_mempty)- , ( "Rectangle mappend is associative"- , quickCheck prop_rectangle_mappend_associative)- , ( "Rectangle mappend is idempotent"- , quickCheck prop_rectangle_mappend_idempotent)- , ( "Horizontal split fulfills constraints"- , quickCheck prop_hsplit_satisfies )- , ( "Union is inverse of horizontal split"- , quickCheck prop_hsplit_union )- , ( "Vertical split fulfills constraints"- , quickCheck prop_vsplit_satisfies )- , ( "Union is inverse of vertical split"- , quickCheck prop_vsplit_union )- , ( "Constraining is idempotent"- , quickCheck prop_constrains_idempotent )- , ( "Rectangle fitting is idempotent"- , quickCheck prop_fitRect_idempotent )- , ( "Fitted rectangle is a subrectangle"- , quickCheck prop_fitRect_subrect )- , ( "Rectangle fitting fits"- , quickCheck prop_fitRect_fits )- , ( "Aligning fits and cannot be improved"- , quickCheck prop_align_fits)- ]