echo >&3 "done"
) || fail

echo -n "build twapi ... "
(
  exec 3>&1
  exec >> build.log 2>&1
  CC=`echo $CC | sed -e 's/-D_WIN32_WINNT=0x[0-9]\+//g'`
  cd twapi
  test -e build-stamp && echo >&3 "already done" && exit 0
  DESTDIR=${HERE} ./configure --build=i386-windows-mingw32 --prefix=${PFX} \
    --with-tcl=${HERE}/tcl/win --enable-threads || exit 1
  if test "X${TWAPI_LDFLAGS}" != "X" ; then
    # standard mingw packages on Debian/Ubuntu lack libwintrust.a
    perl -pi -e 's@\${SHLIB_LD} @\${SHLIB_LD} '"${TWAPI_LDFLAGS}"' @g' Makefile
  fi
  make || exit 1
  make install-binaries install-libraries DESTDIR=${HERE} || exit 1
  touch build-stamp
  echo >&3 "done"
) || fail

echo -n "build tclwmf ... "
(
  exec 3>&1
  exec >> build.log 2>&1
  CC=`echo $CC | sed -e 's/-D_WIN32_WINNT=0x[0-9]\+//g'`
  cd tclwmf
  test -e build-stamp && echo >&3 "already done" && exit 0
  DESTDIR=${HERE} ./configure --build=i386-windows-mingw32 --prefix=${PFX} \
    --with-tcl=${HERE}/tcl/win --with-tk=${HERE}/sdl2tk/sdl \
    --enable-threads || exit 1
  make || exit 1
  make install-binaries install-libraries DESTDIR=${HERE} || exit 1

  echo >&3 "done"
) || fail

echo -n "build twapi ... "
(
  exec 3>&1
  exec >> build.log 2>&1
  CC=`echo $CC | sed -e 's/-D_WIN32_WINNT=0x[0-9]\+//g'`
  cd twapi
  test -e build-stamp && echo >&3 "already done" && exit 0
  DESTDIR=${HERE} ./configure --build=x86_64-windows-mingw32 --prefix=${PFX} \
    --with-tcl=${HERE}/tcl/win --enable-threads || exit 1
  make || exit 1
  make install-binaries install-libraries DESTDIR=${HERE} || exit 1
  touch build-stamp
  echo >&3 "done"
) || fail

echo -n "build tclwmf ... "
(
  exec 3>&1
  exec >> build.log 2>&1
  CC=`echo $CC | sed -e 's/-D_WIN32_WINNT=0x[0-9]\+//g'`
  cd tclwmf
  test -e build-stamp && echo >&3 "already done" && exit 0
  DESTDIR=${HERE} ./configure --build=x86_64-windows-mingw32 --prefix=${PFX} \
    --with-tcl=${HERE}/tcl/win --with-tk=${HERE}/sdl2tk/sdl \
    --enable-threads || exit 1
  make || exit 1
  make install-binaries install-libraries DESTDIR=${HERE} || exit 1

  echo >&3 "done"
) || fail

echo -n "build twapi ... "
(
  exec 3>&1
  exec >> build.log 2>&1
  CC=`echo $CC | sed -e 's/-D_WIN32_WINNT=0x[0-9]\+//g'`
  cd twapi
  test -e build-stamp && echo >&3 "already done" && exit 0
  DESTDIR=${HERE} ./configure --build=i386-windows-mingw32 --prefix=${PFX} \
    --with-tcl=${HERE}/tcl/win --enable-threads || exit 1
  if test "X${TWAPI_LDFLAGS}" != "X" ; then
    # standard mingw packages on Debian/Ubuntu lack libwintrust.a
    perl -pi -e 's@\${SHLIB_LD} @\${SHLIB_LD} '"${TWAPI_LDFLAGS}"' @g' Makefile

  echo >&3 "done"
) || fail

echo -n "build twapi ... "
(
  exec 3>&1
  exec >> build.log 2>&1
  CC=`echo $CC | sed -e 's/-D_WIN32_WINNT=0x[0-9]\+//g'`
  cd twapi
  test -e build-stamp && echo >&3 "already done" && exit 0
  DESTDIR=${HERE} ./configure --build=x86_64-windows-mingw32 --prefix=${PFX} \
    --with-tcl=${HERE}/tcl/win --enable-threads || exit 1
  make || exit 1
  make install-binaries install-libraries DESTDIR=${HERE} || exit 1
  touch build-stamp

}

TWAPI_EXTERN Tcl_Obj *ObjFromTclUniCharN(const Tcl_UniChar *ws, int len)
{
    if (ws == NULL)
        return ObjFromEmptyString();

#if TCL_UTF_MAX <= 4
    TWAPI_ASSERT(sizeof(Tcl_UniChar) == sizeof(WCHAR));
    if (gBaseSettings.use_unicode_obj)
        return Tcl_NewUnicodeObj(ws, len);
    else
        return TwapiUtf8ObjFromWinChars(ws, len);
#else
    return Tcl_NewUnicodeObj(ws, len);
#endif
}

