1 ;; Common Lisp bindings for GTK+ v2.0
2 ;; Copyright (C) 1999-2001 Espen S. Johnsen <esj@stud.cs.uit.no>
4 ;; This library is free software; you can redistribute it and/or
5 ;; modify it under the terms of the GNU Lesser General Public
6 ;; License as published by the Free Software Foundation; either
7 ;; version 2 of the License, or (at your option) any later version.
9 ;; This library is distributed in the hope that it will be useful,
10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 ;; Lesser General Public License for more details.
14 ;; You should have received a copy of the GNU Lesser General Public
15 ;; License along with this library; if not, write to the Free Software
16 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18 ;; $Id: gdk.lisp,v 1.13 2005-01-30 15:08:03 espen Exp $
25 (defbinding (gdk-init "gdk_parse_args") () nil
26 "Initializes the library without opening the display."
33 (defbinding (display-manager "gdk_display_manager_get") () display-manager)
36 (defbinding (display-set-default "gdk_display_manager_set_default_display")
38 ((display-manager) display-manager)
41 (defbinding display-get-default () display)
43 (defbinding %display-open () display
44 (display-name (or null string)))
46 (defun display-open (&optional display-name)
47 (let ((display (%display-open display-name)))
48 (unless (display-get-default)
49 (display-set-default display))
52 (defbinding (display-connection-number "clg_gdk_connection_number")
53 (&optional (display (display-get-default))) int
59 (defbinding (events-pending-p "gdk_events_pending") () boolean)
61 (defbinding event-get () event)
63 (defbinding event-peek () event)
65 (defbinding event-get-graphics-expose () event
68 (defbinding event-put () event
71 ;(defbinding event-handler-set () ...)
73 (defbinding set-show-events () nil
74 (show-events boolean))
78 (defbinding set-use-xshm () nil
81 (defbinding get-show-events () boolean)
83 (defbinding get-use-xshm () boolean)
85 (defbinding get-display () string)
87 ; (defbinding time-get () (unsigned 32))
89 ; (defbinding timer-get () (unsigned 32))
91 ; (defbinding timer-set () nil
92 ; (milliseconds (unsigned 32)))
94 ; (defbinding timer-enable () nil)
96 ; (defbinding timer-disable () nil)
100 (defbinding pointer-grab () int
102 (owner-events boolean)
103 (event-mask event-mask)
104 (confine-to (or null window))
105 (cursor (or null cursor))
106 (time (unsigned 32)))
108 (defbinding pointer-ungrab () nil
109 (time (unsigned 32)))
111 (defbinding keyboard-grab () int
113 (owner-events boolean)
114 (time (unsigned 32)))
116 (defbinding keyboard-ungrab () nil
117 (time (unsigned 32)))
119 (defbinding (pointer-is-grabbed-p "gdk_pointer_is_grabbed") () boolean)
121 (defbinding screen-width () int)
122 (defbinding screen-height () int)
124 (defbinding screen-width-mm () int)
125 (defbinding screen-height-mm () int)
127 (defbinding flush () nil)
128 (defbinding beep () nil)
130 (defbinding atom-intern (atom-name &optional only-if-exists) atom
131 ((string atom-name) string)
132 (only-if-exists boolean))
134 (defbinding atom-name () string
141 (defbinding visual-get-best-depth () int)
143 (defbinding visual-get-best-type () visual-type)
145 (defbinding visual-get-system () visual)
148 (defbinding (%visual-get-best-with-nothing "gdk_visual_get_best") () visual)
150 (defbinding %visual-get-best-with-depth () visual
153 (defbinding %visual-get-best-with-type () visual
156 (defbinding %visual-get-best-with-both () visual
160 (defun visual-get-best (&key depth type)
162 ((and depth type) (%visual-get-best-with-both depth type))
163 (depth (%visual-get-best-with-depth depth))
164 (type (%visual-get-best-with-type type))
165 (t (%visual-get-best-with-nothing))))
167 ;(defbinding query-depths ..)
169 ;(defbinding query-visual-types ..)
171 (defbinding list-visuals () (glist visual))
176 (defbinding window-destroy () nil
180 (defbinding window-at-pointer () window
184 (defbinding window-show () nil
187 (defbinding window-show-unraised () nil
190 (defbinding window-hide () nil
193 (defbinding window-is-visible-p () boolean
196 (defbinding window-is-viewable-p () boolean
199 (defbinding window-withdraw () nil
202 (defbinding window-iconify () nil
205 (defbinding window-deiconify () nil
208 (defbinding window-stick () nil
211 (defbinding window-unstick () nil
214 (defbinding window-maximize () nil
217 (defbinding window-unmaximize () nil
220 (defbinding window-fullscreen () nil
223 (defbinding window-unfullscreen () nil
226 (defbinding window-set-keep-above () nil
230 (defbinding window-set-keep-below () nil
234 (defbinding window-move () nil
239 (defbinding window-resize () nil
244 (defbinding window-move-resize () nil
251 (defbinding window-scroll () nil
256 (defbinding window-reparent () nil
262 (defbinding window-clear () nil
265 (defbinding %window-clear-area () nil
267 (x int) (y int) (width int) (height int))
269 (defbinding %window-clear-area-e () nil
271 (x int) (y int) (width int) (height int))
273 (defun window-clear-area (window x y width height &optional expose)
275 (%window-clear-area-e window x y width height)
276 (%window-clear-area window x y width height)))
278 (defbinding window-raise () nil
281 (defbinding window-lower () nil
284 (defbinding window-focus () nil
286 (timestamp unsigned-int))
288 (defbinding window-register-dnd () nil
291 (defbinding window-begin-resize-drag () nil
297 (timestamp unsigned-int))
299 (defbinding window-begin-move-drag () nil
304 (timestamp unsigned-int))
308 (defbinding window-set-user-data () nil
312 (defbinding window-set-override-redirect () nil
314 (override-redirect boolean))
316 ; (defbinding window-add-filter () nil
318 ; (defbinding window-remove-filter () nil
320 (defbinding window-shape-combine-mask () nil
326 (defbinding window-set-child-shapes () nil
329 (defbinding window-merge-child-shapes () nil
333 (defbinding window-set-static-gravities () boolean
335 (use-static boolean))
337 ; (defbinding add-client-message-filter ...
339 (defbinding window-set-cursor () nil
341 (cursor (or null cursor)))
343 (defbinding window-get-pointer () window
347 (mask modifier-type :out))
349 (defbinding %window-get-toplevels () (glist window))
351 (defun window-get-toplevels (&optional screen)
353 (error "Not implemented")
354 (%window-get-toplevels)))
356 (defbinding %get-default-root-window () window)
358 (defun get-root-window (&optional display)
360 (error "Not implemented")
361 (%get-default-root-window)))
369 (defbinding drag-status () nil
370 (context drag-context)
372 (time (unsigned 32)))
381 (defbinding rgb-init () nil)
388 (defmethod initialize-instance ((cursor cursor) &key type mask fg bg
389 (x 0) (y 0) (display (display-get-default)))
391 (slot-value cursor 'location)
393 (keyword (%cursor-new-for-display display type))
394 (pixbuf (%cursor-new-from-pixbuf display type x y))
395 (pixmap (%cursor-new-from-pixmap type mask fg bg x y)))))
398 (defbinding %cursor-new-for-display () pointer
400 (cursor-type cursor-type))
402 (defbinding %cursor-new-from-pixmap () pointer
409 (defbinding %cursor-new-from-pixbuf () pointer
414 (defbinding %cursor-ref () pointer
417 (defbinding %cursor-unref () nil
420 (defmethod reference-foreign ((class (eql (find-class 'cursor))) location)
421 (declare (ignore class))
422 (%cursor-ref location))
424 (defmethod unreference-foreign ((class (eql (find-class 'cursor))) location)
425 (declare (ignore class))
426 (%cursor-unref location))
431 (defbinding pixmap-new (width height depth &key window) pixmap
435 (window (or null window)))
437 (defbinding %pixmap-colormap-create-from-xpm () pixmap
438 (window (or null window))
439 (colormap (or null colormap))
441 (color (or null color))
444 (defbinding %pixmap-colormap-create-from-xpm-d () pixmap
445 (window (or null window))
446 (colormap (or null colormap))
448 (color (or null color))
449 (data (vector string)))
451 (defun pixmap-create (source &key color window colormap)
453 (if (not (or window colormap))
456 (multiple-value-bind (pixmap mask)
458 ((or string pathname)
459 (%pixmap-colormap-create-from-xpm
460 window colormap color (namestring (truename source))))
462 (%pixmap-colormap-create-from-xpm-d window colormap color source)))
463 ;; (unreference-instance pixmap)
464 ;; (unreference-instance mask)
465 (values pixmap mask))))
471 (defun %scale-value (value)
474 (float (truncate (* value 65535)))))
476 (defmethod initialize-instance ((color color) &rest initargs
478 (declare (ignore initargs))
480 (with-slots ((%red red) (%green green) (%blue blue)) color
482 %red (%scale-value red)
483 %green (%scale-value green)
484 %blue (%scale-value blue))))
486 (defun ensure-color (color)
492 'color :red (svref color 0) :green (svref color 1)
493 :blue (svref color 2)))))
499 (defbinding drawable-get-size () nil
504 (defbinding (drawable-width "gdk_drawable_get_size") () nil
509 (defbinding (drawable-height "gdk_drawable_get_size") () nil
514 ;; (defbinding drawable-get-clip-region () region
515 ;; (drawable drawable))
517 ;; (defbinding drawable-get-visible-region () region
518 ;; (drawable drawable))
520 (defbinding draw-point () nil
521 (drawable drawable) (gc gc)
524 (defbinding %draw-points () nil
525 (drawable drawable) (gc gc)
529 ;; (defun draw-points (drawable gc &rest points)
533 (defbinding draw-line () nil
534 (drawable drawable) (gc gc)
538 ;; (defbinding draw-lines (drawable gc &rest points) nil
539 ;; (drawable drawable) (gc gc)
540 ;; (points (vector point))
541 ;; ((length points) int))
543 (defbinding draw-pixbuf
544 (drawable gc pixbuf src-x src-y dest-x dest-y &optional
545 width height (dither :none) (x-dither 0) (y-dither 0)) nil
546 (drawable drawable) (gc (or null gc))
548 (src-x int) (src-y int)
549 (dest-x int) (dest-y int)
550 ((or width -1) int) ((or height -1) int)
552 (x-dither int) (y-dither int))
554 ;; (defbinding draw-segments (drawable gc &rest points) nil
555 ;; (drawable drawable) (gc gc)
556 ;; (segments (vector segments))
557 ;; ((length segments) int))
559 (defbinding draw-rectangle () nil
560 (drawable drawable) (gc gc)
563 (width int) (height int))
565 (defbinding draw-arc () nil
566 (drawable drawable) (gc gc)
569 (width int) (height int)
570 (angle1 int) (angle2 int))
572 ;; (defbinding draw-polygon (drawable gc &rest points) nil
573 ;; (drawable drawable) (gc gc)
574 ;; (points (vector point))
575 ;; ((length points) int))
577 ;; (defbinding draw-trapezoid (drawable gc &rest points) nil
578 ;; (drawable drawable) (gc gc)
579 ;; (points (vector point))
580 ;; ((length points) int))
582 ;; (defbinding %draw-layout-line () nil
583 ;; (drawable drawable) (gc gc)
586 ;; (line pango:layout-line))
588 ;; (defbinding %draw-layout-line-with-colors () nil
589 ;; (drawable drawable) (gc gc)
592 ;; (line pango:layout-line)
593 ;; (foreground (or null color))
594 ;; (background (or null color)))
596 ;; (defun draw-layout-line (drawable gc font x y line &optional foreground background)
597 ;; (if (or foreground background)
598 ;; (%draw-layout-line-with-colors drawable gc font x y line foreground background)
599 ;; (%draw-layout-line drawable gc font x y line)))
601 (defbinding %draw-layout () nil
602 (drawable drawable) (gc gc)
605 (layout pango:layout))
607 (defbinding %draw-layout-with-colors () nil
608 (drawable drawable) (gc gc)
611 (layout pango:layout)
612 (foreground (or null color))
613 (background (or null color)))
615 (defun draw-layout (drawable gc font x y layout &optional foreground background)
616 (if (or foreground background)
617 (%draw-layout-with-colors drawable gc font x y layout foreground background)
618 (%draw-layout drawable gc font x y layout)))
620 (defbinding draw-drawable
621 (drawable gc src src-x src-y dest-x dest-y &optional width height) nil
622 (drawable drawable) (gc gc)
624 (src-x int) (src-y int)
625 (dest-x int) (dest-y int)
626 ((or width -1) int) ((or height -1) int))
628 (defbinding draw-image
629 (drawable gc image src-x src-y dest-x dest-y &optional width height) nil
630 (drawable drawable) (gc gc)
632 (src-x int) (src-y int)
633 (dest-x int) (dest-y int)
634 ((or width -1) int) ((or height -1) int))
636 (defbinding drawable-get-image () image
639 (width int) (height int))
641 (defbinding drawable-copy-to-image
642 (drawable src-x src-y width height &optional image dest-x dest-y) image
644 (image (or null image))
645 (src-x int) (src-y int)
646 ((if image dest-x 0) int)
647 ((if image dest-y 0) int)
648 (width int) (height int))
653 (defbinding keyval-name () string
654 (keyval unsigned-int))
656 (defbinding keyval-from-name () unsigned-int
659 (defbinding keyval-to-upper () unsigned-int
660 (keyval unsigned-int))
662 (defbinding keyval-to-lower () unsigned-int
663 (keyval unsigned-int))
665 (defbinding (keyval-is-upper-p "gdk_keyval_is_upper") () boolean
666 (keyval unsigned-int))
668 (defbinding (keyval-is-lower-p "gdk_keyval_is_lower") () boolean
669 (keyval unsigned-int))