{-# LINE 1 "libraries\\Win32\\System\\Win32\\Console.hsc" #-}
{-# LINE 2 "libraries\\Win32\\System\\Win32\\Console.hsc" #-}
{-# LANGUAGE Safe #-}
{-# LINE 6 "libraries\\Win32\\System\\Win32\\Console.hsc" #-}
module System.Win32.Console (
getConsoleCP,
setConsoleCP,
getConsoleOutputCP,
setConsoleOutputCP,
CtrlEvent, cTRL_C_EVENT, cTRL_BREAK_EVENT,
generateConsoleCtrlEvent,
commandLineToArgv
) where
#include "windows_cconv.h"
import System.Win32.Types
import Foreign.C.Types (CInt(..))
import Foreign.C.String (withCWString, CWString)
import Foreign.Ptr (Ptr)
import Foreign.Storable (peek)
import Foreign.Marshal.Array (peekArray)
import Foreign.Marshal.Alloc (alloca)
foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleCP"
getConsoleCP :: IO UINT
foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleCP"
setConsoleCP :: UINT -> IO ()
foreign import WINDOWS_CCONV unsafe "windows.h GetConsoleOutputCP"
getConsoleOutputCP :: IO UINT
foreign import WINDOWS_CCONV unsafe "windows.h SetConsoleOutputCP"
setConsoleOutputCP :: UINT -> IO ()
type CtrlEvent = DWORD
cTRL_C_EVENT :: CtrlEvent
cTRL_C_EVENT = 0
cTRL_BREAK_EVENT :: CtrlEvent
cTRL_BREAK_EVENT = 1
{-# LINE 61 "libraries\\Win32\\System\\Win32\\Console.hsc" #-}
generateConsoleCtrlEvent :: CtrlEvent -> DWORD -> IO ()
generateConsoleCtrlEvent e p
= failIfFalse_
"generateConsoleCtrlEvent"
$ c_GenerateConsoleCtrlEvent e p
foreign import WINDOWS_CCONV safe "windows.h GenerateConsoleCtrlEvent"
c_GenerateConsoleCtrlEvent :: CtrlEvent -> DWORD -> IO BOOL
foreign import WINDOWS_CCONV unsafe "Shellapi.h CommandLineToArgvW"
c_CommandLineToArgvW :: CWString -> Ptr CInt -> IO (Ptr CWString)
commandLineToArgv :: String -> IO [String]
commandLineToArgv [] = return []
commandLineToArgv arg =
do withCWString arg $ \c_arg -> do
alloca $ \c_size -> do
res <- c_CommandLineToArgvW c_arg c_size
size <- peek c_size
args <- peekArray (fromIntegral size) res
_ <- localFree res
mapM peekTString args