gtk/gtk.selections.lisp

   1 (in-package :gtk)
   2
   3 (define-g-boxed-cstruct target-entry "GtkTargetEntry"
   4   (target :string :initform 0)
   5   (flags target-flags :initform 0)
   6   (info :uint :initform 0))
   7
   8 (export (boxed-related-symbols 'target-entry))
   9
  10 ;;
  11
  12 (defcfun (selection-owner-set "gtk_selection_owner_set") :boolean
  13   (widget (g-object widget))
  14   (selection gdk-atom-as-string)
  15   (time :uint32))
  16
  17 (defcfun (selection-owner-set-for-display "gtk_selection_owner_set_for_display")
  18     :boolean
  19   (display (g-object display))
  20   (widget (g-object widget))
  21   (selection gdk-atom-as-string)
  22   (time :uint32))
  23
  24 (defcfun (selection-add-target "gtk_selection_add_target") :void
  25   (widget (g-object display))
  26   (selection gdk-atom-as-string)
  27   (target gdk-atom-as-string)
  28   (info :uint))
  29
  30 (defcfun (selection-clear-targets "gtk_selection_clear_targets") :void
  31   (widget (g-object display))
  32   (selection gdk-atom-as-string))
  33
  34 (defcfun (selection-convert "gtk_selection_convert") :boolean
  35   (widget (g-object display))
  36   (selection gdk-atom-as-string)
  37   (target gdk-atom-as-string)
  38   (time :uint32))
  39
  40 ;;
  41
  42 (define-g-boxed-opaque selection-data "GtkSelectionData"
  43   :alloc (error "Not allocated"))
  44
  45 (export (boxed-related-symbols 'selection-data))
  46
  47 (defcfun (gtk-selection-data-set "gtk_selection_data_set") :void
  48   (selection-data (g-boxed-foreign selection-data))
  49   (type gdk-atom-as-string)
  50   (format :int)
  51   (data :pointer)
  52   (length :int))
  53
  54 (defcfun (gtk-selection-data-get-data "gtk_selection_data_get_data") :pointer
  55   (selection-data (g-boxed-foreign selection-data)))
  56
  57 (defcfun (gtk-selection-data-get-data-type "gtk_selection_data_get_data_type")
  58     gdk-atom-as-string
  59   (selection-data (g-boxed-foreign selection-data)))
  60
  61 (defcfun (gtk-selection-data-get-format "gtk_selection_data_get_format")
  62     :int
  63   (selection-data (g-boxed-foreign selection-data)))
  64
  65 (defcfun (gtk-selection-data-get-length "gtk_selection_data_get_length") :int
  66   (selection-data (g-boxed-foreign selection-data)))
  67
  68 (defcfun (gtk-selection-data-set-pixbuf "gtk_selection_data_set_pixbuf") :boolean
  69   (selection-data (g-boxed-foreign selection-data))
  70   (pixbuf (g-object pixbuf)))
  71
  72 (defcfun (selection-data-get-pixbuf "gtk_selection_data_get_pixbuf") (g-object pixbuf)
  73   (selection-data (g-boxed-foreign selection-data)))
  74
  75 (defcfun (selection-data-targets-include-image "gtk_selection_data_targets_include_image")
  76     :boolean
  77   (selection-data (g-boxed-foreign selection-data))
  78   (writable :boolean))
  79
  80 (defcfun (selection-data-targets-include-text "gtk_selection_data_targets_include_text")
  81     :boolean
  82   (selection-data (g-boxed-foreign selection-data)))
  83
  84 (defcfun (selection-data-targets-include-uri "gtk_selection_data_targets_include_uri")
  85     :boolean
  86   (selection-data (g-boxed-foreign selection-data)))
  87
  88 (defcfun (selection-data-targets-include-rich-text "gtk_selection_data_targets_include_rich_text")
  89     :boolean
  90   (selection-data (g-boxed-foreign selection-data))
  91   (buffer (g-object text-buffer)))
  92
  93 (defcfun (selection-data-get-selection "gtk_selection_data_get_selection")
  94     gdk-atom-as-string
  95   (selection-data (g-boxed-foreign selection-data)))
  96
  97 (defcfun (selection-data-get-display "gtk_selection_data_get_display")
  98     (g-object display)
  99   (selection-data (g-boxed-foreign selection-data)))
 100
 101 (defcfun (selection-data-get-target "gtk_selection_data_get_target")
 102     gdk-atom-as-string
 103   (selection-data (g-boxed-foreign selection-data)))
 104
 105 ; Easy future extension
 106 (defgeneric selection-set (selection-data data &key type &allow-other-keys))
 107
 108 (defmethod selection-set ((selection-data selection-data) (data string)
 109                           &key (type "text/plain"))
 110   (with-foreign-string ((ptr len) data)
 111     (gtk-selection-data-set selection-data type 8 ptr (1- len))))
 112
 113 (defmethod selection-set ((selection-data selection-data) (data pixbuf)
 114                           &key (type "image/png"))
 115   (gtk-selection-data-set selection-data type 8 (null-pointer) 0)
 116   (gtk-selection-data-set-pixbuf selection-data data))
 117
 118 (defun foreign-to-int-or-array (ptr fmt len)
 119   (let ((ctype (case fmt (8 :int8) (16 :int16) (32 :long)))
 120         (clen (/ len (if (= fmt 32) (foreign-type-size :long) fmt))))
 121     (if (= clen 1)
 122         (mem-ref ptr ctype)
 123         (let ((array (make-array clen :element-type 'fixnum)))
 124           (loop for i from 0 below clen
 125              do (setf (aref array i) (mem-aref ptr ctype)))
 126           array))))
 127
 128 (defun selection-get (selection-data)
 129   (let ((fmt (gtk-selection-data-get-format selection-data))
 130         (len (gtk-selection-data-get-length selection-data))
 131         (ptr (gtk-selection-data-get-data selection-data)))
 132   (values
 133    (cond
 134      ((= len -1) nil)
 135      ((= fmt 8) (foreign-string-to-lisp ptr :count len))
 136      (t (foreign-to-int-or-array ptr fmt len)))
 137    (gtk-selection-data-get-data-type selection-data)
 138    fmt)))
 139
 140 (export '(selection-set selection-get))