basis/ui/clipboards/clipboards.factor

   1 ! Copyright (C) 2006, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: kernel accessors ui.gadgets ui.gestures namespaces ;
   5
   6 IN: ui.clipboards
   7
   8 ! Two text transfer buffers
   9
  10 TUPLE: clipboard contents ;
  11
  12 GENERIC: clipboard-contents ( clipboard -- string )
  13
  14 GENERIC: set-clipboard-contents ( string clipboard -- )
  15
  16 M: clipboard clipboard-contents contents>> ;
  17
  18 M: clipboard set-clipboard-contents contents<< ;
  19
  20 : <clipboard> ( -- clipboard ) "" clipboard boa ;
  21
  22 GENERIC: paste-clipboard ( gadget clipboard -- )
  23
  24 M: object paste-clipboard
  25     clipboard-contents dup [ swap user-input ] [ 2drop ] if ;
  26
  27 GENERIC: copy-clipboard ( string gadget clipboard -- )
  28
  29 M: object copy-clipboard nip set-clipboard-contents ;
  30
  31 SYMBOL: clipboard
  32 SYMBOL: selection
  33
  34 : gadget-copy ( gadget clipboard -- )
  35     over gadget-selection?
  36         [ [ [ gadget-selection ] keep ] dip copy-clipboard ]
  37         [ 2drop ]
  38     if ;
  39
  40 : com-copy ( gadget -- ) clipboard get gadget-copy ;
  41
  42 : com-copy-selection ( gadget -- ) selection get gadget-copy ;