--  conclip.ew v0.4 10 Sep 2008
--  Win32 Console Clipboard Routines
--  by Greg Haberek <ghaberek at gmail.com>
--
--  This is a simple library for making use of the Windows
--  clipboard in your Win32 console applications.
--
--  Routines:
--
--      SetClipboardText( sequence text )
--      text = GetClipboardText( integer clear )
--
--  Version History:
--
--      v0.4    Added null terminator in SetClipboardText() (thanks to Louis Puster)
--              Added 'clear' parameter to GetClipboardText()
--      v0.3    Added calls to GlobalAlloc, etc. as per MSDN (and jacques deschênes)
--      v0.2    Added call to EmptyClipboard prior to setting data
--      v0.1    Initial release

include dll.e
include machine.e

-- shared libraries
constant kernel32       = open_dll( "kernel32.dll" )
constant user32         = open_dll( "user32.dll" )

-- console routines
constant xGetConsoleWindow              = define_c_func( kernel32, "GetConsoleWindow", {}, C_ULONG )

-- memory routines
constant xGlobalAlloc                   = define_c_func( kernel32, "GlobalAlloc", {C_UINT, C_LONG}, C_POINTER )
constant xGlobalFree                    = define_c_func( kernel32, "GlobalFree", {C_POINTER}, C_POINTER )
constant xGlobalSize                    = define_c_func( kernel32, "GlobalSize", {C_POINTER}, C_LONG )
constant xGlobalLock                    = define_c_func( kernel32, "GlobalLock", {C_POINTER}, C_POINTER )
constant xGlobalUnlock                  = define_c_func( kernel32, "GlobalUnlock", {C_POINTER}, C_POINTER )

-- clipboard routines
constant xOpenClipboard                 = define_c_func( user32, "OpenClipboard", {C_ULONG}, C_UINT )
constant xCloseClipboard                = define_c_func( user32, "CloseClipboard", {}, C_UINT )
constant xEmptyClipboard                = define_c_func( user32, "EmptyClipboard", {}, C_UINT )
constant xSetClipboardData              = define_c_func( user32, "SetClipboardData", {C_UINT,C_LONG}, C_LONG )
constant xGetClipboardData              = define_c_func( user32, "GetClipboardData", {C_UINT}, C_LONG )
constant xIsClipboardFormatAvailable    = define_c_func( user32, "IsClipboardFormatAvailable", {C_UINT}, C_UINT )

-- global memory options
constant GMEM_MOVEABLE  = 2
constant GMEM_DDESHARE  = 8192
constant GMEM_CLIPBOARD = or_bits(GMEM_MOVEABLE, GMEM_DDESHARE)

-- clipboard formats
constant CF_TEXT        = 1

-- generic object
object junk

--/topic Console Clipboard
--/proc SetClipboardText( sequence text )
--Pastes text to the clipboard.
global procedure SetClipboardText( sequence text )

    atom hCon, hGlobal, pData, hData
    
    -- get Console handle
    hCon = c_func( xGetConsoleWindow, {} )

    -- open the clipboard
    if not c_func( xOpenClipboard, {hCon} ) then
        puts( 2, "Error opening clipboard.\n" )
        return
    end if
    
    -- empty the clipboard
    if not c_func( xEmptyClipboard, {} ) then
        puts( 2, "Error emptying clipboard.\n" )
        return
    end if
    
    -- allocate some memory (plus one byte for terminator)
    hGlobal = c_func( xGlobalAlloc, {GMEM_CLIPBOARD, length(text)+1} )
    if not hGlobal then
        puts( 2, "Error allocating memory.\n" )
        junk = c_func( xCloseClipboard, {} )
        return
    end if
    
    -- lock the memory
    pData = c_func( xGlobalLock, {hGlobal} )
    if not pData then
        puts( 2, "Error locking memory.\n" )
        junk = c_func( xGlobalFree, {hGlobal} )
        junk = c_func( xCloseClipboard, {} )
        return
    end if
    
    -- put the string in memory (with null terminator)
    poke( pData, text & 0 )
    
    -- unlock the memory
    junk = c_func( xGlobalUnlock, {hGlobal} )

    -- paste the text
    hData = c_func( xSetClipboardData, {CF_TEXT, pData} )
    if hData = 0 then
        puts( 2, "Error pasting to clipboard.\n" )
    end if
    
    -- free the text
    if c_func( xGlobalFree, {hGlobal} ) then
        puts( 2, "Error freeing memory.\n" )
    end if
    
    -- close the clipbard
    if not c_func( xCloseClipboard, {} ) then
        puts( 2, "Error closing clipboard.\n" )
    end if

end procedure

--/topic Console Clipboard
--/func GetClipboardText( integer clear )
--/ret sequence text
--Copys text from the clipboard.
--
--/b Parameters
--
--/li /i clear /n If /i clear is true, the clipboard will be emptied after copying.
global function GetClipboardText( integer clear )

    atom hCon, hGlobal, pData, size, pos
    sequence text
    
    -- start with empty text
    text = ""
    
    -- get Console handle
    hCon = c_func( xGetConsoleWindow, {} )

    -- open the clipboard
    if not c_func( xOpenClipboard, {hCon} ) then
        puts( 2, "Error opening clipboard.\n" )
        return text
    end if
    
    -- check for data
    if c_func( xIsClipboardFormatAvailable, {CF_TEXT} ) then

        -- get the data
        hGlobal = c_func( xGetClipboardData, {CF_TEXT} )
        if not hGlobal then
            puts( 2, "Error getting data.\n" )
            junk = c_func( xCloseClipboard, {} )
            return text
        end if
        
        -- lock memory
        pData = c_func( xGlobalLock, {hGlobal} )
        if not pData then
            puts( 2, "Error locking memory.\n" )
            junk = c_func( xCloseClipboard, {} )
            return text
        end if
        
        -- get size
        size = c_func( xGlobalSize, {hGlobal} )
        
        -- get the text
        text = peek({ pData, size })
        
        -- trim the text
        pos = find( 0, text )
        if pos then
            text = text[1..pos-1]
        end if
        
        if clear then
            -- empty the clipboard
            if not c_func( xEmptyClipboard, {} ) then
                puts( 2, "Error emptying clipboard.\n" )
                junk = c_func( xCloseClipboard, {} )
                return text
            end if
        end if
        
        -- unlock memory
        junk = c_func( xGlobalUnlock, {hGlobal} )
        
    end if

    -- close the clipbard
    if not c_func( xCloseClipboard, {} ) then
        puts( 2, "Error closing clipboard.\n" )
    end if

    return text
end function