extra/ui/clipboards/clipboards.factor

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