[Ficl-developers] Clipboard functions

[Chris D. <chr...@do...>]

Pasted below are some routines I use in ficlwin for getting data to and
from the clipboard. Inspired by 'Line Filter' from the ugly forth page
(http://home.earthlink.net/~neilbawd/lnfilt.html).

Using these definitions you should be able to get linefilter things
working. The main words are:

: stringfromclipboard ( -- str len )
: stringtoclipboard { str len | hglobal lpvoid -- }
: evalclipboard ( -- )

I'm often using the command line version of ficl compiled for windows
and edit in my editor, copy definitions to the clipboard and then do an
'evalclipboard' in the command line window to get things across to
ficl. Works quite well.

Code thrown together without much checking so and comments appreciated. 

--------------8<----------------
s" kernel32" loadlibrary constant hkernel
s" GlobalAlloc" hkernel getprocaddress constant win32globalalloc
s" GlobalFree" hkernel getprocaddress constant win32globalfree
s" GlobalLock" hkernel getprocaddress constant win32globallock
s" GlobalUnlock" hkernel getprocaddress constant win32globalunlock

2 constant GMEM_MOVEABLE

: globalalloc ( flags length -- hglobal )
	2 win32globalalloc 0 callnativefunction ;

: globalfree ( hglobal -- result )
	1 win32globalfree 0 callnativefunction 0= ;

: globallock ( hglobal -- lpvoid )
	1 win32globallock 0 callnativefunction ;

: globalunlock ( lpvoid -- result )
	1 win32globalunlock 0 callnativefunction ;

s" user32" loadlibrary constant huser
s" OpenClipboard" huser getprocaddress constant win32openclipboard
s" CloseClipboard" huser getprocaddress constant win32closeclipboard
s" IsClipboardFormatAvailable" huser getprocaddress constant
win32isclipboardformatavailable
s" GetClipboardData" huser getprocaddress constant
win32getclipboarddata
s" SetClipboardData" huser getprocaddress constant
win32setclipboarddata
s" EmptyClipboard" huser getprocaddress constant win32emptyclipboard

1 constant CF_TEXT

: openclipboard ( -- result ) 
	0 1 win32openclipboard 0 callnativefunction ;

: closeclipboard ( -- result ) 
	0 win32closeclipboard 0 callnativefunction ;

: isclipboardformatavailable ( type -- result )
	1 win32isclipboardformatavailable 0 callnativefunction ;

: getclipboarddata ( type -- str len )
	1 win32getclipboarddata 0 callnativefunction ( addr -- )
	dup strlen ( addr len -- )
	strdup drop ( -- addr2 len2 ) ;

: setclipboarddata ( type hglobal -- result )
	2 win32setclipboarddata 0 callnativefunction 0> ;

: emptyclipboard ( -- result )
	0 win32emptyclipboard 0 callnativefunction ;

: stringfromclipboard ( -- str len )
	openclipboard drop 
	1 getclipboarddata
	closeclipboard drop ;

: stringtoclipboard { str len | hglobal lpvoid -- }
	openclipboard drop
	GMEM_MOVEABLE len 1+ globalalloc to hglobal
	hglobal globallock to lpvoid
	lpvoid len str len strcpy ( -- str len )
	2dup 1+ + 0 swap ! 
	hglobal globalunlock drop
	CF_TEXT hglobal setclipboarddata drop
	closeclipboard drop ;
	
\ Evaluate whatever exists in the clipboard
: evalclipboard ( -- )
	stringfromclipboard evaluate ;

\ Short version of evalclipboard to save typing...
: ec ( -- )
	evalclipboard ;
--------------8<----------------

Chris.
--
http://www.double.co.nz

-- 
  Chris Double
  chr...@do...