TWAPI_EXTERN Tcl_Obj *ObjFromTclUniChar(const Tcl_UniChar *ws)
{
    if (ws == NULL)
        return ObjFromEmptyString(); /* TBD - log ? */

#if TCL_UTF_MAX <= 4
    TWAPI_ASSERT(sizeof(Tcl_UniChar) == sizeof(WCHAR));
    if (gBaseSettings.use_unicode_obj)
        return Tcl_NewUnicodeObj(ws, -1);
    else
        return TwapiUtf8ObjFromWinChars(ws, -1);
#else
    return Tcl_NewUnicodeObj(ws, -1);

    return res;
}

TWAPI_EXTERN TCL_RESULT ObjToDouble(Tcl_Interp *interp, Tcl_Obj *objP, double *dblP)
{
    return Tcl_GetDoubleFromObj(interp, objP, dblP);
}

TWAPI_EXTERN TCL_RESULT ObjToFloat(Tcl_Interp *interp, Tcl_Obj *objP, float *fltP)
{
    double dval;
    TCL_RESULT res = Tcl_GetDoubleFromObj(interp, objP, &dval);
    if (res == TCL_OK)
        *fltP = (float) dval;
    return res;
}

TWAPI_EXTERN Tcl_Obj *ObjNewList(int objc, Tcl_Obj * const objv[])
{
    return Tcl_NewListObj(objc, objv);
}

TWAPI_EXTERN Tcl_Obj *ObjEmptyList(void)

TWAPI_EXTERN Tcl_Obj *ObjFromWideInt(Tcl_WideInt val)
{
    return Tcl_NewWideIntObj(val);
}

TWAPI_EXTERN Tcl_Obj *ObjFromDouble(double val)
{
    return Tcl_NewDoubleObj(val);
}

TWAPI_EXTERN Tcl_Obj *ObjFromFloat(float val)
{
    return Tcl_NewDoubleObj(val);
}

