%|||%
&|What       |'''ffidl'''|&
&|Where      |http://elf.org/ffidl/|&
&|Where      |http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/doc (dead)|&
&|version    |0.6|&
&|Updated    |??/2006|&
&|Contact    |mailto:rec@elf.org ([Roger E Critchlow%|%Roger E. Critchlow Jr.])|&



** See Also **

   [Ffix - Ffidl eXtented]:   an experimental wrapper to make foreign function calling easier



** Description **

'''ffidl''', "Foreign Function Interface with Dynamic Loading",  by [Roger E
Critchlow], is an [extension] which allows pure Tcl extensions to invoke
functions in shared libraries without having to create any glue code.  Ffidl
supports calls in both directions between C/C++ and Tcl, and operates on a
variety of platforms.

The Tcl command specifies a function name, a library, a list of
argument types, and a return type, and ffidl takes care of the details of
setting up the arguments and invoking the C function.  Using  ffidl, a pure Tcl
wrapper to a shared library can be created. 

Avaliable for [Linux], [Windows], and [Mac OS X].

modifications resulting in version 0.6 were contributed by [DAS].



** Development **

   [https://github.com/prs-de/ffidl%|%git repository]:   Released 0.7 version with Tcl 8.6 support (incorporates [PYK] changes below, compatibility with recent libffi and some cleanups).  Check out the renewed [https://prs-de.github.io/ffidl/%|%documentation]. [APN] Nice to see a new release. From the docs though it is not clear if the new version has support for 64-bit Windows (the original version did not). This is due to the fact, that size of data type ''long ''is 4 bytes even on 64-bit Windows and therefore unsuitable to store and retrieve function pointers.
   [https://chiselapp.com/user/pooryorick/repository/ffidl%|%unofficial fossil repository]:   no releases yet, but some minor fixes have been made.  Unlike 0.6, below, it builds with Tcl-8.6.

Changes to file ffidl.c version 0.7 however let build a properly working binary package for 32-bit Windows as well as for 64-bit Windows, which passes test suite. Verified using
   * Tcl/Tk version 8.6.4.1 installation's header and library files
   * ftp://sourceware.org/pub/libffi%|%libffi%|% library version 3.1.<<br>>Note: Binary built using library version 3.2.1 did not pass test suite.
   * https://sourceforge.net/projects/mingw-w64%|%MinGW-w64 for 32 and 64 bit Windows%|% compilers version 7.2.0.<<br>>Note: Use ''-mlong-double-64'' compiler option as Microsoft's data type ''long double'' is 8 bytes and equal to data type ''double''.

[Effe] 2018-06-20: I ran a bunch of tests on Win32 with ffidl 0.7 and libffi 3.1, 3.2.1 and 3.3-rc0, which is the latest version at the moment. I found that all problems stem from ffidl's use of the raw API. Raw calls in libffi 3.2.1 don't work, raw calls in libffi 3.3-rc0 work, but raw callbacks don't. All versions of libffi pass the basic and callback tests of ffidl if the raw API is ignored. Please consider that the raw API of libffi is neither documented nor covered by any test in its own test suite. I also looked at some libffi wrappers of other languages and found none that uses the raw API. Since raw calls are a runtime decision of ffidl depending on parameter types, I strongly suggest to make it an option that can be enabled at runtime (for those who need the speed).

Additionally, Tcl_LoadFile works on Windows (the Makefile doesn't advertise it). The advantage with Tcl_LoadFile is that Tcl itself takes care of making a copy of a DLL into a temporary folder if the DLL is located in a starkit. Note for users of ActiveTcl: It seems that ActiveTcl installs a hook on LoadLibrary for added comfort. This means that you can use a good old ffidl 0.6 (which uses LoadLibrary) and load a DLL from a starkit without any hassle while all other Tcl interpreters require you to make a copy of the DLL.

The diff applied to file ffidl.c against version 0.7: 
======none
@@ -540,0 +541 @@ EXTERN int        Ffidl_Init _ANSI_ARGS_((Tcl_I
+#endif
@@ -553 +553,0 @@ EXTERN int        Ffidl_Init _ANSI_ARGS_((Tcl_I
-#endif
@@ -1228 +1228 @@ static int cif_protocol(Tcl_Interp *inte
-#ifdef __WIN32__
+#if defined(__WIN32__) && ! defined(__WIN64__)
@@ -1546 +1546 @@ static void callback_callback(ffi_cif *f
-  long ltmp;
+  Tcl_WideIntOrLong ltmp;
@@ -1616 +1616 @@ static void callback_callback(ffi_cif *f
-      Tcl_ListObjAppendElement(interp, list, Tcl_NewLongObj((long)(*(void **)argp)));
+      Tcl_ListObjAppendElement(interp, list, Tcl_NewWideIntOrLong((Tcl_WideIntOrLong)(*(void **)argp)));
@@ -1652 +1652 @@ static void callback_callback(ffi_cif *f
-      ltmp = (long)dtmp;
+      ltmp = (Tcl_WideIntOrLong)dtmp;
@@ -1654 +1654 @@ static void callback_callback(ffi_cif *f
-        if (Tcl_GetLongFromObj(interp, obj, &ltmp) == TCL_ERROR) {
+        if (Tcl_GetWideIntOrLongFromObj(interp, obj, &ltmp) == TCL_ERROR) {
@@ -1658 +1658 @@ static void callback_callback(ffi_cif *f
-    } else if (Tcl_GetLongFromObj(interp, obj, &ltmp) == TCL_ERROR) {
+    } else if (Tcl_GetWideIntOrLongFromObj(interp, obj, &ltmp) == TCL_ERROR) {
@@ -1682 +1682 @@ static void callback_callback(ffi_cif *f
-      if (Tcl_GetLongFromObj(interp, obj, &ltmp) == TCL_ERROR) {
+      if (Tcl_GetWideIntOrLongFromObj(interp, obj, &ltmp) == TCL_ERROR) {
@@ -2257 +2257 @@ static int tcl_ffidl_info(ClientData cli
-    Tcl_SetObjResult(interp, Tcl_NewLongObj((long)interp));
+    Tcl_SetObjResult(interp, Tcl_NewWideIntOrLong((Tcl_WideIntOrLong)interp));
@@ -2400 +2400 @@ static int tcl_ffidl_call(ClientData cli
-  long ltmp;
+  Tcl_WideIntOrLong ltmp;
@@ -2421 +2421 @@ static int tcl_ffidl_call(ClientData cli
-        ltmp = (long)dtmp;
+        ltmp = (Tcl_WideIntOrLong)dtmp;
@@ -2423 +2423 @@ static int tcl_ffidl_call(ClientData cli
-          if (Tcl_GetLongFromObj(interp, obj, &ltmp) == TCL_ERROR)
+            if (Tcl_GetWideIntOrLongFromObj(interp, obj, &ltmp) == TCL_ERROR)
@@ -2425 +2425 @@ static int tcl_ffidl_call(ClientData cli
-      } else if (Tcl_GetLongFromObj(interp, obj, &ltmp) == TCL_ERROR)
+      } else if (Tcl_GetWideIntOrLongFromObj(interp, obj, &ltmp) == TCL_ERROR)
@@ -2441 +2441 @@ static int tcl_ffidl_call(ClientData cli
-        if (Tcl_GetLongFromObj(interp, obj, &ltmp) == TCL_ERROR)
+        if (Tcl_GetWideIntOrLongFromObj(interp, obj, &ltmp) == TCL_ERROR)
@@ -2624 +2624 @@ static int tcl_ffidl_call(ClientData cli
-  case FFIDL_PTR:        Tcl_SetObjResult(interp, Tcl_NewLongObj((long)cif->rvalue.v_pointer)); break;
+  case FFIDL_PTR:        Tcl_SetObjResult(interp, Tcl_NewWideIntOrLong((Tcl_WideIntOrLong)cif->rvalue.v_pointer)); break;
@@ -2647 +2647 @@ static int tcl_ffidl_callout(ClientData
-  long tmp;
+  Tcl_WideIntOrLong tmp;
@@ -2675 +2675 @@ static int tcl_ffidl_callout(ClientData
-  if (Tcl_GetLongFromObj(interp, objv[4], &tmp) == TCL_ERROR) return TCL_ERROR;
+  if (Tcl_GetWideIntOrLongFromObj(interp, objv[4], (Tcl_WideIntOrLong*)&tmp) == TCL_ERROR) return TCL_ERROR;
@@ -2867 +2867 @@ static int tcl_ffidl_symbol(ClientData c
-  Tcl_SetObjResult(interp, Tcl_NewLongObj((long)address));
+  Tcl_SetObjResult(interp, Tcl_NewWideIntOrLong((Tcl_WideIntOrLong)address));
@@ -2938 +2938 @@ static int tcl_ffidl_stubsymbol(ClientDa
-  Tcl_SetObjResult(interp, Tcl_NewLongObj((long)address));
+  Tcl_SetObjResult(interp, Tcl_NewWideIntOrLong((Tcl_WideIntOrLong)address));
======






** Obtaining **

[DAS] - I have updated [Ffidl] to support Darwin/[Mac OS X], as well as modernized it in other ways:
   * updates for 2005 versions of libffi & ffcall
   * TEA 3.2 buildsystem, testsuite
   * support for Tcl 8.4, TclpDlopen, Tcl_WideInt
   * fixes for 64bit LP64
   * callouts & callbacks are created/used relative to current namespace (for unqualified names)
   * addition of [[ffidl::stubsymbol]] for Tcl/Tk symbol resolution via stubs tables
   * callbacks can be called anytime, not just from inside call-outs (using Tcl_BackgroundError to report errors)
the testsuite is just the existing tests wrapped into .test files.

   [http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/doc/%|%updated docs%|%]:   
   [http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/ffidl.tar.gz%|%source tarball%|%]:   
   [http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/ffidl-full.tar.gz%|%full source tarball%|%]:   includes libffi and ffcall sources


For MacOS users, an unofficial update version 0.6.1 can be found at
   * [http://www.categorifiedcoder.info/tcltk/ffidl/ffidl-0.6.1-darwin-9-univ.tar.gz%|%source code%|%]
   * [http://www.tcl.tk/starkits/ffidl0.6.1_ub.tgz%|%MacOS Universal Binary%|%]  (tested on Leopard)

Note that the binary package listed at http://elf.org/ffidl/ does not work on
Tiger/Leopard (? only for PowerPC ?)

A binary package for Win/Linux/Mac, unoficially versioned 0.6.1.1, is available
at the
[https://sourceforge.net/projects/irrational-numbers/files/ffidl-0.6.1.1.zip/download%|%Sourceforge%|%]

Note that a little BUG has been fixed ("Ffidlrt.tcl does not work if installed in a path name with whitespaces").

Ffidl either uses unmodified
[http://www.haible.de/bruno/gnu/ffcall-1.10.tar.gz%|%ffcall 1.10%|%] or the
[http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/libffi.tar.bz2%|%HEAD of
libffi from the gcc CVS%|%] with a
[http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/libffi.diff%|%small
patch%|%] to the buildsystem to make it build standalone (i.e. without relying
on the gcc sourcetree structure)

Note that libffi is under BSD license but ffcall is GPLd.

[APN]:  In response to a question on c.l.t [DAS] replied: no, ffidl uses either
libffi or ffcall, but never both. If you use my 0.6 update to ffidl, the choice
of libffi vs ffcall is a compile time option (with libffi being the default for
GPL avoidance reasons). A ffidl binary built with the default configure options
(or with -enable-libffi) will contain only BSD licensed code, whereas a ffidl
built with --enable-ffcall will indeed become GPLd as a whole by virtue of
static linking with ffcall. 

[http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/ffidl.c.diff%|%The
diff%|%] of ffidl.c against the 0.5 version

[Mac OS X] ffidl binaries (with libffi) are available as tarball
[http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/binaries/darwin/%|%installer package or tarball%|%].

A [Windows] ffidl binary (with libffi) built with [MinGW] on WIndowsXP in
VirtualPC is now also
[http://rutherglen.ics.mq.edu.au/~steffen/tcltk/ffidl/binaries/windows/Ffidl0.6.zip%|%available%|%].

I have tested & exercised this quite extensively on [Mac OS X] 10.3 (with both
libffi and ffcall), and have verified that it builds and passes the testsuite
on Windows XP with [MinGW] (in Virtual PC on my Mac...).

I have also built ffidl and run the testsuite on all the machines in the
[http://sourceforge.net/docman/display_doc.php?group_id=1&docid=762#hosts%|%sourceforge compilefarm%|%]:

hosts passing the test suite with both libffi and ffcall:
   * amd64-linux1
   * alpha-linux1
   * x86-linux1
   * x86-linux2
   * x86-solaris1
   * x86-freebsd1
   * x86-netbsd1
host core dumping when running the test suite (with both libffi and ffcall):
   * sparc-solaris1
hosts passing the test suite with ffcall, but where building the libffi library fails:
   * x86-openbsd1
   * ppc-osx1
   * ppc-osx2
the last two may be fixable by reverting to an earlier version of libffi


** Code Using Ffidl **

   [always on top]:   

   [http://wiki.tcl.tk/4016%|%wrapper code%|%] for [AutoIt]:   

   [web2desktop]:   [ZLM]: includes an example of using ffidl to set the Windows desktop background.

   [Custom Toplevel Frame]:   [SeS] (26-10-2010): uses Ffidl to access DLL's and create customized toplevel frames in the Windows OS 

   [Collation]:    [bll] 2016-5-20: Uses Ffidl to call setlocale() and wcscoll() to provide a collated sort.

** Example: The Tcl Library **

[PYK] 2014-09-19: In the following example, [Tcl C API] functions are called.
One thing to note is how space for a pointer is passed into `Tcl_GetCwd`.

======
#! /bin/env tclsh

package require Ffidl
namespace eval ::ffidl {
        namespace export *
        namespace ensemble create
}

if {[namespace current] ne {::}} {
        namespace import ::ffidl
}
set tclso libtcl8.6.so
#set tclso libtcl8.5.so
#set tclso [ffidl::find-lib tcl8.6]

set Tcl_CreateInterp_sym [ffidl symbol $tclso Tcl_CreateInterp]
set Tcl_GetCwd_sym [ffidl symbol $tclso Tcl_GetCwd]
set Tcl_InterpDeleted_sym [ffidl symbol $tclso Tcl_InterpDeleted]
set Tcl_GetString_sym [ffidl symbol $tclso Tcl_GetString]
set Tcl_EvalObjEx_sym [ffidl symbol $tclso Tcl_EvalObjEx]

ffidl callout Tcl_CreateInterp {} pointer $Tcl_CreateInterp_sym
ffidl callout Tcl_GetCwd {pointer pointer-var} pointer-utf8 $Tcl_GetCwd_sym
ffidl callout Tcl_InterpDeleted pointer int $Tcl_InterpDeleted_sym
ffidl callout Tcl_GetString pointer-obj pointer-utf8 $Tcl_GetString_sym
ffidl callout TclEvalObjEx {pointer pointer-obj int} int $Tcl_EvalObjEx_sym

set interp [Tcl_CreateInterp]
set script {puts [pwd]}
puts [Tcl_GetString $script]
TclEvalObjEx $interp $script 0
set bufferPtr [binary format [ffidl info format pointer] 0]

set pwd [Tcl_GetCwd $interp bufferPtr] 
puts $pwd
======


** Examples **

   [Getting Windows "special folders" with Ffidl]:   [kostix] offers a solution for getting "special folders" on Windows platforms. While [TWAPI] can do this out-of-the-box, it doesn't work on Win9x and is big. [Ffidl] doesn't have these limitations.

   [calling Fortran routines in a DLL]:   

   [AutoIt]:   ffidl wrapper brought to you by [Michael Jacobsen]

   [Windows Desktop modifications with Ffidl]:   playing around with [Microsoft Windows%|%Windows] desktop properties.


----

from [Rolf Schroedter] on c.l.t

--- file foo.h: ---

======c
int foo_init( int adr, int log );
int foo_done( void );
int foo_info( FOO_INFO *infoPtr ); /* FOO_INFO is a structure */
int foo_open( const char *port );
======

--- file foo.tcl: ---

======
load ffidl05.dll
set DLL foo.dll
ffidl::callout foo_init {int int} int  [ffidl::symbol $DLL foo_init]
ffidl::callout foo_done {} int   [ffidl::symbol $DLL foo_done]
ffidl::callout foo_info {pointer-var} int [ffidl::symbol $DLL foo_info]
ffidl::callout foo_open {pointer-utf8} int [ffidl::symbol $DLL foo_open]
======

----

Explain [Rolf Schroedter]'s [screensaver] [http://groups.google.com/groups?th=ec295f4a4849b362%|%example%|%]

----

======
#Rolf Schroedter
#German Aerospace Center
#Institute of Space Sensor Technology and Planetary Exploration
 
load ffidl05.dll
 
ffidl::callout dll_FindWindow       {pointer-utf8 pointer-utf8} int     [ffidl::symbol user32.dll FindWindowA]
ffidl::callout dll_FindWindowTitle  {int pointer-utf8} int              [ffidl::symbol user32.dll FindWindowA]
ffidl::callout dll_FindWindowClass  {pointer-utf8 int} int              [ffidl::symbol user32.dll FindWindowA]
ffidl::callout dll_SetWindowPos     {int int int int int int int} int   [ffidl::symbol user32.dll SetWindowPos]
ffidl::callout dll_SystemParametersInfo {int int pointer int} int       [ffidl::symbol user32.dll SystemParametersInfoA]

proc FindWindow { class title } {
    if { [string length $class] == 0 } {
        dll_FindWindowTitle 0 $title
    } elseif { [string length $title] == 0 } {
        dll_FindWindowClass $class 0
    } else {
        dll_FindWindow $class $title
    }
}
proc SetWindowPos { hwnd after x y cx cy {flags 0} } {
    array set VAL {TOP 0 BOTTOM 1 TOPMOST -1 NOTOPMOST -2}
    set iAfter $VAL([string toupper $after])
    dll_SetWindowPos $hwnd $iAfter $x $y $cx $cy $flags
}
proc SetupScreenSaver { bool } {
    dll_SystemParametersInfo 97 $bool 0 0   ;# SPI_SCREENSAVERRUNNING=97
}
proc exit? {} {
    set answer [tk_messageBox -message "Really quit?" -type yesno -icon question]
    switch -- $answer {
        yes {
            SetupScreenSaver 0
            exit
        }
        no {}
    }
}
proc ScreenSaver {win} {
    set size(X) [winfo screenwidth .]
    set size(Y) [winfo screenheight .]

    toplevel $win
    wm title $win "TclScreenSaver"     ;# to find the window

    wm overrideredirect $win true
    $win configure -relief flat -bd 0
    $win configure -cursor hand2    ;# Ohne cursor ???

    update idletasks                ;# virtually display $win, allows window to be found
    set hwnd [FindWindow "" "TclScreenSaver"]
    set res1 [SetWindowPos $hwnd TOPMOST 0 0 $size(X) $size(Y)]   ;# ever makes full screen
    set res2 [SetupScreenSaver 1]

    canvas $win.c -background yellow -width $size(X) -height $size(Y) -relief flat -bd 0
    pack $win.c -expand yes -fill both

    focus -force $win

    bind $win <Key> exit?
    bind $win <Motion> {}
}

wm withdraw .
ScreenSaver .scr
======

----

from [Rob Hegt] on c.l.t,  '''Subject: solution for regaining focus from OpTcl hosted ActiveX control''':

======
load lib/ffidl05.dll
ffidl::callout dll_SetFocus {int} int [ffidl::symbol user32.dll SetFocus]
proc GrabFocus {args} {dll_SetFocus [winfo id .]}
======

Then just bind GrabFocus to some event.  In the post he uses <button> .

======
bind . <Button> +GrabFocus
======

** Example:  Using Pointers **

by [daapp]

C declarations:

======c
typedef short           I16;
typedef unsigned short  U16;


I16 _7443_initial(I16 *existCards);
I16 _7443_close(void);
I16 _7443_version_info(I16 CardNo, U16 *HardwareInfo, U16 *SoftwareInfo, U16 *DriverInfo);
I16 _7443_d_output(I16 CardNo, I16 Ch_No, I16 value);
======

Tcl code:
  
======
namespace eval 7443 {
    variable dll_name PPCI7443.dll
  
    ffidl::callout _initial {pointer-var} sint16 \
        [ffidl::symbol $dll_name _7443_initial]

    ffidl::callout close {} void [ffidl::symbol $dll_name _7443_close]
  
    ffidl::callout _version_info {sint16 pointer-var pointer-var pointer-var} \
        sint16 [ffidl::symbol $dll_name _7443_version_info]

    ffidl::callout d_output {sint16 sint16 sint16} sint16 \
          [ffidl::symbol $dll_name _7443_d_output]

}
  
# varName should containt quantity of available cards
proc 7443::initial {varName} {
    upvar $varName existsCards
    set cards [binary format s 0]
    set result [_initial cards]
    binary scan $cards s existsCards
    return $result
}

# return: {errorCode hardwareInfo softwareInfo driverInfo}
proc 7443::version_info {cardNumber} {
    set hardwareInfo [binary format s 0]
    set softwareInfo [binary format s 0]
    set driverInfo   [binary format s 0]
  
    set result [_version_info $cardNumber hardwareInfo softwareInfo driverInfo]

    binary scan $hardwareInfo s hi
    binary scan $softwareInfo s si
    binary scan $driverInfo   s di
  
    return [list $result $hi $si $di]
}
======


** Example: Accessing Carbon API's on [Mac OS X] **

[DAS] - The script below is a brief demo of [Ffidl]'s usefulness for accessing
Carbon APIs on [Mac OS X], in particular it shows a carbon event handler
implemented in tcl.  It also shows how to access Tk APIs via the new
[[::ffidl::stubsymbol]].

The demo installs the the system wide hotkey Cmd-Shift-A, pressing it makes the
blue labelframe flash red.  Note how the hotkey works even with Wish not in
front...

======
#!/bin/sh
#
# Let's ffidl with Carbon HotKeys!
#
# Copyright (c) 2005, Daniel A. Steffen <das@users.sourceforge.net>
# BSD License: c.f. <http://www.opensource.org/licenses/bsd-license>
# 
#\
exec wish $0 "$@"

package require Tk
package require Ffidl

namespace eval carbon {

    ::ffidl::typedef EventHotKeyID {unsigned long} uint32
    ::ffidl::typedef EventTypeSpec uint32 uint32
    ::ffidl::typedef EventTargetRef pointer
    ::ffidl::typedef OSStatus sint32
    
    ::ffidl::callout RegisterEventHotKey {uint32 uint32 EventHotKeyID EventTargetRef \
                                          uint32 pointer-var} OSStatus \
            [::ffidl::symbol Carbon.framework/Carbon RegisterEventHotKey]
    
    ::ffidl::callout GetApplicationEventTarget {} EventTargetRef \
            [::ffidl::symbol Carbon.framework/Carbon GetApplicationEventTarget]
    
    ::ffidl::callout InstallEventHandler {EventTargetRef pointer-proc uint32 pointer-byte \
                                          pointer pointer-var} OSStatus \
            [::ffidl::symbol Carbon.framework/Carbon InstallEventHandler]

    ::ffidl::callout XKeysymToKeycode {pointer {unsigned long}} {unsigned long} \
            [::ffidl::stubsymbol tk intXLibStubs 35]; #XKeysymToKeycode
            
    ::ffidl::callout TkStringToKeysym {pointer-utf8} {unsigned long} \
            [::ffidl::stubsymbol tk intStubs 86]; #TkStringToKeysym
}

proc hotkeyHandler {handlerCallRef event userData} {
    .l configure -bg red
    after 200 .l configure -bg blue
    return 0
}

proc installHotKey {key} {
    labelframe .l -width 100 -height 100 -bg blue
    pack .l

    ::ffidl::callback hotkeyHandler {pointer pointer pointer} OSStatus

    set EventHandlerRef [binary format I 0]
    set res [carbon::InstallEventHandler [carbon::GetApplicationEventTarget] hotkeyHandler 1 \
        [binary format a4I keyb 5] 0 EventHandlerRef]
    if {$res} {puts stderr "InstallEventHandler failed: $res"; exit -1}

    set keycode [expr {[carbon::XKeysymToKeycode 0 [carbon::TkStringToKeysym $key]]>>16}]
    set modifiers [expr {1 << 8 | 1 << 9}]; #Cmd-Shift
    #set modifiers [expr {1 << 8}]; #Cmd
    
    set EventHotKeyRef [binary format I 0]
    set res [carbon::RegisterEventHotKey  $keycode $modifiers [binary format a4I wish 1] \
        [carbon::GetApplicationEventTarget] 0 EventHotKeyRef]
    if {$res} {puts stderr "RegisterEventHotKey failed: $res"; exit -1}
}

installHotKey A
======

----

[DAS] - How to set the application menu name at runtime on [Mac OS X] using
undocumented Apple SPI:

======
package require Tk
package require Ffidl 0.6

::ffidl::callout CPSSetProcessName {pointer-byte pointer-utf8} sint32 \
    [::ffidl::symbol /System/Library/Frameworks/ApplicationServices.framework/Frameworks/CoreGraphics.framework/CoreGraphics CPSSetProcessName]
CPSSetProcessName [binary format I2 {0 2}] "MyCoolApp"
======

and how to show or hide the current application: (also see [tclCarbonProcesses])

======
::ffidl::callout ShowHideProcess {pointer-byte int} sint32 [::ffidl::symbol Carbon.framework/Carbon ShowHideProcess]
ShowHideProcess [binary format I2 {0 2}] 1; #Show
ShowHideProcess [binary format I2 {0 2}] 0; #Hide
======

----

[DAS]: [http://groups.google.com/group/comp.lang.tcl/browse_thread/thread/849ace20fcb95806%|%another example%|%] DAS] for [Mac OS X] in response to a question on [c.l.t.] from Steven Myers

How to set the current application's dock tile from a [png] file (c.f. API docs [http://developer.apple.com/documentation/Carbon/Reference/Dock_Manager/]):

======
#!/bin/sh
#
# Set the Dock Tile from a png file with Ffidl
#
# Copyright (c) 2005, Daniel A. Steffen <das@users.sourceforge.net>
# BSD License: c.f. <http://www.opensource.org/licenses/bsd-license>
# 
#\
exec wish $0 "$@"

package require Tk
package require Ffidl

namespace eval carbon {
    proc api {name argl ret lib} {::ffidl::callout $name $argl $ret \
        [::ffidl::symbol $lib.framework/$lib $name]}
    proc type {name type} {::ffidl::typedef $name $type}
    proc const {name args} {variable {}; eval set [list ($name)] $args}
    
    type OSStatus sint32
    type bool int
    type CFURLRef pointer
    type CGDataProviderRef pointer
    type CGImageRef pointer
    type CGColorRenderingIntent int
    const kCGRenderingIntentDefault 0

    api CFURLCreateFromFileSystemRepresentation {pointer pointer-utf8 \
            int bool} CFURLRef CoreFoundation
    api CFRelease {pointer} void CoreFoundation
    api CGDataProviderCreateWithURL {CFURLRef} CGDataProviderRef \
            ApplicationServices
    api CGImageCreateWithPNGDataProvider {CGDataProviderRef pointer \
            bool CGColorRenderingIntent} CGImageRef ApplicationServices
    api SetApplicationDockTileImage {CGImageRef} OSStatus Carbon

    proc setDockTileToPNG {pngFile} {
        if {[file exists $pngFile]} {
            set url [CFURLCreateFromFileSystemRepresentation 0 $pngFile \
                    [string bytelength $pngFile] 0]
            if {$url} {
                set dp [CGDataProviderCreateWithURL $url]
                if {$dp} {
                    set img [CGImageCreateWithPNGDataProvider $dp 0 1 \
                            [const kCGRenderingIntentDefault]]
                    if {$img} {
                        SetApplicationDockTileImage $img
                        CFRelease $img
                    }
                    CFRelease $dp
                }
                CFRelease $url
            }
        }
    }
}

carbon::setDockTileToPNG test.png
======

----

[DAS] - Yet another [Mac OS X] example on how to find the user's preferred
locale (as set in system preferences 'International') via the CFLocale API:

Note that [kroc] has since found a way to get this info without resorting to
Ffidl: [[exec defaults read NSGlobalDomain AppleLocale]]

======
#!/bin/sh
#
# Ffidling CFLocale
#
# Copyright (c) 2005, Daniel A. Steffen <das@users.sourceforge.net>
# BSD License: c.f. <http://www.opensource.org/licenses/bsd-license>
#
#\
exec tclsh $0 "$@"

package require Ffidl 0.6

namespace eval corefoundation {
    proc api {name argl ret} {::ffidl::callout $name $argl $ret \
        [::ffidl::symbol CoreFoundation.framework/CoreFoundation $name]}
    api CFLocaleCopyCurrent {} pointer
    api CFLocaleGetIdentifier pointer pointer
    api CFStringGetLength pointer sint32
    ::ffidl::typedef CFRange sint32 sint32
    api CFStringGetCharacters {pointer CFRange pointer-var} void
    api CFRelease pointer void

    proc getLocaleIdentifier {} {
        set cfloc [CFLocaleCopyCurrent]
        set cfstr [CFLocaleGetIdentifier $cfloc]
        set len [CFStringGetLength $cfstr]
        set buf [binary format x[expr {2*$len}]]
        set range [binary format [::ffidl::info format CFRange] 0 $len]
        CFStringGetCharacters $cfstr $range buf
        CFRelease $cfloc
        encoding convertfrom unicode $buf
    }
}

puts [corefoundation::getLocaleIdentifier]
======


** Example:  Microsoft's '''net send''' **

[http://msdn.microsoft.com/library/default.asp?url=/library/en-us/netmgmt/netmgmt/netmessagebuffersend.asp%|%A wrapper for the Microsoft API-Call, '''NetMessageBufferSend'''%|%]:

======
package require Ffidl 0.5
ffidl::callout dll_netSend {pointer-utf16 pointer-utf16 pointer-utf16 pointer-utf16 long} long \
                           [ffidl::symbol netapi32.dll NetMessageBufferSend]
proc netSend {dest mesg {srv {}}} {
    set from $::tcl_platform(user)
    # or:
    # set from [info host]
    #  (only these two alternatives seems to work...)
    return [dll_netSend $srv $dest $from $mesg [expr [string length $mesg]*2]]
}
======

This is to send small messages to computers or users or work groups, which will
immediately pop-up on the screen (using NT/2000/XP, if the messenger service is
started, or with DOS/Win3x/9x, if winpopup/netpop.exe is running) - a task
often needed by administrators! Note: The data-type-definitions are somewhat
tricky.... 

With the '''srv''' Argument it is theoretically possible to specify the system
which will perform the sending task - (example: \\machine1), but this involves
some complex security aspects...

** Example: expand a path containing [Microsoft Windows] environment variables **

contributed by [FM]

expand strings like `%ProgramFiles%:

======
ffidl::callout dll_ExpandEnvironmentStringsForUser \
    {int pointer-utf16  pointer-utf16 long} int \
    [ffidl::symbol Userenv.dll ExpandEnvironmentStringsForUserW]

proc {ExpandEnvironmentStringsForUser} {WPath} {
    set TclPath [string repeat \u0000 300]
    if [dll_ExpandEnvironmentStringsForUser 0 $WPath $TclPath 300] {
        set ix [string first \u0000 $TclPath]
        if {$ix > 0} {
            return [string range $TclPath 0 [expr {$ix - 1}]]
        } else {
            return {}
        }
    } else {
        return {}
    }
}
======

let's try it:

======
ExpandEnvironmentStringsForUser {%ProgramFiles%\windows media player\wmplayer.exe}
======

result:

======none
C:\Program Files\windows media player\wmplayer.exe
======

** Misc **

[DLR] Including ffidl in the core would be a huge boost to Tcl, and specially,
Tcllib, as many modules could be written in pure Tcl. Part of the success of
[Mono]/[.NET] is its [P/Invoke] feature which allows it to effortlessly wrap
native libraries. The Mono implementation uses (or at least used to do) ffidl
at its core. 

[Lectus]: This is a must have functionality in Tcl. Any chance of moving it to
core?

** See Also **

   [TWAPI]:   an alternative to ffidl for accessing the Win32API
   [critcl]:   provides an alternative approach for "calling functions in arbitrary dynamic libraries"
[http://www.equi4.com/critlib/dyncall.README].
   [Yet another dll caller]:   provides advanced data type handling over FFidl in a Windows-only version. 
The examples are quite impressive. [RT]


----
'''[vinniyo] - 2014-03-06 19:54:56'''

Hello, Im trying to use crypt32.dll without success. Could someone provide assistance? Thank you!
======
package require Ffidl
set handle [ffidl::symbol [file join C:/ Windows System32 crypt32.dll] CryptProtectData]
ffidl::callout CryptProtectData_callout {pointer-utf8 pointer-utf8 pointer-utf8 pointer-utf8 pointer-utf8 int pointer-utf8} int $handle stdcall

proc CryptProtectData {data} {
    set value ""
    if [CryptProtectData_callout $data NULL NULL 0 NULL 0 $value] {
        puts $value
    } else {
        puts "crypt returned 0: $value"
        return {}
    }
}

CryptProtectData "hello how are you"
======

------
[Tim Tomkinson%|%TLT%|%] 2014-07-23 - This is a fairly complicated example of Ffidl. It demonstrates the following techniques:

   * Using typedefs to simplify the code and increase portability.
   * Using the Ffidlrt helper routines [[::ffidl::get-bytearray-from-obj]] and [[::ffidl::new-bytearray]].
   * Allocating space for output data structures with [[[binary format] x]] and [[::ffidl::info sizeof]].
   * Converting structures with [[::ffidl::info format]].
   * Passing NULL pointers.

The input and output arguments to CryptProtectData() and CryptUnprotectData() are pointers to DATA_BLOBs, which are themselves structures. The Ffidlrt command get-bytearray-from-obj is used to get a pointer to the data, which is then stored in the DATA_BLOB along with its length. After calling the functions, the output DATA_BLOBs are converted back into Tcl byte-arrays using new-bytearray.

======
# Encrypts and decrypts data using CryptProtectData() and CryptUnprotectData().

package require Ffidl
package require Ffidlrt

# typedefs
::ffidl::typedef DWORD     {unsigned long}
::ffidl::typedef BOOL      int
::ffidl::typedef DATA_BLOB DWORD pointer

# function declarations
::ffidl::callout CryptProtectData {pointer-byte pointer pointer pointer pointer DWORD pointer-var} BOOL \
    [ffidl::symbol crypt32.dll CryptProtectData] stdcall
::ffidl::callout CryptUnprotectData {pointer-byte pointer pointer pointer pointer DWORD pointer-var} BOOL \
    [ffidl::symbol crypt32.dll CryptUnprotectData] stdcall

proc cryptProtectData {data} {

    # Get a pointer to the data.
    set dataLen [binary format n 0]
    set bData [::ffidl::get-bytearray-from-obj $data dataLen]

    # Initialize the input DATA_BLOB.
    set dataIn [binary format [::ffidl::info format DATA_BLOB] [string length $data] $bData]

    # Initialize the output DATA_BLOB.
    set dataOut [binary format x[::ffidl::info sizeof DATA_BLOB]]

    # Call CryptProtectData().
    set CRYPTPROTECT_LOCAL_MACHINE 0x4
    set status [CryptProtectData $dataIn 0 0 0 0 $CRYPTPROTECT_LOCAL_MACHINE dataOut]
    if {$status == 0} {
        error "CryptProtectData error"
    } else {

        # Convert the output DATA_BLOB to a byte-array.
        binary scan $dataOut [::ffidl::info format DATA_BLOB] cbData bData
        set result [::ffidl::new-bytearray $bData $cbData]
        return $result
    }
}

proc cryptUnprotectData {data} {

    # Get a pointer to the data.
    set dataLen [binary format n 0]
    set bData [::ffidl::get-bytearray-from-obj $data dataLen]

    # Initialize the input DATA_BLOB.
    set dataIn [binary format [::ffidl::info format DATA_BLOB] [string length $data] $bData]

    # Initialize the output DATA_BLOB.
    set dataOut [binary format x[::ffidl::info sizeof DATA_BLOB]]

    # Call CryptUnprotectData().
    set status [CryptUnprotectData $dataIn 0 0 0 0 0 dataOut]
    if {$status == 0} {
        error "CryptUnprotectData error"
    } else {

        # Convert the output DATA_BLOB to a byte-array.
        binary scan $dataOut [::ffidl::info format DATA_BLOB] cbData bData
        set result [::ffidl::new-bytearray $bData $cbData]
        return $result
    }
}

set result [cryptProtectData "hello how are you"]
puts [cryptUnprotectData $result]
======
------
[YS] 2014-09-14: I've noticed that ffidl (ffidlrt, actually) doesn't work in starkits or starpacks on Windows. I needed it to work, so applied this ugly hack to ffidlrt.tcl:
======
...
namespace eval ::ffidl:: {
    set ffidl_lib [find-pkg-lib Ffidl]
      #HORRIBLE HACK goes here <<<:
      set CopyTo [file dirname $::starkit::topdir]
      file copy -force $ffidl_lib $CopyTo
      set ffidl_lib [file join $CopyTo [file tail $ffidl_lib]]
      unset CopyTo
      #>>>
======

----
'''[Boltar] - 2015-09-07 11:08:09'''

i just started using ffidel to access a dll from a middleware and run into some small problems which I hope one of you can clearify for me

Inside the dll there is a function '''myVersion ''' which returns a long value and sets the version information inside the parameter '''szVersion''' (so szVersion is an out Parameter):
======
long myVersion (char szVersion[257])
======

I first tried to define the variable callout like this:
======
set szVersion [binary format [::ffidl::info format char]257 [lrepeat 257 0x20]]

ffidl::callout _MyVersion {char} long [ffidl::symbol $DLL myVersion] stdcall
set result [_MyVersion $szVersion]
======

But this didn't work. The error msg tells me, that an integer value was assumed but the function got "     ".
Therefore I tried different approches but none of them worked. With the following one I don't get an error, but I still don't get the Version (szVersion still is filled with 257 spaces):
======
set szVersion [binary format [::ffidl::info format char]257 [lrepeat 257 0x20]]

ffidl::callout _MyVersion {pointer-obj} long [ffidl::symbol $DLL myVersion] stdcall
set result [_MyVersion szVersion]
binary scan $szVersion a* szVersion
======
The function return 10 (which is defined as OK) but the variable szVersion still doesn't have the Version info.

Additionally what should I do if I have an in parameter which is defined as follows
======
char szXMLAdditionalParameters[513]
======

How can I alloc the size for it (like above?) and set the needed Information string inside it. 

I'm stuck at this point. I guess that  I'm not seeing the wood for the trees 

Thanks in advance!

<<categories>> Package | Foreign Interfaces | Mac | Windows