chiark / gitweb /
Changed to use of settable FOREIGN-LOCATION
[clg] / gdk / gdk.lisp
CommitLineData
112ac1d3 1;; Common Lisp bindings for GTK+ v2.x
2;; Copyright 2000-2005 Espen S. Johnsen <espen@users.sf.net>
560af5c5 3;;
112ac1d3 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:
560af5c5 11;;
112ac1d3 12;; The above copyright notice and this permission notice shall be
13;; included in all copies or substantial portions of the Software.
560af5c5 14;;
112ac1d3 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
cc74b2c9 23;; $Id: gdk.lisp,v 1.20 2006-02-08 22:20:22 espen Exp $
560af5c5 24
25
26(in-package "GDK")
27
13b24566 28;;; Initialization
29
30(defbinding (gdk-init "gdk_parse_args") () nil
31 "Initializes the library without opening the display."
32 (nil null)
33 (nil null))
560af5c5 34
560af5c5 35
13b24566 36
a02fc41f 37;;; Display
13b24566 38
39(defbinding %display-open () display
40 (display-name (or null string)))
41
42(defun display-open (&optional display-name)
43 (let ((display (%display-open display-name)))
44 (unless (display-get-default)
45 (display-set-default display))
46 display))
47
a02fc41f 48(defbinding %display-get-n-screens () int
49 (display display))
50
51(defbinding %display-get-screen () screen
52 (display display)
53 (screen-num int))
54
55(defun display-screens (&optional (display (display-get-default)))
56 (loop
57 for i from 0 below (%display-get-n-screens display)
58 collect (%display-get-screen display i)))
59
60(defbinding display-get-default-screen
61 (&optional (display (display-get-default))) screen
62 (display display))
63
64(defbinding display-beep (&optional (display (display-get-default))) nil
65 (display display))
66
67(defbinding display-sync (&optional (display (display-get-default))) nil
68 (display display))
69
70(defbinding display-flush (&optional (display (display-get-default))) nil
71 (display display))
72
73(defbinding display-close (&optional (display (display-get-default))) nil
74 (display display))
75
76(defbinding display-get-event
77 (&optional (display (display-get-default))) event
78 (display display))
79
80(defbinding display-peek-event
81 (&optional (display (display-get-default))) event
82 (display display))
83
84(defbinding display-put-event
85 (event &optional (display (display-get-default))) event
86 (display display)
87 (event event))
88
13b24566 89(defbinding (display-connection-number "clg_gdk_connection_number")
90 (&optional (display (display-get-default))) int
91 (display display))
92
93
a02fc41f 94
95;;; Display manager
96
97(defbinding display-get-default () display)
98
99(defbinding (display-manager "gdk_display_manager_get") () display-manager)
100
101(defbinding (display-set-default "gdk_display_manager_set_default_display")
102 (display) nil
103 ((display-manager) display-manager)
104 (display display))
105
106
107
13b24566 108;;; Events
560af5c5 109
8bb8ead0 110(defbinding (events-pending-p "gdk_events_pending") () boolean)
560af5c5 111
8bb8ead0 112(defbinding event-get () event)
560af5c5 113
8bb8ead0 114(defbinding event-peek () event)
560af5c5 115
8bb8ead0 116(defbinding event-get-graphics-expose () event
560af5c5 117 (window window))
118
8bb8ead0 119(defbinding event-put () event
560af5c5 120 (event event))
121
8bb8ead0 122;(defbinding event-handler-set () ...)
560af5c5 123
8bb8ead0 124(defbinding set-show-events () nil
560af5c5 125 (show-events boolean))
126
8bb8ead0 127(defbinding get-show-events () boolean)
560af5c5 128
560af5c5 129
a02fc41f 130;;; Miscellaneous functions
560af5c5 131
a02fc41f 132(defbinding screen-width () int)
133(defbinding screen-height () int)
560af5c5 134
a02fc41f 135(defbinding screen-width-mm () int)
136(defbinding screen-height-mm () int)
560af5c5 137
a02fc41f 138(defbinding pointer-grab
139 (window &key owner-events events confine-to cursor time) grab-status
560af5c5 140 (window window)
141 (owner-events boolean)
a02fc41f 142 (events event-mask)
560af5c5 143 (confine-to (or null window))
144 (cursor (or null cursor))
580820d8 145 ((or time 0) (unsigned 32)))
560af5c5 146
a02fc41f 147(defbinding (pointer-ungrab "gdk_display_pointer_ungrab")
580820d8 148 (&optional time (display (display-get-default))) nil
a02fc41f 149 (display display)
580820d8 150 ((or time 0) (unsigned 32)))
560af5c5 151
a02fc41f 152(defbinding (pointer-is-grabbed-p "gdk_display_pointer_is_grabbed")
153 (&optional (display (display-get-default))) boolean)
154
155(defbinding keyboard-grab (window &key owner-events time) grab-status
560af5c5 156 (window window)
157 (owner-events boolean)
580820d8 158 ((or time 0) (unsigned 32)))
560af5c5 159
a02fc41f 160(defbinding (keyboard-ungrab "gdk_display_keyboard_ungrab")
580820d8 161 (&optional time (display (display-get-default))) nil
a02fc41f 162 (display display)
580820d8 163 ((or time 0) (unsigned 32)))
560af5c5 164
560af5c5 165
560af5c5 166
628fd576 167(defbinding atom-intern (atom-name &optional only-if-exists) atom
168 ((string atom-name) string)
169 (only-if-exists boolean))
170
171(defbinding atom-name () string
172 (atom atom))
173
560af5c5 174
175
176;;; Visuals
177
8bb8ead0 178(defbinding visual-get-best-depth () int)
560af5c5 179
8bb8ead0 180(defbinding visual-get-best-type () visual-type)
560af5c5 181
8bb8ead0 182(defbinding visual-get-system () visual)
560af5c5 183
184
8bb8ead0 185(defbinding (%visual-get-best-with-nothing "gdk_visual_get_best") () visual)
560af5c5 186
8bb8ead0 187(defbinding %visual-get-best-with-depth () visual
560af5c5 188 (depth int))
189
8bb8ead0 190(defbinding %visual-get-best-with-type () visual
560af5c5 191 (type visual-type))
192
8bb8ead0 193(defbinding %visual-get-best-with-both () visual
560af5c5 194 (depth int)
195 (type visual-type))
196
197(defun visual-get-best (&key depth type)
198 (cond
199 ((and depth type) (%visual-get-best-with-both depth type))
200 (depth (%visual-get-best-with-depth depth))
201 (type (%visual-get-best-with-type type))
202 (t (%visual-get-best-with-nothing))))
203
8bb8ead0 204;(defbinding query-depths ..)
560af5c5 205
8bb8ead0 206;(defbinding query-visual-types ..)
560af5c5 207
8bb8ead0 208(defbinding list-visuals () (glist visual))
560af5c5 209
210
211;;; Windows
212
8bb8ead0 213(defbinding window-destroy () nil
560af5c5 214 (window window))
215
216
8f30d7da 217(defbinding window-at-pointer () window
218 (x int :out)
219 (y int :out))
560af5c5 220
8bb8ead0 221(defbinding window-show () nil
560af5c5 222 (window window))
223
8f30d7da 224(defbinding window-show-unraised () nil
225 (window window))
226
8bb8ead0 227(defbinding window-hide () nil
560af5c5 228 (window window))
229
8f30d7da 230(defbinding window-is-visible-p () boolean
231 (window window))
232
233(defbinding window-is-viewable-p () boolean
234 (window window))
235
8bb8ead0 236(defbinding window-withdraw () nil
560af5c5 237 (window window))
238
8f30d7da 239(defbinding window-iconify () nil
240 (window window))
241
242(defbinding window-deiconify () nil
243 (window window))
244
245(defbinding window-stick () nil
246 (window window))
247
248(defbinding window-unstick () nil
249 (window window))
250
251(defbinding window-maximize () nil
252 (window window))
253
254(defbinding window-unmaximize () nil
255 (window window))
256
257(defbinding window-fullscreen () nil
258 (window window))
259
260(defbinding window-unfullscreen () nil
261 (window window))
262
263(defbinding window-set-keep-above () nil
264 (window window)
265 (setting boolean))
266
267(defbinding window-set-keep-below () nil
268 (window window)
269 (setting boolean))
270
8bb8ead0 271(defbinding window-move () nil
560af5c5 272 (window window)
273 (x int)
274 (y int))
275
8bb8ead0 276(defbinding window-resize () nil
560af5c5 277 (window window)
278 (width int)
279 (height int))
280
8bb8ead0 281(defbinding window-move-resize () nil
560af5c5 282 (window window)
283 (x int)
284 (y int)
285 (width int)
286 (height int))
287
8f30d7da 288(defbinding window-scroll () nil
289 (window window)
290 (dx int)
291 (dy int))
292
8bb8ead0 293(defbinding window-reparent () nil
560af5c5 294 (window window)
295 (new-parent window)
296 (x int)
297 (y int))
298
8bb8ead0 299(defbinding window-clear () nil
560af5c5 300 (window window))
301
8f30d7da 302(defbinding %window-clear-area () nil
560af5c5 303 (window window)
304 (x int) (y int) (width int) (height int))
305
8f30d7da 306(defbinding %window-clear-area-e () nil
560af5c5 307 (window window)
308 (x int) (y int) (width int) (height int))
309
310(defun window-clear-area (window x y width height &optional expose)
311 (if expose
8f30d7da 312 (%window-clear-area-e window x y width height)
313 (%window-clear-area window x y width height)))
560af5c5 314
8bb8ead0 315(defbinding window-raise () nil
560af5c5 316 (window window))
317
8bb8ead0 318(defbinding window-lower () nil
560af5c5 319 (window window))
320
8f30d7da 321(defbinding window-focus () nil
322 (window window)
323 (timestamp unsigned-int))
324
325(defbinding window-register-dnd () nil
326 (window window))
327
328(defbinding window-begin-resize-drag () nil
329 (window window)
330 (edge window-edge)
331 (button int)
332 (root-x int)
333 (root-y int)
334 (timestamp unsigned-int))
335
336(defbinding window-begin-move-drag () nil
337 (window window)
338 (button int)
339 (root-x int)
340 (root-y int)
341 (timestamp unsigned-int))
342
343;; komplett så langt
344
345(defbinding window-set-user-data () nil
346 (window window)
347 (user-data pointer))
560af5c5 348
8bb8ead0 349(defbinding window-set-override-redirect () nil
560af5c5 350 (window window)
351 (override-redirect boolean))
352
8bb8ead0 353; (defbinding window-add-filter () nil
560af5c5 354
8bb8ead0 355; (defbinding window-remove-filter () nil
560af5c5 356
8bb8ead0 357(defbinding window-shape-combine-mask () nil
560af5c5 358 (window window)
359 (shape-mask bitmap)
360 (offset-x int)
361 (offset-y int))
362
8bb8ead0 363(defbinding window-set-child-shapes () nil
560af5c5 364 (window window))
365
8bb8ead0 366(defbinding window-merge-child-shapes () nil
560af5c5 367 (window window))
368
560af5c5 369
8bb8ead0 370(defbinding window-set-static-gravities () boolean
560af5c5 371 (window window)
372 (use-static boolean))
373
8bb8ead0 374; (defbinding add-client-message-filter ...
560af5c5 375
8bb8ead0 376(defbinding window-set-cursor () nil
560af5c5 377 (window window)
8f30d7da 378 (cursor (or null cursor)))
560af5c5 379
8bb8ead0 380(defbinding window-get-pointer () window
560af5c5 381 (window window)
382 (x int :out)
383 (y int :out)
384 (mask modifier-type :out))
385
8f30d7da 386(defbinding %window-get-toplevels () (glist window))
387
388(defun window-get-toplevels (&optional screen)
389 (if screen
390 (error "Not implemented")
391 (%window-get-toplevels)))
392
bc9997e8 393(defbinding %get-default-root-window () window)
560af5c5 394
3d5e4e39 395(defun get-root-window (&optional display)
bc9997e8 396 (if display
397 (error "Not implemented")
398 (%get-default-root-window)))
560af5c5 399
400
8f30d7da 401
402;;; Drag and Drop
403
404;; Destination side
405
406(defbinding drag-status () nil
407 (context drag-context)
408 (action drag-action)
409 (time (unsigned 32)))
410
411
412
413
414
415
560af5c5 416;;
417
8bb8ead0 418(defbinding rgb-init () nil)
560af5c5 419
420
421
422
423;;; Cursor
424
8f30d7da 425(defmethod initialize-instance ((cursor cursor) &key type mask fg bg
426 (x 0) (y 0) (display (display-get-default)))
427 (setf
cc74b2c9 428 (foreign-location cursor)
8f30d7da 429 (etypecase type
430 (keyword (%cursor-new-for-display display type))
431 (pixbuf (%cursor-new-from-pixbuf display type x y))
432 (pixmap (%cursor-new-from-pixmap type mask fg bg x y)))))
433
434
435(defbinding %cursor-new-for-display () pointer
436 (display display)
560af5c5 437 (cursor-type cursor-type))
438
8f30d7da 439(defbinding %cursor-new-from-pixmap () pointer
560af5c5 440 (source pixmap)
441 (mask bitmap)
442 (foreground color)
443 (background color)
444 (x int) (y int))
445
8f30d7da 446(defbinding %cursor-new-from-pixbuf () pointer
447 (display display)
448 (pixbuf pixbuf)
449 (x int) (y int))
450
8bb8ead0 451(defbinding %cursor-ref () pointer
9adccb27 452 (location pointer))
560af5c5 453
8bb8ead0 454(defbinding %cursor-unref () nil
9adccb27 455 (location pointer))
456
457(defmethod reference-foreign ((class (eql (find-class 'cursor))) location)
458 (declare (ignore class))
459 (%cursor-ref location))
460
461(defmethod unreference-foreign ((class (eql (find-class 'cursor))) location)
462 (declare (ignore class))
463 (%cursor-unref location))
464
560af5c5 465
560af5c5 466;;; Pixmaps
bc9997e8 467
8bb8ead0 468(defbinding pixmap-new (width height depth &key window) pixmap
560af5c5 469 (width int)
470 (height int)
471 (depth int)
472 (window (or null window)))
473
8bb8ead0 474(defbinding %pixmap-colormap-create-from-xpm () pixmap
560af5c5 475 (window (or null window))
476 (colormap (or null colormap))
477 (mask bitmap :out)
478 (color (or null color))
479 (filename string))
480
8bb8ead0 481(defbinding %pixmap-colormap-create-from-xpm-d () pixmap
560af5c5 482 (window (or null window))
483 (colormap (or null colormap))
484 (mask bitmap :out)
485 (color (or null color))
2a189a9e 486 (data (vector string)))
560af5c5 487
bb110f5f 488(defun pixmap-create (source &key color window colormap)
489 (let ((window
490 (if (not (or window colormap))
491 (get-root-window)
492 window)))
493 (multiple-value-bind (pixmap mask)
2a189a9e 494 (etypecase source
bb110f5f 495 ((or string pathname)
496 (%pixmap-colormap-create-from-xpm
497 window colormap color (namestring (truename source))))
2a189a9e 498 ((vector string)
499 (%pixmap-colormap-create-from-xpm-d window colormap color source)))
bc9997e8 500;; (unreference-instance pixmap)
501;; (unreference-instance mask)
bb110f5f 502 (values pixmap mask))))
bc9997e8 503
560af5c5 504
505
506;;; Color
507
508(defun %scale-value (value)
509 (etypecase value
510 (integer value)
511 (float (truncate (* value 65535)))))
512
513(defmethod initialize-instance ((color color) &rest initargs
1ebfd3a6 514 &key red green blue)
560af5c5 515 (declare (ignore initargs))
516 (call-next-method)
517 (with-slots ((%red red) (%green green) (%blue blue)) color
518 (setf
1ebfd3a6 519 %red (%scale-value red)
520 %green (%scale-value green)
521 %blue (%scale-value blue))))
560af5c5 522
560af5c5 523(defun ensure-color (color)
524 (etypecase color
525 (null nil)
526 (color color)
1ebfd3a6 527 (vector
528 (make-instance
529 'color :red (svref color 0) :green (svref color 1)
530 :blue (svref color 2)))))
560af5c5 531
532
533
8f30d7da 534;;; Drawable
535
536(defbinding drawable-get-size () nil
537 (drawable drawable)
538 (width int :out)
539 (height int :out))
540
541(defbinding (drawable-width "gdk_drawable_get_size") () nil
542 (drawable drawable)
543 (width int :out)
544 (nil null))
545
546(defbinding (drawable-height "gdk_drawable_get_size") () nil
547 (drawable drawable)
548 (nil null)
549 (height int :out))
550
551;; (defbinding drawable-get-clip-region () region
552;; (drawable drawable))
553
554;; (defbinding drawable-get-visible-region () region
555;; (drawable drawable))
556
557(defbinding draw-point () nil
558 (drawable drawable) (gc gc)
559 (x int) (y int))
560
561(defbinding %draw-points () nil
562 (drawable drawable) (gc gc)
563 (points pointer)
564 (n-points int))
565
566;; (defun draw-points (drawable gc &rest points)
567
568;; )
569
570(defbinding draw-line () nil
571 (drawable drawable) (gc gc)
572 (x1 int) (y1 int)
573 (x2 int) (y2 int))
574
575;; (defbinding draw-lines (drawable gc &rest points) nil
576;; (drawable drawable) (gc gc)
577;; (points (vector point))
578;; ((length points) int))
579
580(defbinding draw-pixbuf
581 (drawable gc pixbuf src-x src-y dest-x dest-y &optional
582 width height (dither :none) (x-dither 0) (y-dither 0)) nil
583 (drawable drawable) (gc (or null gc))
584 (pixbuf pixbuf)
585 (src-x int) (src-y int)
586 (dest-x int) (dest-y int)
587 ((or width -1) int) ((or height -1) int)
588 (dither rgb-dither)
589 (x-dither int) (y-dither int))
590
591;; (defbinding draw-segments (drawable gc &rest points) nil
592;; (drawable drawable) (gc gc)
593;; (segments (vector segments))
594;; ((length segments) int))
560af5c5 595
8bb8ead0 596(defbinding draw-rectangle () nil
8f30d7da 597 (drawable drawable) (gc gc)
598 (filled boolean)
599 (x int) (y int)
600 (width int) (height int))
601
602(defbinding draw-arc () nil
603 (drawable drawable) (gc gc)
604 (filled boolean)
605 (x int) (y int)
606 (width int) (height int)
607 (angle1 int) (angle2 int))
608
609;; (defbinding draw-polygon (drawable gc &rest points) nil
610;; (drawable drawable) (gc gc)
611;; (points (vector point))
612;; ((length points) int))
613
614;; (defbinding draw-trapezoid (drawable gc &rest points) nil
615;; (drawable drawable) (gc gc)
616;; (points (vector point))
617;; ((length points) int))
618
619;; (defbinding %draw-layout-line () nil
620;; (drawable drawable) (gc gc)
621;; (font pango:font)
622;; (x int) (y int)
623;; (line pango:layout-line))
624
625;; (defbinding %draw-layout-line-with-colors () nil
626;; (drawable drawable) (gc gc)
627;; (font pango:font)
628;; (x int) (y int)
629;; (line pango:layout-line)
630;; (foreground (or null color))
631;; (background (or null color)))
632
633;; (defun draw-layout-line (drawable gc font x y line &optional foreground background)
634;; (if (or foreground background)
635;; (%draw-layout-line-with-colors drawable gc font x y line foreground background)
636;; (%draw-layout-line drawable gc font x y line)))
637
638(defbinding %draw-layout () nil
639 (drawable drawable) (gc gc)
640 (font pango:font)
641 (x int) (y int)
642 (layout pango:layout))
643
644(defbinding %draw-layout-with-colors () nil
645 (drawable drawable) (gc gc)
646 (font pango:font)
647 (x int) (y int)
648 (layout pango:layout)
649 (foreground (or null color))
650 (background (or null color)))
651
652(defun draw-layout (drawable gc font x y layout &optional foreground background)
653 (if (or foreground background)
654 (%draw-layout-with-colors drawable gc font x y layout foreground background)
655 (%draw-layout drawable gc font x y layout)))
656
657(defbinding draw-drawable
658 (drawable gc src src-x src-y dest-x dest-y &optional width height) nil
659 (drawable drawable) (gc gc)
660 (src drawable)
661 (src-x int) (src-y int)
662 (dest-x int) (dest-y int)
663 ((or width -1) int) ((or height -1) int))
664
665(defbinding draw-image
666 (drawable gc image src-x src-y dest-x dest-y &optional width height) nil
667 (drawable drawable) (gc gc)
668 (image image)
669 (src-x int) (src-y int)
670 (dest-x int) (dest-y int)
671 ((or width -1) int) ((or height -1) int))
672
673(defbinding drawable-get-image () image
674 (drawable drawable)
675 (x int) (y int)
676 (width int) (height int))
677
678(defbinding drawable-copy-to-image
679 (drawable src-x src-y width height &optional image dest-x dest-y) image
680 (drawable drawable)
681 (image (or null image))
682 (src-x int) (src-y int)
683 ((if image dest-x 0) int)
684 ((if image dest-y 0) int)
685 (width int) (height int))
560af5c5 686
687
688;;; Key values
689
8bb8ead0 690(defbinding keyval-name () string
560af5c5 691 (keyval unsigned-int))
692
8bb8ead0 693(defbinding keyval-from-name () unsigned-int
560af5c5 694 (name string))
695
8bb8ead0 696(defbinding keyval-to-upper () unsigned-int
560af5c5 697 (keyval unsigned-int))
698
628fd576 699(defbinding keyval-to-lower () unsigned-int
560af5c5 700 (keyval unsigned-int))
701
8bb8ead0 702(defbinding (keyval-is-upper-p "gdk_keyval_is_upper") () boolean
560af5c5 703 (keyval unsigned-int))
704
8bb8ead0 705(defbinding (keyval-is-lower-p "gdk_keyval_is_lower") () boolean
560af5c5 706 (keyval unsigned-int))
707
7be9fc0c 708;;; Cairo interaction
709
710#+gtk2.8
711(progn
712 (defbinding cairo-create () cairo:context
713 (drawable drawable))
714
5fba7ba0 715 (defmacro with-cairo-context ((cr drawable) &body body)
716 `(let ((,cr (cairo-create ,drawable)))
717 (unwind-protect
718 (progn ,@body)
719 (unreference-foreign 'cairo:context (foreign-location ,cr))
720 (invalidate-instance ,cr))))
721
7be9fc0c 722 (defbinding cairo-set-source-color () nil
723 (cr cairo:context)
724 (color color))
725
726 (defbinding cairo-set-source-pixbuf () nil
727 (cr cairo:context)
728 (pixbuf pixbuf)
729 (x double-float)
730 (y double-float))
731
732 (defbinding cairo-rectangle () nil
733 (cr cairo:context)
734 (rectangle rectangle))
735
736;; (defbinding cairo-region () nil
737;; (cr cairo:context)
738;; (region region))
739)