TWAPI_EXTERN Tcl_Obj *ObjFromBoolean(int bval)
{
    return Tcl_NewBooleanObj(bval);
}

        objs[2] = ObjFromDWORD(u.basicP->dwPathLenConstraint);
        objP = ObjNewList(3, objs);
    } else if (dwoid == (DWORD_PTR) X509_AUTHORITY_KEY_ID2) {
        objs[0] = ObjFromCRYPT_BLOB(&u.akeyidP->KeyId);
        objs[1] = ObjFromCERT_ALT_NAME_INFO(&u.akeyidP->AuthorityCertIssuer);
        objs[2] = ObjFromCRYPT_BLOB(&u.akeyidP->AuthorityCertSerialNumber);
        objP = ObjNewList(3, objs);
    } else if (dwoid == (DWORD_PTR) X509_ALGORITHM_IDENTIFIER) {
        fnP = ObjFromCRYPT_ALGORITHM_IDENTIFIER;
    } else if (dwoid == (DWORD_PTR) X509_CERT_REQUEST_TO_BE_SIGNED) {
        fnP = ObjFromCERT_REQUEST_INFO;
    } else if (dwoid == (DWORD_PTR) X509_CERT_POLICIES) {
        fnP = ObjFromCERT_POLICIES_INFO;
    } else if (dwoid == (DWORD_PTR) X509_POLICY_CONSTRAINTS) {
        fnP = ObjFromCERT_POLICY_CONSTRAINTS_INFO;
    } else if (dwoid == (DWORD_PTR) X509_POLICY_MAPPINGS) {
        fnP = ObjFromCERT_POLICY_MAPPINGS_INFO;
    } else if (dwoid == (DWORD_PTR) X509_EXTENSIONS) {
        objP = ObjFromCERT_EXTENSIONS(u.cextsP->cExtension, u.cextsP->rgExtension);
    } else if (dwoid == (DWORD_PTR) X509_CRL_DIST_POINTS) {
        fnP = ObjFromCRL_DIST_POINTS_INFO;
    } else if (dwoid == (DWORD_PTR) X509_AUTHORITY_INFO_ACCESS) {
        fnP = ObjFromCERT_AUTHORITY_INFO_ACCESS;
    } else if (dwoid == (DWORD_PTR) X509_UNICODE_ANY_STRING) {
        fnP = ObjFromCERT_NAME_VALUE_WinChars;
    } else if (dwoid == (DWORD_PTR) X509_PUBLIC_KEY_INFO) {
        fnP = ObjFromCERT_PUBLIC_KEY_INFO;
    } else if (dwoid == (DWORD_PTR) RSA_CSP_PUBLICKEYBLOB) {
        objP = ObjFromBLOBHEADER(u.pv, n);
    } else if (dwoid == (DWORD_PTR) (65535-1)) { // szOID_SUBJECT_KEY_IDENTIFIER
        fnP = ObjFromCRYPT_BLOB;
    } else {
        objP = ObjFromByteArray(u.pv, n);
    }

        if ((res = ParseCERT_ALT_NAME_INFO(ticP, valObj, &u.cani)) != TCL_OK)
            return res;
    } else if (dwoid == (DWORD_PTR) X509_BASIC_CONSTRAINTS2) {
        if (ObjGetElements(NULL, valObj, &nobjs, &objs) != TCL_OK ||
            nobjs != 3 ||
            ObjToBoolean(NULL, objs[0], &u.basic.fCA) != TCL_OK ||
            ObjToBoolean(NULL, objs[1], &u.basic.fPathLenConstraint) != TCL_OK ||
            ObjToBoolean(NULL, objs[2], (int *) &u.basic.dwPathLenConstraint) != TCL_OK) {
            return TwapiReturnErrorMsg(interp, TWAPI_INVALID_ARGS, "Invalid basic constraints.");
        }
    } else if (dwoid == (DWORD_PTR) X509_AUTHORITY_KEY_ID2) {
        if (ObjGetElements(NULL, valObj, &nobjs, &objs) != TCL_OK ||
            nobjs != 3 ||
            ParseCRYPT_BLOB(ticP, objs[0], &u.auth_key_id.KeyId) != TCL_OK ||
            ParseCERT_ALT_NAME_INFO(ticP, objs[1], &u.auth_key_id.AuthorityCertIssuer) != TCL_OK ||
            ParseCRYPT_BLOB(ticP, objs[2], &u.auth_key_id.AuthorityCertSerialNumber) != TCL_OK) {
            return TwapiReturnErrorMsg(interp, TWAPI_INVALID_ARGS, "Invalid authority key id.");
        }
    } else if (dwoid == (DWORD_PTR) X509_ALGORITHM_IDENTIFIER) {
        res = ParseCRYPT_ALGORITHM_IDENTIFIER(ticP, valObj, &u.algid);
        if (res != TCL_OK)
            return res;
    } else if (dwoid == (DWORD_PTR) X509_EXTENSIONS) {
        res = ParseCERT_EXTENSIONS(ticP, valObj, &u.cexts.cExtension, &u.cexts.rgExtension);
    } else if (dwoid == (DWORD_PTR) X509_UNICODE_ANY_STRING) {
        if ((res = ParseCERT_NAME_VALUE_WinChars(ticP, valObj, &u.cnv)) != TCL_OK)
            return res;
    } else if (dwoid == (DWORD_PTR) X509_PUBLIC_KEY_INFO) {
        if ((res = ParseCERT_PUBLIC_KEY_INFO(ticP, valObj, &u.cpki)) != TCL_OK)
            return res;
    } else if (dwoid == (DWORD_PTR) RSA_CSP_PUBLICKEYBLOB) {
        if (ObjGetElements(NULL, valObj, &nobjs, &objs) == TCL_OK &&
            nobjs == 5) {
            int n;
            BLOBHEADER *bhdrP = (BLOBHEADER*) ObjToByteArray(objs[4], &n);
            /* Sanity check that it is a public key blob */
            if (bhdrP->bType == PUBLICKEYBLOB &&
                n > (sizeof(BLOBHEADER)+sizeof(RSAPUBKEY))) {

currently stored in the clipboard may be obtained through the
[uri \#get_clipboard_formats [cmd get_clipboard_formats]] command.

[para]
When reading or writing data, the application is responsible for formatting
data appropriately, possibly through the use of Tcl's [cmd binary] command.
The exceptions to this are the
[uri \#read_clipboard_text [cmd read_clipboard_text]],
[uri \#write_clipboard_text [cmd write_clipboard_text]]
[uri \#read_clipboard_paths [cmd read_clipboard_paths]],
[uri \#write_clipboard_paths [cmd write_clipboard_paths]]
commands which assume the data is text and file paths respectively.

[section "Writing Data"]

To store data in a single format, the
[uri \#write_clipboard [cmd write_clipboard]],
[uri \#write_clipboard_text [cmd write_clipboard_text]] or
[uri \#write_clipboard_paths [cmd write_clipboard_paths]] may
be directly called.
[para]
To store multiple formats, the clipboard must first be
opened with the [uri \#open_clipboard [cmd open_clipboard]]


call followed by a call to [uri #empty_clipboard [cmd empty_clipboard]].
Data may then be stored in the clipboard in different formats
by calling 
[uri \#write_clipboard [cmd write_clipboard]],

[uri \#write_clipboard_text [cmd write_clipboard_text]] or
[uri \#write_clipboard_paths [cmd write_clipboard_paths]]
multiple times. Finally the clipboard must be
closed with [uri \#close_clipboard [cmd close_clipboard]].


[section "Reading Data"]

To read data from the clipboard, call

[uri \#read_clipboard [cmd read_clipboard]],
[uri \#read_clipboard_text [cmd read_clipboard_text]] or
[uri \#read_clipboard_paths [cmd read_clipboard_paths]].

[section "Monitoring clipboard changes"]
An application can monitor the clipboard by calling
[uri #start_clipboard_monitor [cmd start_clipboard_monitor]] to set up a notification
callback that is invoked when the contents of the clipboard change.

[section Commands]

Closes the clipboard which must have been
previously opened with [uri \#open_clipboard [cmd open_clipboard]].

[call [cmd empty_clipboard]]

Empties the clipboard and claims ownership for further writes.
The clipboard must have been
previously opened with [uri \#open_clipboard [cmd open_clipboard]].


[call [cmd get_clipboard_formats]]
Returns a list of the formats currently available in the clipboard. The
clipboard must have been opened before this function is called.

[call [cmd get_registered_clipboard_format_name] [arg FORMAT]]
Returns the name associated with a registered clipboard format. [arg FORMAT]

require the clipboard to have been previously opened. The clipboard must
be closed once the operations are done by calling
[uri \#close_clipboard [cmd close_clipboard]].

[call [cmd read_clipboard] [arg FORMAT]]

Reads the contents of the clipboard in the given format and returns it.
If the clipboard was already opened through
[uri \#open_clipboard [cmd open_clipboard]],
it remains open when the command returns except in the case of any Tcl
exceptions. If the clipboard was not open, it will opened and closed
before the command returns.
In all cases where an exception is raised, the clipboard is closed before
the command returns.
[nl]
[arg FORMAT] must be one of the clipboard formats as defined in
[sectref "Clipboard formats"]. The content is an exact copy of the
contents of the clipboard in binary format. Callers will need to
use Tcl commands such as [cmd binary] and [cmd encoding] to parse the data.

[call [cmd read_clipboard_paths]]

Returns a list of file paths stored in the clipboard.
If the clipboard was already opened through
[uri \#open_clipboard [cmd open_clipboard]],
it remains open when the command returns except in the case of any Tcl
exceptions. If the clipboard was not open, it will be opened and closed
before the command returns.
In all cases where an exception is raised, the clipboard is closed before
the command returns.

[call [cmd read_clipboard_text] [opt "[cmd -raw] [arg BOOLEAN]"]]

Retrieves the content of the clipboard as text.
If the clipboard was already opened through
[uri \#open_clipboard [cmd open_clipboard]],
it remains open when the command returns except in the case of any Tcl
exceptions. If the clipboard was not open, it will be opened and closed
before the command returns.
In all cases where an exception is raised, the clipboard is closed before
the command returns.
[nl]
If [cmd -raw] is specified as false (default),
the command converts CR-LF line terminators in clipboard content
to LF line terminators. If [cmd -raw] specified as true, the command
does no conversion of the clipboard data.

[call [cmd register_clipboard_format] [arg FORMATNAME]]

Stops a previously registered script that monitors clipboard contents.
[arg MONITOR_ID] is monitoring handle previously returned by
[uri #start_clipboard_monitor [cmd start_clipboard_monitor]].

[call [cmd write_clipboard] [arg FORMAT] [arg DATA]]

Writes [arg DATA] to the clipboard in the given format.
If the clipboard is already open, caller must have also claimed ownership

through the [uri #empty_clipboard [cmd empty_clipboard]] command.  In
this case, the clipboard remains open when the command returns
after writing the data except in the case of any Tcl exceptions.
[nl]
If the clipboard was not open when this command is called,
the command opens the clipboard, clears it of all content
by calling [uri #empty_clipboard [cmd empty_clipboard]],
writes the data to the clipboard and closes it.
[nl]
In all cases, the clipboard is
closed before returning if an exception is thrown. This
ensures other applications
are not locked out of the clipboard on errors.

[nl]
[arg FORMAT] must be one of the clipboard formats as defined in
[sectref "Clipboard formats"]. The content is an exact copy of the
contents of the clipboard in binary format. Callers will need to
use Tcl commands such as [cmd binary] and [cmd encoding] to parse the data.
[nl]
Multiple [cmd write_clipboard] commands may be executed between
a [uri \#open_clipboard [cmd open_clipboard]]
and [uri \#close_clipboard [cmd close_clipboard]] pair as long as the
specified formats are different for each. Writing a format previously
specified in the sequence overwrites the previous contents of that format.

[call [cmd write_clipboard_paths] [arg PATHS]]

Stores the specified list of file paths in the clipboard
in the [const CF_HDROP] ([const 15]) clipboard format.
Each path is normalized and converted to native format.
[nl]
If the clipboard is already open, caller must have also claimed ownership
through the [uri #empty_clipboard [cmd empty_clipboard]] command.  In
this case, the clipboard remains open when the command returns
after writing the data except in the case of any Tcl exceptions.
[nl]
If the clipboard was not open when this command is called,
the command opens the clipboard, clears it of all content
by calling [uri #empty_clipboard [cmd empty_clipboard]],
writes the data to the clipboard and closes it.
[nl]
In all cases, the clipboard is
closed before returning if an exception is thrown. This
ensures other applications
are not locked out of the clipboard on errors.

[call [cmd write_clipboard_text] [arg TEXT] [opt "[cmd -raw] [arg BOOLEAN]"]]

Writes the given text string to the clipboard.
If the clipboard is already open, caller must have also claimed ownership
through the [uri #empty_clipboard [cmd empty_clipboard]] command.  In
this case, the clipboard remains open when the command returns
after writing the data except in the case of any Tcl exceptions.
[nl]
If the clipboard was not open when this command is called,
the command opens the clipboard, clears it of all content
by calling [uri #empty_clipboard [cmd empty_clipboard]],
writes the data to the clipboard and closes it.
[nl]
In all cases, the clipboard is
closed before returning if an exception is thrown. This
ensures other applications
are not locked out of the clipboard on errors.
[nl]
If [cmd -raw] is specified as false (default),
the command converts LF line terminators without a preceding CR
to CRLF line terminators. If [cmd -raw] specified as true, the command
does no conversion.

[list_end]

[keywords clipboard "format, clipboard" "read clipboard" "clipboard formats" "write clipboard"]

[manpage_end]

[comment {-*- tcl -*- doctools manpage}]
[manpage_begin "Version History" "n" ""]
[copyright "2003-2015 Ashok P. Nadkarni"]
[moddesc "TWAPI Version History"]
[titledesc "Tcl Windows API extension version history"]
[description]
[para]
Summarizes the list of changes for each version of TWAPI.

[section "Version 4.2a7"]

[list_begin bullet]

[bullet]
Added [uri clipboard.html#read_clipboard_paths [cmd read_clipboard_paths]] and
[uri clipboard.html#write_clipboard_paths [cmd write_clipboard_paths]]
and modified clipboard commands to not require an explicit open.

[bullet]
Added command
[uri storage.html#drive_ready [cmd drive_ready]].

[bullet]
Added [uri certs.html#cert_verify [cmd cert_verify]],
[uri certs.html#cert_chain_build [cmd cert_chain_build]],
[uri certs.html#cert_chain_simple_chain [cmd cert_chain_simple_chain]],
[uri certs.html#cert_chain_trust_errors [cmd cert_chain_trust_errors]],
[uri certs.html#cert_chain_trust_info [cmd cert_chain_trust_info]]
for certificate validation.

[bullet]
[emph "Incompatible change"]
The commands
[uri certs.html#cert_set_key_prov [cmd cert_set_key_prov]],
[uri certs.html#cert_create_self_signed [cmd cert_create_self_signed]]
now take the key container and key specifier as explicit arguments.





[list_end]

[section "Version 4.1.27"]
The major change in this release is support for writing COM servers in Tcl.

[list_begin bullet]

    EVENT_TRACE_PROPERTIES **etPP)
{
    int i, buf_sz;
    Tcl_Obj **objv;
    int       objc;
    int       logfile_name_i;
    int       session_name_i;
    WCHAR    *logfile_name = NULL;
    WCHAR    *session_name = NULL;
    EVENT_TRACE_PROPERTIES *etP;
    Tcl_WideInt wide;
    int field;
    /* IMPORTANT : 
     * Do not change order without changing switch statement below!
     */
    static const char * g_event_trace_fields[] = {

TWAPI_INLINE TCL_RESULT ObjToUINT(Tcl_Interp *ip, Tcl_Obj *objP, UINT *uiP) {
    return ObjToDWORD(ip, objP, (DWORD *)uiP);
}

TWAPI_EXTERN TCL_RESULT ObjToWideInt(Tcl_Interp *interp, Tcl_Obj *objP, Tcl_WideInt *wideP);
TWAPI_EXTERN Tcl_Obj *ObjFromDouble(double val);
TWAPI_EXTERN TCL_RESULT ObjToDouble(Tcl_Interp *interp, Tcl_Obj *objP, double *);
TWAPI_EXTERN Tcl_Obj *ObjFromFloat(float val);
TWAPI_EXTERN TCL_RESULT ObjToFloat(Tcl_Interp *interp, Tcl_Obj *objP, float *);
TWAPI_EXTERN TCL_RESULT ObjToDWORD_PTR(Tcl_Interp *interp, Tcl_Obj *objP, DWORD_PTR *dwP);
#ifdef _WIN64
#define ObjFromDWORD_PTR(p_)  ObjFromULONGLONG((ULONGLONG)(p_))
#define ObjToLONG_PTR         ObjToWideInt
#define ObjFromLONG_PTR       ObjFromWideInt
#else  // ! _WIN64
#define ObjFromDWORD_PTR(p_)  ObjFromDWORD((DWORD_PTR)(p_))

    
    num_chars = Tcl_GetCharLength(input_obj);

    /* Now loop through every character adding it to the input event array */
    /* Win2K and up, accepts unicode characters */

    /* NUmber of events is twice number of chars (keydown + keyup) */
#if TCL_UTF_MAX < 4
    max_input_records = 2 * num_chars;
#else
    max_input_records = 4 * num_chars;
#endif
    input = MemLifoAlloc(ticP->memlifoP, max_input_records * sizeof(*input), NULL);
    for (i = 0, j = 0; i < num_chars; ++i) {
        WCHAR wch;

#if TCL_UTF_MAX > 4
	Tcl_UniChar uch;


#endif

#ifndef KEYEVENTF_UNICODE
#define KEYEVENTF_UNICODE     0x0004
#endif
            
#if TCL_UTF_MAX <= 4
        wch = Tcl_GetUniChar(input_obj, i);
#else
        uch = Tcl_GetUniChar(input_obj, i);
	if (uch > 0xFFFF) {
            wch = (((uch - 0x10000) >> 10) & 0x3FF) | 0xD800;
            init_keyboard_input(&input[j], 0, KEYEVENTF_UNICODE);
            input[j].ki.wScan = wch;
            ++j;
            init_keyboard_input(&input[j], 0, KEYEVENTF_UNICODE|KEYEVENTF_KEYUP);
            input[j].ki.wScan  = wch;
            j++;
            wch = ((uch - 0x10000) & 0x3FF) | 0xDC00;
	} else {
            wch = (WCHAR) uch;
	}
#endif
        init_keyboard_input(&input[j], 0, KEYEVENTF_UNICODE);
        input[j].ki.wScan = wch;
        ++j;
        init_keyboard_input(&input[j], 0, KEYEVENTF_UNICODE|KEYEVENTF_KEYUP);
        input[j].ki.wScan  = wch;
        ++j;

/* 
 * Copyright (c) 2004-2012 Ashok P. Nadkarni
 * All rights reserved.
 *
 * See the file LICENSE for license
 */

/* TBD - move theme functions to UI module ? */

#include "twapi.h"
#include <initguid.h> /* GUIDs in all included files below this will be instantiated */

/* Note: some versions of mingw define IID_IShellLinkDataList and some don't.
   Unlike MS VC++ which does not complain if duplicate definitions match,
   gcc is not happy and I cannot get gcc's selectany attribute for
   ignoring duplicate definitions to work. So just we use our own variable
   with content that is identical to the original.
*/
DEFINE_GUID(TWAPI_IID_IShellLinkDataList,     0x45e2b4ae, 0xb1c3, 0x11d0, 0xb9, 0x2f, 0x0, 0xa0, 0xc9, 0x3, 0x12, 0xe1);

#ifndef TWAPI_SINGLE_MODULE
static HMODULE gModuleHandle;     /* DLL handle to ourselves */
#endif

#ifndef MODULENAME
#define MODULENAME "twapi_shell"

        goto hres_vamoose;
    if (workingDirectory)
        hres = psl->lpVtbl->SetWorkingDirectory(psl, workingDirectory);
    if (FAILED(hres))
        goto hres_vamoose;

    if (runas) {
        hres = psl->lpVtbl->QueryInterface(psl, &TWAPI_IID_IShellLinkDataList,
                                           (LPVOID*)&psldl); 
        if (FAILED(hres))
            goto hres_vamoose;

        hres = psldl->lpVtbl->GetFlags(psldl, &runas);
        if (FAILED(hres))
            goto hres_vamoose;

    hres = psl->lpVtbl->GetWorkingDirectory(psl, buf, sizeof(buf)/sizeof(buf[0]));
    if (SUCCEEDED(hres)) {
        ObjAppendElement(interp, resultObj,
                                 STRING_LITERAL_OBJ("-workdir"));
        ObjAppendElement(interp, resultObj, ObjFromWinChars(buf));
    }
    
    hres = psl->lpVtbl->QueryInterface(psl, &TWAPI_IID_IShellLinkDataList,
                                       (LPVOID*)&psldl); 
    if (SUCCEEDED(hres)) {
        hres = psldl->lpVtbl->GetFlags(psldl, &runas);
        if (SUCCEEDED(hres)) {
            ObjAppendElement(interp, resultObj,
                             STRING_LITERAL_OBJ("-runas"));
            ObjAppendElement(interp, resultObj, ObjFromInt(runas & SLDF_RUNAS_USER ? 1 : 0));

#
# Copyright (c) 2004, 2008 Ashok P. Nadkarni
# All rights reserved.
#
# See the file LICENSE for license

# Clipboard related commands

namespace eval twapi {}


# Open the clipboard
# TBD - why no mechanism to pass window handle to OpenClipboard?
proc twapi::open_clipboard {} {
    OpenClipboard 0
}

# Close the clipboard
proc twapi::close_clipboard {} {
    catch {CloseClipboard}
    return
}

# Empty the clipboard
proc twapi::empty_clipboard {} {
    EmptyClipboard
}


proc twapi::_read_clipboard {fmt} {
    # Always catch errors and close clipboard before passing exception on
    # Also ensure memory unlocked
    trap {
        set h [GetClipboardData $fmt]
        set p [GlobalLock $h]
        set data [Twapi_ReadMemory 1 $p 0 [GlobalSize $h]]
    } onerror {} {
        catch {close_clipboard}
        rethrow
    } finally {
        # If p exists, then we must have locked the handle
        if {[info exists p]} {
            GlobalUnlock $h
        }
    }
    return $data
}

proc twapi::read_clipboard {fmt} {
    trap {
        set data [_read_clipboard $fmt]
    } onerror {TWAPI_WIN32 1418} {
        # Caller did not have clipboard open. Do it on its behalf
        open_clipboard
        trap {
            set data [_read_clipboard $fmt]
        } finally {
            catch {close_clipboard}
        }
    }
    return $data
}

# Read text data from the clipboard
proc twapi::read_clipboard_text {args} {
    array set opts [parseargs args {
        {raw.bool 0}
    }]


    set bin [read_clipboard 13]; # 13 -> Unicode

    # Decode Unicode and discard trailing nulls
    set data [string trimright [encoding convertfrom unicode $bin] \0]
    if {! $opts(raw)} {
        set data [string map {"\r\n" "\n"} $data]








    }

    return $data
}


proc twapi::_write_clipboard {fmt data} {
    # Always catch errors and close
    # clipboard before passing exception on
    trap {
        # For byte arrays, string length does return correct size
        # (DO NOT USE string bytelength - see Tcl docs!)
        set len [string length $data]

        # Allocate global memory
        set mem_h [GlobalAlloc 2 $len]
        set mem_p [GlobalLock $mem_h]

        Twapi_WriteMemory 1 $mem_p 0 $len $data

        # The rest of this code just to ensure we do not free
        # memory beyond this point irrespective of error/success
        set h $mem_h
        unset mem_p mem_h
        GlobalUnlock $h
        SetClipboardData $fmt $h
    } onerror {} {
        catch close_clipboard
        rethrow
    } finally {
        if {[info exists mem_p]} {
            GlobalUnlock $mem_h
        }
        if {[info exists mem_h]} {
            GlobalFree $mem_h
        }
    }
    return
}


proc twapi::write_clipboard {fmt data} {

    trap {

        _write_clipboard $fmt $data
    } onerror {TWAPI_WIN32 1418} {
        # Caller did not have clipboard open. Do it on its behalf
        open_clipboard
        empty_clipboard
        trap {


            _write_clipboard $fmt $data
        } finally {
            catch close_clipboard
        }
    }

    return



}








# Write text to the clipboard

proc twapi::write_clipboard_text {data args} {
    array set opts [parseargs args {
        {raw.bool 0}



    }]



    # Convert \n to \r\n leaving existing \r\n alone
    if {! $opts(raw)} {
        set data [regsub -all {(^|[^\r])\n} $data[set data ""] \\1\r\n]
    }
    append data \0
    write_clipboard 13 [encoding convertto unicode $data]; # 13 -> Unicode
    return
}

# Get current clipboard formats
proc twapi::get_clipboard_formats {} {
    return [Twapi_EnumClipboardFormats]
}

# Returns 1/0 depending on whether a format is on the clipboard. Clipboard
# does not have to be open
proc twapi::clipboard_format_available {fmt} {
    return [IsClipboardFormatAvailable $fmt]
}

proc twapi::read_clipboard_paths {} { 
    set bin [read_clipboard 15]
    # Extract the DROPFILES header 
    if {[binary scan $bin iiiii offset - - - unicode] != 5} { 
        error "Invalid or unsupported clipboard CF_DROP data." 
    } 
    # Sanity check 
    if {$offset >= [string length $bin]} { 
        error "Truncated clipboard data." 
    } 
    if {$unicode} { 
        set paths [encoding convertfrom unicode [string range $bin $offset end]] 
    } else { 
        set paths [encoding convertfrom ascii [string range $bin $offset end]] 
    } 
    return [lmap path [split $paths \0] { 
        if {[string length $path] == 0} break; # Empty string -> end of list 
        file join $path
    }] 
} 

proc twapi::write_clipboard_paths {paths} { 
    # The header for a DROPFILES path list in hex 
    set fheader "1400000000000000000000000000000001000000" 
    set bin [binary format H* $fheader] 
    foreach path $paths { 
        # Note explicit \0 so the encoded binary includes the null terminator 
        append bin [encoding convertto unicode "[file nativename [file normalize $path]]\0"] 
    } 
    # A Unicode null char to terminate the list of paths 
    append bin [encoding convertto unicode \0] 
    write_clipboard 15 $bin 
}

# Start monitoring of the clipboard
proc twapi::_clipboard_handler {} {
    variable _clipboard_monitors

    if {![info exists _clipboard_monitors] ||
        [llength $_clipboard_monitors] == 0} {

namespace eval twapi {
    # Get rid of this ugliness  -  TBD
    # Note this is different from NULL or {0 VOID} etc. It is more like
    # a null token passed to functions that expect ptr to strings and
    # allow the ptr to be NULL.
    variable nullptr "__null__"

    variable scriptdir [file dirname [info script]]

    # Name of the var holding log messages in reflected in the C
    # code, don't change it!
    variable log_messages {}

    ################################################################
    # Following procs are used early in init process so defined here

    proc ntwine {fields l} {
        set ntwine {}
        foreach e $l {
            lappend ntwine [twine $fields $e]
        }
        return $ntwine
    }

    # Qualifies a name in context of caller's caller
    proc callerns {name} {
        if {[string match "::*" $name]} {
            return $name
        }
        if {[info level] > 2} {
            return [uplevel 2 namespace current]::$name
        } else {
            return ::$name
        }
    }
}

# Make twapi versions the same as the base module versions
set twapi::version(twapi) $::twapi::version(twapi_base)

#
# log for tracing / debug messages.
proc twapi::debuglog_clear {} {
    variable log_messages
    set log_messages {}
}

        # "l i n e 1 \r \n l i n e 2 \0" possibly followed by junk.
        twapi::_ucs16_binary_to_string $clip_text
    } -result "line1\r\n\line2"

    ################################################################

    test read_clipboard-1.1 {
        Read the clipboard as character format without opening clipboard
    } -constraints {
        userInteraction
    } -body {
        copy2clip line1 line2

        set clip_text [twapi::read_clipboard 1]; # ANSI format

        # We should see clipboard results read as characters
        # "line1\r\nline2\0" followed potentially by junk
        string range $clip_text 0 [string first \0 $clip_text]-1
    } -result "line1\r\nline2"

    ################################################################

        set clip_data [twapi::read_clipboard 23456]
        twapi::close_clipboard

        string equal $data $clip_data
    } -result 1

    test write_clipboard-1.1 {
        Write Unicode data to the clipboard without opening clipboard
    } -body {


        # We have to format the data with a trailing null char
        set data [encoding convertto unicode "unicode text\0"]
        twapi::write_clipboard 13 $data

        # Now read it back

        set clip_data [twapi::read_clipboard 13]


        string equal $data $clip_data
    } -result 1

    test write_clipboard-2.0 {
        Write multiple formats to the clipboard
    } -body {
        twapi::open_clipboard
        twapi::write_clipboard_text "This is plain text"
        twapi::write_clipboard_paths [list {C:/temp/foo bar} {C:\xxx\yyy.zzz}]
        twapi::close_clipboard
        list [twapi::read_clipboard_text] [twapi::read_clipboard_paths]
    } -result [list "This is plain text" [list "C:/temp/foo bar" "C:/xxx/yyy.zzz"]]
        
    test write_clipboard-2.1 {
        Write multiple formats to the clipboard - fail
    } -body {
        twapi::write_clipboard_paths [list {C:/temp/foo bar} {C:\xxx\yyy.zzz}]
        twapi::write_clipboard_text "This is plain text"
        # If clipboard not already open, the write* calls clear it first
        # so there will be no file paths stored in clipboard
        list [twapi::read_clipboard_text] [catch {twapi::read_clipboard_paths}]
    } -result [list "This is plain text" 1]
        
    ################################################################

    test write_clipboard_text-1.0 {
        Write text to the clipboard
    } -body {
        set data "write_clipboard_text-1.0\nSecond line"
        twapi::open_clipboard
        twapi::empty_clipboard
        twapi::write_clipboard_text $data
        twapi::close_clipboard
        # Now read it back
        twapi::open_clipboard
        set clip_data [twapi::read_clipboard_text -raw 1]
        twapi::close_clipboard
        set clip_data;          # Note expect additional \r in result
    } -result "write_clipboard_text-1.0\r\nSecond line"

    test write_clipboard_text-2.0 {
        Write text to the clipboard -raw 0, without opening clipboard
    } -body {
        set data "write_clipboard_text-1.0\nSecond line"


        twapi::write_clipboard_text $data -raw 0

        # Now read it back

        twapi::read_clipboard_text -raw 1

        # Note expect additional \r in result
    } -result "write_clipboard_text-1.0\r\nSecond line"

    test write_clipboard_text-2.1 {
        Write text to the clipboard -raw 1
    } -body {
        set data "write_clipboard_text-1.0\nSecond line"
        twapi::open_clipboard
        twapi::empty_clipboard
        twapi::write_clipboard_text $data -raw 1
        twapi::close_clipboard
        # Now read it back
        twapi::open_clipboard
        set clip_data [twapi::read_clipboard_text -raw 1]
        twapi::close_clipboard
        set clip_data;          # Note no additional \r in result
    } -result "write_clipboard_text-1.0\nSecond line"

    ################################################################
    
    test write_clipboard_paths-1.0 {
        Write paths to the clipboard, without opening clipboard
    } -body {
        set paths [list foo [file nativename [info nameofexecutable]]]
        twapi::write_clipboard_paths $paths
        twapi::read_clipboard_paths 
    } -result [list [file normalize foo] [file normalize [info nameofexecutable]]]
    

    ################################################################

    test start_clipboard_monitor-1.0 {
        Monitor the clipboard
    } -constraints {
        userInteraction