CFFI and win32 clipboard access

I'm a newbie in Common Lisp and did some experiments on it. I was trying hard to get some access to the windows clipboard, then I found this reference:

https://groups.google.com/forum/#!topic/comp.lang.lisp/hyNqn2QhUY0

That was perfect, except for it was tailored for CLISP FFI, and I wanted it working with CFFI. Then I tried to convert the code, and partially succeed but there's a problem with the routine (get-clip-string), testing with Clozure CL 1.10 on WinXP(!):

Test text: Have Space Suit-Will Travel

? (get-clip-string)

Error: The value "Have Space Suit-Will Travel" is not of the expected type (UNSIGNED-BYTE 32). While executing: GLOBAL-LOCK-STRING, in process listener(1). Type :POP to abort, :R for a list of available restarts. Type :? for other options.

I think I didn't get the type thing on CFFI (although I've read the manual), or the original prescription on CLISP. have someone any hint? the following sequence of commands work, but I'm afraid that's not secure:

(open-clip 0)
(get-clip 1)
(close-clip 0)

(open-clip 0) (get-clip 1) (close-clip 0)

here is the code:

(ql:quickload :cffi)


(cffi:load-foreign-library "user32.dll")

(cffi:load-foreign-library "kernel32.dll")

(cffi:load-foreign-library "msvcrt.dll")


(cffi:defcfun ("GetClipboardData" get-clip) :string

(uformat  :unsigned-int))


(cffi:defcfun ("OpenClipboard" open-clip) :int

  (hOwner  :unsigned-int))


(cffi:defcfun ("CloseClipboard" close-clip) :int


      (hOwner  :unsigned-int))


(cffi:defcfun ("EmptyClipboard" empty-clip) :int)


(cffi:defcfun ("SetClipboardData" set-clip) :int

  (data  :unsigned-int)

  (format :unsigned-int))


(cffi:defcfun ("GlobalAlloc" global-alloc) :int

  (flags  :unsigned-int)

  (numbytes :unsigned-int))


(cffi:defcfun ("GlobalLock" global-lock) :unsigned-int

  (typ  :unsigned-int))


(cffi:defcfun ("GlobalLock" global-lock-string) :string 

  (typ  :unsigned-int))


(cffi:defcfun ("GlobalUnlock" global-unlock) :int

  (typ  :unsigned-int))


(cffi:defcfun ("memcpy" memcpy) :int

  (dest  :unsigned-int)

  (src :string) 

  (coun :unsigned-int))



(defun get-clip-string ()

          (open-clip 0)

          (let* ((h (get-clip 1)) (s (global-lock-string h)))

                 (global-unlock h) (close-clip 0) s))


(defun set-clip-string (s)

          (let* ((slen (+ 1 (length s)))(newh (global-alloc 8194 slen))

(newp (global-lock newh)))

          (memcpy newp s (+ 1 slen)) (global-unlock newh) (open-clip 0)

(set-clip 1 newh) (close-clip 0)))

Solution

The error is in the return type you used for GetClipboardData and the argument type you used for GlobalLock and GlobalUnlock. You define GetClipboardData to return a string, but in C, GetClipboardData returns a HANDLE, which is defined as a pointer to void, and the argument accepted by GlobalLock and GlobalUnlock is also a HANDLE. Change your C function definitions to this:

(cffi:defcfun ("GetClipboardData" get-clip) :pointer
    (uformat  :unsigned-int))

(cffi:defcfun ("GlobalLock" global-lock-string) :string 
    (type  :pointer))

(cffi:defcfun ("GlobalUnlock" global-unlock) :int
    (type  :pointer))

...and the problem goes away.

You also need to fix the other global-lock-* functions and also memcpy if you want to use set-clip-string.

There's another bug, though: When you type-correct the entire program so that the set-clip-string function can also be called, then set-clip-string only seems to be able to put a string onto a clipboard that is local to the Lisp process (I'm using a console build of SBCL via SLIME on Win7). Suppose you copied Have Space Suit-Will Travel to the Clipboard with Notepad. Then try this:

CL-USER> (set-clip-string "MY CLIPBOARD")
1
CL-USER> (get-clip-string)
"MY CLIPBOARD"

So it seems to have worked. But then if you try to paste into EMACS from the Clipboard using ShiftIns, you get:

CL-USER> Have Space Suit-Will Travel

So the real clipboard still has what Notepad put there, and your Lisp program only has a private clipboard that can't be used to copy data to other programs, not even the EMACS session that is hosting it.

This is happening because set-clip-string needs to call empty-clip after calling open-clip.

Also, every one of those Windows calls can fail, but your code doesn't check for failures or handle errors.