core/ui/windows/clipboard.factor

   1 ! Copyright (C) 2006 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel win32-api math namespaces io prettyprint errors sequences alien
   4     libc gadgets ;
   5 IN: win32
   6
   7 : crlf>lf CHAR: \r swap remove ;
   8 : lf>crlf [ [ dup CHAR: \n = [ CHAR: \r , ] when , ] each ] "" make ;
   9
  10 : (enum-clipboard) ( n -- n )
  11     EnumClipboardFormats win32-error dup 0 > [ dup , (enum-clipboard) ] when ;
  12
  13 : enum-clipboard ( -- seq )
  14     [ 0 (enum-clipboard) ] { } make nip ;
  15
  16 : paste ( -- str )
  17     f OpenClipboard drop
  18     CF_TEXT IsClipboardFormatAvailable 0 = [
  19             ! nothing to paste
  20             ""
  21         ] [
  22             CF_TEXT GetClipboardData
  23             dup GlobalLock swap
  24             GlobalUnlock drop
  25             alien>char-string
  26     ] if
  27     CloseClipboard drop
  28     crlf>lf ;
  29
  30 : copy ( str -- )
  31     lf>crlf
  32     f OpenClipboard drop
  33     EmptyClipboard drop
  34     GMEM_MOVEABLE over length 1+ GlobalAlloc dup 0 = [
  35         "unable to allocate memory" throw
  36     ] when
  37
  38     dup GlobalLock
  39     rot [ string>char-alien ] keep length memcpy
  40     dup GlobalUnlock drop
  41     CF_TEXT swap SetClipboardData 0 = [ win32-error ] when
  42     CloseClipboard drop ;
  43
  44 TUPLE: pasteboard ;
  45 M: pasteboard clipboard-contents drop paste ;
  46 M: pasteboard set-clipboard-contents drop copy ;
  47
  48 : init-clipboard ( -- )
  49     <pasteboard> clipboard set-global ;