chiark - git - mdw - clg/blob - gtk/gtkselection.lisp

   1 ;; Common Lisp bindings for GTK+ v2.x
   2 ;; Copyright 2005-2006 Espen S. Johnsen <espen@users.sf.net>
   3 ;;
   4 ;; Permission is hereby granted, free of charge, to any person obtaining
   5 ;; a copy of this software and associated documentation files (the
   6 ;; "Software"), to deal in the Software without restriction, including
   7 ;; without limitation the rights to use, copy, modify, merge, publish,
   8 ;; distribute, sublicense, and/or sell copies of the Software, and to
   9 ;; permit persons to whom the Software is furnished to do so, subject to
  10 ;; the following conditions:
  11 ;;
  12 ;; The above copyright notice and this permission notice shall be
  13 ;; included in all copies or substantial portions of the Software.
  14 ;;
  15 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  16 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  17 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  18 ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
  19 ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
  20 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
  21 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  22
  23 ;; $Id: gtkselection.lisp,v 1.9 2006-04-26 12:30:30 espen Exp $
  24
  25
  26 (in-package "GTK")
  27
  28
  29 ;;;; Selection
  30
  31 (defbinding %target-list-ref () pointer
  32   (location pointer))
  33
  34 (defbinding %target-list-unref () nil
  35   (location pointer))
  36
  37 (defbinding %target-list-new () pointer
  38   (targets (vector (inlined target-entry)))
  39   ((length targets) int))
  40
  41 (defmethod allocate-foreign ((target-list target-list) &key targets)
  42   (%target-list-new targets))
  43
  44 (defbinding target-list-add (target-list target &optional flags info) nil
  45   (target-list target-list)
  46   (target gdk:atom)
  47   (flags unsigned-int)
  48   (info unsigned-int))
  49
  50 (defbinding target-list-add-table (target-list targets) nil
  51   (target-list target-list)
  52   ((etypecase targets
  53      ((or vector list) targets)
  54      (target-entry (vector targets)))
  55    (vector (inlined target-entry)))
  56   ((etypecase targets
  57      ((or vector list) (length targets))
  58      (target-entry 1))
  59    int))
  60
  61 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
  62 (progn
  63   (defbinding target-list-add-text-targets (target-list info &optional writable-p) nil
  64     (target-list target-list)
  65     (info unsigned-int)
  66     (writable-p boolean))
  67
  68   (defbinding target-list-add-image-targets (target-list info &optional writable-p) nil
  69     (target-list target-list)
  70     (info unsigned-int)
  71     (writable-p boolean))
  72
  73   (defbinding target-list-add-uri-targets (target-list info &optional writable-p) nil
  74     (target-list target-list)
  75     (info unsigned-int)
  76     (writable-p boolean)))
  77
  78 (defbinding target-list-remove () nil
  79   (target-list target-list)
  80   (target gdk:atom))
  81
  82 ;; (defbinding target-list-find () nil
  83 ;;   (target-list target-list)
  84 ;;   (target gdk:atom)
  85 ;;   ...)
  86
  87 (defbinding (selection-set-owner "gtk_selection_owner_set_for_display")
  88     (widget selection time &optional (display (gdk:display-get-default)))
  89     boolean
  90   (display gdk:display)
  91   (widget widget)
  92   ((gdk:atom-intern selection) gdk:atom)
  93   (time (unsigned 32)))
  94
  95 (defbinding selection-add-target () nil
  96   (widget widget)
  97   (selection gdk:atom)
  98   (target gdk:atom)
  99   (info unsigned-int))
 100
 101 (defbinding selection-add-targets (widget selection targets) nil
 102   (widget widget)
 103   (selection gdk:atom)
 104   ((etypecase targets
 105      ((or vector list) targets)
 106      (target-entry (vector targets)))
 107    (vector (inlined target-entry)))
 108   ((etypecase targets
 109      ((or vector list) (length targets))
 110      (target-entry 1))
 111    int))
 112
 113 (defbinding selection-clear-targets () nil
 114   (widget widget)
 115   (selection gdk:atom))
 116
 117 (defbinding selection-convert () boolean
 118   (widget widget)
 119   (selection gdk:atom)
 120   (target gdk:atom)
 121   (time unsigned-int))
 122
 123 (defbinding selection-data-set () boolean
 124   (selection-data selection-data)
 125   (type gdk:atom)
 126   (format int)
 127   (data pointer)
 128   (length int))
 129
 130 (defbinding selection-data-set-text () boolean
 131   (selection-data selection-data)
 132   (text string)
 133   (-1 integer))
 134
 135 (defbinding selection-data-get-text () string
 136   (selection-data selection-data))
 137
 138 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
 139 (progn
 140   (defbinding selection-data-set-pixbuf () boolean
 141     (selection-data selection-data)
 142     (puxbuf gdk:pixbuf))
 143
 144   (defbinding selection-data-get-pixbuf () gdk:pixbuf
 145     (selection-data selection-data))
 146
 147   (defbinding selection-data-set-uris () boolean
 148     (selection-data selection-data)
 149     (uris (null-terminated-vector string)))
 150
 151   (defbinding selection-data-get-uris () (null-terminated-vector string)
 152     (selection-data selection-data)))
 153
 154 (defbinding selection-data-get-targets () boolean
 155   (selection-data selection-data)
 156   (targets (vector gdk:atom n-atoms))
 157   (n-atoms int))
 158
 159 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
 160 (defbinding selection-data-targets-include-image-p (selection-data &optional writable-p) boolean
 161   (selection-data selection-data)
 162   (writable-p boolean))
 163
 164 (defbinding selection-data-targets-include-text-p (selection-data) boolean
 165   (selection-data selection-data))
 166
 167 (defbinding selection-remove-all () boolean
 168   (widget widget))
 169
 170
 171 ;;; Clipboard -- untestet
 172
 173 (defbinding (clipboard-get "gtk_clipboard_get_for_display")
 174     (selection &optional (display (gdk:display-get-default))) clipboard
 175   (display gdk:display)
 176   ((gdk:atom-intern selection) gdk:atom))
 177
 178
 179 (define-callback %clipboard-get-callback nil
 180     ((clipboard pointer) (selection-data selection-data)
 181      (info int) (callback-ids unsigned-int))
 182   (declare (ignore clipboard))
 183   (funcall (car (find-user-data callback-ids)) selection-data info))
 184
 185 (define-callback %clipboard-clear-callback nil
 186     ((clipboard pointer) (callback-ids unsigned-int))
 187   (declare (ignore clipboard))
 188   (funcall (cdr (find-user-data callback-ids))))
 189
 190 (defbinding clipboard-set-with-data (clipboard targets get-func clear-func) gobject
 191   (clipboard clipboard)
 192   (targets (vector (inlined target-entry)))
 193   ((length targets) unsigned-int)
 194   (%clipboard-get-callback callback)
 195   (%clipboard-clear-callback callback)
 196   ((register-user-data (cons get-func clear-func)) unsigned-int))
 197
 198 (defbinding clipboard-clear () nil
 199   (clipboard clipboard))
 200
 201 (defbinding clipboard-set-text (clipboard text) nil
 202   (clipboard clipboard)
 203   (text string)
 204   ((length text) int))
 205
 206 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
 207 (defbinding clipboard-set-image () nil
 208   (clipboard clipboard)
 209   (pixbuf gdk:pixbuf))
 210
 211 (defun clipboard-set (clipboard object)
 212   (etypecase object
 213     (string (clipboard-set-text clipboard object))
 214     #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
 215     (gdk:pixbuf (clipboard-set-image clipboard object))))
 216
 217 (define-callback-marshal %clipboard-receive-callback nil
 218  ((:ignore clipboard) selection-data))
 219
 220 (defbinding clipboard-request-contents (clipboard target callback) nil
 221   (clipboard clipboard)
 222   ((gdk:atom-intern target) gdk:atom)
 223   (%clipboard-receive-callback callback)
 224   ((register-callback-function callback) unsigned-int))
 225
 226 (define-callback-marshal %clipboard-text-receive-callback nil
 227   ((:ignore clipboard) (text string)))
 228
 229
 230 (defbinding clipboard-request-text (clipboard callback) nil
 231   (clipboard clipboard)
 232   (%clipboard-text-receive-callback callback)
 233   ((register-callback-function callback) unsigned-int))
 234
 235 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
 236 (progn
 237   (define-callback-marshal %clipboard-image-receive-callback nil
 238     ((:ignore clipboard) (image gdk:pixbuf)))
 239
 240   (defbinding clipboard-request-image (clipboard callback) nil
 241     (clipboard clipboard)
 242     (%clipboard-image-receive-callback callback)
 243     ((register-callback-function callback) unsigned-int)))
 244
 245
 246 (define-callback %clipboard-targets-receive-callback nil
 247     ((clipboard pointer) (atoms (vector gdk:atom n-atoms))
 248      (n-atoms unsigned-int) (callback-id unsigned-int))
 249   (declare (ignore clipboard))
 250   (funcall (find-user-data callback-id) atoms))
 251
 252 (defbinding clipboard-request-targets (clipboard callback) nil
 253   (clipboard clipboard)
 254   (%clipboard-targets-receive-callback callback)
 255   ((register-callback-function callback) unsigned-int))
 256
 257 (defbinding clipboard-wait-for-contents () selection-data
 258   (clipboard clipboard))
 259
 260 (defbinding clipboard-wait-for-text () string
 261   (clipboard clipboard))
 262
 263 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
 264 (defbinding clipboard-wait-for-image () (referenced gdk:pixbuf)
 265   (clipboard clipboard))
 266
 267 (defbinding clipboard-wait-is-text-available-p () boolean
 268   (clipboard clipboard))
 269
 270 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
 271 (defbinding clipboard-wait-is-image-available-p () boolean
 272   (clipboard clipboard))
 273
 274 (defbinding clipboard-wait-for-targets () boolean
 275   (clipboard clipboard)
 276   (targets (vector gdk:atom n-targets) :out)
 277   (n-targets unsigned-int :out))
 278
 279 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
 280 (defbinding clipboard-wait-is-target-available-p () boolean
 281   (clipboard clipboard)
 282   (target gdk:atom))
 283
 284 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
 285 (defbinding clipboard-set-can-store () nil
 286   (clipboard clipboard)
 287   (targets (vector gdk:atom))
 288   ((length targets) int))
 289
 290 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
 291 (defbinding clipboard-store () nil
 292   (clipboard clipboard))
 293
 294
 295 ;;;; Drag and Drop
 296
 297 (defbinding drag-dest-set (widget flags targets actions) nil
 298   (widget widget)
 299   (flags dest-defaults)
 300   ((etypecase targets
 301      ((or vector list) targets)
 302      (target-entry (vector targets)))
 303    (vector (inlined target-entry)))
 304   ((etypecase targets
 305      ((or vector list) (length targets))
 306      (target-entry 1))
 307    int)
 308   (actions gdk:drag-action))
 309
 310 (defbinding drag-dest-set-proxy () nil
 311   (widget widget)
 312   (window gdk:window)
 313   (protocol gdk:drag-protocol)
 314   (use-coordinates-p boolean))
 315
 316 (defbinding drag-dest-unset () nil
 317   (widget widget))
 318
 319 (defbinding drag-dest-find-target () gdk:atom
 320   (widget widget)
 321   (context gdk:drag-context)
 322   (targets target-list))
 323
 324 (defbinding drag-dest-get-target-list () target-list
 325   (widget widget))
 326
 327 (defbinding drag-dest-set-target-list () nil
 328   (widget widget)
 329   (targets target-list))
 330
 331 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
 332 (progn
 333   (defbinding drag-dest-add-text-targets () nil
 334     (widget widget))
 335
 336   (defbinding drag-dest-add-image-targets () nil
 337     (widget widget))
 338
 339   (defbinding drag-dest-add-uri-targets () nil
 340     (widget widget)))
 341
 342 (defbinding drag-finish () nil
 343   (context gdk:drag-context)
 344   (success boolean)
 345   (delete boolean)
 346   (time unsigned-int))
 347
 348 (defbinding drag-get-data () nil
 349   (widget widget)
 350   (context gdk:drag-context)
 351   (target gdk:atom)
 352   (time unsigned-int))
 353
 354 (defbinding drag-get-source-widget () widget
 355   (context gdk:drag-context))
 356
 357 (defbinding drag-highlight () nil
 358   (widget widget))
 359
 360 (defbinding drag-unhighlight () nil
 361   (widget widget))
 362
 363 (defbinding drag-begin () gdk:drag-context
 364   (widget widget)
 365   (targets target-list)
 366   (actions gdk:drag-action)
 367   (button int)
 368   (event gdk:event))
 369
 370 (defbinding %drag-set-icon-widget () nil
 371   (context gdk:drag-context)
 372   (widget widget)
 373   (hot-x int)
 374   (hot-y int))
 375
 376 (defbinding %drag-set-icon-pixmap () nil
 377   (context gdk:drag-context)
 378   (pixmap gdk:pixmap)
 379   (mask gdk:bitmap)
 380   (hot-x int)
 381   (hot-y int))
 382
 383 (defbinding %drag-set-icon-pixbuf () nil
 384   (context gdk:drag-context)
 385   (pixbuf gdk:pixbuf)
 386   (hot-x int)
 387   (hot-y int))
 388
 389 (defbinding %drag-set-icon-stock () nil
 390   (context gdk:drag-context)
 391   (stock-id string)
 392   (hot-x int)
 393   (hot-y int))
 394
 395 (defbinding %drag-set-icon-default () nil
 396   (context gdk:drag-context))
 397
 398 (defun drag-set-icon (context icon &optional (hot-x 0) (hot-y 0))
 399   (etypecase icon
 400     (widget (%drag-set-icon-widget context icon hot-x hot-y))
 401     (gdk:pixbuf (%drag-set-icon-pixbuf context icon hot-x hot-y))
 402     (string (%drag-set-icon-stock context icon hot-x hot-y))
 403     (vector (multiple-value-bind (pixmap mask) (gdk:pixmap-create icon)
 404               (%drag-set-icon-pixmap context pixmap mask hot-x hot-y)))
 405     (pathname (let ((pixbuf (gdk:pixbuf-load icon)))
 406                 (%drag-set-icon-pixbuf context pixbuf hot-x hot-y)))
 407     (null (%drag-set-icon-default context))))
 408
 409 (defbinding drag-check-threshold-p () boolean
 410   (widget widget)
 411   (start-x int)
 412   (start-y int)
 413   (current-x int)
 414   (current-y int))
 415
 416 (defbinding drag-source-set (widget start-button-mask targets actions) nil
 417   (widget widget)
 418   (start-button-mask gdk:modifier-type)
 419   ((etypecase targets
 420      ((or vector list) targets)
 421      (target-entry (vector targets)))
 422    (vector (inlined target-entry)))
 423   ((etypecase targets
 424      ((or vector list) (length targets))
 425      (target-entry 1))
 426    int)
 427   (actions gdk:drag-action))
 428
 429 (defbinding %drag-source-set-icon-pixbuf () nil
 430   (widget widget)
 431   (pixbuf gdk:pixbuf))
 432
 433 (defbinding %drag-source-set-icon-stock () nil
 434   (widget widget)
 435   (pixbuf gdk:pixbuf))
 436
 437 (defun drag-source-set-icon (widget icon)
 438   (etypecase icon
 439     (gdk:pixbuf (%drag-source-set-icon-pixbuf widget icon))
 440     (string (%drag-source-set-icon-stock widget icon))
 441 ;    (vector )
 442     (pathname (let ((pixbuf (gdk:pixbuf-load icon)))
 443                 (%drag-source-set-icon-pixbuf widget pixbuf)))))
 444
 445 (defbinding drag-source-unset () nil
 446   (widget widget))
 447
 448 (defbinding drag-source-set-target-list () nil
 449   (widget widget)
 450   (targets (or null target-list)))
 451
 452 (defbinding drag-source-get-target-list () target-list
 453   (widget widget))
 454
 455 #?(pkg-exists-p "gtk+-2.0" :atleast-version "2.6.0")
 456 (progn
 457   (defbinding drag-source-add-text-targets () nil
 458     (widget widget))
 459
 460   (defbinding drag-source-add-image-targets () nil
 461     (widget widget))
 462
 463   (defbinding drag-source-add-uri-targets () nil
 464     (widget widget)))