Win32 MessageBox with SBCL foreign interface

Viewed 67

I am trying to figure out how to call the Win32 function MessageBox with the SBCL foreign interface. The MessageBox function implemented in "user32.dll" is described as follow:

int MessageBox(
  [in, optional] HWND    hWnd,
  [in, optional] LPCTSTR lpText,
  [in, optional] LPCTSTR lpCaption,
  [in]           UINT    uType
);

[...]

MB_OK 0x00000000L The message box contains one push button: OK. This is the default. 

The use of this function is trivial using the cffi library:

(cffi:load-foreign-library '(:default "user32"))

(cffi:defcfun ("MessageBoxA" message-box) :int
  (hwnd    :pointer)
  (text    :string)
  (caption :string)
  (type    :unsigned-int))

(message-box (cffi:null-pointer) "Hello" "Test" 0)

I tried to use this function directly with the SBCL interface sb-alien: I couldn't make it work.

(sb-alien:load-shared-object "user32")

(defvar c-null (sb-sys:int-sap 0))

(sb-alien:define-alien-routine ("MessageBoxA" MessageBox) sb-alien:int
  (hwnd    (* sb-alien:integer))
  (text    sb-alien:c-string)
  (caption sb-alien:c-string)
  (uType   (sb-alien:unsigned 4)))

;; need a small wrapper to convert Lisp's strings to foreign
(defun message-box (title message)
  (let ((title-alien   (sb-alien:make-alien-string title))
        (message-alien (sb-alien:make-alien-string message)))
    (MessageBox c-null title-alien message-alien 0)
    (sb-alien:free-alien title-alien)
    (sb-alien:free-alien message-alien)))

(message-box "Hello" Test")

There isn't any error or warning but it just don't work. How is working the SBCL alien interface? I tried to read the code from CFFI and SBCL, but I could not find any simple example.

1 Answers

I don't understand how I could have spend the whole afternoon on this issue, but the strings are actually automatically converted from/to Lisp. So the code is actually very simple:

(sb-alien:load-shared-object "user32")

(defvar c-null (sb-sys:int-sap 0))

(define-alien-routine ("MessageBoxA" MessageBox) sb-alien:integer
  (hwnd    (* sb-alien:integer))
  (text    sb-alien:c-string)
  (caption sb-alien:c-string)
  (uType   (sb-alien:unsigned 4)))

(MessageBox c-null "Hello" "Test" 0)
Related