emacs-module-0.1.1.1: Utilities to write Emacs dynamic modules
Copyright(c) Sergey Vinokurov 2018
LicenseApache-2.0 (see LICENSE)
Maintainerserg.foo@gmail.com
Safe HaskellNone
LanguageHaskell2010

Data.Emacs.Module.Env

Description

 
Synopsis

Documentation

data Env Source #

Emacs environment, right from the 'emacs-module.h'.

enum emacs_funcall_exit

data FuncallExit a Source #

Possible Emacs function call outcomes. This is Haskell's version of

Constructors

FuncallExitReturn

Function has returned normally.

FuncallExitSignal a

Function has signaled an error using signal.

FuncallExitThrow a

Function has exit using throw.

Instances

Instances details
Functor FuncallExit Source # 
Instance details

Defined in Data.Emacs.Module.Env.Functions

Methods

fmap :: (a -> b) -> FuncallExit a -> FuncallExit b #

(<$) :: a -> FuncallExit b -> FuncallExit a #

Foldable FuncallExit Source # 
Instance details

Defined in Data.Emacs.Module.Env.Functions

Methods

fold :: Monoid m => FuncallExit m -> m #

foldMap :: Monoid m => (a -> m) -> FuncallExit a -> m #

foldMap' :: Monoid m => (a -> m) -> FuncallExit a -> m #

foldr :: (a -> b -> b) -> b -> FuncallExit a -> b #

foldr' :: (a -> b -> b) -> b -> FuncallExit a -> b #

foldl :: (b -> a -> b) -> b -> FuncallExit a -> b #

foldl' :: (b -> a -> b) -> b -> FuncallExit a -> b #

foldr1 :: (a -> a -> a) -> FuncallExit a -> a #

foldl1 :: (a -> a -> a) -> FuncallExit a -> a #

toList :: FuncallExit a -> [a] #

null :: FuncallExit a -> Bool #

length :: FuncallExit a -> Int #

elem :: Eq a => a -> FuncallExit a -> Bool #

maximum :: Ord a => FuncallExit a -> a #

minimum :: Ord a => FuncallExit a -> a #

sum :: Num a => FuncallExit a -> a #

product :: Num a => FuncallExit a -> a #

Traversable FuncallExit Source # 
Instance details

Defined in Data.Emacs.Module.Env.Functions

Methods

traverse :: Applicative f => (a -> f b) -> FuncallExit a -> f (FuncallExit b) #

sequenceA :: Applicative f => FuncallExit (f a) -> f (FuncallExit a) #

mapM :: Monad m => (a -> m b) -> FuncallExit a -> m (FuncallExit b) #

sequence :: Monad m => FuncallExit (m a) -> m (FuncallExit a) #

Lift a => Lift (FuncallExit a :: Type) Source # 
Instance details

Defined in Data.Emacs.Module.Env.Functions

Methods

lift :: FuncallExit a -> Q Exp #

liftTyped :: FuncallExit a -> Q (TExp (FuncallExit a)) #

Eq a => Eq (FuncallExit a) Source # 
Instance details

Defined in Data.Emacs.Module.Env.Functions

Data a => Data (FuncallExit a) Source # 
Instance details

Defined in Data.Emacs.Module.Env.Functions

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> FuncallExit a -> c (FuncallExit a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (FuncallExit a) #

toConstr :: FuncallExit a -> Constr #

dataTypeOf :: FuncallExit a -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (FuncallExit a)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (FuncallExit a)) #

gmapT :: (forall b. Data b => b -> b) -> FuncallExit a -> FuncallExit a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> FuncallExit a -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> FuncallExit a -> r #

