1 ;; Common Lisp bindings for GTK+ v2.x
2 ;; Copyright 2000-2005 Espen S. Johnsen <espen@users.sf.net>
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:
12 ;; The above copyright notice and this permission notice shall be
13 ;; included in all copies or substantial portions of the Software.
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.
23 ;; $Id: gdk.lisp,v 1.18 2005/11/10 09:01:36 espen Exp $
30 (defbinding (gdk-init "gdk_parse_args") () nil
31 "Initializes the library without opening the display."
39 (defbinding %display-open () display
40 (display-name (or null string)))
42 (defun display-open (&optional display-name)
43 (let ((display (%display-open display-name)))
44 (unless (display-get-default)
45 (display-set-default display))
48 (defbinding %display-get-n-screens () int
51 (defbinding %display-get-screen () screen
55 (defun display-screens (&optional (display (display-get-default)))
57 for i from 0 below (%display-get-n-screens display)
58 collect (%display-get-screen display i)))
60 (defbinding display-get-default-screen
61 (&optional (display (display-get-default))) screen
64 (defbinding display-beep (&optional (display (display-get-default))) nil
67 (defbinding display-sync (&optional (display (display-get-default))) nil
70 (defbinding display-flush (&optional (display (display-get-default))) nil
73 (defbinding display-close (&optional (display (display-get-default))) nil
76 (defbinding display-get-event
77 (&optional (display (display-get-default))) event
80 (defbinding display-peek-event
81 (&optional (display (display-get-default))) event
84 (defbinding display-put-event
85 (event &optional (display (display-get-default))) event
89 (defbinding (display-connection-number "clg_gdk_connection_number")
90 (&optional (display (display-get-default))) int
97 (defbinding display-get-default () display)
99 (defbinding (display-manager "gdk_display_manager_get") () display-manager)
101 (defbinding (display-set-default "gdk_display_manager_set_default_display")
103 ((display-manager) display-manager)
110 (defbinding (events-pending-p "gdk_events_pending") () boolean)
112 (defbinding event-get () event)
114 (defbinding event-peek () event)
116 (defbinding event-get-graphics-expose () event
119 (defbinding event-put () event
122 ;(defbinding event-handler-set () ...)
124 (defbinding set-show-events () nil
125 (show-events boolean))
127 (defbinding get-show-events () boolean)
130 ;;; Miscellaneous functions
132 (defbinding screen-width () int)
133 (defbinding screen-height () int)
135 (defbinding screen-width-mm () int)
136 (defbinding screen-height-mm () int)
138 (defbinding pointer-grab
139 (window &key owner-events events confine-to cursor time) grab-status
141 (owner-events boolean)
143 (confine-to (or null window))
144 (cursor (or null cursor))
145 ((or time 0) (unsigned 32)))
147 (defbinding (pointer-ungrab "gdk_display_pointer_ungrab")
148 (&optional time (display (display-get-default))) nil
150 ((or time 0) (unsigned 32)))
152 (defbinding (pointer-is-grabbed-p "gdk_display_pointer_is_grabbed")
153 (&optional (display (display-get-default))) boolean)
155 (defbinding keyboard-grab (window &key owner-events time) grab-status
157 (owner-events boolean)
158 ((or time 0) (unsigned 32)))
160 (defbinding (keyboard-ungrab "gdk_display_keyboard_ungrab")
161 (&optional time (display (display-get-default))) nil
163 ((or time 0) (unsigned 32)))
167 (defbinding atom-intern (atom-name &optional only-if-exists) atom
168 ((string atom-name) string)
169 (only-if-exists boolean))
171 (defbinding atom-name () string
178 (defbinding visual-get-best-depth () int)
180 (defbinding visual-get-best-type () visual-type)
182 (defbinding visual-get-system () visual)
185 (defbinding (%visual-get-best-with-nothing "gdk_visual_get_best") () visual)
187 (defbinding %visual-get-best-with-depth () visual
190 (defbinding %visual-get-best-with-type () visual
193 (defbinding %visual-get-best-with-both () visual
197 (defun visual-get-best (&key depth type)
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))))
204 ;(defbinding query-depths ..)
206 ;(defbinding query-visual-types ..)
208 (defbinding list-visuals () (glist visual))
213 (defbinding window-destroy () nil
217 (defbinding window-at-pointer () window
221 (defbinding window-show () nil
224 (defbinding window-show-unraised () nil
227 (defbinding window-hide () nil
230 (defbinding window-is-visible-p () boolean
233 (defbinding window-is-viewable-p () boolean
236 (defbinding window-withdraw () nil
239 (defbinding window-iconify () nil
242 (defbinding window-deiconify () nil
245 (defbinding window-stick () nil
248 (defbinding window-unstick () nil
251 (defbinding window-maximize () nil
254 (defbinding window-unmaximize () nil
257 (defbinding window-fullscreen () nil
260 (defbinding window-unfullscreen () nil
263 (defbinding window-set-keep-above () nil
267 (defbinding window-set-keep-below () nil
271 (defbinding window-move () nil
276 (defbinding window-resize () nil
281 (defbinding window-move-resize () nil
288 (defbinding window-scroll () nil
293 (defbinding window-reparent () nil
299 (defbinding window-clear () nil
302 (defbinding %window-clear-area () nil
304 (x int) (y int) (width int) (height int))
306 (defbinding %window-clear-area-e () nil
308 (x int) (y int) (width int) (height int))
310 (defun window-clear-area (window x y width height &optional expose)
312 (%window-clear-area-e window x y width height)
313 (%window-clear-area window x y width height)))
315 (defbinding window-raise () nil
318 (defbinding window-lower () nil
321 (defbinding window-focus () nil
323 (timestamp unsigned-int))
325 (defbinding window-register-dnd () nil
328 (defbinding window-begin-resize-drag () nil
334 (timestamp unsigned-int))
336 (defbinding window-begin-move-drag () nil
341 (timestamp unsigned-int))
343 ;; komplett så langt
345 (defbinding window-set-user-data () nil
349 (defbinding window-set-override-redirect () nil
351 (override-redirect boolean))
353 ; (defbinding window-add-filter () nil
355 ; (defbinding window-remove-filter () nil
357 (defbinding window-shape-combine-mask () nil
363 (defbinding window-set-child-shapes () nil
366 (defbinding window-merge-child-shapes () nil
370 (defbinding window-set-static-gravities () boolean
372 (use-static boolean))
374 ; (defbinding add-client-message-filter ...
376 (defbinding window-set-cursor () nil
378 (cursor (or null cursor)))
380 (defbinding window-get-pointer () window
384 (mask modifier-type :out))
386 (defbinding %window-get-toplevels () (glist window))
388 (defun window-get-toplevels (&optional screen)
390 (error "Not implemented")
391 (%window-get-toplevels)))
393 (defbinding %get-default-root-window () window)
395 (defun get-root-window (&optional display)
397 (error "Not implemented")
398 (%get-default-root-window)))
406 (defbinding drag-status () nil
407 (context drag-context)
409 (time (unsigned 32)))
418 (defbinding rgb-init () nil)
425 (defmethod initialize-instance ((cursor cursor) &key type mask fg bg
426 (x 0) (y 0) (display (display-get-default)))
428 (slot-value cursor 'location)
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)))))
435 (defbinding %cursor-new-for-display () pointer
437 (cursor-type cursor-type))
439 (defbinding %cursor-new-from-pixmap () pointer
446 (defbinding %cursor-new-from-pixbuf () pointer
451 (defbinding %cursor-ref () pointer
454 (defbinding %cursor-unref () nil
457 (defmethod reference-foreign ((class (eql (find-class 'cursor))) location)
458 (declare (ignore class))
459 (%cursor-ref location))
461 (defmethod unreference-foreign ((class (eql (find-class 'cursor))) location)
462 (declare (ignore class))
463 (%cursor-unref location))
468 (defbinding pixmap-new (width height depth &key window) pixmap
472 (window (or null window)))
474 (defbinding %pixmap-colormap-create-from-xpm () pixmap
475 (window (or null window))
476 (colormap (or null colormap))
478 (color (or null color))
481 (defbinding %pixmap-colormap-create-from-xpm-d () pixmap
482 (window (or null window))
483 (colormap (or null colormap))
485 (color (or null color))
486 (data (vector string)))
488 (defun pixmap-create (source &key color window colormap)
490 (if (not (or window colormap))
493 (multiple-value-bind (pixmap mask)
495 ((or string pathname)
496 (%pixmap-colormap-create-from-xpm
497 window colormap color (namestring (truename source))))
499 (%pixmap-colormap-create-from-xpm-d window colormap color source)))
500 ;; (unreference-instance pixmap)
501 ;; (unreference-instance mask)
502 (values pixmap mask))))
508 (defun %scale-value (value)
511 (float (truncate (* value 65535)))))
513 (defmethod initialize-instance ((color color) &rest initargs
515 (declare (ignore initargs))
517 (with-slots ((%red red) (%green green) (%blue blue)) color
519 %red (%scale-value red)
520 %green (%scale-value green)
521 %blue (%scale-value blue))))
523 (defun ensure-color (color)
529 'color :red (svref color 0) :green (svref color 1)
530 :blue (svref color 2)))))
536 (defbinding drawable-get-size () nil
541 (defbinding (drawable-width "gdk_drawable_get_size") () nil
546 (defbinding (drawable-height "gdk_drawable_get_size") () nil
551 ;; (defbinding drawable-get-clip-region () region
552 ;; (drawable drawable))
554 ;; (defbinding drawable-get-visible-region () region
555 ;; (drawable drawable))
557 (defbinding draw-point () nil
558 (drawable drawable) (gc gc)
561 (defbinding %draw-points () nil
562 (drawable drawable) (gc gc)
566 ;; (defun draw-points (drawable gc &rest points)
570 (defbinding draw-line () nil
571 (drawable drawable) (gc gc)
575 ;; (defbinding draw-lines (drawable gc &rest points) nil
576 ;; (drawable drawable) (gc gc)
577 ;; (points (vector point))
578 ;; ((length points) int))
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))
585 (src-x int) (src-y int)
586 (dest-x int) (dest-y int)
587 ((or width -1) int) ((or height -1) int)
589 (x-dither int) (y-dither int))
591 ;; (defbinding draw-segments (drawable gc &rest points) nil
592 ;; (drawable drawable) (gc gc)
593 ;; (segments (vector segments))
594 ;; ((length segments) int))
596 (defbinding draw-rectangle () nil
597 (drawable drawable) (gc gc)
600 (width int) (height int))
602 (defbinding draw-arc () nil
603 (drawable drawable) (gc gc)
606 (width int) (height int)
607 (angle1 int) (angle2 int))
609 ;; (defbinding draw-polygon (drawable gc &rest points) nil
610 ;; (drawable drawable) (gc gc)
611 ;; (points (vector point))
612 ;; ((length points) int))
614 ;; (defbinding draw-trapezoid (drawable gc &rest points) nil
615 ;; (drawable drawable) (gc gc)
616 ;; (points (vector point))
617 ;; ((length points) int))
619 ;; (defbinding %draw-layout-line () nil
620 ;; (drawable drawable) (gc gc)
623 ;; (line pango:layout-line))
625 ;; (defbinding %draw-layout-line-with-colors () nil
626 ;; (drawable drawable) (gc gc)
629 ;; (line pango:layout-line)
630 ;; (foreground (or null color))
631 ;; (background (or null color)))
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)))
638 (defbinding %draw-layout () nil
639 (drawable drawable) (gc gc)
642 (layout pango:layout))
644 (defbinding %draw-layout-with-colors () nil
645 (drawable drawable) (gc gc)
648 (layout pango:layout)
649 (foreground (or null color))
650 (background (or null color)))
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)))
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)
661 (src-x int) (src-y int)
662 (dest-x int) (dest-y int)
663 ((or width -1) int) ((or height -1) int))
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)
669 (src-x int) (src-y int)
670 (dest-x int) (dest-y int)
671 ((or width -1) int) ((or height -1) int))
673 (defbinding drawable-get-image () image
676 (width int) (height int))
678 (defbinding drawable-copy-to-image
679 (drawable src-x src-y width height &optional image dest-x dest-y) image
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))
690 (defbinding keyval-name () string
691 (keyval unsigned-int))
693 (defbinding keyval-from-name () unsigned-int
696 (defbinding keyval-to-upper () unsigned-int
697 (keyval unsigned-int))
699 (defbinding keyval-to-lower () unsigned-int
700 (keyval unsigned-int))
702 (defbinding (keyval-is-upper-p "gdk_keyval_is_upper") () boolean
703 (keyval unsigned-int))
705 (defbinding (keyval-is-lower-p "gdk_keyval_is_lower") () boolean
706 (keyval unsigned-int))
708 ;;; Cairo interaction
712 (defbinding cairo-create () cairo:context
715 (defbinding cairo-set-source-color () nil
719 (defbinding cairo-set-source-pixbuf () nil
725 (defbinding cairo-rectangle () nil
727 (rectangle rectangle))
729 ;; (defbinding cairo-region () nil
730 ;; (cr cairo:context)