gmapQ :: (forall d. Data d => d -> u) -> FuncallExit a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> FuncallExit a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> FuncallExit a -> m (FuncallExit a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> FuncallExit a -> m (FuncallExit a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> FuncallExit a -> m (FuncallExit a) #

Ord a => Ord (FuncallExit a) Source # 
Instance details

Defined in Data.Emacs.Module.Env.Functions

Show a => Show (FuncallExit a) Source # 
Instance details

Defined in Data.Emacs.Module.Env.Functions

Generic (FuncallExit a) Source # 
Instance details

Defined in Data.Emacs.Module.Env.Functions

Associated Types

type Rep (FuncallExit a) :: Type -> Type #

Methods

from :: FuncallExit a -> Rep (FuncallExit a) x #

to :: Rep (FuncallExit a) x -> FuncallExit a #

type Rep (FuncallExit a) Source # 
Instance details

Defined in Data.Emacs.Module.Env.Functions

type Rep (FuncallExit a) = D1 ('MetaData "FuncallExit" "Data.Emacs.Module.Env.Functions" "emacs-module-0.1.1.1-C4EeyV2Os1JLHvH0AMaocA" 'False) (C1 ('MetaCons "FuncallExitReturn" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "FuncallExitSignal" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a)) :+: C1 ('MetaCons "FuncallExitThrow" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a))))

Wrappers around struct emacs_env fields

isValidEnv :: MonadIO m => Env -> m Bool Source #

Check wheter passed emacs_env structure has expected size so that we will be able to access all of its fields.

makeGlobalRef :: forall m. MonadIO m => Env -> RawValue -> m GlobalRef Source #

freeGlobalRef :: forall m. MonadIO m => Env -> GlobalRef -> m () Source #

nonLocalExitGet Source #

Arguments

:: MonadIO m 
=> Env 
-> NonNullPtr RawValue

Symbol output

-> NonNullPtr RawValue

Data output

-> m EnumFuncallExit 

nonLocalExitSignal Source #

Arguments

:: MonadIO m 
=> Env 
-> RawValue

Error symbol

-> RawValue

Error data

-> m () 

nonLocalExitThrow Source #

Arguments

:: MonadIO m 
=> Env 
-> RawValue

Tag, a symbol

-> RawValue

Value

-> m () 

makeFunction Source #

Arguments

:: forall m a. MonadIO m 
=> Env 
-> CPtrdiff

Minimum arity

-> CPtrdiff

Maximum arity

-> RawFunction a

Implementation

-> CString

Documentation

-> Ptr a

Extra data

-> m RawValue 

funcall Source #

Arguments

:: MonadIO m 
=> Env 
-> RawValue

Function

-> CPtrdiff

Number of arguments

-> NonNullPtr RawValue

Actual arguments

-> m RawValue 

funcallPrimitive Source #

Arguments

:: MonadIO m 
=> Env 
-> RawValue

Function

-> CPtrdiff

Number of arguments

-> NonNullPtr RawValue

Actual arguments

-> m RawValue 

isNotNil :: MonadIO m => Env -> RawValue -> m CBoolean Source #

eq :: MonadIO m => Env -> RawValue -> RawValue -> m CBoolean Source #

copyStringContents Source #

Arguments

:: MonadIO m 
=> Env 
-> RawValue

Emacs value that holds a string

-> CString

Destination, may be NULL

-> NonNullPtr CPtrdiff

SIZE pointer

-> m CBoolean 

Copy the content of the Lisp string VALUE to BUFFER as an utf8 null-terminated string.

SIZE must point to the total size of the buffer. If BUFFER is NULL or if SIZE is not big enough, write the required buffer size to SIZE and return true.

Note that SIZE must include the last null byte (e.g. "abc" needs a buffer of size 4).

Return true if the string was successfully copied.

makeString Source #

Arguments

:: MonadIO m 
=> Env 
-> CString

0-terminated utf8-encoded string.

-> CPtrdiff

Length.

-> m RawValue 

makeUserPtr :: forall m a. MonadIO m => Env -> UserPtrFinaliser a -> Ptr a -> m RawValue Source #

getUserPtr :: MonadIO m => Env -> RawValue -> m (Ptr a) Source #

setUserPtr :: MonadIO m => Env -> RawValue -> Ptr a -> m () Source #

vecSet :: MonadIO m => Env -> RawValue -> CPtrdiff -> RawValue -> m () Source #

Expose functions to Emacs

Expose Haskell data to Emacs

freeStablePtrFinaliser :: UserPtrFinaliser a Source #

Pass to makeUserPtr so that Emacs will free the Haskell's stable pointer when the corresponding elisp value goes out of scope.